I want this ggplot-facet to look like this
set.seed(1)
n10_sd1_arma0.5_0.3 <- arima.sim(n = 10, model = list(ar = c(0.5), ma = c(0.3), order = c(1, 0, 1)), sd = 1)
set.seed(1)
n10_sd1_arma0.5_0.4 <- arima.sim(n = 10, model = list(ar = c(0.5), ma = c(0.4), order = c(1, 0, 1)), sd = 1)
set.seed(1)
n10_sd1_arma0.35_0.6 <- arima.sim(n = 10, model = list(ar = c(0.35), ma = c(0.6), order = c(1, 0, 1)), sd = 1)
set.seed(1)
n10_sd3_arma0.5_0.3 <- arima.sim(n = 10, model = list(ar = c(0.5), ma = c(0.3), order = c(1, 0, 1)), sd = 3)
set.seed(1)
n10_sd3_arma0.5_0.4 <- arima.sim(n = 10, model = list(ar = c(0.5), ma = c(0.4), order = c(1, 0, 1)), sd = 3)
set.seed(1)
n10_sd3_arma0.35_0.6 <- arima.sim(n = 10, model = list(ar = c(0.35), ma = c(0.6), order = c(1, 0, 1)), sd = 3)
set.seed(1)
n10_sd5_arma0.5_0.3 <- arima.sim(n = 10, model = list(ar = c(0.5), ma = c(0.3), order = c(1, 0, 1)), sd = 5)
set.seed(1)
n10_sd5_arma0.5_0.4 <- arima.sim(n = 10, model = list(ar = c(0.5), ma = c(0.4), order = c(1, 0, 1)), sd = 5)
set.seed(1)
n10_sd5_arma0.35_0.6 <- arima.sim(n = 10, model = list(ar = c(0.35), ma = c(0.6), order = c(1, 0, 1)), sd = 5)
set.seed(1)
n10_sd10_arma0.5_0.3 <- arima.sim(n = 10, model = list(ar = c(0.5), ma = c(0.3), order = c(1, 0, 1)), sd = 10)
set.seed(1)
n10_sd10_arma0.5_0.4 <- arima.sim(n = 10, model = list(ar = c(0.5), ma = c(0.4), order = c(1, 0, 1)), sd = 10)
set.seed(1)
n10_sd10_arma0.35_0.6 <- arima.sim(n = 10, model = list(ar = c(0.35), ma = c(0.6), order = c(1, 0, 1)), sd = 10)
xx = 1:10
n10_df <- data.frame(xx = 1:10, x1 = n10_sd1_arma0.5_0.3, x2 = n10_sd1_arma0.5_0.4, x3 = n10_sd1_arma0.35_0.6, x4 = n10_sd3_arma0.5_0.3, x5 = n10_sd3_arma0.5_0.4, x6 = n10_sd3_arma0.35_0.6, x7 = n10_sd5_arma0.5_0.3, x8 = n10_sd5_arma0.5_0.4, x9 = n10_sd5_arma0.35_0.6, x10 = n10_sd10_arma0.5_0.3, x11 = n10_sd10_arma0.5_0.4, x12 = n10_sd10_arma0.35_0.6)
n10_df |>
tidyr::pivot_longer(-xx) |>
dplyr:: mutate(id = as.numeric(gsub("x", "", name))) |>
dplyr::arrange(id, xx) |>
dplyr::select(-id) |>
dplyr::mutate(sd = rep(rep(c(sd = 1, sd = 3, sd = 5, sd = 10), each = 10), each = 3),
psi = rep(rep(list(c(0.5, 0.3), c(0.5, 0.4), c(0.35, 0.6)), each = 10), 4)) |>
dplyr::mutate(sd = factor(sd, levels = sd, labels = paste("sd =", sd)),
psi = factor(psi, levels = psi, labels = gsub("c", "", paste("\U03A8 =", psi)))) |>
ggplot2::ggplot(aes(x = xx, y = value)) +
ggplot2::geom_line() +
ggplot2::geom_point() +
ggplot2::scale_y_continuous(expand = c(0.0, 0.00)) +
ggplot2::labs(x = "Time", y = "Series") +
ggplot2::facet_grid(sd ~ psi, scales = "free_y") +
ggplot2::theme_bw() + ggplot2::theme(strip.text.x = ggplot2::element_text(size = 20, face = "bold"), strip.text.y = ggplot2::element_text(size = 16, face = "bold"), axis.title = ggplot2::element_text(size = 20), axis.title.x = ggplot2::element_text(angle = 0, hjust = 0.5,
vjust = 0.5, size = 20), axis.title.y = ggplot2::element_text(angle = 90, hjust = 0.5, vjust = 0.5, size = 20))
I think my problem lies in how to twist this part rep(rep(list(c(0.5, 0.3), c(0.5, 0.4), c(0.35, 0.6)) to be what I want. Please help!
Edit
n10_df |>
tidyr::pivot_longer(-xx) |>
dplyr:: mutate(id = as.numeric(gsub("x", "", name))) |>
dplyr::arrange(id, xx) |>
dplyr::select(-id) |>
dplyr::mutate(sd = rep(rep(c(sd = 1, sd = 3, sd = 5, sd = 10), each = 10), each = 3),
psi = rep(rep(list(c(0.5, 0.3), c(0.5, 0.4), c(0.35, 0.6)), each = 10), 4)) |>
dplyr::mutate(sd = factor(sd, levels = sd, labels = paste("sd =", sd)),
psi = factor(psi, levels = psi, labels = sapply(psi, function(x) sprintf('\U03C6 = %s, \U1D717 = %s', x[1], x[2])))) |>
ggplot2::ggplot(aes(x = xx, y = value)) +
ggplot2::geom_line() +
ggplot2::geom_point() +
ggplot2::scale_y_continuous(expand = c(0.0, 0.00)) +
ggplot2::labs(x = "Time", y = "Series") +
ggplot2::facet_grid(sd ~ psi, scales = "free_y") +
ggplot2::theme_bw() + ggplot2::theme(strip.text.x = ggplot2::element_text(size = 20, face = "bold"), strip.text.y = ggplot2::element_text(size = 16, face = "bold"), axis.title = ggplot2::element_text(size = 20), axis.title.x = ggplot2::element_text(angle = 0, hjust = 0.5, vjust = 0.5, size = 20), axis.title.y = ggplot2::element_text(angle = 90, hjust = 0.5, vjust = 0.5, size = 20))
Related
I have a plot made with ggplot where the legends adds extra black points to all the other legends (see image).
library(tidyverse)
library(ggnewscale)
set.seed(12345)
brks = c(0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1)
fd = expand.grid(x = seq(6,16, length.out = 100),
y = seq(6,18, length.out = 100))
fd$z = sample(x = seq(0,1, length.out = 100), size = nrow(fd), replace = T)
df.t = data.frame(s = LETTERS[1:5], l = c(11,12,8,15,14), d = c(13,10,7,16,8))
mypal = data.frame(A = "black", B = "red",C = "blue", D = "green", E = "yellow")
summmmmmmm = expand.grid(s = LETTERS[1:5],
yr = 1995:2012)
summmmmmmm$yr = as.factor(summmmmmmm$yr)
summmmmmmm$l = NA
summmmmmmm$d = NA
summmmmmmm[summmmmmmm$s == "A","l"] = rnorm(n = 18, mean = 11, sd = .5)
summmmmmmm[summmmmmmm$s == "B","l"] = rnorm(n = 18, mean = 12, sd = .5)
summmmmmmm[summmmmmmm$s == "C","l"] = rnorm(n = 18, mean = 8, sd = .5)
summmmmmmm[summmmmmmm$s == "D","l"] = rnorm(n = 18, mean = 15, sd = .5)
summmmmmmm[summmmmmmm$s == "E","l"] = rnorm(n = 18, mean = 14, sd = .5)
summmmmmmm[summmmmmmm$s == "A","d"] = rnorm(n = 18, mean = 13, sd = .5)
summmmmmmm[summmmmmmm$s == "B","d"] = rnorm(n = 18, mean = 10, sd = .5)
summmmmmmm[summmmmmmm$s == "C","d"] = rnorm(n = 18, mean = 8, sd = .5)
summmmmmmm[summmmmmmm$s == "D","d"] = rnorm(n = 18, mean = 16, sd = .5)
summmmmmmm[summmmmmmm$s == "E","d"] = rnorm(n = 18, mean = 9, sd = .5)
ggplot(data = fd, mapping = aes(x = x, y = y, z = z)) +
geom_contour_filled(breaks = brks)+
geom_point(data = df.t,
mapping = aes(x = l, y = d, color = s), inherit.aes = FALSE, size = 5) +
scale_fill_manual(values = alpha(hcl.colors(100, "YlOrRd", rev = TRUE, alpha = 1), .99))+
scale_color_manual(values = alpha(mypal,1),
name = "obj")+
new_scale_color() +
geom_point(data = summmmmmmm,
mapping = aes(x = l, y = d,
color = yr, group = s),
shape = 19,
inherit.aes = FALSE,
show.legend = TRUE) +
geom_path(data = summmmmmmm[order(summmmmmmm$yr),],
mapping = aes(x = l, y = d, color = yr,
group = as.factor(s)), inherit.aes = FALSE,
show.legend = FALSE) +
scale_color_viridis_d(name = "time")
I'd like to get rid of those extra points. Also, I like the 'time' legend to be in 2 columns, but not the other legends. Is there a way to do this?
You need to use guide = guide_legend(ncol = 2) in your viridis scale to get two columns.
You can set show.legend = c(colour = TRUE, fill = FALSE) in the second point layer, to specifically show the legend in colour scales but not in fill scales.
See example below (where I've renamed summmmmmmm to df for my own sanity)
ggplot(data = fd, mapping = aes(x = x, y = y, z = z)) +
geom_contour_filled(breaks = brks)+
geom_point(
data = df.t,
mapping = aes(x = l, y = d, color = s), inherit.aes = FALSE, size = 5
) +
scale_fill_manual(
values = alpha(hcl.colors(100, "YlOrRd", rev = TRUE, alpha = 1), .99)
)+
scale_color_manual(values = alpha(mypal,1), name = "obj")+
new_scale_color() +
geom_point(
data = df,
mapping = aes(x = l, y = d, color = yr, group = s),
shape = 19, inherit.aes = FALSE,
show.legend = c(colour = TRUE, fill = FALSE)
) +
geom_path(
data = df[order(df$yr),],
mapping = aes(x = l, y = d, color = yr, group = as.factor(s)),
inherit.aes = FALSE, show.legend = FALSE
) +
scale_color_viridis_d(name = "time", guide = guide_legend(ncol = 2))
Could you please help me how to generate the 3D plot something as below?
dat <- tibble::tribble(
~subject, ~response, ~duration,
'1', 10, 20,
'2', -7, 30,
'3', 5, 20,
'4', 7, 50,
'5', -5, 40
)
Here's something a little closer to the original using plot3D
First draw the box, axes, title and plane:
library(plot3D)
persp3D(c(min(as.numeric(dat$subject)) - 1, max(as.numeric(dat$subject)) + 1),
c(0, max(dat$duration)),d = 50, phi = 30, theta = 55, xlab = "subject",
ylab = "Duration", zlab = "Response", ticktype = "detailed",
matrix(rep(range(dat$response), 2), 2, 2), lwd = 3,
col.panel = "gray95", colkey = FALSE, bty = "u")
title("Tumor response and duration", cex.main = 2)
rect3D(min(as.numeric(dat$subject)) - 1, 0, min(dat$response),
max(as.numeric(dat$subject)) + 1,
max(dat$duration), NULL,
col = "#e7e7e7", add = TRUE)
rect3D(min(as.numeric(dat$subject)) - 1, 0, min(dat$response),
NULL,
max(dat$duration),
max(dat$response),
col = "#e0e0e0", add = TRUE)
rect3D(min(as.numeric(dat$subject)) - 1, max(dat$duration), min(dat$response),
max(as.numeric(dat$subject)) + 1, NULL,
max(dat$response),
col = "#f0f0f0", add = TRUE)
rect3D(min(as.numeric(dat$subject)) - 1, 0, 0,
max(as.numeric(dat$subject)) + 1,
max(dat$duration), NULL,
col = "#FFFFFF20", border = "gray50", add = TRUE)
Now the bars using rect3D
for(i in seq(nrow(dat))) {
rect3D(as.numeric(dat$subject[i]) - 0.2, 0, 0,
as.numeric(dat$subject[i]) + 0.2, dat$duration[i], NULL,
col = "#7c95ca", add = TRUE)
}
for(i in seq(nrow(dat))) {
rect3D(as.numeric(dat$subject[i]) - 0.2, 0, 0,
as.numeric(dat$subject[i]) + 0.2, NULL,
dat$response[i],
col = "#de7e6f", add = TRUE)
}
Finally, add the box outlines:
lines3D(c(min(as.numeric(dat$subject)) - 1, max(as.numeric(dat$subject)) + 1),
c(0, 0), rep(max(dat$response), 2), lty = 2, add = TRUE, col = "black")
lines3D(rep(max(as.numeric(dat$subject)) + 1, 2),
c(0, max(dat$duration)), rep(max(dat$response), 2),
lty = 2, add = TRUE, col = "black")
lines3D(rep(max(as.numeric(dat$subject)) + 1, 2),
c(0, 0), range(dat$response),
lty = 2, add = TRUE, col = "black")
lines3D(c(rep(min(as.numeric(dat$subject)) - 1, 3),
rep(max(as.numeric(dat$subject)) + 1, 3),
min(as.numeric(dat$subject)) - 1),
c(0, 0, rep(max(dat$duration), 3), 0, 0),
c(min(dat$response), rep(max(dat$response), 3),
rep(min(dat$response),3)),add = TRUE, col = "black", lwd = 5)
However, as others have pointed out in the comments, although such a plot is superficially impressive, it is actually less useful than displaying the data in a more familiar, elegant 2-D plot. Such a plot is also far easier to create, and contains all the same information in a more readable format
library(ggplot2)
ggplot(dat, aes(response, duration)) +
geom_point(size = 6, aes(color = "(subject id)"), alpha = 0.5) +
geom_text(aes(label = subject), nudge_x = 0.5, nudge_y = 1) +
geom_hline(yintercept = 0) +
geom_vline(xintercept = 0) +
ggtitle("Tumor response versus duration") +
scale_color_manual(NULL, values = "navy") +
theme_minimal(base_size = 20) +
theme(plot.margin = margin(20, 20, 50, 20),
plot.title = element_text(size = 32, color = "gray20",
margin = margin(10, 10, 50, 10)))
I think you'll have to write that yourself. Here are a couple of half-hearted attempts; you'll need to clean them up a lot.
library(scatterplot3d)
dat <- tibble::tribble(
~subject, ~response, ~duration,
'1', 10, 20,
'2', -7, 30,
'3', 5, 20,
'4', 7, 50,
'5', -5, 40
)
rectx <- c(-0.4, 0.4, 0.4, -0.4, -0.4, NA)
recty <- c(0, 0, 1, 1, 0, NA)
rectangles <- data.frame(x = numeric(), y = numeric(), z = numeric() )
for (i in seq_len(nrow(dat))) {
subj <- as.numeric(dat$subject[i])
rectangles <- rbind(rectangles,
data.frame(x = rectx + subj,
y = 0,
z = recty*dat$response[i]),
data.frame(x = rectx + subj,
y = recty*dat$duration[i],
z = 0))
}
with(dat, scatterplot3d(x = rectangles,
type= "l",
xlab = "Subject",
ylab = "Duration",
zlab = "Response"))
i <- seq_len(nrow(rectangles))
drop <- which(is.na(rectangles[i, 1]) )
drop <- c(drop, drop-1)
rectangles <- rectangles[!(i %in% drop),]
library(rgl)
open3d()
#> glX
#> 1
quads3d(rectangles, col = c(rep("red",4), rep("blue", 4)))
aspect3d(1,1,1)
decorate3d(xlab = "Subject",
ylab = "Duration",
zlab = "Response")
Created on 2023-01-07 with reprex v2.0.2
I want to make a multiple-line plot in `facet_grid like this:
I have the following R code that draws column bar plots in the facet grid
library(ggplot2)
library(reshape2)
set.seed(199)
MB_RMSE_sd1 <- runif(12, min = 0, max = 2)
TMB_RMSE_sd1 <- runif(12, min = 0, max = 2)
MB_RMSE_sd3 <- runif(12, min = 2, max = 5)
TMB_RMSE_sd3 <- runif(12, min = 2, max = 5)
MB_RMSE_sd5 <- runif(12, min = 5, max = 10)
TMB_RMSE_sd5 <- runif(12, min = 5, max = 10)
MB_RMSE_sd10 <- runif(12, min = 7, max = 16)
TMB_RMSE_sd10 <- runif(12, min = 7, max = 16)
ID <- rep(rep(c("N10_AR0.8", "N10_AR0.9", "N10_AR0.95", "N15_AR0.8", "N15_AR0.9", "N15_AR0.95", "N20_AR0.8", "N20_AR0.9", "N20_AR0.95", "N25_AR0.8", "N25_AR0.9", "N25_AR0.95"), 2), 1)
df1 <- data.frame(ID, MB_RMSE_sd1, MB_RMSE_sd3, MB_RMSE_sd5, MB_RMSE_sd10, TMB_RMSE_sd1, TMB_RMSE_sd3, TMB_RMSE_sd5, TMB_RMSE_sd10)
reshapp1 <- reshape2::melt(df1, id = "ID")
NEWDAT <- data.frame(value = reshapp1$value, year = reshapp1$ID, n = rep(rep(c("10", "15", "20", "25"), each = 3), 16), Colour = rep(rep(c("RMSE_MB", "RMSE_TMB"), each = 12), 4), sd = rep(rep(c(1, 3, 5, 10), each = 48), 1), phi = rep(rep(c("0.8", "0.9", "0.95"), 16), 4))
NEWDAT$sd <- with(NEWDAT, factor(sd, levels = sd, labels = paste("sd =", sd)))
NEWDAT$year <- factor(NEWDAT$year, levels = NEWDAT$year[1:12])
NEWDAT$n <- with(NEWDAT, factor(n, levels = n, labels = paste("n = ", n)))
library(ggpattern)
ggplot() +
geom_col_pattern(
data = NEWDAT[NEWDAT$Colour %in% c("RMSE_MB", "RMSE_TMB"), ],
aes(x = phi, y = value, pattern = rev(Colour), pattern_angle = rev(Colour)),
fill = 'white',
colour = 'black',
pattern_density = 0.1,
pattern_fill = 'black',
pattern_colour = 'black'
) +
facet_grid(sd ~ n, scales = "free") +
scale_fill_manual(
breaks = c("RMSE_MB", "RMSE_TMB"),
values = c("red", "blue", "orange", "green")
) +
scale_y_continuous(expand = c(0, 0), label = ~ abs(.)) +
guides(fill = guide_legend(reverse = TRUE)) +
labs(fill = "") +
theme_bw() +
theme(axis.text.x = element_text(angle = -90, vjust = 0.5))
#ggsave("AR1.pdf", height = 8, width = 7, device = "pdf", dpi = 700)
EDIT1
What I have after using the answer below:
library(ggplot2)
library(reshape2)
set.seed(199)
MB_RMSE_sd1 <- runif(12, min = 0, max = 2)
TMB_RMSE_sd1 <- runif(12, min = 0, max = 2)
MB_RMSE_sd3 <- runif(12, min = 2, max = 5)
TMB_RMSE_sd3 <- runif(12, min = 2, max = 5)
MB_RMSE_sd5 <- runif(12, min = 5, max = 10)
TMB_RMSE_sd5 <- runif(12, min = 5, max = 10)
MB_RMSE_sd10 <- runif(12, min = 7, max = 16)
TMB_RMSE_sd10 <- runif(12, min = 7, max = 16)
ID <- rep(rep(c("N10_AR0.8", "N10_AR0.9", "N10_AR0.95", "N15_AR0.8", "N15_AR0.9", "N15_AR0.95", "N20_AR0.8", "N20_AR0.9", "N20_AR0.95", "N25_AR0.8", "N25_AR0.9", "N25_AR0.95"), 1), 1)
df1 <- data.frame(ID, MB_RMSE_sd1, MB_RMSE_sd3, MB_RMSE_sd5, MB_RMSE_sd10, TMB_RMSE_sd1, TMB_RMSE_sd3, TMB_RMSE_sd5, TMB_RMSE_sd10)
reshapp1 <- reshape2::melt(df1, id = "ID")
NEWDAT <- data.frame(value = reshapp1$value, year = reshapp1$ID, n =
rep(rep(c("10", "15", "20", "25"), each = 3), 16), Colour =
rep(rep(c("RMSE_MB", "RMSE_TMB"), each = 3), 16), sd = rep(rep(c(1, 3, 5, 10), each = 24), 1), phi = rep(rep(c("0.8", "0.9", "0.95"), 16), 4))
NEWDAT$sd <- with(NEWDAT, factor(sd, levels = sd, labels = paste("sd =", sd)))
NEWDAT$year <- factor(NEWDAT$year, levels = NEWDAT$year[1:12])
NEWDAT$n <- with(NEWDAT, factor(n, levels = n, labels = paste("n = ", n)))
ggplot(NEWDAT, aes(phi, value)) +
geom_line(aes(linetype = Colour)) + geom_point() +
scale_y_continuous(expand = c(0, 0), label = ~ abs(.)) +
guides(fill = guide_legend(reverse = TRUE)) +
#labs(fill = "") +
facet_grid(sd ~ n, scales = "free") +
theme_bw() +
theme(axis.text.x = element_text(angle = -90, vjust = 0.5))
which produces this
WHAT I WANT
Here is a solution.
After reshaping the data, remove the duplicates with unique. Then the plot is easy, map the colour to linetype and the two lines shall be automatically separated.
library(ggplot2)
library(reshape2)
reshapp1 <- reshape2::melt(df1, id = "ID")
reshapp1 <- unique(reshapp1)
NEWDAT <- data.frame(value = reshapp1$value, year = reshapp1$ID,
n = rep(rep(c("10", "15", "20", "25"), each = 3), 16),
Colour = rep(rep(c("RMSE_MB", "RMSE_TMB"), each = 12), 4),
sd = rep(rep(c(1, 3, 5, 10), each = 48), 1),
phi = rep(rep(c(0.8, 0.9, 0.95), 16), 4))
NEWDAT$sd <- with(NEWDAT, factor(sd, levels = sd, labels = paste("sd =", sd)))
NEWDAT$year <- factor(NEWDAT$year, levels = NEWDAT$year[1:12])
NEWDAT$n <- with(NEWDAT, factor(n, levels = n, labels = paste("n = ", n)))
ggplot(NEWDAT, aes(phi, value)) +
geom_line(aes(linetype = Colour)) +
scale_y_continuous(expand = c(0, 0), label = ~ abs(.)) +
guides(fill = guide_legend(reverse = TRUE)) +
#labs(fill = "") +
facet_grid(sd ~ n, scales = "free") +
theme_bw() +
theme(axis.text.x = element_text(angle = -90, vjust = 0.5))
#ggsave("AR1.pdf", height = 8, width = 7, device = "pdf", dpi = 700)
Created on 2022-09-03 by the reprex package (v2.0.1)
I want the column header and row header of this plot to be phi = 0.8, phi = 0.9, phi = 0.95 and sd = 1, sd = 3, sd = 5, sd = 10 respectively. The phi should appear as the Greek letter symbol while the sd remains the English letter.
## simulate ARIMA(1, 0, 0)
set.seed(289805)
x1 <- arima.sim(n = 10, model = list(ar = 0.8, order = c(1, 0, 0)), sd = 1)
set.seed(671086)
x2 <- arima.sim(n = 10, model = list(ar = 0.9, order = c(1, 0, 0)), sd = 1)
set.seed(799837)
x3 <- arima.sim(n = 10, model = list(ar = 0.95, order = c(1, 0, 0)), sd = 1)
set.seed(289805)
x4 <- arima.sim(n = 10, model = list(ar = 0.8, order = c(1, 0, 0)), sd = 3)
set.seed(671086)
x5 <- arima.sim(n = 10, model = list(ar = 0.9, order = c(1, 0, 0)), sd = 3)
set.seed(799837)
x6 <- arima.sim(n = 10, model = list(ar = 0.95, order = c(1, 0, 0)), sd = 3)
set.seed(289805)
x7 <- arima.sim(n = 10, model = list(ar = 0.8, order = c(1, 0, 0)), sd = 5)
set.seed(671086)
x8 <- arima.sim(n = 10, model = list(ar = 0.9, order = c(1, 0, 0)), sd = 5)
set.seed(799837)
x9 <- arima.sim(n = 10, model = list(ar = 0.95, order = c(1, 0, 0)), sd = 5)
set.seed(289805)
x10 <- arima.sim(n = 10, model = list(ar = 0.8, order = c(1, 0, 0)), sd = 10)
set.seed(671086)
x11 <- arima.sim(n = 10, model = list(ar = 0.9, order = c(1, 0, 0)), sd = 10)
set.seed(799837)
x12 <- arima.sim(n = 10, model = list(ar = 0.95, order = c(1, 0, 0)), sd = 10)
xx <- 1:10
df <- data.frame(xx, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12)
reshapp <- reshape2::melt(df, id = "xx")
NEWDAT <- data.frame(y = reshapp$value, x = reshapp$xx, sd = rep(rep(c(sd=1, sd=3, sd=5, sd=10), each = 10), each = 3),phi = rep(rep(c(.8, .9, .95), each = 10), 4))
ggplot(NEWDAT, aes(x = x, y = y)) + geom_line() + geom_point() + labs(x = 'lb', y = 'RMSE') + facet_grid(sd ~ phi, scales = "free_y") +
theme_bw() + ggplot2::scale_y_continuous(expand = c(0.0, 0.00))
[Edited to account for the refactor in the third line of code]
A quick fix is to either create or rename the faceted key with Phi expressed in UTF8 encoding, plus the creation of the string you want (ie. "Phi|SD = N")
In this case I create a new variable:
NEWDAT %>%
mutate(phi_label = paste0("\U03D5 = ", phi), #"\U03D5" represents the character "ϕ"
sd_label = fct_reorder(.f = paste0("sd =", sd), .x = sd)) %>%
ggplot(aes(x = x, y = y)) + geom_line() + geom_point() + labs(x = 'lb', y = 'RMSE') +
facet_grid(sd_label ~ phi_label, scales = "free_y") +
theme_bw() + ggplot2::scale_y_continuous(expand = c(0.0, 0.00))
Here is a solution with plotmath using only standard characters, no special escape sequences.
NEWDAT <- data.frame(y = reshapp$value, x = reshapp$xx, sd = rep(rep(c(sd=1, sd=3, sd=5, sd=10), each = 10), each = 3),phi = rep(rep(c(.8, .9, .95), each = 10), 4))
NEWDAT$sd <- factor(NEWDAT$sd, levels = NEWDAT$sd, labels = paste("sd ==", NEWDAT$sd))
NEWDAT$phi <- with(NEWDAT, factor(phi, levels = phi, labels = paste("phi ==", phi)))
ggplot(NEWDAT, aes(x = x, y = y)) +
geom_line() +
geom_point() +
scale_y_continuous(expand = c(0.0, 0.00)) +
labs(x = 'lb', y = 'RMSE') +
facet_grid(
sd ~ phi,
scales = "free_y",
labeller = label_parsed
) +
theme_bw()
A partial answer is this: Use this facet_grid call instead of the one you're using right now.
facet_grid(sd ~ phi, scales = "free_y", labeller = . %>% label_both(sep = " = "))
Using bquote
facet_grid(sd ~ phi, scales = "free_y",
labeller =
label_bquote(rows = sigma == .(sd), cols = phi == .(phi))
)
This will yield the right labels.
Answer inspired from this post
I have this this ggplot with facet_grid function:
set.seed(1)
df <- data.frame(xx = 1:10, x1 = rnorm(10), x2 = rnorm(10), x3 = rnorm(10), x4 = rnorm(10), x5 = rnorm(10), x6 = rnorm(10), x7 = rnorm(10), x8 = rnorm(10), x9 = rnorm(10), x10 = rnorm(10), x11 = rnorm(10), x12 = rnorm(10))
library(dplyr)
library(tidyr)
library(ggplot2)
df %>%
pivot_longer(-xx) %>%
mutate(id = as.numeric(gsub("x", "", name))) %>%
arrange(id, xx) %>%
select(-id) %>%
mutate(sd = rep(rep(c(sd = 1, sd = 3, sd = 5, sd = 10), each = 10), each = 3),
phi = rep(rep(list(c(0.4, 0.4), c(0.45, 0.45), c(0.35, 0.6)), each = 10), 4)) %>%
mutate(sd = factor(sd, levels = sd, labels = paste("sd =", sd)),
phi = factor(phi, levels = phi, labels = gsub("c", "", paste("\U03D5 =", phi)))) %>%
ggplot(aes(x = xx, y = value)) +
geom_line() +
geom_point() +
scale_y_continuous(expand = c(0.0, 0.00)) +
labs(x = "Time", y = "Series") +
facet_grid(sd ~ phi, scales = "free_y") +
theme_bw()
provided as a satisfactory answer for this question.
What I want
I wantto increase(or customize) the labels sd = c(sd = 1, sd = 3, sd = 5, sd = 10) at the right side and the labels at the top phi = c(0.4, 0.4), c(0.45, 0.45), c(0.35, 0.6))of the plot. And also, how to make them bold.
Easiest way is with:
previous_code_blocks+
theme(strip.text.x = element_text(size = 10, face = "bold"),
strip.text.y = element_text(size = 10, face = "bold"))
You can customise with the usual element_text() args here, changing the font family and other such things, hjust, vjust etc.
If you're looking for more control of the labeller in the future, or for more advanced customisations, you can find documentation at: https://ggplot2.tidyverse.org/reference/labeller.html