сопоставление значений строки (текста) с именами столбцов и возвращаемым значением - PullRequest
Новая
       17

сопоставление значений строки (текста) с именами столбцов и возвращаемым значением

6 голосов
/ 16 февраля 2020

Я пытаюсь найти имя столбца с тем же именем, что и текст в другом столбце под названием «регион», и вернуть соответствующее значение. Мои данные "df" выглядят примерно так: 

region  A   B   C   D   E   F
H      796  792 844 812 796 776
J      568  564 508 268 320 396
A      820  804 748 528 560 600
X      292  272 260 324 224 200
M      872  812 792 760 668 656
N      100 992  972 880 872 864
C      940  948 952 916 864 880
L      960  956 952 920 900 920
E      980  968 956 940 944 932
F      236  364 460 524 552 616
P      796  792 844 812 796 776
Q      568  564 508 268 320 396

И я хочу получить что-то похожее на это: 

region  A   B   C   D   E   F
H       NA  NA  NA  NA  NA  NA
J       NA  NA  NA  NA  NA  NA
A       820 NA  NA  NA  NA  NA
X       NA  NA  NA  NA  NA  NA
M       NA  NA  NA  NA  NA  NA
N       NA  NA  NA  NA  NA  NA
C       NA  NA  952 NA  NA  NA
L       NA  NA  NA  NA  NA  NA
E       NA  NA  NA  NA  944 NA
F       NA  NA  NA  NA  NA  616
P       NA  NA  NA  NA  NA  NA
Q       NA  NA  NA  NA  NA  NA

Чтобы сделать это, я попробовал этот фрагмент кода из этого другого вопроса ( L oop, который сопоставляет имена строк и столбцов и вычисляет среднее значение для 3 предыдущих столбцов ), но возвращает только позицию, и я хотел бы получить значение, как показано в пример выше.

apply (df, MARGIN = 1, FUN = function(x, i){ position <- (which(x[['region']] == colnames(df))) })

Как я могу изменить код, чтобы получить реальное значение? Спасибо

Ответы [ 6 ]

5 голосов
/ 17 февраля 2020

Пятый вариант также с использованием base функций 

idx <- na.omit(cbind(match(names(df1), df1$region),
                     1:length(df1)))
vals <- as.integer(df1[idx])
df1[-1] <- NA
df1[idx] <- vals
df1
#   region   A  B   C  D   E   F
#1       H  NA NA  NA NA  NA  NA
#2       J  NA NA  NA NA  NA  NA
#3       A 820 NA  NA NA  NA  NA
#4       X  NA NA  NA NA  NA  NA
#5       M  NA NA  NA NA  NA  NA
#6       N  NA NA  NA NA  NA  NA
#7       C  NA NA 952 NA  NA  NA
#8       L  NA NA  NA NA  NA  NA
#9       E  NA NA  NA NA 944  NA
#10      F  NA NA  NA NA  NA 616
#11      P  NA NA  NA NA  NA  NA
#12      Q  NA NA  NA NA  NA  NA

data

Благодаря @ akrun 

df1 <- structure(list(region = c("H", "J", "A", "X", "M", "N", "C", 
"L", "E", "F", "P", "Q"), A = c(796L, 568L, 820L, 292L, 872L, 
100L, 940L, 960L, 980L, 236L, 796L, 568L), B = c(792L, 564L, 
804L, 272L, 812L, 992L, 948L, 956L, 968L, 364L, 792L, 564L), 
    C = c(844L, 508L, 748L, 260L, 792L, 972L, 952L, 952L, 956L, 
    460L, 844L, 508L), D = c(812L, 268L, 528L, 324L, 760L, 880L, 
    916L, 920L, 940L, 524L, 812L, 268L), E = c(796L, 320L, 560L, 
    224L, 668L, 872L, 864L, 900L, 944L, 552L, 796L, 320L), F = c(776L, 
    396L, 600L, 200L, 656L, 864L, 880L, 920L, 932L, 616L, 776L, 
    396L)), class = "data.frame", row.names = c(NA, -12L))
4 голосов
/ 17 февраля 2020

Другая базовая опция R: 

dat[-1][sapply(names(dat[-1]), `!=`, dat$region)] <- NA

dat
   region   A  B   C  D   E   F
1       H  NA NA  NA NA  NA  NA
2       J  NA NA  NA NA  NA  NA
3       A 820 NA  NA NA  NA  NA
4       X  NA NA  NA NA  NA  NA
5       M  NA NA  NA NA  NA  NA
6       N  NA NA  NA NA  NA  NA
7       C  NA NA 952 NA  NA  NA
8       L  NA NA  NA NA  NA  NA
9       E  NA NA  NA NA 944  NA
10      F  NA NA  NA NA  NA 616
11      P  NA NA  NA NA  NA  NA
12      Q  NA NA  NA NA  NA  NA
4 голосов
/ 16 февраля 2020

Вот один вариант с tidyverse, где мы преобразуем в «длинный» формат с pivot_longer, replace элементами в «значении», где «регион» не равен значению столбца «имя», а затем изменяем форму обратно в «широкий» формат 

library(dplyr)
library(tidyr)
df1 %>% 
  pivot_longer(cols = -region) %>% 
  mutate(value = replace(value, name!= region, NA)) %>%
  pivot_wider(names_from = name, values_from = value)
#   region   A  B   C  D   E   F
#1       H  NA NA  NA NA  NA  NA
#2       J  NA NA  NA NA  NA  NA
#3       A 820 NA  NA NA  NA  NA
#4       X  NA NA  NA NA  NA  NA
#5       M  NA NA  NA NA  NA  NA
#6       N  NA NA  NA NA  NA  NA
#7       C  NA NA 952 NA  NA  NA
#8       L  NA NA  NA NA  NA  NA
#9       E  NA NA  NA NA 944  NA
#10      F  NA NA  NA NA  NA 616
#11      P  NA NA  NA NA  NA  NA
#12      Q  NA NA  NA NA  NA  NA

Другой вариант: imap

library(purrr)
imap_dfc(df1[-1], ~ replace(.x, .y != df1[['region']], NA)) %>%
   bind_cols(df1['region'], .)
#    region   A  B   C  D   E   F
#1       H  NA NA  NA NA  NA  NA
#2       J  NA NA  NA NA  NA  NA
#3       A 820 NA  NA NA  NA  NA
#4       X  NA NA  NA NA  NA  NA
#5       M  NA NA  NA NA  NA  NA
#6       N  NA NA  NA NA  NA  NA
#7       C  NA NA 952 NA  NA  NA
#8       L  NA NA  NA NA  NA  NA
#9       E  NA NA  NA NA 944  NA
#10      F  NA NA  NA NA  NA 616
#11      P  NA NA  NA NA  NA  NA
#12      Q  NA NA  NA NA  NA  NA

Или, используя base R, мы копируем names из и сделайте сравнение со столбцом 'region', измените эти значения в этих столбцах на NA на основе сравнения 

df1[-1] <- NA^(df1$region != names(df1)[-1][col(df1[-1])]) * df1[-1]

data 

df1 <- structure(list(region = c("H", "J", "A", "X", "M", "N", "C", 
"L", "E", "F", "P", "Q"), A = c(796L, 568L, 820L, 292L, 872L, 
100L, 940L, 960L, 980L, 236L, 796L, 568L), B = c(792L, 564L, 
804L, 272L, 812L, 992L, 948L, 956L, 968L, 364L, 792L, 564L), 
    C = c(844L, 508L, 748L, 260L, 792L, 972L, 952L, 952L, 956L, 
    460L, 844L, 508L), D = c(812L, 268L, 528L, 324L, 760L, 880L, 
    916L, 920L, 940L, 524L, 812L, 268L), E = c(796L, 320L, 560L, 
    224L, 668L, 872L, 864L, 900L, 944L, 552L, 796L, 320L), F = c(776L, 
    396L, 600L, 200L, 656L, 864L, 880L, 920L, 932L, 616L, 776L, 
    396L)), class = "data.frame", row.names = c(NA, -12L))
3 голосов
/ 17 февраля 2020

Вот еще один базовый код R 

df[-1]<-Map(function(v,k) {if(is.na(k)) v<-NA else v[-k]<-NA; v},df[-1], 
            match(names(df[-1]),df$region))

такой, что 

> df
   region   A  B   C  D   E   F
1       H  NA NA  NA NA  NA  NA
2       J  NA NA  NA NA  NA  NA
3       A 820 NA  NA NA  NA  NA
4       X  NA NA  NA NA  NA  NA
5       M  NA NA  NA NA  NA  NA
6       N  NA NA  NA NA  NA  NA
7       C  NA NA 952 NA  NA  NA
8       L  NA NA  NA NA  NA  NA
9       E  NA NA  NA NA 944  NA
10      F  NA NA  NA NA  NA 616
11      P  NA NA  NA NA  NA  NA
12      Q  NA NA  NA NA  NA  NA
3 голосов
/ 16 февраля 2020

Вот вариант с использованием базы R. 

for (col in names(dat[-1])){
  dat[[col]] <- ifelse(dat$region == col, dat[[col]], NA)
}

DATA 

dat <- read.table(text = "region  A   B   C   D   E   F
H      796  792 844 812 796 776
J      568  564 508 268 320 396
A      820  804 748 528 560 600
X      292  272 260 324 224 200
M      872  812 792 760 668 656
N      100 992  972 880 872 864
C      940  948 952 916 864 880
L      960  956 952 920 900 920
E      980  968 956 940 944 932
F      236  364 460 524 552 616
P      796  792 844 812 796 776
Q      568  564 508 268 320 396",
                  stringsAsFactors = FALSE, header = TRUE)
2 голосов
/ 17 февраля 2020

Возможно, не самый чистый способ dplyr, но вы также можете попробовать: 

df %>%
 mutate_at(vars(-1), 
           funs(replace(., .*(deparse(substitute(.)) == region) == 0, NA_integer_)))

   region   A  B   C  D   E   F
1       H  NA NA  NA NA  NA  NA
2       J  NA NA  NA NA  NA  NA
3       A 820 NA  NA NA  NA  NA
4       X  NA NA  NA NA  NA  NA
5       M  NA NA  NA NA  NA  NA
6       N  NA NA  NA NA  NA  NA
7       C  NA NA 952 NA  NA  NA
8       L  NA NA  NA NA  NA  NA
9       E  NA NA  NA NA 944  NA
10      F  NA NA  NA NA  NA 616
11      P  NA NA  NA NA  NA  NA
12      Q  NA NA  NA NA  NA  NA

Или адаптировать логи c от @markus: 

df %>%
 rowwise() %>%
 mutate_at(vars(-1), funs(.[match(region, deparse(substitute(.)))]))

И один экзот c base R опция: 

df[-1] <- sweep(t(apply(df[1], 1, rep, length(df)-1)), 2, FUN = `==`, names(df[-1]))*df[-1]
df[-1] <- replace(df[-1], df[-1] == 0, NA_integer_)
...