[英]User defined function with mutate and case_when in R
我想知道是否/如何將調用波紋轉換為可以在我經常處理數據的任務中使用的函數。 可悲的是,我無法從涉及mutate
和case_when
的調用中弄清楚如何設計函數,這兩個函數都依賴於dplyr
包,並且需要多個附加參數。
另外,對於這么多case_when
,呼叫本身對我來說似乎是多余的,也許可以減少使用次數。
歡迎提供有關替代方法的任何幫助和信息。
呼叫看起來像這樣:
library(dplyr)
library(stringr)
test_data %>%
mutate(
multipleoptions_o1 = case_when(
str_detect(multipleoptions, "option1") ~ 1,
is.na(multipleoptions) ~ NA_real_,
TRUE ~ 0),
multipleoptions_o2 = case_when(
str_detect(multipleoptions, "option2") ~ 1,
is.na(multipleoptions) ~ NA_real_,
TRUE ~ 0),
multipleoptions_o3 = case_when(
str_detect(multipleoptions, "option3") ~ 1,
is.na(multipleoptions) ~ NA_real_,
TRUE ~ 0),
multipleoptions_o4 = case_when(
str_detect(multipleoptions, "option4") ~ 1,
is.na(multipleoptions) ~ NA_real_,
TRUE ~ 0)
)
樣本數據:
structure(list(multipleoptions = c("option1", "option2", "option3",
NA, "option2,option3", "option4")), row.names = c(NA, -6L), class = c("tbl_df",
"tbl", "data.frame"))
該函數的期望輸出:
structure(list(multipleoptions = c("option1", "option2", "option3",
NA, "option2,option3", "option4"), multipleoptions_o1 = c(1,
0, 0, NA, 0, 0), multipleoptions_o2 = c(0, 1, 0, NA, 1, 0), multipleoptions_o3 = c(0,
0, 1, NA, 1, 0), multipleoptions_o4 = c(0, 0, 0, NA, 0, 1)), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -6L))
該函數的參數可能應該是: data
(即輸入數據集), multipleoptions
(即包含答案選項的數據中的列,始終為一列), patterns_to_look_for
(即,str_detect模式以在多個選項中查找), number_of_options
(理想情況下)選項的數量可以大於或小於4(我不確定是否可以實現), output_columns
(即新列的名稱,它始終是名稱或原始列,后跟選項編號或選項名稱)。
通過將選項拆分為單獨的元素,利用嵌套/取消嵌套獲取選項的單個列,然后擴展為每個選項獲取單獨的列,可以避免冗長的case_when
代碼。
更新的答案
library(tidyverse)
# Arguments
# data A data frame
# patterns Regular expression giving the pattern(s) at which to split the options strings
# ... Grouping columns, the first of which must be the "options" column.
# If options has repeated values, then there must be a second grouping
# column (an "ID" column) to differentiate these repeated values.
fnc = function(data, patterns, ...) {
col = quos(...)
data %>%
mutate(option=str_split(!!!col[[1]], patterns)) %>%
unnest %>%
mutate(value=1) %>%
group_by(!!!col) %>%
mutate(num_chosen = ifelse(is.na(!!!col[[1]]), 0, sum(value))) %>%
spread(option, value, fill=0) %>%
select_at(vars(-matches("NA")))
}
fnc(test_data, ",", multipleoptions)
multipleoptions num_chosen option1 option2 option3 option4 1 option1 1 1 0 0 0 2 option2 1 0 1 0 0 3 option2,option3 2 0 1 1 0 4 option3 1 0 0 1 0 5 option4 1 0 0 0 1 6 <NA> 0 0 0 0 0
# Fake data
ops = paste0("option",1:4)
set.seed(2)
d = data_frame(var=replicate(20, paste(sample(ops, sample(1:4,1, prob=c(10,8,5,1))), collapse=",")))
# Add missing values
d = bind_rows(d[1:5,], data.frame(var=rep(NA,3)), d[6:nrow(d),])
fnc(d %>% mutate(ID=1:n()), ",", var, ID)
var ID num_chosen option1 option2 option3 option4 1 option1 17 1 1 0 0 0 2 option1,option2 12 2 1 1 0 0 3 option1,option2,option3 5 3 1 1 1 0 4 option1,option2,option4,option3 9 4 1 1 1 1 5 option1,option3 2 2 1 0 1 0 6 option1,option3,option4 3 3 1 0 1 1 7 option1,option4,option2 20 3 1 1 0 1 8 option1,option4,option3,option2 13 4 1 1 1 1 9 option2 11 1 0 1 0 0 10 option2,option3 23 2 0 1 1 0 11 option2,option3,option4 21 3 0 1 1 1 12 option3 1 1 0 0 1 0 13 option3 15 1 0 0 1 0 14 option3,option1 4 2 1 0 1 0 15 option3,option2,option4 14 3 0 1 1 1 16 option3,option4,option2,option1 22 4 1 1 1 1 17 option4 10 1 0 0 0 1 18 option4 16 1 0 0 0 1 19 option4 18 1 0 0 0 1 20 option4,option2,option3 19 3 0 1 1 1 21 <NA> 6 0 0 0 0 0 22 <NA> 7 0 0 0 0 0 23 <NA> 8 0 0 0 0 0
原始答案
test_data %>%
filter(!is.na(multipleoptions)) %>%
mutate(option=str_split(multipleoptions, ",")) %>%
unnest %>%
mutate(value=1) %>%
spread(option, value)
multipleoptions option1 option2 option3 option4 <chr> <dbl> <dbl> <dbl> <dbl> 1 option1 1 NA NA NA 2 option2 NA 1 NA NA 3 option2,option3 NA 1 1 NA 4 option3 NA NA 1 NA 5 option4 NA NA NA 1
將其打包成一個函數:
fnc = function(data, col, patterns) {
col = enquo(col)
data %>%
filter(!is.na(!!col)) %>%
mutate(option=str_split(!!col, patterns)) %>%
unnest %>%
mutate(value=1) %>%
spread(option, value)
}
fnc(test_data, multipleoptions, ",")
如果您的實際數據有超過一排用相同的值multipleoptons
,那么這段代碼將只如果有也是一個工作ID
列有相同的值區分不同的行multipleoptions
。 例如:
# Fake data
ops = paste0("option",1:4)
set.seed(2)
d = data.frame(var=replicate(20, paste(sample(ops, sample(1:4,1, prob=c(10,8,5,1))), collapse=",")))
fnc(d, var, ",")
錯誤:行(1、27),(16、28、30)的標識符重復
# Add unique row identifier
fnc(d %>% mutate(ID = 1:n()), var, ",")
var ID option1 option2 option3 option4 1 option1 14 1 NA NA NA 2 option1,option2 9 1 1 NA NA 3 option1,option2,option3 5 1 1 1 NA 4 option1,option2,option4,option3 6 1 1 1 1 5 option1,option3 2 1 NA 1 NA 6 option1,option3,option4 3 1 NA 1 1 7 option1,option4,option2 17 1 1 NA 1 8 option1,option4,option3,option2 10 1 1 1 1 9 option2 8 NA 1 NA NA 10 option2,option3 20 NA 1 1 NA 11 option2,option3,option4 18 NA 1 1 1 12 option3 1 NA NA 1 NA 13 option3 12 NA NA 1 NA 14 option3,option1 4 1 NA 1 NA 15 option3,option2,option4 11 NA 1 1 1 16 option3,option4,option2,option1 19 1 1 1 1 17 option4 7 NA NA NA 1 18 option4 13 NA NA NA 1 19 option4 15 NA NA NA 1 20 option4,option2,option3 16 NA 1 1 1
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.