{"id":2149,"date":"2018-11-23T21:32:08","date_gmt":"2018-11-23T20:32:08","guid":{"rendered":"http:\/\/www.theusrus.de\/blog\/?p=2149"},"modified":"2018-11-23T21:34:23","modified_gmt":"2018-11-23T20:34:23","slug":"interactive-graphics-with-r-shiny","status":"publish","type":"post","link":"https:\/\/www.theusrus.de\/blog\/interactive-graphics-with-r-shiny\/","title":{"rendered":"Interactive Graphics with R Shiny"},"content":{"rendered":"<p>Well, R is definitively here to stay and made its way into the data science tool zoo. For me as a statistician, I often feel alienated surrounded by these animals, but R is still also the statistician&#8217;s tool of choice (yes, it has come to age, but where are the predators ..?)<\/p>\n<p>What was usually a big problem for us statistician, was to get our methods and models out to our customers, who (usually) don&#8217;t speak R. At this point Shiny comes in handy and offers a whole suite of bread and butter interface widgets, which can be deployed to web-pages and wired to R functions via all kinds of callback-routines.<\/p>\n<p>A typical <a href=\"http:\/\/shiny.rstudio.com\/gallery\/kmeans-example.html\">example<\/a> (sorry for the data set) looks like this:<\/p>\n<p><iframe loading=\"lazy\" src=\"https:\/\/gallery.shinyapps.io\/050-kmeans-example\" width=\"570\" height=\"770\"><\/iframe><\/p>\n<p>(Please use this example in class to demonstrate how limited k-means is!)<\/p>\n<p>Hey, this is already pretty interactive for what we know from R and all without messing around with <a href=\"https:\/\/www.tcl.tk\" target=\"_blank\" rel=\"noopener\">Tcl\/Tk<\/a> or other hard to manage and hard to port UI builders. But what struck me was to try out and see what can actually be done with &#8220;real&#8221; interactive graphics as we know from e.g. <a href=\"http:\/\/www.theusrus.de\/Mondrian\/\">Mondrian<\/a> and in some parts from <a href=\"https:\/\/www.tableau.com\">Tableau<\/a>.<\/p>\n<p>Here is what I came up with (same data for better recognition ;-):<\/p>\n<p><iframe loading=\"lazy\" src=\"https:\/\/theusrus.shinyapps.io\/shiny-interactive-graphics\/\" width=\"570\" height=\"1400\"><\/iframe><\/p>\n<p>The whole magic is done with these lines of code:<\/p>\n<pre>library(MASS)\r\n\r\noptions(shiny.sanitize.errors = FALSE)\r\n\r\noptions(shiny.fullstacktrace = TRUE)\r\n\r\nui &lt;- fluidPage(title=\"Shiny Linking Demo\",\r\n                fluidRow(\r\n                  column(5,\r\n                         plotOutput(\"plot1\",\r\n                                    click = \"plot_click\",\r\n                                    brush = brushOpts(\"plot_brush\"),\r\n                                    width = 500,\r\n                                    height = 500\r\n                         )),\r\n                  column(5,\r\n                         plotOutput(\"plot2\",\r\n                                    click = \"plot2_click\",\r\n                                    width = 500,\r\n                                    height = 500\r\n                         ))),\r\n                fluidRow(\r\n                  column(5,\r\n                         plotOutput(\"plot3\",\r\n                                    click = \"plot3_click\",\r\n                                    brush = brushOpts(\"plot3_brush\"),\r\n                                    width = 600,\r\n                                    height = 400\r\n                         ))\r\n                )\r\n            )\r\n\r\nserver &lt;- function(input, output, session) {\r\n  keep &lt;- rep(FALSE, 150)\r\n  shift &lt;- FALSE\r\n  old_brush &lt;- -9999\r\n  var&lt;- 1\r\n  \r\n  keeprows &lt;- reactive({\r\n    keepN &lt;- keep\r\n    if (!is.null(input$plot_click$x) |  !is.null(input$plot3_click$x))\r\n      keepN &lt;- rep(FALSE, 150)\r\n    if (!is.null(input$plot_brush$xmin) ) {\r\n      if( old_brush != input$plot_brush$xmin ) {\r\n        keepN &lt;- brushedPoints(iris, input$plot_brush,\r\n                               xvar = \"Sepal.Length\",\r\n                               yvar = \"Sepal.Width\",\r\n                               allRows = TRUE)$selected_\r\n        old_brush &lt;&lt;- input$plot_brush$xmin\r\n      }\r\n    }\r\n    if (!is.null(input$plot2_click$x) ) {\r\n      keepN &lt;- pmax(1,pmin(3,round(input$plot2_click$x))) == as.numeric(iris$Species)\r\n      session$resetBrush(\"plot_brush\")\r\n      session$resetBrush(\"plot3_brush\")\r\n    }\r\n    if (!is.null(input$plot3_brush$xmin) ) {\r\n      if( old_brush != input$plot3_brush$xmin ) {\r\n        var &lt;&lt;- round((input$plot3_brush$xmin + input$plot3_brush$xmax) \/ 2 )\r\n        coor_min &lt;- min(iris[,var]) + input$plot3_brush$ymin * diff(range(iris[,var]))\r\n        coor_max &lt;- min(iris[,var]) + input$plot3_brush$ymax * diff(range(iris[,var]))\r\n        keepN &lt;- iris[, var] &gt;= coor_min &amp; iris[, var] &lt;= coor_max\r\n        old_brush &lt;&lt;- input$plot3_brush$xmin\r\n      }\r\n    }\r\n    if( is.null(input$key) )\r\n      keep &lt;&lt;- keepN\r\n    else {\r\n      if( input$key )\r\n        keep &lt;&lt;- keepN | keep\r\n      else\r\n        keep &lt;&lt;- keepN\r\n    }\r\n    return(keep)\r\n  })\r\n  \r\n  output$plot1 &lt;- renderPlot({\r\n    plot(iris$Sepal.Length, iris$Sepal.Width, main=\"Drag to select points\")\r\n    points(iris$Sepal.Length[keeprows()],\r\n           iris$Sepal.Width[keeprows()], col=2, pch=16)\r\n  })\r\n  output$plot2 &lt;- renderPlot({\r\n    barplot(table(iris$Species), main=\"Click to select classes\")\r\n    barplot(table(iris$Species[keeprows()]), add=T, col=2)\r\n  })\r\n  output$plot3 &lt;- renderPlot({\r\n    parcoord(iris[,-5], col=keeprows() + 1, lwd=keeprows() + 1)\r\n  })\r\n}\r\n\r\nshinyApp(ui, server)\r\n<\/pre>\n<p>What makes this example somewhat special is:<\/p>\n<ul>\n<li>It does not need too much code<\/li>\n<li>It is relatively general, i.e. other plots may be added<\/li>\n<li>It uses traditional R graphics off the shelf<\/li>\n<li>It is not too slow<\/li>\n<\/ul>\n<p>Of course it is a hack! But it proves that Shiny is capable to do interactive statistical graphics to some degree.<\/p>\n<p>Something the developer of Shiny actually do <a href=\"https:\/\/www.rstudio.com\/resources\/webinars\/interactive-graphics-with-shiny\/\">think about<\/a>.<\/p>\n","protected":false},"excerpt":{"rendered":"<p>Well, R is definitively here to stay and made its way into the data science tool zoo. For me as a statistician, I often feel alienated surrounded by these animals, but R is still also the statistician&#8217;s tool of choice (yes, it has come to age, but where are the predators ..?) What was usually [&hellip;]<\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"footnotes":""},"categories":[1,14,6],"tags":[],"class_list":["post-2149","post","type-post","status-publish","format-standard","hentry","category-general","category-r","category-tools"],"_links":{"self":[{"href":"https:\/\/www.theusrus.de\/blog\/wp-json\/wp\/v2\/posts\/2149","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/www.theusrus.de\/blog\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.theusrus.de\/blog\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.theusrus.de\/blog\/wp-json\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/www.theusrus.de\/blog\/wp-json\/wp\/v2\/comments?post=2149"}],"version-history":[{"count":18,"href":"https:\/\/www.theusrus.de\/blog\/wp-json\/wp\/v2\/posts\/2149\/revisions"}],"predecessor-version":[{"id":2167,"href":"https:\/\/www.theusrus.de\/blog\/wp-json\/wp\/v2\/posts\/2149\/revisions\/2167"}],"wp:attachment":[{"href":"https:\/\/www.theusrus.de\/blog\/wp-json\/wp\/v2\/media?parent=2149"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.theusrus.de\/blog\/wp-json\/wp\/v2\/categories?post=2149"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.theusrus.de\/blog\/wp-json\/wp\/v2\/tags?post=2149"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}