This report is automatically generated with the R package knitr (version 1.40) .

sigfig <- function(vec, n=3){
  ### function to print values to N significant digits without dropping trailing zeros
  # input:   vec       vector of numeric
  #          n         integer is the required sigfig  
  # output:  outvec    vector of numeric rounded to N sigfig

  # returns a character output - used in "hovertext" for plotly graphs
  formatC(signif(vec,digits=n), digits=n, format="fg", flag="#")
}


predictionModelPlot <- function(source, knownXlabel=NULL, .predictedYcol=predictedY, predictedYsigfigs=3, .groupByCol, allGroups=NULL, title='', xTitle=NULL, yTitle=NULL, color='', showLegend=F){
  # source         - a single row from a predictionModels() object
  # .groupByCol    - column that will be used to distinguish by color and shape
  # allGroups      - a vector of all unique values in the .groupByCol, which might be a subset
  # .predictedYcol - defaults to the "predictedY" col returned by predictionModels(); usually renamed by user to something more identifiable
  # source <- LMBSafeLevels_Subarea[1,]   # example data from "Recalculate LMB Safe Level.R"

  # .predictedYcol <- quo(LMBSafeLevel) - to test function line-wise
  predictedYcol <- enquo(.predictedYcol)

  # .groupByCol <- quo(TMDL) - to test function line-wise
  groupBy <- enquo(.groupByCol)

  # extract data and model from source
  dataframe <- source$data[[1]]

  .knownXcol <- quo(!!sym(source$knownXcol))
  dfKnownXcol <- enquo(.knownXcol)

  known_Xlabel <- if (is.null(knownXlabel)){
    paste0(as_label(dfKnownXcol),'<sub>known</sub>=',source$knownX)
  } else {
    paste0(knownXlabel,'=',source$knownX)
  }

  .knownYcol <- quo(!!sym(source$knownYcol))
  dfKnownYcol <- enquo(.knownYcol)

  dfKnownX    <- source$knownX


  # Regression Model 
  model     <- source$Model[[1]]
  modelName <- source$ModelName

  model_predict <- tibble(!!dfKnownXcol := seq(floor(  min(dataframe %>% pull(!!dfKnownXcol), dfKnownX)*95)/100,
                                               ceiling(max(dataframe %>% pull(!!dfKnownXcol), dfKnownX)*105)/100,
                                               length.out=500))
  model_predictOrig <- model_predict %>%
    mutate(!!dfKnownYcol := case_when(modelName == 'pwr' | modelName == 'exp' ~ exp(predict(model, model_predict %>% select(!!dfKnownXcol))),
                                      T ~ predict(model, model_predict %>% select(!!dfKnownXcol))))


  #ggplot shapes & colors
  Subareas <- if(!is.null(allGroups)) allGroups else unique(dataframe %>% pull(!!groupBy))
  mySubareashapes <- c(15, 16, 17, 18, 8, 22, 21, 23, 24, 4)
  Subareashapes   <- setNames(mySubareashapes[1:length(Subareas)], Subareas)

  # color safe palette - https://personal.sron.nl/~pault/#sec:qualitative
  if(color == ''){
    mySubareacolors <- c('#0077BB','#33BBEE','#009988','#EE7733','#CC3311','#EE3377', '#919191') # Changed '#BBBBBB' light gray to '#919191' darker gray
    Subareacolors   <- setNames(mySubareacolors[1:length(Subareas)], Subareas)
  } else {
    mySubareacolors <- rep(color, 6)
    Subareacolors   <- setNames(mySubareacolors[1:length(Subareas)], Subareas)
  }


  used_colors_orig <- Subareacolors[unique(dataframe %>% pull(!!groupBy))]
  used_shapes_orig <- Subareashapes[unique(dataframe %>% pull(!!groupBy))]

  xMax <- ceiling(max(model_predictOrig[[1]])*10)/10  #ceiling(max(dataframe %>% select(!!dfKnownXcol), dfKnownX*1.1)*10)/10 
  yMax <- ceiling(max(model_predictOrig[[2]], max(dataframe %>% select(!!dfKnownYcol)))*10)/10

  xscale <- xMax / as.numeric(gsub("\\.+|0+","", xMax)) # removes 0's and "." from value


  #Plot Data Points & Regression Line
  regressionGraph <- ggplot() +
    ggtitle(title) +
    xlab(if(is.null(xTitle)){as_label(dfKnownXcol)}else{xTitle}) +
    ylab(if(is.null(yTitle)){as_label(dfKnownYcol)}else{yTitle}) +
    # ylab('Average Aqueous MeHg<sub>unf</sub> (ng/L)') +
    #Data Points
    geom_point(data=dataframe, aes(x=!!dfKnownXcol, y=!!dfKnownYcol, color=!!groupBy, shape=!!groupBy),
               alpha=1,
               size=3,
               show.legend=T) +
    #Regression Line
    geom_point(data=model_predictOrig, aes(x=!!dfKnownXcol, y=!!dfKnownYcol),
               color='grey26',
               size=.3,
               show.legend=F) +
    #Regression Model SER (Standard Error of Regression)
    annotate("text", x=xMax * 1/5, y=mean(c(yMax, source %>% pull(!!predictedYcol))), # source %>% pull(!!predictedYcol)*1.9,
             label=paste0('Model<sub>', source$ModelName, '</sub>SER=', sigfig(source$SER,3),''), color='grey26') +
    #Scale & Theme
    scale_x_continuous(expand = c(0, 0), limits = c(0, xMax)) +
    scale_y_continuous(expand = c(0, 0), limits = c(0, yMax)) +
    scale_color_manual(values = used_colors_orig) +
    scale_shape_manual(values = used_shapes_orig) +
    theme_light() +
    theme(text         = element_text(size=14),
          legend.position=if(showLegend == F){'none'}else{''}, # Hide legend in plotly
          legend.title = element_blank())

  regressionPlotly <- ggplotly(regressionGraph, tooltip='text')
  #REMOVE Paranethesis & commas that ggplotly sometimes adds to legend labes
  #https://stackoverflow.com/questions/49133395/strange-formatting-of-legend-in-ggplotly-in-r
  for (i in 1:length(regressionPlotly$x$data)){
    if (!is.null(regressionPlotly$x$data[[i]]$name)){
      regressionPlotly$x$data[[i]]$name =  gsub("\\(","",str_split(regressionPlotly$x$data[[i]]$name,",")[[1]][1])
    }
  }


  #Add Prediction Line
  predictionGraph <- regressionGraph +
    #Vertical Line
    geom_segment(aes(x=source$knownX, xend=source$knownX, y=0, yend=source %>% pull(!!predictedYcol)), color='grey26') +
    #Vertical Line Text - Known X
    annotate("text", x=source$knownX + 0, hjust=0, y=source %>% pull(!!predictedYcol)/4, label=known_Xlabel, color='grey26') +
    #Horizontal Line
    geom_segment(aes(x=0, xend=source$knownX, y=source %>% pull(!!predictedYcol), yend=source %>% pull(!!predictedYcol)), color='grey26') +
    #Horizontal Line Text - Predicted Y
    annotate("text", x=source$knownX/2, y=source %>% pull(!!predictedYcol), label=paste0('Predicted<sub>',as_label(dfKnownYcol),'</sub><br>', sigfig(source %>% pull(!!predictedYcol), predictedYsigfigs)), color='grey26')

  predictionPlotly <- ggplotly(predictionGraph, tooltip='text')
  #REMOVE Paranethesis & commas that ggplotly sometimes adds to legend labes
  #https://stackoverflow.com/questions/49133395/strange-formatting-of-legend-in-ggplotly-in-r
  for (i in 1:length(predictionPlotly$x$data)){
    if (!is.null(predictionPlotly$x$data[[i]]$name)){
      predictionPlotly$x$data[[i]]$name =  gsub("\\(","",str_split(predictionPlotly$x$data[[i]]$name,",")[[1]][1])
    }
  }



  if(is.null(knownXlabel)){
    return(regressionPlotly)
  } else return(predictionPlotly)

  # htmlwidgets::saveWidget(plotly::as_widget(regressionPlotly), "test.html") #if get an error try a simple file name
}

The R session information (including the OS info, R version and all packages used):

    sessionInfo()
## R version 4.2.2 (2022-10-31 ucrt)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 22621)
## 
## Matrix products: default
## 
## locale:
## [1] LC_COLLATE=English_United States.utf8  LC_CTYPE=English_United States.utf8   
## [3] LC_MONETARY=English_United States.utf8 LC_NUMERIC=C                          
## [5] LC_TIME=English_United States.utf8    
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] mgcv_1.8-41        nlme_3.1-160       lubridate_1.8.0    plotly_4.10.0     
##  [5] readxl_1.4.1       actuar_3.3-0       NADA_1.6-1.1       forcats_0.5.2     
##  [9] stringr_1.4.1      dplyr_1.0.9        purrr_0.3.4        readr_2.1.2       
## [13] tidyr_1.2.0        tibble_3.1.8       ggplot2_3.3.6      tidyverse_1.3.2   
## [17] fitdistrplus_1.1-8 survival_3.4-0     MASS_7.3-58.1     
## 
## loaded via a namespace (and not attached):
##  [1] lattice_0.20-45     assertthat_0.2.1    digest_0.6.29       utf8_1.2.2         
##  [5] R6_2.5.1            cellranger_1.1.0    backports_1.4.1     reprex_2.0.2       
##  [9] evaluate_0.16       highr_0.9           httr_1.4.4          pillar_1.8.1       
## [13] rlang_1.0.5         lazyeval_0.2.2      googlesheets4_1.0.1 rstudioapi_0.14    
## [17] data.table_1.14.2   Matrix_1.5-1        splines_4.2.2       googledrive_2.0.0  
## [21] htmlwidgets_1.5.4   munsell_0.5.0       broom_1.0.1         compiler_4.2.2     
## [25] modelr_0.1.9        xfun_0.32           pkgconfig_2.0.3     htmltools_0.5.3    
## [29] tidyselect_1.1.2    fansi_1.0.3         viridisLite_0.4.1   crayon_1.5.1       
## [33] tzdb_0.3.0          dbplyr_2.2.1        withr_2.5.0         grid_4.2.2         
## [37] jsonlite_1.8.0      gtable_0.3.1        lifecycle_1.0.1     DBI_1.1.3          
## [41] magrittr_2.0.3      scales_1.2.1        cli_3.3.0           stringi_1.7.8      
## [45] fs_1.5.2            xml2_1.3.3          ellipsis_0.3.2      generics_0.1.3     
## [49] vctrs_0.4.1         expint_0.1-7        tools_4.2.2         glue_1.6.2         
## [53] hms_1.1.2           fastmap_1.1.0       colorspace_2.0-3    gargle_1.2.0       
## [57] rvest_1.0.3         knitr_1.40          haven_2.5.1
    Sys.time()
## [1] "2023-12-26 09:32:30 PST"