| slider {TeachingDemos} | R Documentation |
slider constructs a Tcl/Tk-widget with sliders and buttons
automated calculation and plotting. For example slider allows complete
all axes rotation of objects in a plot.
slider(sl.functions, sl.names, sl.mins, sl.maxs, sl.deltas, sl.defaults, but.functions, but.names, no, set.no.value, obj.name, obj.value, reset.function, title)
sl.functions |
set of functions or function connected to the slider(s) |
sl.names |
labels of the sliders |
sl.mins |
minimum values of the sliders' ranges |
sl.maxs |
maximum values of the sliders' ranges |
sl.deltas |
change of step per click |
sl.defaults |
default values for the sliders |
but.functions |
function or list of functions that are assigned to the button(s) |
but.names |
labels of the buttons |
no |
slider(no=i) requests slider i |
set.no.value |
slider(set.no.value=c(i,val)) sets slider i to value val |
obj.name |
slider(obj.name=name) requests the value of
variable name from environment slider.env |
obj.value |
slider(obj.name=name,obj.value=value) assigns value
to variable name in environment slider.env |
reset.function |
function that comprises the commands of the
reset.button |
title |
title of the control window |
With slider you can:
a) define (multiple) sliders and buttons,
b) request or set slider values, and
c) request or set variables in the environment slider.env.
Slider function management takes place in the
environment slider.env. If slider.env
is not found it is generated.
sl.functions, sl.names, sl.minima, sl.maxima,sl.deltas, and sl.defaults.
The first argument,
sl.functions, is either a list of functions or a single function that
entails the commands for the sliders.
If there are three sliders and slider 2 is moved with the mouse the function stored in
sl.functions[[2]] (or in case of one function for all sliders the function sl.functions)
is called.but.names and a list of functions:
but.functions. If button i is pressed the function stored in but.functions[[i]] is called.slider(no=1) returns the actual value of slider 1,
slider(no=2) returns the value of slider 2, etc.
You are allowed to include expressions of the type
slider(no=i) in functions describing the effect of
sliders or buttons.slider(set.no.value=c(2,333)) sets slider 2 to value 333.
slider(set.no.value=c(i,value)) can be included in the functions
defining the effects of moving sliders or pushing buttons.slider.env: Sometimes information
has to be trransferred back and forth between functions defining the effects of sliders and buttons.
Imagine for example two sliders: one to control p and another one to control q,
but they should satisfy: p+q=1. Consequently, you have to correct the value of the first slider
after the second one was moved. To prevent the creation of global
variables store them in the environment slider.env.
Use slider(obj.name="p.save",obj.value=1-slider(no=2))
to assign value 1-slider(no=2) to the variable p.save .
slider(obj.name=p.save) returns the value of variable p.save.
Using slider in definition mode slider returns the value of new created the top level widget.
slider(no=i) returns the actual value of slider i.
slider(obj.name=name) returns the value of variable name in environment slider.env.
You can move the slider in 3 different ways: You can left click and drag the slider itself, you can left click in the trough to either side of the slider and the slider will move 1 unit in the direction you clicked, or you can right click in the trough and the slider will jump to the location you clicked at.
Hans Peter Wolf
# example 1, sliders only
## Not run:
## This example cannot be run by examples() but should work in an interactive R session
plot.sample.norm<-function(){
refresh.code<-function(...){
mu<-slider(no=1); sd<-slider(no=1); n<-slider(no=3)
x<-rnorm(n,mu,sd)
plot(x)
}
slider(refresh.code,sl.names=c("value of mu","value of sd","n number of observations"),
sl.mins=c(-10,.01,5),sl.maxs=c(+10,50,100),sl.deltas=c(.01,.01,1),sl.defaults=c(0,1,20))
}
plot.sample.norm()
## End(Not run)
# example 2, sliders and buttons
## Not run:
## This example cannot be run by examples() but should work in an interactive R session
plot.sample.norm.2<-function(){
refresh.code<-function(...){
mu<-slider(no=1); sd<-slider(no=2); n<-slider(no=3)
type= slider(obj.name="type")
x<-rnorm(n,mu,sd)
plot(seq(x),x,ylim=c(-20,20),type=type)
}
slider(refresh.code,sl.names=c("value of mu","value of sd","n number of observations"),
sl.mins=c(-10,.01,5),sl.maxs=c(10,10,100),sl.deltas=c(.01,.01,1),sl.defaults=c(0,1,20),
but.functions=list(
function(...){slider(obj.name="type",obj.value="l");refresh.code()},
function(...){slider(obj.name="type",obj.value="p");refresh.code()},
function(...){slider(obj.name="type",obj.value="b");refresh.code()}
),
but.names=c("lines","points","both"))
slider(obj.name="type",obj.value="l")
}
plot.sample.norm.2()
## End(Not run)
# example 3, dependent sliders
## Not run:
## This example cannot be run by examples() but should work in an interactive R session
print.of.p.and.q<-function(){
refresh.code<-function(...){
p.old<-slider(obj.name="p.old")
p<-slider(no=1); if(abs(p-p.old)>0.001) {slider(set.no.value=c(2,1-p))}
q<-slider(no=2); if(abs(q-(1-p))>0.001) {slider(set.no.value=c(1,1-q))}
slider(obj.name="p.old",obj.value=p)
cat("p=",p,"q=",1-p,"\n")
}
slider(refresh.code,sl.names=c("value of p","value of q"),
sl.mins=c(0,0),sl.maxs=c(1,1),sl.deltas=c(.01,.01),sl.defaults=c(.2,.8))
slider(obj.name="p.old",obj.value=slider(no=1))
}
print.of.p.and.q()
## End(Not run)
# example 4, rotating a surface
## Not run:
## This example cannot be run by examples() but should work in an interactive R session
R.veil.in.the.wind<-function(){
# Mark Hempelmann / Peter Wolf
par(bg="blue4", col="white", col.main="white",
col.sub="white", font.sub=2, fg="white") # set colors and fonts
samp <- function(N,D) N*(1/4+D)/(1/4+D*N)
z<-outer(seq(1, 800, by=10), seq(.0025, 0.2, .0025)^2/1.96^2, samp) # create 3d matrix
h<-100
z[10:70,20:25]<-z[10:70,20:25]+h; z[65:70,26:45]<-z[65:70,26:45]+h
z[64:45,43:48]<-z[64:45,43:48]+h; z[44:39,26:45]<-z[44:39,26:45]+h
x<-26:59; y<-11:38; zz<-outer(x,y,"+"); zz<-zz*(65<zz)*(zz<73)
cz<-10+col(zz)[zz>0];rz<-25+row(zz)[zz>0]; z[cbind(cz,rz)]<-z[cbind(cz,rz)]+h
refresh.code<-function(...){
theta<-slider(no=1); phi<-slider(no=2)
persp(x=seq(1,800,by=10),y=seq(.0025,0.2,.0025),z=z,theta=theta,phi=phi,
scale=T, shade=.9, box=F, ltheta = 45,
lphi = 45, col="aquamarine", border="NA",ticktype="detailed")
}
slider(refresh.code, c("theta", "phi"), c(0, 0),c(360, 360),c(.2, .2),c(85, 270) )
}
R.veil.in.the.wind()
## End(Not run)
## The function is currently defined as
function(sl.functions,sl.names,sl.mins,sl.maxs,sl.deltas,sl.defaults,
but.functions,but.names,
no,set.no.value,obj.name,obj.value,
reset.function,title){
# slider, version2, pw 040107
if(!missing(no)) return(as.numeric(tclvalue(get(paste("slider",no,sep=""),env=slider.env))))
if(!missing(set.no.value)){ try(eval(parse(text=paste("tclvalue(slider",set.no.value[1],")<-",
set.no.value[2],sep="")),env=slider.env)); return(set.no.value[2]) }
if(!exists("slider.env")) slider.env<<-new.env()
if(!missing(obj.name)){
if(!missing(obj.value)) assign(obj.name,obj.value,env=slider.env) else
obj.value<-get(obj.name,env=slider.env)
return(obj.value)
}
if(missing(title)) title<-"slider control widget"
require(tcltk); nt<-tktoplevel(); tkwm.title(nt,title); tkwm.geometry(nt,"+0+0")
if(missing(sl.names)) sl.names<-NULL
if(missing(sl.functions)) sl.functions<-function(...){}
for(i in seq(sl.names)){
eval(parse(text=paste("assign('slider",i,"',tclVar(sl.defaults[i]),env=slider.env)",sep="")))
tkpack(fr<-tkframe(nt)); lab<-tklabel(fr, text=sl.names[i], width="25")
sc<-tkscale(fr,from=sl.mins[i],to=sl.maxs[i],showvalue=T,resolution=sl.deltas[i],orient="horiz")
tkpack(lab,sc,side="right"); assign("sc",sc,env=slider.env)
eval(parse(text=paste("tkconfigure(sc,variable=slider",i,")",sep="")),env=slider.env)
sl.fun<-if(length(sl.functions)>1) sl.functions[[i]] else sl.functions
if(!is.function(sl.fun)) sl.fun<-eval(parse(text=paste("function(...){",sl.fun,"}")))
tkconfigure(sc,command=sl.fun)
}
assign("slider.values.old",sl.defaults,env=slider.env)
tkpack(f.but<-tkframe(nt),fill="x")
tkpack(tkbutton(f.but, text="Exit", command=function()tkdestroy(nt)),side="right")
if(missing(reset.function)) reset.function<-function(...) print("relax")
if(!is.function(reset.function))
reset.function<-eval(parse(text=paste("function(...){",reset.function,"}")))
tkpack(tkbutton(f.but, text="Reset", command=function(){
for(i in seq(sl.names))
eval(parse(text=paste("tclvalue(slider",i,")<-",sl.defaults[i],sep="")),env=slider.env)
reset.function() } ),side="right")
if(missing(but.names)) but.names<-NULL
for(i in seq(but.names)){
but.fun<-if(length(but.functions)>1) but.functions[[i]] else but.functions
if(!is.function(but.fun))but.fun<-
eval(parse(text=paste("function(...){",but.fun,"}")))
tkpack(tkbutton(f.but, text=but.names[i], command=but.fun),side="left")
cat("button",i,"eingerichtet")
}
invisible(nt)
}