slider                 package:relax                 R Documentation

_s_l_i_d_e_r / _b_u_t_t_o_n _c_o_n_t_r_o_l _w_i_d_g_e_t_s

_D_e_s_c_r_i_p_t_i_o_n:

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

_U_s_a_g_e:

     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)

_A_r_g_u_m_e_n_t_s:

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

_D_e_t_a_i_l_s:

     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.

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

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

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

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

_V_a_r_i_a_b_l_e_s ... 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'.

_V_a_l_u_e:

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

_A_u_t_h_o_r(_s):

     Hans Peter Wolf

_E_x_a_m_p_l_e_s:

     # 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)
     }

