Related
I have data with large degrees of separation between "clusters/groups" of values that I hope to make a histogram with, but dividing the bins into equal sized groups has been difficult. I'd like for zero (0) to have it's own bin, the total number of equally spaced bins be < 8 (ideally, to avoid crowding the plot) with an extra empty bin for "..." signifying the large gaps in-between the data values. The actual dataset has 800+ zeros with maybe 5% data >0. Naturally the zeros will over-shadow the rest of the data, but a log transform will fix that. I just can't figure out the best way to break-up the data...
Data looks like this:
set.seed(123)
zero <- runif(50, min=0, max=0)
small <- runif(7, min=0, max=0.1)
medium <- runif(5, min=0, max=0.5)
high <- runif(3, min=1.5, max=2.5)
f <- function(x){
return(data.frame(ID=deparse(substitute(x)), value=x))
}
all <- bind_rows(f(zero), f(small), f(medium), f(high))
all <- as.data.frame(all[,-1])
names(all)[1] <- "value"
My attempt:
bins <- all %>% mutate(bin = cut(all$value, breaks = c(0, seq(0.01:0.4), Inf), right = FALSE)) %>%
count(bin, name = "freq") %>%
add_row(bin = "...", freq = NA_integer_) %>%
mutate(bin = fct_relevel(bin, "...", after = 0.4))
But I get this error:
Error in `mutate()`:
! Problem while computing `bin = fct_relevel(bin, "...", after = 0.5)`.
Caused by error:
! `idx` must contain one integer for each level of `f`
This is not equally spaced, but I'm looking for something like this as labels for my plot:
levels(bins$bin) <- c("0", "0.01-0.05", "0.05-0.1", "0.1-0.2", "0.2-0.3", "0.3-0.4", "...", "2.0+")
ggplot(bins, aes(x = bin, y = freq, fill = bin)) +
geom_histogram(stat = "identity", colour = "black")
You can use cut directly inside ggplot
ggplot(all, aes(cut(value, breaks = c(0, 0.25, 0.5, 3), inc = TRUE))) +
geom_bar() +
scale_y_log10() +
labs(x = "value")
This worked for me (using my own data):
bins <- WET %>% mutate(bin = cut(den, breaks = c(0, seq(0.001, 0.225, 0.15), 0.255, 0.3, Inf), right = FALSE)) %>%
count(bin, name = "freq") %>% # build frequency table, frequency = freq
add_row(bin = "...", freq = NA_integer_) %>% # add empty row for NA
mutate(bin = fct_relevel(bin, "...", after = 3)) # Put factor level "..." after 3! (the 3rd position)
levels(bins$bin) <- c("0", "0.001-0.15", "0.15-0.255", "...", "0.3+")
# fct_relevel(f, "a", after = 2), "..., after = x, x must be an integer! (2nd position)
ggplot(bins, aes(x = bin, y = freq, fill = bin)) +
geom_bar(stat = "identity", colour = "black") +
geom_text(aes(label = freq), vjust = -0.5) +
scale_y_continuous(limits = c(0, 800), expand = expansion(mult = c(0, 0.05))) +
scale_fill_brewer(name = "Density", palette="Greys", breaks = c("0", "0.001-0.15", "0.15-0.255", "0.3+")) +
# Only show these legend values (exclude "...")
labs(title = "Wet seasons - Pink shrimp density (no./m2)",x = "Density range", y = "Frequency") +
theme(plot.title = element_text(hjust = 0.5)) +
theme(axis.text = element_text(size = 9, face = "bold")) +
theme(axis.title = element_text(size = 13, face = "bold")) + # Axis titles
theme(axis.title.x = element_text(vjust = -3)) +
theme(panel.border = element_rect(color = "black", fill = NA, size = 1)) +
# Adjust distance of x-axis title from plot
theme(plot.margin = margin(t = 20, # Top margin
r = 50, # Right margin
b = 40, # Bottom margin
l = 10)) # Left margin
I want to plot only one category of a multinomial regression using the Effects package.
Example:
library(nnet)
m1 <- multinom(Species ~ Sepal.Width * Petal.Width + Sepal.Length, data = iris)
plt <- effect("Sepal.Width * Petal.Width", m1, x.var = "Sepal.Width")
plot(plt, x.var = "Sepal.Width",
lattice = list(strip = list(factor.names = F)),
confint = list(style="auto", col = "black"),
axes = list(grid = T,
x = list(rug = F)))
This gives me the following:
https://i.stack.imgur.com/fdOw5.png
Is there any way to plot only, for instance, the class Versicolor?
Already tried with layout() but I can only get as far as plotting Setosa and Versicolor:
plot(plt, x.var = "Sepal.Width",
lattice = list(strip = list(factor.names = F),
layout = c(5, 2, 1)),
confint = list(style="auto", col = "black"),
axes = list(grid = T,
x = list(rug = F)))
If I change layout = c(5, 2, 1) to layout = c(5, 1, 1) it only displays Setosa.
Thank you!
The easiest way I found was to use ggplot2.
First I had to convert my object (from effect()) to a data frame and then go from there:
Example:
m1 <- multinom(Species ~ Sepal.Width * Petal.Width + Sepal.Length, data = iris)
plt <- effect("Sepal.Width * Petal.Width", m1)
plt_df <- data.frame(plt) # creating a data frame
And to plot with ggplot2:
ggplot(data = plt_df, aes(x = Sepal.Width,
y = prob.versicolor,
ymin = L.prob.versicolor, # Lower CI
ymax = U.prob.versicolor)) + # Upper CI
geom_ribbon(alpha = 0.2) + # For CI
geom_line() +
facet_wrap(~Petal.Width, ncol = 5) +
# Few things to custoimze
scale_y_continuous("Predicted Probabilities Y",
# axes on top / right sides
sec.axis = dup_axis(),
breaks = c(0, 0.25, 0.5, .75, 1),
labels = c("0%" , "25%", "50%", "75%", "100%")) +
scale_x_continuous("Sepal Width") +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5),
strip.placement = "outside",
## If you want to point axis ticks inwards:
### (2.75pt is the default axis tick length here)
# axis.ticks.length = unit(-2.75, "pt"),
## do not show top / right axis labels:
# axis.text.x.top = element_blank(),
## For Secondary Axis:
#axis.text.y.right = element_blank(),
## As Above, Don't show axis titles:
# axis.title.x.top = element_blank(),
axis.title.y.right = element_blank(),
# Change the distance between y axis title and ticks:
axis.title.y = element_text(margin = margin(
t = 0, r = 20, b = 0, l = 0)),
panel.background = element_blank())
https://i.stack.imgur.com/ocVJO.png
This question already has an answer here:
How can I add hatches, stripes or another pattern or texture to a barplot in ggplot?
(1 answer)
Closed 1 year ago.
Suppose I want to show in a barplot the gene expression results (logFC) based on RNA-seq and q-PCR analysis. My dataset looks like that:
set.seed(42)
f1 <- expand.grid(
comp = LETTERS[1:3],
exp = c("qPCR", "RNA-seq"),
geneID = paste("Gene", 1:4)
)
f1$logfc <- rnorm(nrow(f1))
f1$SE <- runif(nrow(f1), min=0, max=1.5)
My R command line
p=ggplot(f1, aes(x=geneID, y=logfc, fill= comp,color=exp))+
geom_bar(stat="identity", position =position_dodge2(preserve="single"))+
theme(axis.text.x = element_text(angle = 45, vjust = 0.5, hjust=1))```
I have this output:
I want to get any mark patterns or hatches on the bars corresponding to one of the variables (exp or comp) and adding the upper error bars as shown in this plot bellow:
Any help please?
Following the linked answer, it seems quite natural how to extend it to your case. In the example below, I'm using some dummy data structured like the head() data you gave, since the csv link gave me a 404.
library(ggplot2)
library(ggpattern)
#>
#> Attaching package: 'ggpattern'
#> The following objects are masked from 'package:ggplot2':
#>
#> flip_data, flipped_names, gg_dep, has_flipped_aes, remove_missing,
#> should_stop, waiver
# Setting up some dummy data
set.seed(42)
f1 <- expand.grid(
comp = LETTERS[1:3],
exp = c("qPCR", "RNA-seq"),
geneID = paste("Gene", 1:4)
)
f1$logfc <- rnorm(nrow(f1))
ggplot(f1, aes(x = geneID, y = logfc, fill = comp)) +
geom_col_pattern(
aes(pattern = exp),
colour = "black",
pattern_fill = "black",
pattern_angle = 45,
pattern_density = 0.1,
pattern_spacing = 0.01,
position = position_dodge2(preserve = 'single'),
) +
scale_pattern_manual(
values = c("none", "stripe"),
guide = guide_legend(override.aes = list(fill = "grey70")) # <- make lighter
) +
scale_fill_discrete(
guide = guide_legend(override.aes = list(pattern = "none")) # <- hide pattern
)
Created on 2021-04-19 by the reprex package (v1.0.0)
EDIT: if you want to repeat the hatching in the fill legend, you can make an interaction() and then customise a manual fill scale.
ggplot(f1, aes(x = geneID, y = logfc)) +
geom_col_pattern(
aes(pattern = exp,
fill = interaction(exp, comp)), # <- make this an interaction
colour = "black",
pattern_fill = "black",
pattern_angle = 45,
pattern_density = 0.1,
pattern_spacing = 0.01,
position = position_dodge2(preserve = 'single'),
) +
scale_pattern_manual(
values = c("none", "stripe"),
guide = guide_legend(override.aes = list(fill = "grey70")) # <- make lighter
) +
scale_fill_manual(
# Have 3 colours and repeat each twice
values = rep(scales::hue_pal()(3), each = 2),
# Extract the second name after the '.' from the `interaction()` call
labels = function(x) {
vapply(strsplit(x, "\\."), `[`, character(1), 2)
},
# Repeat the pattern over the guide
guide = guide_legend(
override.aes = list(pattern = rep(c("none", "stripe"), 3))
)
)
Created on 2021-04-19 by the reprex package (v1.0.0)
EDIT2: Now with errorbars:
library(ggplot2)
library(ggpattern)
set.seed(42)
f1 <- expand.grid(
comp = LETTERS[1:3],
exp = c("qPCR", "RNA-seq"),
geneID = paste("Gene", 1:4)
)
f1$logfc <- rnorm(nrow(f1))
f1$SE <- runif(nrow(f1), min=0, max=1.5)
ggplot(f1, aes(x = geneID, y = logfc)) +
geom_col_pattern(
aes(pattern = exp,
fill = interaction(exp, comp)), # <- make this an interaction
colour = "black",
pattern_fill = "black",
pattern_angle = 45,
pattern_density = 0.1,
pattern_spacing = 0.01,
position = position_dodge2(preserve = 'single'),
) +
geom_errorbar(
aes(
ymin = logfc,
ymax = logfc + sign(logfc) * SE,
group = interaction(geneID, comp, exp)
),
position = "dodge"
) +
scale_pattern_manual(
values = c("none", "stripe"),
guide = guide_legend(override.aes = list(fill = "grey70")) # <- make lighter
) +
scale_fill_manual(
# Have 3 colours and repeat each twice
values = rep(scales::hue_pal()(3), each = 2),
# Extract the second name after the '.' from the `interaction()` call
labels = function(x) {
vapply(strsplit(x, "\\."), `[`, character(1), 2)
},
# Repeat the pattern over the guide
guide = guide_legend(
override.aes = list(pattern = rep(c("none", "stripe"), 3))
)
)
Created on 2021-04-22 by the reprex package (v1.0.0)
I am using ggplot2 to create a scatter plot of 2 variables. I want to have these printed out on the caption portion of ggplot:
linear regression equation
r2 value
p-value
I am using brackets, new lines and stored values to concatenate everything together. I have attempted using expression(), parse() and bquote() functions but it only prints out the variable name and not the stored values.
This is the graph I have now. Everything looks great other than the R^2 part. Brackets seem to cause a lot of problems but I want to keep them (looks better in my opinion).This is my ggplot script. I am only concerned about the caption section at the end.
Difficult to work with the code you have provided as an example (see comment re: reproducible example), but I had my students complete a similar exercise for their homework recently, and can provide an example which you can likely generalize from. My approach is to use the TeX() function from the latex2exp package.
A psychologist is interested in whether she can predict GPA in graduate school from students' earlier scores on the Graduate Record Exam (GRE).
Setup the Toy Data and Regression Model
GPA <- c(3.70,3.18,2.90,2.93,3.02,2.65,3.70,3.77,3.41,2.38,
3.54,3.12,3.21,3.35,2.60,3.25,3.48,2.74,2.90,3.28)
GRE <- c(637,562,520,624,500,500,700,680,655,525,
593,656,592,689,550,536,629,541,588,619)
gpa.gre <- data.frame(GPA, GRE)
mod <- lm(GPA ~ GRE, data = gpa.gre)
mod.sum <- summary(mod)
print(cofs <- round(mod$coefficients, digits = 4))
aY <- cofs[[1]]
bY <- cofs[[2]]
print(Rsqr <- round(cor(GPA,GRE)^2, digits = 2))
Generate the Plot
require(ggplot2)
require(latex2exp)
p <- ggplot(data = gpa.gre, aes(x = GRE, y = GPA)) +
geom_smooth(formula = 'y ~ x', color ="grey40", method = "lm",
linetype = 1, lwd = 0.80, se = TRUE, alpha = 0.20) +
geom_point(color = "grey10", size = 1) +
labs(y = "Grade Point Average", x = "GRE Score") +
coord_cartesian(ylim = c(2.28, 3.82), xlim = c(498, 702), clip = "off") +
scale_y_continuous(breaks = seq(2.30, 3.80, 0.25)) +
scale_x_continuous(breaks = seq(500, 700, 50)) +
theme_classic() +
theme(axis.title.x = element_text(margin = unit(c(3.5,0,0,0), "mm"), size = 11.5),
axis.title.y = element_text(margin = unit(c(0,3.5,0,0), "mm"), size = 11.5),
axis.text = element_text(size = 10),
plot.margin = unit(c(0.25,4,1,0.25), "cm"))
# Use TeX function to use LaTeX
str_note <- TeX("\\textit{Note. ***p} < .001")
str_eq <- TeX("$\\hat{\\textit{y}} = 0.4682 + 0.0045 \\textit{x}$")
str_rsq <- TeX("$\\textit{R}^2 = .54***$")
# Create annotations
p + annotate("text", x = 728, y = 3.70, label = str_eq, size = 3.5,
hjust = 0, na.rm = TRUE) +
annotate("text", x = 728, y = 3.57, label = str_rsq, size = 3.5,
hjust = 0, na.rm = TRUE) +
annotate("text", x = 490, y = 1.80, label = str_note, size = 3.5,
hjust = 0, na.rm = TRUE)
Get Result
ggsave(filename = '~/Documents/gregpa.png', # your favourite file path here
width = unit(5, "in"), # width of plot
height = unit(4, "in"), # height of plot
dpi = 400) # resolution in dots per inch
This is my first question to StackExchange, and I've searched for answers that have been helpful, but haven't really gotten me to where I'd like to be.
This is a stacked bar chart, combined with a point chart, combined with a line.
Here's my code:
theme_set(theme_light())
library(lubridate)
FM <- as.Date('2018-02-01')
x.range <- c(FM - months(1) - days(1) - days(day(FM) - 1), FM - days(day(FM) - 1) + months(1))
x.ticks <- seq(x.range[1] + days(1), x.range[2], by = 2)
#populate example data
preds <- data.frame(FM = FM, DATE = seq(x.range[1] + days(1), x.range[2] - days(1), by = 1))
preds <- data.frame(preds, S_O = round(seq(1, 1000000, by = 1000000/nrow(preds))))
preds <- data.frame(preds, S = round(ifelse(month(preds$FM) == month(preds$DATE), day(preds$DATE) / 30.4, 0) * preds$S_O))
preds <- data.frame(preds, O = preds$S_O - preds$S)
preds <- data.frame(preds, pred_sales = round(1000000 + rnorm(nrow(preds), 0, 10000)))
preds$ma <- with(preds, stats::filter(pred_sales, rep(1/5, 5), sides = 1))
y.max <- ceiling(max(preds$pred_sales) / 5000) * 5000 + 15000
line.cols <- c(O = 'palegreen4', S = 'steelblue4',
P = 'maroon', MA = 'blue')
fill.cols <- c(O = 'palegreen3', S = 'steelblue3',
P = 'red')
p <- ggplot(data = preds,
mapping = aes(DATE, pred_sales))
p <- p +
geom_bar(data = reshape2::melt(preds[,c('DATE', 'S', 'O')], id.var = 'DATE'),
mapping = aes(DATE, value, group = 1, fill = variable, color = variable),
width = 1,
stat = 'identity',
alpha = 0.5) +
geom_point(mapping = aes(DATE, pred_sales, group = 2, fill = 'P', color = 'P'),
shape = 22, #square
alpha = 0.5,
size = 2.5) +
geom_line(data = preds[!is.na(preds$ma),],
mapping = aes(DATE, ma, group = 3, color = 'MA'),
alpha = 0.8,
size = 1) +
geom_text(mapping = aes(DATE, pred_sales, label = formatC(pred_sales / 1000, format = 'd', big.mark = ',')),
angle = 90,
size = 2.75,
hjust = 1.25,
vjust = 0.4) +
labs(title = sprintf('%s Sales Predictions - %s', 'Overall', format(FM, '%b %Y')),
x = 'Date',
y = 'Volume in MMlbs') +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1, size = 8),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
legend.title = element_blank(),
legend.position = 'bottom',
legend.text = element_text(size = 8),
legend.margin = margin(t = 0.25, unit = 'cm')) +
scale_x_date(breaks = x.ticks,
date_labels = '%b %e',
limits = x.range) +
scale_y_continuous(limits = c(0, y.max),
labels = function(x) { formatC(x / 1000, format='d', big.mark=',') }) +
scale_color_manual(values = line.cols,
breaks = c('MA'),
labels = c(MA = 'Mvg Avg (5)')) +
scale_fill_manual(values = fill.cols,
breaks = c('P', 'O', 'S'),
labels = c(O = 'Open Orders', S = 'Sales', P = 'Predictions'))
p
The chart it generates is this:
As you can see, the legend does a couple of funky things. It's close, but not quite there. I only want boxes with exterior borders for Predictions, Open Orders, and Sales, and only a blue line for the Mvg Avg (5).
Any advice would be appreciated.
Thanks!
Rather late, but if you are still interested to understand this problem, the following should work. Explanations are included as comments within the code:
library(dplyr)
preds %>%
# scale the values for ALL numeric columns in the dataset, before
# passing the dataset to ggplot()
mutate_if(is.numeric, ~./1000) %>%
# since x / y mappings are stated in the top level ggplot(), there's
# no need to repeat them in the subsequent layers UNLESS you want to
# override them
ggplot(mapping = aes(x = DATE, y = pred_sales)) +
# 1. use data = . to inherit the top level data frame, & modify it on
# the fly for this layer; this is neater as you are essentially
# using a single data source for the ggplot object.
# 2. geom_col() is a more succinct way to say geom_bar(stat = "identity")
# (I'm using tidyr rather than reshape package, since ggplot2 is a
# part of the tidyverse packages, & the two play together nicely)
geom_col(data = . %>%
select(S, O, DATE) %>%
tidyr::gather(variable, value, -DATE),
aes(y = value, fill = variable, color = variable),
width = 1, alpha = 0.5) +
# don't show legend for this layer (o/w the fill / color legend would
# include a square shape in the centre of each legend key)
geom_point(aes(fill = 'P', color = 'P'),
shape = 22, alpha = 0.5, size = 2.5, show.legend = FALSE) +
# use data = . %>% ... as above.
# since the fill / color aesthetic mappings from the geom_col layer would
# result in a border around all fill / color legends, avoid it all together
# here by hard coding the line color to "blue", & map its linetype instead
# to create a separate linetype-based legend later.
geom_line(data = . %>% na.omit(),
aes(y = ma, linetype = 'MA'),
color = "blue", alpha = 0.8, size = 1) +
# scales::comma is a more succinct alternative to formatC for this use case
geom_text(aes(label = scales::comma(pred_sales)),
angle = 90, size = 2.75, hjust = 1.25, vjust = 0.4) +
labs(title = sprintf('%s Sales Predictions - %s', 'Overall', format(FM, '%b %Y')),
x = 'Date',
y = 'Volume in MMlbs') +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1, size = 8),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
legend.title = element_blank(),
legend.position = 'bottom',
legend.text = element_text(size = 8),
legend.margin = margin(t = 0.25, unit = 'cm')) +
scale_x_date(breaks = x.ticks,
date_labels = '%b %e',
limits = x.range) +
# as above, scales::comma is more succinct
scale_y_continuous(limits = c(0, y.max / 1000),
labels = scales::comma) +
# specify the same breaks & labels for the manual fill / color scales, so that
# a single legend is created for both
scale_color_manual(values = line.cols,
breaks = c('P', 'O', 'S'),
labels = c(O = 'Open Orders', S = 'Sales', P = 'Predictions')) +
scale_fill_manual(values = fill.cols,
breaks = c('P', 'O', 'S'),
labels = c(O = 'Open Orders', S = 'Sales', P = 'Predictions')) +
# create a separate line-only legend using the linetype mapping, with
# value = 1 (i.e. unbroken line) & specified alpha / color to match the
# geom_line layer
scale_linetype_manual(values = 1,
label = 'Mvg Avg (5)',
guide = guide_legend(override.aes = list(alpha = 1,
color = "blue")))