使用多个参数创建一个dataframe [r]的函数

Question

有一个名为泰坦尼克号的数据

Class  Sex   Age Survived
1   3rd Male Child       No
2   3rd Male Child       No
3   3rd Male Child       No
4   3rd Male Child       No
5   3rd Male Child       No
6   3rd Male Child       No
...

框

f1 <- function(sex, age, class, survived){
...
}

我 我输入了乘客的一些标准。例如，我希望能够将标准输入到

f1("Female", "Child","3rd", "Yes")

现在返回

     Class    Sex   Age Survived
1534   3rd Female Child      Yes
1535   3rd Female Child      Yes
1536   3rd Female Child      Yes
1537   3rd Female Child      Yes
1538   3rd Female Child      Yes

的函数中，我已经对其进行了硬编码，并且只使用了IF else语句来涵盖所有可能性。

function.q6.1 <- function(sex,age,class,survival){
  if(sex == "Male" & age == "Child" & class == "3rd" & survival == "No"){
    subset(titanic, Sex == "Male" & Age == "Child" & Class == "3rd" & Survived == "No")
  }
  else if(sex == "Female" & age == "Child" & class == "3rd" & survival == "No"){
    subset(titanic, Sex == "Female" & Age == "Child" & Class == "3rd" & Survived == "No")
  }
  else if(sex == "Male" & age == "Adult" & class == "3rd" & survival == "No"){
    subset(titanic, Sex == "Male" & Age == "Adult" & Class == "3rd" & Survived == "No")
  }
...
}

我想知道是否有一种更有效的方法。提前谢谢你。

Answer 1

这假定第一个参数是数据框架，其余参数是每个列以它们出现在数据框架或命名的顺序中的值。

对于未命名参数的这种情况，数据框架的第一列将与相同数量的参数匹配的参数可能少于列。如果命名参数，则匹配将使用这些名称。数据框后的所有参数必须命名或未命名。如果仅通过没有其他参数传递数据框，则无形地返回null。

如果数据框架之后存在非零数量的参数，我们将获得名称或使用第一个n个名称，其中n是数据框后的参数数。然后从DAT中删除Na的行，假设这些行无法匹配。 mapply将连续的列与返回逻辑矩阵的连续参数值进行比较。应用程序返回每个行逻辑值，然后我们按此标记。

我们在测试调用末尾的注释中使用的数据框架可重复显示。

f1 <- function(dat, ...) {
  if (n <- ...length()) {
    if (is.null(nms <- ...names())) nms <- head(names(dat), n)
    dat <- na.omit(dat)
    dat[apply(mapply(`==`, dat[nms], list(...)), 1, all), ]
  }
}

现在，我们运行一些测试

f1(dat, "3rd", "Male", "Child", "No")
##   Class  Sex   Age Survived
## 1   3rd Male Child       No
## 2   3rd Male Child       No
## 3   3rd Male Child       No
## 4   3rd Male Child       No
## 5   3rd Male Child       No
## 6   3rd Male Child       No

f1(dat, "3rd", "Female", "Child", "No")
## [1] Class    Sex      Age      Survived
## <0 rows> (or 0-length row.names)

f1(dat, "3rd")
##   Class  Sex   Age Survived
## 1   3rd Male Child       No
## 2   3rd Male Child       No
## 3   3rd Male Child       No
## 4   3rd Male Child       No
## 5   3rd Male Child       No
## 6   3rd Male Child       No

f1(BOD, 1, 8.3)  # BOD is built into R
##   Time demand
## 1    1    8.3

f1(BOD, demand = 8.3)
##   Time demand
## 1    1    8.3

注意

Lines <- "
Class  Sex   Age Survived
1   3rd Male Child       No
2   3rd Male Child       No
3   3rd Male Child       No
4   3rd Male Child       No
5   3rd Male Child       No
6   3rd Male Child       No"
dat <- read.table(text = Lines)

更新

允许的参数少于列，并允许命名参数。

Answer 2

如果您使用的是data.frame。如您的问题所示，您可以

library(dplyr)
my_filter <- function(sex, age, class, survived) {

  df %>% 
    filter(Sex == sex, Age == age, Class == class, Survived == survived)

}

立即使用my_filter（“女性”，“ child”，“ 3rd”，“ yes”）返回

   Class    Sex   Age Survived
7    3rd Female Child      Yes
8    3rd Female Child      Yes
9    3rd Female Child      Yes
10   3rd Female Child      Yes
11   3rd Female Child      Yes 

Answer 3

#toy dataset
set.seed(1912)
titanic <- data.frame(class = sample(c("1st","2nd","3rd"),100,replace = T),
                      sex = sample(c("Male","Female"),100,replace = T),
                      age = sample(c("Child","Adult"),100,replace = T),
                      survival = sample(c("Yes","No"),100,replace = T)
                      )

f1 <- function(sex,age,class,survival) {
  titanic[titanic$class==class&titanic$sex==sex&titanic$age==age&titanic$survival==survival,]
}

f1("Female", "Child","3rd", "Yes")

class    sex   age survival
11   3rd Female Child      Yes
15   3rd Female Child      Yes
38   3rd Female Child      Yes
71   3rd Female Child      Yes
85   3rd Female Child      Yes
94   3rd Female Child      Yes

Answer 4

更新：

将您的列和条件存储在矢量中，然后将功能应用于数据框：

library(dplyr)
library(stringr)

f1 <- paste(f1, collapse = "|")
cols <- c("Sex", "Age", "Class", "Survived")

my_function <- function(df){
  df %>% 
    select(cols) %>% 
    filter(if_all(everything(), ~str_detect(.,f1))
    )
  }
my_function(df)

第一个答案：

也许另一个策略可能是：

library(dplyr)
library(stringr)

f1 <- paste(f1, collapse = "|")

my_function <- function(df){
  df %>% 
    select(Sex, Age, Class, Survived) %>% 
    filter(if_all(everything(), ~str_detect(.,f1))
    )
  }

my_function(df)

输出：

       Sex   Age Class Survived
1534 Female Child   3rd      Yes
1535 Female Child   3rd      Yes
1536 Female Child   3rd      Yes
1537 Female Child   3rd      Yes
1538 Female Child   3rd      Yes