Instantly share code, notes, and snippets.

Embed
What would you like to do?
.slider.env = new.env()
.sliderMenu <- function(refresh.code, names, minima, maxima, resolutions,
starts, title = "Slider", no = 0, set.no.value = 0) {
# Requirement:
if (!require(tcltk, quietly = TRUE))
stop("\n -- Package tcltk not available -- \n\n")
# Environment:
if (!exists(".slider.env"))
.slider.env <<- new.env()
if (no != 0) {
options(show.error.messages = FALSE)
ans <- as.numeric(tclvalue(get(paste("slider", no, sep = ""),
env = .slider.env)))
options(show.error.messages = TRUE)
return(ans)
}
if (set.no.value[1] != 0) {
try(eval(parse(text = paste("tclvalue(slider", set.no.value[1],
") <- ", set.no.value[2], sep = "")), env = .slider.env),
silent = TRUE)
return(set.no.value[2])
}
# Toplevel:
nt <- tktoplevel()
tkwm.title(nt, title)
# Slider:
for (i in seq(names)) {
eval(parse(text = paste("assign(\"slider", i, "\",
tclVar(starts[i]), env = .slider.env)", sep = "")))
tkpack(fr <- tkframe(nt), anchor = "sw")
lab <- tklabel(fr, text = names[i], anchor = "sw")
sc <- tkscale(fr, command = refresh.code, from = minima[i],
to = maxima[i], showvalue = TRUE, resolution =
resolutions[i], orient = "horiz")
assign("sc", sc, env = .slider.env)
tkgrid(sc, lab)
eval(parse(text = paste("tkconfigure(sc, variable = slider", i, ")",
sep = "")), env = .slider.env)
}
tkpack(fr <- tkframe(nt), anchor = "sw")
# Quit:
quitButton <- tkbutton(fr, text = " Quit ",
command <- function() {
tkdestroy(nt)
})
# Reset:
resetButton <- tkbutton(fr, text = " Start | Reset ",
command <- function() {
for (i in seq(starts)) eval(parse(text =
paste("tclvalue(slider", i, ")<-", starts[i], sep = "")),
env = .slider.env)
refresh.code()
})
# Compose:
tkgrid(resetButton, quitButton, sticky = "sew")
}
ghypSlider <- function() {
refresh.code <- function(...) {
# Sliders:
N <- .sliderMenu(no = 1)
mu <- .sliderMenu(no = 2)
delta <- .sliderMenu(no = 3)
alpha <- .sliderMenu(no = 4)
beta <- .sliderMenu(no = 5)
lambda <- .sliderMenu(no = 6)
param <- c(mu, delta, alpha, beta, lambda)
# Plot Data:
xmin <- round(qghyp(0.01, param = param), digits = 2)
xmax <- round(qghyp(0.99, param = param), digits = 2)
x <- seq(xmin, xmax, length = N)
y <- dghyp(x, param = param)
main <- paste("GHyp Density\n",
"mu = ", as.character(mu), " | ",
"delta = ", as.character(delta), " | ",
"alpha = ", as.character(alpha), " | ",
"beta = ", as.character(beta), " | ",
"lambda = ", as.character(lambda))
# Density:
plot(x, y, type = "l", xlim = c(xmin, xmax), col = "steelblue")
abline(h = 0, lty = 3)
title(main = main)
}
# Open Slider Menu:
.sliderMenu(refresh.code,
names = c( "N", "mu", "delta", "alpha", "beta", "lambda"),
minima = c( 50, -5.0, -0.0, 0.0, -2.0, -2.0),
maxima = c(1000, 5.0, 10.0, 2.0, 2.0, 2.0),
resolutions = c( 50, 1.0, 1.0, 0.2, 0.2, 0.5),
starts = c( 50, 0.0, 1.0, 1.0, 0.0, 1.0))
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment