new_plotter.R

facet_residual_plot_loglog_lazy <- 
  function(
    x, 
    fit, 
    flist, 
    cutoff_index = 5,
    base_size = 10, 
    marker_size = 5, 
    line_width = 1
  ) {
    
    #' This is a sophisticated plot using all kind of tricks
    #' Two type of plots, `peak_area2`, and `residuals` are packaged as facets 
    #' To send data two one or the other facet, the data frames have a `name` variable
    #' This strategy is adopted for both lines and points
    #' Lines are drawn with geom_abline 
    
    save(list = ls(), file = "~/fitter2.RData")
    
    # first data frame pertains to points (real data)
    point_data <- 
      x %>% 
      mutate(
        res = res[, cutoff_index],
        rejected = rejected[, cutoff_index]
      ) %>% 
      filter(FEATURE_ID %in% flist) %>% 
      select(SAMPLE_ID, FEATURE_ID, peak_area2, conc2, Residuals = res, rejected) %>% 
      
      # recast
      rename(`Peak area`= peak_area2) %>% 
      pivot_longer(c(`Peak area`, Residuals))
    
    # ... and the second data frame to lines (fitted values)
    line_data <-
      fit %>% 
      filter(FEATURE_ID %in% flist) %>% 
      mutate(across(-FEATURE_ID, ~.x[, cutoff_index])) %>% 
      rename(b = log_offset) %>% 
      mutate(
        a = 1, 
        name = "Peak area"
        ) %>% 
      select(FEATURE_ID, a, b, a2, b2, r2, count, name) %>% 
      mutate(LAB1 = sprintf("%s \nR2 = %.2f \ncurve = %.2f", FEATURE_ID, r2, a2))
    
    
    # for labeller function
    facet1_names <- line_data$LAB1 %>% set_names(line_data$FEATURE_ID)
    
    # zero lines - only for residuals
    zero_line <-
      tibble(
        a = 0, b = 0, name = "Residuals"
      )
    
    # plot
    ggplot(
      data = point_data,
      mapping = aes(x = conc2, y = value)
    ) + 
      geom_point(mapping = aes(colour = rejected), size = marker_size) +
      
      # facets; this took a long time to figure out
      facet_grid(name~FEATURE_ID, scales = "free_y", space = "free_y", labeller = labeller(name = as.character, FEATURE_ID = facet1_names)) +
      
      # ablines; these are also facet specific because all data frames contain the `name` variable
      geom_abline(data = line_data, mapping = aes(intercept = b, slope = a), linewidth = line_width) +
      geom_abline(data = zero_line, mapping = aes(intercept = b, slope = a), linewidth = line_width) +
      geom_abline(data = line_data, mapping = aes(intercept = b2, slope = a2), colour = "skyblue", linewidth = line_width) +
      theme_bw(base_size = base_size) +
      labs(x="x' [ log2(concentration) ]", y="y' [ log2(peak area) ]") +
      scale_color_manual(values = c("black", "red"))
    
  }