initial metro diagram

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&section=all which you can add to apt.yml:
+```
+packages:
+  - r-cran-shiny
+```
+
+Otherwise add new R packages to r.yml:
+```
+    packages:
+      - name: shiny
+```

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 )
 )
 }
 

shiny/observatory/apt.yml

@@ -4,4 +4,6 @@ repos:
 packages:
   - nginx-core
   - r-base
-  - r-base-dev
+  - r-base-dev
+  - r-cran-littler
+  - r-cran-dplyr

shiny/observatory/r.yml

@@ -2,4 +2,5 @@
 packages:
   - cran_mirror: https://cran.csiro.au
     packages:
-      - name: shiny
+      - name: shiny
+      - name: r2d3

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())"
+/home/vcap/deps/0/apt/usr/sbin/nginx -p . -c nginx.conf &
+R -e "options(shiny.port = 3838); shiny::runApp(getwd())"

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) {
-}
+  output$d3 <- renderD3({
+    r2d3(
+      replicate(input$bar_journeys, list(data.frame(title = replicate(input$bar_steps,"")))),
+      script = "userjourneys.js"
+    )
+  })
+}

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");
+