inst/examples/compare.R

In tdhock/animint2: Animated Interactive Grammar of Graphics

library(animint2)
library(reshape2)
library(plyr)
data(compare)
## difference between rank and compare models.
sets <- dcast(compare$err, N + seed + norm ~ fit.name, value.var="percent")
sets$diff <- sets$compare-sets$rank
sets$set.id <- 1:nrow(sets)
diff.df <- ddply(sets, .(N, norm), summarize,
                   N=N[1], norm=norm[1],
                   mean=mean(diff), sd=sd(diff))
## Axes labels.
xl <- xlab("feature 1")
yl <- ylab("feature 2")
x.lab <- "number of labeled pairs in the training set"
model.colors <- c(compare="#00bfc4", #bluish
                  rank="#f8766d",
                  latent="grey")
ord <- c("latent","compare","rank")
dots <-
  list(data=ggplot()+
       geom_segment(aes(Xt.1, Xt.2, xend=Xtp.1, yend=Xtp.2, colour=factor(yt)),
                    showSelected="set.id",
                    data=compare$train)+
       geom_point(aes(Xtp.1, Xtp.2, colour=factor(yt)),
                  showSelected="set.id",
                  data=subset(compare$train, yt==1))+
       scale_colour_manual("label",values=c("1"="red","-1"="black"))+
       xl+yl+
       ggtitle("training data"),
       error=ggplot()+
       make_text(compare$err, 200, 35, "norm")+
       geom_point(aes(as.integer(as.character(N)), percent, colour=model),
                  showSelected=c("norm", "set.id"),
                  data=compare$bayes)+
       geom_point(aes(N, percent, colour=fit.name),
                  showSelected="norm",
                  clickSelects="set.id",
                 lwd=3,alpha=3/4,data=compare$err)+
       ylab("percent incorrectly predicted test pairs")+
       scale_colour_manual("model", values=c(model.colors[1:2],latent="black"),
                           breaks=ord)+
       xlab(x.lab)+
       ggtitle("test error, select data set"),
       diff=ggplot()+
       geom_ribbon(aes(N, ymin=mean-sd, ymax=mean+sd, group=norm),
                   clickSelects="norm", alpha=1/2,
                   data=diff.df)+
       geom_line(aes(N, mean, group=norm), clickSelects="norm", 
                   data=diff.df)+
       geom_hline(yintercept=0, color="red")+
       geom_text(aes(x,y,label=label),color="red",
                 data=data.frame(x=150,y=1,label="no difference"))+
       ggtitle("test error difference, select norm")+
       xlab(x.lab)+
       ylab("<- compare better (test error percent difference) rank better->"))
for(model in c("compare", "rank")){
  sub.df <- subset(compare$rank, what %in% c(model, "latent"))
  L <- list(ggplot()+
    geom_contour(aes(x1, x2, z=rank, group=interaction(what, norm, seed, N),
                     colour=what), showSelected="set.id", data=sub.df)+
    scale_colour_manual("model",values=model.colors)+
            xl+yl+
    ggtitle(sprintf("learned SVM%s model",model)))
  names(L) <- model
  dots <- c(dots, L)
}
animint2dir(dots, "interactive-dots")