# example 1, sliders only
if (FALSE) {
## 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()
}
# example 2, sliders and buttons
if (FALSE) {
## 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()
}
# example 3, dependent sliders
if (FALSE) {
## 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()
}
# example 4, rotating a surface
if (FALSE) {
## 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*(650];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()
}
Run the code above in your browser using DataLab