关于 R 的因素
Regarding factoring in R
我有这段代码，目前我正在为 2 名患者显示，但我必须将 3 条记录分组并为超过 15 名患者显示它们。
目前我正在为每个患者进行因子分解，如下所示，但是有什么方法可以将因子与 grep 一起使用，这样我的因子就不会变得如此乏味
pat_paste_c<-factor(pat_paste_c,levels=c('Pat_1_IT-6','Pat_1_IT-7','Pat_1_IT-8',"Pat_2_IT-6","Pat_2_IT-7","Pat_2_IT-8"),ordered = TRUE)
c<- data.frame(Var=character(),
Pat_1=double(),
Pat_2=double(),
stringsAsFactors=FALSE)
x<-data.frame("IT-6",4,3)
names(x)<-c('Var','Pat_1','Pat_2')
c<-rbind(c,x)
x<-data.frame("IT-7",2,8)
names(x)<-c('Var','Pat_1','Pat_2')
c<-rbind(c,x)
x<-data.frame("IT-8",2,7)
names(x)<-c('Var','Pat_1','Pat_2')
c<-rbind(c,x)
c_melt<-melt(c, id = c("Var"))
c_melt<-dplyr::rename(c_melt,"Patient"="variable")
c_melt$col<-ifelse(grepl("Pat_1", c_melt$Patient),"pink2","yellow3")
pat_paste_c<-paste(c_melt$Patient,c_melt$Var,sep='_')
pat_paste_c<-factor(pat_paste_c,levels=c('Pat_1_IT-6','Pat_1_IT-7','Pat_1_IT-8',"Pat_2_IT-6","Pat_2_IT-7","Pat_2_IT-8"),ordered = TRUE)
ggplot(data=c_melt,aes(x=pat_paste_c,y=value,fill=col,group=Patient))+
geom_bar(stat="identity",width=0.9,position=position_dodge(width = 0.9))+
geom_hline(aes(yintercept=70),color="Red")+
labs(y="Display(%)",x="")+
scale_x_discrete(limits = c(levels( pat_paste_c)[1:3], "",levels(pat_paste_c)[4:6],""))+
theme(axis.title.x = element_blank(),
axis.text.x = element_text(size=12,angle=0,vjust = 0.5,face = c( 'bold')),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank())+
theme(axis.ticks=element_line(colour = "black"),
panel.border = element_rect(colour = "black", fill=NA, size=0.5),
panel.background = element_blank(),
axis.title.y = element_text(size=15,angle=0,vjust = 0.5),
axis.text.y=element_text(size=12,angle=0,vjust = 0.5))+
theme(legend.position = "none")+ scale_fill_identity()+
scale_y_continuous(breaks = seq(0, 9, 1),limits = c(0, 9),expand = c(0, 0))
New Data
c<- data.frame(Var=character(),
Expected=double(),
Pat_1=double(),
Pat_2=double(),
stringsAsFactors=FALSE)
x<-data.frame("IT-6",2,4,3)
names(x)<-c('Var','Expected','Pat_1','Pat_2')
c<-rbind(c,x)
x<-data.frame("IT-7",3,2,8)
names(x)<-c('Var','Expected','Pat_1','Pat_2')
c<-rbind(c,x)
x<-data.frame("IT-8",4,2,7)
names(x)<-c('Var','Expected','Pat_1','Pat_2')
c<-rbind(c,x)
c_melt<-melt(c, id = c("Var"))
c_melt<-dplyr::rename(c_melt,"Patient"="variable")
c_melt$col<-ifelse(grepl("Expected", c_melt$Patient),"gray88","grey60")
> c_melt
Var Patient value col
1 IT-6 Expected 2 gray88
2 IT-7 Expected 3 gray88
3 IT-8 Expected 4 gray88
4 IT-6 Pat_1 4 grey60
5 IT-7 Pat_1 2 grey60
6 IT-8 Pat_1 2 grey60
7 IT-6 Pat_2 3 grey60
8 IT-7 Pat_2 8 grey60
9 IT-8 Pat_2 7 grey60
```
这是否解决了您的问题？
insert_every_n <- function(x, every_n, what = NA) {
n0 <- length(x); n1 <- (n0 - 1L) %/% every_n
every_n <- every_n + 1L
full_seq <- seq_len(n0 + n1)
offset <- (full_seq - 1L) %/% every_n
pos <- which(full_seq %% every_n == 0L)
`[<-`(x[full_seq - offset], pos, what)
}
pat_seq <- 1:15
var_seq <- 6:8
values <- c(4, 2, 2, 3, 8, 7, sample.int(9, 39, replace = T)) # put here values for each (Pat, IT) pair
colors <- c(
"pink2", "yellow3", "burlywood4",
"aquamarine4", "chocolate3", "cornflowerblue",
"brown2", "darkolivegreen1", "darkorchid1",
"firebrick4", "darkslategray", "gray",
"indianred4", "lightgoldenrod4", "ivory3"
)
df <- data.frame(
Patient = paste0("Pat_", rep(pat_seq, each = length(var_seq))),
Var = paste0("IT-", rep(var_seq, length(pat_seq))),
value = values,
col = rep(colors, each = length(var_seq))
)
df$PatientVar <- with(df, paste(Patient, Var, sep = "_"))
df$PatientVar <- with(df, factor(PatientVar, levels = PatientVar)) # here we keep the order "as is"
ggplot(data=df,aes(x=PatientVar,y=value,fill=col,group=Patient))+
geom_bar(stat="identity",width=0.9,position=position_dodge(width = 0.9))+
geom_hline(aes(yintercept=70),color="Red")+
labs(y="Display(%)",x="")+
scale_x_discrete(limits = insert_every_n(levels(df$PatientVar), length(var_seq), ""))+
theme(axis.title.x = element_blank(),
axis.text.x = element_text(size=12,angle=0,vjust = 0.5,face = c( 'bold')),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank())+
theme(axis.ticks=element_line(colour = "black"),
panel.border = element_rect(colour = "black", fill=NA, size=0.5),
panel.background = element_blank(),
axis.title.y = element_text(size=15,angle=0,vjust = 0.5),
axis.text.y=element_text(size=12,angle=0,vjust = 0.5))+
theme(legend.position = "none")+ scale_fill_identity()+
scale_y_continuous(breaks = seq(0, 9, 1),limits = c(0, 9),expand = c(0, 0)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
输出
更新
假设您的数据框如下所示
> df
Var Expected Pat_1 Pat_2 Pat_3 Pat_4 Pat_5 Pat_6 Pat_7 Pat_8 Pat_9 Pat_10 Pat_11 Pat_12 Pat_13 Pat_14 Pat_15
1 IT-6 2 4 7 1 1 1 1 1 7 9 9 7 8 1 6 4
2 IT-7 3 7 8 3 4 9 7 8 1 4 4 9 9 6 9 2
3 IT-8 4 8 9 7 2 7 8 2 8 8 3 5 1 5 7 5
我们首先需要做一些改造
library(dplyr)
library(tidyr)
df1 <-
df %>%
pivot_longer(starts_with("Pat"), "Patient", values_to = "Real") %>%
pivot_longer(c("Expected", "Real"), "group") %>%
arrange(
factor(Patient, unique(Patient)),
factor(Var, unique(Var)),
factor(group, unique(group))
) %>%
mutate(
PatientVar = paste(Patient, Var, sep = "_"),
PatientVar = factor(PatientVar, levels = unique(PatientVar))
)
生成的数据帧 (df1) 如下所示
> df1
# A tibble: 90 x 5
Var Patient group value PatientVar
<chr> <chr> <chr> <dbl> <fct>
1 IT-6 Pat_1 Expected 2 Pat_1_IT-6
2 IT-6 Pat_1 Real 4 Pat_1_IT-6
3 IT-7 Pat_1 Expected 3 Pat_1_IT-7
4 IT-7 Pat_1 Real 7 Pat_1_IT-7
5 IT-8 Pat_1 Expected 4 Pat_1_IT-8
6 IT-8 Pat_1 Real 8 Pat_1_IT-8
7 IT-6 Pat_2 Expected 2 Pat_2_IT-6
8 IT-6 Pat_2 Real 7 Pat_2_IT-6
9 IT-7 Pat_2 Expected 3 Pat_2_IT-7
10 IT-7 Pat_2 Real 8 Pat_2_IT-7
# ... with 80 more rows
然后用下面的代码进行ggplot
insert_every_n <- function(x, every_n, what = NA) {
n0 <- length(x); n1 <- (n0 - 1L) %/% every_n
every_n <- every_n + 1L
full_seq <- seq_len(n0 + n1)
offset <- (full_seq - 1L) %/% every_n
pos <- which(full_seq %% every_n == 0L)
`[<-`(x[full_seq - offset], pos, what)
}
colors <- c(
"pink2", "red3", "burlywood4",
"aquamarine4", "chocolate3", "cornflowerblue",
"brown2", "darkolivegreen1", "darkorchid1",
"firebrick4", "darkslategray", "gray",
"indianred4", "lightgoldenrod4", "ivory3"
)
ggplot(df1, aes(x = PatientVar, y = value, fill = Patient, group = group, alpha = group)) +
geom_bar(, stat = "identity", width = 0.9, position = position_dodge(width = 0.9)) +
geom_hline(aes(yintercept=70),color="Red")+
labs(y="Display(%)", x="", alpha = element_blank())+
guides(fill = FALSE) +
scale_x_discrete(limits = insert_every_n(levels(df1$PatientVar), length(unique(df1$Var)), ""))+
theme(axis.title.x = element_blank(),
axis.text.x = element_text(size=12,angle=0,vjust = 0.5,face = c( 'bold')),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank())+
theme(axis.ticks=element_line(colour = "black"),
panel.border = element_rect(colour = "black", fill=NA, size=0.5),
panel.background = element_blank(),
axis.title.y = element_text(size=15,angle=0,vjust = 0.5),
axis.text.y=element_text(size=12,angle=0,vjust = 0.5))+
scale_y_continuous(breaks = seq(0, 9, 1),limits = c(0, 9),expand = c(0, 0)) +
scale_fill_manual(values = colors) +
scale_alpha_discrete(range = c(.5, 1)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
输出
我有这段代码，目前我正在为 2 名患者显示，但我必须将 3 条记录分组并为超过 15 名患者显示它们。 目前我正在为每个患者进行因子分解，如下所示，但是有什么方法可以将因子与 grep 一起使用，这样我的因子就不会变得如此乏味
pat_paste_c<-factor(pat_paste_c,levels=c('Pat_1_IT-6','Pat_1_IT-7','Pat_1_IT-8',"Pat_2_IT-6","Pat_2_IT-7","Pat_2_IT-8"),ordered = TRUE)
c<- data.frame(Var=character(),
Pat_1=double(),
Pat_2=double(),
stringsAsFactors=FALSE)
x<-data.frame("IT-6",4,3)
names(x)<-c('Var','Pat_1','Pat_2')
c<-rbind(c,x)
x<-data.frame("IT-7",2,8)
names(x)<-c('Var','Pat_1','Pat_2')
c<-rbind(c,x)
x<-data.frame("IT-8",2,7)
names(x)<-c('Var','Pat_1','Pat_2')
c<-rbind(c,x)
c_melt<-melt(c, id = c("Var"))
c_melt<-dplyr::rename(c_melt,"Patient"="variable")
c_melt$col<-ifelse(grepl("Pat_1", c_melt$Patient),"pink2","yellow3")
pat_paste_c<-paste(c_melt$Patient,c_melt$Var,sep='_')
pat_paste_c<-factor(pat_paste_c,levels=c('Pat_1_IT-6','Pat_1_IT-7','Pat_1_IT-8',"Pat_2_IT-6","Pat_2_IT-7","Pat_2_IT-8"),ordered = TRUE)
ggplot(data=c_melt,aes(x=pat_paste_c,y=value,fill=col,group=Patient))+
geom_bar(stat="identity",width=0.9,position=position_dodge(width = 0.9))+
geom_hline(aes(yintercept=70),color="Red")+
labs(y="Display(%)",x="")+
scale_x_discrete(limits = c(levels( pat_paste_c)[1:3], "",levels(pat_paste_c)[4:6],""))+
theme(axis.title.x = element_blank(),
axis.text.x = element_text(size=12,angle=0,vjust = 0.5,face = c( 'bold')),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank())+
theme(axis.ticks=element_line(colour = "black"),
panel.border = element_rect(colour = "black", fill=NA, size=0.5),
panel.background = element_blank(),
axis.title.y = element_text(size=15,angle=0,vjust = 0.5),
axis.text.y=element_text(size=12,angle=0,vjust = 0.5))+
theme(legend.position = "none")+ scale_fill_identity()+
scale_y_continuous(breaks = seq(0, 9, 1),limits = c(0, 9),expand = c(0, 0))
New Data
c<- data.frame(Var=character(),
Expected=double(),
Pat_1=double(),
Pat_2=double(),
stringsAsFactors=FALSE)
x<-data.frame("IT-6",2,4,3)
names(x)<-c('Var','Expected','Pat_1','Pat_2')
c<-rbind(c,x)
x<-data.frame("IT-7",3,2,8)
names(x)<-c('Var','Expected','Pat_1','Pat_2')
c<-rbind(c,x)
x<-data.frame("IT-8",4,2,7)
names(x)<-c('Var','Expected','Pat_1','Pat_2')
c<-rbind(c,x)
c_melt<-melt(c, id = c("Var"))
c_melt<-dplyr::rename(c_melt,"Patient"="variable")
c_melt$col<-ifelse(grepl("Expected", c_melt$Patient),"gray88","grey60")
> c_melt
Var Patient value col
1 IT-6 Expected 2 gray88
2 IT-7 Expected 3 gray88
3 IT-8 Expected 4 gray88
4 IT-6 Pat_1 4 grey60
5 IT-7 Pat_1 2 grey60
6 IT-8 Pat_1 2 grey60
7 IT-6 Pat_2 3 grey60
8 IT-7 Pat_2 8 grey60
9 IT-8 Pat_2 7 grey60
```
这是否解决了您的问题？
insert_every_n <- function(x, every_n, what = NA) {
n0 <- length(x); n1 <- (n0 - 1L) %/% every_n
every_n <- every_n + 1L
full_seq <- seq_len(n0 + n1)
offset <- (full_seq - 1L) %/% every_n
pos <- which(full_seq %% every_n == 0L)
`[<-`(x[full_seq - offset], pos, what)
}
pat_seq <- 1:15
var_seq <- 6:8
values <- c(4, 2, 2, 3, 8, 7, sample.int(9, 39, replace = T)) # put here values for each (Pat, IT) pair
colors <- c(
"pink2", "yellow3", "burlywood4",
"aquamarine4", "chocolate3", "cornflowerblue",
"brown2", "darkolivegreen1", "darkorchid1",
"firebrick4", "darkslategray", "gray",
"indianred4", "lightgoldenrod4", "ivory3"
)
df <- data.frame(
Patient = paste0("Pat_", rep(pat_seq, each = length(var_seq))),
Var = paste0("IT-", rep(var_seq, length(pat_seq))),
value = values,
col = rep(colors, each = length(var_seq))
)
df$PatientVar <- with(df, paste(Patient, Var, sep = "_"))
df$PatientVar <- with(df, factor(PatientVar, levels = PatientVar)) # here we keep the order "as is"
ggplot(data=df,aes(x=PatientVar,y=value,fill=col,group=Patient))+
geom_bar(stat="identity",width=0.9,position=position_dodge(width = 0.9))+
geom_hline(aes(yintercept=70),color="Red")+
labs(y="Display(%)",x="")+
scale_x_discrete(limits = insert_every_n(levels(df$PatientVar), length(var_seq), ""))+
theme(axis.title.x = element_blank(),
axis.text.x = element_text(size=12,angle=0,vjust = 0.5,face = c( 'bold')),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank())+
theme(axis.ticks=element_line(colour = "black"),
panel.border = element_rect(colour = "black", fill=NA, size=0.5),
panel.background = element_blank(),
axis.title.y = element_text(size=15,angle=0,vjust = 0.5),
axis.text.y=element_text(size=12,angle=0,vjust = 0.5))+
theme(legend.position = "none")+ scale_fill_identity()+
scale_y_continuous(breaks = seq(0, 9, 1),limits = c(0, 9),expand = c(0, 0)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
输出
更新
假设您的数据框如下所示
> df
Var Expected Pat_1 Pat_2 Pat_3 Pat_4 Pat_5 Pat_6 Pat_7 Pat_8 Pat_9 Pat_10 Pat_11 Pat_12 Pat_13 Pat_14 Pat_15
1 IT-6 2 4 7 1 1 1 1 1 7 9 9 7 8 1 6 4
2 IT-7 3 7 8 3 4 9 7 8 1 4 4 9 9 6 9 2
3 IT-8 4 8 9 7 2 7 8 2 8 8 3 5 1 5 7 5
我们首先需要做一些改造
library(dplyr)
library(tidyr)
df1 <-
df %>%
pivot_longer(starts_with("Pat"), "Patient", values_to = "Real") %>%
pivot_longer(c("Expected", "Real"), "group") %>%
arrange(
factor(Patient, unique(Patient)),
factor(Var, unique(Var)),
factor(group, unique(group))
) %>%
mutate(
PatientVar = paste(Patient, Var, sep = "_"),
PatientVar = factor(PatientVar, levels = unique(PatientVar))
)
生成的数据帧 (df1) 如下所示
> df1
# A tibble: 90 x 5
Var Patient group value PatientVar
<chr> <chr> <chr> <dbl> <fct>
1 IT-6 Pat_1 Expected 2 Pat_1_IT-6
2 IT-6 Pat_1 Real 4 Pat_1_IT-6
3 IT-7 Pat_1 Expected 3 Pat_1_IT-7
4 IT-7 Pat_1 Real 7 Pat_1_IT-7
5 IT-8 Pat_1 Expected 4 Pat_1_IT-8
6 IT-8 Pat_1 Real 8 Pat_1_IT-8
7 IT-6 Pat_2 Expected 2 Pat_2_IT-6
8 IT-6 Pat_2 Real 7 Pat_2_IT-6
9 IT-7 Pat_2 Expected 3 Pat_2_IT-7
10 IT-7 Pat_2 Real 8 Pat_2_IT-7
# ... with 80 more rows
然后用下面的代码进行ggplot
insert_every_n <- function(x, every_n, what = NA) {
n0 <- length(x); n1 <- (n0 - 1L) %/% every_n
every_n <- every_n + 1L
full_seq <- seq_len(n0 + n1)
offset <- (full_seq - 1L) %/% every_n
pos <- which(full_seq %% every_n == 0L)
`[<-`(x[full_seq - offset], pos, what)
}
colors <- c(
"pink2", "red3", "burlywood4",
"aquamarine4", "chocolate3", "cornflowerblue",
"brown2", "darkolivegreen1", "darkorchid1",
"firebrick4", "darkslategray", "gray",
"indianred4", "lightgoldenrod4", "ivory3"
)
ggplot(df1, aes(x = PatientVar, y = value, fill = Patient, group = group, alpha = group)) +
geom_bar(, stat = "identity", width = 0.9, position = position_dodge(width = 0.9)) +
geom_hline(aes(yintercept=70),color="Red")+
labs(y="Display(%)", x="", alpha = element_blank())+
guides(fill = FALSE) +
scale_x_discrete(limits = insert_every_n(levels(df1$PatientVar), length(unique(df1$Var)), ""))+
theme(axis.title.x = element_blank(),
axis.text.x = element_text(size=12,angle=0,vjust = 0.5,face = c( 'bold')),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank())+
theme(axis.ticks=element_line(colour = "black"),
panel.border = element_rect(colour = "black", fill=NA, size=0.5),
panel.background = element_blank(),
axis.title.y = element_text(size=15,angle=0,vjust = 0.5),
axis.text.y=element_text(size=12,angle=0,vjust = 0.5))+
scale_y_continuous(breaks = seq(0, 9, 1),limits = c(0, 9),expand = c(0, 0)) +
scale_fill_manual(values = colors) +
scale_alpha_discrete(range = c(.5, 1)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))
输出