acontext("mixtureKNN data set") library(animint2) data(mixtureKNN) mixtureKNN$Bayes.error$text.V1.prop <- 0 mixtureKNN$Bayes.error$text.V2.bottom <- -2 mixtureKNN$other.error$text.V1.prop <- 0 mixtureKNN$Bayes.error$text.V1.error <- -2.6 mixtureKNN$other.error$text.V1.error <- -2.6 classifier.linetypes <- c( Bayes="dashed", KNN="solid") label.colors <- c( "0"="#377EB8", "1"="#FF7F00") set.colors <- c(test="#984EA3",#purple validation="#4DAF4A",#green Bayes="#984EA3",#purple train="black") errorPlot <- ggplot()+ ggtitle("Select number of neighbors")+ theme_bw()+ theme_animint(height=500)+ geom_text(aes( min.neighbors, error.prop, color=set, label="Bayes"), showSelected="classifier", hjust=1, data=mixtureKNN$Bayes.segment)+ geom_segment(aes( min.neighbors, error.prop, xend=max.neighbors, yend=error.prop, color=set, linetype=classifier), showSelected="classifier", data=mixtureKNN$Bayes.segment)+ scale_color_manual(values=set.colors, breaks=names(set.colors))+ scale_fill_manual(values=set.colors)+ guides(fill="none", linetype="none")+ scale_linetype_manual(values=classifier.linetypes)+ ylab("Misclassification Errors")+ scale_x_continuous( "Number of Neighbors", limits=c(-1, 30), breaks=c(1, 10, 20, 29))+ geom_ribbon(aes( neighbors, ymin=mean-sd, ymax=mean+sd, fill=set), showSelected=c("classifier","set"), alpha=0.5, color=NA, data=mixtureKNN$validation.error)+ geom_line(aes( neighbors, mean, color=set, linetype=classifier), showSelected="classifier", data=mixtureKNN$validation.error)+ geom_line(aes( neighbors, error.prop, group=set, color=set, linetype=classifier), showSelected="classifier", data=mixtureKNN$other.error)+ geom_tallrect(aes( xmin=neighbors-1, xmax=neighbors+1), clickSelects="neighbors", alpha=0.5, data=mixtureKNN$validation.error) errorPlot scatterPlot <- ggplot()+ ggtitle("Mis-classification errors in train set")+ theme_bw()+ theme_animint(width=500, height=500)+ xlab("Input feature 1")+ ylab("Input feature 2")+ coord_equal()+ scale_color_manual(values=label.colors)+ scale_linetype_manual(values=classifier.linetypes)+ geom_point(aes( V1, V2, color=label), showSelected="neighbors", size=0.2, data=mixtureKNN$show.grid)+ geom_path(aes( V1, V2, group=path.i, linetype=classifier), showSelected="neighbors", size=1, data=mixtureKNN$pred.boundary)+ geom_path(aes( V1, V2, group=path.i, linetype=classifier), color=set.colors[["test"]], size=1, data=mixtureKNN$Bayes.boundary)+ geom_point(aes( V1, V2, color=label, fill=prediction), showSelected="neighbors", size=3, shape=21, data=mixtureKNN$show.points)+ scale_fill_manual(values=c(error="black", correct="transparent"))+ geom_text(aes( text.V1.error, text.V2.bottom, label=paste(set, "Error:")), data=mixtureKNN$Bayes.error, hjust=0)+ geom_text(aes( text.V1.prop, text.V2.bottom, label=sprintf("%.3f", error.prop)), data=mixtureKNN$Bayes.error, hjust=1)+ geom_text(aes( text.V1.error, V2.bottom, label=paste(set, "Error:")), showSelected="neighbors", data=mixtureKNN$other.error, hjust=0)+ geom_text(aes( text.V1.prop, V2.bottom, label=sprintf("%.3f", error.prop)), showSelected="neighbors", data=mixtureKNN$other.error, hjust=1)+ geom_text(aes( V1, V2, label=paste0( neighbors, " nearest neighbor", ifelse(neighbors==1, "", "s"), " classifier")), showSelected="neighbors", data=mixtureKNN$show.text) scatterPlot+ facet_wrap("neighbors")+ theme(panel.margin=grid::unit(0, "lines")) viz.neighbors <- animint( error=errorPlot, data=scatterPlot, first=list(neighbors=7) ) info <- animint2HTML(viz.neighbors) get_nodes <- function(html=getHTML()){ line.list <- getNodeSet(html, "//g[@class='geom2_segment_error']//line") rect.list <- getNodeSet( html, "//svg[@id='plot_error']//rect[@class='border_rect']") rect.attr.mat <- sapply(rect.list, xmlAttrs) rect.x <- as.numeric(rect.attr.mat["x",]) rect.width <- as.numeric(rect.attr.mat["width",]) rect.right <- rect.x + rect.width line.attr.mat <- sapply(line.list, xmlAttrs) list( ribbon=getNodeSet(html, "//g[@class='geom3_ribbon_error']//path"), validation=getNodeSet(html, "//g[@class='geom4_line_error']//path"), train.test=getNodeSet(html, "//g[@class='geom5_line_error']//path"), Bayes=line.list, Bayes.x2=if(is.matrix(line.attr.mat))as.numeric(line.attr.mat["x2",]), border.right=rect.right, boundary.KNN=getNodeSet(html, "//g[@class='geom8_path_data']//path"), boundary.Bayes=getNodeSet(html, "//g[@class='geom9_path_data']//path") ) } before <- get_nodes(info$html) test_that("1 rendered for validation error band", { expect_equal(length(before$ribbon), 1) }) test_that("1 rendered for validation error mean", { expect_equal(length(before$validation), 1) }) test_that("2 rendered for train/test error", { expect_equal(length(before$train.test), 2) }) test_that("1 rendered for Bayes error", { expect_equal(length(before$Bayes), 1) }) test_that("Bayes error inside of border_rect", { expect_lt(before$Bayes.x2, before$border.right) }) test_that("6 rendered for KNN boundary", { expect_equal(length(before$boundary.KNN), 6) }) test_that("2 rendered for Bayes boundary", { expect_equal(length(before$boundary.Bayes), 2) }) clickID("plot_data_classifier_variable_Bayes") click1 <- get_nodes() test_that("first click, 1 rendered for validation error band", { expect_equal(length(click1$ribbon), 1) }) test_that("first click, 1 rendered for validation error mean", { expect_equal(length(click1$validation), 1) }) test_that("first click, 2 rendered for train/test error", { expect_equal(length(click1$train.test), 2) }) test_that("first click, Bayes error disappears", { expect_equal(length(click1$Bayes), 0) }) test_that("first click, 6 rendered for KNN boundary", { expect_equal(length(click1$boundary.KNN), 6) }) test_that("first click, Bayes boundary disappears", { expect_equal(length(click1$boundary.Bayes), 0) }) clickID("plot_data_classifier_variable_KNN") click2 <- get_nodes() test_that("second click, validation error band disappears", { expect_equal(length(click2$ribbon), 0) }) test_that("second click, validation error mean disappears", { expect_equal(length(click2$validation), 0) }) test_that("second click, train/test error disappears", { expect_equal(length(click2$train.test), 0) }) test_that("second click, Bayes error still gone", { expect_equal(length(click2$Bayes), 0) }) test_that("second click, KNN boundary disappears", { expect_equal(length(click2$boundary.KNN), 0) }) test_that("second click, Bayes boundary still gone", { expect_equal(length(click2$boundary.Bayes), 0) })