While making a nomogram of Remotion related to Depth and Time of sedimentation, I need to fit curves (as paraboles) to remotion labels if they are lower than its upper ten (7 ceils to 10, and 18 to 20). This is very close to what I need.

data.frame(
    depth=rep(seq(0.5, 3.5, 0.5), each=8),
    time=rep(seq(0, 280, 40), times=7),
    ss = c(
        820,369,238,164,107,66,41,33,
        820,224,369,279,213,164,115,90,
        820,631,476,361,287,230,180,148,
        820,672,558,426,353,287,238,187,
        820,713,590,492,402,344,262,230,
        820,722,615,533,460,394,320,262,
        820,738,656,574,492,418,360,303)
) %>% 
transmute(
  depth = depth,
  time = time, 
  R = 100*(1- ss/820)
) %>%
  mutate(G=factor(round(R, digits=-1))) %>%
  ggplot(aes(x=time, y=depth, colour=time)) 
  geom_label(aes(label=round(R)))  
  scale_y_continuous(trans = "reverse") 
  geom_path(aes(group=G))

But it is not getting parabolical curves. How can I smooth them under the tens condition?

CodePudding user response：

I'm not sure if this is what you're looking for. I separated the data and the plot and applied stat_smooth for each group. Unfortunately, the smoothed lines do not follow the color scheme. You will also see several warnings do to the method in which this creates the splines.

plt <- ggplot(df1, aes(x=time, y=depth, colour = time))  
    geom_label(aes(label=round(R)))   
    scale_y_continuous(trans = "reverse")  
    geom_path(aes(group=G), size = .6, alpha = .5)

lapply(1:length(unique(df1$G)),
       function(i){
         df2 <- df1 %>% filter(G == unique(G)[i])
         plt <<- plt   
           stat_smooth(data = df2, size = .5,
                       aes(x = time, y = depth), 
                       se = F,  method = lm, color = "darkred",
                       formula = y ~ splines::bs(x, knots = nrow(df2)))
       })

You can extend this further with additional parameters. I'm just not sure exactly what you're expecting.

plt <- ggplot(df1, aes(x=time, y=depth, colour = time))  
    geom_label(aes(label=round(R)))   
    scale_y_continuous(trans = "reverse")  
    geom_path(aes(group=G), size = .6, alpha = .5)

lapply(1:length(unique(df1$G)),
       function(i){
         df2 <- df1 %>% filter(G == unique(G)[i])
         # u <- df1 %>% {nrow(unique(.[,c(1:2)]))}
         plt <<- plt   
           stat_smooth(
             data = df2, size = .5,
             aes(x = time, y = depth), 
             se = F,  method = lm, color = "darkred",
             formula = y ~ splines::bs(x, knots = nrow(df2),
                                       degree = ifelse(nrow(df2) <= 4,
                                                       3, nrow(df2) - 2)))
       })