varW <- function( x , w ) {
  w <- length(w)*w / sum(w)
  mw <- sum(x*w)/sum(w)
  varW <- sum( w * ( x-mw )^2 )/ ( sum( length(w)-1 ))
  varW
}

meanW <- function( x , w ) {
  meanW <- sum(x*w)/sum(w)
  meanW
}


indexEstimateData <- function(x, w=NULL, alpha=0.05, R=10000 ) {
  v = vector()
  if (length(w)!=0 ) {
    for ( i in 1:R ) {
      u <- sample.int( length(x), replace=TRUE )
      v[i] <- sum(x[u]*w[u]) / sum(w[u])
    }
  } else {
    for ( i in 1:R ) {
      u <- sample.int( length(x), replace=TRUE )
      v[i] <- mean(x[u])
    }
  }
  result <- quantile(v, probs=c(alpha/2, 0.5, 1-alpha/2) )
  names(result)[2] <- "Оценка"
  return(result)
}

indexEstimateDensity <- function(d, tIndex, getFunc, alpha=0.05, R=10000 ) {
  n = sum(d)
  p = d/n
  v = vector()
  for ( i in 1:R ){
    u <- rmultinom(1, n, prob=p)
    v[i] <- getFunc(as.vector(u), tIndex)
  }
  result = quantile(v, probs=c(alpha/2, 0.5, 1-alpha/2) )
  names(result)[2] <- "Оценка"
  return(result)
}

indexCompareDensity <- function(d, tIndex, getFunc, R=10000 ) {
  
  n = nrow(d)
  
  result <- as.data.frame( array(NA, dim = c(n,n)) )
  
  rownames(result) <- colnames(result) <- rownames(d)
  
  for ( i in 1:n )
    for ( j in 1:n ){
      if ( i<j ){
        n1 <- sum(d[i,])
        p1 <- d[i,]/n1
        n2 <- sum(d[j,])
        p2 <- d[j,]/n2
        
        v = vector()
        for ( k in 1:R ){
          u1 <- rmultinom(1, n1, prob=p1)
          u2 <- rmultinom(1, n2, prob=p2)
          v[k] <- getFunc(as.vector(u1), tIndex) - 
            getFunc(as.vector(u2), tIndex)
        }
        result[i,j] <- 2*min( sum(v<0)/R, sum(v>0)/R )
      } 
      if (i>j) 
        result[i,j] = result[j,i]
      
    }
  ndigit <- options()$digits
  options(digits = 4)
  print(result)
  options(digits = ndigit)
  cat("\n\n")
  return(result)
  
}


chiCorrect = function( x, alpha=0.95 ) {
  
  DNAME <- deparse(substitute(x))
  
  if ( length(dim(x))!=2 ) warning("data is not a matrix")
  O = as.matrix(x)
  E = ( as.matrix(rowSums(O))%*%t(colSums(O))) /sum(O)
  
  sum( abs(O-E)^3 / E^2 )
  S = sqrt( qchisq( 1-alpha, df=prod(dim(O)-1) ) )* sum( abs(O-E)^3 / E^2 ) / 3/( sum( (O-E)^2/E ) )^1.5
  
  result <- data.frame()
              
  result[1, "Название критерия"] <- "Минимальное ожид." 
  result[1, "Значение"]     <- min(E)
  result[1, "Условие применимости"] <- "> 5"
  result[1, "Можно ли применять"]  <- min (E) > 5
  
  result[2, "Название критерия"] <- "Среднее наблюд."
  result[2, "Значение"]     <- mean(O)
  result[2, "Условие применимости"] <- "> 5"
  result[2, "Можно ли применять"]  <- mean(O) > 5
  
  result[3, "Название критерия"] <- "Simonov-Tsai" 
  result[3, "Значение"]     <- S
  result[3, "Условие применимости"] <- "< 0.25"
  result[3, "Можно ли применять"]  <- S <0.25
  
  return(result)
}

checkHomGroup <- function(a,f, varName) {
  cat("   Проверка однородности онтогенетических спектров субвыборок\n") 
  cat("         в пределах выборки на основе теста хи-квадрат\n")
  options(digits = 4)
  for( i in 1:nlevels(f) ) {
    b <- a[f==levels(f)[i], ]
    b <- b[ ,colSums(b)!=0]
    chi <- chisq.test(b)
    
    #eval(parse(text=paste ( levels(f)[i], "<-", "a[f==levels(f)[i], ]" )))
    #eval(parse(text=paste ( levels(f)[i], "<-", levels(f)[i], 
    #                        "[ , colSums(", levels(f)[i],")!=0]" )))
    #fisher
    #b = list( p.value = -1 )
    #eval(parse(text=paste ( "b = fisher.test(", levels(f)[i], ")" )))
    #cat( "\nsample: ", b$data.name, "    p-value =", b$p.value )
    
    #eval(parse(text=paste ( "b = chisq.test(", levels(f)[i], ")" )))
    cat( "\nвыбока: ", levels(f)[i], "    параметр: ",varName,   "\nхи-квадрат = ", chi$statistic, 
         ", df = ", chi$parameter )
    if (chi$p.value > 2.2e-16) {
      cat( ", p-значение ", chi$p.value, "\n" )
    } else {
      cat( ", p-значение < 2.2e-16\n" )
    }
    cat( "   Проверка применимости теста хи-квадрат\n" )
    print(chiCorrect(b))
    #eval(parse(text=paste ( "print(chiCorrect(", levels(f)[i], "))" )))
  }
  options(digits = 7)
  cat("\n")
  #warnings()
}

checkHom <- function(a, varName) {
  cat("   Проверка однородности онтогенетических спектров\n")
  cat("         выборок на основе теста хи-квадрат\n")
  options(digits = 4)
  
  b <- chisq.test(a)  
  cat( "параметр: ", varName, "\nХи-квадрат = ", b$statistic, 
       ", df = ", b$parameter )
  if (b$p.value > 2.2e-16) {
    cat( ", p-значение ", b$p.value, "\n" )
  } else {
    cat( ", p-значение < 2.2e-16\n" )
  }
  cat( "   Проверка применимости теста хи-квадрат\n" )
  print(chiCorrect(a) )
  
  options(digits = 7)
  cat("\n")
  #warnings()
}

getOmega <- function ( x, tIndex ) {
  
  if( is.vector(x) ) x <- t(as.matrix(x))
  uran <- 4 * exp( 6 - tIndex ) * ( 1 + exp( 6 - tIndex ) )^-2
  delta <- as.matrix(x) %*% as.matrix(uran) / rowSums(x) 
  return( as.vector(delta) )
}

getDelta <- function ( x, tIndex ) {
  
  if( is.vector(x) ) x <- t(as.matrix(x))
  uran <- ( 1 + exp( 6 - tIndex ) )^-1
  delta <- as.matrix(x) %*% as.matrix(uran) / rowSums(x) 
  return( as.vector(delta) )
}

getI1 <- function ( x, tIndex ) {
  
  if( is.vector(x) ) {
    I1 <- sum( x [ (tIndex > 1.5)&( tIndex < 4.5) ] ) / 
      sum( x [ (tIndex > 1.5)&( tIndex < 7.5) ] )
  }
  else {
    I1 <- rowSums( as.matrix( x [ , (tIndex > 1.5)&( tIndex < 4.5) ] )) / 
      rowSums( x [ , (tIndex > 1.5)&( tIndex < 7.5) ] )
  }
  return( as.vector(I1) )
}

getI2 <- function ( x, tIndex ) {
  
  if( is.vector(x) ){
    I2 <- sum( x [ (tIndex > 7.5)&( tIndex < 10.5) ] ) / 
      sum( x [ (tIndex > 1.5)&( tIndex < 10.5) ] )
  } else {
    I2 <- rowSums( as.matrix( x [ , (tIndex > 7.5)&( tIndex < 10.5) ] )) / 
      rowSums( x [ , (tIndex > 1.5)&( tIndex < 10.5) ] )
  }
  return( as.vector(I2) )
}

getW =function (a, tIndex, funcName) {
  getW = switch ( funcName,
                  delta = rowSums(a),
                  I1 = rowSums( a [ , (tIndex > 1.5)&( tIndex < 7.5) ] ),
                  I2 = rowSums( a [ , (tIndex > 1.5)&( tIndex < 10.5) ] ),
                  omega = rowSums(a)
  )
  return(getW)
}

aov1 <- function( x,f ) {
  n <- table(f)
  mm <- sum(x) / sum(n)
  m <- as.vector(rowsum(x,f)) / n
  
  ss.b <- sum( ( m-mm )^2 * n )
  ss.w <- sum( ( x - m[f] )^2 )
  
  aov1 <- ss.b/ss.w*(length(x)-nlevels(f))/(nlevels(f)-1)
  aov1
}

aov2 <- function( x, f ) {
  n <- table(f)
  n0 <- mean(n) - var(n)/sum(n)
  mm <- sum(x) / sum(n)
  m <- as.vector(rowsum(x,f)) / n
  
  MSb <- sum( ( m-mm )^2 * n )/( nlevels(f)-1 )
  MSw <- sum( ( x - m[f] )^2 )/( length(x)-nlevels(f) )
  
  Sa <- ( MSb - MSw ) / n0 
  aov2 <- Sa / (Sa+MSw)
  aov2
}

aov1w <- function( x,f,w ) {
  
  n <- as.vector( rowsum(w,f) )
  mm <- sum(x*w) / sum(w)
  m <- as.vector(rowsum(x*w,f) / n)
  
  ss.b <- sum( ( m-mm )^2 * n )
  ss.w <- sum( ( x - m[f] )^2 * w )
  
  aov1w <- ss.b/ss.w*(length(x)-nlevels(f))/(nlevels(f)-1)
  aov1w
}

aov2w <- function( x,f,w ) {
  n <- as.vector( rowsum(w,f) )
  n0 <- mean(table(f)) - var(table(f))/sum(table(f))
  mm <- sum(x*w) / sum(w)
  m <- as.vector(rowsum(x*w,f) / n)
  
  MSb <- sum( ( m-mm )^2 * n )/( nlevels(f)-1 )
  MSw <- sum( ( x - m[f] )^2 *w )/( length(x)-nlevels(f) )
  
  Sa <- ( MSb - MSw ) / n0 
  aov2w <- Sa / (Sa+MSw)
  aov2w
}

#########  ########

aov1R <- function( x, f, w = NULL, R = 10000 ) {
  
  if ( length(w) == 0 ) {
    xx <- vector()
    for( i in levels(f) ) {
      xx <- c( xx, x[f==i] )
    }
    x <- xx
    v <- vector()
    for ( i in 1L:(R-1) ) {
      u <- sample.int( length(f), replace = F )
      v[i] <- aov1( x[u] , f )
    }
    vv <- aov1( x, f )
  } else {
    xx <- vector()
    ww <- vector()
    for( i in levels(f) ) {
      xx <- c( xx, x[f==i] )
      ww <- c( ww, w[f==i] )
    }
    x <- xx
    w <- ww
    v <- vector()
    for ( i in 1L:(R-1) ) {
      u <- sample.int( length(f), replace = F )
      v[i] <- aov1w( x[u] , f, w[u] )
    }
    vv <- aov1w( x, f, w )
  }
  aov1R <- 1 - sum( vv > v )/R
  aov1R
}

aov2R <- function( x, f, w = NULL, alpha = 0.05, R = 10000 ) {
  
  if ( length(w) == 0 ) {
    xx <- vector()
    for( i in levels(f) ) {
      xx <- c( xx, x[f==i] )
    }
    x <- xx
    f <- as.factor( rep( levels(f), table(f) ) )
    
    n <- c( 0, table(f) )
    for ( i in 1:nlevels(f) ) n[i+1] <- n[i+1] + n[i]
    v <- vector()
    for ( i in 1L:(R+1) ) {
      u <- vector()
      for ( j in 1:nlevels(f) ) 
        u <- c( u, sample( (n[j]+1):n[j+1] , replace = TRUE) )
      v[i] <- aov2( x[u] , f )
    }
  } else {
    xx <- vector()
    ww <- vector()
    for( i in levels(f) ) {
      xx <- c( xx, x[f==i] )
      ww <- c( ww, w[f==i] )
    }
    x <- xx
    w <- ww
    f <- as.factor( rep( levels(f), table(f) ) )
    n <- c( 0, table(f) )
    for ( i in 1:nlevels(f) ) 
      n[i+1] <- n[i+1] + n[i]
    v <- vector()
    for ( i in 1L:(R+1) ) {
      u <- vector()
      for ( j in 1:nlevels(f) ) 
        u <- c( u, sample( (n[j]+1):n[j+1] , replace = TRUE) )
      v[i] <- aov2w( x[u] , f, w[u] )
    }
  }
  aov2R <- quantile( v, c( alpha/2, 0.5, 1-alpha/2 )) 
  names(aov2R)[2] = "Оценка"
  return(aov2R)
}


scheffePair <- function( xCut, fCut, ss.rem ) {
  
  m <- tapply(xCut, fCut, mean)
  ss.int <- (sum( ( xCut - m[fCut] )^2 ) + ss.rem)
  scheffePair <- ( m[1] - m[2] )^2 / ss.int #/ koeff  / ( 1/n[1] + 1/n[2] )
  scheffePair
}

scheffePairW <- function( xCut, fCut, ss.rem, wCut ) {
  n <- as.vector( rowsum(wCut, fCut) )
  m <- as.vector( rowsum(xCut*wCut, fCut) ) / n
  ss.int <- (sum( ( xCut - m[fCut] )^2 * wCut) + ss.rem)
  scheffePairW <- ( m[1] - m[2] )^2 / ss.int #/ koeff  / ( 1/n[1] + 1/n[2] )
  scheffePairW
}

scheffePairR <- function( xCut, fCut, ss.rem, R = 10000, wCut=NULL ){
  v <- vector()
  if (length(wCut)==0) {
    for ( i in 1L:(R-1) ) {
      u <- sample.int( length(fCut), replace=F )
      v[i] <- scheffePair( xCut[u] , fCut, ss.rem )
    }
    vv <- scheffePair( xCut, fCut, ss.rem )
  } else {
    for ( i in 1L:(R-1) ) {
      u <- sample.int( length(fCut), replace=F )
      v[i] <- scheffePairW( xCut[u] , fCut, ss.rem, wCut )
    }
    vv <- scheffePairW( xCut, fCut, ss.rem, wCut )
  }
  
  scheffePairR <- 1- sum(vv > v)/R
  scheffePairR
}

scheffeR <- function( x, f, w = NULL, R = 10000 ) {
  
  if ( length(w) == 0 ) {
    m <- tapply(x, f, mean)
    ss.total <- sum( (x - m[f])^2 )
  } else {
    n <- as.vector( rowsum(w,f) )
    m <- as.vector( rowsum(x*w,f) / n )
    ss.total <- sum( ( x - m[f] )^2 * w )
  }
  
  k <- nlevels(f)
  scheffeR <- array(NA, dim <- c(k, k))
  colnames(scheffeR) <- levels(f)
  rownames(scheffeR) <- levels(f)
  
  
  for( i in 1:(nlevels(f)-1) ) 
    for ( j in (i+1):nlevels(f) ) {
      look <- f == levels(f)[i] | f == levels(f)[j]
      xCut <- x[look]
      fCut <- f[look]
      fCut <- droplevels(fCut)
      if (length(w) == 0) {
        wCut <- NULL
        m <- tapply( xCut, fCut, mean)
        ss.pair <- sum( (xCut- m[fCut])^2 )
      } else {
        wCut = w[look]
        n <- as.vector( rowsum(wCut, fCut) )
        m <- as.vector( rowsum(xCut*wCut, fCut) ) / n
        ss.pair <- sum( (xCut- m[fCut])^2 * wCut)
      }
      
      ss.rem <- ss.total - ss.pair
      scheffeR[i, j] <- scheffePairR(xCut, fCut, ss.rem, R, wCut )
      scheffeR[j, i] <- scheffeR[i, j]
    }
  scheffeR
}


getIndex <- function( age.names, value=TRUE ) {
  
  uran.index        <- c(   0,    1,   2,    3,   4, 11/3, 13/3,
                            5,    5,    6,   6,     7,    7,    8,   9,  10)
  names(uran.index) <- c("sm", "pl", "j", "im", "v", "v1", "v2", 
                         "g1","g1v", "g2","g2v", "g3","g3v", "ss", "s", "sc")
  
  getIndex <- uran.index[age.names]
  names(getIndex) <- age.names
  getIndex[is.na(getIndex)] <- -Inf
  if (value) getIndex <- ( 1 + exp( 6 - getIndex ) )^-1
  getIndex
} 

######################################################

######################################################

######################################################




require(tcltk)

OntoParam <- function() {
  
  require(tcltk)
  
  ######    updating tk
  have_ttk <- as.character(tcl("info", "tclversion")) >= "8.5"
  if(have_ttk) {
    tkbutton <- ttkbutton
    tkcheckbutton <- ttkcheckbutton
    tkentry <- ttkentry
    tkframe <- ttkframe
    tklabel <- ttklabel
    tkradiobutton <- ttkradiobutton
  }
  
  main.window <- tktoplevel(height=500, width=500)
  tkwm.title(main.window, "OntoParam")
  file.var <- tclVar(" ")
  index.var <- tclVar(" ")
  weighted.var <- tclVar(0)
  iteration.var <- tclVar(10000)
  alpha.var <- tclVar(0.05)
  dataMatrix <- data.frame()
  dataList <- list()
  result <- 0
  
  loadDataList <- function(d){
    if ( length(d)==0 ) {
      tkmessageBox(message = "Необходимо загрузить файл с данными", icon = "warning", type = "ok")
      return( list() )
    }
    loadDataList <- list()
    loadDataList$f <- as.factor( d[,1] )
    loadDataList$a <- d[, 2:ncol(d)]
    loadDataList$tIndex <- getIndex(colnames(loadDataList$a),F)
    loadDataList$uran <- ( 1 + exp( 6 - loadDataList$tIndex ) )^-1
    
    loadDataList$R <- as.numeric(tclvalue(iteration.var))
    loadDataList$alpha <- as.numeric(tclvalue(alpha.var))
    loadDataList$var <- tclvalue(index.var)
    
    if ( nchar(loadDataList$var)>1 ) {
      loadDataList$getFunc <- switch( tclvalue(index.var), 
                                      delta = getDelta,
                                      I1 = getI1, I2 = getI2 )
      loadDataList$x <- loadDataList$getFunc(loadDataList$a, loadDataList$tIndex) 
    } else {
      tkmessageBox(message = "Необходимо выбрать параметр для анализа", icon = "warning", type = "ok")
      return( list() )
    }
    
    if ( as.numeric(tclvalue(weighted.var)) ) {
      #loadDataList$w <- switch( tclvalue(index.var), delta = rowSums(loadDataList$a), 
      #                          I1 = rowSums(loadDataList$a[ , (loadDataList$tIndex > 1.5)&( loadDataList$tIndex < 7.5) ]), 
      #                          I2 = rowSums(loadDataList$a[ , (loadDataList$tIndex > 1.5)&( loadDataList$tIndex < 10.5) ]) )
      loadDataList$w <- getW( loadDataList$a, loadDataList$tIndex, loadDataList$var)
    } else {
      loadDataList$w <- vector()
    }
    
    return(loadDataList)
    
  }
  
  up.frame <- tkframe(main.window)
  down.frame <- tkframe(main.window, borderwidth=2)
  left.frame <- tkframe(up.frame, borderwidth=4, relief="groove")
{
    ## loading file button
    load.button <- tkbutton(left.frame, text = "Загрузить файл...", command = function(){
      fileName <- ""
      fileName <- file.choose()
      dataMatrix <- data.frame()
      if ( nchar(fileName)>1 ) {
        dataMatrix <- read.csv2(fileName)
        if ( dim(dataMatrix)[2]>2 ) {
          dataMatrix[is.na(dataMatrix)]=0
          dataMatrix <<- dataMatrix[ rowSums(dataMatrix[,2:ncol(dataMatrix)])!=0, ]
          cat("\nЗагружена таблица ", dim(dataMatrix)[1], "строк и ", dim(dataMatrix)[2], "столбцов\n")
        } else {
          dataMatrix <<- data.frame()
          warning("Данные в загруженном файле должны быть в виде таблицы")
          tkmessageBox(message = "Данные в загруженном файле должны быть в виде таблицы", icon = "warning", type = "ok")
        }
      }
    })
    tkpack( load.button )
    tkpack( tklabel(left.frame, text="Выберите параметр") )
    
    for ( i in c("delta", "I1", "I2") ) {
      tmp <- tkradiobutton(left.frame, text=i, value=i, variable=index.var )
      tkpack(tmp, anchor="w")
    }
    #load.custom.label = tklabel(left.frame, text = "  " )
    #tkpack(load.custom.label, anchor="w" , fill="both")
    
    check.weighted <- tkcheckbutton(left.frame, text="использовать \nвзвешивание", 
                                    variable = weighted.var  )
    tkpack(check.weighted, fill="both")
    
    entry.alpha <- tkentry(left.frame, text="confidence interval",
                           textvariable=alpha.var, width=6)
    tkpack(tklabel(left.frame, text="Довертельный интервал"), entry.alpha, fill="both")
    
    entry.iteration <- tkentry(left.frame, text="Number of iterations",
                               textvariable=iteration.var, width=8)
    tkpack(tklabel(left.frame, text="Число итераций"), entry.iteration, fill="both")
  }  
  main.frame <- tkframe(up.frame, borderwidth=4, relief="groove")
{
    #tkpack( tklabel(main.frame, text="Check homogenity of subsamples within sample") )
    
    #check.hom.group.button 
    check.hom.group.button <- tkbutton( main.frame, text = "Проверка однородности онтогенетических\nспектров субвыборок в пределах выборки",
                                        command = function(){
                                          dataList <- loadDataList( dataMatrix )
                                          if ( nchar(dataList$var)>0 ) 
                                            checkHomGroup( dataList$a, dataList$f, dataList$var )
                                        } )
    tkpack(check.hom.group.button, fill="both")
    
    frame1 <- tkframe(main.frame, borderwidth=4, relief="groove")
{
      tkpack( tklabel(frame1, text="Онтогенетические спектры субвыборок\n однородны в пределах выборки") )
      tkpack( tklabel(frame1, text="|") )
      check.hom.button <- tkbutton( frame1, text = "Проверка однородности онтогенетических\n              спектров выборок",
                                    command = function(){
                                      dataList <- loadDataList( dataMatrix )
                                      if ( nchar(dataList$var)>0 ) 
                                        checkHom( dataList$a, dataList$var )
                                    } )
      tkpack(check.hom.button, fill="both")
      
      frame11 <- tkframe(frame1, borderwidth=4, relief="groove")
{
        tkpack( tklabel(frame11, text="Онтогенетические спектры\n выборок НЕ различаются") )
        tkpack( tklabel(frame11, text="|") )
        estimate11 <- function(dataList) {
          d <- colSums(dataList$a)
          
          cat("    Оценка значения параметра по всем данным\n")
          cat("параметр:", dataList$var,"    ")
          cat(dataList$R,"итераций")
          if ( length(dataList$w)!=0 ) cat("    взвешенный анализ")
          cat("\n")
          result <- indexEstimateDensity ( d, dataList$tIndex, 
                                           dataList$getFunc,
                                           dataList$alpha, dataList$R )
          ndigit <- options()$digits
          options(digits = 4)
          print(result)
          options(digits = ndigit)
          cat("\n\n")
        }
        estimate11.button <- tkbutton( frame11, text = "Оценка значений\n параметра по всем\n    данным",
                                       command = function(){
                                         dataList <- loadDataList( dataMatrix )
                                         if ( nchar(dataList$var)>0 ) {
                                           estimate11(dataList)
                                         }                                   
                                       } )
        tkpack(estimate11.button, fill="both")
      }
      frame12 <- tkframe(frame1, borderwidth=4, relief="groove")
{
        tkpack( tklabel(frame12, text="Онтогенетические спектры\n    выборок Различаются") )
        tkpack( tklabel(frame12, text="|") )
        distrib.pair.button <- tkbutton( frame12, text = "Парные сравнения значений\n   параметра выборок",
                                         command = function(){
                                           dataList <- loadDataList( dataMatrix )
                                           if ( nchar(dataList$var)>0 ) {
                                             d = rowsum( dataList$a, dataList$f )
                                             cat("    Парные сравнения значений параметра выборок\n")
                                             cat("параметр:", dataList$var,"    ")
                                             cat(dataList$R,"итераций")
                                             if ( length(dataList$w)!=0 ) cat("    взвешенный анализ")
                                             cat("\n")
                                             
                                             indexCompareDensity (d, dataList$tIndex, 
                                                                  dataList$getFunc, dataList$R ) 
                                           }                                   
                                         } )
        tkpack(distrib.pair.button, fill="both")
        
        frame121 <- tkframe(frame12, borderwidth=4, relief="groove")
{
          tkpack( tklabel(frame121, text="Значения параметра\n  выборок НЕ\n  различаются") )
          tkpack( tklabel(frame121, text="|") )
          estimate121 <- function(dataList) {
            d <- colSums(dataList$a)
            
            cat("    Оценка значения параметра по всем данным\n")
            cat("параметр:", dataList$var,"    ")
            cat(dataList$R,"итераций")
            if ( length(dataList$w)!=0 ) cat("    взвешенный анализ")
            cat("\n")
            result <- indexEstimateDensity ( d, dataList$tIndex, 
                                             dataList$getFunc,
                                             dataList$alpha, dataList$R )
            ndigit <- options()$digits
            options(digits = 4)
            print(result)
            options(digits = ndigit)
            cat("\n\n")
          }
          estimate121.button <- tkbutton( frame121, text = "Оценка значения\n параметра по всем\n   данным",
                                          command = function(){
                                            dataList <- loadDataList( dataMatrix )
                                            if ( nchar(dataList$var)>0 ) {
                                              estimate121(dataList)
                                            }                                   
                                          } )
          tkpack(estimate121.button, fill="both")
        }
        frame122 <- tkframe(frame12, borderwidth=4, relief="groove")
{
          tkpack( tklabel(frame122, text="Значения параметра\n   выборок\n  Различаются") )
          tkpack( tklabel(frame122, text="|") )
          estimate122 <- function(dataList) {
            d <- rowsum(dataList$a, dataList$f)
            f <- dataList$f
            result <- as.data.frame( array(0, dim = c(nlevels(f),3)) )
            cat("    Оценка значения параметра выборок\n")
            cat("параметр:", dataList$var,"    ")
            cat(dataList$R,"итераций")
            if ( length(dataList$w)!=0 ) cat("    взвешенный анализ")
            cat("\n")
            rownames(result) <- levels(f)
            for ( lvl in levels(f) ){ # lvl - level of factor 
              
              v <- indexEstimateDensity ( as.vector(d[lvl, ]), dataList$tIndex, 
                                                     dataList$getFunc,
                                                     dataList$alpha, dataList$R )
              result[lvl,] <- v
            }
            colnames(result) = names( v )
            colnames(result)[2] = "Оценка"
            ndigit <- options()$digits
            options(digits = 4)
            print(result)
            options(digits = ndigit)
            cat("\n\n")
          }
          estimate122.button <- tkbutton( frame122, text = "Оценка значения\nпараметра выборок",
                                          command = function(){
                                            dataList <- loadDataList( dataMatrix )
                                            if ( nchar(dataList$var)>0 ) {
                                              estimate122(dataList)
                                            }                                   
                                          } )
          tkpack(estimate122.button, fill="both")
        }
        tkpack(frame121, frame122, side="left", fill="both")
        
        
        
        
      }
      tkpack(frame11, frame12, side="left", fill="both")
    }
    frame2 <- tkframe(main.frame, borderwidth=4, relief="groove")
{
      tkpack( tklabel(frame2, text="Онтогенетические спектры субвыборок\n     различаются в пределах выборки") )
      tkpack( tklabel(frame2, text="|") )
      aov1.button <- tkbutton( frame2, text = "Сравнение значений параметра\n     разных выборок",
                               command = function(){
                                 dataList <- loadDataList( dataMatrix )
                                 if ( nchar(dataList$var)>0 ) {
                                   cat("    Сравнение значений параметра разных выборок\n")
                                   cat("       (ресамплинг на основе ANOVA модель I) \n")
                                   cat("параметр:", dataList$var,"    ")
                                   cat(dataList$R,"итераций")
                                   if ( length(dataList$w)!=0 ) cat("    взвешенный анализ")
                                   cat("\n")
                                   cat("p-значение = ")
                                   cat( aov1R(dataList$x, dataList$f, dataList$w, dataList$R) )
                                   cat("\n\n")
                                 }                                   
                               } )
      tkpack(aov1.button, fill="both")
      
      frame21 <- tkframe(frame2, borderwidth=4, relief="groove")
{
        tkpack( tklabel(frame21, text="Значения параметра\n НЕ различаются") )
        tkpack( tklabel(frame21, text="|") )
        estimate21 <- function(dataList) {
          x <- dataList$x
          f <- dataList$f
          w <- dataList$w
          alpha <- dataList$alpha
          R <- dataList$R
          
          cat("    Оценка значения параметра по всем данным\n")
          
          result <- indexEstimateData(x, w, alpha, R)
          
          ndigit <- options()$digits
          options(digits = 4)
          print(result)
          options(digits = ndigit)
          cat("\n\n")
        }
        estimate21.button <- tkbutton( frame21, text = "Оценка значений\n параметра по всем\n   данным",
                                       command = function(){
                                         dataList <- loadDataList( dataMatrix )
                                         if ( nchar(dataList$var)>0 ) {
                                           estimate21(dataList)
                                         }                                   
                                       } )
        tkpack(estimate21.button, fill="both")
      }
      frame22 <- tkframe(frame2, borderwidth=4, relief="groove")
{
        tkpack( tklabel(frame22, text="  Значения параметра \nвыборок Различаются") )
        tkpack( tklabel(frame22, text="|") )
        aov.pair.button <- tkbutton( frame22, text = "Парные сравнения \n значения параметра\n   выборок",
                                     command = function(){
                                       dataList <- loadDataList( dataMatrix )
                                       if ( nchar(dataList$var)>0 ) {
                                         cat("    Парные сравнения (основанные на тесте Шеффе)\n")
                                         cat("параметр:", dataList$var,"    ")
                                         cat(dataList$R,"итераций")
                                         if ( length(dataList$w)!=0 ) cat("    взвешенный анализ")
                                         cat("\n")
                                         result <<- scheffeR ( dataList$x, dataList$f, dataList$w, dataList$R )
                                         print( result )
                                         cat("\n")
                                       }                                   
                                     } )
        tkpack(aov.pair.button, fill="both")
        aov2.button <- tkbutton( frame22, text = "Оценка доли влияния\n     изменчивости \n  между выборками",
                                 command = function(){
                                   dataList <- loadDataList( dataMatrix )
                                   if ( nchar(dataList$var)>0 ) {
                                     cat("    Оценка доли влияния изменчивости между выборками\n")
                                     cat("          (ресамплинг на основе ANOVA модель II) \n")
                                     cat("параметр:", dataList$var,"    ")
                                     cat(dataList$R,"итераций")
                                     if ( length(dataList$w)!=0 ) cat("    взвешенный анализ")
                                     cat("\n")
                                     print( aov2R(dataList$x, dataList$f, dataList$w, 
                                                  dataList$alpha, dataList$R) )
                                     cat("\n\n")
                                   }                                   
                                 } )
        tkpack(aov2.button, fill="both")
        
        estimate22 <- function(dataList) {
          x <- dataList$x
          f <- dataList$f
          w <- dataList$w
          alpha <- dataList$alpha
          R <- dataList$R
          
          result <- as.data.frame( array(0, dim = c(nlevels(f),3)) )
          cat("    Оценка значения параметра выборок\n")
          cat("параметр:", dataList$var,"    ")
          cat(dataList$R,"итераций")
          if ( length(dataList$w)!=0 ) cat("    взвешенный анализ")
          cat("\n")
          rownames(result) <- levels(f)
          for ( lvl in levels(f) ){ # lvl - level of factor 
            xlevel <- x[f==lvl]
            if( length(w)!=0 ) {
              wlevel <- w[f==lvl]
            } else {
              wlevel <- vector()
            }
            levelEst <- indexEstimateData(xlevel, wlevel, alpha, R)
            result[lvl,] <- levelEst
          }
          #colnames(result) = names(quantile( v, probs=c(alpha/2, 0.5, 1-alpha/2)))
          colnames(result) = names(levelEst)
          ndigit <- options()$digits
          options(digits = 4)
          print(result)
          options(digits = ndigit)
          cat("\n\n")
          return(result)
        }
        estimate22.button <- tkbutton( frame22, text = "Оценка значения\nпараметра выборок",
                                       command = function(){
                                         dataList <- loadDataList( dataMatrix )
                                         if ( nchar(dataList$var)>0 ) {
                                           result <<- estimate22(dataList)
                                         }                                   
                                       } )
        tkpack(estimate22.button, fill="both")
      }
      tkpack(frame21, frame22,side="left", fill="both")
    }
    tkpack(frame1,frame2,side="left", fill="both")
  }
  tkpack( left.frame, main.frame, side="left", fill="both")
  info.label <- tklabel( down.frame, text = "information", foreground = "darkgrey", background = "white")
  #tkpack.forget(main.window, side="left")
  #tkpack( info.label, fill = "both")
  tkpack( up.frame, down.frame, fill = "both")
  tkfocus(main.window)
  #tkpack(main.window)
}

OntoParam()