Nothing
## ——————————————————————————————————————————————————————————————————————
## Analyse de données compositionnelles
## par création d'un graphe et recherche de structures dans ce graphe
##
## © Emmanuel Curis, novembre 2017
##
## Créer une matrice de degrés de signification
## ——————————————————————————————————————————————————————————————————————
## HISTORIQUE
##
## 12 nov. 2017 : création du fichier
##
## 10 mai 2018 : adapté au fait que la fonction de test peut renvoyer
## plusieurs valeurs => on ne garde que la 1re,
## supposée être le p
##
## 17 mai 2018 : création à partir d'une data.frame
##
## 6 nov. 2019 : essais de parallélisation « grossière »
##
## 31 mars 2022 : contrôle de NA ou NaN dans la matrice obtenue
## ——————————————————————————————————————————————————————————————————————
## ——————————————————————————————————————————————————————————————————————
##
## Crée une matrice contenant les p pour tous les tests 2 à 2
## la matrice est forcément symétrique, avec 1 sur la diagonale…
##
## d = la data.frame contenant les variables nécessaires aux tests
## noms = les noms des variables compositionnelles
## f.p = la fonction à utiliser pour faire les tests de chaque rapport
## log = si FALSE, les données sont brutes : on fait le rapport
## si TRUE , les données sont en log : on fait la différence
## en.log = si FALSE, les données sont analysées telles qu'elles
## si TRUE , les données sont analysées après transformation log
## nom.var = nom de la variable contenant le rapport
## n.coeurs= nombre de cœurs à utiliser pour la parallélisation
## controles= si TRUE, on élimine les lignes/colonnes avec NA ou NaN
## ... = passés à f.p
##
## ——————————————————————————————————————————————————————————————————————
creer.Mp <- function( d, noms, f.p, log = FALSE, en.log = !log,
nom.var = 'R', n.coeurs = 1, controles = TRUE,
... ) {
## On prépare les noms sous forme utilisable
noms <- obtenir.colonnes( d = d, noms = noms )
## Combien de variables ?
n.variables <- length( noms )
if ( n.variables < 2 ) {
stop( "Less than 1 usable variable, no possible analysis" )
}
## On construit la matrice des résultats
M.p <- matrix( NA, ncol = n.variables, nrow = n.variables )
colnames( M.p ) <- noms
rownames( M.p ) <- noms
## On a forcément des 1 sur la diagonale
diag( M.p ) <- 1
## On fait les calculs dans les diverses situations…
## On prépare la data.frame avec juste les variables complémentaires
d.calculs <- d[ , -which( names( d ) %in% noms ), drop = FALSE ]
if ( 1 == n.coeurs ) {
for ( i in 1:(n.variables - 1) ) {
for ( j in (i + 1):n.variables ) {
if ( FALSE == log ) {
## Données brutes : on fait le rapport…
R <- d[ , noms[ i ] ] / d[ , noms[ j ] ]
} else {
## Données en log : on fait la différence…
R <- d[ , noms[ i ] ] - d[ , noms[ j ] ]
}
## Si demandé, on passe en log
if ( TRUE == en.log ) {
R <- log( R )
}
## On la stocke dans la data.frame
d.calculs[ , nom.var ] <- R
## On fait le calcul
M.p[ i, j ] <- f.p( d = d.calculs, variable = nom.var, ... )[ 1 ]
M.p[ j, i ] <- M.p[ i, j ]
}
}
} else {
## ## On répartit les cœurs en deux groupes :
## ## - boucle interne
## ## - boucle externe
## n.coeurs <- max( 1, n.coeurs / 2 )
## Les cœurs sont utilisés pour paralléliser la boucle interne...
for ( i in 1:(n.variables - 1) ) {
## On parallélise les calculs pour toute la ligne
ligne.p <- parallel::mclapply( (i+1):n.variables,
function( j, i ) {
if ( FALSE == log ) {
## Données brutes : on fait le rapport…
R <- d[ , noms[ i ] ] / d[ , noms[ j ] ]
} else {
## Données en log : on fait la différence…
R <- d[ , noms[ i ] ] - d[ , noms[ j ] ]
}
## Si demandé, on passe en log
if ( TRUE == en.log ) {
R <- log( R )
}
## On la stocke dans la data.frame
d.calculs[ , nom.var ] <- R
## On fait le calcul
p <- f.p( d = d.calculs, variable = nom.var, ... )[ 1 ]
## On renvoie cette valeur
p
}, i = i,
mc.cores = n.coeurs )
ligne.p <- unlist( ligne.p )
## On stocke dans la matrice
M.p[ i, (i+1):n.variables ] <- ligne.p
M.p[ (i+1):n.variables, i ] <- ligne.p
}
}
if ( controles ) {
if ( any( !is.finite( M.p ) ) ) {
warning( "NA or NaN in the matrix." )
otes <- character( 0 )
## On commence par ôter les lignes inutilisables
l.NA <- lapply( 1:nrow( M.p ),
function( l ) { all( !is.finite( M.p[ l, ] ) ) } )
l.NA <- unlist( l.NA )
if ( any( l.NA ) ) {
idx <- which( l.NA )
warning( "Suppression des lignes ",
paste0( idx, collapse = ", " ) )
otes <- c( otes, noms[ idx ] )
M.p <- M.p[ -idx, ]
M.p <- M.p[ , -idx ]
}
## puis les colonnes, s'il en reste
c.NA <- lapply( 1:ncol( M.p ),
function( colonne ) {
all( !is.finite( M.p[ , colonne ] ) )
} )
c.NA <- unlist( c.NA )
if ( any( c.NA ) ) {
idx <- which( c.NA )
warning( "Suppression des colonnes ",
paste0( idx, collapse = ", " ) )
otes <- c( otes, noms[ idx ] )
M.p <- M.p[ -idx, ]
M.p <- M.p[ , -idx ]
}
## et enfin, les NA ponctuels
idx.NA <- which( !is.finite( M.p ), arr.ind = TRUE )
if ( length( idx.NA ) > 0 ) {
warning( "There are isolated NaN or NA... check the results" )
}
## On mémorise les composants ôtés
attr( M.p, "omis" ) <- sort( otes )
warning( "Ommitted components because of NA or NaN:",
sort( otes ) )
}
}
## On renvoie la matrice…
M.p
}
## ——————————————————————————————————————————————————————————————————————
##
## Crée une matrice contenant les p pour tous les tests 2 à 2
## à partir des valeurs contenues dans une data.frame correspondante
## la matrice est forcément symétrique, avec 1 sur la diagonale…
##
## DFp = la data.frame contenant les valeurs à convertir
## col.noms = les colonnes contenant les noms des composants
## col.p = la colonne contenant les p à utiliser
##
## ——————————————————————————————————————————————————————————————————————
Mp.DFp <- function( DFp, col.noms = c( 1, 2 ), col.p = 'p' ) {
## On force les noms en chaînes
if ( is.factor( DFp[ , col.noms[ 1 ] ] ) ) {
DFp[ , col.noms[ 1 ] ] <- as.character( DFp[ , col.noms[ 1 ] ] )
}
if ( is.factor( DFp[ , col.noms[ 2 ] ] ) ) {
DFp[ , col.noms[ 2 ] ] <- as.character( DFp[ , col.noms[ 2 ] ] )
}
## On récupère la liste des compossants
noms <- sort( unique( c( DFp[ , col.noms[ 1 ] ],
DFp[ , col.noms[ 2 ] ] ) ) )
n <- length( noms )
## On crée la matrice, pour l'instant identité
Mp <- diag( nrow = n )
colnames( Mp ) <- noms
rownames( Mp ) <- noms
## On remplit la matrice avec les valeurs demandées
for ( i in 1:nrow( DFp ) ) {
nom1 <- DFp[ i, col.noms[ 1 ] ]
nom2 <- DFp[ i, col.noms[ 2 ] ]
Mp[ nom1, nom2 ] <- Mp[ nom2, nom1 ] <- DFp[ i, col.p ]
}
Mp
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.