How do I color/differentiate lines of a subset of data in ggplot density graph?-CodePudding

Data

I have fit a LMER model using the data below:

work <- structure(list(Coffee_Cups = c(3L, 0L, 2L, 6L, 4L, 5L, 3L, 3L, 
2L, 2L, 3L, 1L, 1L, 3L, 2L, 2L, 0L, 1L, 1L, 4L, 4L, 3L, 0L, 1L, 
3L, 0L, 0L, 0L, 0L, 2L, 0L, 1L, 2L, 3L, 2L, 2L, 4L, 3L, 6L, 6L, 
3L, 4L, 6L, 8L, 3L, 5L, 0L, 2L, 2L, 8L, 6L, 4L, 6L, 4L, 4L, 2L, 
6L, 6L, 5L, 1L, 1L, 5L, 4L, 6L, 5L, 0L, 6L, 6L, 4L, 4L, 2L, 2L, 
6L, 6L, 7L, 3L, 3L, 0L, 5L, 7L, 6L, 3L, 5L, 3L, 3L, 1L, 9L, 9L, 
3L, 3L, 6L, 6L, 6L, 3L, 0L, 7L, 6L, 6L, 3L, 9L, 3L, 8L, 8L, 3L, 
3L, 7L, 6L, 3L, 3L, 3L, 6L, 6L, 6L, 1L, 9L, 3L, 3L, 2L, 6L, 3L, 
6L, 9L, 6L, 8L, 9L, 6L, 6L, 6L, 0L, 3L, 0L, 3L, 3L, 6L, 3L, 0L, 
9L, 3L, 0L, 2L, 0L, 6L, 6L, 6L, 3L, 6L, 3L, 9L, 3L, 0L, 0L, 6L, 
3L, 3L, 3L, 3L, 6L, 0L, 6L, 3L, 3L, 5L, 5L, 3L, 0L, 6L, 4L, 2L, 
0L, 2L, 4L, 0L, 6L, 4L, 4L, 2L, 2L, 0L, 9L, 6L, 3L, 6L, 6L, 9L, 
0L, 6L, 6L, 6L, 6L, 6L, 6L, 3L, 3L, 0L, 9L, 6L, 3L, 6L, 3L, 6L, 
1L, 6L, 6L, 6L, 6L, 6L, 1L, 3L, 9L, 6L, 3L, 6L, 9L, 3L, 5L, 6L, 
3L, 0L, 6L, 3L, 3L, 5L, 0L, 6L, 3L, 5L, 3L, 0L, 6L, 7L, 3L, 6L, 
6L, 6L, 6L, 3L, 5L, 6L, 7L, 6L, 6L, 4L, 6L, 4L, 5L, 5L, 6L, 8L, 
6L, 6L, 6L, 9L, 3L, 3L, 9L, 7L, 8L, 4L, 3L, 3L, 3L, 6L, 6L, 6L, 
3L, 4L, 3L, 3L, 6L, 4L, 3L, 3L, 4L, 6L, 0L, 3L, 6L, 4L, 3L, 3L, 
7L, 4L, 4L, 3L, 1L, 6L, 4L, 6L, 5L, 3L, 6L, 6L, 3L, 6L, 3L, 5L, 
6L, 6L, 3L, 6L, 4L, 9L, 7L, 6L, 3L, 3L, 3L, 4L, 6L, 3L, 6L, 3L, 
4L, 4L, 3L, 5L, 5L, 5L), Mins_Work = c(435L, 350L, 145L, 135L, 
15L, 60L, 60L, 390L, 395L, 395L, 315L, 80L, 580L, 175L, 545L, 
230L, 435L, 370L, 255L, 515L, 330L, 65L, 115L, 550L, 420L, 45L, 
266L, 196L, 198L, 220L, 17L, 382L, 0L, 180L, 343L, 207L, 263L, 
332L, 0L, 0L, 259L, 417L, 282L, 685L, 517L, 111L, 64L, 466L, 
499L, 460L, 269L, 300L, 427L, 301L, 436L, 342L, 229L, 379L, 102L, 
146L, 94L, 345L, 73L, 204L, 512L, 113L, 135L, 458L, 493L, 552L, 
108L, 335L, 395L, 508L, 546L, 396L, 159L, 325L, 747L, 650L, 377L, 
461L, 669L, 186L, 220L, 410L, 708L, 409L, 515L, 413L, 166L, 451L, 
660L, 177L, 192L, 191L, 461L, 637L, 297L, 601L, 586L, 270L, 479L, 
0L, 480L, 397L, 174L, 111L, 0L, 610L, 332L, 345L, 423L, 160L, 
611L, 0L, 345L, 550L, 324L, 427L, 505L, 632L, 560L, 230L, 495L, 
235L, 522L, 654L, 465L, 377L, 260L, 572L, 612L, 594L, 624L, 237L, 
0L, 38L, 409L, 634L, 292L, 706L, 399L, 568L, 0L, 694L, 298L, 
616L, 553L, 581L, 423L, 636L, 623L, 338L, 345L, 521L, 438L, 504L, 
600L, 616L, 656L, 285L, 474L, 688L, 278L, 383L, 535L, 363L, 470L, 
457L, 303L, 123L, 363L, 329L, 513L, 636L, 421L, 220L, 430L, 428L, 
536L, 156L, 615L, 429L, 103L, 332L, 250L, 281L, 248L, 435L, 589L, 
515L, 158L, 0L, 649L, 427L, 193L, 225L, 0L, 280L, 163L, 536L, 
301L, 406L, 230L, 519L, 0L, 303L, 472L, 392L, 326L, 368L, 405L, 
515L, 308L, 259L, 769L, 93L, 517L, 261L, 420L, 248L, 265L, 834L, 
313L, 131L, 298L, 134L, 385L, 648L, 529L, 487L, 533L, 641L, 429L, 
339L, 508L, 560L, 439L, 381L, 397L, 692L, 534L, 148L, 366L, 167L, 
425L, 476L, 384L, 498L, 502L, 308L, 360L, 203L, 410L, 626L, 593L, 
409L, 531L, 157L, 0L, 357L, 443L, 615L, 564L, 341L, 352L, 609L, 
686L, 386L, 323L, 362L, 597L, 325L, 51L, 570L, 579L, 284L, 0L, 
530L, 171L, 640L, 263L, 112L, 217L, 152L, 203L, 394L, 135L, 234L, 
507L, 224L, 174L, 210L, 138L, 52L, 326L, 413L, 695L, 370L, 256L, 
327L, 490L, 128L, 469L, 567L, 359L, 561L, 478L, 233L, 550L, 390L, 
406L, 56L, 47L, 258L, 332L, 114L), Day_Name = c("Wednesday", 
"Thursday", "Friday", "Saturday", "Sunday", "Monday", "Tuesday", 
"Wednesday", "Thursday", "Friday", "Saturday", "Sunday", "Monday", 
"Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday", 
"Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", 
"Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", 
"Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", 
"Friday", "Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", 
"Thursday", "Friday", "Saturday", "Sunday", "Monday", "Tuesday", 
"Wednesday", "Thursday", "Friday", "Saturday", "Sunday", "Monday", 
"Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Monday", 
"Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday", 
"Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", 
"Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", 
"Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", 
"Friday", "Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", 
"Thursday", "Friday", "Saturday", "Sunday", "Monday", "Tuesday", 
"Wednesday", "Thursday", "Friday", "Saturday", "Sunday", "Monday", 
"Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday", 
"Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", 
"Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", 
"Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", 
"Friday", "Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", 
"Thursday", "Friday", "Saturday", "Sunday", "Monday", "Tuesday", 
"Wednesday", "Thursday", "Friday", "Saturday", "Sunday", "Monday", 
"Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday", 
"Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", 
"Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", 
"Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", 
"Friday", "Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", 
"Thursday", "Friday", "Saturday", "Sunday", "Monday", "Tuesday", 
"Wednesday", "Thursday", "Friday", "Saturday", "Sunday", "Monday", 
"Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday", 
"Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", 
"Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", 
"Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", 
"Friday", "Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", 
"Thursday", "Friday", "Saturday", "Sunday", "Monday", "Tuesday", 
"Wednesday", "Thursday", "Friday", "Saturday", "Sunday", "Monday", 
"Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday", 
"Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", 
"Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", 
"Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", 
"Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", 
"Friday", "Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", 
"Thursday", "Friday", "Saturday", "Sunday", "Monday", "Tuesday", 
"Wednesday", "Thursday", "Friday", "Saturday", "Sunday", "Monday", 
"Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday", 
"Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", 
"Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", 
"Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", 
"Friday", "Saturday", "Sunday", "Monday", "Tuesday", "Wednesday", 
"Thursday", "Friday", "Saturday", "Sunday", "Monday", "Tuesday", 
"Wednesday", "Thursday", "Friday", "Saturday", "Sunday")), class = "data.frame", row.names = c(NA, 
-318L))

Problem

I have fit the model and simulated it a thousand times, which I pivoted in order to put all the values into one density graph:

#### Fit Model ####
fit.work <- lmer(Mins_Work ~ Coffee_Cups   (1|Day_Name),
                 data = work)

#### Simulate Model 1000x ####
sim <- simulate(fit.work, 1000)

#### Pivot Simulation Data ####
sim <- sim %>% 
  pivot_longer(cols = everything(),
               names_to = "Simulation",
               values_to = "Prediction")

#### Graph Data ####
ggplot(sim,
       aes(x=Prediction)) 
  geom_density()

However, there are two things I want to achieve that I'm perplexed on right now. First, I would like to make separate lines for the simulation data which are all one color (i.e. 1000 blue lines). Second, I want to overlay the actual y values (work$Mins_Work) on top of that graph. The problem is that by pivoting I have no created a ton of y values that I'm not sure I can overlay the data on. It should look something like this:

CodePudding user response：

To achieve your desired result you have to map Simulation on the group aes to get separate densities for each simulation run and add a second geom_density for your observed data. To get different colors and line sizes map on the color and size aes which could then be set via scale_xxx_manual. Finally, to get a line for the legend key I switched the key_glyph to "path".

library(ggplot2)

ggplot()  
  geom_density(data = sim, aes(Prediction, color = "Model-predicted Data", size = "Model-predicted Data", 
                               group = Simulation), key_glyph = "path")  
  geom_density(data = work, aes(Mins_Work, color = "Observed Data", size = "Observed Data"), 
               key_glyph = "path")  
  scale_color_manual(values = c("steelblue", "forestgreen"))  
  scale_size_manual(values = c(.1, .5))  
  labs(color = NULL, size = NULL)