如何为数据框的每一行创建一个意外事件 table
how to create a contingency table for each row of a data frame
我有一个大型数据框，其中行作为物种，从 2 年开始计数作为列。我想为每一行创建一个意外事件 table 以测试从第一年到第二年是否有显着变化（减少）。这是类似的假装数据：
Species 2016 2017
cat 14 8
dog 16 12
bird 10 5
然后对于每一行我想要一个 table 比如：
cat 2017 2018
present 14 8
absent 0 6
dog 2017 2018
present 16 12
absent 0 4
bird 2017 2018
present 10 5
absent 0 5
有了这个，我将对每个 table 进行 Fisher 精确检验，以检验减少是否显着。
我认为这可以通过 dplyr 或应用循环来完成，类似于下面的 link 但我不确定如何首先构建正确的 table 列表。
我从一行开始：
A <- df[1,1:3]
A[2,] <- 0
A[2,3] <- (A[1,2] - A[1,3])
fisher.test(A[2:3])
非常感谢有关如何将其应用于大量行的建议！我的大脑真的很难编码。
这是一个使用 base R 的解决方案。您可以使用此答案中的一些想法来做出更简洁的答案。让我知道这是否适合您！
# Create dataframe
df <- data.frame(Species = c("cat", "dog", "bird"),
year_2016 = c(14, 16, 10),
year_2017 = c(8, 12, 5),
stringsAsFactors = F)
# Create columns to later convert to a matrix
df$absent <- 0
df$present <- df$year_2016 - df$year_2017
# Tranpose the dataframe to use lapply
df_t <- t(df)
colnames(df_t) <- as.vector(df_t[1,])
df_t <- df_t[-1,]
class(df_t) <- "numeric"
# Use lapply to create matrices
matrix_list <- lapply(1:ncol(df_t), function(x) matrix(as.vector(df_t[,x]), 2, 2, byrow = T))
names(matrix_list) <- colnames(df_t)
matrix_list
$cat
[,1] [,2]
[1,] 14 8
[2,] 0 6
$dog
[,1] [,2]
[1,] 16 12
[2,] 0 4
$bird
[,1] [,2]
[1,] 10 5
[2,] 0 5
# Lots of fisher.tests
lapply(matrix_list, fisher.test)
$cat
Fisher's Exact Test for Count Data
data: X[[i]]
p-value = 0.01594
alternative hypothesis: true odds ratio is not equal to 1
95 percent confidence interval:
1.516139 Inf
sample estimates:
odds ratio
Inf
$dog
Fisher's Exact Test for Count Data
data: X[[i]]
p-value = 0.1012
alternative hypothesis: true odds ratio is not equal to 1
95 percent confidence interval:
0.7200866 Inf
sample estimates:
odds ratio
Inf
$bird
Fisher's Exact Test for Count Data
data: X[[i]]
p-value = 0.03251
alternative hypothesis: true odds ratio is not equal to 1
95 percent confidence interval:
1.195396 Inf
sample estimates:
odds ratio
Inf
然后，如果您想要 p 值，可以使用 sapply:
将它们放入向量中
sapply(tests, "[[", "p.value")
cat dog bird
0.01594203 0.10122358 0.03250774
编辑：这可能是一个小改进。它更简洁一些。今天晚些时候，如果您关心性能（或者您对 运行 进行了大量测试），我可以检查它如何随 microbenchmark 扩展。另外，请记住用所有这些测试来惩罚那些 p 值；）。此外，@tmfmnk posted 一个很棒的 tidyverse 解决方案，如果你更喜欢 tidyverse 而不是 base。
# Create columns to later convert to a matrix
df$absent <- 0
df$present <- df$year_2016 - df$year_2017
df_t <- t(df[-1]) # tranpose dataframe excluding column of species
# Use lapply to create the list of matrices
matrix_list <- lapply(1:ncol(df_t), function(x) matrix(as.vector(df_t[,x]), 2, 2, byrow = T))
names(matrix_list) <- df$Species
# Running the fisher's test on every matrix
# in the list and extracting the p-values
tests <- lapply(matrix_list, fisher.test)
sapply(tests, "[[", "p.value")
cat dog bird
0.01594203 0.10122358 0.03250774
上次编辑。能够 运行 他们通过 microbenchmark 并希望 post 为将来遇到此 post 的任何人提供结果：
Unit: milliseconds
expr min lq mean median uq max neval
tidyverse_sol 12.506 13.497 15.130 14.560 15.827 26.205 100
base_sol 1.120 1.162 1.339 1.225 1.296 5.712 100
一个 tidyverse 可能性是：
library(tidyverse)
library(broom)
df %>%
rowid_to_column() %>%
gather(var, present, -c(Species, rowid)) %>%
arrange(rowid, var) %>%
group_by(rowid) %>%
mutate(absent = lag(present, default = first(present)) - present) %>%
ungroup() %>%
select(-rowid, -var) %>%
nest(present, absent) %>%
mutate(p_value = data %>%
map(~fisher.test(.)) %>%
map(tidy) %>%
map_dbl(pluck, "p.value")) %>%
select(-data)
Species p_value
<chr> <dbl>
1 cat 0.0159
2 dog 0.101
3 bird 0.0325
在这里，它首先执行从宽到长的数据转换，不包括列 "Species" 和引用行 ID 的列。其次，它根据行 ID 和引用年份和组的原始列名按行 ID 排列数据。第三，它计算了年份之间的差异。最后，它嵌套每个物种的存在和缺失变量并执行 fisher.test，然后 returns 每个物种的 p 值。
我有一个大型数据框，其中行作为物种，从 2 年开始计数作为列。我想为每一行创建一个意外事件 table 以测试从第一年到第二年是否有显着变化（减少）。这是类似的假装数据：
Species 2016 2017
cat 14 8
dog 16 12
bird 10 5
然后对于每一行我想要一个 table 比如：
cat 2017 2018
present 14 8
absent 0 6
dog 2017 2018
present 16 12
absent 0 4
bird 2017 2018
present 10 5
absent 0 5
有了这个，我将对每个 table 进行 Fisher 精确检验，以检验减少是否显着。
我认为这可以通过 dplyr 或应用循环来完成，类似于下面的 link 但我不确定如何首先构建正确的 table 列表。
我从一行开始：
A <- df[1,1:3]
A[2,] <- 0
A[2,3] <- (A[1,2] - A[1,3])
fisher.test(A[2:3])
非常感谢有关如何将其应用于大量行的建议！我的大脑真的很难编码。
这是一个使用 base R 的解决方案。您可以使用此答案中的一些想法来做出更简洁的答案。让我知道这是否适合您！
# Create dataframe
df <- data.frame(Species = c("cat", "dog", "bird"),
year_2016 = c(14, 16, 10),
year_2017 = c(8, 12, 5),
stringsAsFactors = F)
# Create columns to later convert to a matrix
df$absent <- 0
df$present <- df$year_2016 - df$year_2017
# Tranpose the dataframe to use lapply
df_t <- t(df)
colnames(df_t) <- as.vector(df_t[1,])
df_t <- df_t[-1,]
class(df_t) <- "numeric"
# Use lapply to create matrices
matrix_list <- lapply(1:ncol(df_t), function(x) matrix(as.vector(df_t[,x]), 2, 2, byrow = T))
names(matrix_list) <- colnames(df_t)
matrix_list
$cat
[,1] [,2]
[1,] 14 8
[2,] 0 6
$dog
[,1] [,2]
[1,] 16 12
[2,] 0 4
$bird
[,1] [,2]
[1,] 10 5
[2,] 0 5
# Lots of fisher.tests
lapply(matrix_list, fisher.test)
$cat
Fisher's Exact Test for Count Data
data: X[[i]]
p-value = 0.01594
alternative hypothesis: true odds ratio is not equal to 1
95 percent confidence interval:
1.516139 Inf
sample estimates:
odds ratio
Inf
$dog
Fisher's Exact Test for Count Data
data: X[[i]]
p-value = 0.1012
alternative hypothesis: true odds ratio is not equal to 1
95 percent confidence interval:
0.7200866 Inf
sample estimates:
odds ratio
Inf
$bird
Fisher's Exact Test for Count Data
data: X[[i]]
p-value = 0.03251
alternative hypothesis: true odds ratio is not equal to 1
95 percent confidence interval:
1.195396 Inf
sample estimates:
odds ratio
Inf
然后，如果您想要 p 值，可以使用 sapply:
sapply(tests, "[[", "p.value")
cat dog bird
0.01594203 0.10122358 0.03250774
编辑：这可能是一个小改进。它更简洁一些。今天晚些时候，如果您关心性能（或者您对 运行 进行了大量测试），我可以检查它如何随 microbenchmark 扩展。另外，请记住用所有这些测试来惩罚那些 p 值；）。此外，@tmfmnk posted 一个很棒的 tidyverse 解决方案，如果你更喜欢 tidyverse 而不是 base。
# Create columns to later convert to a matrix
df$absent <- 0
df$present <- df$year_2016 - df$year_2017
df_t <- t(df[-1]) # tranpose dataframe excluding column of species
# Use lapply to create the list of matrices
matrix_list <- lapply(1:ncol(df_t), function(x) matrix(as.vector(df_t[,x]), 2, 2, byrow = T))
names(matrix_list) <- df$Species
# Running the fisher's test on every matrix
# in the list and extracting the p-values
tests <- lapply(matrix_list, fisher.test)
sapply(tests, "[[", "p.value")
cat dog bird
0.01594203 0.10122358 0.03250774
上次编辑。能够 运行 他们通过 microbenchmark 并希望 post 为将来遇到此 post 的任何人提供结果：
Unit: milliseconds
expr min lq mean median uq max neval
tidyverse_sol 12.506 13.497 15.130 14.560 15.827 26.205 100
base_sol 1.120 1.162 1.339 1.225 1.296 5.712 100
一个 tidyverse 可能性是：
library(tidyverse)
library(broom)
df %>%
rowid_to_column() %>%
gather(var, present, -c(Species, rowid)) %>%
arrange(rowid, var) %>%
group_by(rowid) %>%
mutate(absent = lag(present, default = first(present)) - present) %>%
ungroup() %>%
select(-rowid, -var) %>%
nest(present, absent) %>%
mutate(p_value = data %>%
map(~fisher.test(.)) %>%
map(tidy) %>%
map_dbl(pluck, "p.value")) %>%
select(-data)
Species p_value
<chr> <dbl>
1 cat 0.0159
2 dog 0.101
3 bird 0.0325
在这里，它首先执行从宽到长的数据转换，不包括列 "Species" 和引用行 ID 的列。其次，它根据行 ID 和引用年份和组的原始列名按行 ID 排列数据。第三，它计算了年份之间的差异。最后，它嵌套每个物种的存在和缺失变量并执行 fisher.test，然后 returns 每个物种的 p 值。