R: ggplot2 наложения между Разброс участков и эффектов сюжета

Question

я сделал следующее биномиальное GLM:

fit_MLPAlog2 = glm(cbind(infected, not_infected)~treatment*log(day+1), family = binomial, data = data) 

, и я хочу сделать следующий сюжет:

Я попытался

plot(allEffects(mod = fit_MLPAlog2), type = "response", ylim = c(0,1),lwd = 0.5, ylab = "Above detection treshold", xlab = "Day", multiline = FALSE) 

и поэтому я получаю следующую графику:

Я также попытался построить его с ggplot2, а затем я получаю точки данных:

p1 <- ggplot(data, aes(day, propinfected, colour = treatment)) + 
     geom_point(size = 3) + geom_smooth(method="glm") + 
     labs(x = "Day", y = "Above treshold") + theme_bw() + 
     theme(legend.position = "top", legend.text = element_text(size = 12), 
      legend.title = element_text(size = 14)) 

Кто-то, кто имеет подсказку, как сделать первый сюжет?

Вот данные:

> data 
     treatment day infected not_infected propinfected 
    1  CTRL 0  0   20   0.00 
    2  DWV 0  20   0   1.00 
    3  CTRL 4  11   9   0.55 
    4  DWV 4  20   0   1.00 
    5  CTRL 8  15   5   0.75 
    6  DWV 8  18   2   0.90 
    7  CTRL 12  16   4   0.80 
    8  DWV 12  19   1   0.95 
    9  CTRL 16  19   1   0.95 
    10  DWV 16  19   1   0.95 

Заранее спасибо!

Answer 1

Так что я думаю, что это довольно близко:

library(reshape2) 

set.seed(1234) 
rawdata <- data.frame(day = 1:16) 
rawdata$CTRL <- c(0, 22,44,55, 56,62,68, 70,75,78, 82,84,87, 89,92,95)/100 + 
                   c(0,rnorm(15,0,0.03)) 
rawdata$DIW <- pmin(1.0,((160-rawdata$day)/170) + rnorm(16,0,0.02)) 
#rawdata$CTRLdots <- c(0,55,60,75,77) 

data <- melt(rawdata,id.var=c("day"),value.name="propinfected",variable.name="treatment") 

clrs <- c("CTRL"="grey","DIW"="grey") 
ltyp <- c("CTRL"="solid","DIW"="dotted") 
fils <- c("CTRL"="black","DIW"="white") 

p1 <- ggplot(data, aes(day, propinfected, 
     colour = treatment,fill=treatment,linetype=treatment)) + 
    geom_point(size = 4,shape=21) + 
    geom_smooth(method="loess",fill=I("grey")) + 
    scale_y_continuous(limits=c(0,1)) + 
    scale_color_manual(values=clrs)+ 
    scale_fill_manual(values=fils)+ 
    scale_linetype_manual(values=ltyp)+ 
    labs(x = "Day", y = "Above detection threshold (%)") + theme_bw() + 
    theme(legend.text = element_text(size = 12), 
     legend.title = element_text(size = 14), 
     legend.justification=c(1,0), 
     legend.position=c(1,0) 
     ) 
    print(p1) 

получают: