Regarding factoring in R

99封情书 提交于 2021-02-20 03:51:43

问题


I have this code where currently I am displaying for 2 patients but I have to group the 3 records and display them for more than 15 patients. Currently I am factoring for each patients as below but is there any way to use factor with grep so that my factor won't become so tedious

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

```

回答1:


Does this solve your problem?

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))

Output

Update

Assume that your dataframe looks like this

> 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

We first need to do some transformation

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))
  )

The resultant dataframe (df1) looks like this

> 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

Then use the following code to 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))

Output



来源:https://stackoverflow.com/questions/64603025/regarding-factoring-in-r

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!