CRAN

atmoschem · Oct 8, 2021 · 848d59d · 848d59d
1 parent 16fba5f
commit 848d59d
Show file tree

Hide file tree

Showing 79 changed files with 5,634 additions and 304 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -2,7 +2,7 @@ Package: vein
 Type: Package
 Title: Vehicular Emissions Inventories
 Version: 0.9.4
-Date: 2021-09-25
+Date: 2021-10-06
 Authors@R: c( 
   person(given = "Sergio", family = "Ibarra-Espinosa",
          role = c("aut", "cre"),

diff --git a/NEWS.md b/NEWS.md
@@ -5,9 +5,8 @@ NEWS
 
 - get_project with *Europe*, Chinese and MOVES EF
 - Add EF from HBEFA
-- Reduce size of sysdata
 
-### vein 0.9.4
+### vein 0.9.4 (5 years!!)
 - add CBMZ into chem_vein. Based on Yang Zhang Labs data and Carter 2015 (Release date: 2021-06-28)
 - add projects `curitiba` and `masp2020`  (Release date: 2021-06-28)
 - fix chem_vein2 for CB4 and CBMZ  (Release date: 2021-07-08)
@@ -24,8 +23,9 @@ NEWS
 - add Ecuador
 - For MOVES contributions, added Joao Bazzo
 - reduced size for ef_hdv_speed. Speciation use `speciate`.
+- Deprecated ef_emfac. I never used and it was too heavy.
 
-### vein 0.9.4 (Release date: 2021-06-09)
+### vein 0.9.3 (Release date: 2021-06-09)
 - Fix RCHO in ef_cetesb
 - Change numeric_dc to vector_dv to avoid copying (dotCall64)
 - update gitlab link for veinextras in get_project

diff --git a/R/ef_emfac.R b/R/ef_emfac.R
@@ -1,4 +1,4 @@
-#' EMFAC2017 emission factors for Statewide California, Calendar Year 2020
+#' Deprecated - EMFAC2017 emission factors for Statewide California, Calendar Year 2020
 #'
 #' \code{\link{ef_emfac}} returns emission factors reflecting California, US,
 #' conditions. If the user enter speeds more emission factors are returned.
@@ -8,123 +8,24 @@
 #' @param fuel Character; "Diesel", "Gasoline", "Electricity" or "Natural Gas"
 #' @param mph Numeric; Speed in miles per hour (optional).
 #' @param pol Character;
-#' \itemize{
-#' \item{if the user enter mph}{"NOx_RUNEX", "PM2.5_RUNEX", "PM10_RUNEX",
-#' "CO2_RUNEX", "CH4_RUNEX", "N2O_RUNEX", "ROG_RUNEX", "TOG_RUNEX", "CO_RUNEX",
-#' "SOx_RUNEX"}
-#' \item{if the user do not enter mph}{
-#' "NOx_RUNEX", "NOx_IDLEX", "NOx_STREX",
-#' "PM2.5_RUNEX", "PM2.5_IDLEX", "PM2.5_STREX",
-#' "PM2.5_PMTW" , "PM2.5_PMBW", "PM10_RUNEX",
-#' "PM10_IDLEX", "PM10_STREX", "PM10_PMTW",
-#' "PM10_PMBW", "CO2_RUNEX", "CO2_IDLEX",
-#' "CO2_STREX", "CH4_RUNEX", "CH4_IDLEX",
-#' "CH4_STREX", "N2O_RUNEX", "N2O_IDLEX",
-#' "N2O_STREX", "ROG_RUNEX", "ROG_IDLEX",
-#' "ROG_STREX", "ROG_HOTSOAK", "ROG_RUNLOSS",
-#' "ROG_RESTLOSS", "ROG_DIURN", "TOG_RUNEX",
-#' "TOG_IDLEX", "TOG_STREX", "TOG_HOTSOAK",
-#' "TOG_RUNLOSS", "TOG_RESTLOSS", "TOG_DIURN",
-#' "CO_RUNEX", "CO_IDLEX", "CO_STREX",
-#' "SOx_RUNEX", "SOx_IDLEX", "SOx_STREX"
-#' }
-#' }
 #' @param season Character: "winter" or "summer".
 #' @param full Logical: To return the whole data.table or not.
 #' @return data.table with emission factors.
-#' @keywords speed emission factors emfac
 #' @references https://arb.ca.gov/emfac/emissions-inventory
-#' @importFrom data.table fifelse
+#' @name vein-deprecated
+#' @seealso \code{\link{vein-deprecated}}
+#' @keywords internal
+NULL
+
+#' @rdname vein-deprecated
+#'
 #' @export
 #' @examples \dontrun{
-#' #do not run
-#' pols <- c("CO_RUNEX", "NOx_RUNEX")
-#' dfef2 <- ef_emfac(full = TRUE)
-#' colplot(df = dfef2,
-#'         x = dfef2$Model_Year,
-#'         cols = pols,
-#'         main = "EF from LDT1 with Gasoline on Winter",
-#'         ylab = units(dfef2[[pols[1]]][1]))
+#' # do not run
+#' # DEPRECATED
 #' }
-ef_emfac <- function(veh = "LDT1",
-                     fuel = "Gasoline",
-                     mph,
-                     pol = "CO_RUNEX",
-                     season = "winter",
-                     full = FALSE){
-  units::install_symbolic_unit("trip", warn = FALSE)
-  units::install_symbolic_unit("veh", warn = FALSE)
-
-  Vehicle_Category <- NULL
-  Model_Year <- NULL
-  Speed <- NULL
-  Fuel <- NULL
-  Season <- NULL
-  # pol <- NULL
-
-  if(missing(mph)) {
-    ef <-sysdata$emfac_agg
-    dt <- ef[Vehicle_Category %in% veh &
-               Fuel %in% fuel &
-               Season %in% season, ]
-    if(full) {
-      return(dt)
-    } else {
-      x <- cbind(dt[, c(1:9,52:54)], dt[[pol]])
-      data.table::setnames(x, c(names(dt[, c(1:9,52:54)]), pol))
-      return(x)
-    }
-  } else {
-    mph <- as.numeric(mph)
-    mph <- data.table::fifelse(
-      mph <= 5, 5L,
-      data.table::fifelse(
-        mph>5 & mph <=10, 10L,
-        data.table::fifelse(
-          mph>10 & mph <=15, 15L,
-          data.table::fifelse(
-            mph>15 & mph <= 20, 20L,
-            data.table::fifelse(
-              mph>20 & mph<=25, 25L,
-              data.table::fifelse(
-                mph>25 & mph<=30, 30L,
-                data.table::fifelse(
-                  mph>30 & mph<=35, 35L,
-                  data.table::fifelse(
-                    mph>35 & mph<=40, 40L,
-                    data.table::fifelse(
-                      mph>40 & mph<=45, 45L,
-                      data.table::fifelse(
-                        mph>45 & mph<=50, 50L,
-                        data.table::fifelse(
-                          mph>50 & mph<=55, 55L,
-                          data.table::fifelse(
-                            mph>55 & mph<=60, 60L,
-                            data.table::fifelse(
-                              mph>60 & mph<=65, 65L,
-                              data.table::fifelse(
-                                mph>65 & mph<=70, 70L,
-                                data.table::fifelse(
-                                  mph>70 & mph<=75, 75L,
-                                  data.table::fifelse(
-                                    mph>75 & mph<=80, 80L,
-                                    data.table::fifelse(
-                                      mph>80 & mph<=85, 85L,
-                                      90L)))))))))))))))))
-    ef <-sysdata$emfac_speed
-
-    dt <- ef[Vehicle_Category %in% veh &
-               Fuel %in% fuel &
-               Speed %in% mph &
-               Season %in% season, ]
-    if(full) {
-      return(dt)
-    } else {
-      x <- cbind(dt[, c(1:7, 18:20)], x)
-      data.table::setnames(x, c(names(dt[, c(1:7,18:20)]), pol))
-      return(x)
-
-    }
-  }
 
+ef_emfac <-  function(x,  ...) {
+  .Deprecated("ef_emfac")
+  "ef_emfac"
 }
diff --git a/R/fuel_corr.R b/R/fuel_corr.R
@@ -13,6 +13,7 @@
 #' den (density at 15 celcius degrees kg/m3), pah (%), cn (number), t95
 #' (Back end distillation in Celcius degrees) and s  (sulphur, ppm)
 #' @return A list with the correction of emission factors.
+#' @importFrom data.table rbindlist
 #' @note This function cannot be used to account for deterioration, therefore,
 #' it is restricted to values between 0 and 1.
 #' Parameters for gasoline (g):
@@ -59,6 +60,8 @@ fuel_corr <- function(euro,
                             t95 = 350,     # C
                             s = 400)       # ppm
 ){
+  if(length(euro) == 1) {
+
   # Pre Euro
   bg1996 <- c(e100 = 52, aro = 39, o2 = 0.4, e150 = 86, olefin = 10, s = 165)
   # Euro 3
@@ -446,7 +449,21 @@ fuel_corr <- function(euro,
                COV = list(fif(fcov_hdv)),
                NOx = list(fif(fnox_hdv)),
                PM = list(fif(fpm_hdv))))
-  return(dfl)
+    return(dfl)
+
+  } else {
+    data.table::rbindlist(lapply(seq_along(euro), function(i) {
+      fuel_corr(euro = euro[i]) -> fcorr
+      value <- unlist(fcorr)
+      names(value)
+      fcorr <- as.data.frame(value)
+      fcorr$vehpol <- names(value)
+      fcorr <- cbind(fcorr, do.call("rbind", strsplit(fcorr$vehpol, "\\.")))
+      fcorr$euro <- euro[i]
+      fcorr
+    })) -> fcorr
+    return(fcorr)
 
+  }
 }
 
diff --git a/R/get_project.R b/R/get_project.R
@@ -18,13 +18,16 @@
 #'   amazon2014      \tab Top-down Amazon\tab CETESB+tunnel\tab  csv and.rds\cr
 #'   curitiba      \tab Bottom-down +GTFS\tab CETESB+tunnel\tab  csv and.rds\cr
 #'   masp2020      \tab Bottom-down\tab CETESB+tunnel\tab  csv and.rds\cr
+#'   ecuador_td      \tab Top-down\tab EEA\tab  csv and.rds\cr
 #'   ecuador_td_hot      \tab Top-down\tab EEA\tab  csv and.rds\cr
 #'   ecuador_td_hot_month      \tab Top-down\tab EEA\tab  csv and.rds\cr
-#'   moves_bu      \tab Bottom-down\tab US/EPA MOVES \tab  csv and.rds (requires MOVES on Windows)\cr
+#'   moves      \tab Bottom-up\tab US/EPA MOVES \tab  csv and.rds (requires MOVES >=3.0 on Windows)\cr
 #' }
 #' @param url String, with the URL to download VEIN project
 #' @note default case can be any of "brasil", "brazil", "brazil_bu", "brasil_bu", they are
 #' the same
+#' Projects for Ecuador are in development.
+#' In any case, if you find any error, please, send a pull request in github or gitlab.
 #' @importFrom utils download.file untar
 #' @export
 #' @examples \dontrun{
@@ -48,13 +51,12 @@ get_project <- function(directory,
     message("Your directory is in ", directory)
 
   } else if(case == "moves_bu"){
-    message("coming soon")
-    # URL <- "https://raw.githubusercontent.com/atmoschem/vein/master/projects/emislacovid.tar.gz"
-    # tf <- paste0(tempfile(), ".tar.gz")
-    # utils::download.file(url = URL,
-    #                      destfile =  tf)
-    # utils::untar(tarfile = tf, exdir = directory)
-    # message("Your directory is in ", directory)
+    URL <- "https://raw.githubusercontent.com/atmoschem/vein/master/projects/moves.tar.gz"
+    tf <- paste0(tempfile(), ".tar.gz")
+    utils::download.file(url = URL,
+                         destfile =  tf)
+    utils::untar(tarfile = tf, exdir = directory)
+    message("Your directory is in ", directory)
 
   } else if(case == "emislacovid"){
     URL <- "https://raw.githubusercontent.com/atmoschem/vein/master/projects/emislacovid.tar.gz"
@@ -112,6 +114,14 @@ get_project <- function(directory,
     utils::untar(tarfile = tf, exdir = directory)
     message("Your directory is in ", directory)
 
+  } else if(case %in% c("ecuador_td")){
+    URL <- "https://raw.githubusercontent.com/atmoschem/vein/master/projects/ecuador_td.tar.gz"
+    tf <- paste0(tempfile(), ".tar.gz")
+    utils::download.file(url = URL,
+                         destfile =  tf)
+    utils::untar(tarfile = tf, exdir = directory)
+    message("Your directory is in ", directory)
+
   } else if(case %in% c("ecuador_td_hot")){
     URL <- "https://raw.githubusercontent.com/atmoschem/vein/master/projects/ecuador_td_hot.tar.gz"
     tf <- paste0(tempfile(), ".tar.gz")

diff --git a/R/sysdata.rda b/R/sysdata.rda
diff --git a/demo/VEIN.R b/demo/VEIN.R
@@ -37,7 +37,8 @@ ggplot(df, aes(x = x, y = pc, colour = as.factor(Age))) + geom_point(size=3)  +
   scale_color_discrete(name = "Average age")
 
 # 3 ####
-data(pc_profile)
+data("profiles")
+pc_profile <- profiles$PC_JUNE_2012
 df2 <- data.frame(TF = as.numeric(unlist(pc_profile)),
                   Hour = rep(1:24,7),
                   Day = c(rep("Monday",24),
@@ -60,8 +61,10 @@ ggplot(df2, aes(x = Hour, y = TF, colour = Day,
 
 
 # 5 ####
-data(net) ; net <- as_Spatial(net)
-data(pc_profile)
+data(net)
+net <- as_Spatial(net)
+data("profiles")
+pc_profile <- profiles$PC_JUNE_2012
 pcw <- temp_fact(net$ldv+net$hdv, pc_profile)
 df <- netspeed(pcw, net$ps,
                net$ffs, net$capacity, net$lkm, alpha = 1)
@@ -114,8 +117,11 @@ ggplot(df4, aes(x=Hour, y=speed, colour=Street)) +
   theme(legend.position = "bottom", legend.key.width  = unit(2,units="cm"))
 
 # 7 ####
-data(fe2015)
-data(pc_profile)
+fe2015 <- ef_cetesb(p = c("CO"), veh = "PC_G", full = T, agemax = 36)
+names(fe2015)[ncol(fe2015)] <- "PC_G"
+names(fe2015)[5] <- "Euro_LDV"
+data("profiles")
+pc_profile <- profiles$PC_JUNE_2012
 data(fkm)
 pckm <- fkm[[1]](1:24)
 pckma <- cumsum(pckm)
@@ -128,7 +134,9 @@ cod <- c(co1$PC_G[1:24] * c(cod1,cod2),
          co1$PC_G[25:nrow(co1)])
 
 # 8 ####
-data(fe2015)
+fe2015 <- ef_cetesb(p = c("CO"), veh = "PC_G", full = T, agemax = 36)
+names(fe2015)[ncol(fe2015)] <- "PC_G"
+names(fe2015)[5] <- "Euro_LDV"
 data(fkm)
 pckm <- fkm[[1]](1:24); pckma <- cumsum(pckm)
 cod1 <- emis_det(po = "CO", cc = 1000, eu = "III", km = kma)
@@ -142,7 +150,8 @@ lef <- ef_ldv_scaled(dfcol = cod, v = "PC", cc = "<=1400",
 #          lef[length(lef)],lef[length(lef)])
 
 # 9 ####
-data(pc_profile)
+data("profiles")
+pc_profile <- profiles$PC_JUNE_2012
 data(net) ; net <- as_Spatial(net)
 E_CO <- emis(veh = pc1,lkm = net$lkm, ef = lef, speed = speed, profile = pc_profile)
 E_CO_DF <- emis_post(arra = E_CO, veh = "PC", size = "1400", fuel = "Gasoline",
@@ -188,7 +197,7 @@ df3$t_CO <- df3$t_CO*52/1000000
 sum(df3$t_CO)
 sum(df3[20:36,]$t_CO)/ sum(df3$t_CO)
 
-dfco <- data.frame(co = c(co1$PC_G,rep(co1$PC_G[length(co1$PC_G)],5),
+dfco <- data.frame(co = c(co1$PC_G, rep(co1$PC_G[length(co1$PC_G)],5),
                           c(cod,rep(cod[length(cod)],5))),
                    EF = c(rep("0 km", 41),rep("Deteriorated", 41)),
                    Age = rep(1:41,2))

diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
@@ -3,7 +3,7 @@ pkgdown: 1.6.1
 pkgdown_sha: ~
 articles:
   basics: basics.html
-last_built: 2021-09-28T00:16Z
+last_built: 2021-10-07T17:21Z
 urls:
   reference: http://atmoschem.github.io/vein//reference
   article: http://atmoschem.github.io/vein//articles

diff --git a/docs/reference/get_project.html b/docs/reference/get_project.html
diff --git a/docs/reference/index.html b/docs/reference/index.html