#0:
# Experiment zur Abweichung von 2*2-Tabellen von der Unabhaengigkeit
source(file="http://www.wiwi.uni-bielefeld.de/~wolf/software/R-wtools/slider/slider.R")

tab.compute<-function(tab,theo=F,chisquare=F,K=F,K.norm=F){
   if(min(tab)<0) return(0)
   h.j<-apply(tab,2,sum); hi.<-apply(tab,1,sum)
   h.theo<-outer(hi.,h.j,"*")/(n<-sum(hi.))
   if(theo) return(h.theo)
   chiq<-sum((tab-h.theo)^2/h.theo)
   if(chisquare) return(chiq)
   K<-(chiq/(n+chiq))^0.5
   if(K) return(K)
   if(K.norm) return(K<-K/(2/3))
   tab
}
mchi<-function(tab){
   h.1<-sum(tab[,1])
   hi.<-tab[,1]+tab[,2]
   tab.mat<-cbind(0:h.1,h.1:0,hi.[1]-(0:h.1),hi.[2]-(h.1:0))
   # tab.mat<-tab.mat[apply(tab.mat>=0,1,all),]
   k<-length(tab.mat[,1]); ws<-result<-1:k
   for(i in seq(result)){
     tab<-matrix(tab.mat[i,],2,2)
     result[i]<-tab.compute(tab,chisquare=T)
   }
   ws<-dhyper(tab.mat[,1],sum(tab[1,]),sum(tab[2,]),sum(tab[,1]))
   cumws<-phyper(tab.mat[,1],sum(tab[1,]),sum(tab[2,]),sum(tab[,1]))
   cbind(tab.mat[,1],result,ws)
}
KT.hyper<-function(initial.m.n.k.n11=c(10,10,10,5)){
  refresh.code<-function(...){
  # Vorbereitung
    m<-slider(no=1); n<-slider(no=2); k<-slider(no=3)
    n.11<-slider(no=4)
  # check
    if(k>(m+n)) k<-slider(set.no.value=c(3,m+n))
    if(n.11>k) n.11<-slider(set.no.value=c(4,k))
    if(n.11>m) n.11<-slider(set.no.value=c(4,m))
   if(n.11<k-n) n.11<-slider(set.no.value=c(4,k-n))
  # berechnung
    tab<-matrix(c(n.11,k-n.11,m-n.11,n-(k-n.11)),2,2)
    chi.n.11<-tab.compute(tab,chisquare=T)
    vertlg<-mchi(tab)
  # Plot
    par(mfrow=2:1)
    plot(vertlg[,1],vertlg[,3],type="h",bty="l",xlab="n.11",ylab="f(n.11)",
         main=paste("hypergeometrisch: m=",m,",n=",n,",k=",k,sep=""))
    abline(v=n.11,col="red",lty=2)
    ind<-order(vertlg[,2]); x<-vertlg[ind,2]; y<-cumsum(vertlg[ind,3])
    plot(c(0,x),c(0,y),type="s",bty="l",main="Verteilung Chisquare",
         xlab="chisquare",ylab="F.chisquare")
    vvv<-rev(y[chi.n.11>=x])[1] # phyper(n.11,m,n,k)
    segments(chi.n.11,0,chi.n.11,vvv,col="red",lty=2)
    segments(chi.n.11,vvv,0,vvv,col="red",lty=2)
       xymax<-par()$usr[c(2,4)];x<-xymax[1]*0.7
      text(x,0.5,"STPR"); text(x,0.4,n.11); text(x,0.3,k-n.11);
      text(x,0.2,k); x<-x*0.8/0.7
      text(x,0.5,"Rest"); text(x,0.4,m-n.11); text(x,0.3,n-(k-n.11));
      text(x,0.2,n+m-k); x<-x*0.9/0.8
      text(x,0.5,"GG"); text(x,0.4,m); text(x,0.3,n); text(x,0.2,m+n)
    par(mfrow=c(1,1))
  }
  slider(refresh.code,
       c("m Summe erste Zeile","n Summe zweite Zeile",
         "k Summe erste Spalte","n.11 Eintrag oben links"),
       c(1,1,1,1),c(99,99,99,99),c(1,1,1,1),initial.m.n.k.n11  )
}

#:0
#3:
KT.hyper()
#:3