I'm trying to change the name of all labels in geom_text from the example below:
mpg %>%
distinct(trans, .keep_all = T) %>%
ggplot(aes(x=cty, y=hwy))+
geom_text(aes(x=cty, y=hwy,label = trans))
I would like to edit "auto(l3)" to "Al3", "auto(l4)" to "Al4", "auto(l5)" to "Al5", "auto(l6)" to "Al6", and so on according to the names in the code below
mpg %>%
distinct(trans, .keep_all = T) %>%
ggplot(aes(x=cty, y=hwy))+
geom_text(aes(x=cty, y=hwy,
label = replace(trans, c("auto(l3)", "auto(l4)", "auto(l5)", "auto(l6)",
"auto(s4)", "auto(s5)", "auto(s6)",
"manual(m5)", "manual(m6)", "auto(av)"),
c("Al3", "Al4", "Al5", "Al6",
"As4", "selected", "good",
"m5", "m6", "av"))))
My output is the following error "Error in check_aesthetics():
! Aesthetics must be either length 1 or the same as the data (10): label"
I put exactly the 10 trans values in the code, is there another way to do this change?
I would suggest to do this kind of recoding outside of ggplot. IMHO this results in cleaner code and is easier to check and to debug. Additionally I switched to dplyr::recode using a named vector:
library(ggplot2)
library(dplyr)
rec_vec <- setNames(
c("Al3", "Al4", "Al5", "Al6", "As4", "selected", "good", "m5", "m6", "av"),
c(
"auto(l3)", "auto(l4)", "auto(l5)", "auto(l6)", "auto(s4)", "auto(s5)",
"auto(s6)", "manual(m5)", "manual(m6)", "auto(av)"
)
)
mpg %>%
distinct(trans, .keep_all = T) %>%
mutate(trans = recode(trans, !!!rec_vec)) |>
ggplot(aes(x = cty, y = hwy)) +
geom_text(aes(
x = cty, y = hwy,
label = trans
))
Related
I have a dodged bar chart that shows the data "Created Date" and "Last Accessed" per year. The date data is formatted as year-month-date hour:minute:second.
Now I want to split the data up into one graph per year that shows Created date and Last accessed per date of the year. I tried to plot everything in one graph, however it was really messy..
Is it possible to plot per year, so in this example it will be 6 graphs because it is 6 years. I was thinking something like looping trough each year?
for(x in 1:number_of_years) {
... plot
}
This is my code:
```{r echo=FALSE, warning=FALSE}
# Libraries
library(ggplot2)
library(data.table)
library(tidyr)
# Read data
df = read.csv2(text = "File.Name|Created.Date|Last.Accessed|Visual.Group
60be1ba43bf7cjpg|1989-11-17 06:25:22|2017-07-15 01:25:22|0
60be1ba43bf89jpg|1989-02-04 04:03:16|2021-12-17 04:03:16|1
60be1ba43bf8djpg|2017-04-22 14:57:13|2017-11-17 23:57:13|2
60be1ba43bf90jpg|2021-04-12 23:03:44|2018-11-17 05:03:44|3
60be1ba43bf93jpg|2019-08-28 18:23:16|1989-09-07 12:23:16|4
60be1ba43bf95jpg|1989-09-11 08:16:20|2020-03-17 10:16:20|5
60be1ba43bf98jpg|2018-08-01 16:56:05|2017-04-24 03:56:05|5
60be1ba43bf9bjpg|2017-06-23 19:01:37|1989-07-14 22:01:37|6
60be1ba43bf9ejpg|2018-02-20 15:21:26|2020-02-01 18:21:26|7
60be1ba43bfa1jpg|2021-12-10 08:34:09|2021-04-17 02:34:09|8
60be1ba43bfa4jpg|2017-01-02 19:03:10|1989-11-16 14:03:10|9
60be1ba43bfa6jpg|2017-04-28 15:50:33|2019-02-22 06:50:33|9
60be1ba43bfd6jpg|2018-04-14 22:21:37|2021-08-28 14:21:37|9
60be1ba43bfdajpg|2019-07-15 04:31:04|2017-07-11 04:31:04|10
60be1ba43bfddjpg|2020-11-06 01:06:25|1989-08-16 09:06:25|10
60be1ba43bfe0jpg|2021-08-05 06:38:07|2021-12-25 15:38:07|11
60be1ba43bfe3jpg|2017-01-14 03:47:54|2020-08-03 20:47:54|12
60be1ba43bfe6jpg|1989-11-26 17:33:01|2018-11-07 22:33:01|13
60be1ba43bfe9jpg|2018-09-21 07:17:29|1989-10-05 03:17:29|14
60be1ba43bfebjpg|2017-03-13 09:42:04|2020-08-23 11:42:04|14
60be1ba43bfeejpg|2020-07-18 08:36:52|2018-10-04 12:36:52|15
60be1ba43bff1jpg|2021-01-21 05:20:29|2019-04-28 03:20:29|16
60be1ba43bff4jpg|2018-10-19 08:13:24|1989-10-16 18:13:24|17
60be1ba43bff7jpg|2017-06-15 07:49:44|2021-05-11 01:49:44|18
60be1ba43bff9jpg|2019-05-23 23:41:20|2019-08-26 13:41:20|18
60be1ba43bffcjpg|1989-02-17 03:13:27|1989-11-20 16:13:27|19
60be1ba43bfffjpg|2020-08-26 15:22:01|2018-08-21 17:22:01|20
60be1ba43c001jpg|2020-12-21 05:22:03|2017-04-04 15:22:03|21
60be1ba43c004jpg|2018-02-14 08:23:01|1989-03-26 06:23:01|21
60be1ba43c007jpg|2018-10-25 08:19:18|2021-07-06 08:19:18|21
60be1ba43c00ajpg|2017-11-28 07:22:03|2021-09-23 08:22:03|22
60be1ba43c00cjpg|2019-11-19 17:12:02|2019-05-23 03:12:02|23
60be1ba43c00fjpg|2017-02-26 00:43:21|2019-11-19 20:43:21|24
60be1ba43c012jpg|2017-10-27 01:05:53|1989-03-14 02:05:53|25
60be1ba43c015jpg|2019-06-18 08:06:07|1989-10-28 16:06:07|25
60be1ba43c017jpg|2021-08-19 02:01:32|2020-05-28 03:01:32|25
60be1ba43c01ajpg|2021-07-13 23:02:21|2017-07-05 03:02:21|25
60be1ba43c01djpg|1989-05-14 02:51:23|2020-03-24 01:51:23|25
60be1ba43c020jpg|2021-12-13 04:05:19|2021-04-16 03:05:19|25
60be1ba43c023jpg|2019-03-26 23:42:25|2021-08-03 20:42:25|26
60be1ba43c025jpg|1989-05-09 04:08:58|2019-10-23 00:08:58|26
60be1ba43c028jpg|2018-08-11 00:48:32|2019-05-08 08:48:32|26
60be1ba43c02bjpg|2018-07-14 08:38:02|2019-05-06 22:38:02|27
60be1ba43c02ejpg|2020-03-06 19:13:14|2019-09-18 18:13:14|28
60be1ba43c030jpg|1989-07-10 11:40:46|2019-08-03 01:40:46|28
60be1ba43c033jpg|2021-12-11 02:23:44|2019-08-09 01:23:44|28
60be1ba43c036jpg|2017-11-03 19:53:43|2021-02-13 17:53:43|29
60be1ba43c038jpg|2017-02-07 02:45:47|2021-09-20 09:45:47|29
60be1ba43c03bjpg|2020-07-28 20:56:59|2018-06-06 11:56:59|30
60be1ba43c040jpg|2019-06-20 16:42:30|2020-01-02 00:42:30|31
60be1ba43c042jpg|2020-05-27 03:39:41|2021-08-11 08:39:41|31
60be1ba43c045jpg|2017-08-07 12:11:03|2017-12-15 20:11:03|32
60be1ba43c048jpg|1989-04-28 01:19:49|2019-08-17 23:19:49|32
60be1ba43c04bjpg|2017-08-26 22:07:51|2019-02-25 16:07:51|33
60be1ba43c04djpg|1989-10-12 02:27:44|2020-11-10 22:27:44|34
60be1ba43c050jpg|2021-08-18 09:01:48|2020-01-08 07:01:48|35
60be1ba43c053jpg|2017-07-21 20:56:50|2018-02-24 20:56:50|36
60be1ba43c056jpg|1989-05-13 11:23:09|2020-01-20 11:23:09|37
60be1ba43c058jpg|2020-08-21 18:46:14|2017-04-14 10:46:14|37
60be1ba43c05bjpg|2020-04-08 11:14:54|2020-12-02 00:14:54|38
60be1ba43c05ejpg|2021-02-21 06:13:14|2018-08-21 03:13:14|38
60be1ba43c060jpg|2018-06-28 04:36:20|2020-09-28 15:36:20|39
60be1ba43c063jpg|2017-09-22 23:39:53|2021-05-27 20:39:53|39
60be1ba43c065jpg|2018-05-09 16:54:13|2021-06-03 16:54:13|39
60be1ba43c068jpg|2019-01-04 00:19:33|2017-05-18 08:19:33|40
60be1ba43c06bjpg|2019-04-12 21:19:37|2017-06-23 04:19:37|40
60be1ba43c06ejpg|2019-09-22 20:44:20|2021-10-23 12:44:20|40
60be1ba43c070jpg|2021-10-23 07:57:35|2019-02-23 21:57:35|40
60be1ba43c073jpg|2021-09-17 19:13:53|2020-05-27 06:13:53|40
60be1ba43c075jpg|2017-08-13 23:06:53|2019-08-03 00:06:53|41
60be1ba43c078jpg|2017-11-02 04:47:11|2018-07-05 03:47:11|42
60be1ba43c07bjpg|2017-05-11 23:04:25|2021-09-22 04:04:25|42
60be1ba43c07ejpg|2018-04-06 21:19:03|2021-09-16 21:19:03|42
60be1ba43c080jpg|2019-03-16 01:56:36|2021-04-03 18:56:36|42
60be1ba43c083jpg|2019-02-24 13:21:29|2019-10-28 09:21:29|43
60be1ba43c086jpg|2020-03-08 10:50:00|2018-06-22 15:50:00|44
60be1ba43c088jpg|1989-06-10 16:34:03|2020-11-10 18:34:03|45
60be1ba43c08bjpg|2018-04-20 10:29:46|2021-01-24 08:29:46|46
60be1ba43c08ejpg|2019-02-13 18:27:24|2021-10-16 07:27:24|47
60be1ba43c090jpg|2019-09-16 21:54:43|2018-07-21 22:54:43|48
60be1ba43c094jpg|2021-05-23 17:25:18|2019-06-18 00:25:18|49
60be1ba43c097jpg|2020-09-15 06:42:26|2019-03-25 13:42:26|50
60be1ba43c09ajpg|2020-05-02 20:14:35|2020-06-13 08:14:35|50
60be1ba43c09djpg|1989-02-25 15:11:22|2017-08-28 03:11:22|51
60be1ba43c09fjpg|2018-07-13 15:42:14|2019-02-23 14:42:14|52
60be1ba43c0a2jpg|2020-09-09 08:58:49|2019-07-11 18:58:49|53
60be1ba43c0a4jpg|1989-12-17 02:36:08|2021-10-04 10:36:08|54
60be1ba43c0a7jpg|2020-03-11 08:41:55|2017-10-16 17:41:55|55
60be1ba43c0aajpg|2020-12-18 19:59:08|2017-12-02 03:59:08|55
60be1ba43c0adjpg|2019-06-20 09:48:27|2020-11-10 17:48:27|56
60be1ba43c0b0jpg|2020-01-05 15:49:18|1989-11-27 05:49:18|56
60be1ba43c0b2jpg|1989-06-23 23:50:52|2017-09-08 02:50:52|56
60be1ba43c0b5jpg|2019-09-01 04:29:25|2020-10-25 00:29:25|56
60be1ba43c0b8jpg|2020-08-08 07:08:47|2021-05-22 20:08:47|57
60be1ba43c0bbjpg|2018-04-11 07:32:17|2018-06-21 12:32:17|58
60be1ba43c0bdjpg|2021-05-26 08:32:28|1989-02-04 12:32:28|58
60be1ba43c0c0jpg|1989-11-25 22:22:37|2019-07-16 04:22:37|58
60be1ba43c0c4jpg|2018-02-03 10:37:57|2019-08-02 08:37:57|58
60be1ba43c0c7jpg|2018-08-18 06:36:04|1989-03-17 08:36:04|58
60be1ba43c0cajpg|2019-02-12 23:31:52|2020-06-17 13:31:52|59",
sep="|",stringsAsFactors=TRUE, na.strings="unknown");
# Remove duplicates (Visual group defines duplicate)
df <-df[!duplicated(df$Visual.Group), ]
# Extract year
df$Created.Date.Year <- format(as.Date(df$Created.Date, format="%Y-%m-%d"), format="%Y");
df$Last.Accessed.Year <- format(as.Date(df$Last.Accessed, format="%Y-%m-%d"), format="%Y");
#set to data.table object
dt <- as.data.table(df)
#change column names to match desired names of groups
setnames(dt, old = c("Created.Date", "Last.Accessed"), new = c("Created date", "Last Accessed"))
#pivot longer (this column becomes the variable you use in aes(fill = ..) later on. Change it to whichever name you want to have as legend title
dt <- pivot_longer(dt, cols = c("Created date", "Last Accessed"), names_to = "Legend Title", values_to = "Date")
#plot
ggplot(dt, aes(x = Date, fill = `Legend Title`)) +
geom_bar(position = "dodge") +
theme_bw() + geom_text(stat = "count", aes(label = after_stat(count)), position = position_dodge(width = 1), vjust = -1)
```
perhaps this one? I switched to points and lines for better visualization.
library(tidyverse)
df %>%
pivot_longer(cols = 2:3) %>%
mutate(value = as.Date(value)) %>%
count(name, value) %>%
mutate(year = lubridate::year(value)) %>%
ggplot(aes(x = value, n, color =name)) +
geom_point() +
geom_line() +
scale_x_date(date_breaks = "3 month", date_labels = "%b") +
facet_grid(~year, scales = "free") +
theme_bw()
I have the following data frame:
df.test <- data.frame(
id = c("EIF3H", "USP9X", "USP44", "USP51", "USP15",
"USP48", "USP47", "USP43", "USPL1", "UCHL5", "USP50", "USP7",
"UCHL1", "USP11", "USP26", "PAN2", "VCPIP1", "USP46", "USP29",
"USP22", "USP49", "ZRANB1", "OTUD4", "OTUD7B", "USP54", "PSMD14",
"USP20", "USP6", "OTUD3", "USP39", "UCHL3", "USP19", "USP21",
"USP30", "TNFAIP3", "USP17L2", "USP32", "JOSD2", "PSMD7", "ATXN3L",
"SENP2", "STAMBPL1", "USP37", "USP35", "USP3", "ALG13", "USP45",
"Control", "USP9Y", "ATXN3", "OTUD6A", "USP42", "USP12", "MPND",
"USP40", "OTUD1", "USP31", "USP8", "USP13", "USP53", "USP34",
"USP17L5", "MYSM1", "USP36", "OTUD7A", "USP10", "USP2", "USP18",
"OTUB1", "EIF3F", "USP1", "USP14", "COPS5", "USP24", "USP4",
"CYLD", "COPS6", "STAMBP", "USP5", "OTUD6B", "BAP1", "USP25",
"YOD1", "USP28", "USP38", "USP41", "JOSD1", "UCK2", "USP16",
"USP27X", "BRCC3", "USP33", "OTUD5", "OTUB2"),
log.score = c(4.22265293851218, 3.03983376346562,
2.4139305569695, 2.32586482009754, 2.30391458369018, 2.19017103893211,
2.10803347738743, 2.10011933499842, 1.82596928196197, 1.79890343496053,
1.78330640083025, 1.58384231036782, 1.4480988629484, 1.4331502122056,
1.41965675282741, 1.37552194849409, 1.37548070593268, 1.3126672736385,
1.27123241483349, 1.25213781606166, 1.1643918571801, 1.14738583497561,
1.0423927129399, 1.03157776352028, 1.0279685056071, 0.953426802337995,
0.94104282122269, 0.929925173732472, 0.886424283199432, 0.886123467368948,
0.815961921373111, 0.811437095842094, 0.767054687254773,
0.754314635766764, 0.750654863646671, 0.728646377897516,
0.707899061519581, 0.703532261199885, 0.692546751828376,
0.684554481775416, 0.652104306506768, 0.642046105413661,
0.630116510664521, 0.62908000782908, 0.619354680809075, 0.614876544107784,
0.61293067306798, 0.606898831140113, 0.603504247802433, 0.578642901486857,
0.576246380387172, 0.549612309171809, 0.53101794103743, 0.513442014568548,
0.506304999011214, 0.492144128304169, 0.462596515841992,
0.454185884038717, 0.450163300207299, 0.434529992991809,
0.429725658566606, 0.42864060724616, 0.419896514762075, 0.409715596281838,
0.365946146577929, 0.363963683646553, 0.357614629472314,
0.352851847129221, 0.343470593766502, 0.313051079788499,
0.304614649499993, 0.291604597354374, 0.287030586811975,
0.272263598289704, 0.27175988000523, 0.265200170411153, 0.264528852761016,
0.244704590019742, 0.179680291853473, 0.154102353851514,
0.147800680553723, 0.127575655021633, 0.126051956011554,
0.1207205737776, 0.118712371231544, 0.11046860245595, 0.0939775902962627,
0.0673791277640148, 0.066320409857141, 0.0582650179118847,
0.0548860857591892, 0.0374554663486737, 0.0147532091971383,
0.0134163514896924),
neg.rank = 1:94)
From this data frame I made this plot:
library(ggplot2)
x <- "neg.rank"
p <- ggplot(df.test, aes_string(x = x, y = df.test$log.score)) +
geom_point()
I want to add labels to the top10 ids and I tried the following:
library(ggrepel)
library(dplyr)
p + geom_label_repel(data = df.test[df.test[[x]] %in% 1:10, ], aes_string(x = x, y = df$log.score, label = df.test$id))
But this gives me a More than one expression parsed error:
More than one expression parsed
Backtrace:
█
1. ├─ggrepel::geom_label_repel(...)
2. │ └─ggplot2::layer(...)
3. └─ggplot2::aes_string(x = x, y = df$log.score, label = df.test$id)
4. └─base::lapply(...)
5. └─ggplot2:::FUN(X[[i]], ...)
6. └─rlang::parse_expr(x)
I have no clue what is wrong with the code.
It is not working as you are inserting the vectors directly into your aes_string.
If you want yours to be working you need to be strict with your aes_string and really should only use strings:
p +
geom_label_repel(
data = df.test[df.test[[x]] %in% 1:10, ],
aes_string(x = x, y = "log.score", label = "id"),
)
I also added a "cleaner" solution. I changed your subsetting logic to use dplyr, as you are already loading the package anyway and changed all your aes_string() to aes().
library(ggplot2)
library(ggrepel)
library(dplyr)
ggplot(df.test, aes(x = neg.rank, y = log.score)) +
geom_point() +
geom_label_repel(
data = df.test %>% slice_min(neg.rank, n = 10),
aes(label = id),
max.overlaps = 10,
xlim = c(10, NA),
ylim = c(3, NA),
direction = "x"
)
Cheers
Hannes
I am required to re-create the visualization but filter the data to keep only the businesses that had terms less than 360 months.
The data I am using is the SBA data from this link:
https://amstat.tandfonline.com/doi/full/10.1080/10691898.2018.1434342
library('magrittr')
library(dplyr)
library(tidyr)
library(ggplot2)
sba2 <- sba_data %>%
mutate(default_binary = ifelse(MIS_Status=="CHGOFF","Paid in Full","Default"), daysterm = Term*30, xx = as.Date(sba_data$DisbursementDate, format="%Y-%m-%d") + daysterm, recession_binary = ifelse(xx >= "2007-12-01" & xx <="2009-06-30","Active during Recession","Not Active during Recession"), smaller_business_binary = ifelse(NoEmp < 30, "Very Small Biz", "Not Very Small Biz"), business_length = ifelse(Term < 360, "Short Business", "Long Business"))
table(sba2$business_length)
sba_3 <- sba2 %>%
group_by(recession_binary, default_binary) %>%
summarise(frequencies=n()) %>%
drop_na() %>%
mutate(percents = round(frequencies/sum(frequencies),2))
ggplot(data = sba_3 ) +
geom_col(mapping = aes(x = recession_binary, y = percents, fill = default_binary)) +
coord_flip() +
scale_fill_manual(breaks = c("Default", "Paid in Full"),
values=c(rgb(232/255,74/255,39/255), rgb(19/255,41/255,75/255))) +
scale_y_continuous(labels = scales::percent)
This is my code so far to recreate the visualization. However, I am unsure how to filter the data to only keep business with a term less than 360 months. I had created the variable business_length when mutating sba2, but am not sure what the next steps are. Any help would be greatly appreciated, thanks!
Something like this?
sba_3 <- sba2 %>%
filter(Term < 360) %>%
group_by(recession_binary, default_binary) %>%
summarise(frequencies=n()) %>%
drop_na() %>%
mutate(percents = round(frequencies/sum(frequencies),2))
I have the following matrix :
df1 <- read.table(text= 'Sample Al2O3_D1 CaO_D1 Fe2O3_D1 K2O_D1 SiO2_D1 TiO2_D1 Al2O3_D1b0 CaO_D1b0 Fe2O3_D1b0 K2O_D1b0 SiO2_D1b0 TiO2_D1b0 Al2O3_D2 CaO_D2 Fe2O3_D2 K2O_D2 SiO2_D2 TiO2_D2 Al2O3_D2b0 CaO_D2b0 Fe2O3_D2b0 K2O_D2b0 SiO2_D2b0 TiO2_D2b0
BIL1 18.527771 18.256632 6.56251 8.342669 4.374867 0.5842755 17.7422245 23.987872 6.238913 6.780187 5.211082 0.1722543 14.524362 11.540785027 6.567724 11.59751 2.716793 0.148641 21.5237007 32.4114021 6.802355 12.696409 2.418464 0.9386197
Ha11 4.397232 12.888497 34.33309 52.961988 11.131223 45.1434655 15.0384636 12.980365 30.093978 54.002291 3.393567 38.6145158 12.323475 17.028706310 38.690775 49.06582 20.080664 45.619040 3.5297936 16.5442327 41.180170 47.440273 24.276975 44.3668208
Ha137 103.000052 2.212967 51.25095 306.746410 121.806659 63.6579611 212.8800243 2.165292 18.769017 364.236920 62.013419 21.9816389 106.235891 1.269353476 5.057160 287.15363 55.081696 58.204002 161.4670946 1.2884466 34.972412 298.504372 104.189560 31.8284467
Ha171 90.591557 1.569013 67.93309 232.845227 127.158291 75.5793762 254.3307398 1.513897 27.405290 310.109817 42.146396 27.6889288 79.012056 0.145186508 3.886563 222.66687 7.391477 68.673164 191.7846982 0.2314552 42.085088 246.272719 80.267907 36.9812088
Ha21 7.097864 17.014437 45.15964 69.600986 13.324667 55.9935294 25.9518750 17.074982 40.215454 74.263048 2.894586 46.7076167 15.344770 20.336227579 46.986192 62.41907 18.820986 55.880410 10.5328447 19.9025608 50.333141 60.448031 25.283637 52.3899333
Ha28a 14.276762 10.891896 36.92640 93.706836 22.456851 53.3221147 33.2916429 10.929970 31.081099 98.541650 11.519390 43.0020990 23.122859 13.698527956 38.803813 85.77801 28.915269 53.137565 17.2874734 13.2874359 42.799188 83.485379 35.607017 49.1309903
Ha45 8.755274 16.194970 23.72806 24.662651 10.998789 33.8922508 9.9868429 16.441356 22.187580 23.786921 6.279046 30.1799502 14.205216 22.219296703 30.537651 24.31487 22.675330 34.744338 4.7672324 21.8993271 30.730442 23.807887 24.471693 35.2918163
Ha56 2.519377 19.291306 17.78027 14.689078 1.340254 26.7134525 0.3009044 19.692186 16.525441 13.056810 1.866104 25.1075378 5.078764 25.877687826 24.668074 16.58434 12.172266 27.542356 0.9123158 25.9770408 24.642464 16.954296 13.036683 28.7758434
Ha78a 16.630011 10.518633 36.20753 65.697116 18.732162 49.0261161 31.7415436 10.576057 31.740250 68.840011 9.396106 41.7404661 25.679895 13.894132835 40.025832 59.56926 26.868566 49.336063 17.2903714 13.4394515 42.754641 57.575556 32.258478 47.4607437
Ha91 47.531258 6.963291 44.16573 120.753235 57.927836 57.5642663 92.4665900 6.947703 35.101718 135.376499 34.582463 39.3617521 56.780675 7.732582039 39.817328 109.13196 49.911602 56.081569 64.6430022 7.5310163 47.001601 108.587613 66.871031 46.5091579
L110 32.616500 6.162218 48.84669 204.508488 51.576478 64.5594220 100.1659655 6.133002 32.384991 232.810812 20.687400 40.3856100 35.670427 6.239853155 31.080776 188.34130 26.920909 61.901493 67.6463355 6.1250955 45.472784 190.557631 51.085145 47.6973747
L28d 213.963550 4.226734 91.60353 263.427318 250.950733 98.6845750 638.5723017 4.165268 36.270331 529.076984 70.311398 0.0038225 154.434579 2.280303654 3.936042 300.61284 42.674167 82.568998 501.6810607 2.4456430 49.319737 419.089754 116.983089 13.1846725
SARM41 9.206072 8.542555 16.87283 1.652141 6.469613 4.8801782 9.9053176 15.636966 17.675264 3.357829 7.712771 5.6633793 5.816894 1.068768333 9.466277 6.61795 1.658162 3.989925 12.5027313 25.0161949 9.891560 7.313323 1.511116 2.3360493', header=T, stringsAsFactors = F)
These are chemical analysis for different samples obtained with different techniques (techniques are D1, D1b0, D2, D2b0). So for each sample, I have an analysis of different elements (e.g.) Al2O3 made with 4 techniques (Al2O3_D1, Al2O3_D1b0, Al2O3_D2, Al2O3_D2bO)
I want to make boxplot of the variations associated with each element and each technique, with the mean value obtained for each element and each technique in a facet_wrap, so I made the following code:
df1 %>%
pivot_longer(cols = -Sample) %>%
separate(name, c("key","number"), sep = "_") %>%
group_by(number) %>%
ggplot(aes(x=number, y=value, fill = number)) +
geom_boxplot() +
scale_fill_brewer(palette = "RdBu") +
scale_y_log10(limits = c(0.01, NA)) +
theme(legend.position="bottom") +
stat_summary(aes(y = value, label = round(..y.., 2)),
fun = mean, geom = "text", vjust=10,
position = position_dodge(0.9)) +
facet_wrap(key~., ncol=2)
They are two problems with this code:
it is giving me a mean value for something else than what I want. I should have for Al2O3: D1 135.32, D1b0 390.2, D2 100.29, D2b0 307.55
Instead, I have D1 1.3, D1b0 1.53, D2 1.4, D2b0 1.38
I would like all the mean values to be aligned on the same line (e.g. along 1e-1 line) on top of their respective technique but they are not aligned.
Thanks a lot for your help, Anne-Christine
You can use something like the following
df1 %>%
pivot_longer(cols = -Sample) %>%
separate(name, c("key","number"), sep = "_") %>%
group_by(number) %>%
ggplot(aes(x=number, y=value, fill = number)) +
geom_boxplot() +
scale_fill_brewer(palette = "RdBu") +
theme(legend.position="bottom") +
stat_summary(aes(y = value, label = round(..y.., 2)), fun = mean, geom = "text",colour="darkblue") +
facet_wrap(key~., ncol=2, scales = "free")
I will just piggyback off Bappa's answer and your updated code (I don't have enough rep to just comment)
df1 %>%
pivot_longer(cols = -Sample) %>%
separate(name, c("key","number"), sep = "_") %>%
group_by(key, number) %>%
mutate(mean = mean(value, na.rm = T)) %>%
ggplot(aes(x=number, y=value, fill = number)) +
geom_boxplot() +
scale_fill_brewer(palette = "RdBu") +
scale_y_log10() +
geom_text(aes(label = round(mean, 2), y = 1e-01)) +
facet_wrap(key~., ncol=2)
By getting the mean value before creating the plot and log transforming, you should be able to get around the issue with the means you had. The numbers align with those Bappa displayed.
Using geom_text, you can position the labels wherever you like.
I have the following 3 way table I created in R.
with(dataset, ftable(xtabs(count ~ dos + sex + edu)))
The output looks like
edu high low medium unknown
dos sex
five-to-ten-years female 247776 44916 127133 23793
male 225403 37858 147821 20383
five-years-or-less female 304851 58018 182152 33649
male 253977 55720 193621 28972
more-than-ten-years female 709303 452605 539403 165675
male 629162 309193 689299 121336
native-born female 1988476 1456792 2094297 502153
male 1411509 1197395 2790522 395953
unknown female 57974 75480 73204 593141
male 40176 57786 93108 605542
I want to rename the variables and format the table so that I can include it in a report. I know that I can use dnn to rename the variables, but are there any other recommendations to rename the variables? And to format the table (similar to using kable)?
You could convert the output to a text matrix using the following function, after which you can style with kable however you choose:
ftab_to_matrix <- function(ft)
{
row_vars <- attr(ft, "row.vars")
for(i in seq_along(row_vars)){
row_vars[[i]] <- c(names(row_vars[i]), row_vars[[i]])}
rowvar_widths <- sapply(row_vars, function(x) max(nchar(x))) + 1
col_vars <- attr(ft, "col.vars")
rowvar_widths <- c(1, cumsum(c(rowvar_widths, max(nchar(names(col_vars))))))
ft_text <- capture.output(print(ft))
row_cols <- sapply(seq_along(rowvar_widths)[-1], function(x)
substr(ft_text, rowvar_widths[x - 1], rowvar_widths[x]))
ft_text <- substr(ft_text, rowvar_widths[length(rowvar_widths)] + 2, 100)
ft_breaks <- c(1, cumsum(lapply(strsplit(ft_text[length(ft_text)], "\\d "),
function(x) nchar(x) + 2)[[1]]))
col_cols <- sapply(seq_along(ft_breaks)[-1], function(x)
substr(ft_text, ft_breaks[x - 1], ft_breaks[x]))
trimws(cbind(row_cols, col_cols))
}
So, for example, using my example data from your last question, you could do something like:
my_tab <- with(`3waydata`, ftable(xtabs(count ~ duration + sex + education)))
as_image(kable_styling(kable(ftab_to_df(my_tab))), file = "kable.png")
Might have been easier had you given the full picture when you asked your first question... You could use gt to make fancy tables for reports. This is an edited version more fully demonstrating some capabilities.
library(dplyr)
library(gt)
way3data <- data %>%
group_by(duration, education, sex) %>%
summarise(count = sum(number)) %>%
ungroup
# Reorder with select and Titlecase with stringr
longer <- tidyr::pivot_wider(way3data,
values_from = count,
names_from = "education") %>%
select(duration, sex, high, medium, low, unknown) %>%
rename_with(stringr::str_to_title)
# Demonstrating some of the features of gt
# obviously could have done some of this
# to the original dataframe
myresults <- longer %>%
group_by(Duration) %>%
gt(rowname_col = "Sex") %>%
row_group_order(
groups = c("native-born",
"more-than-ten-years",
"five-to-ten-years",
"five-years-or-less",
"unknown")
) %>%
tab_spanner(label = "Education",
columns = matches("High|Low|Medium|Unknown")) %>%
tab_stubhead(label = "Duration or something") %>%
tab_style(
style = cell_text(style = "oblique", weight = "bold"),
locations = cells_row_groups()) %>%
tab_style(
style = cell_text(align = "right", style = "italic", weight = "bold"),
locations = cells_column_labels(
columns = vars(High, Low, Medium, Unknown)
)) %>%
tab_style(
style = cell_text(align = "right", weight = "bold"),
locations = cells_stub()) %>%
tab_header(
title = "Fancy table of counts with Duration, Education and Gender") %>%
tab_source_note(md("More information is available at https://stackoverflow.com/questions/62284264."))
# myresults
# Can save in other formats including .rtf
myresults %>%
gtsave(
"tab_1.png", expand = 10
)
You can read about all the formatting choices here
Data compliments of Allan
set.seed(69)
data <- data.frame(education = sample(c("high","low","medium","unknown"), 600, T),
sex = rep(c("Male", "Female"), 300),
duration = sample(c("unknown", "native-born",
"five-years-or-less", "five-to-ten-years",
"more-than-ten-years"), 600, T),
number = rpois(600, 10))