#########################
# R-Code for function slider  #
#########################
slider<-function(refresh.code,names,minima,maxima,resolutions,starts,title="control",no=0,
   set.no.value=0){
   if(no!=0) return(as.numeric(tclvalue(get(paste("slider",no,sep=""),env=slider.env))))
   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)); return(set.no.value[2]) }
   if(!exists("slider.env")) slider.env<<-new.env()
   library(tcltk); nt<-tktoplevel(); tkwm.title(nt,title); tkwm.geometry(nt,"+0+0")
   for(i in seq(names))
      eval(parse(text=paste("assign(\"slider",i,"\",tclVar(starts[i]),env=slider.env)",sep="")))
   for(i in seq(names)){
      tkpack(fr<-tkframe(nt));  lab<-tklabel(fr, text=names[i], width="25")
      sc<-tkscale(fr, command=refresh.code, from=minima[i], to=maxima[i],
                     showvalue=T, resolution=resolutions[i], orient="horiz")
      assign("sc",sc,env=slider.env); tkpack(lab,sc,side="right")
      eval(parse(text=paste("tkconfigure(sc,variable=slider",i,")",sep="")),env=slider.env)
   }
   tkpack(fr<-tkframe(nt),fill="x")
   tkpack(tkbutton(fr, text="Exit",    command=function()tkdestroy(nt)),side="right")
   tkpack(tkbutton(fr, text="Reset", command=function(){
      for(i in seq(starts)) eval(parse(text=paste("tclvalue(slider",i,")<-",starts[i],sep="")),env=slider.env)
      refresh.code()    }  ),side="left")
  }
#########################
# R-Code for an example       #
#########################
successes.of.bernoulli.experiments<-function(){
  refresh.code<-function(...){
  # Modellierung
     prozent.ok<-slider(no=1); f.ok<-prozent.ok/100; h.ok<-21000*f.ok
     gg<-c(rep(1,h.ok),rep(0,21000-h.ok))
  # Experimentparameter
     n.stpr<-slider(no=2); wd<-slider(no=3); set.seed(zz<-slider(no=4))
  # Umsetzung
     result<-unlist(lapply(1:wd,function(x) { stpr<-sample(gg,size=n.stpr); sum(stpr) }))
  # Ergebnisdarstellung
     f.anz<-table(result)/wd
     plot(as.character(names(f.anz)),f.anz,bty="n",
        xlab="number of successes",ylab="frequency",
        xlim=c(0,n.stpr),ylim=c(0,1.5*dbinom(round(n.stpr*.5),n.stpr,.5)),
        main=paste("frequencies of different number of successes\n","p*100=",
                        prozent.ok,", sample size=",n.stpr,", repetitions=",wd,", seed=",zz,sep=""),type="h")
    result<<-result
  }
  slider(refresh.code,
       c("parameter: p*100","sample size","number of repetitions","random seed"),
       c(1,10,100,1),c(99,100,3000,30),c(1,5,200,1),c(58,50,500,13)  )
}
successes.of.bernoulli.experiments()