Копировать массив SAS в R

Question

Я пытаюсь воссоздать этот массив SAS в R без транспонирования моего набора данных из широких в длинные (из-за размера моих данных).Я посмотрел здесь , чтобы помочь, но, похоже, не могу обобщить это.

data esoph_pre1;
    set ESOPH.Pedsf_esophagus &opts;

    *get sequence of esophageal cancer;
    array siterwho {*} SITERWHO1-SITERWHO3;
    array site {*} SITE1-SITE3;
    array yrdx{*} $ YRDX1-YRDX3;

    do i = 1 to 3;
        *set to 0 at b/g of loop;
        esoph_index = .;
        *1 rec for each instance of esophageal of the correct SITERWHO and location (SITE);
        if (SITERWHO{i} in('21010') OR 
        site{i} in('151','152','153','154','155','158','159')) and
        '2004' <= yrdx{i} <= '2013'
        then esoph_index = i;
        if esoph_index ne . then output;
    end;
    drop i;
run;

Если вы, по сути, не знакомы с SAS, выполняется циклический просмотр каждого из 3 столбцов и определение необходимости вывода строки с сохранением номера индекса как esoph_index.

Мой вопрос: есть ли способ вывести новую строку каждый раз, когда выполняются условия, и поместить индекс, связанный с этой итерацией (т. Е. Если во время второй итерации цикла индекс скажет 2)?

Вот моя попытка и желаемый вывод, но был бы признателен за любой ввод:

#original Data Frame
dx <- data.frame(ID = c(1,2,3),
                 SITERWHO1 = c('21010',NA,'42322'),
                 SITERWHO2 = c('21010','21010','56987'),
                 SITERWHO3 = c(NA,NA,'21010'),
                 SITE1 = c('159', NA,'160'),
                 SITE2 = c('151', '232','160'),
                 SITE3 = c(NA, NA,'154'),
                 YEARRX1 = c('2005','2001','2004'),
                 YEARRX2 = c('2006','2007','2009'),
                 YEARRX3 = c('1998','1989','2004'),
                 stringsAsFactors = FALSE)
#list of codes 
si <- c(as.character(151:159))
#list of years 
yr <- c(as.character(2004:2013))


#list of variables names
siter <- paste0("SITERWHO",1:3)

site <- paste0("SITE", 1:3)

yeardx <- paste0("YEARRX",1:3)

#put list of variables together 
df <- as.data.frame(t(data.frame(siter = siter, site = site, yeardx = yeardx, 
              stringsAsFactors = FALSE)),stringsAsFactors = FALSE)

#conditions work one at a time but need to get index on df
tcond <- dx[(dx[df$V1][1] == '21010'|
      dx[df$V1][2] == si)  &
      dx[df$V1][3] == '2005',]

#can't seem to get the loop to work
lscond <- lapply(df, function(x){
  dx[(dx[df[['x']]][1] == '21010'
      |dx[df[['x']]][2] %in% si ) &
       dx[df[['x']]][3] == yr, ] 
})

    #desired output
desired <-         data.frame(ID = c(1,1,2,3),
                   SITERWHO1 = c('21010','21010',NA,'42322'),
                   SITERWHO2 = c('21010','21010', '21010','56987'),
                   SITERWHO3 = c(NA,NA,NA, '21010'),
                   SITE1 = c('159', '159',NA,'160'),
                   SITE2 = c('151', '151', '232','160'),
                   SITE3 = c(NA, NA,NA, '154'),
                   YEARRX1 = c('2005','2005','2001','2004'),
                   YEARRX2 = c('2006','2006', '2007','2009'),
                   YEARRX3 = c('1998','1998','1989','2004'),
                   Index = c(1,2,2,3),
                   stringsAsFactors = FALSE)

Answer 1

library(purrr)
library(data.table) # just for %between% function

vars <- c('SITERWHO', 'SITE', 'YEARRX')

map(1:3, ~pmap_lgl(dx[paste0(vars, .x)], ~ 
       (..1 == '21010' 
        | ..2 %in% c('151','152','153','154','155','158','159')
       ) & ..3 %between% c('2004', '2013'))) %>% 
  transpose %>% 
  map(which) %>% 
  imap_dfr(~dx[rep(.y, length(.x)),] %>% mutate(Index = .x))


#   ID SITERWHO1 SITERWHO2 SITERWHO3 SITE1 SITE2 SITE3 YEARRX1 YEARRX2 YEARRX3 Index
# 1  1     21010     21010      <NA>   159   151  <NA>    2005    2006    1998     1
# 2  1     21010     21010      <NA>   159   151  <NA>    2005    2006    1998     2
# 3  2      <NA>     21010      <NA>  <NA>   232  <NA>    2001    2007    1989     2
# 4  3     42322     56987     21010   160   160   154    2004    2009    2004     3

Объяснение:

Здесь мы проверяем условия для столбцов, заканчивающихся на 1, для каждой строки.

i <- 1
pmap_lgl(dx[paste0(vars, i)], ~ 
         (..1 == '21010' 
          | ..2 %in% c('151','152','153','154','155','158','159')
         ) & ..3 %between% c('2004', '2013'))
# [1]  TRUE FALSE FALSE

Затем нам нужно сделатьчто для тех, кто заканчивается на 2 и 3, также используется map.

map(1:3, ~pmap_lgl(dx[paste0(vars, .x)], ~ 
         (..1 == '21010' 
          | ..2 %in% c('151','152','153','154','155','158','159')
         ) & ..3 %between% c('2004', '2013')))
# [[1]]
# [1]  TRUE FALSE FALSE
# 
# [[2]]
# [1]  TRUE  TRUE FALSE
# 
# [[3]]
# [1] FALSE FALSE  TRUE

Вы можете видеть, что для первой строки совпадают 1-конечные столбцы и 2-конечные столбцы (1 = TRUE,2 = ИСТИНА, 3 = ЛОЖЬ).Но результат на самом деле не сгруппирован таким образом, его нужно транспонировать.

[[1]]
[1]  TRUE  TRUE FALSE

[[2]]
[1] FALSE  TRUE FALSE

[[3]]
[1] FALSE FALSE  TRUE

Затем нам нужно map which, чтобы получить индексы, которые TRUE

[[1]]
[1] 1 2

[[2]]
[1] 2

[[3]]
[1] 3

Наконец, нам нужно выбрать соответствующую строку из фрейма данных, несколько раз, если необходимо (отсюда rep), и добавить новую переменную (mutate)

imap_dfr(~dx[rep(.y, length(.x)),] %>% mutate(Index = .x))