merry fucking christmas

atmoschem · Dec 25, 2024 · 51ef824 · 51ef824
1 parent 9006884
commit 51ef824
Show file tree

Hide file tree

Showing 151 changed files with 740 additions and 1,544 deletions.
diff --git a/CODE_OF_CONDUCT.md b/CODE_OF_CONDUCT.md
@@ -1,45 +1 @@
-# Contributor Covenant Code of Conduct
-
-## Our Pledge
-
-In the interest of fostering an open and welcoming environment, we as contributors and maintainers pledge to making participation in our project and our community a harassment-free experience for everyone, regardless of age, body size, disability, ethnicity, gender identity and expression, level of experience, nationality, personal appearance, race, religion, or sexual identity and orientation.
-
-## Our Standards
-
-Examples of behavior that contributes to creating a positive environment include:
-
-* Being respectful of differing viewpoints and experiences
-* Gracefully accepting constructive criticism
-* Focusing on what is best for the community
-* Showing empathy towards other community members
-
-Examples of unacceptable behavior by participants include:
-
-* The use of sexualized language or imagery and unwelcome sexual attention or advances
-* Trolling, insulting/derogatory comments, and personal or political attacks
-* Public or private harassment
-* Publishing others' private information, such as a physical or electronic address, without explicit permission
-* Other conduct which could reasonably be considered inappropriate in a professional setting
-
-## Our Responsibilities
-
-Project maintainers are responsible for clarifying the standards of acceptable behavior and are expected to take appropriate and fair corrective action in response to any instances of unacceptable behavior.
-
-Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct, or to ban temporarily or permanently any contributor for other behaviors that they deem inappropriate, threatening, offensive, or harmful.
-
-## Scope
-
-This Code of Conduct applies both within project spaces and in public spaces when an individual is representing the project or its community. Examples of representing a project or community include using an official project e-mail address, posting via an official social media account, or acting as an appointed representative at an online or offline event. Representation of a project may be further defined and clarified by project maintainers.
-
-## Enforcement
-
-Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by contacting the project team at [email protected]. The project team will review and investigate all complaints, and will respond in a way that it deems appropriate to the circumstances. The project team is obligated to maintain confidentiality with regard to the reporter of an incident. Further details of specific enforcement policies may be posted separately.
-
-Project maintainers who do not follow or enforce the Code of Conduct in good faith may face temporary or permanent repercussions as determined by other members of the project's leadership.
-
-## Attribution
-
-This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, available at [http://contributor-covenant.org/version/1/4][version]
-
-[homepage]: http://contributor-covenant.org
-[version]: http://contributor-covenant.org/version/1/4/
+# do not be an asshole
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: vein
 Type: Package
 Title: Vehicular Emissions Inventories
-Version: 1.1.4
-Date: 2024-08-20
+Version: 1.2.0
+Date: 2024-12-25
 Authors@R: c( 
   person(given = "Sergio", family = "Ibarra-Espinosa",
          role = c("aut", "cre"),

diff --git a/NAMESPACE b/NAMESPACE
@@ -39,6 +39,7 @@ export(age)
 export(age_hdv)
 export(age_ldv)
 export(age_moto)
+export(age_veh)
 export(aw)
 export(celsius)
 export(check_nt)
@@ -84,7 +85,6 @@ export(emis_evap2)
 export(emis_grid)
 export(emis_hot_td)
 export(emis_long)
-export(emis_merge)
 export(emis_order)
 export(emis_paved)
 export(emis_post)

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,10 @@
 NEWS
 ===========
+### vein 1.2.0 (date: 2024-12-25)
+
+- Deprecated age_ldv, age_hdv and age_mc in favor of age_veh.
+- Deleted emis_merge, now all projects store emissions in databases.
+
 ### vein 1.1.4 (date: 2024-08-20)
 
 - ef_ldv_speed when LCV G and eu longer than 1,  works 

diff --git a/R/EmissionFactors.R b/R/EmissionFactors.R
@@ -108,26 +108,8 @@ plot.EmissionFactors <- function(x,
                                  mai3 = c(0.7, 0.62, 0.82, 0.42),
                                  bias = 1.5,
                                  ...) {
-  # ef <- x
-  # if (ncol(ef) >= 1 & ncol(ef) <= 3) {
-  #   graphics::par(mfrow=c(1, ncol(ef)), tcl = -0.5)
-  # } else if (ncol(ef) == 4) {
-  #   graphics::par(mfrow=c(2, 2), tcl = -0.5)
-  # } else if (ncol(ef) >= 5 & ncol(ef) <= 6 ) {
-  #   graphics::par(mfrow=c(2, 3), tcl = -0.5)
-  # } else if (ncol(ef) >= 7 & ncol(ef) <= 9 ) {
-  #   graphics::par(mfrow=c(3, 3), tcl = -0.5)
-  # } else {
-  #   message("Plotting first 9 plots")
-  #   graphics::par(mfrow=c(3, 3), tcl = -0.5)
-  # }
-  # nc <- ifelse(ncol(ef) <= 9, ncol(ef), 9)
-  # for (i in 1:nc) {
-  #   graphics::plot(ef[,i], type = "l", ...)
-  # }
-  # graphics::par(mfrow=c(1,1))
-  #
-  oldpar <- par(no.readonly = TRUE)       # code line i
+
+    oldpar <- par(no.readonly = TRUE)       # code line i
   on.exit(par(oldpar))                    # code line i + 1
 
   if(ncol(x) > 1) {
@@ -139,14 +121,6 @@ plot.EmissionFactors <- function(x,
                                                bias = bias)(seq(0, 1,0.01)),
                           maxColorValue = 255)
 
-    # fields::image.plot(
-    #   x = 1:ncol(x),
-    #   xaxt = "n",
-    #   z =t(as.matrix(x))[, nrow(x):1],
-    #   xlab = "",
-    #   ylab = paste0("EF by streets [",as.character(units(x[[1]])), "]"),
-    #   col = col, horizontal = TRUE)
-
     graphics::image(x = 1:ncol(x),
                     xaxt = "n",
                     z =t(as.matrix(x))[, nrow(x):1],

diff --git a/R/age_hdv.R b/R/age_hdv.R
@@ -51,132 +51,5 @@ age_hdv <- function (x,
                      verbose = FALSE,
                      namerows,
                      time){
-  # check na
-  x[is.na(x)] <- 0
-
-  x <- as.numeric(x)
-
-  # length k
-  if(length(k)  > 1 & length(k) < length(x)){
-    stop("length of 'k' must be 1 ore equal to length of 'x'")
-  }
-
-  # check agemax
-  if(agemax < 1) stop("Agemax should be bigger than 1")
-
-
-  # bystreet = TRUE
-  if (bystreet == TRUE){
-    if(length(x) != length(a)){
-      stop("Lengths of veh and age must be the same")
-    }
-    d <- suca <- list()
-    for (i in seq_along(x)) {
-      suca[[i]] <- function (t) {1/(1 + exp(a[i]*(t+b[i])))+1/(1 + exp(a[i]*(t-b[i])))}
-      anos <- seq(agemin,agemax)
-      d[[i]] <- (-1)*diff(suca[[i]](anos))
-      d[[i]][length(d[[i]])+1] <- d[[i]][length(d[[i]])]
-      d[[i]] <- d[[i]] + (1 - sum(d[[i]]))/length(d[[i]])
-      d[[i]] <- d[[i]]*x[i]
-    }
-    df <- as.data.frame(matrix(0,ncol=length(anos), nrow=1))
-    for (i in seq_along(x)) {
-      df[i,] <- d[[i]]
-    }
-
-    df <- as.data.frame(cbind(as.data.frame(matrix(0,ncol=agemin-1,
-                                                   nrow=length(x))), df))
-
-    names(df) <- paste(name,seq(1,agemax),sep="_")
-
-    df <- df*k
-
-    if(verbose){
-      message(paste("Average age of",name, "is",
-                    round(sum(seq(1,agemax)*base::colSums(df)/sum(df)), 2),
-                    sep=" "))
-      message(paste("Number of",name, "is",
-                    round(sum(df, na.rm = T), 3),
-                    " [veh]",
-                    sep=" "))
-      cat("\n")
-    }
-
-    if(!missing(namerows)) {
-      if(length(namerows) != nrow(df)) stop("length of namerows must be the length of number of rows of veh")
-      row.names(df) <- namerows
-    }
-
-
-
-    # replace NA and NaN
-    df[is.na(df)] <- 0
-
-    if(!missing(net)){
-      netsf <- sf::st_as_sf(net)
-      if(!missing(time)){
-        dfsf <- sf::st_sf(Vehicles(df*k, time = time), geometry = sf::st_geometry(netsf))
-      } else {
-        dfsf <- sf::st_sf(Vehicles(df*k), geometry = sf::st_geometry(netsf))
-      }
-      return(dfsf)
-    } else {
-      if(!missing(time)){
-        return(Vehicles(df*k, time = time))
-      } else {
-        return(Vehicles(df*k))
-      }
-    }
-
-    #bystreet = FALSE
-  } else {
-    suca <- function (t) {1/(1 + exp(a*(t+b)))+1/(1 + exp(a*(t-b)))}
-    anos <- seq(agemin,agemax)
-    d <- (-1)*diff(suca(anos))
-    d[length(d)+1] <- d[length(d)]
-    d <- d + (1 - sum(d))/length(d)
-    df <- as.data.frame(as.matrix(x) %*%matrix(d,ncol=length(anos), nrow=1))
-
-    df <- as.data.frame(cbind(as.data.frame(matrix(0,ncol=agemin-1,
-                                                   nrow=length(x))), df))
-
-    names(df) <- paste(name,seq(1,agemax),sep="_")
-
-    df <- df*k
-
-    if(verbose){
-      message(paste("Average age of",name, "is",
-                    round(sum(seq(1,agemax)*base::colSums(df)/sum(df)), 2),
-                    sep=" "))
-      message(paste("Number of",name, "is",
-                    round(sum(df, na.rm = T)/1000, 2),
-                    "* 10^3 veh", sep=" "))
-      cat("\n")
-    }
-
-    if(!missing(namerows)) {
-      if(length(namerows) != nrow(df)) stop("length of namerows must be the length of number of rows of veh")
-      row.names(df) <- namerows
-    }
-
-    # replace NA and NaN
-    df[is.na(df)] <- 0
-
-
-    if(!missing(net)){
-      netsf <- sf::st_as_sf(net)
-      if(!missing(time)){
-        dfsf <- sf::st_sf(Vehicles(df, time = time), geometry = sf::st_geometry(netsf))
-      } else {
-        dfsf <- sf::st_sf(Vehicles(df), geometry = sf::st_geometry(netsf))
-      }
-      return(dfsf)
-    } else {
-      if(!missing(time)){
-        return(Vehicles(df, time = time))
-      } else {
-        return(Vehicles(df))
-      }
-    }
-  }
+  .Deprecated("age_veh")
 }
diff --git a/R/age_ldv.R b/R/age_ldv.R
@@ -53,130 +53,5 @@ age_ldv <- function (x,
                      verbose = FALSE,
                      namerows,
                      time){
-  # check na
-  x[is.na(x)] <- 0
-
-  x <- as.numeric(x)
-
-  # length k
-  if(length(k)  > 1 & length(k) < length(x)){
-    stop("length of 'k' must be 1 ore equal to length of 'x'")
-  }
-
-  #check agemax
-  if(agemax < 1) stop("Agemax should be bigger than 1")
-
-  #bystreet = TRUE
-  if (bystreet == T){
-    if(length(x) != length(a)){
-      stop("Lengths of veh and age must be the same")
-    }
-    d <- suca <- list()
-    for (i in seq_along(x)) {
-      suca[[i]] <- function (t) {1 - exp(-exp(a[i] + b[i]*t))}
-      anos <- seq(agemin,agemax)
-      d[[i]] <- (-1)*diff(suca[[i]](anos))
-      d[[i]][length(d[[i]])+1] <- d[[i]][length(d[[i]])]
-      d[[i]] <- d[[i]] + (1 - sum(d[[i]]))/length(d[[i]])
-      d[[i]] <- d[[i]]*x[i]
-    }
-    df <- as.data.frame(matrix(0,ncol=length(anos), nrow=1))
-    for (i in seq_along(x)) {
-      df[i,] <- d[[i]]
-    }
-
-    df <- as.data.frame(cbind(as.data.frame(matrix(0,ncol=agemin-1,
-                                                   nrow=length(x))),
-                              df))
-
-    names(df) <- paste(name,seq(1,agemax),sep="_")
-
-    df <- df*k
-
-
-    if(verbose){
-      message(paste("Average age of",name, "is",
-                    round(sum(seq(1,agemax)*base::colSums(df, na.rm = T)/sum(df, na.rm = T)), 2),
-                    sep=" "))
-      message(paste("Number of",name, "is",
-                    round(sum(df, na.rm = T)/1000, 2),
-                    "* 10^3 veh",
-                    sep=" ")
-      )
-      cat("\n")
-    }
-    if(!missing(namerows)) {
-      if(length(namerows) != nrow(df)) stop("length of namerows must be the length of number of rows of veh")
-      row.names(df) <- namerows
-    }
-
-    if(!missing(net)){
-      netsf <- sf::st_as_sf(net)
-      if(!missing(time)){
-        dfsf <- sf::st_sf(Vehicles(df*k, time = time), geometry = sf::st_geometry(netsf))
-      } else {
-        dfsf <- sf::st_sf(Vehicles(df*k), geometry = sf::st_geometry(netsf))
-      }
-      return(dfsf)
-    } else {
-      if(!missing(time)){
-        return(Vehicles(df*k, time = time))
-      } else {
-        return(Vehicles(df*k))
-      }
-    }
-
-    #bystreet = FALSE
-  } else {
-    suca <- function (t) {1 - exp(-exp(a + b*t))}
-    anos <- seq(agemin,agemax)
-    d <- (-1)*diff(suca(anos))
-    d[length(d)+1] <- d[length(d)]
-    d <- d + (1 - sum(d))/length(d)
-    df <- as.data.frame(as.matrix(x) %*%matrix(d,ncol=length(anos), nrow=1))
-
-    df <- as.data.frame(cbind(as.data.frame(matrix(0,ncol=agemin-1,
-                                                   nrow=length(x))),
-                              df))
-
-    names(df) <- paste(name,seq(1,agemax),sep="_")
-
-    df <- df*k
-
-    if(verbose){
-      message(paste("Average age of",name, "is",
-                    round(sum(seq(1,agemax)*base::colSums(df, na.rm = T)/sum(df, na.rm = T)), 2),
-                    sep=" "))
-      message(paste("Number of",name, "is",
-                    round(sum(df, na.rm = T), 3),
-                    " [veh]",
-                    sep=" "))
-
-      cat("\n")
-    }
-    if(!missing(namerows)) {
-      if(length(namerows) != nrow(df)) stop("length of namerows must be the length of number of rows of veh")
-      row.names(df) <- namerows
-    }
-
-    # replace NA and NaN
-    df[is.na(df)] <- 0
-
-
-    if(!missing(net)){
-      netsf <- sf::st_as_sf(net)
-      if(!missing(time)){
-        dfsf <- sf::st_sf(Vehicles(df, time = time), geometry = sf::st_geometry(netsf))
-      } else {
-        dfsf <- sf::st_sf(Vehicles(df), geometry = sf::st_geometry(netsf))
-      }
-      return(dfsf)
-    } else {
-      if(!missing(time)){
-        return(Vehicles(df, time = time))
-      } else {
-        return(Vehicles(df))
-      }
-    }
-  }
+  .Deprecated("age_veh")
 }