Selector widgets

.gitignore

@@ -18,3 +18,4 @@ animint.Rproj
 tests/testthat/animint-htmltest/
 tests/testthat/pids.txt
 tests/testthat/.httr-oauth
+.httr-oauth

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: animint
 Maintainer: Toby Dylan Hocking <tdhock5@gmail.com>
 Author: Toby Dylan Hocking, Susan VanderPlas, Carson Sievert
-Version: 2015.08.31
+Version: 2015.09.08
 License: GPL-3
 Title: Interactive animations
 Description: An interactive animation can be defined using a list of

NEWS

@@ -112,24 +112,6 @@ RENDER: Easy legend decoding: draw an arrow next to the legend entry
 for the value of the element that the mouse is hovering over, e.g.
 http://www.highcharts.com/maps/demo/map-drilldown/dark-unica
 
-RENDER: For each selector variable, render a widget for selecting values:
-- single selection variable: <select> or <input type="radio">
-- multiple selection categorical variable: <input type="checkbox">
-- multiple selection numeric/datetime variable: crossfilter.js
-http://square.github.io/crossfilter/
-Currently, it is only possible to change the selection by clicking on
-data points/lines, not widgets. To implement that you would probably
-just have to add a few lines of JavaScript code to add the widgets,
-right after the plot meta-data is loaded, in add_selector
-https://github.com/tdhock/animint/blob/master/inst/htmljs/animint.js#L261. Also
-for an example of adding a button to the web page in JavaScript, see
-https://github.com/tdhock/animint/blob/master/inst/htmljs/animint.js#L1114.
-
-DSL: For each widget selector, should we show all available values,
-or just the values that are clickable onscreen? Or both? This may be
-specified by the designer using an option
-widgets=list(var1="onscreen", var2="all", var3="both").
-
 DSL: To accomplish interactivity like in this plot
 http://timelyportfolio.blogspot.ca/2014/05/pdf-chart-inkscape-svg-d3-interactive.html
 http://kbroman.github.io/qtlcharts/assets/chartexamples/iplotMScanone_example.html
@@ -194,6 +176,11 @@ https://github.com/mbostock/d3/wiki/SVG-Shapes#symbol_type
 
 RENDER: Determine why border of tiles in pirates example does not seem to be rendering.
 
+2015.09.08
+
+RENDER: For each selector variable, render a widget for selecting
+values using selectize.js
+
 2015.08.31
 
 BUGFIX: For geom_point(aes(fill=annotation,

R/animint.R

@@ -121,6 +121,10 @@ parsePlot <- function(meta){
         if(is.null(meta$selector.types[[var_name]])) {
           meta$selector.types[[var_name]] <- "multiple"
         }
+        # if first is not specified, create it
+        if(is.null(meta$first)) {
+          meta$first <- list()
+        }
         # if first is not specified, add all to first
         if(is.null(meta$first[[var_name]])) {
           u.vals <- unique(var)
@@ -444,8 +448,11 @@ saveLayer <- function(l, d, meta){
       stopifnot(length(selector.type)==1)
       stopifnot(selector.type %in% c("single", "multiple"))
       meta$selectors[[v.name]] <-
-        list(selected=as.character(value),
-             type=selector.type)
+        list(
+          selected=as.character(value),
+          type=selector.type, 
+          levels=as.character(unique(l$data[[v.name]]))
+        )
     }
     meta$selectors[[v.name]]$update <-
       c(meta$selectors[[v.name]]$update, as.list(g$classed))

inst/examples/WorldBank.R

@@ -103,9 +103,9 @@ animint2dir(good, "WorldBank-good")
 
 ## This example additionally uses multiple selection on countries.
 library(dplyr)
-max.years <- not.na %.%
-  group_by(country) %.%
-  filter(year==max(year)) %.%
+max.years <- not.na %>%
+  group_by(country) %>%
+  filter(year==max(year)) %>%
   mutate(year=2012)
 wb.mult <-
   list(ts=ggplot()+
@@ -134,17 +134,15 @@ wb.mult <-
                  data=not.na)+
        scale_size_animint(breaks=10^(5:9))+
        make_text(not.na, 5, 85, "year"),
+
        time=list(variable="year",ms=3000),
-       bar=ggplot()+
-       theme_animint(height=2400)+
-       geom_bar(aes(country, life.expectancy, fill=region,
-                    showSelected=year, clickSelects=country,
-                    key=country),
-                data=not.na, stat="identity", position="identity")+
-       coord_flip(),
+
        duration=list(year=1000),
+
        first=list(year=1975, country=c("United States", "Vietnam")),
+
        selector.types=list(country="multiple"),
+
        title="World Bank data (multiple selection)")
 animint2dir(wb.mult, "WorldBank-multiple")
 
@@ -157,9 +155,9 @@ TS <- function(df)BOTH(df, "Years", "Life expectancy")
 SCATTER <- function(df)BOTH(df, "Fertility rate", "Life expectancy")
 TS2 <- function(df)BOTH(df, "Fertility rate", "Years")
 years <- unique(not.na[, "year", drop=FALSE])
-min.years <- not.na %.%
-  group_by(country) %.%
-  filter(year==min(year)) %.%
+min.years <- not.na %>%
+  group_by(country) %>%
+  filter(year==min(year)) %>%
   mutate(year=1958)
 wb.facets <-
   list(ts=ggplot()+
@@ -204,16 +202,15 @@ wb.facets <-
        geom_text(aes(5, 85, label=paste0("year = ", year),
                      showSelected=year),
                  data=SCATTER(years)),
+
        time=list(variable="year",ms=3000),
-       bar=ggplot()+
-       theme_animint(height=2400)+
-       geom_bar(aes(country, life.expectancy, fill=region,
-                    showSelected=year, clickSelects=country,
-                    key=country),
-                data=not.na, stat="identity", position="identity")+
-       coord_flip(),
+
        duration=list(year=1000),
+
        first=list(year=1975, country=c("United States", "Vietnam")),
+
        selector.types=list(country="multiple"),
+
        title="World Bank data (multiple selection, facets)")
+
 animint2dir(wb.facets, "WorldBank-facets")

inst/examples/intreg.R

@@ -1,5 +1,5 @@
-works_with_R("3.1.1",
-             "tdhock/animint@adefc133fd71a2ecd344bfaa102e3b5038ddf596")
+works_with_R("3.2.2",
+             "tdhock/animint@9df282ba7b9e1dec9fd16124219870fa25e5df57")
 
 ## Example: 4 plots, 2 selectors.
 data(intreg)
@@ -98,6 +98,7 @@ animint2dir(mmir.plot, "intreg-nofacets")
 ## facets. The simpler facetted version looks like this:
 mmir.facet <- 
   list(signal=mmir.plot$signal,
+
        penalty=ggplot()+
        geom_tallrect(aes(xmin=min.L, xmax=max.L,
                          showSelected=signal,
@@ -123,7 +124,9 @@ mmir.facet <-
                         showSelected=signal),
                     data=data.frame(intreg$selection, what="segments"))+
        xlab("penalty value $L=f(x)$")+ # TODO: mathjax.
-       facet_grid(what~.,scales="free"))
+       facet_grid(what~.,scales="free"),
+
+       title="Max-margin interval regression")
 animint2dir(mmir.facet, "intreg-facets") 
 ## This plot has an additional facet for signal, which would not be
 ## present in the interactive plot, but is useful here to see all
@@ -134,6 +137,103 @@ too.many.facets <- mmir.facet$penalty+
   theme(panel.margin=grid::unit(0, "cm"))
 print(too.many.facets)
 
+## Regions with linetype indicating errors.
+breaks.by.signal <- split(intreg$breaks, intreg$breaks$signal)
+anns.by.signal <- split(intreg$ann, intreg$ann$signal)
+error.regions.list <- list()
+for(signal in names(breaks.by.signal)){
+  signal.breaks <- breaks.by.signal[[signal]]
+  signal.anns <- anns.by.signal[[signal]]
+  signal.anns$target.breaks <-
+    ifelse(signal.anns$annotation=="1breakpoint", 1, 0)
+  for(model.i in 1:20){
+    model.breaks <- subset(signal.breaks, segments==model.i)
+    signal.anns$breaks <- NA
+    for(region.i in 1:nrow(signal.anns)){
+      region <- signal.anns[region.i, ]
+      after.start <- region$first.base < model.breaks$base
+      before.end <- model.breaks$base < region$last.base
+      signal.anns$breaks[region.i] <- sum(after.start & before.end)
+    }
+    signal.anns$error.type <- with(signal.anns, {
+      ifelse(breaks < target.breaks, "false negative",
+             ifelse(target.breaks < breaks, "false positive", "correct"))
+    })
+    error.regions.list[[paste(model.i, signal)]] <-
+      data.frame(segments=model.i, signal.anns)
+  }
+}
+error.regions <- do.call(rbind, error.regions.list)
+
+intreg.errors <- 
+  list(signal=ggplot()+
+       theme_animint(height=300, width=800)+       
+       scale_x_continuous("position on chromosome (mega base pairs)",
+                          breaks=c(100,200))+
+       ylab("noisy copy number logratio signal")+
+       geom_tallrect(aes(xmin=first.base/1e6, xmax=last.base/1e6,
+                         fill=annotation,
+                         linetype=error.type,
+                         showSelected2=segments,
+                         showSelected=signal),
+                     color="black",
+                     alpha=0.5,
+                     data=error.regions)+
+       scale_linetype_manual("error type", values=c(correct=0,
+                                   "false negative"=3,
+                                   "false positive"=1))+
+       guides(linetype=guide_legend(override.aes=list(fill="white")))+       
+       scale_fill_manual(values=breakpoint.colors)+
+       geom_blank(aes(first.base/1e6, logratio+2/8), data=intreg$ann)+
+       geom_point(aes(base/1e6, logratio,
+                      showSelected=signal),
+                  data=intreg$sig)+
+       geom_segment(aes(first.base/1e6, mean, xend=last.base/1e6, yend=mean,
+                        showSelected=signal,
+                        showSelected2=segments),
+                    data=intreg$seg, colour=signal.colors[["estimate"]])+
+       geom_vline(aes(xintercept=base/1e6,
+                      showSelected=signal,
+                      showSelected2=segments),
+                  colour=signal.colors[["estimate"]],
+                  linetype="dashed",
+                  data=intreg$breaks),
+
+       penalty=ggplot()+
+       geom_tallrect(aes(xmin=min.L, xmax=max.L,
+                         showSelected=signal,
+                         clickSelects=segments),
+                     data=data.frame(intreg$selection
+                      ##,what="segments"
+                                     ),
+                     alpha=1/2)+
+       ylab("")+
+       theme_animint(height=500, width=800)+
+       geom_segment(aes(min.L, feature, xend=max.L, yend=feature,
+                        clickSelects=signal),
+                    size=5,
+                    data=data.frame(intreg$int, what="regression"))+
+       geom_segment(aes(min.L, min.feature, xend=max.L, yend=max.feature,
+                        linetype=line),
+                    colour="violet",
+                    size=3,
+                    data=data.frame(intreg$model, what="regression"))+
+       scale_linetype_manual(values=model.linetypes)+
+       geom_segment(aes(min.L, cost, xend=max.L, yend=cost,
+                        showSelected=signal),
+                    data=data.frame(intreg$selection, what="error"))+
+       geom_segment(aes(min.L, segments, xend=max.L, yend=segments,
+                        showSelected=signal),
+                    data=data.frame(intreg$selection, what="segments"))+
+       xlab("penalty value log(lambda)")+ # TODO: mathjax.
+       facet_grid(what~., scales="free"),
+
+       title="Max-margin interval regression")
+
+animint2dir(intreg.errors, "intreg-errors")
+
+##animint2gist(intreg.errors)
+
 ## No annotated regions!
 mmir.segs <- 
   list(signal=ggplot()+