Related
I have this dataframe:
structure(list(taxon = c("Acidaminococcus", "Butyricicoccus",
"Butyrivibrio", "Collinsella", "Coprococcus", "Olsenella", "Parabacteroides",
"Paraprevotella", "Pasteurellaceae_unclassified"), lfc_StatusChronic.ACST0. = c(0.88175957,
0.88803574, 0.790947444, 1.319321361, 0.7176503, 0.758374253,
-0.833877215, -1.106098414, 0.932218695), se_StatusChronic.ACST0. = c(0.439259504,
0.449835605, 0.369268494, 0.391714918, 0.27578621, 0.364036816,
0.377314959, 0.485078744, 0.421283473), lfc_Time.fT1 = c(-0.021243562,
0.66196107, 0.334274258, -0.382520121, -0.005363874, -0.313304181,
-0.439558941, -0.029316428, 0.682658747), se_Time.fT1 = c(0.312681188,
0.330173331, 0.301559494, 0.309355933, 0.293938402, 0.302957725,
0.339292487, 0.361459254, 0.385696553), lfc_Time.fT2 = c(-1.092105655,
-0.083635974, -0.435405323, -1.221704783, -0.557850053, -0.734425087,
-0.19277856, 0.148094198, 0.461233277), se_Time.fT2 = c(0.326565043,
0.344533883, 0.31544836, 0.323423323, 0.307225241, 0.317023725,
0.354270528, 0.377368442, 0.403530764), lfc_Time.fT3 = c(-0.684898535,
0.007779894, -0.661494348, -0.765693993, -0.294827229, -1.082174069,
-0.428338824, 0.072377208, 0.682615791), se_Time.fT3 = c(0.324919486,
0.342422134, 0.314578177, 0.322254678, 0.305999846, 0.316331693,
0.352370636, 0.375283079, 0.402530027), lfc_Time.fT4 = c(-1.038613852,
-0.159777157, -0.172345815, -0.691220321, -0.444048742, -1.062300665,
0.073495083, 0.295212326, 0.337145234), se_Time.fT4 = c(0.319416657,
0.336513636, 0.309526757, 0.316959694, 0.300928605, 0.311343927,
0.346365478, 0.36886735, 0.396117478), lfc_Time.fT5 = c(-0.714954683,
0.081376697, -0.621676699, -0.483698623, -0.339094441, -0.718106519,
-0.055315775, 0.475970869, 0.160939365), se_Time.fT5 = c(0.317230276,
0.334106044, 0.307553106, 0.314893819, 0.298943665, 0.309379791,
0.343965965, 0.366296439, 0.393607858)), row.names = c(NA, -9L
), class = "data.frame")
It is a dataframe where each row is a category, and the columns correspond with a time series (from T0 til T5).
I want to do a bar chart for each category (taxon) for their time (T0-T5):
melted_df <- reshape2::melt(taxonFC1, id.vars = "taxon", variable.name = "timepoint", value.name = "value")
ggplot(melted_df, aes(x = timepoint, y = value, fill = taxon)) +
geom_bar(stat = "identity") +
facet_wrap(~ taxon, ncol = 3) +
labs(title = "Bar Chart for Different Time Series",
x = "Time Point",
y = "Value",
fill = "Category")
The question is if it is possible to assign the standard error (se columns) to their logFC value (lfc columns) for each time series.
Update:
I did this, but only for T0:
ggplot(data = taxonFC1, aes(x = taxon, y = lfc_StatusChronic.ACST0., fill = taxon)) +
geom_bar(stat = "identity") +
theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
xlab("Category") +
ylab("lfc_StatusChronic.ACST0.") +
ggtitle("Bar Plot of lfc_StatusChronic.ACST0. by Category") +
# Add error bars using se_StatusChronic.ACST0. column
geom_errorbar(aes(ymin = lfc_StatusChronic.ACST0. - se_StatusChronic.ACST0.,
ymax = lfc_StatusChronic.ACST0. + se_StatusChronic.ACST0.),
width = 0.4)
Output expected (the image is from other data):
Is this what you're looking for?
library(dplyr)
library(tidyr)
library(ggplot2)
dat <- structure(list(taxon = c("Acidaminococcus", "Butyricicoccus",
"Butyrivibrio", "Collinsella", "Coprococcus", "Olsenella", "Parabacteroides",
"Paraprevotella", "Pasteurellaceae_unclassified"), lfc_StatusChronic.ACST0. = c(0.88175957,
0.88803574, 0.790947444, 1.319321361, 0.7176503, 0.758374253,
-0.833877215, -1.106098414, 0.932218695), se_StatusChronic.ACST0. = c(0.439259504,
0.449835605, 0.369268494, 0.391714918, 0.27578621, 0.364036816,
0.377314959, 0.485078744, 0.421283473), lfc_Time.fT1 = c(-0.021243562,
0.66196107, 0.334274258, -0.382520121, -0.005363874, -0.313304181,
-0.439558941, -0.029316428, 0.682658747), se_Time.fT1 = c(0.312681188,
0.330173331, 0.301559494, 0.309355933, 0.293938402, 0.302957725,
0.339292487, 0.361459254, 0.385696553), lfc_Time.fT2 = c(-1.092105655,
-0.083635974, -0.435405323, -1.221704783, -0.557850053, -0.734425087,
-0.19277856, 0.148094198, 0.461233277), se_Time.fT2 = c(0.326565043,
0.344533883, 0.31544836, 0.323423323, 0.307225241, 0.317023725,
0.354270528, 0.377368442, 0.403530764), lfc_Time.fT3 = c(-0.684898535,
0.007779894, -0.661494348, -0.765693993, -0.294827229, -1.082174069,
-0.428338824, 0.072377208, 0.682615791), se_Time.fT3 = c(0.324919486,
0.342422134, 0.314578177, 0.322254678, 0.305999846, 0.316331693,
0.352370636, 0.375283079, 0.402530027), lfc_Time.fT4 = c(-1.038613852,
-0.159777157, -0.172345815, -0.691220321, -0.444048742, -1.062300665,
0.073495083, 0.295212326, 0.337145234), se_Time.fT4 = c(0.319416657,
0.336513636, 0.309526757, 0.316959694, 0.300928605, 0.311343927,
0.346365478, 0.36886735, 0.396117478), lfc_Time.fT5 = c(-0.714954683,
0.081376697, -0.621676699, -0.483698623, -0.339094441, -0.718106519,
-0.055315775, 0.475970869, 0.160939365), se_Time.fT5 = c(0.317230276,
0.334106044, 0.307553106, 0.314893819, 0.298943665, 0.309379791,
0.343965965, 0.366296439, 0.393607858)), row.names = c(NA, -9L
), class = "data.frame")
dat %>%
rename(lfc_time.fT0 = lfc_StatusChronic.ACST0.,
se_Time.fT0 = se_StatusChronic.ACST0.) %>%
pivot_longer(-taxon, names_pattern="(.*)_[Tt]ime\\.f(.*)",
names_to = c(".value", "time")) %>%
ggplot(aes(x = time, y = lfc, ymin = lfc - se, ymax = lfc + se, fill = taxon)) +
geom_bar(stat = "identity") +
geom_errorbar(width=.4) +
theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
scale_fill_brewer(palette="Set1") +
xlab("Category") +
ylab("lfc_StatusChronic.ACST0.") +
facet_wrap(~taxon, ncol=1) +
ggtitle("Bar Plot of lfc_StatusChronic.ACST0. by Category")```
If so, the key is to rename the T0 variables to have the same format as the other time-period variables and then use pivot_longer() to put all the lfc measures in a single column and all the se measures in a single column. The rest is accomplished with faceting on the time variable. The pivot_longer() documentation has some good examples of retaining multiple columns, see in particular the last example on the page.
Raw data
structure(list(attainment_target = c(7.5, 15), quarter_2022 = c("Q1",
"Q2"), total_attainment = c(2, 4), percent_attainment = c(0.2666,
0.2666)), row.names = c(NA, -2L), class = c("tbl_df", "tbl",
"data.frame"))
Quarter | Target | Attainment
2022-01-01 7.5 2
2022-04-01 15 4
Scenario
I would like to plot a ggplot (geom_col or geom_bar) with Quarter as x-axis and Attainment as y-axis with Target as a horizontal dash line that shows how far off I am from that value.
However, I am having trouble plotting YTD (Total attainment given # of quarters) in the same plot. Here is an example of how I used dplyr to create new field that shows calculated YTD value:
Desired output
Quarter | Target | Attainment | YTD. | % Attainment
2022-01-01 7.5 2 2 27
2022-04-01 15 4 6 40
Which is the best way to plot this via ggplot in R? Here is my current approach but having trouble incorporating all the above:
df1 <- df %>%
mutate(YTD_TOTAL = sum(total_attainment)) %>%
mutate(YTD_PERCENT_ATTAINMENT = sum(total_attainment) / max(attainment_target))
ggplot(data = df1, aes(fill=quarter_2022, x=attainment_target, y=total_attainment, color = quarter_2022, palette = "Paired",
label = TRUE,
position = position_dodge(0.9)))
Not sure exactly what you have in mind but here are some of the pieces you might want to use:
df %>%
mutate(YTD_TOTAL = cumsum(total_attainment)) %>%
mutate(YTD_PERCENT_ATTAINMENT = YTD_TOTAL/ attainment_target) %>%
ggplot(aes(quarter_2022, total_attainment)) +
geom_col(aes(y = YTD_TOTAL), fill = NA, color = "gray20") +
geom_text(aes(y = YTD_TOTAL, label = scales::percent(YTD_PERCENT_ATTAINMENT)),
vjust = -0.5) +
geom_col(fill = "gray70", color = "gray20") +
geom_text(aes(label = total_attainment),
position = position_stack(vjust = 0.5)) +
geom_segment(aes(x = as.numeric(as.factor(quarter_2022)) - 0.4,
xend = as.numeric(as.factor(quarter_2022)) + 0.4,
y = attainment_target, yend = attainment_target),
linetype = "dashed")
I have a dataset where the errors have the following x1 (age min), x2 (age max), y1 (height min), y2 (height max) and make a trapezium shape like this plot.
I want to do the same and plot these as errors and then have the gaussian process mean and error from a different model showing. To plot the errors as trapezium shapes I think I can do this using geom_polygon but I can't work out how to get the polygons to plot. It looks like you have to manually specify all of the coordinates see https://ggplot2.tidyverse.org/reference/geom_polygon.html . This seems extremely time-consuming to do for over 20 data points. Does anyone know of a more concise way to do this?
N.B. I have flipped the coordinates for the plot - this can be a bit confusing
Thanks,
library(ggplot2)
library(tidypalaeo)
### Create graph
ggplot(WAPRSL, aes(x =RSLc, y = Age))+
labs(x = "RSL (m)",y="Age (AD)")+
theme_classic()+
geom_lineh(data = WAPRSLgp, aes(x=mean,y=Age),col="#227988")+
coord_flip()+
geom_ribbon(data = WAPRSLgp, aes(x=mean, xmax=mean+error, xmin=mean-error), fill="#227988",alpha=.5)+
geom_ribbon(data = WAPRSLgp, aes(x=mean, xmax=mean+error*2, xmin=mean-error*2), fill="#227988",alpha=.7)+
geom_polygon(data=WAPRSL, aes(c(x1,x2,x2,x1),c(y1,y1,y2,y2))) ### something like this?
current plot without polygons
Data
### WAPRSL data
structure(list(depths = c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5), RSL = c(0.162319931,
0.170053941, 0.166157744, 0.268604159, 0.173369111, 0.207652794
), RSLerror = c(0.084355046, 0.084524909, 0.084307832, 0.084389419,
0.0838797, 0.083901714), Age = c(2017.393323, 2015.935137, 2013.065412,
2008.534508, 2004.853771, 2001.797776), Ageerror = c(0.183297248,
0.303357588, 0.566892665, 1.183257304, 2.427930603, 2.481236284
), RSLc = c(0.162319931, 0.16973314, 0.165205604, 0.26665522,
0.17061041, 0.204221774), y1 = c(2017.210026, 2015.631779, 2012.498519,
2007.351251, 2002.42584, 1999.31654), y2 = c(2017.57662, 2016.238495,
2013.632305, 2009.717765, 2007.281702, 2004.279012), x1 = c(0.162360256,
0.169799879, 0.16533032, 0.266915536, 0.171144554, 0.204767646
), x2 = c(0.162279606, 0.169666401, 0.165080887, 0.266394903,
0.170076265, 0.203675902)), row.names = c(NA, 6L), class = "data.frame")
### WAPRSLgp data
structure(list(Age = 1832:1837, mean = c(-0.098482271, -0.09855201,
-0.098622714, -0.098572523, -0.098894533, -0.099396926), error = c(0.054412551,
0.053483911, 0.052543897, 0.051595228, 0.05064071, 0.049683294
), min = c(-0.152894822, -0.152035921, -0.151166611, -0.150167751,
-0.149535243, -0.14908022), max = c(-0.04406972, -0.045068098,
-0.046078817, -0.046977296, -0.048253822, -0.049713632)), row.names = c(NA,
6L), class = "data.frame")
Your x1, x2, y1 and y2 points describe a perfect rectangle. Hence, the easiest thing is to simply use geom_rect(). I've commented out some lines since the WAPRSLgp data seems to describe a different part of the x-axis. The examples assume the WAPRSL data is in the global environment.
library(ggplot2)
#> Warning: package 'ggplot2' was built under R version 4.0.5
ggplot(WAPRSL, aes(x =RSLc, y = Age))+
labs(x = "RSL (m)",y="Age (AD)")+
theme_classic()+
# geom_line(data = WAPRSLgp, aes(x=mean,y=Age),col="#227988", orientation = "x")+
coord_flip()+
# geom_ribbon(data = WAPRSLgp, aes(x=mean, xmax=mean+error, xmin=mean-error), fill="#227988",alpha=.5)+
# geom_ribbon(data = WAPRSLgp, aes(x=mean, xmax=mean+error*2, xmin=mean-error*2), fill="#227988",alpha=.7) +
geom_rect(aes(xmin = x1, xmax = x2, ymin = y1, ymax = y2),
fill = "transparent", colour = "black")
However, if you insist on polygons, you'd need to reshape your data a bit.
WAPRSL$id <- seq_len(nrow(WAPRSL))
poly <- tidyr::pivot_longer(WAPRSL, y1:y2, names_to = "y_var", values_to = "y_val")
poly <- tidyr::pivot_longer(poly, x2:x1, names_to = "x_var", values_to = "x_val")
# Correct for the order
poly <- poly[(poly$id - 1) * 4 + rep(c(1,2,4,3), max(poly$id)), ]
ggplot(WAPRSL, aes(x =RSLc, y = Age))+
labs(x = "RSL (m)",y="Age (AD)")+
theme_classic()+
# geom_line(data = WAPRSLgp, aes(x=mean,y=Age),col="#227988", orientation = "x")+
coord_flip()+
# geom_ribbon(data = WAPRSLgp, aes(x=mean, xmax=mean+error, xmin=mean-error), fill="#227988",alpha=.5)+
# geom_ribbon(data = WAPRSLgp, aes(x=mean, xmax=mean+error*2, xmin=mean-error*2), fill="#227988",alpha=.7) +
geom_polygon(
data = poly,
aes(x = x_val, y = y_val, group = id),
fill = NA, colour = "black"
)
Created on 2021-07-07 by the reprex package (v1.0.0)
I think I'm missing something very easy here, but I just can't figure it out at the moment:
I would like to consistently assign colors to certain values from a column across multiple plots.
So I have this tibble (sl):
# A tibble: 15 x 3
class hex x
<chr> <chr> <int>
1 translational slide #c23b22 1
2 rotational slide #AFC6CE 2
3 fast flow-type #b7bf5e 3
4 complex #A6CEE3 4
5 area subject to rockfall/topple #1F78B4 5
6 fall-type #B2DF8A 6
7 n.d. #33A02C 7
8 NA #FB9A99 8
9 area subject to shallow-slides #E31A1C 9
10 slow flow-type #FDBF6F 10
11 topple #FF7F00 11
12 deep-seated movement #CAB2D6 12
13 subsidence #6A3D9A 13
14 areas subject to subsidence #FFFF99 14
15 area of expansion #B15928 15
This should recreate it:
structure(list(class = c("translational slide", "rotational slide",
"fast flow-type", "complex", "area subject to rockfall/topple",
"fall-type", "n.d.", NA, "area subject to shallow-slides", "slow flow-type",
"topple", "deep-seated movement", "subsidence", "areas subject to subsidence",
"area of expansion"), hex = c("#c23b22", "#AFC6CE", "#b7bf5e",
"#A6CEE3", "#1F78B4", "#B2DF8A", "#33A02C", "#FB9A99", "#E31A1C",
"#FDBF6F", "#FF7F00", "#CAB2D6", "#6A3D9A", "#FFFF99", "#B15928"
), x = 1:15), row.names = c(NA, -15L), class = c("tbl_df", "tbl",
"data.frame"))
Now I would like to plot each class with a bar in the color if its hex-code (for now just for visualization purposes). So I did:
ggplot(sl) +
geom_col(aes(x = x,
y = 1,
fill = class)) +
scale_fill_manual(values = sl$hex) +
geom_text(aes(x = x,
y = 0.5,
label = class),
angle = 90)
But these are not the colors as they are in the tibble.
So I tried to follow this guide: How to assign colors to categorical variables in ggplot2 that have stable mapping? and created this:
# create the color palette
mycols = sl$hex
names(mycols) = sl$class
and then plotted it with
ggplot(sl) +
geom_col(aes(x = x,
y = 1,
fill = class)) +
scale_fill_manual(values = mycols) +
geom_text(aes(x = x,
y = 0.5,
label = class),
angle = 90)
But the results is the same. It's this:
For example the translational slide has the hex code: "#c23b22" and should be a pastell darkish red.
Anyone might have an idea what I'm missing here?
Consider this:
sl <- structure(list(class = c("translational slide", "rotational slide",
"fast flow-type", "complex", "area subject to rockfall/topple",
"fall-type", "n.d.", NA, "area subject to shallow-slides", "slow flow-type",
"topple", "deep-seated movement", "subsidence", "areas subject to subsidence",
"area of expansion"), hex = c("#c23b22", "#AFC6CE", "#b7bf5e",
"#A6CEE3", "#1F78B4", "#B2DF8A", "#33A02C", "#FB9A99", "#E31A1C",
"#FDBF6F", "#FF7F00", "#CAB2D6", "#6A3D9A", "#FFFF99", "#B15928"
), x = 1:15), row.names = c(NA, -15L), class = c("tbl_df", "tbl",
"data.frame"))
sl$class <- factor( sl$class, levels=unique(sl$class) )
cl <- sl$hex
names(cl) <- paste( sl$class )
ggplot(sl) +
geom_col(aes(x = x,
y = 1,
fill = class)) +
scale_fill_manual( values = cl, na.value = cl["NA"] ) +
geom_text(aes(x = x,
y = 0.5,
label = class),
angle = 90)
By changing class to a factor and setting levels to it, and using a named vector for your values in scale_fill_manual, and using na.value in there properly, yo might get something that looks more as expected.
You need to provide correct order to colors as per your column, since there is already one called 'x' I have used it as well. Also I replaced NA with character 'NA'. I have checked few of them, Please let me know if this is not the desired output. Thanks
#Assuming df is your dataframe:
df[is.na(df$class), 'class'] <- 'NA'
ggplot(df) +
geom_col(aes(x = x,
y = 1,
fill = factor(x))) +
scale_fill_manual(values = df$hex, labels=df$class) +
geom_text(aes(x = x,
y = 0.5,
label = class),
angle = 90)
Output:
I think the problem is that scale_fill_manual expect the order of its values and labels arguments to match. This isn't the case with your dataset.
Does
sl %>% ggplot() +
geom_col(aes(x = x,
y = 1,
fill = hex)) +
geom_text(aes(x = x,
y = 0.5,
label = class),
angle = 90) +
scale_fill_manual(values=sl$hex, labels=sl$class)
Give you what you want?
next time, please dput() your test data: it took me as long to create the test dataset as to answer your question. Also, using hex codes for colours make it difficult to check the colours are as expected. For a MWE, blue/green/black etx would have been more helpful.
I've got a data like below:
structure(list(bucket = structure(1:23, .Label = c("(1.23,6.1]",
"(6.1,10.9]", "(10.9,15.6]", "(15.6,20.4]", "(20.4,25.1]", "(25.1,29.9]",
"(29.9,34.6]", "(34.6,39.4]", "(39.4,44.2]", "(44.2,48.9]", "(48.9,53.7]",
"(53.7,58.4]", "(58.4,63.2]", "(63.2,68]", "(68,72.7]", "(72.7,77.5]",
"(77.5,82.2]", "(82.2,87]", "(87,91.7]", "(91.7,96.5]", "(96.5,101]",
"(101,106]", "(106,111]"), class = "factor"), value = c(0.996156321090158, 0.968144290236367, 0.882793110384066, 0.719390676388129, 0.497759597498133,
0.311721580067415, 0.181244079443301, 0.0988516758834657, 0.0527504526341006,
0.0278716018561911, 0.0145107725175315, 0.00785033086321829,
0.00405759957072942, 0.00213190168252939, 0.00109610249274952,
0.000578154695264754, 0.000301095727545301, 0.000155696457494707,
8.2897211122996e-05, 4.09225082176349e-05, 2.33782236798641e-05,
1.21665352966827e-05, 6.87373003802479e-06), bucket_id = 1:23), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -23L))
Which I want to visualise as a circular stacked bar plot:
cutoff_values <- seq(0, 115, by = 5)
library(tidyverse)
ex %>%
mutate(r0 = cutoff_values[-length(cutoff_values)],
r = cutoff_values[-1]) %>%
mutate(x0 = 100,
y0 = 50) %>%
ggplot(aes(x0 = x0, y0 = y0, r0 = r0, r = r)) +
ggforce::geom_arc_bar(aes(start = 0, end = 2 * pi, fill = value),
colour = NA) +
theme_void() +
labs(fill = 'colour')
But I also need to be able to mark out some particular bucket with different filling at best. So I need to be able to preserve filling using value with continuous scale, but also fill one particular stratum (let's say bucket == 15) with another colour, leaving the other strata (buckets) as they are. Is it possible? What are the alternatives to mark out bucket 15th?
I believe that this can be done with the relayer package, which is still highly experimental. You can copy a subset of your data in a seperate geom and give it another fill aesthetic. This seperate geom can then be piped into rename_geom_aes() and you would have to set the scale_fill_*() for your renamed aesthetic. You'd probably get a warning about that the geom is ignoring unknown aesthetics, but I don't know if that can be helped.
Below is an example for making bucket 15 red.
library(tidyverse)
library(relayer) # https://github.com/clauswilke/relayer
ex <- df %>%
mutate(r0 = cutoff_values[-length(cutoff_values)],
r = cutoff_values[-1]) %>%
mutate(x0 = 100,
y0 = 50)
ggplot(ex, aes(x0 = x0, y0 = y0, r0 = r0, r = r)) +
ggforce::geom_arc_bar(aes(start = 0, end = 2 * pi, fill = value),
colour = NA) +
ggforce::geom_arc_bar(data = ex[ex$bucket_id == 15,], # Whatever bucket you want
aes(start = 0, end = 2 * pi, fill2 = as.factor(bucket_id))) %>%
rename_geom_aes(new_aes = c("fill" = "fill2")) +
scale_fill_manual(aesthetics = "fill2", values = "red", guide = "legend") +
theme_void() +
labs(fill = 'colour', fill2 = "highlight")