मेरे पास इस तरह का डेटा है:

data_in <- read_table2("ID  Q26_1_1 Q26_1_2 Q26_1_3 Q26_1_4 Q26_2_1 Q26_2_2 Q26_2_3 Q26_2_4 Q26_3_1 Q26_3_2 Q26_3_3 Q26_3_4 Q26_4_1 Q26_4_2 Q26_4_3 Q26_4_4 Q26_5_1 Q26_5_2 Q26_5_3 Q26_5_4 Q14_1_1 Q14_1_2 Q14_1_3 Q14_1_4 Q14_1_5 Q14_1_6 Q14_2_1 Q14_2_2 Q14_2_3 Q14_2_4 Q14_2_5 Q14_2_6 Q14_3_1 Q14_3_2 Q14_3_3 Q14_3_4 Q14_3_5 Q14_3_6 Q14_4_1 Q14_4_2 Q14_4_3 Q14_4_4 Q14_4_5 Q14_4_6 Q14_5_1 Q14_5_2 Q14_5_3 Q14_5_4 Q14_5_5 Q14_5_6
1   NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  1   NA  NA  NA  NA  NA  1   1   1   NA  NA  NA  NA  NA  NA  NA  NA  NA  1   NA  NA  NA  NA  NA  1
2   NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  1   NA  NA  NA  NA  NA  1   NA  NA  NA  NA  NA  1   NA  NA  NA  NA  NA  1   NA  NA  NA  NA  NA  1
3   1   NA  1   NA  1   NA  1   NA  1   NA  NA  NA  NA  NA  NA  1   1   1   1   NA  NA  NA  1   NA  NA  NA  NA  NA  1   NA  NA  NA  NA  1   1   NA  NA  NA  NA  NA  NA  NA  NA  1   NA  NA  1   NA  NA  NA
4   NA  NA  NA  1   NA  NA  NA  1   NA  NA  NA  1   NA  NA  NA  1   NA  NA  NA  1   NA  NA  NA  NA  NA  1   NA  NA  NA  NA  NA  1   NA  NA  NA  NA  NA  1   NA  NA  NA  NA  NA  1   NA  NA  NA  NA  NA  1
5   1   NA  NA  NA  NA  1   1   NA  1   NA  NA  NA  1   NA  NA  NA  1   1   1   NA  NA  NA  1   NA  NA  NA  NA  NA  1   NA  NA  NA  NA  NA  1   NA  NA  NA  NA  NA  1   NA  NA  NA  NA  NA  1   NA  NA  NA
")

मैं डेटा में हेरफेर करना चाहता हूं: यदि प्रश्नों की श्रृंखला का योग 0 के बराबर है, तो उस पूरी श्रृंखला को लापता असाइन करें, यदि यह 0 के बराबर नहीं है, तो "0" असाइन करें। मैंने इस डेटा में हेरफेर करने के लिए पहले ही कोड लिखा है।

समस्या यह है कि मेरे पास प्रश्नों की कई श्रृंखलाएं हैं, और मैं इसे एक फ़ंक्शन में लिखना चाहता हूं, ताकि मैं इसे प्रत्येक प्रश्न श्रृंखला पर लागू कर सकूं, इसलिए मुझे इस तरह कॉपी पेस्ट करने की आवश्यकता नहीं है:

data_out <- 
data_in  %>%
  
  ### Q26 ####
  # Convert the Q26 series missing to zero
  mutate(across(matches("Q26"), ~replace_na(., 0))) %>% 
  mutate_if(is.character, as.numeric) %>%
  
  # Q26_1 
  mutate(sum_Q26_1=rowSums(select(.,matches(("^Q26_1_[1-4]$"))), na.rm = T)) %>%
  mutate(across(matches("^Q26_1_[1-4]$"),.fns=~case_when(sum_Q26_1==0~"NA",
                                                         TRUE~as.character(.)))) %>%
  
  # Q26_2 
  mutate(sum_Q26_2=rowSums(select(.,matches(("^Q26_2_[1-4]$"))), na.rm = T)) %>%
  mutate(across(matches("^Q26_2_[1-4]$"),.fns=~case_when(sum_Q26_2==0~"NA",
                                                         TRUE~as.character(.)))) %>%
  
  # Q26_3 
  mutate(sum_Q26_3=rowSums(select(.,matches(("^Q26_3_[1-4]$"))), na.rm = T)) %>%
  mutate(across(matches("^Q26_3_[1-4]$"),.fns=~case_when(sum_Q26_3==0~"NA",
                                                         TRUE~as.character(.)))) %>% 
  
  # Q26_4
  mutate(sum_Q26_4=rowSums(select(.,matches(("^Q26_4_[1-4]$"))), na.rm = T)) %>%
  mutate(across(matches("^Q26_4_[1-4]$"),.fns=~case_when(sum_Q26_4==0~"NA",
                                                         TRUE~as.character(.)))) %>%
  
  
  # Q26_5
  mutate(sum_Q26_5=rowSums(select(.,matches(("^Q26_5_[1-4]$"))), na.rm = T)) %>%
  mutate(across(matches("^Q26_5_[1-4]$"),.fns=~case_when(sum_Q26_5==0~"NA",
      
                                                  TRUE~as.character(.)))) %>% 
  
  
  ### Q14 ####
  mutate(across(matches("Q14"), ~replace_na(., 0))) %>% 
  mutate_if(is.character, as.numeric) %>%
  
  # Q14_1 
  mutate(sum_Q14_1=rowSums(select(.,matches(("^Q14_1_[1-6]$"))), na.rm = T)) %>%
  mutate(across(matches("^Q14_1_[1-6]$"),.fns=~case_when(sum_Q14_1==0~"NA",
                                                         TRUE~as.character(.)))) %>%
  
  # Q14_2 
  mutate(sum_Q14_2=rowSums(select(.,matches(("^Q14_2_[1-6]$"))), na.rm = T)) %>%
  mutate(across(matches("^Q14_2_[1-6]$"),.fns=~case_when(sum_Q14_2==0~"NA",
                                                         TRUE~as.character(.)))) %>%
  
  # Q14_3 
  mutate(sum_Q14_3=rowSums(select(.,matches(("^Q14_3_[1-6]$"))), na.rm = T)) %>%
  mutate(across(matches("^Q14_3_[1-6]$"),.fns=~case_when(sum_Q14_3==0~"NA",
                                                         TRUE~as.character(.)))) %>% 
  
  # Q14_4
  mutate(sum_Q14_4=rowSums(select(.,matches(("^Q14_4_[1-6]$"))), na.rm = T)) %>%
  mutate(across(matches("^Q14_4_[1-6]$"),.fns=~case_when(sum_Q14_4==0~"NA",
                                                         TRUE~as.character(.)))) %>%
  
  
  # Q14_5
  mutate(sum_Q14_5=rowSums(select(.,matches(("^Q14_5_[1-6]$"))), na.rm = T)) %>%
  mutate(across(matches("^Q14_5_[1-6]$"),.fns=~case_when(sum_Q14_5==0~"NA",
                                                         TRUE~as.character(.))))

ध्यान दें कि प्रश्नों पर रेगेक्स पैटर्न बदलता है। उदाहरण के लिए: Q26 श्रृंखला मैचों(("^Q26_1_[1-4]$"))) है

जहाँ तक, Q14 श्रृंखला मैचों(("^Q14_1_[1-6]$"))) है

मैं बदलते रेगेक्स पैटर्न को देखते हुए इसे एक फ़ंक्शन में लपेटना नहीं जानता। कोई सुझाव?

0
NewBee 7 अक्टूबर 2020, 18:07

1 उत्तर

सबसे बढ़िया उत्तर

मेरे अवलोकन के आधार पर, मुझे लगता है कि

  1. वे sum_... कॉलम केवल अस्थायी चर हैं, और यदि मैं चाहूं तो मैं उन्हें स्वतंत्र रूप से छोड़ सकता हूं;
  2. हालाँकि आपने बाद में अपनी पाइपलाइन में एक और mutate_if(is.character, as.numeric) किया, आप वास्तव में प्रत्येक कॉलम as.character चाहते हैं और इसमें केवल "0", "1" या NA शामिल हैं;
  3. इस तरह की पंक्तियों में sum_Q14_4==0~"NA", आप इसे एक वर्ण प्रकार (जो NA_character_ होना चाहिए) का एक लापता मान निर्दिष्ट करना चाहते हैं, न कि "NA" शाब्दिक।

फिर, आपका कोड सरल हो जाता है:

library(dplyr)
library(tidyr)

data_in %>% 
  pivot_longer(-ID, names_to = c("qns", "sub1", "sub2"), names_pattern = "([^_]+)_([^_]+)_([^_]+)") %>% 
  group_by(ID, qns, sub1) %>% 
  mutate(value = if (all(is.na(value))) NA_character_ else replace_na(value, "0")) %>% 
  pivot_wider(names_from = c("qns", "sub1", "sub2"))

उत्पादन

# A tibble: 5 x 51
# Groups:   ID [5]
     ID Q26_1_1 Q26_1_2 Q26_1_3 Q26_1_4 Q26_2_1 Q26_2_2 Q26_2_3 Q26_2_4 Q26_3_1 Q26_3_2 Q26_3_3 Q26_3_4 Q26_4_1 Q26_4_2 Q26_4_3 Q26_4_4 Q26_5_1 Q26_5_2
  <dbl> <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>  
1     1 NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA     
2     2 NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA      NA     
3     3 1       0       1       0       1       0       1       0       1       0       0       0       0       0       0       1       1       1      
4     4 0       0       0       1       0       0       0       1       0       0       0       1       0       0       0       1       0       0      
5     5 1       0       0       0       0       1       1       0       1       0       0       0       1       0       0       0       1       1      
# ... with 32 more variables: Q26_5_3 <chr>, Q26_5_4 <chr>, Q14_1_1 <chr>, Q14_1_2 <chr>, Q14_1_3 <chr>, Q14_1_4 <chr>, Q14_1_5 <chr>, Q14_1_6 <chr>,
#   Q14_2_1 <chr>, Q14_2_2 <chr>, Q14_2_3 <chr>, Q14_2_4 <chr>, Q14_2_5 <chr>, Q14_2_6 <chr>, Q14_3_1 <chr>, Q14_3_2 <chr>, Q14_3_3 <chr>,
#   Q14_3_4 <chr>, Q14_3_5 <chr>, Q14_3_6 <chr>, Q14_4_1 <chr>, Q14_4_2 <chr>, Q14_4_3 <chr>, Q14_4_4 <chr>, Q14_4_5 <chr>, Q14_4_6 <chr>,
#   Q14_5_1 <chr>, Q14_5_2 <chr>, Q14_5_3 <chr>, Q14_5_4 <chr>, Q14_5_5 <chr>, Q14_5_6 <chr>

अपडेट करें

चूंकि आप केवल इस तर्क को Q26 और Q14 पर लागू करना चाहते हैं, तो आप नीचे दिए गए कोड को आजमा सकते हैं, जो आपको डेटा के केवल एक सबसेट को बदलने की अनुमति देता है।

library(dplyr)
library(tidyr)

only_at <- function(df, ..., join_by, .do) {
  order <- names(df)
  cols_to_change <- select(df, !!join_by, ...)
  cols_to_keep <- select(df, !!join_by, !any_of(names(cols_to_change)))
  left_join(.do(cols_to_change), cols_to_keep, join_by)[, order]
}

data_in %>% 
  only_at(ID, starts_with("Q26"), starts_with("Q14"), 
    join_by = "ID", 
    .do = . %>% 
      pivot_longer(-ID, names_to = c("qns", "sub1", "sub2"), names_pattern = "([^_]+)_([^_]+)_([^_]+)") %>% 
      group_by(ID, qns, sub1) %>% 
      mutate(value = if (all(is.na(value))) NA_character_ else replace_na(value, "0")) %>% 
      pivot_wider(names_from = c("qns", "sub1", "sub2"))
  )

टेस्ट डेटा इस तरह दिखता है

> data_in
# A tibble: 5 x 53
     ID random_column Q26_1_1 Q26_1_2 Q26_1_3 Q26_1_4 Q26_2_1 Q26_2_2 random_column2 Q26_2_3 Q26_2_4 Q26_3_1 Q26_3_2 Q26_3_3 Q26_3_4 Q26_4_1 Q26_4_2
  <dbl> <chr>           <dbl> <lgl>     <dbl>   <dbl>   <dbl>   <dbl> <chr>            <dbl>   <dbl>   <dbl> <lgl>   <lgl>     <dbl>   <dbl> <lgl>  
1     1 NA                 NA NA           NA      NA      NA      NA two                 NA      NA      NA NA      NA           NA      NA NA     
2     2 orange             NA NA           NA      NA      NA      NA one                 NA      NA      NA NA      NA           NA      NA NA     
3     3 NA                  1 NA            1      NA       1      NA NA                   1      NA       1 NA      NA           NA      NA NA     
4     4 apple              NA NA           NA       1      NA      NA one                 NA       1      NA NA      NA            1      NA NA     
5     5 orange              1 NA           NA      NA      NA       1 NA                   1      NA       1 NA      NA           NA       1 NA     
# ... with 36 more variables: Q26_4_3 <lgl>, Q26_4_4 <dbl>, Q26_5_1 <dbl>, Q26_5_2 <dbl>, Q26_5_3 <dbl>, Q26_5_4 <dbl>, Q14_1_1 <lgl>, Q14_1_2 <lgl>,
#   Q14_1_3 <dbl>, Q14_1_4 <lgl>, Q14_1_5 <lgl>, Q14_1_6 <dbl>, Q14_2_1 <lgl>, Q14_2_2 <lgl>, Q14_2_3 <dbl>, Q14_2_4 <lgl>, Q14_2_5 <lgl>,
#   Q14_2_6 <dbl>, Q14_3_1 <dbl>, Q14_3_2 <dbl>, Q14_3_3 <dbl>, Q14_3_4 <lgl>, Q14_3_5 <lgl>, Q14_3_6 <dbl>, Q14_4_1 <lgl>, Q14_4_2 <lgl>,
#   Q14_4_3 <dbl>, Q14_4_4 <lgl>, Q14_4_5 <lgl>, Q14_4_6 <dbl>, Q14_5_1 <lgl>, Q14_5_2 <lgl>, Q14_5_3 <dbl>, Q14_5_4 <lgl>, Q14_5_5 <lgl>, Q14_5_6 <dbl>

उत्पादन

# A tibble: 5 x 53
# Groups:   ID [5]
     ID random_column Q26_1_1 Q26_1_2 Q26_1_3 Q26_1_4 Q26_2_1 Q26_2_2 random_column2 Q26_2_3 Q26_2_4 Q26_3_1 Q26_3_2 Q26_3_3 Q26_3_4 Q26_4_1 Q26_4_2
  <dbl> <chr>         <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>          <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>  
1     1 NA            NA      NA      NA      NA      NA      NA      two            NA      NA      NA      NA      NA      NA      NA      NA     
2     2 orange        NA      NA      NA      NA      NA      NA      one            NA      NA      NA      NA      NA      NA      NA      NA     
3     3 NA            1       0       1       0       1       0       NA             1       0       1       0       0       0       0       0      
4     4 apple         0       0       0       1       0       0       one            0       1       0       0       0       1       0       0      
5     5 orange        1       0       0       0       0       1       NA             1       0       1       0       0       0       1       0      
# ... with 36 more variables: Q26_4_3 <chr>, Q26_4_4 <chr>, Q26_5_1 <chr>, Q26_5_2 <chr>, Q26_5_3 <chr>, Q26_5_4 <chr>, Q14_1_1 <chr>, Q14_1_2 <chr>,
#   Q14_1_3 <chr>, Q14_1_4 <chr>, Q14_1_5 <chr>, Q14_1_6 <chr>, Q14_2_1 <chr>, Q14_2_2 <chr>, Q14_2_3 <chr>, Q14_2_4 <chr>, Q14_2_5 <chr>,
#   Q14_2_6 <chr>, Q14_3_1 <chr>, Q14_3_2 <chr>, Q14_3_3 <chr>, Q14_3_4 <chr>, Q14_3_5 <chr>, Q14_3_6 <chr>, Q14_4_1 <chr>, Q14_4_2 <chr>,
#   Q14_4_3 <chr>, Q14_4_4 <chr>, Q14_4_5 <chr>, Q14_4_6 <chr>, Q14_5_1 <chr>, Q14_5_2 <chr>, Q14_5_3 <chr>, Q14_5_4 <chr>, Q14_5_5 <chr>, Q14_5_6 <chr>

परीक्षण डेटा

structure(list(ID = c(1, 2, 3, 4, 5), random_column = c(NA, "orange", 
NA, "apple", "orange"), Q26_1_1 = c(NA, NA, 1, NA, 1), Q26_1_2 = c(NA, 
NA, NA, NA, NA), Q26_1_3 = c(NA, NA, 1, NA, NA), Q26_1_4 = c(NA, 
NA, NA, 1, NA), Q26_2_1 = c(NA, NA, 1, NA, NA), Q26_2_2 = c(NA, 
NA, NA, NA, 1), random_column2 = c("two", "one", NA, "one", NA
), Q26_2_3 = c(NA, NA, 1, NA, 1), Q26_2_4 = c(NA, NA, NA, 1, 
NA), Q26_3_1 = c(NA, NA, 1, NA, 1), Q26_3_2 = c(NA, NA, NA, NA, 
NA), Q26_3_3 = c(NA, NA, NA, NA, NA), Q26_3_4 = c(NA, NA, NA, 
1, NA), Q26_4_1 = c(NA, NA, NA, NA, 1), Q26_4_2 = c(NA, NA, NA, 
NA, NA), Q26_4_3 = c(NA, NA, NA, NA, NA), Q26_4_4 = c(NA, NA, 
1, 1, NA), Q26_5_1 = c(NA, NA, 1, NA, 1), Q26_5_2 = c(NA, NA, 
1, NA, 1), Q26_5_3 = c(NA, NA, 1, NA, 1), Q26_5_4 = c(NA, NA, 
NA, 1, NA), Q14_1_1 = c(NA, NA, NA, NA, NA), Q14_1_2 = c(NA, 
NA, NA, NA, NA), Q14_1_3 = c(NA, NA, 1, NA, 1), Q14_1_4 = c(NA, 
NA, NA, NA, NA), Q14_1_5 = c(NA, NA, NA, NA, NA), Q14_1_6 = c(1, 
1, NA, 1, NA), Q14_2_1 = c(NA, NA, NA, NA, NA), Q14_2_2 = c(NA, 
NA, NA, NA, NA), Q14_2_3 = c(NA, NA, 1, NA, 1), Q14_2_4 = c(NA, 
NA, NA, NA, NA), Q14_2_5 = c(NA, NA, NA, NA, NA), Q14_2_6 = c(1, 
1, NA, 1, NA), Q14_3_1 = c(1, NA, NA, NA, NA), Q14_3_2 = c(1, 
NA, 1, NA, NA), Q14_3_3 = c(NA, NA, 1, NA, 1), Q14_3_4 = c(NA, 
NA, NA, NA, NA), Q14_3_5 = c(NA, NA, NA, NA, NA), Q14_3_6 = c(NA, 
1, NA, 1, NA), Q14_4_1 = c(NA, NA, NA, NA, NA), Q14_4_2 = c(NA, 
NA, NA, NA, NA), Q14_4_3 = c(NA, NA, NA, NA, 1), Q14_4_4 = c(NA, 
NA, NA, NA, NA), Q14_4_5 = c(NA, NA, NA, NA, NA), Q14_4_6 = c(1, 
1, 1, 1, NA), Q14_5_1 = c(NA, NA, NA, NA, NA), Q14_5_2 = c(NA, 
NA, NA, NA, NA), Q14_5_3 = c(NA, NA, 1, NA, 1), Q14_5_4 = c(NA, 
NA, NA, NA, NA), Q14_5_5 = c(NA, NA, NA, NA, NA), Q14_5_6 = c(1, 
1, NA, 1, NA)), row.names = c(NA, -5L), class = c("tbl_df", "tbl", 
"data.frame"))

!!join_by और .do = . %>% ... के बारे में कुछ स्पष्टीकरण

सीधे शब्दों में कहें तो, !! एक विशेष ऑपरेटर है जिसका उपयोग <tidy-select> शब्दार्थ में किया जाता है। यह join_by के मूल्यांकन को बाध्य करता है। दूसरे शब्दों में, यह select फ़ंक्शन को बताता है कि join_by डेटाफ़्रेम में एक चर नहीं है। अधिक विस्तृत स्पष्टीकरण के लिए, इसे देखें आर-ब्लॉग.

.do एक तर्क है जो एक फ़ंक्शन को इसके इनपुट के रूप में लेता है। नाम के साथ कुछ खास नहीं। आप इसे dosomthing या whatever_you_like भी कह सकते हैं। यहाँ कुंजी यह हिस्सा है:

. %>% 
  pivot_longer(-ID, names_to = c("qns", "sub1", "sub2"), names_pattern = "([^_]+)_([^_]+)_([^_]+)") %>% 
  group_by(ID, qns, sub1) %>% 
  mutate(value = if (all(is.na(value))) NA_character_ else replace_na(value, "0")) %>%
  pivot_wider(names_from = c("qns", "sub1", "sub2"))

जब कोई पाइपलाइन . से शुरू होती है, तो पूरी पाइपलाइन एक ही फ़ंक्शन में बदल जाएगी। तो .do = . %>% ... सिर्फ .do तर्क के लिए एक फ़ंक्शन पास कर रहा है। आप आर कंसोल में . %>% + 1 टाइप करने का प्रयास कर सकते हैं और देख सकते हैं कि यह क्या लौटाता है। अधिक जानकारी के लिए, देखें ?`%>%`

1
ekoam 8 अक्टूबर 2020, 18:47