Main changes to dev

.Rbuildignore

@@ -4,3 +4,8 @@
 ^Notes - Sim model for management C.beticola in SB.Rmd$
 ^Notes---Sim-model-for-management-C.beticola-in-SB.html$
 ^cercospora.bib$
+^_pkgdown\.yml$
+^docs$
+^pkgdown$
+^\.github$
+.Rprofile

.github/.gitignore

@@ -0,0 +1 @@
+*.html

.github/workflows/pkgdown.yaml

@@ -0,0 +1,47 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+  release:
+    types: [published]
+  workflow_dispatch:
+
+name: pkgdown
+
+jobs:
+  pkgdown:
+    runs-on: ubuntu-latest
+    # Only restrict concurrency for non-PR jobs
+    concurrency:
+      group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    permissions:
+      contents: write
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::pkgdown, local::., PaulMelloy/epiphytoolR
+          needs: website
+
+      - name: Build site
+        run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE)
+        shell: Rscript {0}
+
+      - name: Deploy to GitHub pages 🚀
+        if: github.event_name != 'pull_request'
+        uses: JamesIves/[email protected]
+        with:
+          clean: false
+          branch: gh-pages
+          folder: docs

.gitignore

@@ -4,3 +4,4 @@
 .httr-oauth
 .DS_Store
 inst/doc
+docs

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: cercospoRa
-Title: What the Package Does (One Line, Title Case)
-Version: 0.0.0.9001
+Title: Mechanistic Epidemiological Model for Cercospora Leaf Spot of Sugar Beet
+Version: 0.0.0.9002
 Authors@R: c(
     person(given = "Paul",
            family = "Melloy",
@@ -30,25 +30,35 @@ Authors@R: c(
            family = "Mahlein",
            role = c("ctb"),
            comment = c(ORCID = "0000-0003-1091-3690")))
-Description: Mechanistic epidemiological model for Cercospora leaf spot of sugar beet
+Description: This package provides functions to recreate the negative prognosis 
+    epidemiological model for describing when the model can't be certain a 
+    chance Cercospora leaf spot (_Cercospora beticola_) epidemic has not 
+    commenced. The model is based on the work of Wolf and Verreet 
+    (2005 <https://apsjournals.apsnet.org/doi/abs/10.1094/PHYTO-95-0269>).
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Suggests: 
     knitr,
     rmarkdown,
     testthat (>= 3.0.0),
     lubridate,
-    remotes
+    remotes,
+    epiphytoolR,
+    stats,
 Config/testthat/edition: 3
 Imports: 
     data.table,
-    epiphytoolR,
     Rdpack,
-    stats
+    sf,
+    terra,
+    minpack.lm
 RdMacros: Rdpack
 VignetteBuilder: knitr
+Remotes: 
+    PaulMelloy/epiphytoolR
 Depends: 
     R (>= 2.10)
 LazyData: true
+URL: https://paulmelloy.github.io/cercospoRa/

LICENSE.md

@@ -1,6 +1,6 @@
 # MIT License
 
-Copyright (c) 2023 cercospoRa authors
+Copyright (c)(CC-BY-SA-4.0) 2023 cercospoRa authors
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal
@@ -12,6 +12,9 @@ furnished to do so, subject to the following conditions:
 The above copyright notice and this permission notice shall be included in all
 copies or substantial portions of the Software.
 
+[Creative Commons Attribution-ShareAlike 4.0 International Public
+License](https://www.r-project.org/Licenses/CC-BY-SA-4.0)
+
 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE

NAMESPACE

@@ -1,14 +1,12 @@
 # Generated by roxygen2: do not edit by hand
 
 export(calc_DIV)
+export(calc_c_closure)
 export(calc_epidemic_onset)
-export(calc_inf_rate)
-export(calc_pseudo_maturity)
-export(calc_sb_emergence)
-export(calc_spore_rate)
-export(calc_sugarbeet_gdd)
-export(cercospora_dk)
-export(estimate_sb_drymatter)
+export(calc_epidemic_onset_from_image)
+export(calc_r_x0)
+export(read_sb_growth_parameter)
 import(data.table)
 importFrom(Rdpack,reprompt)
 importFrom(data.table,":=")
+importFrom(terra,plot)

NEWS.md

@@ -1,6 +1,18 @@
 # cercospoRa (development version)
+  - Four functions have been added to deal with spatial heterogeneity:
+    - `read_sb_growth_parameter`: read in and format raster images to allow 
+     further computation.
+    - `calc_r_x0`: fit logistic growth curve to the date.
+    - `calc_c_closure`: to deduct canopy closure dates from the fitted curves.
+    - `calc_epidemic_onset_from_image`: builds on the existing `calc_epidemic_onset` 
+    function to compute a value for each pixel.
+  - Example datasets have been provided to check the functions. 
+  It consists of a folder containing two LAI maps computed from UAV images.  
+
 
 # cercospoRa 0.0.0.9001
-Change package name
+ - Change package name  
+ - Add pkgdown site  
+ - Reduce functions to only those described by Wolf and Verreet (2005)  
 
 # cercosporaR 0.0.0.9000

R/calc_DIV.R

@@ -65,19 +65,12 @@ calc_DIV <- function(date_time, Tm,RH, rain,dat){
              ]
 
   dat[, c("Tm_index",
-          "moist_ind",
-          "s_rate",
-          "inf_rate") := list(temperature_index(temp),
-                              moisture_index(rh,rain),
-                              calc_spore_rate(temp,rh),
-                              calc_inf_rate(temp, RH = rh))]
+          "moist_ind") := list(temperature_index(temp),
+                              moisture_index(rh,rain,70))]
 
-  DIV <- dat[, list(DIV = mean(fifelse(Tm_index == 0 | moist_ind == 0,
-                                  0, (Tm_index * moist_ind))),
-                    DIV_racca = mean(Tm_index *
-                                       s_rate *
-                                       inf_rate)),
-             by = c("Year","Month","Day")]
+  DIV <- dat[, list(DIV = mean(fifelse(test = Tm_index == 0 | moist_ind == 0,
+                                  yes = 0, no = (Tm_index * moist_ind)))),
+             by = c("Year", "Month", "Day")]
 
   return(DIV)
 }

R/calc_c_closure.R

@@ -0,0 +1,40 @@
+#' Calculate growth rate(r) and LAI0 at time t0
+#'
+#' @param param_rxt Output of the function \link{calc_r_x0}, which produces a
+#'  list containing parameters that are necessary to calculate `c_closure`.
+#'  These parameters are `r`, the growth rate, `x0`, the initial LAI value, and
+#'  `t0`, the initial date and the associated dates
+#' @param x1 LAI value at which 90% canopy closure is reached. It is fixed to
+#'  1.3 for sugar beet.
+#' @param k carrying capacity, which is the maximum LAI that can be attained.
+#'  This value can be cultivar-dependent. The default is fixed to 6
+#'
+#' @return `c_closure` date at which 90% canopy closure is reached at each location.
+#'
+#' @export
+#'
+#'
+#' @examples
+#' img_dir <- system.file("extdata", "uav_img",package = "cercospoRa")
+#' epidemic_onset_param <-
+#'   read_sb_growth_parameter(img_files = list.files(img_dir,pattern = "tif",
+#'                                                   full.names = TRUE),
+#'                            img_dates = as.POSIXct(
+#'                              c("2022-06-14","2022-06-28"),tz = "UTC"),
+#'                            target_res = 10)
+#' param_rxt <- calc_r_x0(epidemic_onset_param,
+#'                        min_r = 0.02,
+#'                        max_r = 0.05,
+#'                        k = 6)
+#' c_closure <- calc_c_closure(param_rxt,
+#'                             x1 = 1.3,
+#'                             k=6 )
+calc_c_closure <- function(param_rxt,
+                           x1 = 1.3,
+                           k=6 ){
+  x0 <- param_rxt$x0
+  r <- param_rxt$r
+  t0 <- param_rxt$t0
+  c_closure <- as.numeric(t0)/(24*60*60) + round(log( x1*(k-x0)/(x0*(k-x1)))/r,0)
+  return(c_closure)
+}

R/calc_epidemic_onset.R

@@ -42,25 +42,26 @@ calc_epidemic_onset <- function(start,
     warning("'c_closure' not supplied, setting 'start' as canopy closure date")
     start <- c_closure
   }
-  if(c_closure >= end) stop("'c_closure' is after last weather date")
 
-  w <- copy(weather[times > as.POSIXct(start) &
-                times < (as.POSIXct(end) + 3600),][times >= as.POSIXct(c_closure)])
+  c_closure <- as.POSIXct(c_closure,tz = "UTC")
 
-  daily_inf_val <- calc_DIV(dat = w)
+  out <- sapply(c_closure,function(cc){
+    if(is.na(cc)) return(NA)
+    if(cc >= end) stop("'c_closure' is after last weather date")
 
-  div_cs <- daily_inf_val[first(which(cumsum(DIV) >cultivar_sus)),
-                          as.POSIXct(paste(Year,Month,Day,sep = "-"), tz = "UTC")]
+    w <- copy(weather[times > as.POSIXct(start) &
+                        times < (as.POSIXct(end) + 3600),][times >= as.POSIXct(cc)])
 
-  # return date when 5% of canopy is infected
-  div_cs_r <- daily_inf_val[first(which(cumsum(DIV_racca) > 0.05)),
-                          as.POSIXct(paste(Year,Month,Day,sep = "-"), tz = "UTC")]
+    daily_inf_val <- calc_DIV(dat = w)
 
-  if(length(div_cs) == 0) div_cs <- sum(daily_inf_val$DIV, na.rm = TRUE) / cultivar_sus
-  # calculate percentage
-  if(length(div_cs_r) == 0) div_cs_r <- sum(daily_inf_val$DIV_racca,na.rm = TRUE) *100
+    div_cs <- daily_inf_val[first(which(cumsum(DIV) >cultivar_sus)),
+                            as.POSIXct(paste(Year,Month,Day,sep = "-"), tz = "UTC")]
 
-  return(list(wolf_date = div_cs[1],
-              racca_date = div_cs_r[1]))
+    if(length(div_cs) == 0) div_cs <- sum(daily_inf_val$DIV, na.rm = TRUE) / cultivar_sus
+    # calculate percentage
 
+    return(div_cs[1])
+  })
+
+  return(as.POSIXct(out,tz = "UTC"))
 }

R/calc_epidemic_onset_from_image.R

@@ -0,0 +1,83 @@
+#' Calculate epidemic onset from image
+#'
+#' @param start posixct, start date in which to begin calculating the epidemic
+#'  onset, if not specified, the first date in the weather data will be used.
+#' @param end posixct, end date, last date to complete calculating the epidemic
+#'  onset, if not specified, the last date in the weather data will be used.
+#' @param c_closure map of canopy closure dates formatted as number of days since
+#' 1970-01-01. It defines the date to start running the model (Wolf)
+#' @param weather data.table, formatted with `epiphytoolR::format_weather`
+#' @param cultivar_sus character, susceptibility of the cultivar in "R" resistant,
+#'  "S" susceptible, "MR" moderately resistant ect.
+#' @importFrom terra plot
+#' @return `$wolf_date:` If the input weather is conducive for epidemic, the function returns a
+#'  POSIX_ct date when epidemic commences. If no epidemic occurs, a numeric,
+#'  proportion indicating the progress an epidemic is returned
+#'
+#' @export
+#'
+#' @examples
+#' wethr <- read.csv(system.file("extdata", "clean_weather.csv",
+#'                   package = "cercospoRa"))
+#' wethr <- epiphytoolR::format_weather(wethr,time_zone = "UTC")
+#'
+#' img_dir <- system.file("extdata", "uav_img",package = "cercospoRa")
+#'
+#' epidemic_onset_param <-
+#'    read_sb_growth_parameter(
+#'       list.files(img_dir,pattern = "tif",
+#'                  full.names = TRUE),
+#'       img_dates = as.POSIXct(c("2022-06-14","2022-06-28"),
+#'                              tz = "UTC"),
+#'       10)
+#' param_rxt <- calc_r_x0(epidemic_onset_param,
+#'                        min_r = 0.02,
+#'                        max_r = 0.05,
+#'                        k = 6)
+#' c_closure <- calc_c_closure(param_rxt,
+#'                             x1 = 1.3,
+#'                             k=6 )
+#'
+#' epidemic_onset_map <- calc_epidemic_onset_from_image(start = as.POSIXct("2022-04-25",tz = "UTC"),
+#'                                                      end = as.POSIXct("2022-09-30",tz = "UTC"),
+#'                                                      c_closure = c_closure,
+#'                                                      weather = wethr)
+#'
+#' terra::plot(epidemic_onset_map)
+calc_epidemic_onset_from_image <- function(start,
+                                           end,
+                                           c_closure,
+                                           weather,
+                                           cultivar_sus = 5){
+  # initialise onset raster
+
+  Ep_onset <- terra::app(x = c_closure,
+                        calc_r_onset,
+                        start = start,
+                        end = end,
+                        weather = weather,
+                        cultivar_sus = cultivar_sus)
+
+  return(Ep_onset)
+}
+
+#' Calculate epidemic onset from raster
+#'
+#' @details
+#'  Wrapper function to help internally calculate the earliest CLS onset date
+#'  from canopy closure dates supplied as integers with an origin date of 1970-01-01
+#'
+#' @param r SpatRaster with integer onset dates as values. This is usually the
+#'  output of `calc_c_closure`
+#' @param ... additional arguments to be supplied to `calc_epidemic_onset()`
+#'
+#' @return SpatRaster with integer values representing days since origin "1970-01-01"
+#' @noRd
+calc_r_onset <- function(r, ...){
+  #cat(r," | ")
+  c_closure_date <- as.Date.numeric(round(r),
+                                    origin = '1970-01-01')
+  onset_epidemic_date <- calc_epidemic_onset(c_closure = c_closure_date, ...)
+  return(as.integer(onset_epidemic_date))
+}
+