R/density_estimation_gui.r

#' Density Estimation Gui
#'
#' Tool to help build understanding about desity estimation.
#'
#' @return True if it successfully builds.
#' @author Trevor Olsen
#' @export
#'
#' @examples
#' ### density_estimation_gui()
#'

density_estimation_gui <- function(){
  ld_window <- RGtk2::gtkWindow(show=F)
  RGtk2::gtkWindowSetTitle(ld_window,"Density Estimation 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()
  kernel_box <- RGtk2::gtkHBox()
  bw_box <- RGtk2::gtkHBox()
  generate_button <- RGtk2::gtkButton("Generate Plot")
  RGtk2::gtkBoxPackStart(main_box, distribution_box,F,F, padding = 5)
  RGtk2::gtkBoxPackStart(main_box, kernel_box,F,F, padding = 5)
  RGtk2::gtkBoxPackStart(main_box, bw_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)

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


  distribution_combo <- RGtk2::gtkComboBoxNewText()

  distribution_names <- list("Beta"             =c("rbeta(n=100, shape1=0.5, shape2=0.5, ncp = 0)","dbeta")
                             ,"Binomial"         =c("rbinom(n=100, size=100, prob=.5)","dbinom")
                             ,"Cauchy"           =c("rcauchy(n=100, location = 0, scale = 1)","dcauchy")
                             ,"Chi-Square"       =c("rchisq(n=100, df=10, ncp = 0)","dchisq")
                             ,"Exponential"      =c("rexp(n=100, rate = 1)","dexp")
                             ,"F"                =c("rf(n=100, df1=10, df2=10)","df")
                             ,"Gamma"            =c("rgamma(n=100, shape=2, rate = 1, scale = 1)","dgamma")
                             ,"Geometric"        =c("rgeom(n=100, prob=.5)","dgeom")
                             ,"Hypergeometric"   =c("rhyper(nn=100, m=10, n=10, k=5)","dhyper")
                             ,"Logistic"         =c("rlogis(n=100, location = 0, scale = 1)","dlogis")
                             ,"Log Normal"       =c("rlnorm(n=100, meanlog = 0, sdlog = 1)","dlnorm")
                             ,"Negative Binomial"=c("rnbinom(n=100, size=1, prob=.5)","dnbinom")
                             ,"Normal"           =c("rnorm(n=100, mean = 0, sd = 1)","dnorm")
                             ,"Poisson"          =c("rpois(n=100, lambda=1)","dpois")
                             ,"Student t"        =c("rt(n=100, df=2)","dt")
                             ,"Uniform"          =c("runif(n=100, min = 0, max = 1)","dunif")
                             ,"Weibull"          =c("rweibull(n=100, shape=1, scale = 1)","dweibull"))
  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)

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


  kernel_combo <- RGtk2::gtkComboBoxNewText()

  kernel_names <- c("gaussian", "rectangular", "triangular", "epanechnikov", "biweight", "cosine" , "optcosine")

  sapply(kernel_names, function(x){RGtk2::gtkComboBoxAppendText(kernel_combo,x)})

  RGtk2::gtkBoxPackStart(kernel_box, RGtk2::gtkLabel(" Kernel: "),F,F, padding = 5)
  RGtk2::gtkBoxPackStart(kernel_box, kernel_combo)
  RGtk2::gtkComboBoxSetActive(kernel_combo,0)



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

  bw_combo <- RGtk2::gtkComboBoxNewText()

  bw_names <- c("nrd0", "nrd", "ucv", "bcv", "SJ")

  sapply(bw_names, function(x){RGtk2::gtkComboBoxAppendText(bw_combo,x)})

  RGtk2::gtkBoxPackStart(bw_box, RGtk2::gtkLabel(" bw: "),F,F, padding = 5)
  RGtk2::gtkBoxPackStart(bw_box, bw_combo)
  RGtk2::gtkComboBoxSetActive(bw_combo,0)




  RGtk2::gtkBoxPackStart(bw_box, RGtk2::gtkLabel(" adjust : "),F,F, padding = 5)
  adjust_entry <- RGtk2::gtkEntry()
  RGtk2::gtkEntrySetText(adjust_entry, "1")
  RGtk2::gtkBoxPackStart(bw_box, adjust_entry)






  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(kernel_combo, "changed", function(...) {
    RGtk2::gtkButtonClicked(generate_button)
    return(T)
  })

  RGtk2::gSignalConnect(bw_combo, "changed", function(...) {
    RGtk2::gtkButtonClicked(generate_button)
    return(T)
  })

  RGtk2::gSignalConnect(help_button1, "clicked", function(...) {

    rstudioapi::sendToConsole("?bw.nrd", execute = TRUE)
    return(T)
  })

  RGtk2::gSignalConnect(help_button2, "clicked", function(...) {

    rstudioapi::sendToConsole("?density", execute = TRUE)
    return(T)
  })


  RGtk2::gSignalConnect(help_button3, "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)
    sampling_file <- tempfile(pattern = "file", tmpdir = tempdir(), fileext = ".png")
    sink(sampling_file)
    cat(paste("x <- ",sampling_code))
    cat(paste("\ny <- seq(min(x)-10,max(x)+10,length.out=1000)"))
    current_distribution <- RGtk2::gtkComboBoxGetActiveText(distribution_combo)
    dname <- gsub("^r", "d", sampling_code)
    replaced_code <- gsub("\\(n=\\d+,","\\(y,",dname)

    cat(paste("\nz <- ", replaced_code))
    sink()
    source(sampling_file, local = T)

    my_density <- density(x, bw = RGtk2::gtkComboBoxGetActiveText(bw_combo),
                          adjust = as.numeric(RGtk2::gtkEntryGetText(adjust_entry)),
                          kernel=RGtk2::gtkComboBoxGetActiveText(kernel_combo))
    my_max <- max(z,my_density$y)

    plot(my_density ,xlab=distribution_names[[current_distribution]][2],
         ylab="f_hat",
         main = paste("Density of" , current_distribution),
         sub=sampling_code, ylim=c(0,my_max))

    lines(y,z,col='red')
    dev.off()
    RGtk2::gtkImageSetFromFile(top_image,file_name)
    return(T)
  })
  RGtk2::gtkButtonClicked(generate_button)
  RGtk2::gtkShow(ld_window)
  return(T)
}
ArithmeticR/TOmisc documentation built on May 14, 2019, 12:43 p.m.