R/clt_sampling_gui.r

In ArithmeticR/TOmisc:

#' Central Limit Theorem Gui
#'
#' Tool to help build understanding about the Central Limit Theorem.
#'
#' @return True if it successfully builds.
#' @author Trevor Olsen
#' @export
#'
#' @examples
#' ### clt_sampling_gui()
#'

clt_sampling_gui <- function(){
  ld_window <- RGtk2::gtkWindow(show=F)
  RGtk2::gtkWindowSetTitle(ld_window,"Central Limit Theorem Gui")
  file_name <- tempfile(pattern = "file", tmpdir = tempdir(), fileext = ".png")
  png(file_name)
  hist(rnorm(100))
  dev.off()
  main_box <- RGtk2::gtkVBox()
  RGtk2::gtkAdd(ld_window, main_box)

  top_image <- RGtk2::gtkImageNewFromFile(file_name)
  sample_box <- RGtk2::gtkHBox()
  distribution_box <- RGtk2::gtkHBox()
  iterations_box <- RGtk2::gtkHBox()
  generate_button <- RGtk2::gtkButton("Generate Plot")
  RGtk2::gtkBoxPackStart(main_box, distribution_box,F,F, padding = 5)
  RGtk2::gtkBoxPackStart(main_box, iterations_box,F,F, padding = 5)
  RGtk2::gtkBoxPackStart(main_box, top_image,T,T, padding = 5)
  RGtk2::gtkBoxPackStart(main_box, sample_box,F,F, padding = 5)
  RGtk2::gtkBoxPackStart(main_box, generate_button,F,F, padding = 5)


  distribution_combo <- RGtk2::gtkComboBoxNewText()

  distribution_names <- list("Beta"             =c("rbeta(n=100, shape1=0.5, shape2=0.5, ncp = 0)","rbeta")
                             ,"Binomial"         =c("rbinom(n=100, size=100, prob=.5)","rbinom")
                             ,"Cauchy"           =c("rcauchy(n=100, location = 0, scale = 1)","rcauchy")
                             ,"Chi-Square"       =c("rchisq(n=100, df=10, ncp = 0)","rchisq")
                             ,"Exponential"      =c("rexp(n=100, rate = 1)","rexp")
                             ,"F"                =c("rf(n=100, df1=10, df2=10)","rf")
                             ,"Gamma"            =c("rgamma(n=100, shape=2, rate = 1, scale = 1)","rgamma")
                             ,"Geometric"        =c("rgeom(n=100, prob=.5)","rgeom")
                             ,"Hypergeometric"   =c("rhyper(nn=100, m=10, n=10, k=5)","rhyper")
                             ,"Logistic"         =c("rlogis(n=100, location = 0, scale = 1)","rlogis")
                             ,"Log Normal"       =c("rlnorm(n=100, meanlog = 0, sdlog = 1)","rlnorm")
                             ,"Negative Binomial"=c("rnbinom(n=100, size=1, prob=.5)","rnbinom")
                             ,"Normal"           =c("rnorm(n=100, mean = 0, sd = 1)","rnorm")
                             ,"Poisson"          =c("rpois(n=100, lambda=1)","rpois")
                             ,"Student t"        =c("rt(n=100, df=2)","rt")
                             ,"Uniform"          =c("runif(n=100, min = 0, max = 1)","runif")
                             ,"Weibull"          =c("rweibull(n=100, shape=1, scale = 1)","rweibull"))

  sapply(names(distribution_names), function(x){RGtk2::gtkComboBoxAppendText(distribution_combo,x)})



  RGtk2::gtkBoxPackStart(distribution_box, RGtk2::gtkLabel(" Distribution: "),F,F, padding = 5)
  RGtk2::gtkBoxPackStart(distribution_box, distribution_combo)
  RGtk2::gtkComboBoxSetActive(distribution_combo,which( names(distribution_names) %in% "Normal")-1)

  RGtk2::gtkBoxPackStart(iterations_box, RGtk2::gtkLabel(" Number of sample means : "),F,F, padding = 5)
  iterations_entry <- RGtk2::gtkEntry()
  RGtk2::gtkEntrySetText(iterations_entry, "100")
  RGtk2::gtkBoxPackStart(iterations_box, iterations_entry)



  help_button <- RGtk2::gtkButton()
  RGtk2::gtkAdd(help_button, RGtk2::gtkImage(stock="gtk-info",size=2L))
  RGtk2::gtkBoxPackStart(distribution_box, help_button,F,F, padding = 5)
  RGtk2::gtkButtonSetRelief(help_button,'GTK_RELIEF_NONE')



  RGtk2::gtkBoxPackStart(sample_box, RGtk2::gtkLabel(" Sampling code : "),F,F, padding = 5)
  distribution_entry <- RGtk2::gtkEntry()
  RGtk2::gtkEntrySetText(distribution_entry, distribution_names[["Normal"]][1])
  RGtk2::gtkBoxPackStart(sample_box, distribution_entry)




  RGtk2::gSignalConnect(distribution_combo, "changed", function(...) {
    current_distribution <- RGtk2::gtkComboBoxGetActiveText(distribution_combo)
    RGtk2::gtkEntrySetText(distribution_entry, distribution_names[[current_distribution]][1])
    RGtk2::gtkButtonClicked(generate_button)
    return(T)
  })

  RGtk2::gSignalConnect(help_button, "clicked", function(...) {
    current_distribution <- RGtk2::gtkComboBoxGetActiveText(distribution_combo)
    rstudioapi::sendToConsole(paste0("?",distribution_names[[current_distribution]][2]), execute = TRUE)
    return(T)
  })

  RGtk2::gSignalConnect(generate_button, "clicked", function(...) {
    file_name <- tempfile(pattern = "file", tmpdir = tempdir(), fileext = ".png")
    allocation <- RGtk2::gtkWidgetGetAllocation(top_image)$allocation
    width_pic  <- max(400,min(allocation$width,allocation$height)-20)
    png(file_name,
        width = width_pic, height = width_pic)
    sampling_code <- RGtk2::gtkEntryGetText(distribution_entry)
    iterations <- as.numeric(RGtk2::gtkEntryGetText(iterations_entry))
    sampling_file <- tempfile(pattern = "file", tmpdir = tempdir(), fileext = ".png")
    sink(sampling_file)
    cat(paste("sample_means <- matrix(NA,nrow=",iterations,",ncol=1)\nfor(i in 1:",iterations,"){\nsample_means[i,1] <- mean(",sampling_code,")\n}"))
    sink()
    source(sampling_file, local = T)
    current_distribution <- RGtk2::gtkComboBoxGetActiveText(distribution_combo)
    hist(sample_means[,1,drop=T], xlab=distribution_names[[current_distribution]][2],
         main = paste0("Histogram of " , current_distribution," Sample Means"),
         sub=paste0("mean(",sampling_code,")"),
         border = "dark blue", col = "light blue",
         col.lab="dark blue",col.main="dark blue",col.sub="dark blue"
         , col.axis="dark blue")
    dev.off()
    RGtk2::gtkImageSetFromFile(top_image,file_name)
    return(T)
  })
  RGtk2::gtkButtonClicked(generate_button)
  RGtk2::gtkShow(ld_window)
  return(T)
}