Related
I have a df:
test<- data.frame (Metrics = c("PCT_PF_READS (%)" , "PCT_Q30_R1 (%)" , "PCT_Q30_R2 (%)"),
LowerLimit = c(80,80,80),
Percent = c(93.1,95.1,92.4)
)
> test
Metrics LowerLimit Percent
1 PCT_PF_READS (%) 80 93.1
2 PCT_Q30_R1 (%) 80 95.1
3 PCT_Q30_R2 (%) 80 92.4
I am trying to plot in ggplot2 but I want to specify the yaxis.
If I do:
ggplot(data=test3, aes(x= Metrics,y=Percent,)) +
geom_bar(stat="identity" )
If I try to set the yaxis to start at 75, I get a blank plot:
ggplot(data=test3, aes(x= Metrics,y=Percent,)) +
geom_bar(stat="identity" ) + scale_y_continuous(limits = c(75,100))
with the message
Warning message:
Removed 3 rows containing missing values (geom_bar)
But the values are in range????
Does this answer your question?
library(tidyverse)
test<- data.frame (Metrics = c("PCT_PF_READS (%)" , "PCT_Q30_R1 (%)" , "PCT_Q30_R2 (%)"),
LowerLimit = c(80,80,80),
Percent = c(93.1,95.1,92.4)
)
# Starting plot:
ggplot(data = test, aes(x = Metrics, y = Percent)) +
geom_bar(stat = "identity")
# If you cut off any of the bar using "limit" the bar is removed,
# E.g. this removes the middle bar (Percent = 95.1)
ggplot(data = test, aes(x = Metrics, y = Percent)) +
geom_bar(stat = "identity") +
scale_y_continuous(limits = c(0,95))
#> Warning: Removed 1 rows containing missing values (position_stack).
# A better solution is to use "coord_cartesian()"
ggplot(data = test, aes(x = Metrics, y = Percent)) +
geom_bar(stat = "identity") +
coord_cartesian(ylim = c(75, 100))
# Although it's generally advised to keep the whole axis,
# as 'chopping off' the bottom can be misleading
# Another alternative is to write the percentages on the plot:
ggplot(data = test, aes(x = Metrics, y = Percent)) +
geom_bar(stat = "identity") +
geom_text(aes(label = paste0(Percent, "%")),
nudge_y = 2)
Created on 2022-10-19 by the reprex package (v2.0.1)
I have a dataframe (dat) with two columns 1) Month and 2) Value. I would like to highlight that the x-axis is not continuous in my boxplot by interrupting the x-axis with two angled lines on the x-axis that are empty between the angled lines.
Example Data and Boxplot
library(ggplot2)
set.seed(321)
dat <- data.frame(matrix(ncol = 2, nrow = 18))
x <- c("Month", "Value")
colnames(dat) <- x
dat$Month <- rep(c(1,2,3,10,11,12),3)
dat$Value <- rnorm(18,20,2)
ggplot(data = dat, aes(x = factor(Month), y = Value)) +
geom_boxplot() +
labs(x = "Month") +
theme_bw() +
theme(panel.grid = element_blank(),
text = element_text(size = 16),
axis.text.x = element_text(size = 14, color = "black"),
axis.text.y = element_text(size = 14, color = "black"))
The ideal figure would look something like below. How can I make this discontinuous axis in ggplot?
You could make use of the extended axis guides in the ggh4x package. Alas, you won't easily be able to create the "separators" without a hack similar to the one suggested by user Zhiqiang Wang
guide_axis_truncated accepts vectors to define lower and upper trunks. This also works for units, by the way, then you have to pass the vector inside the unit function (e.g., trunc_lower = unit(c(0,.45), "npc") !
library(ggplot2)
library(ggh4x)
set.seed(321)
dat <- data.frame(matrix(ncol = 2, nrow = 18))
x <- c("Month", "Value")
colnames(dat) <- x
dat$Month <- rep(c(1,2,3,10,11,12),3)
dat$Value <- rnorm(18,20,2)
# this is to make it slightly more programmatic
x1end <- 3.45
x2start <- 3.55
p <-
ggplot(data = dat, aes(x = factor(Month), y = Value)) +
geom_boxplot() +
labs(x = "Month") +
theme_classic() +
theme(axis.line = element_line(colour = "black"))
p +
guides(x = guide_axis_truncated(
trunc_lower = c(-Inf, x2start),
trunc_upper = c(x1end, Inf)
))
Created on 2021-11-01 by the reprex package (v2.0.1)
The below is taking user Zhiqiang Wang's hack a step further. You will see I am using simple trigonometry to calculate the segment coordinates. in order to make the angle actually look as it is defined in the function, you would need to set coord_equal.
# a simple function to help make the segments
add_separators <- function(x, y = 0, angle = 45, length = .1){
add_y <- length * sin(angle * pi/180)
add_x <- length * cos(angle * pi/180)
## making the list for your segments
myseg <- list(x = x - add_x, xend = x + add_x,
y = rep(y - add_y, length(x)), yend = rep(y + add_y, length(x)))
## this function returns an annotate layer with your segment coordinates
annotate("segment",
x = myseg$x, xend = myseg$xend,
y = myseg$y, yend = myseg$yend)
}
# you will need to set limits for correct positioning of your separators
# I chose 0.05 because this is the expand factor by default
y_sep <- min(dat$Value) -0.05*(min(dat$Value))
p +
guides(x = guide_axis_truncated(
trunc_lower = c(-Inf, x2start),
trunc_upper = c(x1end, Inf)
)) +
add_separators(x = c(x1end, x2start), y = y_sep, angle = 70) +
# you need to set expand to 0
scale_y_continuous(expand = c(0,0)) +
## to make the angle look like specified, you would need to use coord_equal()
coord_cartesian(clip = "off", ylim = c(y_sep, NA))
I think it is possible to get what you want. It may take some work.
Here is your graph:
library(ggplot2)
set.seed(321)
dat <- data.frame(matrix(ncol = 2, nrow = 18))
x <- c("Month", "Value")
colnames(dat) <- x
dat$Month <- rep(c(1,2,3,10,11,12),3)
dat$Value <- rnorm(18,20,2)
p <- ggplot(data = dat, aes(x = factor(Month), y = Value)) +
geom_boxplot() +
labs(x = "Month") +
theme_bw() +
theme(panel.grid = element_blank(),
text = element_text(size = 16),
axis.text.x = element_text(size = 14, color = "black"),
axis.text.y = element_text(size = 14, color = "black"))
Here is my effort:
p + annotate("segment", x = c(3.3, 3.5), xend = c(3.6, 3.8), y = c(14, 14), yend = c(15, 15))+
coord_cartesian(clip = "off", ylim = c(15, 25))
Get something like this:
If you want to go further, it may take several tries to get it right:
p + annotate("segment", x = c(3.3, 3.5), xend = c(3.6, 3.8), y = c(14, 14), yend = c(15, 15))+
annotate("segment", x = c(0, 3.65), xend = c(3.45, 7), y = c(14.55, 14.55), yend = c(14.55, 14.55)) +
coord_cartesian(clip = "off", ylim = c(15, 25)) +
theme_classic()+
theme(axis.line.x = element_blank())
Just replace axis with two new lines. This is a rough idea, it may take some time to make it perfect.
You could use facet_wrap. If you assign the first 3 months to one group, and the other months to another, then you can produce two plots that are side by side and use a single y axis.
It's not exactly what you want, but it will show the data effectively, and highlights the fact that the x axis is not continuous.
dat$group[dat$Month %in% c("1", "2", "3")] <- 1
dat$group[dat$Month %in% c("10", "11", "12")] <- 2
ggplot(data = dat, aes(x = factor(Month), y = Value)) +
geom_boxplot() +
labs(x = "Month") +
theme_bw() +
theme(panel.grid = element_blank(),
text = element_text(size = 16),
axis.text.x = element_text(size = 14, color = "black"),
axis.text.y = element_text(size = 14, color = "black")) +
facet_wrap(~group, scales = "free_x")
* Differences in the plot are likely due to using different versions of R where the set.seed gives different result
I am using R. In a previous post (R: Loop Producing the Following Error: Argument 1 must have names), I learned how to make a function ("create_data") for my code.
Now, I am trying to modify this function.
First, I create some data to be used for this example:
#load library
library(dplyr)
set.seed(123)
# create some data for this example
a1 = rnorm(1000,100,10)
b1 = rnorm(1000,100,5)
c1 = sample.int(1000, 1000, replace = TRUE)
train_data = data.frame(a1,b1,c1)
Here is the modified version of the function:
create_data <- function() {
#generate random numbers
random_1 = runif(1, 80, 120)
random_2 = runif(1, random_1, 120)
random_3 = runif(1, 85, 120)
random_4 = runif(1, random_3, 120)
#bin data according to random criteria
train_data <- train_data %>% mutate(cat = ifelse(a1 <= random_1 & b1 <= random_3, "a", ifelse(a1 <= random_2 & b1 <= random_4, "b", "c")))
train_data$cat = as.factor(train_data$cat)
#new splits
a_table = train_data %>%
select(a1, b1, c1) %>%
filter(cat == "a")
b_table = train_data %>%
select(a1, b1, c1) %>%
filter(cat == "b")
c_table = train_data %>%
select(a1, b1, c1) %>%
filter(cat == "c")
split_1 = runif(1,0, 1)
split_2 = runif(1, 0, 1)
split_3 = runif(1, 0, 1)
#calculate 60th quantile ("quant") for each bin
table_a = data.frame(a_table%>% group_by(cat) %>%
mutate(quant = quantile(c1, prob = split_1)))
table_b = data.frame(b_table%>% group_by(cat) %>%
mutate(quant = quantile(c1, prob = split_2)))
table_c = data.frame(c_table%>% group_by(cat) %>%
mutate(quant = quantile(c1, prob = split_3)))
#create a new variable ("diff") that measures if the quantile is bigger tha the value of "c1"
table_a$diff = ifelse(table_a$quant > table_a$c1,1,0)
table_b$diff = ifelse(table_b$quant > table_b$c1,1,0)
table_c$diff = ifelse(table_c$quant > table_c$c1,1,0)
#group all tables
final_table = rbind(table_a, table_b, table_c)
#create a table: for each bin, calculate the average of "diff"
final_table_2 = data.frame(final_table %>%
group_by(cat) %>%
summarize(
mean = mean(diff)
))
#add "total mean" to this table
final_table_2 = data.frame(final_table_2 %>% add_row(cat = "total", mean = mean(final_table$diff)))
#format this table: add the random criteria to this table for reference
final_table_2$random_1 = random_1
final_table_2$random_2 = random_2
final_table_2$random_3 = random_3
final_table_2$random_4 = random_4
final_table_2$split_1 = split_1
final_table_2$split_2 = split_2
final_table_2$split_3 = split_3
final_table$iteration_number = i
}
The error results when I try to call the function:
Error: Problem with `filter()` input `..1`.
i Input `..1` is `cat == "a"`.
x comparison (1) is possible only for atomic and list types
I have a feeling that maybe the error is occurring over here:
a_table = train_data %>%
select(a1, b1, c1) %>%
filter(cat == "a")
I tried to replace this "select" with a non-dplyr version:
a_table <- train_data[cat == "a", ]
But this also producing an error:
Error in cat == "a" :
comparison (1) is possible only for atomic and list types
Can someone please show me what I am doing wrong?
Thanks
You are selecting only 3 columns here which does not include cat column hence you get the error.
a_table = train_data %>%
select(a1, b1, c1) %>%
filter(cat == "a")
Instead you can first filter and then select.
a_table = train_data %>%
filter(cat == "a") %>%
select(a1, b1, c1)
Same should be applied for b_table and c_table.
We could do this in base R
a_table <- subset(train_data, cat == "a", select = c(a1, b1, c1))
library(tidyverse)
set.seed(12345)
dat <- data.frame(year = c(rep(1990, 100), rep(1991, 100), rep(1992, 100)),
fish_length = sample(x = seq(from = 10, 131, by = 0.1), 300, replace = F),
nb_caught = sample(x = seq(from = 1, 200, by = 0.1), 300, replace = T),
stringsAsFactors = F) %>%
mutate(age = ifelse(fish_length < 20, 1,
ifelse(fish_length >= 20 & fish_length < 100, 2,
ifelse(fish_length >= 100 & fish_length < 130, 3, 4)))) %>%
arrange(year, fish_length)
head(dat)
year fish_length nb_caught age
1 1990 10.1 45.2 1
2 1990 10.7 170.0 1
3 1990 10.9 62.0 1
4 1990 12.1 136.0 1
5 1990 14.1 80.8 1
6 1990 15.0 188.9 1
dat %>% group_by(year) %>% summarise(ages = n_distinct(age)) # Only 1992 has age 4 fish
# A tibble: 3 x 2
year ages
<dbl> <int>
1 1990 3
2 1991 3
3 1992 4
dat %>% filter(age == 4) # only 1 row for age 4
year fish_length nb_caught age
1 1992 130.8 89.2 4
Here:
year = year of sampling
fish_length = length of the fish in cm
nb_caught = number of fish caught following the use of an age-length key, hence explaining the presence of decimals
age = age of the fish
graph1: geom_violin not using the weight aesthetic.
Here, I got to copy each line of dat according to the value found in nb_caught.
dim(dat) # 300 rows
dat_graph1 <- dat[rep(1:nrow(dat), floor(dat$nb_caught)), ]
dim(dat_graph1) # 30932 rows
dat_graph1$nb_caught <- NULL # useless now
sum(dat$nb_caught) - nrow(dat_graph1) # 128.2 rows lost here
Since I have decimal values of nb_caught, I took the integer value to create dat_graph1. I lost 128.2 "rows" in the process.
Now for the graph:
dat_tile <- data.frame(year = sort(unique(dat$year))[sort(unique(dat$year)) %% 2 == 0])
# for the figure's background
graph1 <- ggplot(data = dat_graph1,
aes(x = as.factor(year), y = fish_length, fill = as.factor(age),
color = as.factor(age), .drop = F)) +
geom_tile(data = dat_tile, aes(x = factor(year), y = 1, height = Inf, width = 1),
fill = "grey80", inherit.aes = F) +
geom_violin(draw_quantiles = c(0.05, 0.5, 0.95), color = "black",
scale = "width", position = "dodge") +
scale_x_discrete(expand = c(0,0)) +
labs(x = "Year", y = "Fish length", fill = "Age", color = "Age", title = "graph1") +
scale_fill_brewer(palette = "Paired", drop = F) + # drop = F for not losing levels
scale_color_brewer(palette = "Paired", drop = F) + # drop = F for not losing levels
scale_y_continuous(expand = expand_scale(mult = 0.01)) +
theme_bw()
graph1
graph1
Note here that I have a flat bar for age 4 in year 1992.
dat_graph1 %>% filter(year == 1992, age == 4) %>% pull(fish_length) %>% unique
[1] 130.8
That is because I only have one length for that particular year-age combination.
graph2: geom_violin using the weight aesthetic.
Now, instead of copying each row of dat by the value of number_caught, let's use the weight aesthetic.
Let's calculate the weight wt that each line of dat will have in the calculation of the density curve of each year-age combinations.
dat_graph2 <- dat %>%
group_by(year, age) %>%
mutate(wt = nb_caught / sum(nb_caught)) %>%
as.data.frame()
head(dat_graph2)
year fish_length nb_caught age wt
1 1990 10.1 45.2 1 0.03573123
2 1990 10.7 170.0 1 0.13438735
3 1990 10.9 62.0 1 0.04901186
4 1990 12.1 136.0 1 0.10750988
5 1990 14.1 80.8 1 0.06387352
6 1990 15.0 188.9 1 0.14932806
graph2 <- ggplot(data = dat_graph2,
aes(x = as.factor(year), y = fish_length, fill = as.factor(age),
color = as.factor(age), .drop = F)) +
geom_tile(data = dat_tile, aes(x = factor(year), y = 1, height = Inf, width = 1),
fill = "grey80", inherit.aes = F) +
geom_violin(aes(weight = wt), draw_quantiles = c(0.05, 0.5, 0.95), color = "black",
scale = "width", position = "dodge") +
scale_x_discrete(expand = c(0,0)) +
labs(x = "Year", y = "Fish length", fill = "Age", color = "Age", title = "graph2") +
scale_fill_brewer(palette = "Paired", drop = F) + # drop = F for not losing levels
scale_color_brewer(palette = "Paired", drop = F) + # drop = F for not losing levels
scale_y_continuous(expand = expand_scale(mult = 0.01)) +
theme_bw()
graph2
dat_graph2 %>% filter(year == 1992, age == 4)
year fish_length nb_caught age wt
1 1992 130.8 89.2 4 1
graph2
Note here that the flat bar for age 4 in year 1992 seen on graph1 has been dropped here even though the line exists in dat_graph2.
My questions
Why is the age 4 in 1992 level dropped when using the weight aesthetic? How can I overcome this?
Why are the two graphs not visually alike even though they used the same data?
Thanks in advance for your help!
1.
Problem 1 is not related to using the weight aesthetic. You can check this by dropping the weight aesthetic in the code for your second graph. The problem is, that the algorithm for computing the density fails, when there are too less observations.
That is the reason, why group 4 shows up in graph 1 with the expanded dataset (grpah 1). Here you increase the number of observations by replicating the number of obs.
Unfortunately, geom_violin gives no warning in your specific case. However, if you filter dat_graph2 for age == 4 geom_violin gives you the warning
Warning message:
Computation failed in `stat_ydensity()`:
replacement has 1 row, data has 0
geom_density is much clearer on this issue, giving a warning, that groups with less than two obs have been dropped.
Unfortunately, I have no solution to overcome this, besides working with the expanded dataset.
2.
Concerning problem 2 I have no convincing answer except that I guess that this is related to the details of the kernel density estimator used by geom_violin, geom_density, ... and perhaps also somehow related to the number of data points.
I am trying to create a Kaplan-Meier plot with 95% confidence bands plus having the censored data in a table beneath it. I can create the plot, but not the table. I get the error message: Error in grid.draw(both) : object 'both' not found.
library(survival)
library(ggplot2)
library(GGally)
library(gtable)
data(lung)
sf.sex <- survfit(Surv(time, status) ~ sex, data = lung)
pl.sex <- ggsurv(sf.sex) +
geom_ribbon(aes(ymin=low,ymax=up,fill=group),alpha=0.3) +
guides(fill=guide_legend("sex"))
pl.sex
tbl <- ggplot(df_nums, aes(x = Time, y = factor(variable), colour = variable,+
label=value)) +
geom_text() +
theme_bw() +
theme(panel.grid.major = element_blank(),+
legend.position = "none",+
plot.background = element_blank(), +
panel.grid.major = element_blank(),+
panel.grid.minor = element_blank(),+
panel.border = element_blank(),+
legend.position="none",+
axis.line = element_blank(),+
axis.text.x = element_blank(),+
axis.text.y = element_text(size=15, face="bold", color = 'black'),+
axis.ticks=element_blank(),+
axis.title.x = element_blank(),+
axis.title.y = element_blank(),+
plot.title = element_blank()) +
scale_y_discrete(breaks=c("Group.A", "Group.B"), labels=c("Group A", "Group B"))
both = rbind(ggplotGrob(g), ggplotGrob(tbl), size="last")
panels <- both$layout$t[grep("panel", both$layout$name)]
both$heights[panels] <- list(unit(1,"null"), unit(2, "lines"))
both <- gtable_add_rows(both, heights = unit(1,"line"), 8)
both <- gtable_add_grob(both, textGrob("Number at risk", hjust=0, x=0), t=9, l=2, r=4)
grid.newpage()
grid.draw(both)
I solved the problem by using the Rcmdrplugin KMggplot2 The code is generated by the plugin after selecting the data and variables.
library(survival, pos=18)
data(lung, package="survival")
lung <- within(lung, {
sex <- factor(sex, labels=c('male','female'))
})
ggthemes_data <- ggthemes::ggthemes_data
require("ggplot2")
.df <- na.omit(data.frame(x = lung$time, y = lung$status, z = lung$sex))
.df <- .df[do.call(order, .df[, c("z", "x"), drop = FALSE]), , drop = FALSE]
.fit <- survival::survfit(survival::Surv(time = x, event = y, type = "right") ~ z,
.df)
.pval <- plyr::ddply(.df, plyr::.(),
function(x) {
data.frame(
x = 0, y = 0, df = 1,
chisq = survival::survdiff(
survival::Surv(time = x, event = y, type = "right") ~ z, x
)$chisq
)})
.pval$label <- paste0(
"paste(italic(p), \" = ",
signif(1 - pchisq(.pval$chisq, .pval$df), 3),
"\")"
)
.fit <- data.frame(x = .fit$time, y = .fit$surv, nrisk = .fit$n.risk, nevent =
.fit$n.event, ncensor= .fit$n.censor, upper = .fit$upper, lower = .fit$lower)
.df <- .df[!duplicated(.df[,c("x", "z")]), ]
.df <- .fit <- data.frame(.fit, .df[, c("z"), drop = FALSE])
.med <- plyr::ddply(.fit, plyr::.(z), function(x) {
data.frame(
median = min(subset(x, y < (0.5 + .Machine$double.eps^0.5))$x)
)})
.df <- .fit <- rbind(unique(data.frame(x = 0, y = 1, nrisk = NA, nevent = NA,
ncensor = NA, upper = 1, lower = 1, .df[, c("z"), drop = FALSE])), .fit)
.cens <- subset(.fit, ncensor == 1)
.tmp1 <- data.frame(as.table(by(.df, .df[, c("z"), drop = FALSE], function(d)
max(d$nrisk, na.rm = TRUE))))
.tmp1$x <- 0
.nrisk <- .tmp1
for (i in 1:9) {.df <- subset(.fit, x < 100 * i); .tmp2 <-
data.frame(as.table(by(.df, .df[, c("z"), drop = FALSE], function(d) if
(all(is.na(d$nrisk))) NA else min(d$nrisk - d$nevent - d$ncensor, na.rm = TRUE))));
.tmp2$x <- 100 * i; .tmp2$Freq[is.na(.tmp2$Freq)] <- .tmp1$Freq[is.na(.tmp2$Freq)];
.tmp1 <- .tmp2; .nrisk <- rbind(.nrisk, .tmp2)}
.nrisk$y <- rep(seq(0.075, 0.025, -0.05), 10)
.plot <- ggplot(data = .fit, aes(x = x, y = y, colour = z)) +
RcmdrPlugin.KMggplot2::geom_stepribbon(data = .fit, aes(x = x, ymin = lower, ymax =
upper, fill = z), alpha = 0.25, colour = "transparent", show.legend = FALSE, kmplot
= TRUE) + geom_step(size = 1.5) +
geom_linerange(data = .cens, aes(x = x, ymin = y,
ymax = y + 0.02), size = 1.5) +
geom_text(data = .pval, aes(y = y, x = x, label =
label), colour = "black", hjust = 0, vjust = -0.5, parse = TRUE, show.legend =
FALSE, size = 14 * 0.282, family = "sans") +
geom_vline(data = .med, aes(xintercept
= median), colour = "black", lty = 2) + scale_x_continuous(breaks = seq(0, 900, by
= 100), limits = c(0, 900)) +
scale_y_continuous(limits = c(0, 1), expand = c(0.01,0)) + scale_colour_brewer(palette = "Set1") + scale_fill_brewer(palette = "Set1") +
xlab("Time from entry") + ylab("Proportion of survival") + labs(colour = "sex") +
ggthemes::theme_calc(base_size = 14, base_family = "sans") + theme(legend.position
= c(1, 1), legend.justification = c(1, 1))
.nrisk$y <- ((.nrisk$y - 0.025) / (max(.nrisk$y) - 0.025) + 0.5) * 0.5
.plot2 <- ggplot(data = .nrisk, aes(x = x, y = y, label = Freq, colour = z)) +
geom_text(size = 14 * 0.282, family = "sans") + scale_x_continuous(breaks = seq(0,900, by = 100), limits = c(0, 900)) +
scale_y_continuous(limits = c(0, 1)) +
scale_colour_brewer(palette = "Set1") + ylab("Proportion of survival") +
RcmdrPlugin.KMggplot2::theme_natrisk(ggthemes::theme_calc, 14, "sans")
.plot3 <- ggplot(data = subset(.nrisk, x == 0), aes(x = x, y = y, label = z, colour = z)) +
geom_text(hjust = 0, size = 14 * 0.282, family = "sans") +
scale_x_continuous(limits = c(-5, 5)) + scale_y_continuous(limits = c(0, 1)) +
scale_colour_brewer(palette = "Set1") +
RcmdrPlugin.KMggplot2::theme_natrisk21(ggthemes::theme_calc, 14, "sans")
.plotb <- ggplot(.df, aes(x = x, y = y)) + geom_blank() +
RcmdrPlugin.KMggplot2::theme_natriskbg(ggthemes::theme_calc, 14, "sans")
grid::grid.newpage(); grid::pushViewport(grid::viewport(layout =
grid::grid.layout(2, 2, heights = unit(c(1, 3), c("null", "lines")), widths =
unit(c(4, 1), c("lines", "null")))));
print(.plotb, vp =
grid::viewport(layout.pos.row = 1:2, layout.pos.col = 1:2));
print(.plot , vp =
grid::viewport(layout.pos.row = 1 , layout.pos.col = 1:2));
print(.plot2, vp =
grid::viewport(layout.pos.row = 2 , layout.pos.col = 1:2));
print(.plot3, vp =
grid::viewport(layout.pos.row = 2 , layout.pos.col = 1 ));
.plot <- recordPlot()
print(.plot)
Here's a start (code below)
I guess you can create the table need and replace it by the random.table
# install.packages("ggplot2", dependencies = TRUE)
# install.packages("RGraphics", dependencies = TRUE)
# install.packages("gridExtra", dependencies = TRUE)
# install.packages("survival", dependencies = TRUE)
require(ggplot2)
library(RGraphics)
library(gridExtra)
library(survival)
# Plot
data(lung)
sf.sex <- survfit(Surv(time, status) ~ sex, data = lung)
pl.sex <- ggsurv(sf.sex) +
geom_ribbon(aes(ymin=low,ymax=up,fill=group),alpha=0.3) +
guides(fill=guide_legend("sex"))
# Table
random.table <- data.frame("CL 95"=rnorm(5),n=runif(5,1,3))
pl.table <- tableGrob(random.table)
# Arrange the plots on the same page
grid.arrange(pl.sex, pl.table, ncol=1)