Как сопоставить значения нескольких переменных с переменной в таблице поиска? - PullRequest
Новая
       7

Как сопоставить значения нескольких переменных с переменной в таблице поиска?

0 голосов
/ 15 мая 2018

У меня есть два набора данных: 

loc <- c("a","b","c","d","e")
id1 <- c(NA,9,3,4,5)
id2 <- c(2,3,7,5,6)
id3 <- c(2,NA,5,NA,7)
cost1 <- c(10,20,30,40,50)
cost2 <- c(50,20,30,30,50)
cost3 <- c(40,20,30,10,20)
dt <- data.frame(loc,id1,id2,id3,cost1,cost2,cost3)


id <- c(1,2,3,4,5,6,7)
rate <- c(0.9,0.8,0.7,0.6,0.5,0.4,0.3)
lookupd_tb <- data.frame(id,rate)

, что я хочу сделать, это сопоставить значения в dt с lookup_tb для id1, id2 и id3 и, если есть совпадение, умножить скорость для этого идентификатора

Это мой подход: 

dt <- dt %>% 
left_join(lookupd_tb , by=c("id1"="id")) %>%
dplyr :: mutate(cost1 = ifelse(!is.na(rate), cost1*rate, cost1)) %>% 
dplyr :: select (-rate)

то, что я делаю сейчас, работает нормально, но я должен повторить это 3 раза для каждой переменной, и мне было интересно, если естьэто более эффективный способ сделать это (возможно, с использованием apply family?)

Я попытался объединить все три переменные с идентификатором в моей справочной таблице, но когда показатель соединен с моим dt, все затраты (cost1,cost2 и cost3) будут умножены на тот же коэффициент, который я не хочу.

Я ценю вашу помощь!

Ответы [ 2 ]

0 голосов
/ 15 мая 2018

В tidyverse вы также можете попробовать альтернативный подход, преобразовав данные из широкого в длинный 

  library(tidyverse)
  dt %>% 
  # data transformation to long
  gather(k, v, -loc) %>% 
  mutate(ID=paste0("costnew", str_extract(k, "[:digit:]")),
         k=str_remove(k, "[:digit:]")) %>% 
  spread(k, v) %>% 
  # left_join and calculations of new costs
  left_join(lookupd_tb , by="id") %>% 
  mutate(cost_new=ifelse(is.na(rate), cost,rate*cost)) %>% 
  #  clean up and expected output
  select(loc, ID, cost_new) %>% 
  spread(ID, cost_new) %>% 
  left_join(dt,., by="loc")  # or %>% bind_cols(dt, .)
  loc id1 id2 id3 cost1 cost2 cost3 costnew1 costnew2 costnew3
1   a  NA   2   2    10    50    40       10       40       32
2   b   9   3  NA    20    20    20       20       14       20
3   c   3   7   5    30    30    30       21        9       15
4   d   4   5  NA    40    30    10       24       15       10
5   e   5   6   7    50    50    20       25       20        6

Идея состоит в том, чтобы привести данные в подходящий длинный формат для lef_joining, используя gather & spread комбинация с новыми столбцами индекса k и ID.После расчета мы перейдем к ожидаемому результату, используя секунду spread и привязку к dt

0 голосов
/ 15 мая 2018

Подход base R будет заключаться в циклическом просмотре столбцов id с использованием sapply/lapply, получения индекса match ing из столбца 'id' lookupd_tb 'на основе индекса, получения соответствующего'rate', replace NA элементов с 1, умножьте на столбцы 'cost' и обновите столбцы 'cost' 

nmid <- grep("id", names(dt))
nmcost <- grep("cost", names(dt))

dt[nmcost] <- dt[nmcost]*sapply(dt[nmid], function(x) {
         x1 <- lookupd_tb$rate[match(x, lookupd_tb$id)]
          replace(x1, is.na(x1), 1) })

. Или, используя tidyverse, мы можем выполнить циклнаборы столбцов, т. е. «id» и «cost» с purrr::map2, затем используют тот же подход, что и выше.Единственное отличие состоит в том, что здесь мы создали новые столбцы вместо обновления столбцов «стоимость» 

library(tidyverse)
dt %>% 
   select(nmid) %>% 
   map2_df(., dt %>% 
               select(nmcost), ~  
                 .x %>% 
                     match(., lookupd_tb$id) %>%
                     lookupd_tb$rate[.] %>% 
                     replace(., is.na(.),1) * .y ) %>%
    rename_all(~ paste0("costnew", seq_along(.))) %>%
    bind_cols(dt, .)
...