R ggplot facet_wrap y ticks on different sides - r

For some reason, I have to make a plot that looks more or less like this:
For this I use the following code:
library(ggplot2)
library(tidyverse)
set.seed(10)
df<-data.frame(Meas = runif(1000,0,10),
Prop1 = sample(x = LETTERS[1:3],1000,replace=TRUE),
Prop2 = sample(x = letters[1:5],1000,replace=TRUE),
Prop3 = sample(x=c("monkey","donkey","flipper"),1000,replace=TRUE))%>%
gather(Prop,Propvalue,-Meas)
ggplot(df,aes(x = Propvalue,y=Meas))+
geom_boxplot()+
facet_wrap(~Prop,ncol=2,scales="free_y")+
coord_flip()
I believe this would look better if the y-ticks on the right graph would appear on the right (for the graphs on the left, the y-ticks should remain where they are, but flipper and donkey should appear on the right side to avoid the gap between the left and right panels), but I can't find a way to do this.

Here's a hack that utilises ggplot's sec.axis argument, which creates a secondary axis opposite the primary axis & has to be a one-to-one mapping of it. I call this a hack, because this works only for continuous axis, so we need to map the categorical Propvalue to numeric values.
Note: I assumed in this example that you want all odd numbered PropX facets' labels on the left, & even numbered PropX facets' labels on the right. You can also tweak the options for other variations.
library(ggplot2)
library(tidyverse)
# generate data
set.seed(10)
df<-data.frame(Meas = runif(1000,0,10),
Prop1 = sample(x = LETTERS[1:3],1000,replace=TRUE),
Prop2 = sample(x=c("monkey","donkey","flipper"),1000,replace=TRUE),
Prop3 = sample(x = letters[1:5],1000,replace=TRUE))%>%
gather(Prop,Propvalue,-Meas)
# map Propvalue to integers, primary axis contents, & secondary axis contents.
df2 <- df %>%
mutate(Propvalue.int = as.integer(factor(Propvalue,
levels = df %>% select(Prop, Propvalue) %>%
arrange(Prop, Propvalue) %>% unique() %>%
select(Propvalue) %>% unlist())),
facet.column = ifelse(as.integer(str_extract(Prop, "[0-9]")) %% 2 == 0, 2, 1),
Propvalue.left = ifelse(facet.column == 1, Propvalue, ""),
Propvalue.right = ifelse(facet.column == 2, Propvalue, ""))
# create mapping table
integer2factor <- df2 %>%
select(Propvalue.int, Propvalue.left, Propvalue.right) %>%
unique() %>% arrange(Propvalue.int)
ggplot(df2,aes(x = Propvalue.int, y=Meas,
group = Propvalue.int))+
geom_boxplot() +
scale_x_continuous(breaks = integer2factor$Propvalue.int,
labels = integer2factor$Propvalue.left,
name = "Propvalue",
sec.axis = dup_axis(breaks = integer2factor$Propvalue.int,
labels = integer2factor$Propvalue.right,
name = "")) +
facet_wrap(~Prop,ncol=2,scales="free")+
coord_flip() +
theme(axis.ticks.y = element_blank())

I believe this will do the trick.
library(ggplot2)
library(tidyverse)
library(tidyr)
set.seed(10)
df <-data.frame(Meas = runif(1000,0,10),
Prop1 = sample(x = LETTERS[1:3],1000,replace=TRUE),
Prop2 = sample(x = letters[1:5],1000,replace=TRUE),
Prop3 = sample(x=c("monkey","donkey","flipper"),1000,replace=TRUE))%>%
gather(Prop,Propvalue,-Meas)
ggplot(df,aes(x = Propvalue,y=Meas))+
geom_boxplot()+
facet_wrap(~Prop,ncol=2,scales="free_y")+
coord_flip()
p.list = lapply(sort(unique(df$Prop)), function(i) { # i <- "Prop1"
ggplot(df[df$Prop==i,],aes(x = Propvalue, y=Meas))+
geom_boxplot()+
facet_wrap(~Prop,scales="free_y")+
coord_flip()
})
p.list[[2]] <- p.list[[2]] + scale_x_discrete(position = "top")
library(gridExtra)
do.call(grid.arrange, c(p.list, nrow=2))

Related

ggplotly stacked bar chart not resizing after filtering

For some reason when producing a plotly graph with the ggplotly function, the filtering does not seem to resize the y-axis. The filtered portion are simply removed, while yaxis stays at it's original length. Please see this example:
library(plotly)
library(ggplot2)
library(dplyr)
lab <- paste("Vertical Label", c(1, 2, 3, 4, 5))
ds <- data.frame(x = sample(lab, size = 1000, replace = T),
y = sample(LETTERS[1:5], size = 1000, replace = T)) %>%
group_by(x,y) %>% summarise(count= n())
ggplotly(
ggplot(ds, aes(x = x,y=count, fill = y)) +
geom_col() +
theme(axis.text.x = element_text(angle = 90))
)
Same approach with plot_ly function works. However, I needed similar results with ggploty
plot_ly(ds, x = ~x, y = ~count, type = 'bar', color = ~y
) %>% layout(title = "Vertical Axis Lables",
xaxis = list(title = ""),
yaxis = list(title = ""), barmode = 'stack')
I couldn't find anything helpful in stack overflow or google. Just came across an incomplete answer here:
https://community.rstudio.com/t/ggplotly-bar-chart-not-resizing-after-filtering/115675/3
Any help will be greatly appreciated.
Applying a tip from R Plotly Legend Filtering enables re-stacking and similar ordering, while enabling auto-scaling provides y-axis adaptation:
library(plotly)
library(ggplot2)
library(dplyr)
lab <- paste("Vertical Label", c(1, 2, 3, 4, 5))
ds <- data.frame(x = sample(lab, size = 1000, replace = T),
y = sample(LETTERS[1:5], size = 1000, replace = T)) %>%
group_by(x,y) %>% summarise(count= n())
p <- ggplotly(
ggplot(ds, aes(x = x,y=count, fill = y)) +
geom_col() +
theme(axis.text.x = element_text(angle = 90))
)
for (i in 1:length(p$x$data)) {
p$x$data[[i]]$base <- c()
tmp <- p$x$data[[i]]
p$x$data[[i]] <- p$x$data[[length(p$x$data) - i + 1]]
p$x$data[[length(p$x$data) - i + 1]] <- tmp
}
p
It is only necessary to reset the base of the plotly variable for each of the x-axis elements that will be plotted.
for (i in 1:length(p$x$data)) {
p$x$data[[i]]$base <- c()
}
In the above example, if you reset the order, (1) D does not resize and (2) purple overlays A (A is never seen unless purple is filtered).

How to label lines obtained using split with ggrepel

I am trying to label 4 lines grouped by the value of variable cc. To label the lines I use ggrepel but I get all the 4 labels instead of 2 for each graph. How to correct this error?
The location of the labels is in this example at the last date but I want something more flexible: I want to locate each of the 4 labels in specific points that I chose (e.g. b at date 1, a at date 2, etc.). How to do that?
library(tidyverse)
library(ggrepel)
library(cowplot)
set.seed(1234)
df <- tibble(date = c(rep(1,4), rep(2,4), rep(3,4), rep(4,4)),
country = rep(c('a','b','c','d'),4),
value = runif(16),
cc = rep(c(1,1,2,2),4))
df$cc <- as.factor(df$cc)
# make list of plots
ggList <- lapply(split(df, df$cc), function(i) {
ggplot(i, aes(x = date, y = value, color = country)) +
geom_line(lwd = 1.1) +
geom_text_repel(data = subset(df, date == 4),
aes(label = country)) +
theme(legend.position = "none")
})
# plot as grid in 1 columns
cowplot::plot_grid(plotlist = ggList, ncol = 1,
align = 'v', labels = levels(df$cc))
Created on 2021-08-18 by the reprex package (v2.0.0)
Here I make a tibble to hold color and position preferences, and join that to df.
The geom_text_repel line should probably use i instead of df so that it's split the same way as the line. The only trouble is this forces us to specify that we want four colors up front, since otherwise each chart would just use the two it needs.
set.seed(1234)
df <- tibble(date = c(rep(1,4), rep(2,4), rep(3,4), rep(4,4)),
country = rep(c('a','b','c','d'),4),
value = runif(16),
cc = rep(c(1,1,2,2),4))
label_pos <- tibble(country = letters[1:4],
label_pos = c(2, 1, 3, 2),
color = RColorBrewer::brewer.pal(4, "Set2")[1:4])
df <- df %>% left_join(label_pos)
df$cc <- as.factor(df$cc)
# make list of plots
ggList <- lapply(split(df, df$cc), function(i) {
ggplot(i, aes(x = date, y = value, color = color)) +
geom_line(lwd = 1.1) +
geom_text_repel(data = subset(i, date == label_pos),
aes(label = country), box.padding = unit(0.02, "npc"), direction = "y") +
scale_color_identity() +
theme(legend.position = "none")
})
# plot as grid in 1 columns
cowplot::plot_grid(plotlist = ggList, ncol = 1,
align = 'v', labels = levels(df$cc))

R: ggplot2 let the characters of geom_text exactly cover one X unit

I want to highlight text based on the position in a string, for example if we have this text:
this is a really nice informative piece of text
Then I want to say let's draw a rectangle around positions 2 till 4:
t[his] is a really nice informative piece of text
I tried to do so in ggplot2 using the following code:
library(ggplot2)
library(dplyr)
box.data <- data.frame(
start = c(4,6,5,7,10,7),
type = c('BOX1.start', 'BOX1.start', 'BOX1.start','BOX1.end', 'BOX1.end', 'BOX1.end'),
text.id = c(1,2,3,1,2,3)
)
text.data <- data.frame(
x = rep(1,3),
text.id = c(1,2,3),
text = c('Thisissomerandomrandomrandomrandomtext1',
'Thisissomerandomrandomrandomrandomtext2',
'Thisissomerandomrandomrandomrandomtext3')
)
ggplot(data = text.data, aes(x = x, y = text.id)) +
scale_x_continuous(limits = c(1, nchar(as.character(text.data$text[1])))) +
geom_text(label = text.data$text, hjust = 0, size = 3) +
geom_line(data = box.data, aes(x = start, y = text.id, group = text.id, size = 3, alpha = 0.5, colour = 'red'))
This produces the following graph:
My method fails as a letter does not cover exactly one unit of the x-axis, is there any way to achieve this?
I just figured out that I can split the string in characters and plot these, perhaps it is useful for someone else.
library(ggplot2)
library(dplyr)
library(splitstackshape)
# First remember the plotting window, which equals the text length
text.size = nchar(as.character(text.data$text[1]))
# Split the string into single characters, and adjust the X-position to the string position
text.data <- cSplit(text.data, 'text', sep = '', direction = 'long', stripWhite = FALSE) %>%
group_by(text.id) %>%
mutate(x1 = seq(1,n()))
# Plot each character and add highlights
ggplot(data = text.data, aes(x = x1, y = text.id)) +
scale_x_continuous(limits = c(1, text.size)) +
geom_text(aes(x = text.data$x1, y = text.data$text.id, group = text.id, label = text)) +
geom_line(data = box.data, aes(x = start, y = text.id, group = text.id, size = 3, alpha = 0.5, colour = 'red'))
Which produces this plot:
Perhaps the marking should extend a little but upwards and downwards, but that's an easy fix.

Nonstandard breaks in plot for yaxis

I would like to create a simple plot but with nonstandard breaks.
That's the code for my data:
> dput(dt1)
c(15.9540654816514, 37.5416557213931, 143.317585514018, 317.329051086954,
736.342269565211, 611.759999999995, 1145.49376842104, 3287.57274999997
)
> dput(dt2)
c(7.74957214839424, 17.5499521829522, 47.8167516932271, 72.1468924428822,
131.457629238329, 119.135097468354, 193.812365333332, 339.109355072461
)
> dput(dt3)
c(3.43850794565666, 11.4081262121212, 24.6747108504399, 54.7253625128734,
85.7360432084306, 89.7801271317832, 117.764457806452, 152.859368367347
)
and I would like to achieve something like that:
Just ignore red point on that graph.
That's the code which I have written so far. However, approach of changing the y breaks doesn't work.
plot(dt1,col="blue",cex = 1.8,xlim=c(0,10), ylim = c(1,5000), yaxt = "n", bty="n",xlab="",ylab="")
axis(side = 2, at = C(10,100,1000,5000)
points(dt2,col="green",cex = 1.8)
points(dt3,col="red",cex = 1.8)
Is it possible ? I would like to create identical xlabel like on the attached picture. I can change it as well in other software so do not focus mostly on that.
This is the closest I can think of using ggplot2.
library(data.table)
library(dplyr)
library(ggplot2)
theme_set(theme_bw())
dat <- rbindlist(list(
data.table(dt = "dt1",
y = c(15.9540654816514, 37.5416557213931, 143.317585514018, 317.329051086954,
736.342269565211, 611.759999999995, 1145.49376842104, 3287.57274999997)),
data.table(dt = "dt2",
y = c(7.74957214839424, 17.5499521829522, 47.8167516932271, 72.1468924428822,
131.457629238329, 119.135097468354, 193.812365333332, 339.109355072461)),
data.table(dt = "dt3",
y = c(3.43850794565666, 11.4081262121212, 24.6747108504399, 54.7253625128734,
85.7360432084306, 89.7801271317832, 117.764457806452, 152.859368367347))))
## generate lables
labs <- paste(rep(1:4, c(2,3,2,1)), rep(c(1,2,3,4,3,4), c(1,2,1,1,1,2)), sep = '\n-\n')
## create x variable
dat[, x := rep(1:8, 3) %>% factor(labels = labs)]
## plot
ggplot(dat, aes(x = x, y = y, colour = dt)) +
geom_point() +
scale_y_log10(limits = c(1, 10000),
breaks = 10^(0:4)) +
xlab("") + ylab("")
ggsave('temp.png', width = 4, height = 3)
The output looks like this:

Bar/Pie Chart Label from Data Frame Column

I am making a pie chart and want to label it with the value for each slice. I have the information in a data frame but the column in which to look should be defined in the function call.
The code is the (decently) long, but I think only 1 line needs to be changed. I have tried mainsym, as.symbol, as.name, quote, and anything else I could think to throw at it but to no avail.
Thanks
library(dplyr)
library(ggplot2)
library(gridExtra)
pie_chart <- function(df, main, labels, labels_title=NULL) {
mainsym <- as.symbol(main)
labelssym <- as.symbol(labels)
# convert the data into percentages. add label position and inner label text
df <- df %>%
mutate(perc = mainsym / sum(mainsym)) %>%
mutate(label_pos = 1 - cumsum(perc) + perc / 2,
inner_label_text = paste0(round(perc * 100), "%\n",main)) #NEED HELP HERE! Replace 'main' with something
#debug print statement
print(df)
# reorder the category factor levels to order the legend
df[[labels]] <- factor(df[[labels]], levels = unique(df[[labels]]))
p <- ggplot(data = df, aes_(x = factor(1), y = ~perc, fill = labelssym)) +
# make stacked bar chart with black border
geom_bar(stat = "identity", color = "black", width = 1) +
# add the percents and values to the interior of the chart
geom_text(aes(x = 1.25, y = label_pos, label = inner_label_text), size = 4) +
# convert to polar coordinates
coord_polar(theta = "y",direction=-1)
return(p)
}
set.seed(42)
donations <- data.frame(donation_total=sample(1:1E5,50,replace=TRUE))
donation_size_levels_same <- seq(0,2E6,10E3)
donations$bracket <- cut(donations$donation_total,breaks=donation_size_levels_same,right=FALSE,dig.lab = 50)
donations.by_bracket <- donations %>%
group_by(bracket) %>%
summarize(n=n(),total=sum(donation_total)) %>%
ungroup() %>%
arrange(bracket)
grid.arrange(
pie_chart(df=donations.by_bracket,main="n",labels="bracket",labels_title="Total Amount Donated"),
pie_chart(df=donations.by_bracket,main="total",labels="bracket",labels_title="Total Amount Donated"))
The label placement still needs some adjustment but this seems to address the labelling issue, if you just replace that one line (where you say need help here) as follows:
mutate(label_pos = 1 - cumsum(perc) + perc / 2,
inner_label_text = paste0(round(perc * 100), "%\n",as.character(df[[main]])))

Resources