как создать таблицу сопряженности для каждой строки фрейма данных

Question

У меня есть большой фрейм данных со строками в виде видов и отсчетами от 2 лет в виде столбцов.Я хочу создать таблицу непредвиденных расходов для каждой строки, чтобы проверить, произошло ли значительное изменение (уменьшение) с первого по второй год.Вот аналогичные данные для притворства:

Species   2016    2017
cat        14      8
dog        16      12
bird       10      5

, а затем для каждой строки я хочу таблицу типа:

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

После этого я проведу точный тест Фишера для каждой таблицы, чтобы проверитьЕсли уменьшение было значительным или нет.

Я думаю, что это можно сделать с помощью dplyr, или применить циклический переход по строкам, аналогичным ссылке ниже, но я не уверен, как сначала составить правильный список таблиц. Как преобразовать фрейм данных в таблицу сопряженности в R?

Я начал с одной строки за раз:

A <- df[1,1:3]
A[2,] <- 0
A[2,3] <- (A[1,2] - A[1,3])
fisher.test(A[2:3])

Рекомендации по применению этого к большомуколичество строк будет принята с благодарностью!Мой мозг действительно борется с кодированием.

Answer 1

Одна 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

Здесь он, во-первых, выполняет преобразование данных с широкой в ​​длинную, исключая столбцы «Вид» и столбец, относящийся к идентификатору строки.Во-вторых, он упорядочивает данные в соответствии с идентификатором строки и исходными именами столбцов со ссылкой на годы и группы по идентификатору строки.В-третьих, он рассчитывает разницу между годами.Наконец, он вкладывает существующие и отсутствующие переменные для каждого вида и выполняет fisher.test, а затем возвращает p-значения для каждого вида.

Answer 2

Вот решение с использованием базы 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 опубликовал отличное решение tidyverse, если вы предпочитаете Tidyverse над базой.

# 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 и хотел публиковать результаты для тех, кто сталкивается с этим постом в будущем:

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