R: How to add vertical line (geom_vline) on plotly (ts_plot)? - ggplot2
I have weekly time series for 2 variables. Now I need to add 2 vertical lines (geom_vline) at "2019-11-10" and "2020-04-26 date points.
structure(list(week = structure(c(18119, 18126, 18133, 18140,
18147, 18154, 18161, 18168, 18175, 18182, 18189, 18196, 18203,
18210, 18217, 18224, 18231, 18238, 18245, 18252, 18259, 18266,
18273, 18280, 18287, 18294, 18301, 18308, 18315, 18322, 18329,
18336, 18343, 18350, 18357, 18364, 18371, 18378, 18385, 18392,
18399, 18406, 18413, 18420, 18427, 18434, 18441, 18448, 18455,
18462, 18469, 18476, 18483, 18490, 18497, 18504, 18511, 18518,
18525, 18532, 18539, 18546, 18553, 18560, 18567, 18574, 18581,
18588, 18595, 18602, 18609, 18616, 18623, 18630, 18637, 18644,
18651, 18658, 18665, 18672, 18679, 18686, 18693, 18700, 18707,
18714, 18721, 18728, 18735, 18742, 18749, 18756, 18763, 18770,
18777, 18784, 18791, 18798, 18805, 18812, 18819, 18826, 18833,
18840, 18847, 18854, 18861, 18868, 18875, 18882, 18889, 18896,
18903, 18910, 18917, 18924, 18931, 18938, 18945, 18952, 18959,
18966, 18973, 18980, 18987, 18994, 19001, 19008, 19015, 19022,
19029, 19036, 19043, 19050, 19057, 19064, 19071, 19078, 19085,
19092, 19099, 19106, 19113, 19120, 19127, 19134, 19141, 19148,
19155, 19162, 19169, 19176, 19183, 19190, 19197, 19204, 19211,
19218, 19225, 19232, 19239, 19246, 19253, 19260, 19267), class = "Date"),
X = c(6L, 104L, 123L, 82L, 67L, 108L, 89L, 1153L, 311L, 346L,
220L, 219L, 184L, 257L, 585L, 342L, 197L, 184L, 351L, 278L,
120L, 204L, 206L, 146L, 216L, 186L, 171L, 200L, 198L, 170L,
192L, 139L, 136L, 414L, 256L, 306L, 281L, 221L, 271L, 311L,
315L, 277L, 342L, 394L, 493L, 855L, 1617L, 954L, 1143L, 1031L,
692L, 380L, 378L, 493L, 381L, 706L, 546L, 653L, 447L, 1004L,
499L, 442L, 926L, 564L, 568L, 755L, 581L, 572L, 780L, 601L,
739L, 563L, 300L, 454L, 727L, 733L, 673L, 648L, 614L, 754L,
827L, 719L, 874L, 692L, 752L, 536L, 658L, 817L, 913L, 813L,
844L, 811L, 977L, 877L, 818L, 673L, 1419L, 809L, 818L, 709L,
577L, 802L, 508L, 536L, 663L, 782L, 634L, 665L, 583L, 685L,
908L, 1013L, 903L, 965L, 981L, 1030L, 1205L, 1197L, 956L,
936L, 901L, 707L, 565L, 384L, 341L, 529L, 510L, 597L, 610L,
587L, 715L, 777L, 638L, 619L, 617L, 677L, 1118L, 1173L, 1025L,
655L, 1006L, 1129L, 811L, 773L, 796L, 993L, 891L, 900L, 1072L,
1182L, 947L, 743L, 759L, 616L, 584L, 613L, 597L, 734L, 671L,
1119L, 906L, 825L, 1109L, 1085L, 913L), Y = c(0L, 23L, 50L,
35L, 38L, 38L, 43L, 173L, 128L, 134L, 115L, 103L, 104L, 122L,
168L, 186L, 158L, 136L, 122L, 91L, 87L, 73L, 105L, 97L, 96L,
84L, 121L, 108L, 83L, 106L, 108L, 107L, 96L, 151L, 128L,
135L, 148L, 133L, 114L, 150L, 175L, 172L, 182L, 185L, 181L,
224L, 451L, 369L, 399L, 377L, 325L, 259L, 245L, 268L, 284L,
338L, 375L, 383L, 307L, 318L, 341L, 290L, 401L, 333L, 336L,
404L, 406L, 333L, 372L, 372L, 388L, 236L, 162L, 264L, 378L,
390L, 350L, 327L, 341L, 359L, 462L, 413L, 421L, 400L, 424L,
283L, 377L, 459L, 478L, 482L, 411L, 416L, 522L, 557L, 502L,
479L, 631L, 533L, 514L, 442L, 477L, 432L, 378L, 365L, 443L,
407L, 384L, 451L, 381L, 435L, 603L, 612L, 685L, 567L, 603L,
576L, 564L, 643L, 671L, 722L, 695L, 463L, 328L, 228L, 160L,
235L, 282L, 346L, 332L, 340L, 396L, 433L, 354L, 356L, 355L,
367L, 462L, 445L, 454L, 355L, 566L, 628L, 491L, 517L, 429L,
569L, 595L, 520L, 601L, 646L, 630L, 590L, 513L, 465L, 390L,
356L, 356L, 417L, 420L, 443L, 450L, 482L, 540L, 611L, 572L
)), row.names = c(NA, -165L), class = c("tbl_df", "tbl",
"data.frame"))
Firstly I convert it into xts object and next use ts_plot() for visualization
#Create xts object
df.xts <- xts(df[, 2:3], order.by = df.w$week)
#plot
library(TSstudio)
ts_plot(df.xts,
slider = TRUE)
I tried the following codes, but it give me the "NULL" in the output
+ geom_vline(xintercept = as.Date("2020-03-01"))
or
+ geom_vline(xintercept = as.POSIXct("2020-03-01"))
Edit
You could use the add_segments function from plotly. You could also add multiple lines by specifying vectors like this:
library(xts)
library(TSstudio)
library(dplyr)
library(plotly)
#Create xts object
df.xts <- xts(df[, 2:3], order.by = df$week)
# plot
ts_plot(df.xts) %>%
add_segments(y = c(0, 0, 0),
x = as.Date(c("2020-03-01", "2020-06-01", "2020-08-01")),
yend = c(1500, 1500, 1500),
xend = as.Date(c("2020-03-01", "2020-06-01", "2020-08-01")),
color = c('red', 'green', 'purple'),
showlegend = FALSE)
Created on 2022-10-12 with reprex v2.0.2
Because you are using xts data format, you can use the function addEventLines to add some vertical lines. Here is a reproducible example:
library(xts)
library(rtweet)
#Create xts object
df.xts <- xts(df[, 2:3], order.by = df$week)
# plot
plot(df.xts)
addEventLines(xts('', as.Date("2020-03-01")), pos = 2, srt = 90, col = 'blue')
Created on 2022-10-11 with reprex v2.0.2
Related
Colors don't stick when lollipop plot is run
I have created a lollipop chart that I love. However, when the code runs to create the plot, the colors of the lines, segments, and points all change from what they were set to. Everything else runs great, so this isn't the end of the world, but I am trying to stick with a color palette throughout a report.
The colors should be this ("#9a0138", and "#000775" specifically):
But come out like this:
Any ideas?
Here is the data:
TabPercentCompliant <- structure(list(Provider_ShortName = c("ProviderA", "ProviderA", "ProviderA", "ProviderB",
"ProviderB", "ProviderB", "ProviderC", "ProviderC", "ProviderC", "ProviderD"), SubMeasureID = c("AMM2", "FUH7", "HDO", "AMM2", "FUH7", "HDO", "AMM2", "FUH7", "HDO", "AMM2"), AdaptedCompliant = c(139, 2, 117, 85, 1, 33, 36, 2, 22, 43), TotalEligible = c(238, 27, 155, 148, 10, 34, 61, 3, 24, 76), PercentCompliant = c(0.584033613445378, 0.0740740740740741, 0.754838709677419, 0.574324324324324, 0.1, 0.970588235294118, 0.590163934426229, 0.666666666666667, 0.916666666666667, 0.565789473684211 ), PercentTotalEligible = c(0.00516358587173479, 0.00058578495183546, 0.00336283953831467, 0.00321096936561659, 0.000216957389568689, 0.000737655124533542, 0.001323440076369, 6.50872168706066e-05, 0.000520697734964853, 0.00164887616072203), ClaimsAdjudicatedThrough = structure(c(19024, 19024, 19024, 19024, 19024, 19024, 19024, 19024, 19024, 19024 ), class = "Date"), AdaptedNCQAMean = c(0.57, 0.39, 0.93, 0.57, 0.39, 0.93, 0.57, 0.39, 0.93, 0.57), PerformanceLevel = c(0.0140336134453782, -0.315925925925926, -0.175161290322581, 0.00432432432432439, -0.29, 0.0405882352941176, 0.0201639344262295, 0.276666666666667, -0.0133333333333334, -0.00421052631578944)), row.names = c(NA, -10L), class = c("tbl_df", "tbl", "data.frame"))
VBP_Report_Date = "2022-09-01"
And the code for the plot:
Tab_PercentCompliant %>%
filter(ClaimsAdjudicatedThrough == VBP_Report_Date) %>%
ggplot(aes(x = Provider_ShortName,
y = PercentCompliant)
) +
geom_line(aes(x = Provider_ShortName,
y = AdaptedNCQAMean,
group = SubMeasureID,
color = "#9a0138",
size = .001)
) +
geom_point(aes(color = "#000775",
size = (PercentTotalEligible)
)
) +
geom_segment(aes(x = Provider_ShortName,
xend = Provider_ShortName,
y = 0,
yend = PercentCompliant,
color = "#000775")
)+
facet_grid(cols = vars(SubMeasureID),
scales = "fixed",
space = "fixed")+
theme_classic()+
theme(legend.position = "none") +
theme(panel.spacing = unit(.5, "lines"),
panel.border = element_rect(
color = "black",
fill = NA,
linewidth = .5),
panel.grid.major.y = element_line(
color = "gray",
linewidth = .5),
axis.text.x = element_text(
angle = 65,
hjust=1),
axis.title.x = element_blank(),
axis.line = element_blank(),
strip.background = element_rect(
color = NULL,
fill = "#e1e7fa"))+
scale_y_continuous(labels = scales::percent)+
labs(title = "Test",
subtitle = "Test",
caption = "Test")
If you have an aesthetic constant, it is often easier / better to have it "outside" your aes call. If you want to have a legend for your color, then you need to keep it "inside", but you will need to manually set the colors with + scale_color/fill_manual. I've had to cut down quite a lot in your code to make it work. I've also removed bits that are extraneous to the problem. I've removed line size = 0.001 or the line wasn't visible. I've removed the weird filter step or the plot wasn't possible. Tips: when defining a global aesthetic with ggplot(aes(x = ... etc), you don't need to specify this aesthetic in each geom layer (those aesthetics will be inherited)- makes a more concise / readable code. library(ggplot2) ggplot(TabPercentCompliant, aes(x = Provider_ShortName, y = PercentCompliant)) + geom_line(aes(y = AdaptedNCQAMean, group = SubMeasureID), color = "#9a0138") + geom_point(aes(size = PercentTotalEligible), color = "#000775") + geom_segment(aes(xend = Provider_ShortName, y = 0, yend = PercentCompliant), color = "#000775") + facet_grid(~SubMeasureID) + theme(strip.background = element_rect(color = NULL, fill = "#e1e7fa"))
Here is the final code. Thanks again tjebo! # Lollipop Chart ---------------------------------------------------------- Tab_PercentCompliant %>% filter(ClaimsAdjudicatedThrough == VBP_Report_Date) %>% ggplot(aes(x = Provider_ShortName, y = PercentCompliant) ) + geom_line(aes(y = AdaptedNCQAMean, group = SubMeasureID), color = "#9a0138" ) + geom_point(aes(size = PercentTotalEligible), color = "#000775", ) + geom_segment(aes(xend = Provider_ShortName, y = 0, yend = PercentCompliant), color = "#000775" )+ facet_grid(cols = vars(SubMeasureID) )+ theme_bw()+ theme(legend.position = "none", axis.text.x = element_text( angle = 65, hjust=1), axis.title.x = element_blank(), axis.line = element_blank(), strip.background = element_rect( fill = "#e1e7fa"))+ scale_y_continuous(labels = scales::percent)+ labs(title = "Test", subtitle = "Test", caption = "Test")
How to add count (n) / summary statistics as a label to ggplot2 boxplots?
I am new to R and trying to add count labels to my boxplots, so the sample size per boxplot shows in the graph.
This is my code:
bp_east_EC <-total %>% filter(year %in% c(1977, 2020, 2021, 1992),
sampletype == "groundwater",
East == 1,
#EB == 1,
#N59 == 1,
variable %in% c("EC_uS")) %>%
ggplot(.,aes(x = as.character(year), y = value, colour = as.factor(year))) +
theme_ipsum() +
ggtitle("Groundwater EC, eastern Curacao") +
theme(plot.title = element_text(hjust = 0.5, size=14)) +
theme(legend.position = "none") +
labs(x="", y="uS/cm") +
geom_jitter(color="grey", size=0.4, alpha=0.9) +
geom_boxplot() +
stat_summary(fun.y=mean, geom="point", shape=23, size=2) #shows mean
I have googled a lot and tried different things (with annotate, with return functions, mtext, etc), but it keeps giving different errors. I think I am such a beginner I cannot figure out how to integrate such suggestions into my own code.
Does anybody have an idea what the best way would be for me to approach this?
I would create a new variable that contained your sample sizes per group and plot that number with geom_label. I've generated an example of how to add count/sample sizes to a boxplot using the iris dataset since your example isn't fully reproducible. library(tidyverse) data(iris) # boxplot with no label ggplot(iris, aes(x = Species, y = Sepal.Length, fill = Species)) + geom_boxplot() # boxplot with label iris %>% group_by(Species) %>% mutate(count = n()) %>% mutate(mean = mean(Sepal.Length)) %>% ggplot(aes(x = Species, y = Sepal.Length, fill = Species)) + geom_boxplot() + geom_label(aes(label= count , y = mean + 0.75), # <- change this to move label up and down size = 4, position = position_dodge(width = 0.75)) + geom_jitter(alpha = 0.35, aes(color = Species)) + stat_summary(fun = mean, geom = "point", shape = 23, size = 6)
Multi-row x-axis labels with breaks in R
I would like to add 2-row x-axis labels on my line plot, but not sure how to also incorporate the continuous labels and breaks I have for my 1st x-axis (Column "CYR" - short for calendar year). I'd like to have the 2nd axis (WYR) start half-way between the first label and the second (WYR = 2010 starts between CYR = 2009 -> 2010). I also wasn't sure how to add 2 x-axis titles either, maybe at the beginning of each x-axis row?
My data:
> dput(wet_pivot)
structure(list(WYR = c("WR_2010", "WR_2011", "WR_2012", "WR_2013",
"WR_2014", "WR_2015", "WR_2016", "WR_2017", "WR_2018", "WR_2019",
"WR_2020", "WR_2021", "WR_2022"), CYR = c(2009, 2010, 2011, 2012,
2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021), Season = structure(c(2L,
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("DRY",
"WET"), class = "factor"), N = c(59L, 63L, 69L, 70L, 72L, 71L,
71L, 72L, 71L, 68L, 70L, 48L, 72L), n_mean = c(0.00696806934430411,
0.000649730847004026, 0.00288256551918419, 0.01141088388474,
0.000536174103147671, 0.00349584646220785, 0.000482925207291882,
0.00245359625194744, 0.00292096956686587, 0.00252817293686805,
0.00196286772014134, 0.00501799463867351, 0.00132244297252478
), n_median = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), sd = c(0.030946706350869,
0.00248965525641742, 0.0100973832581282, 0.051577934580242, 0.00331468784320076,
0.0266064084754242, 0.00212505905295283, 0.00675243933898364,
0.0119729983336735, 0.00639785127193391, 0.00930625647382774,
0.0136275258272549, 0.00543420856675111), se = c(0.00402891799826298,
0.000313667078988821, 0.00121558209746373, 0.0061647423020683,
0.000390639708573979, 0.00315759975690469, 0.000252198110662322,
0.000795782607691024, 0.00142093348159893, 0.000775853428563995,
0.00111231039833223, 0.00196696392618855, 0.000640427621321956
)), row.names = c(NA, -13L), class = "data.frame")
My attempt:
years <- seq(2009,2021,1)
labs <- seq(2009,2021,by=1)
myplot <- ggplot(wet_pivot, aes(x = CYR, y = n_mean)) +
geom_errorbar(aes(ymin=n_mean-se, ymax=n_mean+se), width=.2, color = "black") +
geom_point(color = "black", shape = 1, size = 2) +
geom_line(color = "black") +
scale_y_continuous(limits = c(0, 0.04), expand = expansion(mult = c(0, 0.05))) +
scale_x_continuous(breaks= years, labels = labs)
myplot +
annotate(geom = "text",
x = 1:nrow(wet_pivot),
y = min(wet_pivot$n_mean),
label = labs,
vjust = 3.5) +
annotate(geom = "text",
x = 1:nrow(wet_pivot),
y = min(wet_pivot$n_mean),
label = wet_pivot$WYR,
vjust = 5)
You indeed can use text annotations to substitute for x-axis labels. A few recommendations:
Set y = -Inf to automatically place text as bottom, independent of whatever data is on the plot. vjust can indeed be used to place it further down.
You'd need coord_cartesian(clip = "off") to actually show the text.
You can place 'titles' with an extra annotation layer, with x = -Inf to place it on the left.
I used the above for the example below. Maybe the text is still to big, so you could set the 8.8 / .pt to something smaller. (The / .pt translates between mm, which geom_text() uses, to points, which is used in theme)
library(ggplot2)
# wet_pivot <- structure(...) # omitted for previty
ggplot(wet_pivot, aes(x = CYR, y = n_mean)) +
geom_errorbar(aes(ymin=n_mean-se, ymax=n_mean+se), width=.2, color = "black") +
geom_point(color = "black", shape = 1, size = 2) +
geom_line(color = "black") +
scale_y_continuous(limits = c(0, 0.04), expand = expansion(mult = c(0, 0.05))) +
scale_x_continuous(breaks= years, labels = ~ rep("", length(.x))) +
annotate(geom = "text",
x = wet_pivot$CYR,
y = -Inf,
label = labs,
size = 8.8 / .pt,
vjust = 2.5) +
annotate(geom = "text",
x = wet_pivot$CYR,
y = -Inf,
label = wet_pivot$WYR,
size = 8.8 / .pt,
vjust = 4) +
# Titles
annotate(geom = "text",
x = -Inf,
y = -Inf,
label = c("CYR", "WYR"),
vjust = c(2.5, 4), hjust = 1,
size = 8.8 / .pt
) +
coord_cartesian(clip = "off") +
theme(
# Make extra space between axis ticks and axis title
axis.text.x.bottom = element_text(margin = margin(t = 8.8, b = 8.8))
)
Created on 2022-05-19 by the reprex package (v2.0.1)
What is Julia's equivalent ggplot code of R's?
I would like to plot a sophisticated graph in Julia. The code below is in Julia's version using ggplot.
using CairoMakie, DataFrames, Effects, GLM, StatsModels, StableRNGs, RCall
#rlibrary ggplot2
rng = StableRNG(42)
growthdata = DataFrame(; age=[13:20; 13:20],
sex=repeat(["male", "female"], inner=8),
weight=[range(100, 155; length=8); range(100, 125; length=8)] .+ randn(rng, 16))
mod_uncentered = lm(#formula(weight ~ 1 + sex * age), growthdata)
refgrid = copy(growthdata)
filter!(refgrid) do row
return mod(row.age, 2) == (row.sex == "male")
end
effects!(refgrid, mod_uncentered)
refgrid[!, :lower] = #. refgrid.weight - 1.96 * refgrid.err
refgrid[!, :upper] = #. refgrid.weight + 1.96 * refgrid.err
df= refgrid
ggplot(df, aes(x=:age, y=:weight, group = :sex, shape= :sex, linetype=:sex)) +
geom_point(position=position_dodge(width=0.15)) +
geom_ribbon(aes(ymin=:lower, ymax=:upper), fill="gray", alpha=0.5)+
geom_line(position=position_dodge(width=0.15)) +
ylab("Weight")+ xlab("Age")+
theme_classic()
However, I would like to modify this graph a bit more. For example, I would like to change the scale of the y axis, the colors of the ribbon, add some error bars, and also change the text size of the legend and so on. Since I am new to Julia, I am not succeding in finding the equivalent language code for these modifications. Could someone help me translate this R code below of ggplot into Julia's language?
t1= filter(df, sex=="male") %>% slice_max(df$weight)
ggplot(df, aes(age, weight, group = sex, shape= sex, linetype=sex,fill=sex, colour=sex)) +
geom_line(position=position_dodge(width=0.15)) +
geom_point(position=position_dodge(width=0.15)) +
geom_errorbar(aes(ymin = lower, ymax = upper),width = 0.1,
linetype = "solid",position=position_dodge(width=0.15))+
geom_ribbon(aes(ymin = lower, ymax = upper, fill = sex, colour = sex), alpha = 0.2) +
geom_text(data = t1, aes(age, weight, label = round(weight, 1)), hjust = -0.25, size=7,show_guide = FALSE) +
scale_y_continuous(limits = c(70, 150), breaks = seq(80, 140, by = 20))+
theme_classic()+
scale_colour_manual(values = c("orange", "blue")) +
guides(color = guide_legend(override.aes = list(linetype = c('dotted', 'dashed'))),
linetype = "none")+
xlab("Age")+ ylab("Average marginal effects") + ggtitle("Title") +
theme(
axis.title.y = element_text(color="Black", size=28, face="bold", hjust = 0.9),
axis.text.y = element_text(face="bold", color="black", size=16),
plot.title = element_text(hjust = 0.5, color="Black", size=28, face="bold"),
legend.title = element_text(color = "Black", size = 13),
legend.text = element_text(color = "Black", size = 16),
legend.position="bottom",
axis.text.x = element_text(face="bold", color="black", size=11),
strip.text = element_text(face= "bold", size=15)
)
As I commented before, you can use R-strings to run R code. To be clear, this isn't like your post's approach where you piece together many Julia objects that wrap many R objects, this is RCall converting a Julia Dataframe to an R dataframe then running your R code.
Running an R script may not seem very Julian, but code reuse is very Julian. Besides, you're still using an R library and active R session either way, and there might even be a slight performance benefit from reducing how often you make wrapper objects and switch between Julia and R.
## import libraries for Julia and R; still good to do at top
using CairoMakie, DataFrames, Effects, GLM, StatsModels, StableRNGs, RCall
R"""
library(ggplot2)
library(dplyr)
"""
## your Julia code without the #rlibrary or ggplot lines
rng = StableRNG(42)
growthdata = DataFrame(; age=[13:20; 13:20],
sex=repeat(["male", "female"], inner=8),
weight=[range(100, 155; length=8); range(100, 125; length=8)] .+ randn(rng, 16))
mod_uncentered = lm(#formula(weight ~ 1 + sex * age), growthdata)
refgrid = copy(growthdata)
filter!(refgrid) do row
return mod(row.age, 2) == (row.sex == "male")
end
effects!(refgrid, mod_uncentered)
refgrid[!, :lower] = #. refgrid.weight - 1.96 * refgrid.err
refgrid[!, :upper] = #. refgrid.weight + 1.96 * refgrid.err
df= refgrid
## convert Julia's df and run your R code in R-string
## - note that $df is interpolation of Julia's df into R-string,
## not R's $ operator like in rdf$weight
## - call the R dataframe rdf because df is already an R function
R"""
rdf <- $df
t1= filter(rdf, sex=="male") %>% slice_max(rdf$weight)
ggplot(rdf, aes(age, weight, group = sex, shape= sex, linetype=sex,fill=sex, colour=sex)) +
geom_line(position=position_dodge(width=0.15)) +
geom_point(position=position_dodge(width=0.15)) +
geom_errorbar(aes(ymin = lower, ymax = upper),width = 0.1,
linetype = "solid",position=position_dodge(width=0.15))+
geom_ribbon(aes(ymin = lower, ymax = upper, fill = sex, colour = sex), alpha = 0.2) +
geom_text(data = t1, aes(age, weight, label = round(weight, 1)), hjust = -0.25, size=7,show_guide = FALSE) +
scale_y_continuous(limits = c(70, 150), breaks = seq(80, 140, by = 20))+
theme_classic()+
scale_colour_manual(values = c("orange", "blue")) +
guides(color = guide_legend(override.aes = list(linetype = c('dotted', 'dashed'))),
linetype = "none")+
xlab("Age")+ ylab("Average marginal effects") + ggtitle("Title") +
theme(
axis.title.y = element_text(color="Black", size=28, face="bold", hjust = 0.9),
axis.text.y = element_text(face="bold", color="black", size=16),
plot.title = element_text(hjust = 0.5, color="Black", size=28, face="bold"),
legend.title = element_text(color = "Black", size = 13),
legend.text = element_text(color = "Black", size = 16),
legend.position="bottom",
axis.text.x = element_text(face="bold", color="black", size=11),
strip.text = element_text(face= "bold", size=15)
)
"""
The result is the same as your post's R code:
I used Vega-Lite (https://github.com/queryverse/VegaLite.jl) which is also grounded in the "Grammar of Graphics", and LinearRegression (https://github.com/ericqu/LinearRegression.jl) which provides similar features as GLM, although I think it is possible to get comparable results with the other plotting and linear regression packages. Nevertheless, I hope that this gives you a starting point.
using LinearRegression: Distributions, DataFrames, CategoricalArrays
using DataFrames, StatsModels, LinearRegression
using VegaLite
growthdata = DataFrame(; age=[13:20; 13:20],
sex=categorical(repeat(["male", "female"], inner=8), compress=true),
weight=[range(100, 155; length=8); range(100, 125; length=8)] .+ randn(16))
lm = regress(#formula(weight ~ 1 + sex * age), growthdata)
results = predict_in_sample(lm, growthdata, req_stats="all")
fp = select(results, [:age, :weight, :sex, :uclp, :lclp, :predicted]) |> #vlplot() +
#vlplot(
mark = :errorband, color = :sex,
y = { field = :uclp, type = :quantitative, title="Average marginal effects"},
y2 = { field = :lclp, type = :quantitative },
x = {:age, type = :quantitative} ) +
#vlplot(
mark = :line, color = :sex,
x = {:age, type = :quantitative},
y = {:predicted, type = :quantitative}) +
#vlplot(
:point, color=:sex ,
x = {:age, type = :quantitative, axis = {grid = false}, scale = {zero = false}},
y = {:weight, type = :quantitative, axis = {grid = false}, scale = {zero = false}},
title = "Title", width = 400 , height = 400
)
which gives:
You can change the style of the elements by changing the "config" as indicated here (https://www.queryverse.org/VegaLite.jl/stable/gettingstarted/tutorial/#Config-1).
As the Julia Vega-Lite is a wrapper to Vega-Lite additional documentation can be found on the Vega-lite website (https://vega.github.io/vega-lite/)
plot observed data and predict data by two models (lm and lme) in the same plot
How can I plot observed data and the results of differents models (lm and lme) in the same plot? I tried the code below, but it only worked for points. I would like to add the data predicted by the inline models of different colors. #Data d <- runif(160,0,100)#data y <- rnorm(16,1,0.05)*x + rnorm(16,0,0.5)#data df = data.frame(d,y) #Models #linear - 1 m1 = lm(y~d, data = df) summary(m1) # linear - 2 m2 = lm(y~d+I(d^2), data = df) summary(m2) df$Class10<-with(df,ifelse(d<20,"<20",ifelse(d<30,"20-30", ifelse(d<40,"30-40",ifelse(d<50,"40-50",ifelse(d<60,"50-60", ifelse(d<70,"60-70",ifelse(d<80,"70-80",ifelse(d<90,"80-90", ifelse(d>=90,">90","ERROR")))))))))) # number of classes length(unique(df$Class10)) # classes sort(unique(df$Class10)) # observations by class table(df$Class10) plot(table(df$Class10)) # b0 m10 = lme(y~d, random=~1|Class10, method="ML" ,data = df) # b1 m10 = lme(y~d, random=~-1+d|Class10, method="ML" , data = df) # m10 = lme(y~d, random=~d|Class10, method="ML" , data = df, control = lmeControl(niterEM = 5200, msMaxIter = 5200)) #plot points - It works plot(df$d, df$y) points(df$d, predict(m1), col="blue") points(df$d, predict(m10, level=1), col="red") #curve plot(df$d, df$y) curve(predict(m1,newdata=data.frame(d=x)),lwd=2, add=T) curve(predict(m10,newdata=data.frame(d=x)),lwd=1, add=T)#error # line plot(df$d,df$y) curve(predict(m1,newdata=data.frame(d=x)),lwd=2, add=T) lines(df$d, predict(m10, level=1),col="green")#error Is there any way in ggplot2, for example?
Here is a way! I like using broom and broom.mixed to get a complete tibble with predicted values for each model.
library(tidyverse)
library(lme4)
library(broom)
library(broom.mixed)
df <- ChickWeight
lin <- lm(weight ~ Time,df)
mlm <- lmer(weight ~ Time + (1 | Chick),df)
df <- df %>%
mutate(linpred = broom::augment(lin)[,3] %>% pull(),
mlmpred = broom.mixed::augment(mlm)[,4] %>% pull())
ggplot(df,aes(Time,weight,group = Chick)) +
geom_line(alpha = .2) +
geom_line(aes(y = linpred,color = 'Fixed Linear Effect')) +
geom_line(aes(y = mlmpred,color = 'Random Intercepts'), alpha = .4) +
scale_color_manual(values = c('blue','red')) +
labs(color = '') +
theme_minimal()