如何解决用于检查值并根据结果添加值的功能 示例数据框：更长的枢轴点使用case_when 枢轴更宽功能解决方案示例
有！ 我有一张桌子：
532 obs. of 44 variables
它看起来像这样：
A tibble: 10 x 44
ID PVD Vasculitis CVA CHF MI HTN COPD
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 11 NA NA NA NA NA 1 NA
2 22 1 NA 1 NA 1 1 1
3 33 NA NA NA NA 1 1 1
4 44 NA NA 1 NA NA NA 1
5 55 1 NA NA 1 1 1 1
6 66 NA NA NA 1 1 1 1
7 77 NA NA NA NA NA NA NA
8 88 1 NA 1 1 1 1 1
9 99 NA NA NA NA NA 1 1
10 1010 NA NA NA 1 1 1 NA
# ... with 36 more variables: TB <dbl>,Diabetes <dbl>,# Liver <dbl>,CRF <dbl>,Dementia <dbl>,Obesity <dbl>,# Hearing_loss <dbl>,Paraplegia <dbl>,`Peptic
# _ulcer` <dbl>,Autoimmune <dbl>,Breast_Cancer <dbl>,# Colon_Cancer <dbl>,Anus_Cancer <dbl>,# Stomach_Cancer <dbl>,Pancreas_Cancer <dbl>,# Ovarian_Cancer <dbl>,Cervix_uteri_Cancer <dbl>,# Uterus_Cancer <dbl>,Prostate_Cancer <dbl>,# Melanoma <dbl>,Lymphoma <dbl>,Leukemia <dbl>,# Thyroid_Cancer <dbl>,Head_and_neck_Cancer <dbl>,# Kidney_Cancer <dbl>,Adrenal_Cancer <dbl>,# Bone_Cancer <dbl>,Testicular_Cancer <dbl>,# Skin_Cancer <dbl>,Urinary_Cancer <dbl>,# Liver_Cancer <dbl>,Musculoskeletal_Cancer <dbl>,# Multiple_myeloma <dbl>,CNS_Cancer <dbl>,# Unknown_primary_Cancer <dbl>,solid <dbl>
因此，第一列是唯一的ID，后续列是不同疾病的名称（无重复）。第1行中的值分别是如果有疾病和没有NA。 例如，患者编号55（第5行）具有“ PVD”，“ CHF”，“ MI”，“ HTN”，“ COPD”等。 我还创建了一个带有癌症名称的载体（这些是第19至43列的名称）。 我想编写一个函数来检查此表，并且如果列名与我的载体的癌症名称匹配，它将检查该行（患者数）在匹配的列中是否患有癌症（如果有标记1 ），则将标记添加到名称为“ solid”的最后一列。至少一个巧合就足够了。因此，对于所有患者。 例如，如果同一位患者55患有“结肠癌”（第20列），则应在“实心”列中加1，如果他患有其他癌症也没关系。 我尝试了类似的方法，但是没有成功，并且被卡住了：
solid_tumor <- function(x){
x <- as.data.frame(x)
for (i in length(x)) {
if (colnames(x) %in% tumors) {
if(any(x==1)) {
x[i] <- 1
}
}
}
}
谢谢。
解决方法
一种使用tidyverse
的关键方法
在我看来，最好是轮换数据，以便更轻松地编写函数。
示例数据框：
首先，我们制作一个示例数据框，以便其他人更轻松地考虑这个问题和将来的解决方案：
library(tidyverse)
df <- tibble(
ID = sample(10:100,30),car = sample(na_or_1,30,replace = T,prob = c(.05,.95)),bug = sample(na_or_1,blast = sample(na_or_1,opt = sample(na_or_1,star = sample(na_or_1,queue = sample(na_or_1,man = sample(na_or_1,ring = sample(na_or_1,happy = sample(na_or_1,after = sample(na_or_1,hug = sample(na_or_1,dragon = sample(na_or_1,.95))
)
更长的枢轴点
现在，我们可以使用pivot_longer函数对ID列进行更长的数据透视。
df %>%
pivot_longer(cols = -ID) %>%
filter(!is.na(value))
这将产生以下输出：
ID Name value其中name ==列名（癌症名称）和value == 1（所有NA均被过滤掉）
这使函数更容易将逻辑应用于您要执行的操作。
使用case_when
进行更改
使用tumors的向量，我可以应用case_when逻辑，并mutate新建一个列solid。我拿出了NA过滤器，因为我想到您会希望DF基本上保持不变。
df %>%
pivot_longer(cols = -ID) %>%
# filter( !is.na(value) ) %>%
mutate(solid = case_when(name %in% tumors &
!is.na(value) ~ 1,T ~ NA_real_))
枢轴更宽
最后，我将使用pivot_wider撤消更长的数据透视。我将从更长的时间内使用原来创建的名称列中获取名称。
df %>%
pivot_longer(cols = -ID) %>%
# filter( !is.na(value) ) %>%
mutate(solid = case_when(name %in% tumors &
!is.na(value) ~ 1,T ~ NA_real_)) %>%
pivot_wider(
names_from = name
)
功能解决方案
myfunction <- function(df,tumors){
df %>%
pivot_longer(cols = -ID) %>%
# filter( !is.na(value) ) %>%
mutate(solid = case_when(name %in% tumors &
!is.na(value) ~ 1,T ~ NA_real_)) %>%
pivot_wider(
names_from = name
)
}
示例
现在，当我获取肿瘤的载体时，我可以将其放入函数和df中，并附上您原始问题的答案。
tumors <- c("hug","happy","man")
myfunction(df,tumors)
# # A tibble: 32 x 14
# ID solid car bug blast opt star queue man ring happy after hug dragon
# <int> <dbl> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
# 1 16 NA NA NA NA NA NA NA NA NA NA NA NA NA
# 2 98 NA NA NA NA NA NA NA NA NA NA NA NA NA
# 3 74 NA NA NA NA NA NA NA NA NA NA NA NA NA
# 4 50 NA NA NA NA NA NA 1 NA NA NA NA NA NA
# 5 50 1 NA NA NA NA NA NA 1 NA NA NA NA NA
# 6 29 NA NA NA NA NA NA NA NA NA NA NA NA NA
# 7 94 NA NA NA NA 1 NA NA NA NA NA NA NA NA
# 8 19 NA NA 1 NA NA NA NA NA NA NA NA NA NA
# 9 46 NA NA NA NA NA NA NA NA NA NA NA NA NA
# 10 15 NA NA 1 NA NA NA NA NA NA NA NA NA NA
以其他方式看待这个问题。
简单功能
这证明了简单的功能方法的简单性和灵活性：
func <- function(x,candidates) {
cnames <- intersect(candidates,colnames(x))
if (length(cnames)) {
+(rowSums(!is.na(subset(x,select = cnames))) > 0)
} else rep(0L,nrow(x))
}
dat$solid <- func(dat,c("CHF","MI"))
dat
# ID PVD Vasculitis CVA CHF MI HTN COPD solid
# 1 11 NA NA NA NA NA 1 NA 0
# 2 22 1 NA 1 NA 1 1 1 1
# 3 33 NA NA NA NA 1 1 1 1
# 4 44 NA NA 1 NA NA NA 1 0
# 5 55 1 NA NA 1 1 1 1 1
# 6 66 NA NA NA 1 1 1 1 1
# 7 77 NA NA NA NA NA NA NA 0
# 8 88 1 NA 1 1 1 1 1 1
# 9 99 NA NA NA NA NA 1 1 0
# 10 1010 NA NA NA 1 1 1 NA 1
整洁
不幸的是，dplyr并不容易将所有列传递给mutate中的函数。 （我敢肯定有人会推荐c_across()……我还没有发现它在这种情况下的用法很优雅。）
第一个刺可能会使用点.：
dat %>%
mutate(solid = func(.,"MI")))
它在没有任何分组的情况下仍然可以正常工作，但是无论使用哪种分组，它始终使用整个框架，因此，如果考虑到这一点，则会出现错误：
dat %>%
group_by(ID) %>%
# I know this is equivalent to rowwise() with this data
mutate(solid = func(.,"MI")))
# Error: Problem with `mutate()` input `solid`.
# x Input `solid` can't be recycled to size 1.
# i Input `solid` is `func(.,"MI"))`.
# i Input `solid` must be size 1,not 10.
# i The error occured in group 1: ID = 11.
所以简单的解决方法是do。
dat %>%
group_by(ID) %>%
do(mutate(.,solid = func(.,"MI"))))
（我意识到分组与 this 数据无关，但是将“简单”非tidyverse函数应用于当前框架的所有列可能在其他地方有用，并且尊重分组很重要。 ）
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。