满足条件的逐行操作的整洁解决方案

Question

我被困在如何开发一个整洁的解决方案，该解决方案将逐行查看是否在每一行中唯一地满足条件。

具体来说，我有使用评分量表的调查回复数据。评级量表中的类别数量可能因项目而异。我的数据是宽格式的。

数据示例如下。

• 在这些数据中，标题为“项目”的列索引了每个调查项目。
• 标题为“Cat_1”到“Cat_5”的列是跨项目的评级量表类别。这些单元格中的值代表支持某个等级量表类别的受访者百分比。项目 1 在评级量表中有 5 个有效类别，这就是为什么值出现在标题为“Cat_1 到 'Cat_5”的列中的原因。 Item_2 有 4 个可能的评级量表类别。 Item_2 的“Cat_5”中的 NA 表明这不是该项目评分量表的有效类别。
• 标题为“Percent_missing”的列是每个项目的缺失数据百分比（用于模拟数据的实际应用）。
• 标题为“flr_ceil”的列是我想用来查看每个项目的第一个或最后一个有效评级量表类别是否超过其阈值的阈值。

理想情况下，我想添加一个名为“thresh_met”的列，根据每个项目的第一个或最后一个有效评级量表类别是否超过其阈值，该列被编码为 0/1。例如，对于“Item_1”，“thresh_met”的值将是 1，因为 Cat_1 == 33，大于其阈值 25。这与 Item_2 的“thresh_met”值 = 0 形成对比，因为这两个值都不是Cat_1 或 Cat_4 的数量超过了 22 的阈值。

数据看起来像这样：

Items  | Cat_1  |  Cat_2  |  Cat_3  |  Cat_4  |  Cat_5  |  Percent_missing | flr_ceil         |
Item_1 | 33     |  23     | 23      |  21     |  0      |   2              | 25               |
Item_2 | 20     |  30     | 20      |  10     |  NA     |   4              | 22               |

到目前为止我开发的代码如下。应该清楚我卡在哪里了。在此代码中，我要使用的阈值标记为“flr_ceil”。

代码：

# load packages and create data
if(!require("pacman"))install.packages("pacman")
p_load(tidyverse, magrittr, mice)

sample_dat <- tibble(
  Item_1 = sample(0:4, 100, replace = TRUE, prob = c(0.1, 0.2, 0.4, 0.2, 0.1)),
  Item_2 = sample(0:4, 100, replace = TRUE, prob = c(0.4, 0.2, 0.05, 0.2, 0.15)),
  Item_3 = sample(0:5, 100, replace = TRUE, prob = c(0.2, 0.2, 0.1, 0.2, 0.1, 0.2)),
  Item_4 = sample(0:4, 100, replace = TRUE, prob = c(0.6, 0.1, 0.2, 0.05, 0.05))) %>%
  mice::ampute(prop = .25) %$%
  amp

# get the valid number of categories for each item
col_names <- colnames(sample_dat) # for sorting at end of the pipe

cat_counts <-  sample_dat %>% 
  gather(key = Item, value = rating)  %>% 
  group_by(Item, rating) %>%
  summarise(
    n = n()) %>%
  group_by(Item) %>%
  summarise(
    flr_ceil = (1/n())*100
  ) %>%
  arrange(match(Item, col_names))

sample_dat %>% 
  gather(key = Item, value = rating)  %>% 
  group_by(Item, rating) %>%
  summarise(
    n = n()) %>%
  mutate(
    prop = (n/sum(n))*100
  ) %>%
  select(Item, rating, prop) %>%
  spread(rating, prop) %>%
  arrange(match(Item, col_names)) %>%
  left_join(cat_counts) 

Answer 1

下面是一个可能有用的 tidyverse 解决方案：

1. 将数据 (df) 转换为长格式，每个 Item 和 Category 都有一行
2. 删除具有NA 值的行
3. 按Item 分组并按Category 名称排列行
4. 检查第一个或最后一个类别值是否超过flr_ceil中的阈值

您可以通过join 或mutate 调用将新列thresh_met 添加回df。

library(tidyverse)

## df is generated using the code in the question
df
#> # A tibble: 4 x 8
#> # Groups:   Item [4]
#>   Item   Cat_1 Cat_2 Cat_3 Cat_4 Cat_5 Cat_6 flr_ceil
#>   <chr>  <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>    <dbl>
#> 1 Item_1    10    20    34   25      4    NA     16.7
#> 2 Item_2    43    15     5   23     11    NA     16.7
#> 3 Item_3    21    18     6   17     10    20     14.3
#> 4 Item_4    51    16    19    7.     2    NA     16.7

gather(df, key = "Category", value = "Value", starts_with("Cat")) %>%    
    na.omit() %>%                                                        
    group_by(Item) %>%                                                  
    arrange(Category) %>%                                               
    summarize(thresh_met = as.integer(any(Value[c(1, n())] > flr_ceil[c(1, n())])))
#> # A tibble: 4 x 2
#>   Item   thresh_met
#>   <chr>       <int>
#> 1 Item_1          0
#> 2 Item_2          1
#> 3 Item_3          1
#> 4 Item_4          1

^{由reprex package (v0.3.0) 于 2019 年 6 月 19 日创建}