fixed some issues for the nonparametric version

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: HRM
-Version: 0.9.0
-Date: 2018-02-14
+Version: 0.9.1
+Date: 2018-04-23
 Title: High-Dimensional Repeated Measures
 Authors@R: c(person("Martin Happ", role = c("aut", "cre"),
                       email = "[email protected]"),
@@ -13,8 +13,9 @@ Depends: R (>= 3.4.0), MASS, matrixcalc, plyr, ggplot2
 Imports: xtable, reshape2, tcltk, data.table, pracma
 Suggests: RGtk2 (>= 2.8.0), cairoDevice, RGtk2Extras
 Description: Methods for testing main and interaction effects in possibly
-    high-dimensional repeated measures in factorial designs. The observations
-    of the subjects are assumed to be multivariate normal.
+    high-dimensional parametric or nonparametric repeated measures in factorial designs.
+    The observations of the subjects are assumed to be multivariate normal if using the parametric test.
+    The nonparametric version tests with regard to nonparametric relative effects (based on pseudo-ranks).
     It is possible to use up to 2 whole- and 3 subplot factors.
 License: GPL-2 | GPL-3
 RoxygenNote: 6.0.1

NAMESPACE

@@ -10,7 +10,7 @@ importFrom("utils", "read.table", "write.table")
 importFrom("xtable", "xtable")
 importFrom("grDevices", "dev.new")
 importFrom("tcltk", "tkchooseDirectory","tkgetOpenFile" , "tclvalue")
-importFrom("data.table", "setDT", "rbindlist", "setnames", "as.data.table")
+importFrom("data.table", "setDT", "rbindlist", "setnames", "as.data.table", ":=")
 importFrom("pracma", "Lcm")
 S3method(print,HRM)
 S3method(summary,HRM)

R/Repeated.R

@@ -83,6 +83,7 @@ hrm.test.matrices <- function(data, alpha=0.05){
   output$subject <- NULL
   output$factors <- list(NULL, NULL)
   output$data <- data
+  output$nonparametric <- FALSE
   class(output) <- "HRM"
 
   return (output)

R/f2.R

@@ -79,60 +79,9 @@ hrm.1w.1f <- function(X, alpha, group , factor1, subject, data, H, text, nonpara
   } else {
     X <- ranked
   }
-
-  # group <- as.character(group)
-  # factor1 <- as.character(factor1)
-  # subject <- as.character(subject)
-  # X <- split(X, X[,group], drop=TRUE)
-  # a <- length(X)
-  # d <- nlevels(X[[1]][,factor1])
-  # c <- 1
-  # n <- rep(0,a) 
-  # 
-  # for(i in 1:a){
-  #   X[[i]] <- X[[i]][ order(X[[i]][,subject], X[[i]][,factor1]), ]
-  #   X[[i]]<-X[[i]][,data]
-  #   X[[i]] <- matrix(X[[i]],ncol=d*c,byrow=TRUE)
-  #   n[i] <- dim(X[[i]])[1]
-  # }
-
-  # dataOriginal <<- X
-  # 
-  # startR <- Sys.time()
-  # X <- pseudorank(X)
-  # endeR <<- Sys.time() - startR
-  # 
-  # dataRanks <<-  X
-
-  # print("orig")
-  # print( sum(var(X[[1]])[1,] ))
-  # 
-  # Y <- X[[1]]
-  # 
-  # for(i in 1:(n[1])){
-  #   Y[i,] <- Y[i,]-(sum(n)*d+1)/2
-  # }
-  # 
-  # print("centered")
-  # print(sum(var(Y)[1,] ))
-
 
-
-
-  # fehl <- rep(0,a)
-  # for(j in 1:1){
-  #   g1 <- rep(0, n[j])
-  #   for(i in 1:n[j]){
-  #     g1[i] <- sum((X[[j]][i,]-1/2)^2)^2
-  #   }
-  #   fehl[j] <- mean(g1)-matrix.trace(var(X[[j]]-1/2 ))^2 - 2*matrix.trace(var(X[[j]]-1/2)%*%var(X[[j]]-1/2) )
-  # }
-  # print("fehler")
-  # print(fehl[1])
-
-
   # creating X_bar (list with a entries)
-  X_bar <<- as.matrix(vec(sapply(X, colMeans, na.rm=TRUE))) #- (sum(n)*d+1)*1/2
+  X_bar <- as.matrix(vec(sapply(X, colMeans, na.rm=TRUE))) #- (sum(n)*d+1)*1/2
 
   if(H=="A"){
     K <- 1/d*J(d)
@@ -152,12 +101,6 @@ hrm.1w.1f <- function(X, alpha, group , factor1, subject, data, H, text, nonpara
   K_AB <- kronecker(S, K)
   V <- lapply(X, DualEmpirical2, B=K)
 
-  zaehler <<- t(X_bar)%*%K_AB%*%X_bar
-
-  sp1 <<- matrix.trace(V[[1]])
-  cov1 <<- t(X[[1]][1,])%*%(X[[1]][1,])
-  cov2 <<- t(X[[1]][2,])%*%(X[[1]][2,])
-
   ##########################
   ### U statistics
   #########################
@@ -169,82 +112,6 @@ hrm.1w.1f <- function(X, alpha, group , factor1, subject, data, H, text, nonpara
     }    
   }
 
-
-  # for(i in 1:n[1]){
-  #   j <- i + 1
-  #   while(j <= n[1]){
-  #     ii <- sample(setdiff(1:n[1],c(i,j)),1)
-  #     jj <- sample(setdiff(1:n[1],c(i,j,ii)),1)
-  #     Z1 <- K%*%(X[[1]][i,]- X[[1]][ii,] )
-  #     Z2 <- K%*%(X[[1]][j,]- X[[1]][jj,] )
-  #     # Z1 <- K%*%(X[[1]][i,]-colMeans(X[[1]]) )
-  #     # Z2 <- K%*%(X[[1]][j,]-colMeans(X[[1]]) )
-  #     Q2[1] <- Q2[1] + (t(Z1)%*%Z2)^2
-  #     Q1[1] <- Q1[1] + t(Z1)%*%Z1*t(Z2)%*%Z2
-  #     j <- j + 1
-  #   }
-  # }
-  #corr <- (n[1]^2-2*n[1]+2)/n[1]^2
-  # Q2[1] <- Q2[1]*2/(n[1]*(n[1]-1))*1/corr[1]^2
-  # Q1[1] <- Q1[1]*2/(n[1]*(n[1]-1))*1/corr[1]^2
-  # 
-  # for(i in 1:n[2]){
-  #   j <- i + 1
-  #   while(j <= n[2]){
-  #     ii <- sample(setdiff(1:n[2],c(i,j)),1)
-  #     jj <- sample(setdiff(1:n[2],c(i,j,ii)),1)
-  #     Z1 <- K%*%(X[[2]][i,]- X[[2]][ii,] )
-  #     Z2 <- K%*%(X[[2]][j,]- X[[2]][jj,] )
-  #     # Z1 <- K%*%(X[[2]][i,]-colMeans(X[[2]]) )
-  #     # Z2 <- K%*%(X[[2]][j,]-colMeans(X[[2]]) )
-  #     Q2[2] <- Q2[2] + (t(Z1)%*%Z2)^2
-  #     Q1[2] <- Q1[2] + t(Z1)%*%Z1*t(Z2)%*%Z2
-  #     j <- j + 1
-  #   }
-  # }
-  # #corr <- (n[2]^2-2*n[2]+2)/n[2]^2
-  # Q2[2] <- Q2[2]*2/(n[2]*(n[2]-1))*1/corr[2]^2
-  # Q1[2] <- Q1[2]*2/(n[2]*(n[2]-1))*1/corr[2]^2
-  # 
-  # for(i in 1:n[3]){
-  #   j <- i + 1
-  #   while(j <= n[1]){
-  #     ii <- sample(setdiff(1:n[3],c(i,j)),1)
-  #     jj <- sample(setdiff(1:n[3],c(i,j,ii)),1)
-  #     Z1 <- K%*%(X[[3]][i,]- X[[3]][ii,] )
-  #     Z2 <- K%*%(X[[3]][j,]- X[[3]][jj,] )
-  #     # Z1 <- K%*%(X[[3]][i,]-colMeans(X[[3]]) )
-  #     # Z2 <- K%*%(X[[3]][j,]-colMeans(X[[3]]) )
-  #     Q2[3] <- Q2[3] + (t(Z1)%*%Z2)^2
-  #     Q1[3] <- Q1[3] + t(Z1)%*%Z1*t(Z2)%*%Z2
-  #     j <- j + 1
-  #   }
-  # }
-  # #corr <- (n[3]^2-2*n[3]+2)/n[3]^2
-  # Q2[3] <- Q2[3]*2/(n[3]*(n[3]-1))*1/corr[3]^2
-  # Q1[3] <- Q1[3]*2/(n[3]*(n[3]-1))*1/corr[3]^2
-
-
-  # .E1 <- function(n,i, M) {
-  #   return (Q[i,1])
-  # }
-  # .E2 <- function(n,i, M) {
-  #   return (Q[i,2])
-  # }
-
-  # .E1 = function(n,i, M) {
-  #   return ((matrix.trace(M)^2))
-  # }
-  # .E2 = function(n,i, M) {
-  #   return ((matrix.trace(M%*%M)))
-  # }
-
-  # .E11 <- function(n,i, M) {
-  #   return ((n[i]*(n[i]-1))/((n[i]-2)*(n[i]+1))*(matrix.trace(M)^2-2/n[i]*matrix.trace(M%*%M)))
-  # }
-  # .E21 <- function(n,i, M) {
-  #   return ((n[i]-1)^2/((n[i]-2)*(n[i]+1))*(matrix.trace(M%*%M)-1/(n[i]-1)*matrix.trace(M)^2))
-  # }
 
   #################################################################################################