https://github.com/cran/ConvergenceConcepts
Raw File
Tip revision: 8709684e3587abe34550db683638acedc0e07660 authored by P. Lafaye de Micheaux on 10 February 2010, 00:00:00 UTC
version 1.0
Tip revision: 8709684
investigate.R
investigate <- function() {

# We investigate here the examples and the exercices from the article cited in the references section above


graphics.off()

exists.investigate <- exists("tt.investigate")
if (exists.investigate) {tkdestroy(tt.investigate);rm(tt.investigate,pos=1)}

for (i in 1:9) {

            x1 <- paste("tt",format(i),".1",sep="")
            x2 <- paste("tt",format(i),".2",sep="")
            exists.x1 <- exists(x1)
            exists.x2 <- exists(x2)
 
            if (exists.x1) {eval(parse(text=paste("tkdestroy(",x1,")",sep="")));eval(parse(text=paste("rm(",as.character(x1),",pos=1)",sep="")))}
            if (exists.x2) {eval(parse(text=paste("tkdestroy(",x2,")",sep="")));eval(parse(text=paste("rm(",as.character(x2),",pos=1)",sep="")))}

}


  plotright <- function(...) {

    val <- as.numeric(tkcurselection(tl))+1
    if (length(val) == 0) val <- 0

    if (val == 0) {

    plot.new()
    plot.window(xlim=c(0,1),ylim=c(0,1))
    box()
    text(0.5,0.9,expression("Let Z be a uniform U[0,1] random variable."))
    text(0.5,0.8,expression("Define " ~ X[n]=="1"["[m.2^(-k);(m+1).2^(-k))"](Z)))
    text(0.5,0.7,expression("where" ~ n==2^k+m ~ "for " ~ k<=1 ~ "and with " ~ 0<=m ~ ""<2^k ~ "."))
    text(0.5,0.6,expression("Does" ~ X[n] ~ " " ~ frac("a.s.","     ")~">" ~0 ~ "? Does" ~ X[n] ~ " " ~ frac(P,"     ")~">" ~0 ~ "?"))
    }

    if (val == 1) {

    plot.new()
    plot.window(xlim=c(0,1),ylim=c(0,1))
    box()
    text(0.5,0.9,expression("Let Z be a uniform U[0,1] random variable."))
    text(0.5,0.8,expression("Define " ~ X[n]=="1"["[m.2^(-k);(m+1).2^(-k))"](Z)))
    text(0.5,0.7,expression("where" ~ n==2^k+m ~ "for " ~ k<=1 ~ "and with " ~ 0<=m ~ ""<2^k ~ "."))
    text(0.5,0.6,expression("Does" ~ X[n] ~ " " ~ frac("a.s.","     ")~">" ~0 ~ "? Does" ~ X[n] ~ " " ~ frac(P,"     ")~">" ~0 ~ "?"))

      }

    
    if (val == 2) {
    
    plot.new()
    plot.window(xlim=c(0,1),ylim=c(0,1))
    box()
    text(0.5,0.9,expression("Let " ~ X[1] ~ ",... , " ~ X[n] ~ "be i.i.d. N(0,1) random variables and " ~ X==X[1] ~ "."))
    text(0.5,0.8,expression("Does" ~ X[n] ~ " " ~ frac(L,"     ")~">" ~X ~ "? Does" ~ X[n] ~ " " ~ frac(P,"     ")~">" ~X ~ "?"))
  }

    if (val ==3) {
    
    plot.new()
    plot.window(xlim=c(0,1),ylim=c(0,1))
    box()
    text(0.5,0.9,expression("Let " ~ X[1] ~ ",... , " ~ X[n] ~ "be independent random variables"))
    text(0.5,0.8,expression("such that P[" ~ X[n]==sqrt(n) ~ "]=1/n and P[" ~ X[n]==0 ~ "]=1-1/n."))
    text(0.5,0.7,expression("Does" ~ X[n] ~ " " ~ frac(2,"     ")~">" ~0 ~ "? Does" ~ X[n] ~ " " ~ frac(P,"     ")~">" ~0 ~ "?"))
  }


    if (val == 4) {

    plot.new()
    plot.window(xlim=c(0,1),ylim=c(0,1))
    box()
    text(0.5,0.9,expression("Let Z be U[0,1] and let" ~ X[n]==2^n ~ "1"["[0,1/n)"](Z)))
    text(0.5,0.7,expression("Does" ~ X[n] ~ " " ~ frac("r","     ")~">" ~0 ~ "? Does" ~ X[n] ~ " " ~ frac("a.s.","     ")~">" ~0 ~ "?"))
    }


    if (val ==5) {
    
    plot.new()
    plot.window(xlim=c(0,1),ylim=c(0,1))
    box()
    text(0.5,0.9,expression("Let " ~ Y[1] ~ ",... , " ~ Y[n] ~ "be independent random variables with mean 0"))
    text(0.5,0.8,expression("and variance 1. Define" ~ X[1]==X[2] ~ "=1 and"))
    text(0.5,0.68,expression(X[n]==frac(sum(Y[i], i==1, n),"(2n log log n)"^{1/2}) ~ "," ~ n>=3))
    text(0.5,0.5,expression("Does" ~ X[n] ~ " " ~ frac(2,"     ")~">" ~0 ~ "? Does" ~ X[n] ~ " " ~ frac("a.s.","     ")~">" ~0 ~ "?"))
    
  }

   
    if (val == 6) {

    plot.new()
    plot.window(xlim=c(0,1),ylim=c(0,1))
    box()
    text(0.5,0.9,expression("Let Z be Unif [0,1]."))
    text(0.5,0.8,expression("Let " ~ Y[1] ~ ",... , " ~ Y[n] ~ "be i.i.d. Unif{0,1,...,9} and let " ~ X[n]==sum(frac(Y[i],10^i), i==1, n) ~ "."))
    text(0.5,0.7,expression("It can be proved that " ~ X[n] ~ " " ~ frac("a.s.","     ") ~ ">" ~ X==sum(frac(Y[i],10^i), i==1, infinity)))
    text(0.5,0.6,expression("which follows a Unif [0,1] distribution."))
    text(0.5,0.5,expression("Does" ~ X[n] ~ " " ~ frac(L,"     ")~">" ~Z ~ "? Does" ~ X[n] ~ " " ~ frac("a.s.","     ")~">" ~Z ~ "?"))


    }

    if (val == 7) {

    plot.new()
    plot.window(xlim=c(0,1),ylim=c(0,1))
    box()
    text(0.5,0.9,expression("Let " ~ Y[1] ~ ",... , " ~ Y[n] ~ "be i.i.d. N(0,1) random variables and let " ~ X[n]==frac(1,n) ~ sum(Y[i], i==1, n) ~ "."))
    text(0.5,0.8,expression("Does" ~ X[n] ~ " " ~ frac(P,"     ")~">" ~0 ~ "?"))
    text(0.5,0.7,expression("Does" ~ X[n] ~ " " ~ frac("a.s.","     ")~">" ~0 ~ "?"))

  }

    

    if (val == 8) {

    plot.new()
    plot.window(xlim=c(0,1),ylim=c(0,1))
    box()
    text(0.5,0.9,expression("Let " ~ X[1] ~ ",... , " ~ X[n] ~ "be independent random variables"))
    text(0.5,0.8,expression("such that P[" ~ X[n]==n^0.4 ~ "]=1/n and P[" ~ X[n]==0 ~ "]=1-1/n."))
    text(0.5,0.7,expression("Does" ~ X[n] ~ " " ~ frac(r,"     ")~">" ~0 ~ "?, r=1, 2, 3."))

      
    }

    if (val == 9) {

    plot.new()
    plot.window(xlim=c(0,1),ylim=c(0,1))
    box()
    text(0.5,0.9,expression("Let " ~ Z[1] ~ ",... , " ~ Z[n] ~ "be " ~ chi[1]^{2} ~ " independent random variables."))
    text(0.5,0.7,expression("Let " ~ X[n]==frac(1,sqrt(n))*bgroup("[",frac(sum(Z[i], i==1, n)-n,sqrt(2)),"]") ~ "."))
    text(0.5,0.5,expression("Does" ~ X[n] ~ " " ~ frac(L,"     ")~">" ~"N(0,1)" ~ "?"))

      
    }
   
    
  }


listboxfunc <- function(...) {

    tkrreplot(imgright)

}


tt.investigate <<- tktoplevel()
tkgrid(tklabel(tt.investigate,text="What do you want to investigate?"))
exercises <- c("Exercise 1","Exercise 2","Exercise 3","Exercise 4","Exercise 5","Exercise 6","Example 1","Example 2","Example 3","Example 4")
tl <- tklistbox(tt.investigate,height=9,selectmode="single",background="white")
if (.Platform$OS.type == "unix") {imgright <- tkrplot(tt.investigate,plotright,hscale=1.2,vscale=1)}
if (.Platform$OS.type == "windows") {imgright <- tkrplot(tt.investigate,plotright,hscale=2,vscale=2)}
tkgrid(tl,imgright)
tkbind(tl, "<ButtonRelease-1>",listboxfunc)
val <<- 0

for (i in 1:9)
{
    tkinsert(tl,"end",exercises[i])
}
tkselection.set(tl,0)  # Default value.  Indexing starts at zero.


OnOK <- function(...)
{

    graphics.off()

    exerciseChoice <- exercises[as.numeric(tkcurselection(tl))+1]

    for (i in 1:9) {

            x1 <- paste("tt",format(i),".1",sep="")
            x2 <- paste("tt",format(i),".2",sep="")
            exists.x1 <- exists(x1)
            exists.x2 <- exists(x2)
  
            if (exists.x1) {eval(parse(text=paste("tkdestroy(",x1,")",sep="")));eval(parse(text=paste("rm(",as.character(x1),",pos=1)",sep="")))}
            if (exists.x2) {eval(parse(text=paste("tkdestroy(",x2,")",sep="")));eval(parse(text=paste("rm(",as.character(x2),",pos=1)",sep="")))}

}

    if (exerciseChoice=="Exercise 1") {

########### Exercise 1 ###########

       pnotasgen <- function(n){
       Z<-runif(1)
       k<-floor(log2(1:n))
       m<-1:n-2^k
       res<-(m*2^(-k)<= Z & Z<(m+1)*2^(-k))
       return(as.integer(res))
       }
    
       tt1.1 <<- check.convergence(nmax=2000,M=500,genXn=pnotasgen,mode="as")

    }

    if (exerciseChoice=="Exercise 2") {

########### Exercise 2 ###########

       lnotpgen <- function(n){x<-rnorm(n);x-x[1]}

       tt2.2 <<- check.convergence(nmax=2000,M=500,genXn=lnotpgen,mode="p")

   }

    if (exerciseChoice=="Exercise 3") {

########### Exercise 3 ###########

       pnotrgen <- function(n){rbinom(n,1,1/(1:n))*sqrt(1:n)}

       if (.Platform$OS.type=="unix") X11()
       if (.Platform$OS.type=="windows") windows()
       if (.Platform$OS.type=="mac") quartz()

       check.convergence(nmax=1000,M=10000,genXn=pnotrgen,mode="r",r=2,ylim=c(0,5))
       legend("topleft",legend=expression(hat(e)[n~bold(',')~'2']),lty=1)
       tt3.1 <<- check.convergence(nmax=2000,M=500,genXn=pnotrgen,mode="p")


    }

    if (exerciseChoice=="Exercise 4") {

########### Exercise 4 ###########

       asnotrgen <- function(n){x<-2^(1:n);res<-(runif(1)<1/(1:n))*x;res[is.infinite(x)]<-0;return(res)}

       if (.Platform$OS.type=="unix") X11()
       if (.Platform$OS.type=="windows") windows()
       if (.Platform$OS.type=="mac") quartz()

       check.convergence(nmax=10,M=500,genXn=asnotrgen,mode="r",r=2)
       legend("topleft",legend=expression(hat(e)[n~bold(',')~'2']),lty=1)
       tt4.1 <<- check.convergence(nmax=2000,M=500,genXn=asnotrgen,mode="as")

    }

    if (exerciseChoice=="Exercise 5") {

########### Exercise 5 ###########

       rnotasgen <- function(n){if (n == 1) res <- 1 else if (n == 2) res <- c(1,1) else res<-c(1,1,cumsum(rnorm(n))[-(1:2)]/sqrt(2*(3:n)*log(log(3:n))))}

       if (.Platform$OS.type=="unix") X11()
       if (.Platform$OS.type=="windows") windows()
       if (.Platform$OS.type=="mac") quartz()

       check.convergence(nmax=2000,M=500,genXn=rnotasgen,mode="r",r=2,col="red")
       points(3:1000,1/(2*log(log(3:1000))),type="l",col="blue")
       legend("topright",legend=c(expression(hat(e)[n~bold(',')~'2']),expression(e[n~bold(',')~'2'])),col=c("red","blue"),lty=1)
       tt5.1 <<- check.convergence(nmax=2000,M=500,genXn=rnotasgen,mode="as")

    }

    if (exerciseChoice=="Exercise 6") {

########### Exercise 6 ###########

       gen6.1 <- function(n){res<-cumsum(floor(10*runif(n))/(10^(1:n)))}
       gen6.2 <- function(n){res<-cumsum(floor(10*runif(n))/(10^(1:n)))-runif(1)}

       if (.Platform$OS.type=="unix") X11()
       if (.Platform$OS.type=="windows") windows()
       if (.Platform$OS.type=="mac") quartz()

       tt6.1 <<- check.convergence(nmax=20,M=5000,genXn=gen6.1,mode="L",density=FALSE,densfunc=dunif,probfunc=punif,tinf=-0.1,tsup=1.1)
       tt6.2 <<- check.convergence(nmax=2000,M=500,genXn=gen6.2,mode="as")

    }


    if (exerciseChoice=="Example 1") {

########### Example 1 ###########

       moyrand <- function(n,...){cumsum(rnorm(n,...))/(1:n)}

       tt7.1 <<- check.convergence(nmax=2000,M=500,genXn=moyrand,mode="p")

    }


    if (exerciseChoice=="Example 2") {

########### Example 2 ###########

       myrbinom <- function(n,alpha){rbinom(n,1,1/(1:n))*((1:n)**alpha)}

       if (.Platform$OS.type=="unix") X11()
       if (.Platform$OS.type=="windows") windows()
       if (.Platform$OS.type=="mac") quartz()

       check.convergence(nmax=2000,M=500,genXn=myrbinom,argsXn=list(alpha=0.5),mode="r",r=3,plotfunc=plot,col="green",ylim=c(0,300))
       check.convergence(nmax=2000,M=500,genXn=myrbinom,argsXn=list(alpha=0.5),mode="r",r=2,plotfunc=points,col="blue",ylim=c(0,300))
       check.convergence(nmax=2000,M=500,genXn=myrbinom,argsXn=list(alpha=0.5),mode="r",r=1,plotfunc=points,col="red",ylim=c(0,300))
       text(100,-5,'r=1',xpd=TRUE,col='red')
       text(200,5,'r=2',xpd=TRUE,col='blue')
       text(300,50,'r=3',xpd=TRUE,col='green')
       legend("topleft",legend=c(expression(hat(e)[n~bold(',')~'1']),expression(hat(e)[n~bold(',')~'2']),expression(hat(e)[n~bold(',')~'3'])),col=c("red","blue","green"),lty=1)

    }

    if (exerciseChoice=="Example 3") {

########### Example 3 ###########

      
      if (.Platform$OS.type=="unix") {X11(width=2,height=2);plot.new();title("Please wait ...");X11()}
      if (.Platform$OS.type=="windows") {windows(width=2,height=2);plot.new();title("Please wait ...");windows()}
      if (.Platform$OS.type=="mac") {quartz(width=2,height=2);plot.new();title("Please wait ...");quartz()}
      
      if (exists("bringToTop")) bringToTop(dev.prev())
      rand1 <- function(n){(cumsum(rchisq(n,df=1))-(1:n))/sqrt(2*(1:n))}
      tt8.1 <<- check.convergence(nmax=200,M=5000,genXn=rand1,mode="L",density=FALSE,densfunc=dnorm,probfunc=pnorm,tinf=-4,tsup=4)
      dev.off() 
    }
}

OK.but <-tkbutton(tt.investigate,text="   OK   ",command=OnOK)
tkgrid(OK.but)

 
}
back to top