1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
"procuste.rtest" <- function (df1, df2, nrepet = 99) {
if (!is.data.frame(df1))
stop("data.frame expected")
if (!is.data.frame(df2))
stop("data.frame expected")
l1 <- nrow(df1)
if (nrow(df2) != l1)
stop("Row numbers are different")
if (any(row.names(df2) != row.names(df1)))
stop("row names are different")
X <- scale(df1, scale = FALSE)
Y <- scale(df2, scale = FALSE)
var1 <- apply(X, 2, function(x) sum(x^2))
var2 <- apply(Y, 2, function(x) sum(x^2))
tra1 <- sum(var1)
tra2 <- sum(var2)
X <- X/sqrt(tra1)
Y <- Y/sqrt(tra2)
X <- as.matrix(X)
Y <- as.matrix(Y)
obs <- sum(svd(t(X) %*% Y)$d)
if (nrepet == 0)
return(obs)
perm <- matrix(0, nrow = nrepet, ncol = 1)
perm <- apply(perm, 1, function(x) sum(svd(t(X) %*% Y[sample(l1),
])$d))
w <- as.rtest(obs = obs, sim = perm, call = match.call())
return(w)
}
|
