# Re: Another question: Correlation ratios of fuzzy traits with RLQ axes

Date: Mon Oct 04 2004 - 17:31:22 MEST

• Next message: Fabiana Castellarini: "(no subject)"

Hi,

I have a function ‘delta.disper’ which compute the dispersion index (delta
of Ter Braak 1987) for a fuzzy variable (one trait) proposed by Chevenet et
al. (1994, page 301).

This “dispersion index is the ratio of the variance of the weighted average
of the species of the total variance” (In Fuzzy coding and external
information, page 301).

Arguments of delta.disper:
df a fuzzy variable
w a data.frame of score or a vector score
z to select a column of w (if w is a data.frame)

I think that this function maybe use to compute the correlation ratio
between one trait and the score of RLQ analysis.

Ter Braak C. J. F. (1987) The analysis of vegetation-environment
relationships by canonical correspondence analysis. Vegetatio, 69, 69-77.

Chevenet F., Dolédec S. & Chessel D. (1994)A fuzzy coding approach for the
analysis of long-term ecological data. Freshwater Biology, 31, 295-309.

#--------------------------
# for one trait
#-----------------
# w a data.frame containing the habitat score (length = s).
# z select a column of the w.
# df a data.frame containing the affinity of species for the s habitats
# (one trait).

#----------------------------------------------------
# first example
#----------------------------------------------------

data(bsetal97)
w2 <- prep.fuzzy.var(bsetal97\$ecol, bsetal97\$ecol.blo)
# Warning ! we consider only one trait !
w4 <- prep.fuzzy.var(w2[,1:7], bsetal97\$ecol.blo[1])
d4 <- dudi.fca(w4,scannf=F,nf=4)
d4\$cr
# RS1 RS2 RS3 RS4
# FV1 0.8877 0.8268 0.7283 0.6782

delta.disper(w4,d4\$co,z=1)
# [1] 0.8877

delta.disper(w4,d4\$co,z=2)
# [1] 0.8268

#----------------------------------------------------
# second example: Chevent et al. 1994
# data ‘coleop+1’ in the MetaCard version (“EM.car”).
# source("C:/.../delta.disper.R")
#----------------------------------------------------

habf <- apply(coleo,1,function(x)x/sum(x))
habf <- as.data.frame(t(habf))
wscore <- 1:9
delta1 <- delta.disper(df=habf,w=wscore)
delta1
#[1] 0.2824

deltatest <- delta.rtest(delta1,nrepet=99)
deltatest
# Monte-Carlo test
# Observation: 0.2824
# Call: delta.rtest(delta = delta1, nrepet = 99)
# Based on 99 replicates
# Simulated p-value: 0.01
plot(deltatest)

hope this helps

Appendix : functions 'delta.disper'

delta.disper <- function(df,w,z=NULL)
{
if (!inherits(df, "data.frame"))
stop("object 'data.frame' expected")
if (any(df < 0))
stop("Negative value in df")
if(inherits(w, "data.frame")){
if(is.null(z)){
cat("choose a variable of w:\n")
for(i in 1:2)
cat(i," = ",names(w)[i],"\n")
cat("...\n")
cat("Select an integer (1-",ncol(w),"): ")
}
w <- w[,z]
}
vart <-nrow(df)
vars <-ncol(df)
fbar <- unlist(apply(df,2,mean))
wbar <- sum(fbar*w)
wo <- (w-wbar)
xi <- unlist(apply(t(t(df)*wo),1,sum))
delta <- (sum(xi*xi)/vart)/sum(fbar*wo*wo)
attributes(delta)\$df <-df
attributes(delta)\$w <-w
class(delta)<- c("delta",class(delta))
return(delta)
}
print.delta <-function(x,...){
print(as.numeric(x))
}
delta.rtest <- function(delta,nrepet=99)
{
# chevenet et al. 1994
if (!inherits(delta, "delta"))
stop("object 'delta' expected")
perm <- matrix(0, nrow = nrepet, ncol = 1)
w1 <- attributes(delta)\$w
df1 <- attributes(delta)\$df
nl <- nrow(df1)
nc <- ncol(df1)
f1 <- function(df,w){
vart <-nrow(df)
vars <-ncol(df)
fbar <- unlist(apply(df,2,mean))
wbar <- sum(fbar*w)
wo <- (w-wbar)
xi <- unlist(apply(t(t(df)*wo),1,sum))
delta <- (sum(xi*xi)/vart)/sum(fbar*wo*wo)
return(delta)
}
obs <- f1(df1,w1)
if (nrepet == 0)
return(obs)
perm <- apply(perm, 1, function(x) f1(df1,w1[sample(nc)]))
w <- as.rtest(obs = obs, sim = perm, call = match.call())
return(w)
}

At 10:11 04/10/2004 +0200, Andres Mellado wrote:
>Hi all,
>
>I would like to know how to calculate correlation ratios between
>fuzzy-coded traits and the RLQ first axis,
>R give me the modalities scores on RLQ axis 1 but it doesn't calculate the
>new correlation ratios (if I'm not wrong)
>could you please give me a hand? (I'm working with ADE-4 in R)
>
>thanks,
>
>Andres
>*************************************
>
>Departamento de Ecología e Hidrología
>Campus de Espinardo
>30100 Murcia
>ESPAÑA
>Tlf: 968 36 49 77
>Fax: 968 36 39 63
>
>
>
>

Université Claude Bernard Lyon 1
UMR CNRS 5023, LEHF
bat Alphonse Forel
43 boulevard du 11 novembre 1918
F-69622 VILLEURBANNE CEDEX
FRANCE
TEL : +33 (0)4 72 44 62 34
FAX : +33 (0)4 72 43 28 92