I am trying to use facet_wrap to plot indvidual plots.
library(lme4)
library(dplyr)
library(tibble)
# Convert to tibble for better printing. Convert factors to strings
sleepstudy <- sleepstudy %>%
as_tibble() %>%
mutate(Subject = as.character(Subject))
xlab <- "Days of sleep deprivation"
ylab <- "Average reaction time (ms)"
ggplot(df_sleep) +
aes(x = Days, y = Reaction) +
stat_smooth(method = "lm", se = FALSE) +
# Put the points on top of lines
geom_point() +
facet_wrap("Subject") +
labs(x = xlab, y = ylab) +
theme(axis.text=element_text(size=0.02),
axis.title=element_text(size=0.02,face="bold"),
plot.title = element_text(size=0.02)) +
theme(strip.text.x = element_text(size = 8),
strip.background = element_rect(fill="lightblue", colour="black",size=0.2)) +
theme(strip.text.x = element_text(margin = margin(0.02, 0, 0.02, 0, "cm")))
What I want to do is to only visualise selected Subject using facet_wrap? At the moment,
it is plotting plots of all the Subject. How do I plot only for say subject 308`` and352`?
Thanks
You just want to filter your data before plotting
library(lme4)
library(dplyr)
library(tibble)
library(ggplot2)
# Convert to tibble for better printing. Convert factors to strings
sleepstudy <- sleepstudy %>%
as_tibble() %>%
mutate(Subject = as.character(Subject))
xlab <- "Days of sleep deprivation"
ylab <- "Average reaction time (ms)"
sleepstudy %>%
filter(Subject %in% c("308", "352")) %>%
ggplot(.) +
aes(x = Days, y = Reaction) +
stat_smooth(method = "lm", se = FALSE) +
# Put the points on top of lines
geom_point() +
facet_wrap("Subject") +
labs(x = xlab, y = ylab) +
theme(axis.text=element_text(size=0.02),
axis.title=element_text(size=0.02,face="bold"),
plot.title = element_text(size=0.02)) +
theme(strip.text.x = element_text(size = 8),
strip.background = element_rect(fill="lightblue", colour="black",size=0.2)) +
theme(strip.text.x = element_text(margin = margin(0.02, 0, 0.02, 0, "cm")))
Related
I want to combine multiple ggplots into one plot with same x and y axis. This is my data. I have one Time column and 6 trend columns (A_Trnd, B_Trnd, C_Trnd etc). I have generated plot for Time vs A_Trnd.
library(ggplot2)
library(scales)
result <- read.csv("Downloads/Questions Trend - Questions Trend.csv")
result$Time_Formatted <- as.Date(result$Time_Formatted)
date_breaks <- as.Date(c("9/1/08", "5/12/14", "7/1/17", "2/2/19", "6/3/20"), "%m/%d/%y")
p1 <- ggplot(result, aes(result$Time_Formatted, result$A_Trnd)) +
geom_point(size = 0.1) + xlab("Month") + ylab("Temporal Trend") +
scale_x_date(breaks = date_breaks , date_labels = "%Y-%m", limits = c(as.Date("2008-08-01"), as.Date("2021-08-01"))) +
theme(axis.text.x = element_text(angle = 70, vjust = 0.9, hjust = 1))
p1 + geom_smooth(method = "loess", color = "red")
Now, I want to plot the same for Time vs B_Trnd, Time vs C_Trnd and have a combine plot like below.
How can I achieve this?
library(tidyverse)
library(scales)
result <-read.csv("Downloads/Questions Trend - Questions Trend.csv") %>%
mutate(Time = as.Date(Time, format = "%m/%d/%y")) %>%
pivot_longer(cols = -Time, names_to = "group", values_to = "value")
date_breaks <- as.Date(c("9/1/08", "5/12/14", "7/1/17", "2/2/19", "6/3/20"), "%m/%d/%y")
p1 <- ggplot(result, aes(Time, value)) +
geom_point(size = 0.1) +
labs(x = "Month", y = "Temporal Trend") +
scale_x_date(breaks = date_breaks , date_labels = "%Y-%m", limits = c(as.Date("2008-08-01"), as.Date("2021-08-01"))) +
theme(axis.text.x = element_text(angle = 70, vjust = 0.9, hjust = 1),
legend.position = "none") +
geom_smooth(method = "loess", aes(color = group)) +
facet_wrap(vars(group), nrow = 1)
p1
Is there a way to flip the facet label using small_multiple from the dotwhisker package to have the facet labels on the left-handside and coefficient estimate on the right-hand side? I've seen the solutions to this when using ggplot and facet_wrap or facet_grid, but those aren't working with small_multiple since it does the faceting without those arguments. For simplicity, I'll be using the Dot-and-Whisker Plot Vignette that uses small_multiple as the example.
code used to generate plot:
# Generate a tidy data frame of regression results from six models
m <- list()
ordered_vars <- c("wt", "cyl", "disp", "hp", "gear", "am")
m[[1]] <- lm(mpg ~ wt, data = mtcars)
m123456_df <- m[[1]] %>%
tidy() %>%
by_2sd(mtcars) %>%
mutate(model = "Model 1")
for (i in 2:6) {
m[[i]] <- update(m[[i-1]], paste(". ~ . +", ordered_vars[i]))
m123456_df <- rbind(m123456_df, m[[i]] %>%
tidy() %>%
by_2sd(mtcars) %>%
mutate(model = paste("Model", i)))
}
# Relabel predictors (they will appear as facet labels)
m123456_df <- m123456_df %>%
relabel_predictors(c("(Intercept)" = "Intercept",
wt = "Weight",
cyl = "Cylinders",
disp = "Displacement",
hp = "Horsepower",
gear = "Gears",
am = "Manual"))
# Generate a 'small multiple' plot
small_multiple(m123456_df) +
theme_bw() + ylab("Coefficient Estimate") +
geom_hline(yintercept = 0, colour = "grey60", linetype = 2) +
ggtitle("Predicting Mileage") +
theme(plot.title = element_text(face = "bold"),
legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1))
Ideally, I would have the flipped version of this plot with labels on the left and estimates on the right.
This could be achieved by overwriting facet_grid and the scale_y as you would do in a normal ggplot like so:
facet_grid(term~., switch = "y", scales="free_y")
scale_y_continuous(position = "right")
library(dotwhisker)
library(dplyr)
library(broom)
# Generate a 'small multiple' plot
small_multiple(m123456_df) +
theme_bw() + ylab("Coefficient Estimate") +
geom_hline(yintercept = 0, colour = "grey60", linetype = 2) +
facet_grid(term~., switch = "y", scales="free_y") +
scale_y_continuous(position = "right") +
ggtitle("Predicting Mileage") +
theme(plot.title = element_text(face = "bold"),
legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1))
For some reason I am getting two legends in my dot-whisker plot.
Plot produced by the below code:
The data are available here.
#first importing data
Q2a<-read.table("~/Q2a.txt", header=T)
# Optionally, read in data directly from figshare.
# Q2a <- read.table("https://ndownloader.figshare.com/files/13283882?private_link=ace5b44bc12394a7c46d", header=TRUE)
library(dplyr)
#splitting into female and male
F2female<-Q2a %>%
filter(sex=="F")
F2male<-Q2a %>%
filter(sex=="M")
library(lme4)
#Female models
ab_f2_f_LBS = lmer(LBS ~ ft + grid + (1|byear), data = subset(F2female))
ab_f2_f_surv = glmer.nb(age ~ ft + grid + (1|byear), data = subset(F2female), control=glmerControl(tol=1e-6,optimizer="bobyqa",optCtrl=list(maxfun=1e19)))
#Male models
ab_f2_m_LBS = lmer(LBS ~ ft + grid + (1|byear), data = subset(F2male))
ab_f2_m_surv = glmer.nb(age ~ ft + grid + (1|byear), data = subset(F2male), control=glmerControl(tol=1e-6,optimizer="bobyqa",optCtrl=list(maxfun=1e19)))
I only plot two of the variables (ft2 and gridSU) from each model.
ab_f2_f_LBS <- tidy(ab_f2_f_LBS) %>% filter(!grepl('sd_Observation.Residual', term)) %>% filter(!grepl('byear', group)) %>% mutate(model = "ab_f2_f_LBS")
ab_f2_m_LBS <- tidy(ab_f2_m_LBS) %>% filter(!grepl('sd_Observation.Residual', term)) %>% filter(!grepl('byear', group)) %>% mutate(model = "ab_f2_m_LBS")
ab_f2_f_surv <- tidy(ab_f2_f_surv)%>% filter(!grepl('sd_Observation.Residual', term)) %>% filter(!grepl('byear', group)) %>% mutate(model = "ab_f2_f_surv")
ab_f2_m_surv <- tidy(ab_f2_m_surv) %>% filter(!grepl('sd_Observation.Residual', term)) %>% filter(!grepl('byear', group)) %>% mutate(model = "ab_f2_m_surv")
tidy_mods <- bind_rows(ab_f2_f_LBS, ab_f2_m_LBS, ab_f2_f_surv, ab_f2_m_surv)
I am then ready to make a dot-whisker plot.
#required packages
library(dotwhisker)
library(broom)
dwplot(tidy_mods,
vline = geom_vline(xintercept = 0, colour = "black", linetype = 2),
conf.int=TRUE,
dodge_size=0.2, #space between the CI's
dot_args = list(aes(shape = model), size = 3), #changes shape of points and the size of the points
style="dotwhisker") %>% # plot line at zero _behind_ coefs
relabel_predictors(c(DamDisFate2= "Immigrant mothers",
gridSU = "Grid (SU)")) +
theme_classic() +
xlab("Coefficient estimate (+/- CI)") +
ylab("") +
scale_color_manual(values=c("#000000", "#666666", "#999999", "#CCCCCC"),
labels = c("Daughter LBS", "Son LBS", "Daughter longevity", "Son longevity"),
name = "First generation models, maternity known") +
theme(axis.title=element_text(size=15),
axis.text.x = element_text(size=15),
axis.text.y = element_text(size=15, angle=90, hjust=.5),
legend.position = c(0.7, 0.7),
legend.justification = c(0, 0),
legend.title=element_text(size=15),
legend.text=element_text(size=13),
legend.key = element_rect(size = 0),
legend.key.size = unit(0.5, "cm"))+
guides(colour = guide_legend(override.aes=list(shape=c(16,17,15,3)))) #changes shape of points in legend
I am encountering this problem:
As is obvious from the plot, I have two legends. One that is unmodified and one that is modified.
I can't find any short cut within the theme() function and the dwplot() package doesn't offer any solutions either.
How can I suppress the unmodified legend (bottom one) and only keep my modified legend (top one)?
Assuming this function uses ggplot, try adding shape="none" to your guides():
guides(colour = guide_legend(override.aes=list(shape=c(16,17,15,3))), shape="none")
I have a matrix with many zero elements. The column names are labeled on the horizontal axis. I'd like to show explictly the nonzero elements as the bias from the vertical line for each column.
So how should construct a figure such as the example using ggplot2?
An example data can be generated as follow:
set.seed(2018)
N <- 5
p <- 40
dat <- matrix(0.0, nrow=p, ncol=N)
dat[2:7, 1] <- 4*rnorm(6)
dat[4:12, 2] <- 2.6*rnorm(9)
dat[25:33, 3] <- 2.1*rnorm(9)
dat[19:26, 4] <- 3.3*rnorm(8)
dat[33:38, 5] <- 2.9*rnorm(6)
colnames(dat) <- letters[1:5]
print(dat)
Here is another option using facet_wrap and geom_col with theme_minimal.
library(tidyverse)
dat %>%
as.data.frame() %>%
rowid_to_column("row") %>%
gather(key, value, -row) %>%
ggplot(aes(x = row, y = value, fill = key)) +
geom_col() +
facet_wrap(~ key, ncol = ncol(dat)) +
coord_flip() +
theme_minimal()
To further increase the aesthetic similarity to the plot in your original post we can
move the facet strips to the bottom,
rotate strip labels,
add "zero lines" in matching colours,
remove the fill legend, and
get rid of the x & y axis ticks/labels/title.
library(tidyverse)
dat %>%
as.data.frame() %>%
rowid_to_column("row") %>%
gather(key, value, -row) %>%
ggplot(aes(x = row, y = value, fill = key)) +
geom_col() +
geom_hline(data = dat %>%
as.data.frame() %>%
gather(key, value) %>%
count(key) %>%
mutate(y = 0),
aes(yintercept = y, colour = key), show.legend = F) +
facet_wrap(~ key, ncol = ncol(dat), strip.position = "bottom") +
coord_flip() +
guides(fill = FALSE) +
theme_minimal() +
theme(
strip.text.x = element_text(angle = 45),
axis.title = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank())
It would be much easier if you can provide some sample data. Thus I needed to create them and there is no guarantee that this will work for your purpose.
set.seed(123)
# creating some random sample data
df <- data.frame(id = rep(1:100, each = 3),
x = rnorm(300),
group = rep(letters[1:3], each = 100),
bias = sample(0:1, 300, replace = T, prob = c(0.7, 0.3)))
# introducing bias
df$bias <- df$bias*rnorm(nrow(df))
# calculate lower/upper bias for errorbar
df$biaslow <- apply(data.frame(df$bias), 1, function(x){min(0, x)})
df$biasupp <- apply(data.frame(df$bias), 1, function(x){max(0, x)})
Then I used kind of hack to be able to print groups in sufficient distance to make them not overlapped. Based on group I shifted bias variable and also lower and upper bias.
# I want to print groups in sufficient distance
df$bias <- as.numeric(df$group)*5 + df$bias
df$biaslow <- as.numeric(df$group)*5 + df$biaslow
df$biasupp <- as.numeric(df$group)*5 + df$biasupp
And now it is possible to plot it:
library(ggplot2)
ggplot(df, aes(x = x, col = group)) +
geom_errorbar(aes(ymin = biaslow, ymax = biasupp), width = 0) +
coord_flip() +
geom_hline(aes(yintercept = 5, col = "a")) +
geom_hline(aes(yintercept = 10, col = "b")) +
geom_hline(aes(yintercept = 15, col = "c")) +
theme(legend.position = "none") +
scale_y_continuous(breaks = c(5, 10, 15), labels = letters[1:3])
EDIT:
To incorporate special design you can add
theme_bw() +
theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.y = element_blank(),
axis.text.x = element_text(angle = 45, vjust = 0.5, hjust = 1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
to your plot.
EDIT2:
To incorporate several horizontal lines, you can create different dataset:
df2 <- data.frame(int = unique(as.numeric(df$group)*5),
gr = levels(df$group))
And use
geom_hline(data = df2, aes(yintercept = int, col = gr))
instead of copy/pasting geom_hline for each group level.
I need a flexible way to make radar / spider charts in ggplot2. From solutions I've found on github and the ggplot2 group, I've come this far:
library(ggplot2)
# Define a new coordinate system
coord_radar <- function(...) {
structure(coord_polar(...), class = c("radar", "polar", "coord"))
}
is.linear.radar <- function(coord) TRUE
# rescale all variables to lie between 0 and 1
scaled <- as.data.frame(lapply(mtcars, ggplot2:::rescale01))
scaled$model <- rownames(mtcars) # add model names as a variable
as.data.frame(melt(scaled,id.vars="model")) -> mtcarsm
ggplot(mtcarsm, aes(x = variable, y = value)) +
geom_path(aes(group = model)) +
coord_radar() + facet_wrap(~ model,ncol=4) +
theme(strip.text.x = element_text(size = rel(0.8)),
axis.text.x = element_text(size = rel(0.8)))
which works, except for the fact that lines are not closed.
I thougth that I would be able to do this:
mtcarsm <- rbind(mtcarsm,subset(mtcarsm,variable == names(scaled)[1]))
ggplot(mtcarsm, aes(x = variable, y = value)) +
geom_path(aes(group = model)) +
coord_radar() + facet_wrap(~ model,ncol=4) +
theme(strip.text.x = element_text(size = rel(0.8)),
axis.text.x = element_text(size = rel(0.8)))
in order to join the lines, but this does not work. Neither does this:
closes <- subset(mtcarsm,variable == names(scaled)[c(1,11)])
ggplot(mtcarsm, aes(x = variable, y = value)) +
geom_path(aes(group = model)) +
coord_radar() + facet_wrap(~ model,ncol=4) +
theme(strip.text.x = element_text(size = rel(0.8)),
axis.text.x = element_text(size = rel(0.8))) + geom_path(data=closes)
which does not solve the problem, and also produces lots of
"geom_path: Each group consist of only one observation. Do you need to
adjust the group aesthetic?"
messages. Som, how do I go about closing the lines?
/Fredrik
Using the new ggproto mechanism available in ggplot2 2.0.0, coord_radar can be defined as:
coord_radar <- function (theta = "x", start = 0, direction = 1)
{
theta <- match.arg(theta, c("x", "y"))
r <- if (theta == "x")
"y"
else "x"
ggproto("CoordRadar", CoordPolar, theta = theta, r = r, start = start,
direction = sign(direction),
is_linear = function(coord) TRUE)
}
Not sure if the syntax is perfect but it is working...
The codes here seem outdated for ggplot2: 2.0.0
Try my package zmisc: devtools:install_github("jerryzhujian9/ezmisc")
After you install it, you will be able to run:
df = mtcars
df$model = rownames(mtcars)
ez.radarmap(df, "model", stats="mean", lwd=1, angle=0, fontsize=0.6, facet=T, facetfontsize=1, color=id, linetype=NULL)
ez.radarmap(df, "model", stats="none", lwd=1, angle=0, fontsize=1.5, facet=F, facetfontsize=1, color=id, linetype=NULL)
if you are curious about what's inside, see my codes at github:
The main codes were adapted from http://www.cmap.polytechnique.fr/~lepennec/R/Radar/RadarAndParallelPlots.html
solution key factor
add duplicated mpg row after melt by rbind
inherit CoordPolar on ggproto
set is_linear = function() TRUE on ggproto
especially is_linear = function() TRUE is important,
since if not you will get plot like this...
with is_linear = function() TRUE settings you can get,
library(dplyr)
library(data.table)
library(ggplot2)
rm(list=ls())
scale_zero_to_one <-
function(x) {
r <- range(x, na.rm = TRUE)
min <- r[1]
max <- r[2]
(x - min) / (max - min)
}
scaled.data <-
mtcars %>%
lapply(scale_zero_to_one) %>%
as.data.frame %>%
mutate(car.name=rownames(mtcars))
plot.data <-
scaled.data %>%
melt(id.vars='car.name') %>%
rbind(subset(., variable == names(scaled.data)[1]))
# create new coord : inherit coord_polar
coord_radar <-
function(theta='x', start=0, direction=1){
# input parameter sanity check
match.arg(theta, c('x','y'))
ggproto(
NULL, CoordPolar,
theta=theta, r=ifelse(theta=='x','y','x'),
start=start, direction=sign(direction),
is_linear=function() TRUE)
}
plot.data %>%
ggplot(aes(x=variable, y=value, group=car.name, colour=car.name)) +
geom_path() +
geom_point(size=rel(0.9)) +
coord_radar() +
facet_wrap(~ car.name, nrow=4) +
theme_bw() +
theme(
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_blank(),
legend.position = 'none') +
labs(title = "Cars' Status")
final result
Sorry, I was beeing stupid. This seems to work:
library(ggplot2)
# Define a new coordinate system
coord_radar <- function(...) {
structure(coord_polar(...), class = c("radar", "polar", "coord"))
}
is.linear.radar <- function(coord) TRUE
# rescale all variables to lie between 0 and 1
scaled <- as.data.frame(lapply(mtcars, ggplot2:::rescale01))
scaled$model <- rownames(mtcars) # add model names as a variable
as.data.frame(melt(scaled,id.vars="model")) -> mtcarsm
mtcarsm <- rbind(mtcarsm,subset(mtcarsm,variable == names(scaled)[1]))
ggplot(mtcarsm, aes(x = variable, y = value)) +
geom_path(aes(group = model)) +
coord_radar() + facet_wrap(~ model,ncol=4) +
theme(strip.text.x = element_text(size = rel(0.8)),
axis.text.x = element_text(size = rel(0.8)))
It turns out than geom_polygom still produces a polygon in the polar coordinates so that
# rescale all variables to lie between 0 and 1
scaled <- as.data.frame(lapply(mtcars, ggplot2:::rescale01))
scaled$model <- rownames(mtcars) # add model names as a variable
# melt the dataframe
mtcarsm <- reshape2::melt(scaled)
# plot it as using the polygon geometry in the polar coordinates
ggplot(mtcarsm, aes(x = variable, y = value)) +
geom_polygon(aes(group = model), color = "black", fill = NA, size = 1) +
coord_polar() + facet_wrap( ~ model) +
theme(strip.text.x = element_text(size = rel(0.8)),
axis.text.x = element_text(size = rel(0.8)),
axis.ticks.y = element_blank(),
axis.text.y = element_blank()) +
xlab("") + ylab("")
works perfectly...
Thank you guys for the help but it did not cover all of my needs. I used two series of data to be compared so I took the subset of mtcars for Mazda:
nobody mentioned about order of the x variable and ggplot2 sorts this variable for the plot but does not sort the data and it made my chart wrong at the first attempt. Apply sorting function for me it was dplyr::arrange(plot.data, x.variable.name)
I needed to annotate the chart with values and ggplot2::annotate() works fine but it was not included in the recent answers
the above code did not work fine for my data until adding ggplot2::geom_line
Finally this code chunk did my chart:
scaled <- as.data.frame(lapply(mtcars, ggplot2:::rescale01))
scaled$model <- rownames(mtcars)
mtcarsm <- scaled %>%
filter(grepl('Mazda', model)) %>%
gather(variable, value, mpg:carb) %>%
arrange(variable)
ggplot(mtcarsm, aes(x = variable, y = value)) +
geom_polygon(aes(group = model, color = model), fill = NA, size = 1) +
geom_line(aes(group = model, color = model), size = 1) +
annotate("text", x = mtcarsm$variable, y = (mtcarsm$value + 0.05), label = round(mtcarsm$value, 2), size = 3) +
theme(strip.text.x = element_text(size = rel(0.8)),
axis.text.x = element_text(size = rel(1.2)),
axis.ticks.y = element_blank(),
axis.text.y = element_blank()) +
xlab("") + ylab("") +
guides(color = guide_legend()) +
coord_radar()
Hopefully usefull for somebody