#' 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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.