使用 tidyverse 和 dplyr 映射数据集，计算观测值，列出 id，然后 re-count 遵循特定标准的观测值
Using tidyverse and dplyr to map the dataset, count observations, list ids and then re-count the observations following specific criteria
在教育环境中，使用多个测试（c_sum、cg_sum、... , 在 df) 中，然后检查它们是否比平均值低 1 个标准差（结果中的 monitor）或者他们是否需要再次进行测试（below）。我可以计算两种情况下 children 的百分比（monitor 和 below）。
但是，现在我想发现 children 在 中的 monitoring zone 的百分比只是一个主题 ， 或两个科目、或三个科目，依此类推。最多5个科目。然后，我将计算一个域或两个域中的 below group 中有多少 children，等等
输出可能是这样的：
请注意：68% 的参与者未在 monitoring zone 中分类。 21% 的参与者在一次测试中达到 monitoring zone。 9% 的参与者在两次测试中 monitoring zone
我想return到数据集data，获取所有id，然后统计这个id出现了多少次，但我不确定这是否是正确的路径得到这个 result.I我也知道 crossing 函数，但我不知道如何正确使用它。
我用来获取 monitoring zone 和 below 百分比的代码是：
df %>%
select(id, quest, ends_with("sum")) %>%
pivot_longer(-c(id, quest)) %>% #tranform into long format
nest_by(quest, name) %>% #nest
#here is the trick. all counts are here
mutate(
n = map_dbl(data[2], ~nrow(data.frame(.))), #compute sample size
mean = map_dbl(data[2], ~mean(.)), #get the ROBUST means
sd = map_dbl(data[2], ~sd(.)), #get the ROBUST sd
one_below = mean-sd, #1 below
two_below = mean - 2 * sd,
monitor = sum(one_below >= data[[2]] & two_below < data[[2]])/n,
below = sum(two_below > data[[2]])/n)
而这段代码我用来检查 children 在监控区域中有一个、两个或更多结果的百分比
df %>%
filter(quest == 2) %>%
select(quest, ends_with("sum")) %>%
mutate(c_monitor =
if_else(c_sum <= mean(c_sum)-1*sd(c_sum) & c_sum > mean(c_sum)-2*sd(c_sum), 1,0),
gm_monitor =
if_else(gm_sum <= mean(gm_sum)-1*sd(c_sum) & gm_sum > mean(gm_sum)-2*sd(gm_sum), 1,0),
fm_monitor =
if_else(fm_sum <= mean(fm_sum)-1*sd(fm_sum) & fm_sum > mean(fm_sum)-2*sd(fm_sum), 1,0),
cg_monitor =
if_else(cg_sum <= mean(cg_sum)-1*sd(cg_sum) & cg_sum > mean(cg_sum)-2*sd(cg_sum), 1,0),
ps_monitor =
if_else(ps_sum <= mean(ps_sum)-1*sd(ps_sum) & ps_sum > mean(ps_sum)-2*sd(ps_sum), 1,0)) %>%
ungroup() %>%
mutate(c_monitor =
if_else(c_sum <= mean(c_sum)-1*sd(c_sum) & c_sum > mean(c_sum)-2*sd(c_sum), 1,0),
gm_monitor =
if_else(gm_sum <= mean(gm_sum)-1*sd(c_sum) & gm_sum > mean(gm_sum)-2*sd(gm_sum), 1,0),
fm_monitor =
if_else(fm_sum <= mean(fm_sum)-1*sd(fm_sum) & fm_sum > mean(fm_sum)-2*sd(fm_sum), 1,0),
cg_monitor =
if_else(cg_sum <= mean(cg_sum)-1*sd(cg_sum) & cg_sum > mean(cg_sum)-2*sd(cg_sum), 1,0),
ps_monitor =
if_else(ps_sum <= mean(ps_sum)-1*sd(ps_sum) & ps_sum > mean(ps_sum)-2*sd(ps_sum), 1,0)) %>%
mutate(c_below =
if_else(c_sum <= mean(c_sum)-2*sd(c_sum), 1,0),
gm_below =
if_else(gm_sum <= mean(gm_sum)-2*sd(gm_sum), 1,0),
fm_below =
if_else(fm_sum <= mean(fm_sum)-2*sd(fm_sum), 1,0),
cg_below =
if_else(cg_sum <= mean(cg_sum)-2*sd(cg_sum), 1,0),
ps_below =
if_else(ps_sum <= mean(ps_sum)-2*sd(ps_sum), 1,0)) %>%
ungroup() %>%
mutate(how_many_monitor = rowSums(select(., c_monitor, gm_monitor, fm_monitor, cg_monitor, ps_monitor))) %>%
mutate(how_many_below = rowSums(select(., c_below, gm_below, fm_below, cg_below, ps_below))) %>%
select(starts_with("how_many")) %>%
pivot_longer(everything()) %>%
group_by(name, value) %>%
summarise(n=n()) %>%
mutate(prop = prop.table(n)*100) %>%
arrange(desc(name)) %>%
pivot_wider(id_cols = value, names_from = name, values_from = prop)
数据如下
df = structure(list(id = c("0c82badd-3bf2-41ce-99a8-39744fa1a4eb",
"44042bad-974f-4964-85fd-434f9034c84a", "3ac57afb-8c94-4b20-9d8b-8b64ff59adb2",
"7329063b-7050-4c2b-b8b3-286df50989be", "52a022", "bef816c4-04bb-4727-90ee-b778eca79e64",
"1cf5b895-68be-4db3-bd5e-106765af5743", "ebc3435d-7422-4bf3-8d54-065742a5c5d3",
"4968d4a1-a40c-4ee6-ad68-8a5b4521e97e", "c2aaae70-e971-4817-888c-2e7c892d3efe",
"f1395902-2c1a-4eda-92a5-3b09fe916b5f", "8c32e64c-6873-49bc-af55-3ce2de367960",
"76983d8f-6291-4669-9b82-c080e3178e42", "232cccbd-f2c9-4858-a302-516208151a11",
"bb623164-7b97-47a0-b57b-727a99297e06", "488403bb-6116-4e49-945a-3559dfc0cad3",
"5ef34de7-f995-44d5-9224-e18c7f45f056", "51c01fb6-f575-4b47-ac08-6b1ba8ddd938",
"b4141c4e-ba3e-48a9-b025-d1365f31c184", "c6774d33-ddd9-470f-a408-32c83aac07d8",
"17a86d4f-ff5b-4d77-bd76-41057d6ec5f2", "6dd2a77d-e92e-438a-a2b2-2d22eb7edaf4",
"f40115d9-fca6-4432-a888-9299348124c5", "d36850", "fcfba97c-78d5-454c-8591-4651b89f83de",
"fe5fccd9-560a-43c0-a4b0-086132be77e1", "9268a298-38e4-49e6-ba53-23f2559a0b85",
"6979bbce-6272-4519-b226-d969ecba9ff0", "f1a00d10-9283-4c8b-99be-447973b21bec",
"5229a289-dce2-4ecc-a07e-36109ddbd502", "22ef9b3a-a866-47f7-b688-1e3c8575a8e7",
"3f4b036f-5201-4b4d-b03f-489aa9659028", "b67029f5-4be8-4913-ac39-975774253dcd",
"1560", "4f7aa6", "1f0c4f9a-a103-4e52-a033-01a6f48cce63", "cf694f",
"39c6b7f4-1964-476c-9616-0380bdfc836b", "94c98b67-9780-4bad-9f1a-39c7ca02805d",
"b567d8f9-a97a-4cdc-9b4b-108db54711e9", "24f68031-0e1e-4433-a950-f68c67a25d5d",
"5359", "4cd39e1b-8acf-4632-ab5a-d25cd969c427", "75863be5-f780-4ef2-bc6a-c1374cd628bc",
"360a31d0-d1c7-462d-b163-33f4b3f97426", "aed72a91-8ea2-40c0-9ead-6054c5b4aa73",
"fee10722-53d9-4dea-a8dd-d769406e7dfe", "4301d5a1-e677-455a-968e-710cb476a474",
"6be4de", "7d8103cd-22af-4295-a7af-20e8d7118ac1", "88806559-1367-4408-81ea-285fa78b7230",
"c446b04f-640a-4b13-baec-f089a6275bce", "3057", "61bdf3", "033539",
"fd2a061f-d9bc-4e28-bf05-e8d7dff6b94e", "748d7bac-56b0-4ac3-906a-8b8ff0daaf5f",
"08868e5b-2f6c-4dab-bf41-c2fc2ae52291", "368cfae0-c3b0-416d-8f2e-74b656c8cd2d",
"a2c287f2-4d4d-4d4a-a115-ebaccc6f8d7d", "4228c1d7-63b4-4756-87bc-8d62298f2cd4",
"ee691627-65b0-4137-a331-5923825bc98c", "dec357", "3154177d-ff23-4cbd-9a0c-49eb532657fb",
"98f1e706-f046-479c-8256-7e0fa12865c9", "a54eab2e-d45f-437d-b171-8b203dea71be",
"ff90b21a-7507-4605-90fa-a5e552b45270", "9edc3e9a-bbd1-46ee-85e6-5804e820135f",
"94e384", "28fac058-38c5-4bea-995e-e9687bf05aa9", "43417039-29fe-4acd-84c4-67ab1e4a5a8f",
"3612", "df81e4", "e5bed2cb-2e42-41b4-b21b-e9617bf63b31", "6ed6f533-ef04-4869-91c2-b986fb59bceb",
"3da6d57e-ccba-4f22-855e-60582b743003", "8a51dbdc-4935-4790-84a1-9b6f58803437",
"c1773b8b-3994-4261-ac26-0b2b5be747fe", "7b13fee5-2ef4-4d6a-9476-1bef62704613",
"2c1a67a5-b651-48f2-85eb-71d599a53802", "f3d4de8e-d84c-438a-aa28-34e4987e7012",
"a0ce8268-ba3f-4868-8f99-31466046d728", "c9423932-d6f7-4b56-8d20-83b061e42f7f",
"dfe249d3-ceab-4032-abcf-86f767d0e800", "b9409d71-71a1-4cb8-b23a-c1dd2c75a79b",
"a865c6c0-9981-477b-9b74-c4587b9ccd87", "5f9ea55f-88a9-48ac-bb62-f9bfe75308fb",
"1164", "31076bf6-7589-46b0-8bed-71013ab54f9b", "c9e2a3c3-1304-44d2-8ccc-dbc0dbd48d2a",
"6d9d76f5-9884-4f42-b89d-b47dc9ead3ac", "3c8b7cf6-3157-4a66-8137-fbb2833b501f",
"728920eb-0a53-4f8b-9b1a-4bf08f0fcbfb", "4ac02b40-e31b-4cac-8567-8abdff83dc2b",
"1073", "4b18c1e7-89f8-444b-ab72-494ea4bd9d2a", "240d3439-2942-4733-9d92-a021af21cfc4",
"871a5920-5e5c-4081-8604-f0f44adc1e78", "cb1a46", "f3865310-80be-424d-a1f7-f7882f886a1d",
"6e0601d7-0d78-4e44-b179-729b946fcd69", "b3e3a4f0-fac7-4214-815c-d06944003295",
"a7ab32d4-72df-40a4-babd-0364ed31f26d", "0d6c95", "755635eb-6277-4700-aa5b-7424c557d364",
"06c853ae-7619-4c49-ad06-a930ccea8e53", "5c112618-e9ba-4436-a512-279c22c41836",
"83668a", "96074678-3432-4832-a310-2666c5e02a4c", "111026fd-1515-4f77-9fd2-453c872b4e07",
"2fcaa4", "a228c4", "ad06441a-efa1-41ed-83db-d2c997ca5000", "528c84f3-0a58-40ac-9b18-71f3c9d82d7e",
"4b58598c-377f-442c-8285-0a7d1aa905b4", "15bef130-7c0e-47a4-bdc8-5166d4eac0d9",
"1353", "f3087b35-e6cd-4bf9-8ae4-1a5c8fbc9207", "12a83cb7-d4aa-48b5-b696-825f73426982",
"2082", "9c6f9b53-9d11-4c3d-91c1-284222d29705", "80b0c451-96d5-4b95-a63c-624d9d3060d3",
"771ac1e4-e677-4041-90c2-b297e73abb7b", "c8f2d425-3523-421b-9b95-e4b7c57e81cb",
"70d97a8e-ae8d-46a9-b63b-5a901d1d6e11", "9da1e867-aae3-43fe-8417-9817334a68d9",
"c9491a", "2155", "fbe2178f-c1b9-486f-8ed3-74a96badc3cb", "f1af3929-83d2-4b2a-b535-fccbfb78c830",
"3149", "8cbec309-16e8-40d8-b1b3-6951df048f87", "f6168740-052c-4e05-b588-48766d79db32",
"51f7a031-7c2b-4951-b66e-e7f5db460ac5", "57a0a6a3-3eca-4f87-82e4-e5ef4b10ffb4",
"cee16812-b4b4-4645-9691-b96bf45ce2e9", "5238", "5109", "681f0157-a480-433e-a5e4-32c41a28eb87",
"26d5de09-ddc5-42be-a49f-d9392957c11c", "b81575", "b5d49242-44b6-4644-921d-7c48c1b37e9d",
"56877e8b-add3-4a50-aa41-a4b174475708", "3a0279", "2e8c88a3-85ef-48e9-90ac-cc38f0f6ac63",
"25e132c3-5ee1-47f5-b9e7-ec0d6b928e9f", "d0f89c2b-0759-4966-9d65-72ec0b88da27",
"51d51da3-75fc-472e-8d05-7362fcb42b33", "527743c7-cad0-4ec9-95de-23b594b3793b",
"c04fa726-ad03-40c6-b04d-82a6d60fa362", "31fc06f9-c612-453f-9904-ed9703520205",
"adc7626f-3af7-4b3e-b4f5-1be28cdc917b", "b0b8ad67-6391-4003-af23-09a16802207f",
"3436", "158b0cbc-b374-4dc2-a136-450fdb1814bf", "7ed70547-41bd-4a77-8646-84c3a404ac97",
"7183788f-1d55-483b-99e2-53534d72e879", "8c4961da-602a-4834-908d-2d6a7f26e490",
"e052d8", "1055", "7f7a57b7-21a4-4ef5-8eb3-5d6e98606584", "1df13bf3-ccc2-4616-b067-ca0d38753923",
"5073", "7d2d807d-c38b-476e-9407-17c5c9c2a256", "4d234bee-79ba-48a3-b8fd-e28ebfbf8d27",
"cc8de54b-a436-4b42-8586-5bbe0893d79c", "e3aa437c-15b9-4a8c-97c3-ac92245a48fb",
"05a3622a-f411-4eeb-9d4f-b22c02a51b4a", "829b5a6f-b6df-4678-bb90-97cef0d565ea",
"1492", "5106", "82902122-11bd-4c04-b056-e9ac215f4999", "c2b890f0-e480-4b5c-aaff-b6ec14dadddd",
"a5dca910-5259-4e5a-9eb6-0d341e63f0b0", "d9d8ac", "238da913-2315-47d5-952c-5e09564e3864",
"446e22f7-a88a-46f7-9dea-8bad5ec52b4d", "169350ba-e388-45ae-aa2e-470c7a03ac9e",
"f45902be-3414-43df-b732-9a1cc5aae0d4", "13f09881-a041-41a2-be87-b6dc4294e4e3",
"9649e43b-ba9a-4fd3-abea-c35674fb497b", "5d74c4e1-fc27-4db7-b0e2-d407e4ddc257",
"226eaf66-5324-442b-9ae0-b3a967df6819", "251ced13-4398-47e7-99a0-044a1820dc30",
"7ebe80c3-3837-43dd-9373-cdc4265642e9", "66511a51-d433-4320-bf17-49fa711dc66b",
"5274", "f07971ad-1e5f-4ad3-9775-f281d5d455f2", "e2993e4d-654a-46c4-8127-5bb84cb288d5",
"30ddf51b-b4fa-4654-87a4-1e61fe1dec82", "2b2c8b84-310d-4e08-b97f-c6190415a860",
"beedcc", "3d483c", "9a3f40ac-f61b-4909-97fa-a784406d9bb4", "15b88752-d219-4263-928e-efa486e501cf",
"67dee1", "57d45f", "6b22b5", "f88944bd-f208-4f2f-81be-ce13a7f71058",
"412bb47c-a3a7-41a6-8fce-160abfb8c03c"), quest = structure(c(18L,
6L, 19L, 21L, 11L, 2L, 22L, 6L, 19L, 10L, 11L, 12L, 8L, 21L,
2L, 4L, 1L, 18L, 18L, 20L, 10L, 6L, 17L, 10L, 13L, 13L, 19L,
3L, 19L, 8L, 11L, 1L, 18L, 15L, 17L, 11L, 11L, 17L, 8L, 10L,
4L, 22L, 2L, 17L, 9L, 19L, 4L, 13L, 10L, 3L, 22L, 1L, 6L, 20L,
18L, 17L, 2L, 9L, 3L, 19L, 2L, 1L, 7L, 7L, 21L, 3L, 9L, 18L,
20L, 6L, 10L, 17L, 7L, 6L, 3L, 17L, 19L, 1L, 6L, 1L, 12L, 7L,
21L, 6L, 21L, 10L, 2L, 12L, 18L, 4L, 10L, 7L, 2L, 19L, 4L, 4L,
20L, 10L, 20L, 18L, 9L, 22L, 4L, 5L, 20L, 3L, 1L, 21L, 2L, 18L,
18L, 2L, 20L, 6L, 2L, 3L, 19L, 4L, 6L, 11L, 16L, 8L, 18L, 20L,
18L, 9L, 7L, 21L, 3L, 2L, 18L, 1L, 12L, 1L, 7L, 10L, 14L, 18L,
21L, 2L, 18L, 21L, 13L, 13L, 13L, 2L, 8L, 2L, 1L, 11L, 2L, 8L,
17L, 20L, 21L, 13L, 13L, 20L, 17L, 13L, 7L, 13L, 15L, 16L, 9L,
16L, 1L, 9L, 6L, 16L, 18L, 4L, 20L, 15L, 18L, 14L, 3L, 20L, 20L,
20L, 4L, 21L, 22L, 3L, 7L, 19L, 9L, 14L, 16L, 20L, 7L, 20L, 4L,
7L, 8L, 17L, 16L, 17L, 12L, 13L), .Label = c("2", "4", "6", "8",
"9", "10", "12", "14", "16", "18", "20", "22", "24", "27", "30",
"33", "36", "42", "48", "54", "60", "72"), class = "factor"),
c_sum = c(55, 45, 55, 50, 10, 60, 60, 55, 50, 35, 60, 55,
10, 60, 45, 50, 40, 45, 30, 50, 35, 30, 60, 60, 60, 40, 60,
50, 60, 40, 45, 35, 60, 60, 55, 5, 10, 55, 35, 35, 50, 60,
50, 45, 45, 50, 35, 35, 50, 45, 55, 50, 50, 55, 10, 45, 60,
45, 35, 40, 40, 35, 60, 25, 20, 50, 40, 50, 55, 50, 60, 50,
60, 40, 55, 55, 50, 40, 60, 55, 20, 45, 45, 40, 55, 40, 40,
50, 60, 60, 15, 45, 60, 60, 60, 40, 45, 5, 45, 60, 50, 60,
25, 55, 60, 50, 10, 55, 40, 50, 40, 55, 40, 60, 55, 25, 60,
50, 55, 20, 55, 35, 55, 55, 60, 35, 30, 60, 35, 60, 60, 50,
40, 25, 40, 60, 60, 60, 60, 50, 60, 50, 60, 60, 20, 60, 60,
30, 55, 45, 45, 25, 55, 50, 60, 0, 20, 60, 60, 60, 45, 20,
50, 55, 50, 60, 35, 45, 55, 60, 55, 60, 60, 55, 55, 55, 45,
40, 60, 55, 55, 60, 0, 60, 20, 50, 60, 55, 10, 50, 15, 40,
60, 45, 35, 55, 60, 5, 50, 30), gm_sum = c(60, 55, 60, 35,
20, 60, 40, 30, 60, 60, 50, 50, 25, 55, 55, 35, 60, 60, 55,
50, 55, 50, 50, 60, 60, 60, 60, 40, 55, 60, 60, 50, 60, 55,
45, 55, 45, 45, 40, 55, 60, 50, 60, 50, 45, 40, 35, 50, 55,
40, 45, 55, 55, 60, 55, 45, 55, 60, 60, 25, 60, 60, 60, 60,
35, 50, 0, 40, 55, 40, 60, 60, 50, 40, 40, 60, 60, 50, 25,
60, 45, 60, 50, 55, 50, 60, 35, 30, 45, 55, 50, 60, 60, 60,
40, 60, 55, 10, 25, 60, 50, 55, 25, 40, 60, 60, 55, 55, 50,
60, 50, 60, 60, 55, 55, 45, 60, 45, 60, 55, 60, 50, 55, 60,
60, 60, 60, 55, 30, 60, 60, 35, 55, 40, 60, 60, 55, 60, 60,
55, 60, 55, 60, 60, 50, 40, 40, 55, 45, 45, 55, 50, 50, 50,
60, 60, 45, 50, 45, 60, 35, 55, 60, 60, 60, 55, 60, 60, 55,
60, 45, 60, 60, 50, 55, 50, 55, 35, 60, 50, 55, 45, 30, 50,
25, 55, 60, 60, 15, 60, 45, 45, 60, 35, 60, 50, 60, 45, 55,
45), fm_sum = c(50, 60, 50, 50, 40, 60, 60, 60, 30, 55, 45,
45, 45, 50, 55, 50, 55, 55, 20, 25, 45, 50, 30, 60, 45, 50,
60, 25, 60, 60, 60, 35, 55, 60, 25, 55, 10, 10, 50, 55, 60,
60, 50, 55, 60, 30, 50, 35, 60, 50, 30, 60, 60, 45, 5, 10,
60, 55, 55, 45, 55, 55, 60, 30, 35, 50, 45, 25, 45, 30, 60,
50, 50, 60, 45, 40, 45, 45, 55, 60, 30, 35, 55, 55, 60, 60,
30, 50, 30, 60, 60, 45, 50, 60, 50, 55, 20, 30, 55, 60, 50,
60, 25, 50, 60, 55, 45, 60, 50, 50, 45, 60, 25, 60, 40, 40,
50, 60, 60, 55, 40, 35, 45, 60, 60, 50, 50, 60, 25, 40, 60,
35, 60, 40, 40, 60, 55, 40, 50, 50, 60, 50, 50, 50, 30, 60,
60, 50, 55, 40, 50, 30, 10, 60, 55, 40, 25, 60, 45, 50, 35,
35, 60, 30, 45, 55, 60, 60, 60, 45, 50, 60, 60, 60, 55, 30,
50, 15, 55, 30, 55, 60, 5, 60, 40, 35, 50, 50, 5, 50, 15,
15, 60, 50, 25, 40, 45, 15, 60, 40), cg_sum = c(45, 55, 40,
45, 30, 60, 55, 55, 45, 60, 60, 30, 45, 50, 50, 45, 55, 60,
25, 40, 50, 50, 55, 55, 60, 45, 55, 50, 55, 55, 60, 35, 55,
60, 55, 50, 30, 55, 30, 50, 50, 60, 50, 60, 50, 35, 50, 25,
55, 45, 45, 50, 60, 60, 5, 40, 45, 55, 40, 30, 60, 55, 60,
25, 40, 55, 35, 35, 60, 40, 50, 55, 60, 60, 30, 50, 55, 55,
40, 60, 30, 45, 55, 45, 55, 50, 35, 45, 55, 60, 15, 45, 60,
50, 60, 60, 20, 15, 55, 60, 40, 60, 25, 30, 60, 50, 35, 60,
50, 55, 55, 60, 45, 40, 50, 40, 55, 60, 60, 45, 50, 35, 50,
50, 50, 55, 50, 55, 30, 60, 60, 40, 50, 45, 35, 55, 50, 60,
60, 45, 60, 45, 55, 60, 40, 45, 45, 50, 50, 30, 30, 30, 35,
30, 55, 25, 15, 55, 60, 45, 30, 50, 50, 55, 50, 50, 40, 55,
40, 60, 45, 60, 60, 55, 55, 45, 40, 30, 60, 50, 55, 55, 10,
55, 0, 50, 50, 60, 15, 50, 35, 30, 60, 50, 45, 60, 60, 30,
55, 40), ps_sum = c(45, 60, 60, 60, 5, 60, 45, 60, 60, 45,
60, 60, 30, 55, 60, 50, 55, 50, 40, 60, 40, 55, 60, 60, 60,
50, 55, 15, 40, 55, 40, 30, 60, 45, 55, 50, 30, 60, 40, 60,
55, 60, 50, 60, 55, 50, 40, 60, 50, 50, 40, 55, 60, 55, 0,
45, 60, 55, 50, 50, 55, 35, 60, 40, 45, 55, 35, 35, 60, 50,
60, 45, 30, 40, 40, 60, 50, 45, 40, 60, 45, 50, 55, 50, 60,
60, 40, 50, 60, 50, 25, 55, 45, 50, 45, 60, 50, 15, 55, 60,
50, 55, 50, 35, 60, 50, 25, 60, 45, 60, 55, 55, 45, 50, 55,
60, 55, 45, 60, 60, 50, 40, 60, 60, 60, 45, 45, 55, 15, 55,
50, 50, 50, 30, 40, 60, 50, 50, 60, 55, 60, 35, 60, 55, 45,
45, 50, 50, 45, 30, 40, 45, 50, 50, 60, 45, 25, 60, 45, 60,
45, 50, 50, 60, 55, 60, 55, 55, 50, 55, 55, 60, 60, 30, 40,
45, 45, 45, 60, 60, 60, 55, 10, 60, 35, 60, 55, 55, 15, 60,
25, 35, 60, 55, 50, 50, 60, 10, 60, 60)), row.names = c(NA,
-200L), groups = "data.frame", class = "data.frame")
dplyr 似乎是完成这项工作的好工具，但我会把它留给这里的一位 dplyr 专家来添加 dplyr 答案。这是我在 base 中的做法：
## Define a cutoff value for each test based on one sd lower than the mean;
## Compare each individual student's score with the cutoff value for each test;
## Assign a cutoff status to each students score where '1 indicates a student's
## score was below the cutoff;
## Sum these values for each student and calculate the frequency of sums
## across the dataset.
# Create a binary vector of 'cutoff statuses', example:
c_sum_monitor <- ifelse(df$c_sum < mean(df$c_sum) - sd(df$c_sum), 1, 0)
head(c_sum_monitor)
#> [1] 0 0 0 0 1 0
# Repeat for each test type
tests <- c("c_sum", "gm_sum", "fm_sum", "cg_sum", "ps_sum")
monitor <- sapply(tests, FUN = function(x)
ifelse(df[,x] < (mean(df[,x]) - sd(df[,x])), 1, 0)
)
# The result is a matrix where rows correspond to students
# and columns correspond to tests
# Values of 1 indicate a test score was below the cutoff value (mean-sd)
# Values of 0 indicate a test score was equal to or greater than the cutoff value
head(monitor)
#> c_sum gm_sum fm_sum cg_sum ps_sum
#> [1,] 0 0 0 0 0
#> [2,] 0 0 0 0 0
#> [3,] 0 0 0 0 0
#> [4,] 0 1 0 0 0
#> [5,] 1 1 0 1 1
#> [6,] 0 0 0 0 0
# Frequency of cutoff == 1
# e.g. "44 students scored lower than the cutoff value on one test"
# e.g. "3 students scored lower than the cutoff value on five tests"
table(apply(monitor, 1, sum))
#>
#> 0 1 2 3 4 5
#> 122 44 14 9 8 3
# Proportion of students with at least x number of tests below cutoff
# e.g. "61% of students never scored below the cutoff value for any test"
# e.g. "39% of students scored below the cutoff value on at least one test"
data.frame(
monitor_0 = sum(apply(monitor, 1, sum) == 0)/nrow(monitor),
monitor_1 = sum(apply(monitor, 1, sum) >= 1)/nrow(monitor),
monitor_2 = sum(apply(monitor, 1, sum) >= 2)/nrow(monitor),
monitor_3 = sum(apply(monitor, 1, sum) >= 3)/nrow(monitor),
monitor_4 = sum(apply(monitor, 1, sum) >= 4)/nrow(monitor),
monitor_5 = sum(apply(monitor, 1, sum) >= 5)/nrow(monitor))
#> monitor_0 monitor_1 monitor_2 monitor_3 monitor_4 monitor_5
#> 1 0.61 0.39 0.17 0.1 0.055 0.015
循环任务：（我将输入数据名称更新为 dfall）
# template for output
out <- data.frame(matrix(ncol = 8, nrow = 0))
names(out) <- c("quest", 0:5, "n")
# Quest == 9 only has one entry in the sample data, so no SD can be calculated
# Remove Quest == 9
quests <- setdiff(unique(dfall$quest), 9)
for(q in quests){
# operate on one quest at a time
df <- dfall[dfall$quest == q,]
# determine if scores are below cutoff value
tests <- c("c_sum", "gm_sum", "fm_sum", "cg_sum", "ps_sum")
monitor <- sapply(tests, FUN = function(x)
ifelse(df[,x] < (mean(df[,x]) - sd(df[,x])), 1, 0)
)
# frequency of scores below cutoff value
tt <- as.data.frame(t(as.matrix(table(apply(monitor, 1, sum)))))
# total students in quest
tt$n <- rowSums(tt, na.rm = TRUE)
# quest id
tt$quest <- as.numeric(q)
# compile results
out <- dplyr::bind_rows(out, tt)
}
# Format table
out$Age <- out$quest
out$Domain0 <- paste0(round(out$`0`/ out$n * 100, 2), "% (", out$`0`, ")")
out$Domain1 <- paste0(round(out$`1`/ out$n * 100, 2), "% (", out$`1`, ")")
out$Domain2 <- paste0(round(out$`2`/ out$n * 100, 2), "% (", out$`2`, ")")
out$Domain3 <- paste0(round(out$`3`/ out$n * 100, 2), "% (", out$`3`, ")")
out$Domain4 <- paste0(round(out$`4`/ out$n * 100, 2), "% (", out$`4`, ")")
out$Domain5 <- paste0(round(out$`5`/ out$n * 100, 2), "% (", out$`5`, ")")
yourtable <- (out[c("Age", "Domain0", "Domain1", "Domain2", "Domain3", "Domain4", "Domain5")])
yourtable[order(yourtable$Age),]
#>
#> Age Domain0 Domain1 Domain2 Domain3 Domain4 Domain5
#> 12 2 63.64% (7) NA% (NA) 9.09% (1) 27.27% (3) NA% (NA) NA% (NA)
#> 6 4 46.67% (7) 40% (6) 6.67% (1) NA% (NA) NA% (NA) 6.67% (1)
#> 16 6 60% (6) 20% (2) 10% (1) NA% (NA) 10% (1) NA% (NA)
#> 11 8 54.55% (6) 27.27% (3) NA% (NA) 9.09% (1) 9.09% (1) NA% (NA)
#> 2 10 36.36% (4) 45.45% (5) 9.09% (1) 9.09% (1) NA% (NA) NA% (NA)
#> 19 12 54.55% (6) 27.27% (3) NA% (NA) 18.18% (2) NA% (NA) NA% (NA)
#> 10 14 42.86% (3) 42.86% (3) NA% (NA) 14.29% (1) NA% (NA) NA% (NA)
#> 18 16 50% (4) 37.5% (3) NA% (NA) NA% (NA) 12.5% (1) NA% (NA)
#> 8 18 80% (8) NA% (NA) NA% (NA) 10% (1) NA% (NA) 10% (1)
#> 5 20 57.14% (4) 28.57% (2) 14.29% (1) NA% (NA) NA% (NA) NA% (NA)
#> 9 22 40% (2) 40% (2) NA% (NA) NA% (NA) 20% (1) NA% (NA)
#> 15 24 54.55% (6) 27.27% (3) 9.09% (1) NA% (NA) 9.09% (1) NA% (NA)
#> 21 27 66.67% (2) 33.33% (1) NA% (NA) NA% (NA) NA% (NA) NA% (NA)
#> 17 30 66.67% (2) 33.33% (1) NA% (NA) NA% (NA) NA% (NA) NA% (NA)
#> 20 33 83.33% (5) NA% (NA) NA% (NA) NA% (NA) NA% (NA) 16.67% (1)
#> 14 36 63.64% (7) 18.18% (2) 9.09% (1) 9.09% (1) NA% (NA) NA% (NA)
#> 1 42 70.59% (12) 11.76% (2) 5.88% (1) 5.88% (1) 5.88% (1) NA% (NA)
#> 3 48 60% (6) 20% (2) NA% (NA) 20% (2) NA% (NA) NA% (NA)
#> 13 54 62.5% (10) 12.5% (2) 12.5% (2) NA% (NA) 6.25% (1) 6.25% (1)
#> 4 60 72.73% (8) NA% (NA) 18.18% (2) NA% (NA) NA% (NA) 9.09% (1)
#> 7 72 80% (4) NA% (NA) NA% (NA) NA% (NA) NA% (NA) 20% (1)
Created on 2022-01-12 by the reprex package (v2.0.1)
这个答案实现了tidyverse函数来处理这个问题。结果与我在运行 @skaqqs 提供的优雅代码后得到的结果相同。
代码在下面，我构建了一个 gif 图像来显示解决方案。 [请记住，我编辑了这个答案而不是 gif。因此，您会在 gif 演示中看到细微差别]
library(tidyverse)
library(janitor)
df %>% select(id, quest, ends_with("sum")) %>%
pivot_longer(-c(id, quest)) %>% #tranform to long format
nest_by(quest, name) %>% #nest (id will not be used this time)
#all counts are performed here
mutate(
n = map_dbl(data[2], ~nrow(data.frame(.))), #compute sample size
mean = map_dbl(data[2], ~mean(.)), #get the ROBUST means
sd = map_dbl(data[2], ~sd(.)), #get the ROBUST sd
one_below = mean-sd, #1 below
two_below = mean - 2 * sd) %>%
#outside of the map, add a new variable to the nested data
mutate(data = list(data %>% mutate(area_monitor = as.character(ifelse(data[[2]] <= one_below, paste0(name),0))))) %>%
unnest(cols = c(data)) %>% #I'll unnest the data and get again the ids. my df will be very long
pivot_wider(id_cols = c(id, quest), names_from = area_monitor, values_fn = length) %>% #now I'll group by ids!! my df will be sample size * quest
ungroup() %>% #end of function
#now I'll count values
mutate(how_many = select(.,ends_with("_sum")) %>%
rowSums(., na.rm = T)) %>%
#now I'll present the results
tabyl(quest, how_many) %>%
adorn_totals(c("row", "col")) %>%
adorn_percentages("row") %>%
adorn_pct_formatting(digits = 2) %>%
adorn_ns()
在教育环境中，使用多个测试（c_sum、cg_sum、... , 在 df) 中，然后检查它们是否比平均值低 1 个标准差（结果中的 monitor）或者他们是否需要再次进行测试（below）。我可以计算两种情况下 children 的百分比（monitor 和 below）。
但是，现在我想发现 children 在 中的 monitoring zone 的百分比只是一个主题 ， 或两个科目、或三个科目，依此类推。最多5个科目。然后，我将计算一个域或两个域中的 below group 中有多少 children，等等
输出可能是这样的：
请注意：68% 的参与者未在 monitoring zone 中分类。 21% 的参与者在一次测试中达到 monitoring zone。 9% 的参与者在两次测试中 monitoring zone
我想return到数据集data，获取所有id，然后统计这个id出现了多少次，但我不确定这是否是正确的路径得到这个 result.I我也知道 crossing 函数，但我不知道如何正确使用它。
我用来获取 monitoring zone 和 below 百分比的代码是：
df %>%
select(id, quest, ends_with("sum")) %>%
pivot_longer(-c(id, quest)) %>% #tranform into long format
nest_by(quest, name) %>% #nest
#here is the trick. all counts are here
mutate(
n = map_dbl(data[2], ~nrow(data.frame(.))), #compute sample size
mean = map_dbl(data[2], ~mean(.)), #get the ROBUST means
sd = map_dbl(data[2], ~sd(.)), #get the ROBUST sd
one_below = mean-sd, #1 below
two_below = mean - 2 * sd,
monitor = sum(one_below >= data[[2]] & two_below < data[[2]])/n,
below = sum(two_below > data[[2]])/n)
而这段代码我用来检查 children 在监控区域中有一个、两个或更多结果的百分比
df %>%
filter(quest == 2) %>%
select(quest, ends_with("sum")) %>%
mutate(c_monitor =
if_else(c_sum <= mean(c_sum)-1*sd(c_sum) & c_sum > mean(c_sum)-2*sd(c_sum), 1,0),
gm_monitor =
if_else(gm_sum <= mean(gm_sum)-1*sd(c_sum) & gm_sum > mean(gm_sum)-2*sd(gm_sum), 1,0),
fm_monitor =
if_else(fm_sum <= mean(fm_sum)-1*sd(fm_sum) & fm_sum > mean(fm_sum)-2*sd(fm_sum), 1,0),
cg_monitor =
if_else(cg_sum <= mean(cg_sum)-1*sd(cg_sum) & cg_sum > mean(cg_sum)-2*sd(cg_sum), 1,0),
ps_monitor =
if_else(ps_sum <= mean(ps_sum)-1*sd(ps_sum) & ps_sum > mean(ps_sum)-2*sd(ps_sum), 1,0)) %>%
ungroup() %>%
mutate(c_monitor =
if_else(c_sum <= mean(c_sum)-1*sd(c_sum) & c_sum > mean(c_sum)-2*sd(c_sum), 1,0),
gm_monitor =
if_else(gm_sum <= mean(gm_sum)-1*sd(c_sum) & gm_sum > mean(gm_sum)-2*sd(gm_sum), 1,0),
fm_monitor =
if_else(fm_sum <= mean(fm_sum)-1*sd(fm_sum) & fm_sum > mean(fm_sum)-2*sd(fm_sum), 1,0),
cg_monitor =
if_else(cg_sum <= mean(cg_sum)-1*sd(cg_sum) & cg_sum > mean(cg_sum)-2*sd(cg_sum), 1,0),
ps_monitor =
if_else(ps_sum <= mean(ps_sum)-1*sd(ps_sum) & ps_sum > mean(ps_sum)-2*sd(ps_sum), 1,0)) %>%
mutate(c_below =
if_else(c_sum <= mean(c_sum)-2*sd(c_sum), 1,0),
gm_below =
if_else(gm_sum <= mean(gm_sum)-2*sd(gm_sum), 1,0),
fm_below =
if_else(fm_sum <= mean(fm_sum)-2*sd(fm_sum), 1,0),
cg_below =
if_else(cg_sum <= mean(cg_sum)-2*sd(cg_sum), 1,0),
ps_below =
if_else(ps_sum <= mean(ps_sum)-2*sd(ps_sum), 1,0)) %>%
ungroup() %>%
mutate(how_many_monitor = rowSums(select(., c_monitor, gm_monitor, fm_monitor, cg_monitor, ps_monitor))) %>%
mutate(how_many_below = rowSums(select(., c_below, gm_below, fm_below, cg_below, ps_below))) %>%
select(starts_with("how_many")) %>%
pivot_longer(everything()) %>%
group_by(name, value) %>%
summarise(n=n()) %>%
mutate(prop = prop.table(n)*100) %>%
arrange(desc(name)) %>%
pivot_wider(id_cols = value, names_from = name, values_from = prop)
数据如下
df = structure(list(id = c("0c82badd-3bf2-41ce-99a8-39744fa1a4eb",
"44042bad-974f-4964-85fd-434f9034c84a", "3ac57afb-8c94-4b20-9d8b-8b64ff59adb2",
"7329063b-7050-4c2b-b8b3-286df50989be", "52a022", "bef816c4-04bb-4727-90ee-b778eca79e64",
"1cf5b895-68be-4db3-bd5e-106765af5743", "ebc3435d-7422-4bf3-8d54-065742a5c5d3",
"4968d4a1-a40c-4ee6-ad68-8a5b4521e97e", "c2aaae70-e971-4817-888c-2e7c892d3efe",
"f1395902-2c1a-4eda-92a5-3b09fe916b5f", "8c32e64c-6873-49bc-af55-3ce2de367960",
"76983d8f-6291-4669-9b82-c080e3178e42", "232cccbd-f2c9-4858-a302-516208151a11",
"bb623164-7b97-47a0-b57b-727a99297e06", "488403bb-6116-4e49-945a-3559dfc0cad3",
"5ef34de7-f995-44d5-9224-e18c7f45f056", "51c01fb6-f575-4b47-ac08-6b1ba8ddd938",
"b4141c4e-ba3e-48a9-b025-d1365f31c184", "c6774d33-ddd9-470f-a408-32c83aac07d8",
"17a86d4f-ff5b-4d77-bd76-41057d6ec5f2", "6dd2a77d-e92e-438a-a2b2-2d22eb7edaf4",
"f40115d9-fca6-4432-a888-9299348124c5", "d36850", "fcfba97c-78d5-454c-8591-4651b89f83de",
"fe5fccd9-560a-43c0-a4b0-086132be77e1", "9268a298-38e4-49e6-ba53-23f2559a0b85",
"6979bbce-6272-4519-b226-d969ecba9ff0", "f1a00d10-9283-4c8b-99be-447973b21bec",
"5229a289-dce2-4ecc-a07e-36109ddbd502", "22ef9b3a-a866-47f7-b688-1e3c8575a8e7",
"3f4b036f-5201-4b4d-b03f-489aa9659028", "b67029f5-4be8-4913-ac39-975774253dcd",
"1560", "4f7aa6", "1f0c4f9a-a103-4e52-a033-01a6f48cce63", "cf694f",
"39c6b7f4-1964-476c-9616-0380bdfc836b", "94c98b67-9780-4bad-9f1a-39c7ca02805d",
"b567d8f9-a97a-4cdc-9b4b-108db54711e9", "24f68031-0e1e-4433-a950-f68c67a25d5d",
"5359", "4cd39e1b-8acf-4632-ab5a-d25cd969c427", "75863be5-f780-4ef2-bc6a-c1374cd628bc",
"360a31d0-d1c7-462d-b163-33f4b3f97426", "aed72a91-8ea2-40c0-9ead-6054c5b4aa73",
"fee10722-53d9-4dea-a8dd-d769406e7dfe", "4301d5a1-e677-455a-968e-710cb476a474",
"6be4de", "7d8103cd-22af-4295-a7af-20e8d7118ac1", "88806559-1367-4408-81ea-285fa78b7230",
"c446b04f-640a-4b13-baec-f089a6275bce", "3057", "61bdf3", "033539",
"fd2a061f-d9bc-4e28-bf05-e8d7dff6b94e", "748d7bac-56b0-4ac3-906a-8b8ff0daaf5f",
"08868e5b-2f6c-4dab-bf41-c2fc2ae52291", "368cfae0-c3b0-416d-8f2e-74b656c8cd2d",
"a2c287f2-4d4d-4d4a-a115-ebaccc6f8d7d", "4228c1d7-63b4-4756-87bc-8d62298f2cd4",
"ee691627-65b0-4137-a331-5923825bc98c", "dec357", "3154177d-ff23-4cbd-9a0c-49eb532657fb",
"98f1e706-f046-479c-8256-7e0fa12865c9", "a54eab2e-d45f-437d-b171-8b203dea71be",
"ff90b21a-7507-4605-90fa-a5e552b45270", "9edc3e9a-bbd1-46ee-85e6-5804e820135f",
"94e384", "28fac058-38c5-4bea-995e-e9687bf05aa9", "43417039-29fe-4acd-84c4-67ab1e4a5a8f",
"3612", "df81e4", "e5bed2cb-2e42-41b4-b21b-e9617bf63b31", "6ed6f533-ef04-4869-91c2-b986fb59bceb",
"3da6d57e-ccba-4f22-855e-60582b743003", "8a51dbdc-4935-4790-84a1-9b6f58803437",
"c1773b8b-3994-4261-ac26-0b2b5be747fe", "7b13fee5-2ef4-4d6a-9476-1bef62704613",
"2c1a67a5-b651-48f2-85eb-71d599a53802", "f3d4de8e-d84c-438a-aa28-34e4987e7012",
"a0ce8268-ba3f-4868-8f99-31466046d728", "c9423932-d6f7-4b56-8d20-83b061e42f7f",
"dfe249d3-ceab-4032-abcf-86f767d0e800", "b9409d71-71a1-4cb8-b23a-c1dd2c75a79b",
"a865c6c0-9981-477b-9b74-c4587b9ccd87", "5f9ea55f-88a9-48ac-bb62-f9bfe75308fb",
"1164", "31076bf6-7589-46b0-8bed-71013ab54f9b", "c9e2a3c3-1304-44d2-8ccc-dbc0dbd48d2a",
"6d9d76f5-9884-4f42-b89d-b47dc9ead3ac", "3c8b7cf6-3157-4a66-8137-fbb2833b501f",
"728920eb-0a53-4f8b-9b1a-4bf08f0fcbfb", "4ac02b40-e31b-4cac-8567-8abdff83dc2b",
"1073", "4b18c1e7-89f8-444b-ab72-494ea4bd9d2a", "240d3439-2942-4733-9d92-a021af21cfc4",
"871a5920-5e5c-4081-8604-f0f44adc1e78", "cb1a46", "f3865310-80be-424d-a1f7-f7882f886a1d",
"6e0601d7-0d78-4e44-b179-729b946fcd69", "b3e3a4f0-fac7-4214-815c-d06944003295",
"a7ab32d4-72df-40a4-babd-0364ed31f26d", "0d6c95", "755635eb-6277-4700-aa5b-7424c557d364",
"06c853ae-7619-4c49-ad06-a930ccea8e53", "5c112618-e9ba-4436-a512-279c22c41836",
"83668a", "96074678-3432-4832-a310-2666c5e02a4c", "111026fd-1515-4f77-9fd2-453c872b4e07",
"2fcaa4", "a228c4", "ad06441a-efa1-41ed-83db-d2c997ca5000", "528c84f3-0a58-40ac-9b18-71f3c9d82d7e",
"4b58598c-377f-442c-8285-0a7d1aa905b4", "15bef130-7c0e-47a4-bdc8-5166d4eac0d9",
"1353", "f3087b35-e6cd-4bf9-8ae4-1a5c8fbc9207", "12a83cb7-d4aa-48b5-b696-825f73426982",
"2082", "9c6f9b53-9d11-4c3d-91c1-284222d29705", "80b0c451-96d5-4b95-a63c-624d9d3060d3",
"771ac1e4-e677-4041-90c2-b297e73abb7b", "c8f2d425-3523-421b-9b95-e4b7c57e81cb",
"70d97a8e-ae8d-46a9-b63b-5a901d1d6e11", "9da1e867-aae3-43fe-8417-9817334a68d9",
"c9491a", "2155", "fbe2178f-c1b9-486f-8ed3-74a96badc3cb", "f1af3929-83d2-4b2a-b535-fccbfb78c830",
"3149", "8cbec309-16e8-40d8-b1b3-6951df048f87", "f6168740-052c-4e05-b588-48766d79db32",
"51f7a031-7c2b-4951-b66e-e7f5db460ac5", "57a0a6a3-3eca-4f87-82e4-e5ef4b10ffb4",
"cee16812-b4b4-4645-9691-b96bf45ce2e9", "5238", "5109", "681f0157-a480-433e-a5e4-32c41a28eb87",
"26d5de09-ddc5-42be-a49f-d9392957c11c", "b81575", "b5d49242-44b6-4644-921d-7c48c1b37e9d",
"56877e8b-add3-4a50-aa41-a4b174475708", "3a0279", "2e8c88a3-85ef-48e9-90ac-cc38f0f6ac63",
"25e132c3-5ee1-47f5-b9e7-ec0d6b928e9f", "d0f89c2b-0759-4966-9d65-72ec0b88da27",
"51d51da3-75fc-472e-8d05-7362fcb42b33", "527743c7-cad0-4ec9-95de-23b594b3793b",
"c04fa726-ad03-40c6-b04d-82a6d60fa362", "31fc06f9-c612-453f-9904-ed9703520205",
"adc7626f-3af7-4b3e-b4f5-1be28cdc917b", "b0b8ad67-6391-4003-af23-09a16802207f",
"3436", "158b0cbc-b374-4dc2-a136-450fdb1814bf", "7ed70547-41bd-4a77-8646-84c3a404ac97",
"7183788f-1d55-483b-99e2-53534d72e879", "8c4961da-602a-4834-908d-2d6a7f26e490",
"e052d8", "1055", "7f7a57b7-21a4-4ef5-8eb3-5d6e98606584", "1df13bf3-ccc2-4616-b067-ca0d38753923",
"5073", "7d2d807d-c38b-476e-9407-17c5c9c2a256", "4d234bee-79ba-48a3-b8fd-e28ebfbf8d27",
"cc8de54b-a436-4b42-8586-5bbe0893d79c", "e3aa437c-15b9-4a8c-97c3-ac92245a48fb",
"05a3622a-f411-4eeb-9d4f-b22c02a51b4a", "829b5a6f-b6df-4678-bb90-97cef0d565ea",
"1492", "5106", "82902122-11bd-4c04-b056-e9ac215f4999", "c2b890f0-e480-4b5c-aaff-b6ec14dadddd",
"a5dca910-5259-4e5a-9eb6-0d341e63f0b0", "d9d8ac", "238da913-2315-47d5-952c-5e09564e3864",
"446e22f7-a88a-46f7-9dea-8bad5ec52b4d", "169350ba-e388-45ae-aa2e-470c7a03ac9e",
"f45902be-3414-43df-b732-9a1cc5aae0d4", "13f09881-a041-41a2-be87-b6dc4294e4e3",
"9649e43b-ba9a-4fd3-abea-c35674fb497b", "5d74c4e1-fc27-4db7-b0e2-d407e4ddc257",
"226eaf66-5324-442b-9ae0-b3a967df6819", "251ced13-4398-47e7-99a0-044a1820dc30",
"7ebe80c3-3837-43dd-9373-cdc4265642e9", "66511a51-d433-4320-bf17-49fa711dc66b",
"5274", "f07971ad-1e5f-4ad3-9775-f281d5d455f2", "e2993e4d-654a-46c4-8127-5bb84cb288d5",
"30ddf51b-b4fa-4654-87a4-1e61fe1dec82", "2b2c8b84-310d-4e08-b97f-c6190415a860",
"beedcc", "3d483c", "9a3f40ac-f61b-4909-97fa-a784406d9bb4", "15b88752-d219-4263-928e-efa486e501cf",
"67dee1", "57d45f", "6b22b5", "f88944bd-f208-4f2f-81be-ce13a7f71058",
"412bb47c-a3a7-41a6-8fce-160abfb8c03c"), quest = structure(c(18L,
6L, 19L, 21L, 11L, 2L, 22L, 6L, 19L, 10L, 11L, 12L, 8L, 21L,
2L, 4L, 1L, 18L, 18L, 20L, 10L, 6L, 17L, 10L, 13L, 13L, 19L,
3L, 19L, 8L, 11L, 1L, 18L, 15L, 17L, 11L, 11L, 17L, 8L, 10L,
4L, 22L, 2L, 17L, 9L, 19L, 4L, 13L, 10L, 3L, 22L, 1L, 6L, 20L,
18L, 17L, 2L, 9L, 3L, 19L, 2L, 1L, 7L, 7L, 21L, 3L, 9L, 18L,
20L, 6L, 10L, 17L, 7L, 6L, 3L, 17L, 19L, 1L, 6L, 1L, 12L, 7L,
21L, 6L, 21L, 10L, 2L, 12L, 18L, 4L, 10L, 7L, 2L, 19L, 4L, 4L,
20L, 10L, 20L, 18L, 9L, 22L, 4L, 5L, 20L, 3L, 1L, 21L, 2L, 18L,
18L, 2L, 20L, 6L, 2L, 3L, 19L, 4L, 6L, 11L, 16L, 8L, 18L, 20L,
18L, 9L, 7L, 21L, 3L, 2L, 18L, 1L, 12L, 1L, 7L, 10L, 14L, 18L,
21L, 2L, 18L, 21L, 13L, 13L, 13L, 2L, 8L, 2L, 1L, 11L, 2L, 8L,
17L, 20L, 21L, 13L, 13L, 20L, 17L, 13L, 7L, 13L, 15L, 16L, 9L,
16L, 1L, 9L, 6L, 16L, 18L, 4L, 20L, 15L, 18L, 14L, 3L, 20L, 20L,
20L, 4L, 21L, 22L, 3L, 7L, 19L, 9L, 14L, 16L, 20L, 7L, 20L, 4L,
7L, 8L, 17L, 16L, 17L, 12L, 13L), .Label = c("2", "4", "6", "8",
"9", "10", "12", "14", "16", "18", "20", "22", "24", "27", "30",
"33", "36", "42", "48", "54", "60", "72"), class = "factor"),
c_sum = c(55, 45, 55, 50, 10, 60, 60, 55, 50, 35, 60, 55,
10, 60, 45, 50, 40, 45, 30, 50, 35, 30, 60, 60, 60, 40, 60,
50, 60, 40, 45, 35, 60, 60, 55, 5, 10, 55, 35, 35, 50, 60,
50, 45, 45, 50, 35, 35, 50, 45, 55, 50, 50, 55, 10, 45, 60,
45, 35, 40, 40, 35, 60, 25, 20, 50, 40, 50, 55, 50, 60, 50,
60, 40, 55, 55, 50, 40, 60, 55, 20, 45, 45, 40, 55, 40, 40,
50, 60, 60, 15, 45, 60, 60, 60, 40, 45, 5, 45, 60, 50, 60,
25, 55, 60, 50, 10, 55, 40, 50, 40, 55, 40, 60, 55, 25, 60,
50, 55, 20, 55, 35, 55, 55, 60, 35, 30, 60, 35, 60, 60, 50,
40, 25, 40, 60, 60, 60, 60, 50, 60, 50, 60, 60, 20, 60, 60,
30, 55, 45, 45, 25, 55, 50, 60, 0, 20, 60, 60, 60, 45, 20,
50, 55, 50, 60, 35, 45, 55, 60, 55, 60, 60, 55, 55, 55, 45,
40, 60, 55, 55, 60, 0, 60, 20, 50, 60, 55, 10, 50, 15, 40,
60, 45, 35, 55, 60, 5, 50, 30), gm_sum = c(60, 55, 60, 35,
20, 60, 40, 30, 60, 60, 50, 50, 25, 55, 55, 35, 60, 60, 55,
50, 55, 50, 50, 60, 60, 60, 60, 40, 55, 60, 60, 50, 60, 55,
45, 55, 45, 45, 40, 55, 60, 50, 60, 50, 45, 40, 35, 50, 55,
40, 45, 55, 55, 60, 55, 45, 55, 60, 60, 25, 60, 60, 60, 60,
35, 50, 0, 40, 55, 40, 60, 60, 50, 40, 40, 60, 60, 50, 25,
60, 45, 60, 50, 55, 50, 60, 35, 30, 45, 55, 50, 60, 60, 60,
40, 60, 55, 10, 25, 60, 50, 55, 25, 40, 60, 60, 55, 55, 50,
60, 50, 60, 60, 55, 55, 45, 60, 45, 60, 55, 60, 50, 55, 60,
60, 60, 60, 55, 30, 60, 60, 35, 55, 40, 60, 60, 55, 60, 60,
55, 60, 55, 60, 60, 50, 40, 40, 55, 45, 45, 55, 50, 50, 50,
60, 60, 45, 50, 45, 60, 35, 55, 60, 60, 60, 55, 60, 60, 55,
60, 45, 60, 60, 50, 55, 50, 55, 35, 60, 50, 55, 45, 30, 50,
25, 55, 60, 60, 15, 60, 45, 45, 60, 35, 60, 50, 60, 45, 55,
45), fm_sum = c(50, 60, 50, 50, 40, 60, 60, 60, 30, 55, 45,
45, 45, 50, 55, 50, 55, 55, 20, 25, 45, 50, 30, 60, 45, 50,
60, 25, 60, 60, 60, 35, 55, 60, 25, 55, 10, 10, 50, 55, 60,
60, 50, 55, 60, 30, 50, 35, 60, 50, 30, 60, 60, 45, 5, 10,
60, 55, 55, 45, 55, 55, 60, 30, 35, 50, 45, 25, 45, 30, 60,
50, 50, 60, 45, 40, 45, 45, 55, 60, 30, 35, 55, 55, 60, 60,
30, 50, 30, 60, 60, 45, 50, 60, 50, 55, 20, 30, 55, 60, 50,
60, 25, 50, 60, 55, 45, 60, 50, 50, 45, 60, 25, 60, 40, 40,
50, 60, 60, 55, 40, 35, 45, 60, 60, 50, 50, 60, 25, 40, 60,
35, 60, 40, 40, 60, 55, 40, 50, 50, 60, 50, 50, 50, 30, 60,
60, 50, 55, 40, 50, 30, 10, 60, 55, 40, 25, 60, 45, 50, 35,
35, 60, 30, 45, 55, 60, 60, 60, 45, 50, 60, 60, 60, 55, 30,
50, 15, 55, 30, 55, 60, 5, 60, 40, 35, 50, 50, 5, 50, 15,
15, 60, 50, 25, 40, 45, 15, 60, 40), cg_sum = c(45, 55, 40,
45, 30, 60, 55, 55, 45, 60, 60, 30, 45, 50, 50, 45, 55, 60,
25, 40, 50, 50, 55, 55, 60, 45, 55, 50, 55, 55, 60, 35, 55,
60, 55, 50, 30, 55, 30, 50, 50, 60, 50, 60, 50, 35, 50, 25,
55, 45, 45, 50, 60, 60, 5, 40, 45, 55, 40, 30, 60, 55, 60,
25, 40, 55, 35, 35, 60, 40, 50, 55, 60, 60, 30, 50, 55, 55,
40, 60, 30, 45, 55, 45, 55, 50, 35, 45, 55, 60, 15, 45, 60,
50, 60, 60, 20, 15, 55, 60, 40, 60, 25, 30, 60, 50, 35, 60,
50, 55, 55, 60, 45, 40, 50, 40, 55, 60, 60, 45, 50, 35, 50,
50, 50, 55, 50, 55, 30, 60, 60, 40, 50, 45, 35, 55, 50, 60,
60, 45, 60, 45, 55, 60, 40, 45, 45, 50, 50, 30, 30, 30, 35,
30, 55, 25, 15, 55, 60, 45, 30, 50, 50, 55, 50, 50, 40, 55,
40, 60, 45, 60, 60, 55, 55, 45, 40, 30, 60, 50, 55, 55, 10,
55, 0, 50, 50, 60, 15, 50, 35, 30, 60, 50, 45, 60, 60, 30,
55, 40), ps_sum = c(45, 60, 60, 60, 5, 60, 45, 60, 60, 45,
60, 60, 30, 55, 60, 50, 55, 50, 40, 60, 40, 55, 60, 60, 60,
50, 55, 15, 40, 55, 40, 30, 60, 45, 55, 50, 30, 60, 40, 60,
55, 60, 50, 60, 55, 50, 40, 60, 50, 50, 40, 55, 60, 55, 0,
45, 60, 55, 50, 50, 55, 35, 60, 40, 45, 55, 35, 35, 60, 50,
60, 45, 30, 40, 40, 60, 50, 45, 40, 60, 45, 50, 55, 50, 60,
60, 40, 50, 60, 50, 25, 55, 45, 50, 45, 60, 50, 15, 55, 60,
50, 55, 50, 35, 60, 50, 25, 60, 45, 60, 55, 55, 45, 50, 55,
60, 55, 45, 60, 60, 50, 40, 60, 60, 60, 45, 45, 55, 15, 55,
50, 50, 50, 30, 40, 60, 50, 50, 60, 55, 60, 35, 60, 55, 45,
45, 50, 50, 45, 30, 40, 45, 50, 50, 60, 45, 25, 60, 45, 60,
45, 50, 50, 60, 55, 60, 55, 55, 50, 55, 55, 60, 60, 30, 40,
45, 45, 45, 60, 60, 60, 55, 10, 60, 35, 60, 55, 55, 15, 60,
25, 35, 60, 55, 50, 50, 60, 10, 60, 60)), row.names = c(NA,
-200L), groups = "data.frame", class = "data.frame")
dplyr 似乎是完成这项工作的好工具，但我会把它留给这里的一位 dplyr 专家来添加 dplyr 答案。这是我在 base 中的做法：
## Define a cutoff value for each test based on one sd lower than the mean;
## Compare each individual student's score with the cutoff value for each test;
## Assign a cutoff status to each students score where '1 indicates a student's
## score was below the cutoff;
## Sum these values for each student and calculate the frequency of sums
## across the dataset.
# Create a binary vector of 'cutoff statuses', example:
c_sum_monitor <- ifelse(df$c_sum < mean(df$c_sum) - sd(df$c_sum), 1, 0)
head(c_sum_monitor)
#> [1] 0 0 0 0 1 0
# Repeat for each test type
tests <- c("c_sum", "gm_sum", "fm_sum", "cg_sum", "ps_sum")
monitor <- sapply(tests, FUN = function(x)
ifelse(df[,x] < (mean(df[,x]) - sd(df[,x])), 1, 0)
)
# The result is a matrix where rows correspond to students
# and columns correspond to tests
# Values of 1 indicate a test score was below the cutoff value (mean-sd)
# Values of 0 indicate a test score was equal to or greater than the cutoff value
head(monitor)
#> c_sum gm_sum fm_sum cg_sum ps_sum
#> [1,] 0 0 0 0 0
#> [2,] 0 0 0 0 0
#> [3,] 0 0 0 0 0
#> [4,] 0 1 0 0 0
#> [5,] 1 1 0 1 1
#> [6,] 0 0 0 0 0
# Frequency of cutoff == 1
# e.g. "44 students scored lower than the cutoff value on one test"
# e.g. "3 students scored lower than the cutoff value on five tests"
table(apply(monitor, 1, sum))
#>
#> 0 1 2 3 4 5
#> 122 44 14 9 8 3
# Proportion of students with at least x number of tests below cutoff
# e.g. "61% of students never scored below the cutoff value for any test"
# e.g. "39% of students scored below the cutoff value on at least one test"
data.frame(
monitor_0 = sum(apply(monitor, 1, sum) == 0)/nrow(monitor),
monitor_1 = sum(apply(monitor, 1, sum) >= 1)/nrow(monitor),
monitor_2 = sum(apply(monitor, 1, sum) >= 2)/nrow(monitor),
monitor_3 = sum(apply(monitor, 1, sum) >= 3)/nrow(monitor),
monitor_4 = sum(apply(monitor, 1, sum) >= 4)/nrow(monitor),
monitor_5 = sum(apply(monitor, 1, sum) >= 5)/nrow(monitor))
#> monitor_0 monitor_1 monitor_2 monitor_3 monitor_4 monitor_5
#> 1 0.61 0.39 0.17 0.1 0.055 0.015
循环任务：（我将输入数据名称更新为 dfall）
# template for output
out <- data.frame(matrix(ncol = 8, nrow = 0))
names(out) <- c("quest", 0:5, "n")
# Quest == 9 only has one entry in the sample data, so no SD can be calculated
# Remove Quest == 9
quests <- setdiff(unique(dfall$quest), 9)
for(q in quests){
# operate on one quest at a time
df <- dfall[dfall$quest == q,]
# determine if scores are below cutoff value
tests <- c("c_sum", "gm_sum", "fm_sum", "cg_sum", "ps_sum")
monitor <- sapply(tests, FUN = function(x)
ifelse(df[,x] < (mean(df[,x]) - sd(df[,x])), 1, 0)
)
# frequency of scores below cutoff value
tt <- as.data.frame(t(as.matrix(table(apply(monitor, 1, sum)))))
# total students in quest
tt$n <- rowSums(tt, na.rm = TRUE)
# quest id
tt$quest <- as.numeric(q)
# compile results
out <- dplyr::bind_rows(out, tt)
}
# Format table
out$Age <- out$quest
out$Domain0 <- paste0(round(out$`0`/ out$n * 100, 2), "% (", out$`0`, ")")
out$Domain1 <- paste0(round(out$`1`/ out$n * 100, 2), "% (", out$`1`, ")")
out$Domain2 <- paste0(round(out$`2`/ out$n * 100, 2), "% (", out$`2`, ")")
out$Domain3 <- paste0(round(out$`3`/ out$n * 100, 2), "% (", out$`3`, ")")
out$Domain4 <- paste0(round(out$`4`/ out$n * 100, 2), "% (", out$`4`, ")")
out$Domain5 <- paste0(round(out$`5`/ out$n * 100, 2), "% (", out$`5`, ")")
yourtable <- (out[c("Age", "Domain0", "Domain1", "Domain2", "Domain3", "Domain4", "Domain5")])
yourtable[order(yourtable$Age),]
#>
#> Age Domain0 Domain1 Domain2 Domain3 Domain4 Domain5
#> 12 2 63.64% (7) NA% (NA) 9.09% (1) 27.27% (3) NA% (NA) NA% (NA)
#> 6 4 46.67% (7) 40% (6) 6.67% (1) NA% (NA) NA% (NA) 6.67% (1)
#> 16 6 60% (6) 20% (2) 10% (1) NA% (NA) 10% (1) NA% (NA)
#> 11 8 54.55% (6) 27.27% (3) NA% (NA) 9.09% (1) 9.09% (1) NA% (NA)
#> 2 10 36.36% (4) 45.45% (5) 9.09% (1) 9.09% (1) NA% (NA) NA% (NA)
#> 19 12 54.55% (6) 27.27% (3) NA% (NA) 18.18% (2) NA% (NA) NA% (NA)
#> 10 14 42.86% (3) 42.86% (3) NA% (NA) 14.29% (1) NA% (NA) NA% (NA)
#> 18 16 50% (4) 37.5% (3) NA% (NA) NA% (NA) 12.5% (1) NA% (NA)
#> 8 18 80% (8) NA% (NA) NA% (NA) 10% (1) NA% (NA) 10% (1)
#> 5 20 57.14% (4) 28.57% (2) 14.29% (1) NA% (NA) NA% (NA) NA% (NA)
#> 9 22 40% (2) 40% (2) NA% (NA) NA% (NA) 20% (1) NA% (NA)
#> 15 24 54.55% (6) 27.27% (3) 9.09% (1) NA% (NA) 9.09% (1) NA% (NA)
#> 21 27 66.67% (2) 33.33% (1) NA% (NA) NA% (NA) NA% (NA) NA% (NA)
#> 17 30 66.67% (2) 33.33% (1) NA% (NA) NA% (NA) NA% (NA) NA% (NA)
#> 20 33 83.33% (5) NA% (NA) NA% (NA) NA% (NA) NA% (NA) 16.67% (1)
#> 14 36 63.64% (7) 18.18% (2) 9.09% (1) 9.09% (1) NA% (NA) NA% (NA)
#> 1 42 70.59% (12) 11.76% (2) 5.88% (1) 5.88% (1) 5.88% (1) NA% (NA)
#> 3 48 60% (6) 20% (2) NA% (NA) 20% (2) NA% (NA) NA% (NA)
#> 13 54 62.5% (10) 12.5% (2) 12.5% (2) NA% (NA) 6.25% (1) 6.25% (1)
#> 4 60 72.73% (8) NA% (NA) 18.18% (2) NA% (NA) NA% (NA) 9.09% (1)
#> 7 72 80% (4) NA% (NA) NA% (NA) NA% (NA) NA% (NA) 20% (1)
Created on 2022-01-12 by the reprex package (v2.0.1)
这个答案实现了tidyverse函数来处理这个问题。结果与我在运行 @skaqqs 提供的优雅代码后得到的结果相同。
代码在下面，我构建了一个 gif 图像来显示解决方案。 [请记住，我编辑了这个答案而不是 gif。因此，您会在 gif 演示中看到细微差别]
library(tidyverse)
library(janitor)
df %>% select(id, quest, ends_with("sum")) %>%
pivot_longer(-c(id, quest)) %>% #tranform to long format
nest_by(quest, name) %>% #nest (id will not be used this time)
#all counts are performed here
mutate(
n = map_dbl(data[2], ~nrow(data.frame(.))), #compute sample size
mean = map_dbl(data[2], ~mean(.)), #get the ROBUST means
sd = map_dbl(data[2], ~sd(.)), #get the ROBUST sd
one_below = mean-sd, #1 below
two_below = mean - 2 * sd) %>%
#outside of the map, add a new variable to the nested data
mutate(data = list(data %>% mutate(area_monitor = as.character(ifelse(data[[2]] <= one_below, paste0(name),0))))) %>%
unnest(cols = c(data)) %>% #I'll unnest the data and get again the ids. my df will be very long
pivot_wider(id_cols = c(id, quest), names_from = area_monitor, values_fn = length) %>% #now I'll group by ids!! my df will be sample size * quest
ungroup() %>% #end of function
#now I'll count values
mutate(how_many = select(.,ends_with("_sum")) %>%
rowSums(., na.rm = T)) %>%
#now I'll present the results
tabyl(quest, how_many) %>%
adorn_totals(c("row", "col")) %>%
adorn_percentages("row") %>%
adorn_pct_formatting(digits = 2) %>%
adorn_ns()