Dear Aedin,
Answering your mail :
At 13:43 15/05/2003 +0100, vous avez écrit:
>Dear ADE4 List,
>Within ADE4 two output files are produced by DDutil: Supplementary Rows.
>Within R only one output file (the co-ordinates) is produced. How can I get
>the _tab file.
>Thank you,
>Aedin
indeed, there is a difference between the two versions and it will be
corrected in the next version.
You can use now, if you want, the following functions. They return a list
of two components - (1) 'tabsup' the modified array, (2) 'lisup' the array
of the supplementary row coordinates.
"suprow.coa" <- function (x, Xsup, ...) {
Xsup <- data.frame(Xsup)
if (!inherits(x, "dudi"))
stop("Object of class 'dudi' expected")
if (!inherits(x, "coa"))
stop("Object of class 'coa' expected")
if (!inherits(Xsup, "data.frame"))
stop("Xsup is not a data.frame")
if (ncol(Xsup) != ncol(x$tab))
stop("non convenient col numbers")
lwsup <- apply(Xsup, 1, sum)
lwsup[lwsup == 0] <- 1
Xsup <- sweep(Xsup, 1, lwsup, "/")
coosup <- as.matrix(Xsup) %*% as.matrix(x$c1)
coosup <- data.frame(coosup, row.names = row.names(Xsup))
names(coosup) <- names(x$li)
return(list(tabsup=Xsup, lisup=coosup))
}
"suprow.default" <- function (x, Xsup, ...) {
# modif pour Culhane, Aedin" <a.culhane@ucc.ie>
# suprow renvoie une liste à deux éléments tabsup et lisup
Xsup <- data.frame(Xsup)
if (!inherits(x, "dudi"))
stop("Object of class 'dudi' expected")
if (!inherits(Xsup, "data.frame"))
stop("Xsup is not a data.frame")
if (ncol(Xsup) != ncol(x$tab))
stop("non convenient col numbers")
coosup <- as.matrix(Xsup) %*% t(t(as.matrix(x$c1)) * x$cw)
coosup <- data.frame(coosup, row.names = row.names(Xsup))
names(coosup) <- names(x$li)
return(coosup)
return(list(tabsup=Xsup, lisup=coosup))
}
"suprow.pca" <- function (x, Xsup, ...) {
Xsup <- data.frame(Xsup)
if (!inherits(x, "dudi"))
stop("Object of class 'dudi' expected")
if (!inherits(x, "pca"))
stop("Object of class 'pca' expected")
if (!inherits(Xsup, "data.frame"))
stop("Xsup is not a data.frame")
if (ncol(Xsup) != ncol(x$tab))
stop("non convenient col numbers")
f1 <- function(w) (w - x$cent)/x$norm
Xsup <- t(apply(Xsup, 1, f1))
coosup <- as.matrix(Xsup) %*% as.matrix(x$c1)
coosup <- data.frame(coosup, row.names = row.names(Xsup))
names(coosup) <- names(x$li)
return(list(tabsup=Xsup, lisup=coosup))
}
You also asked this question :
"Culhane, Aedin" <a.culhane@ucc.ie> wrote :
>Is it possible to run row weighted COA within in R?
You can use the function :
"forrwcoa" <- function(df, rowweights = rep(1/nrow(df),nrow(df))){
if (!is.data.frame(df))
stop("data.frame expected")
if (any(rowweights <0)) stop ("negative entries in row weighting")
if (length(rowweights)!= nrow(df)) stop ("non convenient length for
'rowweights'")
lig <- nrow(df)
col <- ncol(df)
if (any(df < 0))
stop("negative entries in table")
if ((N <- sum(df)) == 0)
stop("all frequencies are zero")
df <- df/N
row.w <- apply(df, 1, sum)
df <- df/row.w
df <- df*rowweights
return(df)
}
To get the same result from COA: Row weighted COA, you can use:
forrwcoa(df, rowweights = rep(1/nrow(df), nrow(df))
where
df is a data frame
rowweights a weighting row vector (by default the uniform weighting)
The function returns a data frame which COA computes the required weighting.
Use 'dudi.coa' on this result.
example
library(ade4)
data(atlas)
coa1=dudi.coa(atlas$birds,scannf=F)
coa2=dudi.coa(forrwcoa(atlas$birds),scannf=F)
D. Chessel & A.B. Dufour
This archive was generated by hypermail 2b30 : Tue Sep 07 2004 - 13:45:22 MEST