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

From: Pierre BADY (pierre.bady@univ-lyon1.fr)
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”).
    # coleo <- read.table("C:/.../habitatcoleo.txt",h=T)
    # 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

    P.BADY

    Appendix : functions 'delta.disper'

    require(ade4)
    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),"): ")
             z <- as.integer(readLines(n = 1))
             }
        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
    >*************************************
    >
    >Andres Mellado Diaz
    >Departamento de Ecología e Hidrología
    >Universidad de Murcia
    >Campus de Espinardo
    >30100 Murcia
    >ESPAÑA
    >Tlf: 968 36 49 77
    >Fax: 968 36 39 63
    >e-mail: amellado@um.es
    >
    >
    >
    >

    Pierre BADY <°)))))><
    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
    MEL : pierre.bady@univ-lyon1.fr
    http://limnologie.univ-lyon1.fr



    This archive was generated by hypermail 2b30 : Mon Oct 04 2004 - 17:47:39 MEST