Filename in text box using tcltk in R - r

Using tcltk to create a GUI in R, I want to make a non-editable text box that displays the name of the save file that was selected by the user. I am able to create the button and the box, but I cannot figure out how to display the name of the selected file. I think I need to use tkinsert()
This is what I have so far:
library(tcltk)
library(tcltk2)
library(readxl)
test1 <- tktoplevel()
tkwm.title(test1, "Test 1")
tkgrid.rowconfigure(test1, 4)
tkgrid.columnconfigure(test1, 3)
getXlsx <- function() {
xlsheet <- tclvalue(tkgetOpenFile(
filetypes = "{ {Excel Files} {.xlsx} } { {All Files} * }"))
a <- read_excel(xlsheet)
assign("a", a, envir = .GlobalEnv)
}
test1$env$butSelect1 <- tk2button(test1, text = " Select File ", command
= getXlsx)
tkgrid(test1$env$butSelect1, padx = c(10,0), pady = 10, column = 0, row =
0)
test1$env$txt1 <- tk2text(test1, width = 40, height = 1)
tkgrid(test1$env$txt1, padx = c(10,10), pady = 10, column = 1, row = 0,
columnspan = 2)
tkconfigure(test1$env$txt1, state = "disabled")
### tkinsert(test1$env$txt1, ???) ###
Any help would be greatly appreciated, thank you.

I got it now, I had to add 4 lines to the function itself:
getXlsx <- function() {
xlsheet <- tclvalue(tkgetOpenFile(
filetypes = "{ {Excel Files} {.xlsx} } { {All Files} * }"))
a <- read_excel(xlsheet)
assign("a", a, envir = .GlobalEnv)
assign("z", xlsheet, envir = .GlobalEnv)
tkconfigure(test1$env$txt1, state = "normal")
tkinsert(test1$env$txt1, "end", z)
tkconfigure(test1$env$txt1, state = "disabled")
}
This creates a new "z" value in the global environment with the path name, then allows the text box to be editable, then adds the path name, then makes the text box non-editable again.

Related

How can I add a baseplot with no fixed values to a document

I want to add a baseplot to a word document.
In the documentation for the officer package there's an example that uses the plot_instr function:
anyplot <- plot_instr(code = {
barplot(1:5, col = 2:6)
})
doc <- read_docx()
doc <- body_add(doc, anyplot, width = 5, height = 4)
print(doc, target = tempfile(fileext = ".docx"))
I want to add a plot to a word document inside a function so I need variable input for the plot function like this:
x=1:5
cols=2:6
anyplot <- plot_instr(code = {
barplot(x,col=cols)
})
doc <- read_docx()
doc <- body_add(doc, anyplot, width = 5, height = 4)
print(doc, target = tempfile(fileext = ".docx"))
But the code above doesn't work and I can't find any other examples of plot_instr usage.
I think I found a solution!
When I set a breakpoint before the barplot(...) call, I could see the code when body_add is called with a plot_instr wrapper function. The code creates a temporary png file. I copied this code and adapted it:
x=1:5
cols=2:6
doc <- read_docx()
file <- tempfile(fileext = ".png")
options(bitmapType = "cairo")
png(filename = file, width = 5, height = 5, units = "in", res = 300)
tryCatch({
barplot(x,col=cols)
}, finally = {
dev.off()
})
on.exit(unlink(file))
value <- external_img(src = file, width = 5, height = 5)
body_add(doc, value)
print(doc, target = tempfile(fileext = ".docx"))
The code is generating the following error
Error in barplot.default(x, col = cols) :
'height' must be a vector or a matrix
The issue here is that function body_add has an argument x and you are defining an x before the call. Changing the name to something else solves the issue:
z <- 1:5
cols=2:6
anyplot <- plot_instr(code = {
barplot(z, col = cols)
})
doc <- read_docx()
doc <- body_add(doc, anyplot, width = 5, height = 4)
print(doc, target = "temp.docx")

Setting up TclArray in R

I am new to coding and I am trying to set up TclArray in R, so anytime users checks the checkbutton in GUI, TclArray will get input 0 or 1. The issues in my code occurs in value2, the code does not assign 1 or 0 each checkbutton. Also, once I value is assign, how do I assign it to other regular array?
Thanks,
library(tcltk)
base2 = tktoplevel()
tkwm.title(base2,'Process data Input')
headers <- c("Files","Tool1","Tool2","Tool3","Tool4")
file_name_GUI <- c("SYS1","SYS2","SYS3","SYS4") #More system can be added
parameters <- tclArray()
nfrm2 = tkframe(base2)
fontSub <- tkfont.create(family="times",size=11.0, weight="bold")
fontSub2 <- tkfont.create(family="times",size=11.0)
for (i in 0:length(file_name_GUI))
{
if(i == 0)
{
f2 = tkframe(nfrm2)
value = tklabel(f2,text=headers[1], font = fontSub, width = 20,bg="gray64", relief = 'raised')
tkgrid(value, row = i, column=0, padx =1, pady =1)
}else
{
f2 = tkframe(nfrm2)
value1 = tklabel(f2,text=file_name_GUI[i], font = fontSub2, width = 23)
tkgrid(value1,row=i,column=0, padx = 1, pady = 1)
}
for (j in 1:4)
{
if (i == 0){
value = tklabel(f2,text=headers[j+1], font = fontSub, width = 20,bg="gray64", relief = 'raised')
tkgrid(value,row=i,column=j,padx=1,padx=1)
}
else {
value2 = tkcheckbutton(f2, variable = .Tcl(paste("set parameters(", i, ",", j, ") 1", sep = "")), width = 23) #Issue is here, I can't assign value to each checkbox.
tkgrid(value2,row = i, column = j, padx = 1, pady =1)
}
}
tkpack(f2,side ='top')
}
tkpack(nfrm2)

Highlight/find data points in plotly scatter from the browser

I generated a scatterplot in HTML format using plotly and a generic dataframe. I am aware that it is possible to highlight (with a different color for example) certain data points before generating the plot HTML. However, I wonder if it is possible to add an element to the HTML file that would enable a user to find/highlight a certain data point based on its text label after the plot has been produced.
The code I used to produce the dataframe and scatter:
tab <- data.frame(sample.id = pca$sample.id,
EV1 = pca$eigenvect[, 1],
EV2 = pca$eigenvect[, 2],
stringsAsFactors=F)
p <- plot_ly(tab, x=tab$EV1, y=tab$EV2, text=tab$sample.id)
p <- layout(p, title="PCA", xaxis=list(title="PC 1"),
yaxis=list(title="PC 2"))
htmlwidgets::saveWidget(as.widget(p), paste(output_name, ".html", sep=""))
As far as I know there is not builtin functionality in Plotly but you just need a few lines of Javascript code to get the functionality.
Plotly stores the data in a application/json object in the HTML file. You can get the data via
var data = JSON.parse(document.querySelectorAll("script[type='application/json']")[0].innerHTML);
The text elements are stored in
data.x.data[i].text[j]
where i is the trace number and j is point number.
Now we need a text field and a button, we can use htmltools for that purpose
p <- htmlwidgets::appendContent(p, htmltools::tags$input(id='inputText', value='Merc', ''), htmltools::tags$button(id='buttonSearch', 'Search'))
Let's add a eventlister to the button which triggers a hover event of the first point of the first trace.
p <- htmlwidgets::appendContent(p, htmltools::tags$script(HTML(
'document.getElementById("buttonSearch").addEventListener("click", function()
{
var myDiv = document.getElementsByClassName("js-plotly-plot")[0]
Plotly.Fx.hover(myDiv, [{curveNumber: 0, pointNumber: 0}]);
}
)
')))
And the whole code which searches for through all text labels and triggers a hover event when the entered text is found in the label.
library(plotly)
library(htmlwidgets)
library(htmltools)
pcaCars <- princomp(mtcars, cor = TRUE)
carsHC <- hclust(dist(pcaCars$scores), method = "ward.D2")
carsDf <- data.frame(pcaCars$scores, "cluster" = factor(carsClusters))
carsClusters <- cutree(carsHC, k = 3)
carsDf <- transform(carsDf, cluster_name = paste("Cluster", carsClusters))
p <- plot_ly(carsDf, x = ~Comp.1 , y = ~Comp.2, text = rownames(carsDf),
mode = "markers", color = ~cluster_name, marker = list(size = 11), type = 'scatter', mode = 'markers')
p <- htmlwidgets::appendContent(p, htmltools::tags$input(id='inputText', value='Merc', ''), htmltools::tags$button(id='buttonSearch', 'Search'))
p <- htmlwidgets::appendContent(p, htmltools::tags$script(HTML(
'document.getElementById("buttonSearch").addEventListener("click", function()
{
var i = 0;
var j = 0;
var found = [];
var myDiv = document.getElementsByClassName("js-plotly-plot")[0]
var data = JSON.parse(document.querySelectorAll("script[type=\'application/json\']")[0].innerHTML);
for (i = 0 ;i < data.x.data.length; i += 1) {
for (j = 0; j < data.x.data[i].text.length; j += 1) {
if (data.x.data[i].text[j].indexOf(document.getElementById("inputText").value) !== -1) {
found.push({curveNumber: i, pointNumber: j});
}
}
}
Plotly.Fx.hover(myDiv, found);
}
);')))
htmlwidgets::saveWidget(p, paste('pca', ".html", sep=""))
p
The PCA implementation was modified from here.

r gWidgets How to get gcombobox value?

I'm new with making gui's and I need some help.
I have a gcombobox, and i want to know users choice after clicking on button Calculate
library(gWidgets)
city <- c("NY", "Tokyo", "Rome")
#main window
window <- gwindow(title = "stackoverflow",
visible=TRUE)
group <- ggroup(cont = window)
lay <- glayout(cont=group)
lay[1,1] <- "City:"
lay[1,2] <- gcombobox(city,
selected=0L,
cont=lay)
lay[2,2] <- gbutton(text = "Calculate",
border = TRUE,
cont = lay,
handler = function(h,...){
#here i want to know the users choice(NY, Tokyo, Rome).
#for example: if(combobox == "Rome") a = 5
})
Tnx in advance
Try to get value of lay[1,2]using svalue
for example
lay[2,2] <- gbutton(text = "Calculate",
border = TRUE,
cont = lay,
handler = function(h,...){
combobox=svalue(lay[1,2])
if(combobox == "Rome") {
a = 5} else {
a=0
}
print(paste(combobox , a))
})

Understanding 'gslider' function to make interactive plots

I am trying to create an interactive histogram in R whose bin width can be adjusted either by moving a slider or entering a value in the text box. In addition to this, I would also like to provide the user with an option of saving the plot for a particular bin width.
To this end, I found the 'gslider' function of 'aplpack' library to be a good starting point. I tried to modify it to meet my purpose as well as learn more about Tcl/Tk constructs. But I am now stuck and can't proceed, mostly because I haven't completely understood how a slider value is captured and transferred between functions.
Following are the snippets of code that I haven't really understood. These are from the source code of the 'gslider' function.
# What is the rationale behind using the 'assign' function here and at
# other instances in the code?
img <- tkrplot::tkrplot(gr.frame, newpl, vscale = 1, hscale = 1)
tkpack(img, side = "top")
assign("img", img, envir = slider.env)
# I understand the below lines when considered individually. But collectively,
# I am having a difficult time comprehending them. Most importantly, where
# exactly is the slider movement captured here?
sc <- tkscale(fr, from = sl.min, to = sl.max,
showvalue = TRUE, resolution = sl.delta, orient = "horiz")
assign("sc", sc, envir = slider.env)
eval(parse(text = "tkconfigure(sc, variable=inputbw1)"), envir = slider.env)
sl.fun <- sl.function
if (!is.function(sl.fun))
sl.fun <- eval(parse(text = paste("function(...){",
sl.fun, "}")))
fname <- 'tkrrsl.fun1'
eval(parse(text = c(paste(fname, " <-"), " function(...){",
"tkrreplot(get('img',envir=slider.env),fun=function()",
deparse(sl.fun)[-1], ")", "}")))
eval(parse(text = paste("environment(", fname, ")<-parent.env")))
if (prompt)
tkconfigure(sc, command = get(fname))
else tkbind(sc, "<ButtonRelease>", get(fname))
if (exists("tkrrsl.fun1")) {
get("tkrrsl.fun1")()
}
assign("slider.values.old", sl.default, envir = slider.env)
Thanks to everyone for the varied scope of answers. Juba's and Greg's answers were the ones I could work upon to write the following code:
slider_txtbox <- function (x, col=1, sl.delta, title)
{
## Validations
require(tkrplot)
pos.of.panel <- 'bottom'
if(is.numeric(col))
col <- names(x)[col]
x <- x[,col, drop=FALSE]
if (missing(x) || is.null(dim(x)))
return("Error: insufficient x values")
sl.min <- sl.delta # Smarter initialization required
sl.max <- max(x)
xrange <- (max(x)-min(x))
sl.default <- xrange/30
if (!exists("slider.env")) {
slider.env <<- new.env(parent = .GlobalEnv)
}
if (missing(title))
title <- "Adjust parameters"
## Creating initial dialogs
require(tcltk)
nt <- tktoplevel()
tkwm.title(nt, title)
if(.Platform$OS.type == 'windows')
tkwm.geometry(nt, "390x490+0+10")
else if(.Platform$OS.type == 'unix')
tkwm.geometry(nt, "480x600+0+10")
assign("tktop.slider", nt, envir = slider.env)
"relax"
nt.bak <- nt
sl.frame <- tkframe(nt)
gr.frame <- tkframe(nt)
tx.frame <- tkframe(nt)
tkpack(sl.frame, tx.frame, gr.frame, side = pos.of.panel)
## Function to create and refresh the plot
library(ggplot2)
library(gridExtra)
makeplot <- function(bwidth, save) {
if(bwidth <= 0) {
df <- data.frame('x'=1:10, 'y'=1:10)
histplot <- ggplot(df, aes(x=x, y=y)) + geom_point(size=0) + xlim(0, 10) + ylim(0, 100) +
geom_text(aes(label='Invalid binwidth...', x=5, y=50), size=9)
} else {
histplot <- ggplot(data=x, aes_string(x=col)) +
geom_histogram(binwidth=bwidth, aes(y = ..density..), fill='skyblue') +
theme(axis.title.x=element_text(size=15), axis.title.y=element_text(size=15),
axis.text.x=element_text(size=10, colour='black'),
axis.text.y=element_text(size=10, colour='black'))
}
print(histplot)
if(save){
filename <- tkgetSaveFile(initialfile=paste('hist_bw_', bwidth, sep=''),
filetypes='{{PNG files} {.png}} {{JPEG files} {.jpg .jpeg}}
{{PDF file} {.pdf}} {{Postscript file} {.ps}}')
filepath <- as.character(filename)
splitpath <- strsplit(filepath, '/')[[1]]
flname <- splitpath[length(splitpath)]
pieces <- strsplit(flname, "\\.")[[1]]
ext <- tolower(pieces[length(pieces)])
if(ext != 'png' && ext != 'jpeg' && ext != 'jpg' && ext != 'pdf' && ext != 'ps') {
ext <- 'png'
filepath <- paste(filepath, '.png', sep='')
filename <- tclVar(filepath)
}
if(ext == 'ps')
ext <- 'postscript'
eval(parse(text=paste(ext, '(file=filepath)', sep='')))
eval(parse(text='print(histplot)'))
dev.off()
}
}
img <- tkrplot::tkrplot(gr.frame, makeplot(sl.default, FALSE), vscale = 1, hscale = 1)
tkpack(img, side = "top")
assign("img", img, envir = slider.env)
## Creating slider, textbox and labels
parent.env <- sys.frame(sys.nframe() - 1)
tkpack(fr <- tkframe(sl.frame), side = 'top')
sc <- tkscale(fr, from = sl.min, to = sl.max,
showvalue = TRUE, resolution = sl.delta,
orient = "horiz")
tb <- tkentry(fr, width=4)
labspace <- tklabel(fr, text='\t\t\t')
tkpack(sc, labspace, tb, side = 'left')
tkpack(textinfo <- tkframe(tx.frame), side = 'top')
lab <- tklabel(textinfo, text = ' Move slider', width = "20")
orlabel <- tklabel(textinfo, text=' OR', width='10')
txtboxmsg <- tklabel(textinfo, text = 'Enter binwidth', width='20')
tkpack(txtboxmsg, orlabel, lab, side='right')
tkpack(f.but <- tkframe(sl.frame))
tkpack(tklabel(f.but, text=''))
tkpack(tkbutton(f.but, text = "Exit", command = function() tkdestroy(nt)),
side='right')
tkpack(tkbutton(f.but, text = "Save", command = function(...) {
bwidth <- as.numeric(tclvalue(get('inputtb', envir=slider.env)))
tkrreplot(get('img',envir=slider.env),fun=function() { makeplot(bwidth, TRUE); sync_slider()})
}), side='right')
## Creating objects and variables associated with slider and textbox
assign("sc", sc, envir = slider.env)
eval(parse(text = "assign('inputsc', tclVar(sl.default), envir=slider.env)"))
eval(parse(text = "tkconfigure(sc, variable=inputsc)"), envir = slider.env)
assign("tb", tb, envir = slider.env)
eval(parse(text = "assign('inputtb', as.character(tclVar(sl.default)),
envir=slider.env)"))
eval(parse(text = "tkconfigure(tb, textvariable=inputtb)"), envir = slider.env)
## Function to update the textbox value when the slider has changed
sync_textbox <- function() {
bwidth_sl <- tclvalue(get('inputsc', envir=slider.env))
assign('inputtb', tclVar(bwidth_sl), envir=slider.env)
eval(parse(text = "tkconfigure(tb, textvariable=inputtb)"), envir = slider.env)
}
## Function to update the slider value when the textbox has changed
sync_slider <- function() {
bwidth_tb <- tclvalue(get('inputtb', envir=slider.env))
assign('inputsc', tclVar(bwidth_tb), envir=slider.env)
eval(parse(text = "tkconfigure(sc, variable=inputsc)"), envir = slider.env)
}
## Bindings : association of certain functions to certain events for the slider
## and the textbox
tkbind(sc, "<ButtonRelease>", function(...) {
bwidth <- as.numeric(tclvalue(get('inputsc', envir=slider.env)))
tkrreplot(get('img',envir=slider.env),fun=function() { makeplot(bwidth, FALSE); sync_textbox()})
})
tkbind(tb, "<Return>", function(...) {
bwidth <- as.numeric(tclvalue(get('inputtb', envir=slider.env)))
if(bwidth > sl.max && !is.na(bwidth)) {
bwidth <- sl.max
assign('inputtb', tclVar(bwidth), envir=slider.env)
eval(parse(text = "tkconfigure(tb, textvariable=inputtb)"), envir = slider.env)
} else
if(bwidth < sl.min || is.na(bwidth)) {
bwidth <- sl.min
assign('inputtb', tclVar(bwidth), envir=slider.env)
eval(parse(text = "tkconfigure(tb, textvariable=inputtb)"), envir = slider.env)
}
tkrreplot(get('img',envir=slider.env),fun=function() { makeplot(bwidth, FALSE); sync_slider()})
})
}
library(ggplot2)
slider_txtbox(movies, 'rating', 0.1, 'Adjust binwidth')
Here is a minimal working example with comments, based on the complete code you first submit. As I'm far from an expert in tcl/tk, there may be cleaner or better ways to do it. And it is quite incomplete (for example the textbox values should be checked to be in the range of the slider, etc.) :
library(ggplot2)
library(gridExtra)
title <- "Default title"
data(movies)
## Init dialog
require(tkrplot)
if (!exists("slider.env")) slider.env <<- new.env(parent = .GlobalEnv)
require(tcltk)
nt <- tktoplevel()
tkwm.title(nt, title)
tkwm.geometry(nt, "480x600+0+10")
assign("tktop.slider", nt, envir = slider.env)
"relax"
nt.bak <- nt
sl.frame <- tkframe(nt)
gr.frame <- tkframe(nt)
tx.frame <- tkframe(nt)
tkpack(sl.frame, tx.frame, gr.frame, side = "bottom")
## First default plot
newpl <- function(...) {
dummydf <- data.frame('x'=1:10, 'y'=1:10)
dummy <- ggplot(dummydf, aes(x=x, y=y)) + geom_point(size=0) + xlim(0, 10) + ylim(0, 100) +
geom_text(aes(label='Generating plot...', x=5, y=50), size=9)
print(dummy)
}
img <- tkrplot::tkrplot(gr.frame, newpl, vscale = 1, hscale = 1)
tkpack(img, side = "top")
assign("img", img, envir = slider.env)
tkpack(fr <- tkframe(sl.frame), side = 'top')
## Creating slider, textbox and labels
sc <- tkscale(fr, from = 0, to = 5, showvalue = TRUE, resolution = 0.1, orient = "horiz")
tb <- tkentry(fr, width=4)
lab <- tklabel(fr, text = 'Select binwidth ', width = "16")
orlabel <- tklabel(fr, text=' or ', width='4')
tkpack(lab, sc, orlabel, tb, side = 'left')
tkpack(textinfo <- tkframe(tx.frame), side = 'top')
## Creating objects and variables associated with slider and textbox
assign("sc", sc, envir = slider.env)
assign("tb", tb, envir = slider.env)
assign('inputsc', tclVar(2.5), envir=slider.env)
assign('inputtb', tclVar('2.5'), envir=slider.env)
eval(parse(text = "tkconfigure(sc, variable=inputsc)"), envir = slider.env)
eval(parse(text = "tkconfigure(tb, textvariable=inputtb)"), envir = slider.env)
## Function to update the textbox value when the slider has changed
sync_textbox <- function() {
bwidth_sl <- tclvalue(get('inputsc', envir=slider.env))
assign('inputtb', tclVar(bwidth_sl), envir=slider.env)
eval(parse(text = "tkconfigure(tb, textvariable=inputtb)"), envir = slider.env)
}
## Function to update the slider value when the textbox has changed
sync_slider <- function() {
bwidth_tb <- tclvalue(get('inputtb', envir=slider.env))
assign('inputsc', tclVar(bwidth_tb), envir=slider.env)
eval(parse(text = "tkconfigure(sc, variable=inputsc)"), envir = slider.env)
}
## Function to refresh the plot
refresh <- function(bwidth) {
histplot <- ggplot(data=movies, aes_string(x="rating")) +
geom_histogram(binwidth=bwidth,
aes(y = ..density..), fill='skyblue') +
theme(axis.title.x=element_text(size=15), axis.title.y=element_text(size=15),
axis.text.x=element_text(size=10, colour='black'),
axis.text.y=element_text(size=10, colour='black'))
print(histplot)
}
## Bindings : association of certain functions to certain events for the slider
## and the textbox
tkbind(sc, "<ButtonRelease>", function(...) {
bwidth <- as.numeric(tclvalue(get('inputsc', envir=slider.env)))
tkrreplot(get('img',envir=slider.env),fun=function() { refresh(bwidth); sync_textbox()})
})
tkbind(tb, "<Return>", function(...) {
bwidth <- as.numeric(tclvalue(get('inputtb', envir=slider.env)))
tkrreplot(get('img',envir=slider.env),fun=function() { refresh(bwidth); sync_slider()})
})
If you do not insist on a local solution, you might give rapporter.net a try, which lets you specify such tasks easily with any number of tweakable sliders. Okay, enough of marketing :)
Here goes a quick demo: Interactive histogram on mtcars which looks like:
There you could choose one of the well-know variables of mtcars, but of course you could provide any data frame to be used here or tweak the above form after a free registration.
How it's done? I have just created a quick rapport template and let it rapplicate. The body of the template is written in brew-style (please see the above "rapport" URL for more details):
<%=
evalsOptions('width', width)
evalsOptions('height', height)
%>
# Histogram
<%=
set.caption(paste('Histogram of', var.name))
hist(var, breaks=seq(min(var), max(var), diff(range(var))/round(binwidth)), main = paste('Histogram of', var.name), xlab = '')
%>
## Parameters
Provided parameters were:
* variable: <%=var.name%> (<%=var.label%>)
* bin-width of histogram: <%=binwidth%>
* height of generated images: <%=height%>
* width of generated images: <%=width%>
# Kernel density plot
<%=
set.caption('A kernel density plot')
plot(density(var), main = '', xlab = '')
%>
But a bare-minimal example of the task could be also addressed by a simple one-liner template:
<%=hist(var, breaks=seq(min(var), max(var), diff(range(var))/round(binwidth)))%>
There you would only need to create a new template, add two input types with a click (one numeric variable of any data set and a number input field which would hold the binwidth of the histogram), and you are ready to go.
You might want to look at the R package 'rpanel' -- it uses tcltk under the hood but is much simpler to use:
rpanel
rpanel reference
I don't know the gslider function and cannot help you there, but here are some alternatives:
One simple option is to use the tkexamp function from the TeachingDemos package, here is one way:
library(TeachingDemos)
myhist <- function(x, s.width, e.width, ...) {
if( missing(e.width) || is.null(e.width) || is.na(e.width) ) {
e.width<- s.width
}
b <- seq( min(x)-e.width/2, max(x)+e.width, by=e.width )
hist(x, b, ...)
}
mylist <- list( s.width=list('slider', init=1, from=1, to=10, resolution=1),
e.width=list('numentry', init='', width=7)
)
sampdata <- rnorm(100, 50, 5)
tkexamp(myhist(sampdata), mylist)
This will create a quick GUI with your histogram and a slider and entry widget. The width of the bars are determined by the value in the entry widget, and if that is blank (default) then the value of the slider. Unfortunately the slider and entry widget do not update each other. There is a button that will print out the current call, so the same plot can be recreated from the command line in the default or current plotting device. You can edit the mylist variable above to make the controls fit your data better.
If you want the entry and slider to update each other then you can program that more directly. Here is a basic function that uses tkrplot:
mytkhist <- function(x, ...) {
width <- tclVar()
tclvalue(width) <- 1
replot <- function(...) {
width <- as.numeric(tclvalue(width))
b <- seq( min(x) - width/2, max(x)+width, by=width )
hist(x,b,...)
}
tt <- tktoplevel()
img <- tkrplot(tt, replot)
tkpack(img, side='top')
tkpack( tkscale(tt, variable=width, from=1, to=10,
command=function(...) tkrreplot(img),
orient='horizontal'), side='top' )
tkpack( e <- tkentry(tt, textvariable=width), side='top' )
tkbind(e, "<KeyRelease>", function(...) tkrreplot(img))
}
mytkhist(sampdata)
The fact that both the slider (scale) and the entry widget use the same variable is what makes them automatically update each other (no calls to assign needed). The command argument in tkscale and the tkbind call mean that any changes to either the slider or the entry will update the plot. This does not have anything to save the current plot, but you should be able to add that part as well as any other controls that you want to use.

Resources