.packageName <- "mokken"
"check.data" <-
function(X){
   if (data.class(X) != "matrix" && data.class(X) != "data.frame")
     stop("Data are not matrix or data.frame")
    matrix.X <- as.matrix(X)
    if (is.na(any(X))) stop("Missing values are not allowed")
    if (any(mode(matrix.X)!="numeric")) stop("Data must be numeric")
    if (any(matrix.X) < 0) stop("Data should be positive")
    matrix.X <- matrix.X - min(matrix.X)
    return(matrix.X)
}
"check.monotonicity" <-
function(X, minvi = .03, minsize = default.minsize){

  X <- check.data(X)
  N <- nrow(X)
  J <- ncol(X)
  m <- max(X) + 1
  default.minsize <- ifelse(N > 500, floor(N/10), floor(N/5))
  default.minsize <- ifelse(N <= 250, floor(N/3), default.minsize)
  default.minsize <- ifelse(N <  150, 50, default.minsize)

  if (N < minsize) stop("Sample size less than Minsize")

  # Initial computation
  R <- as.matrix(X) %*% (matrix(1,J,J) - diag(J))
  results <- list()
  # results checks per item
  I.labels <- dimnames(X)[[2]]
  if(length(I.labels)==0) I.labels <- paste("C",1:ncol(X))
  for (j in 1:J){
    violation.matrix <- matrix(0,nrow=m,ncol=10)
    dimnames(violation.matrix) <- list(c(paste("P(X >=",1:(m-1),")",sep=""),"Total"), dimnames(violation.matrix)[[2]] <- c("#ac","#vi","#vi/#ac","maxvi","sum","sum/#ac","zmax","group","group","#zsig"))
    results[[j]] <- list()
    results[[j]][1] <- I.labels[j]
    sorted.R <- sort(R[,j])
    group <- max(which(sorted.R==sorted.R[minsize]))
    repeat{
      if(N - max(group) < minsize)break
      group <- c(group,max(which(sorted.R==sorted.R[minsize+max(group)])))
    }
    group <- group[-length(group)]
    summary.matrix <- matrix(nrow = length(group)+1,ncol = 4 + 2* m)
    dimnames(summary.matrix)[[2]] <- c("Group", "Lo Score", "Hi Score", "N", paste("F",0:(m-1)), "Mean", paste("P(X >=",1:(m-1),")",sep=""))
    summary.matrix[,1] <- 1:nrow(summary.matrix)
    summary.matrix[,4] <- c(group,N) - c(0,group)
    group <- c(sorted.R[group],max(sorted.R))
    L <- length(group)
    summary.matrix[,3] <- group
    summary.matrix[,2] <- c(min(sorted.R),group[-L]+1)

    member <- apply(1 - outer(R[,j], group, "<="),1,sum) + 1
    for (i in 1:L){
      Ni <- summary.matrix[i,4]
      freq <- tabulate(X[member==i,j]+1,m)
      summary.matrix[i,5:(m+4)] <- freq
      summary.matrix[i,m+5] <- sum(freq * min(X):max(X)) / Ni
      cum.freq <- rev(cumsum(rev(freq))/Ni)
      summary.matrix[i,(m+6):(2*m+4)] <- cum.freq[2:m]
    }
    results[[j]][[2]] <- summary.matrix
    violation.matrix[1:(m-1),1] <- L*(L-1)*.5
    violation.matrix[m,1] <- L*(L-1)*.5 * (m-1)

    freq <- summary.matrix[,5:(m+4)]
    for (i in 1:(m-1)){
      V <- outer(summary.matrix[,(m+5+i)],summary.matrix[,(m+5+i)],"-")
      V[row(V) <= col(V)] <- 0
      V[V >= -minvi] <- 0
      violation.matrix[i,2] <- sum(ceiling(abs(V)))
      violation.matrix[i,4] <- max(abs(V))
      if(violation.matrix[i,4] > minvi){
        violation.matrix[i,5] <- sum(abs(V))
        freqd <- cbind(apply(as.matrix(freq[,1:i]),1,sum), apply(as.matrix(freq[,(i+1):m]),1,sum))
        Z <- abs(sign(-V) * 2 * (sqrt(outer(freqd[,2]+1,freqd[,1]+1)) - sqrt(outer(freqd[,1],freqd[,2]))) /
              sqrt(outer(freqd[,2],freqd[,1],"+") + outer(freqd[,1],freqd[,2],"+")))
        violation.matrix[i,7] <- max(Z)
        violation.matrix[i,8] <- col(Z)[Z==max(Z)]
        violation.matrix[i,9] <- row(Z)[Z==max(Z)]
        violation.matrix[i,10] <- sum(sign(Z[Z > 1.6449]))
      }
    }
    violation.matrix[m,2] <- sum(violation.matrix[1:(m-1),2])
    violation.matrix[1:m,3] <- violation.matrix[1:m,2]/violation.matrix[1:m,1]
    violation.matrix[m,4] <- max(violation.matrix[1:(m-1),4])
    violation.matrix[m,5] <- sum(violation.matrix[1:(m-1),5])
    violation.matrix[1:m,6] <- violation.matrix[1:m,5]/violation.matrix[1:m,1]
    violation.matrix[m,7] <- max(violation.matrix[1:(m-1),7])
    violation.matrix[m,10] <- sum(violation.matrix[1:(m-1),10])
    results[[j]][[3]] <- violation.matrix
    results[[j]][[4]] <- paste("Minsize = ",minsize," Minvi = ",minvi,sep="")

  }
 Hi <- coefH(X)$Hi
 monotonicity.list <- list(results=results,I.labels=I.labels,Hi=Hi,m=m)
 class(monotonicity.list) <- "monotonicity.class"
 return(monotonicity.list)
}

"check.pmatrix" <-
function(X, minvi = .03){

   compute.pmatrix <- function(X,P1,N,J,m){
      label <- as.vector(t(outer(paste("P(X",1:J,">=",sep=""),paste(1:(m-1),")",sep=""), paste, sep="")))
      Pmm <- Ppp <- matrix(0,J*(m-1),J*(m-1))
      i <- 0
      j <- 0
      for(i in 1:(J-1)){
         for(j in (i+1):J){
            Ppp[((i-1)*(m-1)+1):((i-1)*(m-1)+(m-1)),((j-1)*(m-1)+1):((j-1)*(m-1)+(m-1))] <-
            t(outer(X[,i],0:(m-2),">")) %*% outer(X[,j],0:(m-2),">")/N
            Pmm[((i-1)*(m-1)+1):((i-1)*(m-1)+(m-1)),((j-1)*(m-1)+1):((j-1)*(m-1)+(m-1))] <-
            t(outer(X[,i],0:(m-2),"<=")) %*% outer(X[,j],0:(m-2),"<=")/N
         }
      }
      Ppp <- Ppp + t(Ppp) + kronecker(diag(J),matrix(-1,m-1,m-1))
      Pmm <- Pmm + t(Pmm) + kronecker(diag(J),matrix(-1,m-1,m-1))
      Ppp[Ppp < -.5] <- NA
      Pmm[Pmm < -.5] <- NA
      dimnames(Ppp) <- dimnames(Pmm) <- list(label,label)
      Ppp <- Ppp[order(P1),order(P1)]
      Pmm <- Pmm[order(P1),order(P1)]
      return(list(Ppp=Ppp,Pmm=Pmm))
   }

  X <- check.data(X)
  J <- ncol(X)
  N <- nrow(X)
  m <- max(X) + 1
  P1 <- matrix(t(apply(outer(as.matrix(X), 1:(m-1), ">=")*1,c(2,3),mean)),nrow=(m-1)*J)
  I.item <- rep(1:J,each=m-1)[order(P1)]
  I.step <- as.vector(t(outer(paste("X",1:J,">=",sep=""),paste(1:(m-1),sep=""), paste, sep="")))[order(P1)]
  I.labels <- dimnames(X)[[2]]
  if(length(I.labels)==0) I.labels <- paste("C",1:ncol(X))

  P2 <- compute.pmatrix(X,P1,N,J,m)
  Pmm <- P2$Pmm
  Ppp <- P2$Ppp
  Hi <- coefH(X)$Hi
  pmatrix.list <- list(Ppp=Ppp,Pmm=Pmm, I.item=I.item, I.step=I.step, I.labels=I.labels, Hi=Hi, minvi=minvi)
  class(pmatrix.list) <- "pmatrix.class"  
  return(pmatrix.list)
  }

"check.restscore" <-
function(X, minvi = .03, minsize = default.minsize){

  X <- check.data(X)
  J <- ncol(X)
  N <- nrow(X)
  m <- max(X) + 1
  I.labels <- dimnames(X)[[2]]
  if(length(I.labels)==0) I.labels <- paste("C",1:ncol(X))
  default.minsize <- ifelse(N > 500, floor(N/10), floor(N/5))
  default.minsize <- ifelse(N <= 250, floor(N/3), default.minsize)
  default.minsize <- ifelse(N <  150, 50, default.minsize)

  # Is the sample size large enough?
  if (N < minsize) stop("Sample size less than Minsize")

  # Are there enough items?
  if (J < 3) stop("Less than 3 items. Restscore cannot be computed")

  # Initial computation
  results <- list()
  g <- 0; gg <- 0; h <- 0; i <- 0; j <- 0; k <- 0
  # Non-intersection checks per item
  for (i in 1:(J-1)){
    R <- as.matrix(X) %*% (matrix(1,J,J) - diag(J)) - X[,i]
    R[,i] <- 0
    for (j in (i+1):J){
      k <- k + 1
      rvm <- (m-1)*(m-1)+2
      violation.matrix <- matrix(0,nrow=rvm,ncol=8)
      dimnames(violation.matrix) <-  list(
       c(t(outer(paste("P(X",i,">=",1:(m-1),")",sep=""),paste("P(X",j,">=",1:(m-1),")",sep=""),paste)),paste("E(X",i,") E(X",j,")", sep=""),"Total"),
       c("#ac","#vi","#vi/#ac","maxvi","sum","sum/#ac","zmax","#zsig"))
      results[[k]] <- list()
      results[[k]][[1]] <- list()
      results[[k]][[1]][1] <- I.labels[i]
      results[[k]][[1]][2] <- I.labels[j]
      sorted.R <- sort(R[,j])
      group <- max(which(sorted.R==sorted.R[minsize]))
      repeat{
        if(N - max(group) < minsize)break
        group <- c(group,max(which(sorted.R==sorted.R[minsize+max(group)])))
      }
      group <- group[-length(group)]

      summary.matrix <- matrix(nrow = length(group)+1,ncol = 6 + 2*(m-1))
      dimnames(summary.matrix)[[2]] <- c("Group", "Lo", "Hi", "N", paste("E(X",i,")",sep=""), paste("E(X",j,")",sep=""), paste("P(X",i,">=",1:(m-1),")",sep=""), paste("P(X",j,">=",1:(m-1),")",sep=""))
      summary.matrix[,1] <- 1:nrow(summary.matrix)
      summary.matrix[,4] <- c(group,N) - c(0,group)
      group <- c(sorted.R[group],max(sorted.R))
      L <- length(group)
      summary.matrix[,3] <- group
      summary.matrix[,2] <- c(min(sorted.R),group[-L]+1)
      member <- apply(1 - outer(R[,j], group, "<="),1,sum) + 1



      for (g in 1:L){
        Ng <- summary.matrix[g,4]
        summary.matrix[g,5] <- mean(X[member==g,i])
        summary.matrix[g,6] <- mean(X[member==g,j])
        freqi <- tabulate(X[member==g,i]+1,m)
        freqj <- tabulate(X[member==g,j]+1,m)
        cum.freqi <- rev(cumsum(rev(freqi))/Ng)
        cum.freqj <- rev(cumsum(rev(freqj))/Ng)
        summary.matrix[g,7:(5+m)] <- cum.freqi[2:m]
        summary.matrix[g,(6+m):(4+2*m)] <- cum.freqj[2:m]
      }
      results[[k]][[2]] <- summary.matrix

      ac <- violation.matrix[1:(rvm-1),1] <- L-1
#      for (g in 1:(m-1)) for (h in 1:(m-1)){
#         violation.matrix[(g-1)*(m-1)+h,2:8] <- compute.violations(summary.matrix[,6+g],summary.matrix[,5+m+h],L-1,minvi)
#      }  
      
      for (g in 1:(m-1)) for (h in 1:(m-1)){
        p.1 <- summary.matrix[,6+g]
        p.2 <- summary.matrix[,5+m+h]
        n <- summary.matrix[,4]
        if(sum(n*p.1) >  sum(n*p.2)) d <- p.2-p.1
        if(sum(n*p.1) <= sum(n*p.2)) d <- p.1-p.2
        d[d <= minvi] <- 0
        vi <- length(d[d > minvi/2])
        sum.vi <- sum(d)
        z <- rep(0,L-1)
        if(any(d > 0)){
           for (gg in 1:L){
              if(d[gg] > 0){
                 Xgg <-  X[member==gg,]
                 f.01 <- length(Xgg[Xgg[,i] >= g & Xgg[,j] <  h])/J
                 f.10 <- length(Xgg[Xgg[,i] <  g & Xgg[,j] >= h])/J
                 f.k <- min(f.01,f.10); f.n <- f.01 + f.10; f.b <- ((2 * f.k + 1 - f.n)^2 - 10 * f.n) /(12 * f.n)
                 z[gg] <- abs(sqrt(2*f.k + 2 + f.b) - sqrt(2*f.n-2*f.k+f.b))          
              }  
           }
        }        
        violation.matrix[(g-1)*(m-1)+h,2:8] <- c(vi,vi/(L-1),max(d),sum.vi,sum.vi/ac,max(z),length(z[abs(z) > qnorm(.95)]))
      }  

#     violation.matrix[(rvm-1),2:8] <- compute.violations(,summary.matrix[,6],L-1,minvi)
      if(sum(summary.matrix[,5]) > sum(summary.matrix[,6])) d <- summary.matrix[,6]-summary.matrix[,5]
      if(sum(summary.matrix[,5]) <= sum(summary.matrix[,6])) d <- summary.matrix[,5]-summary.matrix[,6]
      d[d <= minvi] <- 0
      vi <- length(d[d > minvi/2])
      sum.vi <- sum(d)
      violation.matrix[(rvm-1),2:8] <- c(vi,vi/ac,max(d),sum.vi,sum.vi/ac,NA,NA)

      if(rvm > 3){
         violation.matrix[rvm,c(1,2,5,8)] <- apply(violation.matrix[1:(rvm-2),c(1,2,5,8)],2,sum)
         violation.matrix[rvm,c(4,7)] <- apply(violation.matrix[1:(rvm-2),c(4,7)],2,max)
      }else{
         violation.matrix[rvm,c(1,2,4,5,7,8)] <- violation.matrix[1,c(1,2,4,5,7,8)]
      }
      violation.matrix[rvm,3] <- violation.matrix[rvm,2]/violation.matrix[rvm,1]
      violation.matrix[rvm,6] <- violation.matrix[rvm,5]/violation.matrix[rvm,1]
      results[[k]][[3]] <- violation.matrix
   }
 }
 Hi <- coefH(X)$Hi
 restscore.list <- list(results=results,I.labels=I.labels,Hi=Hi,m=m)
 class(restscore.list) <- "restscore.class"
 return(restscore.list)
}

"coefH" <-
function(X){
    X <- check.data(X)
    S <- var(X)
    Smax <- var(apply(X, 2, sort))
    Hij <- S/Smax
    diag(S) <- 0
    diag(Smax) <- 0
    Hi <- apply(S, 1, sum)/apply(Smax, 1, sum)
    H <- sum(S)/sum(Smax)
    return(list(Hij=Hij,Hi=Hi,H=H))
}

"coefZ" <-
function(X){
    X <- check.data(X)
    N <- nrow(X)
    S <- var(X)
    Sij <- outer(apply(X,2,var),apply(X,2,var),"*")
    Zij <- (S * sqrt(N-1))/sqrt(Sij)
    diag(S) <- diag(Sij) <- diag(Zij) <- 0
    Zi <- (apply(S,1,sum) * sqrt(N-1))/ sqrt(apply(Sij,1,sum))       
    Z  <- (sum(S)/2 * sqrt(N-1))/ sqrt(sum(Sij)/2)
    return(list(Zij=Zij,Zi=Zi,Z=Z))
}

"plot.monotonicity.class" <-
function(x, items = all, ...){
  results <- x$results
  m <- x$m
  all <- 1:length(x$I.labels)
  i <- 0; j <- 0
  for (j in items){
    plot.matrix <- results[[j]][[2]]
    x.labels <- paste(plot.matrix[,2],"-",plot.matrix[,3],sep="")
    par("ask"=TRUE)
    plot(plot.matrix[,1],plot.matrix[,m+5]/(m-1),
      ylim=c(0,1),
      xaxt = 'n',
      xlab = "Rest score group",
      ylab = "Item rest function",
      type = "l", 
      lwd=3)
    title(results[[j]][[1]])
    axis(1, at=1:nrow(plot.matrix),labels=x.labels)
    for(i in 2:m){
     lines(plot.matrix[,1],plot.matrix[,(m+4+i)], col=4, lwd=2,lty=3)
    }
  }
 invisible()
}


"plot.pmatrix.class" <-
function(x, items = all, pmatrix = "both", ...){
  all <- 1:max(x$I.item)
  m <- length(x$I.item)/max(x$I.item)
  j <- 1; i <- 1
  #
  if (pmatrix == "both" || pmatrix == "ppp"){
    I.item <- x$I.item
    I.step <- x$I.step
    plot.matrix <- x$Ppp
    for (j in items){
       plot.matrix.j <- plot.matrix[I.item==j,I.item!=j]
       if(!is.matrix(plot.matrix.j)) plot.matrix.j <- t(as.matrix(plot.matrix.j))
       I.step.j <- I.step[I.item!=j]
       x.axis <- length(I.step.j)
       par("ask"=TRUE)
       plot(1:x.axis,plot.matrix.j[1,],
         ylim=c(0,1),
         xlim=c(1,x.axis),
         xaxt = 'n',
         xlab = "ordered item steps",
         ylab = paste("P(X",j," >= x, item step)",sep=""),
         type = "n", lwd=3)
       title(paste("P(++) matrix: ", x$I.labels[[j]]))
       if (x.axis < 10) axis(1, at=1:x.axis,labels=I.step.j) else axis(1, at=1:x.axis,labels=rep("",x.axis))
       for(i in 1:m) lines(1:x.axis,plot.matrix.j[i,], col=4, lwd=2)
     }
  }
  if (pmatrix == "both" || pmatrix == "pmm"){
    I.item <- x$I.item
    I.step <- x$I.step
    plot.matrix <- x$Pmm
    for (j in items){
       plot.matrix.j <- plot.matrix[I.item==j,I.item!=j]
       I.step.j <- I.step[I.item!=j]
       x.axis <- length(I.step.j)
       plot(1:x.axis,plot.matrix.j[1,],
         ylim=c(0,1),
         xlim=c(1,x.axis),
         xaxt = 'n',
         xlab = "ordered item steps",
         ylab = paste("P(X",j," < x| item step)",sep=""),
         type = "n", lwd=3)
       title(paste("P(--) matrix: ", x$I.labels[[j]]))
       if (x.axis < 10) axis(1, at=1:x.axis,labels=I.step.j) else axis(1, at=1:x.axis,labels=rep("",x.axis))
       for(i in 1:m) lines(1:x.axis,plot.matrix.j[i,], col=4, lwd=2)
     }
  }
 invisible()
}

"plot.restscore.class" <-
function(x, item.pairs = all, ...){
  J <- length(x$Hi)
  max.item.pairs <- J*(J-1)/2
  all <- 1:max.item.pairs
  j <- 0; i <- 0
  results <- x$results
  m <- x$m
  for (j in item.pairs){
    plot.matrix <- results[[j]][[2]]
    x.labels <- paste(plot.matrix[,2],"-",plot.matrix[,3],sep="")
    par("ask"=TRUE)
    plot(plot.matrix[,1],plot.matrix[,5]/m,
      ylim=c(0,1),
      xaxt = 'n',
      xlab = "Rest score group",
      ylab = "Item rest function",
      type = "n", lwd=3)
    lines(plot.matrix[,1],plot.matrix[,5]/m, lwd=5, lty=1)
    lines(plot.matrix[,1],plot.matrix[,6]/m, lwd=5, lty=3)
    title(paste(results[[j]][[1]][1],"(solid)",results[[j]][[1]][2],"(dashed)"))
    axis(1, at=1:nrow(plot.matrix),labels=x.labels)
    for(i in 1:(m-1)){
     lines(plot.matrix[,1],plot.matrix[,(6+i)], col=4, lwd=2)
     lines(plot.matrix[,1],plot.matrix[,(6+(m-1)+i)], col=4, lwd=2, lty=3)
    }
  }
 invisible()
}

"search.normal" <-
function(X, lowerbound =.3, alpha = .05 ){

   # Internal functions
   
   any.neg <- function(x){if(any(x < 0))T else F}

   adjusted.alpha <- function(alpha, K) alpha/(K[1]*(K[1]-1)*.5 + sum(K[-1]))

   fitstring <- function(string.arg,length.arg) substr(paste(string.arg,"                        "),1,length.arg)
   
   newH <- function(j,in.this.set, x, lowerbound, Z.c){

     newX <- cbind(x[,in.this.set==1],x[,j])
     H.list <- coefH(newX)
     if (H.list$Hi[length(H.list$Hi)] < lowerbound) return(-98) # less than lower bound
     Zi <- coefZ(newX)$Zi
     if (Zi[length(Zi)] < Z.c) return(-97)                      # not significant
     return(H.list$H)
   }

   # initial calculations
   
   X <- check.data(X)
   item.label <- dimnames(X)[[2]]
   N <- nrow(X)
   S <- var(X)

   if(any(is.na(diag(S/S)))) stop("At least one item has no variance")

   Smax <- var(apply(X,2,sort))
   Hij <- S/Smax
   Sij <- outer(apply(X,2,var),apply(X,2,var),"*")
   Zij <- (S * sqrt(N-1))/sqrt(Sij)

   J <- nrow(Hij)
   result <- rep(-99,J);
   j <- 0
   InSet <- rep(0,J)
   scale <- 0

   # start scaling
   repeat{
     scale <- scale + 1
     step <- 1
     K <- rep(0,J)

     cat("",fill=T)
     cat("SCALE",scale,fill=T)
     cat("",fill=T)

     # Are there two items left?
     if(length(InSet[InSet==0]) < 2){
       cat("Less than two items left. PROCEDURE STOPS",fill=T)
       break
     }

     # Compute the critical value for Zij 
     
     K[step] <- length(InSet[InSet == 0])
     Z.c <- abs(qnorm(adjusted.alpha(alpha,K)))

     # Select the first two items

     Hselect <- Hij
     Hselect[abs(Zij) < Z.c] <- -99
     Hselect[InSet > 0 & InSet < scale,] <- -99
     Hselect[,InSet > 0 & InSet < scale] <- -99
     Hselect[col(Hselect) >= row(Hselect)] <- -99
     first.item <- row(Hselect)[Hselect==max(Hselect)]
     second.item <- col(Hselect)[Hselect==max(Hselect)]
     maxHij <- Hij[first.item,second.item]



     # Check if H of two item-scale is greater than c
     if(maxHij < lowerbound){
       cat("Scale ", scale," could not be formed due to H < ",lowerbound,". PROCEDURE STOPS",fill=T)
       break
     }


     # Add the first two items to the scale
     cat("Item: ",fitstring(item.label[first.item],20)," Scale", scale," H = ",round(maxHij,2),fill=T)
     cat("Item: ",fitstring(item.label[second.item],20)," Scale", scale," H = ",round(maxHij,2),fill=T)
     InSet[first.item] <- scale
     InSet[second.item] <- scale

     # Adding new items
     repeat{
       step <- step + 1

       # exclude items from previous scales
       in.this.set <- InSet
       in.this.set <- ifelse(InSet == scale, 1,0)
       in.this.set <- ifelse(InSet <  scale & InSet > 0,-1,in.this.set)

       # exclude items having a negative covariance with the already selected items
       neg1 <- apply(Hij[in.this.set==1,],2,any.neg)
       neg2 <- apply(Hij[,in.this.set==1],1,any.neg)
       in.this.set[neg1|neg2 & in.this.set==0] <- -1

       # Are there items left after the exclusion?
       available.items <- which(in.this.set==0)
       if(length(available.items)==0){
         cat("Scale ", scale," is completed. No items left with Hij => 0",fill=T)
         break
       }

       # Compute H and Hi of potentially new items
       result[in.this.set!=0] <- -99  # items already selected in other scales
       K[step] <- length(available.items)
       Z.c <- abs(qnorm(adjusted.alpha(alpha,K)))
       for (j in available.items) result[j] <- newH(j,in.this.set, X, lowerbound, Z.c)


       # Is maximum value Hi greater than c?
       if(max(result) < lowerbound){
         cat("Scale ", scale," is completed. No items left such that Hi > ",lowerbound,".",fill=T)
         break
       }

       # Add the newly selected item to the scale
       new.item <- row(as.matrix(result))[result==max(result)]
       InSet[new.item] <- scale
       cat("Item: ",fitstring(item.label[new.item],20)," Scale", scale," H = ",round(max(result),2),fill=T)
     }
  # start with next scale
  }
  InSet <- as.matrix(InSet)
  dimnames(InSet) <- list(item.label,"Scale")
  return(InSet)
}

"summary.monotonicity.class" <-
function(object, ...){
   results <- object$results
   I.labels <- object$I.labels
   Hi <- object$Hi
   m <- object$m
   J <- length(results)
   j <- 0
   summary.matrix <- matrix(nrow=J,ncol=9)
   dimnames(summary.matrix) <- list(I.labels,c("ItemH","#ac","#vi","#vi/#ac","maxvi","sum","sum/#ac","zmax","#zsig"))
   summary.matrix[,1] <- Hi
   for (j in 1:J) summary.matrix[j,2:9] <- results[[j]][[3]][m,c(1:7,10)]
   return(round(summary.matrix,2))
}

"summary.pmatrix.class" <-
function(object, ...){

  ppp.vi. <- function(X){
    i <- 0
    nr.vi <- 0
    for (i in 1: nrow(X)){
      x <- X[i,]
      z <- outer(x,x, function(x,y,criterion){x-y > criterion},criterion=minvi)
      z[is.na(z)] <- F
      z[row(z) >= col(z)] <- F 
      nr.vi <- nr.vi + sum(z)
    }
   return(nr.vi) 
  }  

  pmm.vi. <- function(X){
    i <- 0
    nr.vi <- 0
    for (i in 1: nrow(X)){
      x <- X[i,]
      z <- outer(x,x, function(x,y,criterion){x-y < -criterion},criterion=minvi)
      z[is.na(z)] <- F
      z[row(z) >= col(z)] <- F 
      nr.vi <- nr.vi + sum(z)
    }
   return(nr.vi) 
  }  

  ppp.vi.. <- function(X,minvi){
    i <- 0
    max.vi <- 0
    sum.vi <- 0
    for (i in 1: nrow(X)){
      x <- outer(X[i,],X[i,],"-")
      x <- x[row(x) < col(x)]
      max.vi <- max(max.vi,max(x))
      sum.vi <- sum(sum.vi,sum(x[x > minvi]))
    }
  return(list(max.vi=max.vi,sum.vi=sum.vi)) 
  }    

  pmm.vi.. <- function(X,minvi){
    i <- 0
    max.vi <- 0
    sum.vi <- 0
    for (i in 1: nrow(X)){
      x <- outer(X[i,],X[i,],"-")
      x <- x[row(x) > col(x)]
      max.vi <- max(max.vi,max(x))
      sum.vi <- sum(sum.vi,sum(x[x > minvi]))
    }
  return(list(max.vi=max.vi,sum.vi=sum.vi)) 
  }    

  minvi <- object$minvi 
  J <- max(object$I.item)

  ppp.summary.matrix <- matrix(nrow=J,ncol=7)
  dimnames(ppp.summary.matrix) <- list(object$I.labels,c("ItemH","#ac","#vi","#vi/#ac","maxvi","sum","sum/#ac"))
  ppp.summary.matrix[,1] <- round(object$Hi,2) 
  Ppp <- object$Ppp
  I.item <- object$I.item
  items <- 1:max(I.item)
  j <- 1
  for (j in items){
     Ppp.j <- Ppp[I.item==j,I.item!=j] 
     if(!is.matrix(Ppp.j)) Ppp.j <- t(as.matrix(Ppp.j))
     ppp.summary.matrix[j,2] <- length(Ppp.j) # ac
     ppp.summary.matrix[j,3] <- ppp.vi.(Ppp.j)
     tmp <- ppp.vi..(Ppp.j,minvi)
     ppp.summary.matrix[j,5] <- ifelse(tmp$max.vi > minvi,round(tmp$max.vi,2),0)
     ppp.summary.matrix[j,6] <- round(tmp$sum.vi,2)
  }     
  ppp.summary.matrix[,4] <- round(ppp.summary.matrix[,5]/ppp.summary.matrix[,2],3)    
  ppp.summary.matrix[,7] <- round(ppp.summary.matrix[,6]/ppp.summary.matrix[,2],3)    
  
  pmm.summary.matrix <- matrix(nrow=J,ncol=7)
  dimnames(pmm.summary.matrix) <- list(object$I.labels,c("ItemH","#ac","#vi","#vi/#ac","maxvi","sum","sum/#ac"))
  pmm.summary.matrix[,1] <- round(object$Hi,2) 
  Pmm <- object$Pmm
  I.item <- object$I.item
  items <- 1:max(I.item)
  j <- 1
  for (j in items){
     Pmm.j <- Pmm[I.item==j,I.item!=j] 
     if(!is.matrix(Pmm.j)) Pmm.j <- t(as.matrix(Pmm.j))
     pmm.summary.matrix[j,2] <- length(Pmm.j) # ac
     pmm.summary.matrix[j,3] <- pmm.vi.(Pmm.j)
     tmp <- pmm.vi..(Pmm.j,minvi)
     pmm.summary.matrix[j,5] <- ifelse(tmp$max.vi > minvi,round(tmp$max.vi,2),0)
     pmm.summary.matrix[j,6] <- round(tmp$sum.vi,2)
  }     
  pmm.summary.matrix[,4] <- round(pmm.summary.matrix[,5]/pmm.summary.matrix[,2],3)    
  pmm.summary.matrix[,7] <- round(pmm.summary.matrix[,6]/pmm.summary.matrix[,2],3)    
  
  return(list(ppp.summary.matrix=ppp.summary.matrix,pmm.summary.matrix=pmm.summary.matrix))  
}

"summary.restscore.class" <-
function(object, ...){
   results <- object$results
   Hi <- object$Hi
   J <- length(Hi)
   m <- object$m
   I.labels <- object$I.labels
   summary.matrix <- matrix(0,nrow=J,ncol=9)
   dimnames(summary.matrix) <- list(I.labels,c("ItemH","#ac","#vi","#vi/#ac","maxvi","sum","sum/#ac","zmax","#zsig"))
   summary.matrix[,1] <- round(Hi,2)
   rvm <- (m-1)*(m-1)+2
   k <- 0; i <- 0; j <- 0
   for(i in 1:(J-1)){for(j in (i+1):J){
     k <- k+1
     summary.matrix[i,c(2,3,6,9)] <- summary.matrix[i,c(2,3,6,9)] + results[[k]][[3]][rvm,c(1,2,5,8)]
     summary.matrix[j,c(2,3,6,9)] <- summary.matrix[j,c(2,3,6,9)] + results[[k]][[3]][rvm,c(1,2,5,8)]
     summary.matrix[i,c(5)] <- max(summary.matrix[i,c(5)], results[[k]][[3]][rvm,c(4)])
     summary.matrix[j,c(5)] <- max(summary.matrix[j,c(5)], results[[k]][[3]][rvm,c(4)])
     summary.matrix[i,c(8)] <- max(summary.matrix[i,c(8)], results[[k]][[3]][rvm,c(7)])
     summary.matrix[j,c(8)] <- max(summary.matrix[j,c(8)], results[[k]][[3]][rvm,c(7)])
   }}
   summary.matrix[,4] <- summary.matrix[,3]/summary.matrix[,2]
   summary.matrix[,7] <- summary.matrix[,6]/summary.matrix[,2]
   return(round(summary.matrix,2))
}

