I am trying to fit association-dissociation SPR kinetics data for a protein and small molecule for two concentrations using ggplot2. The data is here.
The time variable indicates the time in seconds, the sample variable indicates the two concentrations (32nM and 8nM), and the values variable is the readout.
I have imported the data and running the following code to plot:
# LINE PLOT
ggplot(data) +
geom_point(aes(x = time, y = values), size = 1, color = "black") +
geom_smooth(aes(x = time, y = values, color = sample), method = "loess", se = F) +
scale_x_continuous(expand = c(0, 0), limits = c(0, NA)) +
#scale_y_continuous(expand = c(0, 0), limits = c(0, 60)) +
scale_color_npg(breaks = c("2nM", "4nM", "8nM", "16nM", "32nM")) +
theme_linedraw() +
labs(x = "Time (seconds)",
y = "Response Units") +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
Here is the plot:
As you can see that the fit did not work using method = "loess". I need something like this(there are 5 concentrations here):
The fitting requires 1:1 Langmuir model but I am not sure how I can do that in ggplot. Can someone please help me?
Here is the equation:
This is from the pbm package that fits this kind of plots.
Your data are smooth enough that you need only use geom_line, not geom_smooth:
df %>%
ggplot(aes(time, values, color = sample)) +
geom_line(size = 2, na.rm = TRUE) +
geom_point(color = 'black', size = 1) +
theme_linedraw(base_size = 16) +
xlim(c(0, 400))
Edit
It is possible to fit the results to the data using non-linear least squares, employing the binding1to1 function from pbm, but it requires a bit of method tweaking to get the model to fit. It would probably be better to create a model then plot the predictions rather than using geom_smooth. However, if you really wanted to, you could do:
df %>%
ggplot(aes(time, values, color = sample)) +
geom_smooth(method = nls, se = FALSE, n = 1000,
formula = y ~ binding1to1(x, 123, 32e-9, kon, koff, rmax),
method.args = list(
start = list(kon = 2000, koff = 0.02, rmax = 2e4),
control = nls.control(minFactor = 1e-6, maxiter = 1000)
),
data = df[df$time > 0 & df$sample == "32nM",]) +
geom_smooth(method = nls, se = FALSE, n = 1000,
formula = y ~ binding1to1(x, 123, 8e-9, kon, koff, rmax),
method.args = list(
start = list(kon = 3000, koff = 0.02, rmax = 2e4),
control = nls.control(minFactor = 1e-9, maxiter = 10000)
),
data = df[df$time > 0 & df$sample == "8nM",]) +
geom_point(color = 'black', size = 1) +
theme_linedraw(base_size = 16) +
xlim(c(0, 400))
If you want to actually fit a model from which to extract the parameters and plot, you can do:
library(tidyverse)
library(pbm)
df <- read.csv("SPR.csv") %>%
filter(time >= 0) %>%
mutate(sample = as.numeric(gsub("\\D+", "", sample)) * 1e-9,
values = values * 1e-3) %>%
group_by(sample) %>%
mutate(tmax = time[which.max(values)])
fit_fun <- function(time, tmax, sample, kon, koff, rmax) {
unlist(Map(function(time, tmax, sample) {
binding1to1(time, tmax, sample, kon, koff, rmax)
}, time, tmax, sample))
}
mod <- nls(values ~ fit_fun(time, tmax, sample, kon, koff, rmax),
data = df,
start = list(kon = 3000, koff = 0.02, rmax = 2),
control = nls.control(minFactor = 1e-9, maxiter = 10000))
This gives us a model with the best fitting values for the various parameters:
mod
#> Nonlinear regression model
#> model: values ~ fit_fun(time, tmax, sample, kon, koff, rmax)
#> data: df
#> kon koff rmax
#> 8.925e+05 2.521e-03 5.445e-02
#> residual sum-of-squares: 5.219e-05
#>
#> Number of iterations to convergence: 536
#> Achieved convergence tolerance: 5.155e-07
We can then predict the output of the model over the range of our input variables:
pred_df <- expand.grid(time = 0:400, sample = c(8, 32) * 1e-9,
tmax = df$tmax[1])
pred_df$values <- predict(mod, pred_df)
And we can plot it like this:
df %>%
ggplot(aes(time, values, color = factor(sample))) +
geom_line(data = pred_df, size = 1) +
geom_point(color = 'black', size = 1) +
theme_linedraw(base_size = 16) +
xlim(c(0, 400))
Related
I would like to ask for some help with depicting the slopes generated by a lmer() model.
The data that I have is the mass volume of different rats across different days. Each rat has different time points where they took the measurement of that volume.
For rat 1 I have volume c(78,304,352,690,952,1250) at days c(89,110,117,124,131,138) that belong to country Chile
For rat 2 I have volume c(202,440,520,870,1380) at days c(75,89,96,103,110) that belong to country Chile.
For rat 3 I have volume c(186,370,620,850,1150) at days c(75,89,96,103,110) that belong to country Chile.
For rat 4 I have volume c(92,250,430,450,510,850,1000,1200) at days c(47,61,75,82,89,97,103,110) that belong to country England.
For rat 5 I have volume c(110,510,710,1200) at days c(47,61,75,82) that belong to country England.
For rat 6 I have volume c(115,380,480,540,560,850,1150,1350) at days c(47,61,75,82,89,97,103,110) that belong to country England.
The lmer model is:
m1 <- lmer(lVolume ~ Country*Day + (1|Rat))
I managed to plot the curves of my model by using:
m1%>%
augment() %>%
clean_names() %>%
ggplot(data = .,
mapping = aes(x = day,
y = exp(l_volume),
group = rat)) +
geom_point(alpha = 0.5) +
geom_line(alpha = 0.5) +
geom_point(aes(y = exp(fitted)),
color = "red") +
geom_line(aes(y = exp(fitted)),
color = "red") +
expand_limits(x = 0 , y = 0)
This model gave me predictions for new data points based on the model m1 for each of the rats across country.
From this lmer() I have one slope across the whole measurements, this is:
And by exp(predicted):
However, I would like to plot this in a different way. I would like to plot the slope generated by each of the levels of country that I have.
The red lines would be the exp(slopes) generating by Chile, and England, but also depict the exp(slope) of the whole model containing both levels.
So, initially I thought that creating three lmer() models:
m1 <- lmer(lVolume ~ Country*Day + (1|Rat))
m2 <- lmer(lVolume ~ Day + (1|Rat)) (Rats in Chile)
m3 <- lmer(lVolume ~ Day + (1|Rat)) (Rats in England)
But I noticed that m2 and m3 are quite different models because they do not have the interaction from Country that is something that I would like to check. So, I don't know what to do here.
Update
I tried this and kind of worked:
Final.Fixed<-effect(c("Country*Day"), m1,
xlevels=list(Day=seq(0,168,14)))
Final.Fixed<-as.data.frame(Final.Fixed)
Final.Fixed.Plot <-ggplot(data = Final.Fixed, aes(x = Day, y =exp(fit), group=Country))+
coord_cartesian(xlim=c(0,170),ylim = c(0,8000))+
geom_line(aes(color=Country), size=2)+
geom_ribbon(aes(ymin=exp(fit-se), ymax=exp(fit+se),fill=Country),alpha=.2)+
xlab("Day")+
ylab("Volume")+
scale_color_manual(values=c("blue", "red"))+
scale_fill_manual(values=c("blue", "red"))+
theme_bw()+
theme(text=element_text(face="bold", size=12),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_rect(fill = NA, colour = "NA"),
axis.line = element_line(size = 1, colour = "grey80"),
legend.title=element_blank(),
legend.position = c(.2, .92))
Final.Fixed.Plot
Is this ok ? I think that I am still cosnidering the m1 with the country*Day interaction. Correct me if I am worng, please! Also, I don't know how I can add the exp(fit) curve for the whole model and the raw data points in this plot.
Could I get some hint/help, please ?
Clean summary on top
The first code chunk contains a cleaned up version that addresses all points of the question, using some input from the comments. I've left the original answer below which step by step builds to the final plot.
library(tidyverse)
library(lme4)
library(broom.mixed)
library(ggeffects)
m1 <- lme4::lmer(lVolume ~ Country*Day + (1|Rat), data = df_rats %>%
dplyr::mutate(lVolume = log(Volume)))
# predictions for each country
syn_df <- tidyr::expand_grid(
Day = 1:170,
Country = c("Chile", "England")
) %>%
dplyr::mutate(lVolume = predict(m1, ., re.form = ~0))
# marginal effects for variable "Day"
df_day_marginal <- ggeffect(model = m1, terms = "Day", type = "fe") %>%
as.data.frame() %>%
dplyr::rename(Day = x, lVolume = predicted) %>%
dplyr::mutate(Country = "overall")
#combine prediction curves
df_preds <- bind_rows(syn_df, df_day_marginal)
# manually assemble formulas [units missing]
y0 <- round(fixef(m1)[["(Intercept)"]], 2)
beta_day <- round(fixef(m1)[["Day"]], 3)
beta_englday <- round(fixef(m1)[["CountryEngland:Day"]], 3)
beta_engl <- round(fixef(m1)[["CountryEngland"]], 2)
f_chile <- paste0("volume = exp(", y0, " + ", beta_day, " * days)")
f_england <- paste0("volume = exp(", y0 + beta_engl , " + ", beta_day + beta_englday, " * days)")
df_labels <- data.frame(
x = c(50, 50),
y = c(1300, 1400),
form = c(f_chile, f_england),
country = c("Chile", "England")
)
m1 %>%
broom.mixed::augment()%>%
ggplot(aes(x = Day, y = exp(lVolume), color = Country)) +
geom_ribbon(data = df_preds, aes(ymin = exp(conf.low), ymax = exp(conf.high), color = NULL, fill = Country), alpha = 0.3) +
geom_line(data = df_preds, size = 1.5) +
geom_line(aes(group = Rat)) +
geom_point() +
coord_cartesian(ylim = c(0, 1500), xlim = c(0, 150)) +
geom_text(data = df_labels, aes(x = x, y = y, label = form, color = country)) +
labs(x = "days", y = "volume")
original answer
I've tried to stay as close as possible to your initial code for the first part of the question.
The first chunk trains the model and makes population-level predictions for Chile and England over the specified days. (using the re.form = ~0 argument as explained e.g. here)
library(tidyverse)
library(lme4)
library(broom.mixed)
#helpful to specify in that `lVolume` is the log of the data you provid in the question
m1 <- lme4::lmer(lVolume ~ Country*Day + (1|Rat), data = df_rats %>%
dplyr::mutate(lVolume = log(Volume)))
days <- seq(0,168,14)
syn_df <- tidyr::expand_grid(
Day = 1:170,
Country = c("Chile", "England")
)
syn_df <- syn_df %>%
dplyr::mutate(l_volume = predict(m1, syn_df, re.form = ~0)) %>%
janitor::clean_names()
This can then be added to your original plot with minor modifications:
m1 %>%
broom.mixed::augment() %>%
janitor::clean_names() %>%
ggplot(data = .,
mapping = aes(x = day,
y = exp(l_volume),
color = country)) +
geom_point(alpha = 0.7) +
geom_line(aes(group = rat), alpha = 0.7) +
expand_limits(x = 0 , y = 0) +
geom_line(data = syn_df, alpha = 1, size = 1.5) +
coord_cartesian(ylim = c(NA, 1500), xlim = c(NA, 150))
Added
In addition, we can add marginal effect for days to the plot.
df_day_marginal <- ggeffect(model = m1, terms = "Day", type = "fe")
m1 %>%
broom.mixed::augment() %>%
janitor::clean_names() %>%
ggplot() +
geom_ribbon(data = df_day_marginal, aes(x = x, ymin = exp(conf.low), ymax = exp(conf.high)), alpha = 0.3) +
geom_line(data = syn_df, aes(x = day, y = exp(l_volume), color = country), size = 1.5) +
geom_line(data = df_day_marginal, aes(x = x, y = exp(predicted)), size = 1.5) +
geom_point(aes(x = day, y = exp(l_volume), color = country), alpha = 0.7) +
geom_line(aes(x = day, y = exp(l_volume), color = country, group = rat), alpha = 0.7) +
expand_limits(x = 0 , y = 0) +
coord_cartesian(ylim = c(NA, 1500), xlim = c(NA, 150)) +
labs(x = "days", y = "volume")
when I tried to plot a graph of decision boundary in R, I met some problem and it returned a error "Continuous value supplied to discrete scale". I think the problem happened in the scale_colur_manual but I don't know how to fix it. Below is the code attached.
library(caTools)
set.seed(123)
split = sample.split(df$Purchased,SplitRatio = 0.75)
training_set = subset(df,split==TRUE)
test_set = subset(df,split==FALSE)
# Feature Scaling
training_set[,1:2] = scale(training_set[,1:2])
test_set[,1:2] = scale(test_set[,1:2])
# Fitting logistic regression to the training set
lr = glm(formula = Purchased ~ .,
family = binomial,
data = training_set)
#Predicting the test set results
prob_pred = predict(lr,type = 'response',newdata = test_set[-3])
y_pred = ifelse(prob_pred > 0.5, 1, 0)
#Making the Confusion Matrix
cm = table(test_set[,3],y_pred)
cm
#Visualizing the training set results
library(ggplot2)
set = training_set
X1 = seq(min(set[, 1]) - 1, max(set[, 1]) + 1, by = 0.01)
X2 = seq(min(set[, 2]) - 1, max(set[, 2]) + 1, by = 0.01)
grid_set = expand.grid(X1, X2)
colnames(grid_set) = c('Age', 'EstimatedSalary')
prob_set = predict(lr, type = 'response', newdata = grid_set)
y_grid = ifelse(prob_set > 0.5, 1,0)
ggplot(grid_set) +
geom_tile(aes(x = Age, y = EstimatedSalary, fill = factor(y_grid)),
show.legend = F) +
geom_point(data = set, aes(x = Age, y = EstimatedSalary, color = Purchased),
show.legend = F) +
scale_fill_manual(values = c("orange", "springgreen3")) +
scale_colour_manual(values = c("red3", "green4")) +
scale_x_continuous(breaks = seq(floor(min(X1)), ceiling(max(X2)), by = 1)) +
labs(title = "Logistic Regression (Training set)",
ylab = "Estimated Salary", xlab = "Age")
Is your Purchased variable a factor? If not, it has to be. Try this:
grid_set %>%
mutate(Purchased=factor(Purchased)) %>%
ggplot() +
geom_tile(aes(x = Age, y = EstimatedSalary, fill = factor(y_grid)),
show.legend = F) + ... # add the rest of your commands.
I am working with the Growthrates package to generate parameter estimates of growth rate curves for my data. I have made the regressions and looked at the produced plots and I am happy with the data, but I would like to reproduce the following plots in ggplot2.
Figure 1: Multiplot of a regression for each group:treatment combo
I would like a multiplot of the regression lines for each group:Treatment combination, but with all the regressions I performed on it in ((i.e. logistic, gompertz, gompertz2, etc..). So far I have:
library(growthrates)
####Using logistic regression to fit the data across mutliple groups
p <- c(y0 = 1, mumax = 0.5, K = 200)
lower <- c(y0 = 0, mumax = 0, K = 20)
upper <- c(y0 = 100, mumax = 5, K = 400)
many_logistics <- all_growthmodels(y_data ~
grow_logistic(total_time_days, parms) | sample + treatment,
data = Alldata,
p = p,
lower = lower,
upper = upper,
log = "y")
pp <- coef(many_logistics)
par(mfrow = c(5, 3))
par(mar = c(2.5, 4, 2, 1))
plot(many_logistics)
many_logistics_results <- results(many_logistics)
xyplot(mumax ~ treatment | sample, data = many_logistics_results, layout = c(3, 1))
xyplot(r2 ~ treatment | sample, data = many_logistics_results, layout = c(3, 1))
xyplot(K ~ treatment | sample, data = many_logistics_results, layout = c(3, 1))
curve_logistics <- predict(many_logistics) #Prediction for given data (data for curve)
est_logistics <- predict(many_logistics, newdata=data.frame(time=seq(0, 1, 0.1))) #Extrapolation/Interpolation from curve
####Using Gompertz regression to fit the data across mutliple groups
p <- c(y0 = 1, mumax = 0.5, K = 200)
lower <- c(y0 = 0, mumax = 0, K = 20)
upper <- c(y0 = 100, mumax = 5, K = 400)
many_gompertz <- all_growthmodels(y_datay_data ~
grow_gompertz(total_time_days, parms) | sample + treatment,
data = Alldata,
p = p,
lower = lower,
upper = upper)
pp <- coef(many_gompertz)
par(mfrow = c(5, 3))
par(mar = c(2.5, 4, 2, 1))
plot(many_gompertz)
many_gompertz_results <- results(many_gompertz)
xyplot(mumax ~ treatment | sample, data = many_gompertz_results, layout = c(3, 1))
xyplot(r2 ~ treatment | sample, data = many_gompertz_results, layout = c(3, 1))
xyplot(K ~ treatment | sample, data = many_gompertz_results, layout = c(3, 1))
curve_gompertz <- predict(many_gompertz) #Prediction for given data (data for curve)
est_gompertz <- predict(many_gompertz, newdata=data.frame(time=seq(0, 1, 0.1))) #Extrapolation/Interpolation from curve
#Prepare the data frames
curve_logistics2 <- curve_logistics %>%
map_df(as_tibble, .id = "src") %>%
separate(src, c("sample", "treatment"), ":") %>%
mutate(regression = "logistic")
curve_gompertz2 <- curve_gompertz %>%
map_df(as_tibble, .id = "src") %>%
separate(src, c("sample", "treatment"), ":") %>%
mutate(regression = "gompertz")
alldata2<- Alldata %>%
select("sample", "treatment","total_time_days", "y_data") %>%
rename(time = "total_time_days") %>%
rename(y = "y_data") %>%
mutate(regression = "none")
comp_reg <- bind_rows(curve_logistics2, curve_gompertz2, alldata2)
#define the function to automatically generate plots#define the function to automatically generate plots
REGRESSION_LINE_PLOT <-function(x) {ggplot(data = x, aes(x=time, y=y, colour = regression, linetype = regression)) +
geom_point(size = 2.5, data = subset(x, regression %in% c("none"))) +
stat_smooth(data = subset(x, regression %in% c("gompertz", "logistic"))) +
theme_bw() +
theme(panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
panel.spacing = unit(0,"cm"),
axis.line=element_line(colour="black"),
# axis.title.x = element_text(size=14, colour = "black"),
axis.title.x = element_blank(),
# axis.title.y = element_text(size=14, colour = "black"),
axis.title.y = element_blank(),
# axis.text.y = element_text(size=14, colour = "black"),
# axis.text.x = element_text(size=14, colour = "black"),
strip.background = element_blank(),
strip.text = element_text(size = 12, colour="black", face = "bold"),
legend.text= element_text(size = 12, colour = "black"),
legend.title=element_blank(),
text = element_text(size=12, family="Arial")) +
# plot.margin=unit(c(0.1,0.1,0.1,0.1),"cm")) +
#scale_colour_manual(values = cbbPalette) + ### here I tell R to use my custom colour palette
#scale_x_continuous(limits = c(-1,14)) + # set time range from -1 to 70 since we started sampling on day -1
#scale_y_continuous(limits = c(-1,350), breaks = seq(0, 360, 90)) + # For comparison purposes, i want all my panels to have the same y axis scale
ylab("") +
xlab("")
}
comp_reg_nested<- comp_reg %>%
group_by(sample, treatment) %>%
nest() %>%
mutate(plots=map(.x=data, ~REGRESSION_LINE_PLOT(.x)))
fo_ad_line <- comp_reg_nested[[1,"plots"]]
However, I do not think the regression lines are properly represented in ggplot22. Is there a better way to do this?
I created a data example more or less similar to your data structure from the builtin data of the package and simplified the code a little bit, omitting the default plot functions. I very much enjoyed your data frame construction method with map_df, thank you. Then I added a simple ggplot, that can of course be extended and adapted to your needs.
library(growthrates)
library(dplyr)
library(purrr)
library(tidyr)
library(ggplot2)
## use subset of built-in example data of the package
## and adapt it to the existing part of the script
data(bactgrowth)
Alldata <- bactgrowth[(bactgrowth$conc < 1) & bactgrowth$replicate == 1, ]
names(Alldata) <- c("sample", "replicate", "treatment", "total_time_days", "y_data")
Alldata$y_data <- Alldata$y_data * 1000
Alldata$treatment <- as.character(Alldata$treatment)
####Using logistic regression to fit the data across mutliple groups
p <- c(y0 = 1, mumax = 0.5, K = 200)
lower <- c(y0 = 0, mumax = 0, K = 20)
upper <- c(y0 = 100, mumax = 5, K = 400)
many_logistics <- all_growthmodels(y_data ~
grow_logistic(total_time_days, parms) | sample + treatment,
data = Alldata,
p = p,
lower = lower,
upper = upper)
many_logistics_results <- results(many_logistics)
curve_logistics <- predict(many_logistics)
####Using Gompertz regression to fit the data across mutliple groups
many_gompertz <- all_growthmodels(y_data ~
grow_gompertz(total_time_days, parms) | sample + treatment,
data = Alldata,
p = p,
lower = lower,
upper = upper)
many_gompertz_results <- results(many_gompertz)
curve_gompertz <- predict(many_gompertz)
#Prepare the data frames
curve_logistics2 <- curve_logistics %>%
map_df(as_tibble, .id = "src") %>%
separate(src, c("sample", "treatment"), ":") %>%
mutate(regression = "logistic")
curve_gompertz2 <- curve_gompertz %>%
map_df(as_tibble, .id = "src") %>%
separate(src, c("sample", "treatment"), ":") %>%
mutate(regression = "gompertz")
alldata2<- Alldata %>%
rename(time = "total_time_days", y = "y_data")
## combine the two curves to a joint data frame
comp_reg <- bind_rows(curve_logistics2, curve_gompertz2)
## plot it
ggplot(comp_reg, aes(time, y)) +
geom_point(data = alldata2) +
geom_line(aes(color = regression)) +
facet_grid(treatment ~ sample)
I am trying to annotate the plot below in a pairwise fashion - in each facet compare corresponding samples in the variable. Essentially comparing CTR from pos to CTR from neg and so on. I can't seem to get it to work.
Here is my data and plots:
library(ggpubr)
#data.frame
samples <- rep(c('LA', 'EA', 'CTR'), 300)
variable <- sample(c('pos', 'neg'), 900, replace = T)
stim <- rep(c('rp','il'), 450)
population <- sample(c('EM','CM','TEMRA'), 900, replace = T)
values <- runif(900, min = 0, max = 100)
df <- data.frame(samples, variable, stim, population, values)
#test and comparisons
test_comparisons <- list(c('neg', 'pos'))
test <- compare_means(values ~ variable, data = df, method = 'wilcox.test',
group.by = c('samples', 'stim', 'population'))
#plot
ggplot(aes(x= variable, y = values, fill = samples), data = df) +
geom_boxplot(position = position_dodge(0.85)) +
geom_dotplot(binaxis='y', stackdir='center', position =
position_dodge(0.85), dotsize = 1.5) +
facet_grid(population ~ stim, scales = 'free_x') +
stat_compare_means(comparisons = test_comparisons, label = 'p.signif') +
theme_bw()
This only produces 1 comparison per facet between pos and neg instead of 3...What am I doing wrong?
You can use the following code:
samples <- rep(c('LA', 'EA', 'CTR'), 300)
variable <- sample(c('pos', 'neg'), 900, replace = T)
stim <- rep(c('rp','il'), 450)
population <- sample(c('EM','CM','TEMRA'), 900, replace = T)
values <- runif(900, min = 0, max = 100)
df <- data.frame(samples, variable, stim, population, values)
#test and comparisons
test_comparisons <- list(c('neg', 'pos'))
test <- compare_means(values ~ variable, data = df, method = 'wilcox.test',
group.by = c('samples', 'stim', 'population'))
#plot
ggplot(aes(x= variable, y = values, fill = samples), data = df) +
geom_boxplot(position = position_dodge(0.85)) +
geom_dotplot(binaxis='y', stackdir='center', position =
position_dodge(0.85), dotsize = 1.5) +
facet_grid(population ~ stim+samples, scales = 'free_x') +
stat_compare_means(comparisons = test_comparisons, label = 'p.signif') +
theme_bw()
Hope this will rectify your problem
I know that this is possible with other types of models (e.g., this), but I haven't come across this for a model fit with "brms".
Has anyone had luck plotting the coefficients of multiple models, with different DVs, that were fit through brms?
Edit:
This is as far as I've gotten trying to use the method from that link for brms.
m1h<-fixef(mcmcm1_h1)
m1e<-fixef(mcmcm1_e1) #these extract fixed effect info from a model fit with brms; below is an example of their output#
m1h
Estimate Est.Error 2.5%ile 97.5%ile
Intercept 0.2615716 0.1482702 -0.01995366 0.5593722
m1hframe <- data.frame(Variable = colnames(m1h),Coefficient = m1h[, 1],SE =
m1h[, 2],min = m1h[, 3],max = m1h[, 4],modelName = "HH")
m1eframe <- data.frame(Variable = colnames(m1e),Coefficient = m1e[, 1],SE =
m1e[, 2],min = m1e[, 3],max = m1e[, 4],modelName = "Em")
allModelFrame <- data.frame(rbind(m1hframe, m1eframe))
library(ggplot2)
zp1 <- ggplot(allModelFrame, aes(colour = modelName))
zp1 <- zp1 + geom_hline(yintercept = 0, colour = gray(1/2), lty = 2)
zp1 <- zp1 + geom_linerange(aes(x = Variable, ymin = min,ymax = max),lwd = 1,
position = position_dodge(width = 1/2))
zp1 <- zp1 + geom_pointrange(aes(x = Variable, y = Coefficient, ymin = min,
ymax = max,lwd = 1/2, position = position_dodge(width = 1/2),shape = 21, fill
= "WHITE"))
zp1 <- zp1 + coord_flip() + theme_bw()
zp1 <- zp1 + ggtitle("two models")
print(zp1)
This is the error I am getting:
Don't know how to automatically pick scale for object of type PositionDodge/Position/ggproto. Defaulting to continuous.
Error: A continuous variable can not be mapped to shape
A slightly simpler solution using broom:
multiplot <- function(x) {
x %>% purrr::map(function(.) {
broom::tidy(., conf.int = TRUE, par_type = "non-varying") }) %>%
dplyr::bind_rows(.id = "model") %>%
ggplot(aes(term, estimate, ymin = lower, ymax = upper, color = model)) +
geom_pointrange(position = position_dodge(width = 0.3)) + coord_flip()
}
Use like this multiplot(list(m1, m2, m3)).