slider {relax} | R Documentation

## slider / button control widgets

### Description

`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.

### Usage

    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)

### Arguments

`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

### Details

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.

Definition
  ... of sliders: First of all you have to define sliders, buttons and the attributes of them. Sliders are established by six arguments: `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.
Definition
  ... of buttons: Buttons are defined by a vector of labels `but.names` and a list of functions: `but.functions`. If button `i` is pressed the function stored in `but.functions[[i]]` is called.
Requesting
  ... a slider: `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.
Setting
  ... a slider: `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.
Variables
  ... of the environment `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`.

### Value

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`.

### Author(s)

Hans Peter Wolf

### Examples

    # 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=2); 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)
    }

[Package relax version 1.01 Index]