关于游泳者瀑布图的时间轴的一个问题。
我使用下面的代码生成了游泳者图>
但是,我想根据数据集中的responseStartTime和responseEndTime持续时间,用responseType(而不是“ Stage”)对每个主题的条进行着色。请建议我如何在响应持续时间内通过responseType定义颜色。
谢谢!
来源:(http://rpubs.com/alexiswl/swimmer)。
library(magrittr)
library(stringi)
library(readr) # Reading in the dataset
library(ggplot2) # Viewing the dataset
library(forcats) # Sorting factors
library(RColorBrewer) # Plot colours
library(dplyr, warn.conflicts=FALSE) # Manipulating the dataframes
library(purrr, warn.conflicts=FALSE) # Manipulating dataframe metadata
library(zoo, warn.conflicts=FALSE) # Filling in NA values
library(reshape2) # Reformmating dataframes
library(editData)
df.data <- df
swimmer_file = "https://blogs.sas.com/content/graphicallyspeaking/files/2014/06/Swimmer_93.txt"
col.names = c("subjectID", "stage", "startTime", "endTime",
"isContinued", "responseType", "responseStartTime", "responseEndTime", "Durable")
df <- readr::read_lines(swimmer_file) %>%
# Split by line recursion (\r\n)
stringi::stri_split(fixed="\r\n", simplify=TRUE) %>%
# Take only lines starting with a number (sample id)
.[grepl("^[0-9]+", .)] %>%
# Remove spaces from response column
gsub(pattern="\\sresponse", replacement="_response") %>%
# Remove spaces from stage column
gsub(pattern="Stage\\s", replacement="Stage_") %>%
# Some lines missing 'Stage' and 'isContinued' column.
# Replace any set of 8 or more spaces with ' . '
gsub(pattern="\\s{8,}", replacement=' . ') %>%
# Split strings by spaces, do not include empty strings as columns
stringi::stri_split(fixed=" ", simplify=TRUE, omit_empty=TRUE) %>%
# Convert to dataframe
as.data.frame(stringsAsFactors=FALSE) %>%
# Set the column names
purrr::set_names(col.names) %>%
# We need to do some more cleaning up of the dataframe
# Convert all . to NAs
dplyr::na_if(".") %>%
# Fill NAs in Stage column
dplyr::mutate(stage=zoo::na.locf(stage)) %>%
# Turn isContinued into boolean
dplyr::mutate(isContinued=dplyr::if_else(isContinued=="FilledArrow", TRUE, FALSE, missing=FALSE)) %>%
# Convert stage variable to factor, remove underscore
dplyr::mutate(stage = as.factor(gsub(pattern="_", replacement=" ", x=stage))) %>%
# Remove underscore from response types
dplyr::mutate(responseType = gsub("_", " ", responseType)) %>%
# Change Durable from character to numeric
dplyr::mutate(Durable = as.numeric(Durable)) %>%
# Change Time variables from character to numeric
dplyr::mutate_at(vars(dplyr::ends_with("Time")), as.numeric)
df.shapes <- df %>%
# Get just the subject and response time columns
dplyr::select(subjectID, responseType, responseStartTime) %>%
# Melt the data frame, so one row per response value.
reshape2::melt(id.vars=c("subjectID", "responseType"), value.name="time") %>%
# Remove na values
dplyr::filter(!is.na(time)) %>%
# Remove response variable column
dplyr::select(-variable) %>%
# Add 'start' to the end of the response type
dplyr::mutate(responseType=paste(responseType, "start", sep=" "))
# Add the end time for each
df.shapes %<>%
dplyr::bind_rows(df %>%
dplyr::select(subjectID, endTime, responseEndTime, isContinued) %>%
# Place endtime as response endtime if not continuing and responseEndTime is NA
dplyr::mutate(responseEndTime=dplyr::if_else(!isContinued & is.na(responseEndTime),
endTime, responseEndTime)) %>%
dplyr::select(-endTime, -isContinued) %>%
# Remove other existing NA responseEndTimes
dplyr::filter(!is.na(responseEndTime)) %>%
dplyr::mutate(responseType="Response end") %>%
dplyr::rename(time=responseEndTime))
# Append on the durable column
df.shapes %<>%
dplyr::bind_rows(df %>%
dplyr::select(subjectID, Durable) %>%
dplyr::filter(!is.na(Durable)) %>%
dplyr::mutate(responseType="Durable") %>%
dplyr::rename(time=Durable))
# Add on the arrow sets
df.shapes %<>%
dplyr::bind_rows(df %>%
dplyr::select(subjectID, endTime, isContinued) %>%
dplyr::filter(isContinued) %>%
dplyr::select(-isContinued) %>%
dplyr::mutate(responseType="Continued Treatment") %>%
dplyr::mutate(endTime=endTime+0.25) %>%
dplyr::rename(time=endTime))
responseLevels = c("Complete response start", "Partial response start",
"Response end", "Durable", "Continued Treatment")
# Convert responseType to factor and set the levels
df.shapes %<>%
dplyr::mutate(responseType = factor(responseType, levels=responseLevels)) %>%
# Order by response type
dplyr::arrange(desc(responseType))
unicode = list(triangle=sprintf('\u25B2'),
circle=sprintf('\u25CF'),
square=sprintf('\u25A0'),
arrow=sprintf('\u2794'))
df %>%
# Get just the variables we need for the base of the plot
dplyr::select(subjectID, endTime, stage) %>%
# Remove duplicate rows
dplyr::distinct() %>%
# Order subject ID by numeric value
dplyr::mutate(subjectID=forcats::fct_reorder(.f=subjectID, .x=as.numeric(subjectID), .desc = TRUE)) %>%
# Pipe into ggplot
ggplot(aes(subjectID, endTime)) + # Base axis
geom_bar(stat="identity", aes(fill=factor(stage))) + # Bar plot. Colour by stage
geom_point(data=df.shapes, # Use df.shapes to add reponse points
aes(subjectID, time, colour=responseType, shape=responseType), size=5) +
coord_flip() + # Flip to horizonal bar plot.
scale_colour_manual(values=c(RColorBrewer::brewer.pal(3, "Set1")[1:2], # Add colours
rep("black", 3))) + # min of brewerpal is three but we only need 2.
scale_shape_manual(values=c(rep(unicode[["triangle"]], 2), # Add shapes
unicode[["circle"]], unicode[["square"]], unicode[["arrow"]])) +
scale_y_continuous(limits=c(-0.5, 20), breaks=0:20) + # Set time limits
labs(fill="Disease Stage", colour="Symbol Key", shape="Symbol Key", # Add labels
x="Subject ID ", y="Months since diagnosis",
title="Swimmer Plot",
caption="Durable defined as subject with six months or more of confirmed response") +
theme(plot.title = element_text(hjust = 0.5), # Put title in the middle of plot
plot.caption = element_text(size=7, hjust=0)) # Make caption size smaller
答案 0 :(得分:0)
很抱歉,您的回答很晚,但是我认为这是一个非常有趣的问题,因此即使您不再需要了,我也可以发布解决方案。我希望我了解你想要的。
基本上,您必须采用其他方法并使用geom_segment().
如果这样做,解决方案将非常简单。
唯一的问题是您没有明确设定目标:例如,如果您拥有responseEndTime
值的NA,或者想要保留或不保留自己的信息,该怎么办?显示在您的条形图中,因此我不得不做出任意选择,但是您应该能够弄清楚如何从此解决方案中获得所需的东西:
df %>%
# Add a few variables to your df
dplyr::select(subjectID, stage, responseStartTime, responseEndTime,
endTime, responseType) %>%
# Remove duplicate rows
dplyr::distinct() %>%
# Order subject ID by numeric value
dplyr::mutate(
subjectID=forcats::fct_reorder(.f=subjectID,
.x=as.numeric(subjectID),
.desc = TRUE)) %>%
# Pipe into ggplot
ggplot(aes(subjectID, endTime)) + # Base axis
# substitute geom_bar by a geom_segment
geom_segment(aes(x = 0, xend = endTime, y=subjectID,
yend=subjectID, color = factor(stage)),
size = 12) +
# Substitue geom_point with another geom_segment for the responseTime part
geom_segment(aes(x = responseStartTime, xend = responseEndTime,
y=subjectID, yend=subjectID, color = responseType),
size =8) +
# don't need coord_flip anymore
# probably could improve this part but you got the idea
scale_colour_manual(values=c("#FFFFFF", "#000000",
"#F8766D", "#C49A00", "#53B400",
"#00C094")) +
# the y scale is now the x scale...
scale_x_continuous(limits=c(-0.5, 20), breaks=0:20) + # Set time limits
labs(fill="Disease Stage", colour="Symbol Key",
shape="Symbol Key", # Add labels
y="Subject ID ", x="Months since diagnosis",
title="Swimmer Plot",
caption="Durable defined as subject with six months or more of confirmed response") +
theme(plot.title = element_text(hjust = 0.5),
plot.caption = element_text(size=7, hjust=0))