Renvoie l'en-tête de la colonne si les valeurs de la ligne sont supérieures à un certain seuil.

Question

J'ai un cadre de données appelé tt . Je veux créer une nouvelle colonne appelée Ethnicité où je veux avoir un en-tête de colonne pour chaque valeur de ligne qui est supérieure à 80%. Si aucune ligne n'a une valeur supérieure à 80 %, alors je veux avoir la chaîne 'MIX' dans cette ligne.

tt <- structure(list(INDIVIDUAL = c("SJL0253301", "SJL1073801", "SJL1066401", 
"SJL1762813"), EUR = c(0.974378, 0.496489, 1e-05, 1e-05), EAS = c(0.010592, 
0.438799, 0.99996, 1e-05), AMR = c(0.004699, 1e-05, 1e-05, 0.99996
), SAS = c(1e-05, 0.053618, 1e-05, 1e-05), AFR = c(0.010321, 
0.011084, 1e-05, 1e-05)), row.names = c(1L, 44L, 19L, 911L), class = "data.frame")

Le résultat que je veux :

INDIVIDUAL      EUR      EAS      AMR      SAS      AFR Ethnicity
SJL0253301 0.974378 0.010592 0.004699 0.000010 0.010321 EUR
SJL1073801 0.496489 0.438799 0.000010 0.053618 0.011084 MIX
SJL1066401 0.000010 0.999960 0.000010 0.000010 0.000010 EAS
SJL1762813 0.000010 0.000010 0.999960 0.000010 0.000010 AMR

Answer 1

Nous pouvons utiliser max.col pour renvoyer le first l'indice de la colonne (pour chaque ligne) qui présente une valeur supérieure à 0,8, puis attribue MIX pour les cas où il n'y en a pas à "MIX"

tt$Ethnicity <- names(tt)[-1][max.col(tt[-1] > 0.8, "first")]
tt$Ethnicity[!rowSums(tt[2:6] > 0.8)] <- "MIX"

-sortie

> tt
    INDIVIDUAL      EUR      EAS      AMR      SAS      AFR Ethnicity
1   SJL0253301 0.974378 0.010592 0.004699 0.000010 0.010321       EUR
44  SJL1073801 0.496489 0.438799 0.000010 0.053618 0.011084       MIX
19  SJL1066401 0.000010 0.999960 0.000010 0.000010 0.000010       EAS
911 SJL1762813 0.000010 0.000010 0.999960 0.000010 0.000010       AMR

Answer 2

Une autre solution possible, en base R :

cbind(tt, Ethnicity = apply(tt[-1] > 0.8, 1, \(x) if (any(x)) names(x)[x] else "MIX"))

#>     INDIVIDUAL      EUR      EAS      AMR      SAS      AFR Ethnicity
#> 1   SJL0253301 0.974378 0.010592 0.004699 0.000010 0.010321       EUR
#> 44  SJL1073801 0.496489 0.438799 0.000010 0.053618 0.011084       MIX
#> 19  SJL1066401 0.000010 0.999960 0.000010 0.000010 0.000010       EAS
#> 911 SJL1762813 0.000010 0.000010 0.999960 0.000010 0.000010       AMR

Answer 3

Voici un tidyverse approche :

library(dplyr)
library(tidyr)

tt %>% 
  mutate(across(-INDIVIDUAL, ~case_when(. > 0.8 ~ cur_column()), .names = "new_{.col}")) %>% 
  unite(Ethnicity, starts_with('new'), na.rm = TRUE, sep = ' ') %>% 
  mutate(Ethnicity = ifelse(Ethnicity== "", "MIX", Ethnicity))

   INDIVIDUAL      EUR      EAS      AMR      SAS      AFR Ethnicity
1   SJL0253301 0.974378 0.010592 0.004699 0.000010 0.010321       EUR
44  SJL1073801 0.496489 0.438799 0.000010 0.053618 0.011084       MIX
19  SJL1066401 0.000010 0.999960 0.000010 0.000010 0.000010       EAS
911 SJL1762813 0.000010 0.000010 0.999960 0.000010 0.000010       AMR

Answer 4

Voici une autre option :

library(dplyr)

tt %>% 
  rowwise() %>% 
  mutate(Ethnicity = ifelse(all(c_across(-INDIVIDUAL) < 0.8), "MIX", names(which.max(across(-INDIVIDUAL))))) %>% 
  ungroup()

Sortie

   INDIVIDUAL      EUR      EAS      AMR      SAS      AFR Ethnicity
1   SJL0253301 0.974378 0.010592 0.004699 0.000010 0.010321       EUR
44  SJL1073801 0.496489 0.438799 0.000010 0.053618 0.011084       MIX
19  SJL1066401 0.000010 0.999960 0.000010 0.000010 0.000010       EAS
911 SJL1762813 0.000010 0.000010 0.999960 0.000010 0.000010       AMR

Answer 5

Voici un data.table approche :

library(data.table)

setDT(tt)[, Ethnicity := names(.SD)[unlist(.SD) > 0.8], 
          by = INDIVIDUAL][is.na(Ethnicity), Ethnicity := "MIX"]

Sortie

   INDIVIDUAL      EUR      EAS      AMR      SAS      AFR Ethnicity
       <char>    <num>    <num>    <num>    <num>    <num>    <char>
1: SJL0253301 0.974378 0.010592 0.004699 0.000010 0.010321       EUR
2: SJL1073801 0.496489 0.438799 0.000010 0.053618 0.011084       MIX
3: SJL1066401 0.000010 0.999960 0.000010 0.000010 0.000010       EAS
4: SJL1762813 0.000010 0.000010 0.999960 0.000010 0.000010       AMR