ETHZ_Logo RAMSES_Logo_Right   RAMSES   RAMSES_Logo_Left Systems Ecology  
Start    search button      Modules:   A-Z   Function   Layer        QuickRefs:   DM   AuxLib   AuxLibE   SciLib   EasyMW   MW   ISIS   RMSLib

DEFINITION MODULE CanCor;

  (*******************************************************************

    Module  CanCor     (Version 1.0)

      Copyright (c) 1993-2006 by Dimitrios Gyalistras and ETH Zurich.

    Purpose   Perform Canonical Correlation Analysis (CCA)
              of two data matrices in the sub-spaces spanned
              by their empirical orthogonal functions (EOFs).

    Remarks   Requires input data as calculated by means of
              procedure PrinComp.MakePCA.


    Programming

      o Design
        Dimitrios Gyalistras      27/07/1993

      o Implementation
        Dimitrios Gyalistras      27/07/1993


    ETH Zurich
    Systems Ecology
    CHN E 35.1
    Universitaetstrasse 16
    8092 Zurich
    SWITZERLAND

    URLs:
        <mailto:RAMSES@env.ethz.ch>
        <http://www.sysecol.ethz.ch>
        <http://www.sysecol.ethz.ch/SimSoftware/RAMSES>


    Last revision of definition:  24/05/2002  AF

  *******************************************************************)


  FROM DMFiles IMPORT TextFile;
  IMPORT Errors;
  FROM LgMatrices IMPORT LMatrix, LVector;
  FROM PrinComp IMPORT WeightingType;


  (******************************************************************)

  CONST  (* result codes returned *)
    allOk   = Errors.allOk;
    notDone = Errors.onlyAnInsert;

  CONST  (* types of matrices supported *)

   ccCoeffSqMatType  = 201;  (* squared canonical correlation coefficients             *)
   tvxXMatType       = 202;  (* X total variances explained by canonical modes         *)
   tvxYMatType       = 203;  (* Y total variances explained by canonical modes         *)

   mapXMatType       = 210;  (* X canonical maps                                       *)
   lvxXMatType       = 211;  (* X local variances explained by canonical modes         *)
   cmpXMatType       = 212;  (* X components of canonical modes                        *)

   mapYMatType       = 220;  (* Y canonical maps                                       *)
   lvxYMatType       = 221;  (* Y local variances explained by canonical modes         *)
   cmpYMatType       = 222;  (* Y components of canonical modes                        *)

   xEstCmpMatType    = 230;  (* X estimated components from CCA model application      *)
   yEstMatType       = 231;  (* Y estimated variables from CCA model application       *)
   yCrossVldMatType  = 232;  (* Y estimated variables from CCA model cross-validation  *)

  (*
    Note: the dimensions of all LVector and LMatrix objects used below
    are determined automatically via procedures LgMatrices.NElems,
    LgMatrices.NRows and LgMatrices.NCols.
  *)


  (*********************************)
  (*#####   Main procedures   #####*)
  (*********************************)


  PROCEDURE MakeCCA(
           (*  in:  input data sets and their means  *)
                    xDat          : LMatrix;
                    yDat          : LMatrix;
           (*  in, or in/out: numbers of EOFs to use  *)
                    VAR nXEofs    : INTEGER;  (* if = 0, minXCumulV or maxXEigValREB is considered *)
                    VAR nYEofs    : INTEGER;  (* if = 0, minYCumulV or maxYEigValREB is considered *)
           (*  in: criteria used to automatically determine number of EOFs (used only if n*Eofs=0) *)
                    minXCumulV    : LONGREAL; (* if undefined or = 0, maxXEigValREB is considered *)
                    minYCumulV    : LONGREAL; (* if undefined or = 0, maxYEigValREB is considered *)
                    maxXEigValREB : LONGREAL;
                    maxYEigValREB : LONGREAL;
           (*  in:  results of PC analyses (see module PrinComp)  *)
                    muX           : LMatrix;  (*  1 x NCols(X)           *)
                    wghtX         : LMatrix;  (*  1 x NCols(X)           *)
                    eigValX       : LMatrix;  (*  1 x NEofs(X)           *)
                    pcX           : LMatrix;  (*  NRows(X) x NCols(X)    *)
                    muY           : LMatrix;  (*  1 x NCols(Y)           *)
                    wghtY         : LMatrix;  (*  1 x NCols(Y)           *)
                    eigValY       : LMatrix;  (*  1 x NEofs(Y)           *)
                    pcY           : LMatrix;  (*  NRows(Y) x NCols(Y)    *)
           (*  out: results of CCA  *)
                    ccCoeffSq     : LMatrix;  (*  1 x NCCCoeffs          *)
                    mapX          : LMatrix;  (*  NCCCoeffs x NCols(X)   *)
                    cmpX          : LMatrix;  (*  NRows(X) x NCols(X)    *)
                    tvxX          : LMatrix;  (*  1 x NCols(X)           *)
                    lvxX          : LMatrix;  (*  NCCCoeffs x NCols(X)   *)
                    mapY          : LMatrix;  (*  NCCCoeffs x NCols(Y)   *)
                    cmpY          : LMatrix;  (*  NRows(Y) x NCols(Y)    *)
                    tvxY          : LMatrix;  (*  1 x NCols(Y)           *)
                    lvxY          : LMatrix;  (*  NCCCoeffs x NCols(Y)   *)
                    VAR resCode   : INTEGER;
                    VAR errTxt    : ARRAY OF CHAR );


  PROCEDURE ApplyCCA(
            (*  in:  independent data  *)
                     xDat          : LMatrix;
                     areAnomalies  : BOOLEAN;  (* if FALSE, X data are converted to anomalies first  *)
            (*  in, or in/out: specification of canonical modes to use  *)
                     VAR nCanModes : INTEGER;  (* if = 0, taken are all modes for which ccCoeffSq is above ccCfSqTrshld  *)
                     ccCfSqTrshld  : LONGREAL; (* considered only if nCanModes = 0 *)
            (*  in:  CCA model parameters  *)
                     ccCoeffSq     : LMatrix;
                     muX           : LMatrix;
                     wghtX         : LMatrix;
                     mapX          : LMatrix;
                     muY           : LMatrix;
                     wghtY         : LMatrix;
                     mapY          : LMatrix;
            (*  out: estimated components and y-values  *)
                     xEstCmp       : LMatrix;
                     yEst          : LMatrix;
                     VAR resCode   : INTEGER;
                     VAR errTxt    : ARRAY OF CHAR );




  TYPE
    PCAResultsProc = PROCEDURE (      (* resultNr *)  INTEGER,
                                 VAR  (* mu       *)  LMatrix,
                                 VAR  (* wght     *)  LMatrix,
                                 VAR  (* eigVal   *)  LMatrix,
                                 VAR  (* pcX      *)  LMatrix,
                                 VAR  (* resCode  *)  INTEGER,
                                 VAR  (* errTxt   *)  ARRAY OF CHAR );

  PROCEDURE EmptyPCAResultsProc( resultNr     : INTEGER;
                                 VAR  mu      : LMatrix;
                                 VAR  wght    : LMatrix;
                                 VAR  eigVal  : LMatrix;
                                 VAR  pc      : LMatrix;
                                 VAR  resCode : INTEGER;
                                 VAR  errTxt  : ARRAY OF CHAR );


  PROCEDURE CrossValidCCA(
                 (*  in:  independent data  *)
                          xDat           : LMatrix;
                          yDat           : LMatrix;
                          xWType         : WeightingType;
                          yWType         : WeightingType;
                 (*  in, or in/out: numbers of EOFs to use  *)
                          VAR nXEofs     : INTEGER;  (* if = 0, minXCumulV or maxXEigValREB is considered *)
                          VAR nYEofs     : INTEGER;  (* if = 0, minYCumulV or maxYEigValREB is considered *)
                 (*  in: criteria used to automatically determine number of EOFs (used only if n*Eofs=0) *)
                          minXCumulV     : LONGREAL; (* if undefined or = 0, maxXEigValREB is considered *)
                          minYCumulV     : LONGREAL; (* if undefined or = 0, maxYEigValREB is considered *)
                          maxXEigValREB  : LONGREAL;
                          maxYEigValREB  : LONGREAL;
                 (*  in:  procedures for geting pre-calculated eofs   *)
                          getXPCAResults : PCAResultsProc;
                          getYPCAResults : PCAResultsProc;
                 (*  in: specification of canonical modes to use  *)
                          nCanModes      : INTEGER;    (* if = 0, taken are all modes for which ccCoeffSq is above ccCfSqTrshld  *)
                          ccCfSqTrshld   : LONGREAL;   (* considered only if nCanModes = 0 *)
                 (*  in:  procedure called to signify progress report  *)
                          progrReport    : PROC;
                 (*  out: results from cross-validation  *)
                          yCrossVld      : LMatrix;
                          VAR resCode    : INTEGER;
                          VAR errTxt     : ARRAY OF CHAR );



  (**************************)
  (*#####   Auxilary   #####*)
  (**************************)


  PROCEDURE InDataMatsOK( xDat          : LMatrix;
                          yDat          : LMatrix;
                          xGenericDescr : ARRAY OF CHAR;  (* used if xDat has no descriptor attached to it *)
                          yGenericDescr : ARRAY OF CHAR;  (* used if yDat has no descriptor attached to it *)
                          callee        : ARRAY OF CHAR;
                          VAR errTxt    : ARRAY OF CHAR ): BOOLEAN;


  PROCEDURE NCanModesOK( ccCoeffSq    : LMatrix;
                         nCanModes    : INTEGER;
                         genericDescr : ARRAY OF CHAR;   (*  used if ccCoeffSq has no descriptor attached to it *)
                         callee       : ARRAY OF CHAR;
                         VAR errTxt   : ARRAY OF CHAR ): BOOLEAN;


  PROCEDURE GetNumCanModes( ccCoeffSq     : LMatrix;
                            ccCfSqTrshld  : LONGREAL;
                            VAR nCanModes : INTEGER;
                            VAR resCode   : INTEGER;
                            VAR errTxt    : ARRAY OF CHAR );
   (*
    Returns the number of canonical modes for which ccCoeffSq is above ccCfSqTrshld.
  *)


  PROCEDURE AllocCCAResVars( nXEofs : INTEGER;
                             nYEofs : INTEGER;
                             xDat   : LMatrix;
                             yDat   : LMatrix;
                             VAR ccCoeffSq : LMatrix;
                             VAR mapX, cmpX, tvxX, lvxX : LMatrix;
                             VAR mapY, cmpY, tvxY, lvxY : LMatrix;
                             VAR resCode   : INTEGER;
                             VAR errTxt    : ARRAY OF CHAR );


  PROCEDURE DeallocCCAResVars( VAR ccCoeffSq : LMatrix;
                               VAR mapX, cmpX, tvxX, lvxX : LMatrix;
                               VAR mapY, cmpY, tvxY, lvxY : LMatrix );


  (************************************)
  (*#####   I/O of CCA results   #####*)
  (************************************)


  PROCEDURE WriteCCAResults( VAR outF    : TextFile;
                             (* main results *)
                             wrCcCoeffSq  : BOOLEAN;  ccCoeffSq  : LMatrix;
                             wrTvxX       : BOOLEAN;  tvxX       : LMatrix;
                             wrTvxY       : BOOLEAN;  tvxY       : LMatrix;
                             (* X model parameters *)
                             wrMuX        : BOOLEAN;  muX        : LMatrix;
                             wrWghtX      : BOOLEAN;  wghtX      : LMatrix;
                             wrMapX       : BOOLEAN;  mapX       : LMatrix;
                             (* Y model parameters *)
                             wrMuY        : BOOLEAN;  muY        : LMatrix;
                             wrWghtY      : BOOLEAN;  wghtY      : LMatrix;
                             wrMapY       : BOOLEAN;  mapY       : LMatrix;
                             (* X local explained variances and components *)
                             wrLvxX       : BOOLEAN;  lvxX       : LMatrix;
                             wrCmpX       : BOOLEAN;  cmpX       : LMatrix;
                             (* Y local explained variances and components *)
                             wrLvxY       : BOOLEAN;  lvxY       : LMatrix;
                             wrCmpY       : BOOLEAN;  cmpY       : LMatrix;
                             VAR resCode  : INTEGER;
                             VAR errTxt   : ARRAY OF CHAR );


  PROCEDURE ReadCCAResults( inFName       : ARRAY OF CHAR;
                            tryOpenFile   : BOOLEAN;
                            keepFileOpen  : BOOLEAN;
                            (* main results *)
                            rdCcCoeffSq   : BOOLEAN;  VAR ccCoeffSq  : LMatrix;
                            rdTvxX        : BOOLEAN;  VAR tvxX       : LMatrix;
                            rdTvxY        : BOOLEAN;  VAR tvxY       : LMatrix;
                            (* X model parameters *)
                            rdMuX         : BOOLEAN;  VAR muX        : LMatrix;
                            rdWghtX       : BOOLEAN;  VAR wghtX      : LMatrix;
                            rdMapX        : BOOLEAN;  VAR mapX       : LMatrix;
                            (* Y model parameters *)
                            rdMuY         : BOOLEAN;  VAR muY        : LMatrix;
                            rdWghtY       : BOOLEAN;  VAR wghtY      : LMatrix;
                            rdMapY        : BOOLEAN;  VAR mapY       : LMatrix;
                            (* X local explained variances and components *)
                            rdLvxX        : BOOLEAN;  VAR lvxX       : LMatrix;
                            rdCmpX        : BOOLEAN;  VAR cmpX       : LMatrix;
                            (* Y local explained variances and components *)
                            rdLvxY        : BOOLEAN;  VAR lvxY       : LMatrix;
                            rdCmpY        : BOOLEAN;  VAR cmpY       : LMatrix;
                            VAR endOfFile : BOOLEAN;
                            VAR resCode   : INTEGER;
                            VAR errTxt    : ARRAY OF CHAR );

END CanCor.

  Contact RAMSES@env.ethz.ch Last updated: 25-Jul-2011 [Top of page]