diff --git a/shiny/observatory/README.Rmd b/shiny/observatory/README.Rmd new file mode 100644 index 0000000..479db4f --- /dev/null +++ b/shiny/observatory/README.Rmd @@ -0,0 +1,18 @@ +# Observatory + +## Getting started +Run the app from app.R +Put submodules in their own R files then include into app.R, adding the component to UI and the server function to Server. + +## Adding new R packages +First check if there is an "r-cran" APT package for the package by searching on https://packages.ubuntu.com/search?keywords=r-cran&searchon=names&suite=bionic§ion=all which you can add to apt.yml: +``` +packages: + - r-cran-shiny +``` + +Otherwise add new R packages to r.yml: +``` + packages: + - name: shiny +``` diff --git a/shiny/observatory/app.R b/shiny/observatory/app.R index a1292ff..5508aa5 100644 --- a/shiny/observatory/app.R +++ b/shiny/observatory/app.R @@ -1,4 +1,5 @@ library(shiny) +library(r2d3) # Define UI ---- # User interface ---- @@ -13,7 +14,7 @@ ui <- function() { subline = "To quantify interactions with every government service", # https://support.dominodatalab.com/hc/en-us/articles/360015932932-Increasing-the-timeout-for-Shiny-Server keepalive= textOutput("keepAlive"), - main = navbarPage("", shinyTester, painPoints, userJourneys) + main = navbarPage("", userJourneys, shinyTester, painPoints ) ) } diff --git a/shiny/observatory/apt.yml b/shiny/observatory/apt.yml index 922aeb1..1085f15 100644 --- a/shiny/observatory/apt.yml +++ b/shiny/observatory/apt.yml @@ -4,4 +4,6 @@ repos: packages: - nginx-core - r-base - - r-base-dev \ No newline at end of file + - r-base-dev + - r-cran-littler + - r-cran-dplyr \ No newline at end of file diff --git a/shiny/observatory/r.yml b/shiny/observatory/r.yml index 131d264..4d94800 100644 --- a/shiny/observatory/r.yml +++ b/shiny/observatory/r.yml @@ -2,4 +2,5 @@ packages: - cran_mirror: https://cran.csiro.au packages: - - name: shiny \ No newline at end of file + - name: shiny + - name: r2d3 \ No newline at end of file diff --git a/shiny/observatory/run.sh b/shiny/observatory/run.sh index bfac38c..6f53bb4 100644 --- a/shiny/observatory/run.sh +++ b/shiny/observatory/run.sh @@ -9,4 +9,5 @@ if [ ! -f setup_complete ]; then /home/vcap/deps/0/apt/usr/sbin/nginx -V touch setup_complete fi -/home/vcap/deps/0/apt/usr/sbin/nginx -p . -c nginx.conf & && R -e "options(shiny.port = 3838); shiny::runApp(getwd())" \ No newline at end of file +/home/vcap/deps/0/apt/usr/sbin/nginx -p . -c nginx.conf & +R -e "options(shiny.port = 3838); shiny::runApp(getwd())" diff --git a/shiny/observatory/userjourneys.R b/shiny/observatory/userjourneys.R index 1159037..040d41c 100644 --- a/shiny/observatory/userjourneys.R +++ b/shiny/observatory/userjourneys.R @@ -4,13 +4,24 @@ userJourneys <- tabPanel( sidebarLayout( # Sidebar panel for inputs ---- sidebarPanel( + sliderInput("bar_steps", label = "Steps:", + min = 1, max = 6, value = 6, step = 1), + sliderInput("bar_journeys", label = "Journeys:", + min = 1, max = 6, value = 5, step = 1) ) , # Main panel for displaying outputs ---- main = mainPanel( +d3Output("d3", width = "100%", height = 800) ) ) ) userjourneys_server <- function (input, output) { -} \ No newline at end of file + output$d3 <- renderD3({ + r2d3( + replicate(input$bar_journeys, list(data.frame(title = replicate(input$bar_steps,"")))), + script = "userjourneys.js" + ) + }) +} diff --git a/shiny/observatory/userjourneys.js b/shiny/observatory/userjourneys.js new file mode 100644 index 0000000..93fe888 --- /dev/null +++ b/shiny/observatory/userjourneys.js @@ -0,0 +1,80 @@ +// !preview r2d3 data=list(data.frame(title = c("","","")), data.frame(title = c("","",""))),height=800 +// +// r2d3: https://rstudio.github.io/r2d3 +// + +r2d3.svg.selectAll("svg > *").remove(); +var g = r2d3.svg.selectAll() + .data(data) + .enter() + .append("g") + .attr("transform", function(d, i) {return "translate(" + 10 + "," + (i*140) + ")"}); + +function dx(d,i) { + return (i * 125) + 50; +} +function dy(d,i) { + return 90; +} +var lineFunction = d3.line() + .x(function(d,i) {return dx(d,i)}) + .y(function(d,i) {return dy(d,i)}) + .curve(d3.curveLinear); +var line = g.append("path") + .attr("d", function(d) {return lineFunction(d.title)}) + .attr("stroke", "grey") + .attr("stroke-width", 20) + .attr("fill", "white"); + +var circles = g.selectAll().data(function (d) { + return HTMLWidgets.dataframeToD3(d) +}); +circles.enter() + .append('circle') + .attr("cy", function(d,i) {return dy(d,i)}) + .attr("cx", function(d,i) {return dx(d,i)}) + .attr('r',30) + .attr('fill', 'white') + .attr('stroke', 'grey') + .attr('stroke-width','20px') + ; + +function wrap(text, width) { + // https://stackoverflow.com/questions/24784302/wrapping-text-in-d3 + text.each(function () { + var text = d3.select(this), + words = text.text().split(/\s+/).reverse(), + word, + line = [], + lineNumber = 0, + lineHeight = 1.1, // ems + x = text.attr("x"), + y = text.attr("y"), + dy = 0, //parseFloat(text.attr("dy")), + tspan = text.text(null) + .append("tspan") + .attr("x", x) + .attr("y", y) + .attr("dy", dy + "em"); + while (word = words.pop()) { + line.push(word); + tspan.text(line.join(" ")); + if (tspan.node().getComputedTextLength() > width) { + line.pop(); + tspan.text(line.join(" ")); + line = [word]; + tspan = text.append("tspan") + .attr("x", x) + .attr("y", y) + .attr("dy", ++lineNumber * lineHeight + dy + "em") + .text(word); + } + } + }); +} +var texts = g.selectAll().data(function(d) { return d.title}).enter().append("text") + .text(function(d) { return d }) + .style("font-size", function(d,i) { return Math.min(20, dy(d,i)/ this.getComputedTextLength() * 20) + "px"; }) + .attr("dx", function(d,i) {return dx(d,i)-this.getComputedTextLength()/2}) + .attr("dy", "160px"); +