Waffle chart with time on x axis - r

I would like to plot a waffle chart with time on the x-axis in R, similar to this one below. Can anyone help, please? Thanks.
The dataset is here:
df <- data.frame(spec = c("Rehab", "Cardiology", "Endocrine", "Respiratory", "General Surgery"),
start.month = c(11,11,7,3,1) )

Perhaps something like this?
library(ggplot2)
df2 <- do.call(rbind, lapply(seq(nrow(df)), function(i)
data.frame(month = factor(month.abb[12:df$start.month[i]], levels = month.abb),
spec = df$spec[i])))
df2$spec <- factor(df2$spec, levels = names(rev(sort(table(df2$spec)))))
ggplot(df2, aes(month, spec, colour = spec)) +
geom_point(size = 8, shape = 15) +
coord_cartesian(ylim = c(1, 9)) +
labs(y = "Cumulative no. of specialties",
x = "Months",
colour = "Specialties") +
scale_color_manual(values = c("#ffc000", "#ed7d31", "#5a9bd5",
"#70ad46", "#44546b")) +
theme_classic() +
theme(axis.text.y.left = element_blank(),
axis.ticks.length.y = unit(0, "points"),
legend.background = element_rect(colour = "black"),
axis.text = element_text(size = 16),
axis.title = element_text(size = 16))

Related

ggplot2: using square brackets and superscript in axis title

I have a plot where each axis has been log10 transformed. For one of my axis titles I would like to use both a square bracket ([]) and a superscript. How can I do this?
Example Data
library(dplyr)
library(ggplot2)
set.seed(123)
df <- data.frame(matrix(ncol = 2, nrow = 20))
colnames(df)[1:2] <- c('x','y')
df$x <- rnorm(20,1000,100)
df$y <- rnorm(20,1000,100)
df <- df %>%
mutate(log_x = log10(x),
log_y = log10(y))
Here is an example of the figure I am trying to make. I need to know how to make the -2 on the x-axis superscripted.
df %>%
ggplot(aes(x = log_x, y = log_y)) +
geom_point() +
labs(x = expression(log[10]~"[Area (m^-2)]"),
y = expression(log[10]~"[ Time Variable (months)]")) +
theme_bw() +
theme(axis.text.x = element_text(size = 16, color = "black"),
axis.text.y = element_text(size = 16, color = "black"),
axis.title = element_text(size = 16, color = "black"),
panel.grid = element_blank(),
panel.background = element_blank())
#MrFlick response provides the correct answer, see below.
df %>%
ggplot(aes(x = log_x, y = log_y)) +
geom_point() +
labs(x = expression(log[10]~"[Area"~ (m^-2) ~"]"),
y = expression(log[10]~"[ Time Variable (months)]")) +
theme_bw() +
theme(axis.text.x = element_text(size = 16, color = "black"),
axis.text.y = element_text(size = 16, color = "black"),
axis.title = element_text(size = 16, color = "black"),
panel.grid = element_blank(),
panel.background = element_blank())

R Hourly Heatmap with adjusted Dates

I'm new to r and tried the hourly heatmapt from the r grah gallery:
https://r-graph-gallery.com/283-the-hourly-heatmap.html
My question is, if it possible to adjust it that way, that the x axis ish shown with the correct amount of days in the month(example: Jan 1 … 31, Feb 1 … 28)
I tried to change scale_x_continuos with scale_x_date but it didnt worked as expected.
You can amend the code as folows, using a custom labelling function in scale_x_continuous:
ggplot(df, aes(day, hour, fill = temp)) +
geom_tile(color = "white",size = 0.1) +
scale_fill_viridis(name = "Hrly Temps C", option = "C") +
facet_grid(year~month, scales = 'free_x') +
scale_y_continuous(trans = "reverse", breaks = unique(df$hour)) +
scale_x_continuous(breaks = ~c(1, 10, 20, floor(max(.x, na.rm = TRUE)) -2)) +
theme_minimal(base_size = 8) +
labs(title= paste("Hourly Temps - Station", statno), x = "Day",
y = "Hour Commencing") +
theme(legend.position = "bottom",
plot.title = element_text(size = 14, hjust = 0),
axis.text.y = element_text(size = 6),
strip.background = element_rect(colour = "white"),
axis.ticks = element_blank(),
axis.text = element_text(size = 7),
legend.title = element_text(size = 8),
legend.text = element_text(size = 6)) +
removeGrid()

How to remove one facet category from facet_wrap after using tidyr to reshape data

I am trying to plot some data and see below the replicable example, starting from the relevant libraries
library(ggplot2)
library(tidyr)
library(scales)
library(dplyr)
and the creation of the random dataset see below:
data <- data.frame(replicate(3, sample(0:100, 100, rep=TRUE)))
data$Place <- sample(c("PlaceA", "PlaceB","PlaceC"), size = nrow(data), prob = c(0.76, 0.14, 0.10), replace = TRUE)
data$Preference <- sample(c("Strong", "Medium","Low"), size = nrow(data), replace = TRUE)
data$Risk <- sample(c("Yes","No"), size = nrow(data), replace = TRUE)
colnames(data) <- c("A","B","C","Place","Preference","Risk")
rownames(data) <- NULL
After this step I am trying to get the data along a different shape by using tidyr package
data_long <- tidyr::gather(data, key = type_col, value = categories, -c("A","B","C","Place","Preference"))
And then I wish to plot the proportions of respondents saying yes to risk by place- see below the code to achieve the visual output
data_long %>%
count(type_col, categories,Place) %>%
left_join(data_long %>% count(type_col, Place, name = "m"),by = c("type_col", "Place")) %>%
mutate(Prop = n/m) %>%
ggplot(aes(x = categories, y = Prop, fill = Place)) +
geom_col(position = position_dodge()) +
geom_text(aes(label = scales::percent(Prop)),
hjust = 0.1,
position = position_dodge(1)) +
facet_wrap(~ type_col, scales = "free_x", ncol = 3) +
scale_fill_brewer(palette = "Oranges") + #scale_x_discrete(limits = positions)+
scale_y_continuous(limits = c(0, 1), labels = scales::percent) +
xlab("") +
ylab("") +
coord_flip() +
theme(panel.background = element_rect(fill = "white"),
legend.position = "bottom",
strip.text.x = element_text(size = 15, colour = "black"),
plot.title = element_text(size = 20, face = "bold"),
axis.text = element_text(size = 12),
axis.title = element_text(size = 12))
See below the output which is correct. Yet, I do not want to show the yes and nos, but just the yes proportions. Is there an easy way to just plot the output below while retaining just one option of the facets (Yes in this case)? Thanks for the help
Maybe this:
library(tidyverse)
#Code
data_long %>%
count(type_col, categories,Place) %>%
left_join(data_long %>% count(type_col, Place, name = "m"),by = c("type_col", "Place")) %>%
mutate(Prop = n/m) %>%
filter(categories=='Yes') %>%
mutate(Place=factor(Place,levels = rev(unique(Place)),ordered = T)) %>%
ggplot(aes(x = categories, y = Prop, fill = Place)) +
geom_col(position = position_dodge()) +
geom_text(aes(label = scales::percent(Prop)),
hjust = 0.1,
position = position_dodge(1)) +
facet_wrap(~ type_col, scales = "free_x", ncol = 3) +
scale_fill_brewer(palette = "Oranges",guide = guide_legend(reverse = TRUE)) + #scale_x_discrete(limits = positions)+
scale_y_continuous(limits = c(0, 1), labels = scales::percent) +
xlab("") +
ylab("") +
coord_flip() +
theme(panel.background = element_rect(fill = "white"),
legend.position = "bottom",
strip.text.x = element_text(size = 15, colour = "black"),
plot.title = element_text(size = 20, face = "bold"),
axis.text = element_text(size = 12),
axis.title = element_text(size = 12))
Output:

Dynamic midpoint in ggplot2's scale_fill_gradient2

I'm making a heatmap in R using ggplot2 and I want to dynamically change the value of midpoint for scale_fill_gradient2. I want the midpoint for every row to be the maximum of v1 and v2.
Here's the original plot and data:
library(ggplot2)
set.seed(1L)
s = sprintf("d%s", 1:9)
vars = sprintf("v%s", 1:6)
data = data.frame(s = rep(s, 6), stringsAsFactors = FALSE)
data$variable = rep(vars, rep.int(9, 6))
data$variable = as.factor(data$variable)
data$value = round(runif(54, min=-100, max=100), 1)
pdf(save)
heatmap = ggplot(data = data, aes(x = variable, y = s, fill = value)) +
geom_tile(color = "black", aes(width = 1)) +
scale_fill_gradient2(low = cbbPalette$pink, high = cbbPalette$green, mid = cbbPalette$grey,
midpoint = 0, space = "Lab",
name = title) +
scale_color_discrete("exps", data$variable) +
theme_minimal() +
theme(axis.text.x = element_text(vjust = 1,
size = title.size), legend.title = element_blank(),
axis.text.y = element_text(size = title.size),
strip.text.x = element_text(size = title.size)) +
coord_fixed()
#add numbers to cells
heatmap = heatmap + geom_text(aes(x = variable, y = s, label = value), color = cbbPalette$black, size = 3) +
theme(
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.grid.major = element_blank(),
panel.border = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
legend.justification = c(0.5, 0),
legend.direction = "horizontal",
legend.position = "top") +
guides(fill = guide_colorbar(barwidth = 7, barheight = 1,
title.position = "top", title.hjust = 0.5))
# Print the heatmap
print(heatmap)
dev.off()
I tried to change midpoint by taking max of v1 and v2 but that affects all rows instead each row separately.
scale_fill_gradient2(low = cbbPalette$pink, high = cbbPalette$green, mid = cbbPalette$grey,
midpoint = data[data$variable == "v1", "value"], space = "Lab",
name = title)
Scales don't really work that way, as they map a range of values to a set of colours. Consequentially, a particular colour means a particular value for the whole plot. My best advice would be to pre-normalise the data by subtracting the max of v1/v2. See example in code below (there were a few variables in your example but not in the shared code which I've subsituted).
library(ggplot2)
library(tidyverse)
set.seed(1L)
s = sprintf("d%s", 1:9)
vars = sprintf("v%s", 1:6)
data = data.frame(s = rep(s, 6), stringsAsFactors = FALSE)
data$variable = rep(vars, rep.int(9, 6))
data$variable = as.factor(data$variable)
data$value = round(runif(54, min=-100, max=100), 1)
new_data <- data %>% group_by(s) %>%
mutate(value = value - max(value[variable %in% c("v1", "v2")]))
ggplot(data = new_data, aes(x = variable, y = s, fill = value)) +
geom_tile(color = "black", aes(width = 1)) +
scale_fill_gradient2(low = "pink", high = "green", mid = "grey",
midpoint = 0, space = "Lab",
name = "title") +
scale_color_discrete("exps", data$variable) +
theme_minimal() +
coord_fixed()

Partial italics in facet headings of ggplot

I am wondering if there is any way to rename facet titles so that they contain partial italics and partial non-italics.
Here is some toy data
library(Hmisc)
library(dplyr)
# Plot power vs. n for various odds ratios
n <- seq(10, 1000, by=10) # candidate sample sizes
OR <- as.numeric(sort(c(seq(1/0.90,1/0.13,length.out = 9),2.9))) # candidate ORs
alpha <- c(.001, .01, .05) # alpha significance levels
# put all of these into a dataset and calculate power
powerDF <- data.frame(expand.grid(OR, n, alpha)) %>%
rename(OR = Var1, num = Var2, alph = Var3) %>%
arrange(OR) %>%
mutate(power = as.numeric(bpower(p1=.29, odds.ratio=OR, n=num, alpha = alph))) %>%
transform(OR = factor(format(round(OR,2),nsmall=2)),
alph = factor(ifelse(alph == 0.001, "p=0.001",
ifelse(alph == 0.01, "p=0.01", "p=0.05"))))
pPower <- ggplot(powerDF, aes(x = num, y = power, colour = factor(OR))) +
geom_line() +
facet_grid(factor(alph)~.) +
labs(x = "sample size") +
scale_colour_discrete(name = "Odds Ratio") +
scale_x_continuous(breaks = seq(0,1000,100)) +
scale_y_continuous(breaks = seq(0,1,.1), sec.axis = sec_axis(trans=I, breaks=NULL, name="Significance Level")) + # this is the second axis label
theme_light() +
theme(axis.title.x = element_text(size = 12, face = "bold"),
axis.title.y = element_text(size = 12, face = "bold"),
axis.text = element_text(size = 11),
panel.grid.minor = element_blank(),
panel.grid.major.y = element_line(colour = "gray95"),
panel.grid.major.x = element_line(colour = "gray95"),
strip.text = element_text(colour = 'black', face = 'bold', size = 12),
legend.text = element_text(size = 12),
legend.title = element_text(size = 12, face = "bold"))
pPower
Is there any way to get the facet headings to read "p=0.001", "p=0.01" etc, instead of "p=0.001", i.e. to get partial italics and partial non-italics?

Resources