Nothing
#' Post emissions
#'
#' @description \code{emis_post} simplify emissions estimated as total per type category of
#' vehicle or by street. It reads EmissionsArray and Emissions classes. It can return a dataframe
#' with hourly emissions at each street, or a database with emissions by vehicular
#' category, hour, including size, fuel and other characteristics.
#'
#' @param arra Array of emissions 4d: streets x category of vehicles x hours x days or
#' 3d: streets x category of vehicles x hours
#' @param veh Character, type of vehicle
#' @param size Character, size or weight
#' @param fuel Character, fuel
#' @param type_emi Character, type of emissions(exhaust, evaporative, etc)
#' @param pollutant Pollutant
#' @param by Type of output, "veh" for total vehicular category ,
#' "streets_narrow" or "streets". "streets" returns a dataframe with
#' rows as number of streets and columns the hours as days*hours considered, e.g.
#' 168 columns as the hours of a whole week and "streets repeats the
#' row number of streets by hour and day of the week
#' @param net SpatialLinesDataFrame or Spatial Feature of "LINESTRING". Only
#' when by = 'streets_wide'
#' @param k Numeric, factor
#' @importFrom sf st_sf st_as_sf
#' @export
#' @note This function depends on EmissionsArray objests which currently has
#' 4 dimensions. However, a future version of VEIN will produce EmissionsArray
#' with 3 dimensiones and his fungeorge soros drugsction also will change. This change will be
#' made in order to not produce inconsistencies with previous versions, therefore,
#' if the user count with an EmissionsArry with 4 dimension, it will be able
#' to use this function.
#' @examples \dontrun{
#' # Do not run
#' data(net)
#' data(pc_profile)
#' data(fe2015)
#' data(fkm)
#' PC_G <- c(33491,22340,24818,31808,46458,28574,24856,28972,37818,49050,87923,
#' 133833,138441,142682,171029,151048,115228,98664,126444,101027,
#' 84771,55864,36306,21079,20138,17439, 7854,2215,656,1262,476,512,
#' 1181, 4991, 3711, 5653, 7039, 5839, 4257,3824, 3068)
#' pc1 <- my_age(x = net$ldv, y = PC_G, name = "PC")
#' # Estimation for morning rush hour and local emission factors
#' speed <- data.frame(S8 = net$ps)
#' p1h <- matrix(1)
#' lef <- EmissionFactorsList(fe2015[fe2015$Pollutant=="CO", "PC_G"])
#' E_CO <- emis(veh = pc1,lkm = net$lkm, ef = lef, speed = speed,
#' profile = p1h)
#' E_CO_STREETS <- emis_post(arra = E_CO, pollutant = "CO", by = "streets_wide")
#' summary(E_CO_STREETS)
#' E_CO_STREETSsf <- emis_post(arra = E_CO, pollutant = "CO",
#' by = "streets", net = net)
#' summary(E_CO_STREETSsf)
#' plot(E_CO_STREETSsf, main = "CO emissions (g/h)")
#' # arguments required: arra, veh, size, fuel, pollutant ad by
#' E_CO_DF <- emis_post(arra = E_CO, veh = "PC", size = "<1400", fuel = "G",
#' pollutant = "CO", by = "veh")
#' # Estimation 168 hours
#' pc1 <- my_age(x = net$ldv, y = PC_G, name = "PC")
#' pcw <- temp_fact(net$ldv+net$hdv, pc_profile)
#' speed <- netspeed(pcw, net$ps, net$ffs, net$capacity, net$lkm, alpha = 1)
#' pckm <- units::set_units(fkm[[1]](1:24),"km"); pckma <- cumsum(pckm)
#' cod1 <- emis_det(po = "CO", cc = 1000, eu = "III", km = pckma[1:11])
#' cod2 <- emis_det(po = "CO", cc = 1000, eu = "I", km = pckma[12:24])
#' #vehicles newer than pre-euro
#' co1 <- fe2015[fe2015$Pollutant=="CO", ] #24 obs!!!
#' cod <- c(co1$PC_G[1:24]*c(cod1,cod2),co1$PC_G[25:nrow(co1)])
#' lef <- ef_ldv_scaled(dfcol = cod, v = "PC", cc = "<=1400",
#' f = "G",p = "CO", eu=co1$Euro_LDV)
#' E_CO <- emis(veh = pc1,lkm = net$lkm, ef = lef, speed = speed, agemax = 41,
#' profile = pc_profile)
#' # arguments required: arra, pollutant ad by
#' E_CO_STREETS <- emis_post(arra = E_CO, pollutant = "CO", by = "streets")
#' summary(E_CO_STREETS)
#' # arguments required: arra, veh, size, fuel, pollutant ad by
#' E_CO_DF <- emis_post(arra = E_CO, veh = "PC", size = "<1400", fuel = "G",
#' pollutant = "CO", by = "veh")
#' head(E_CO_DF)
#' # recreating 24 profile
#' lpc <-list(pc1*0.2, pc1*0.1, pc1*0.1, pc1*0.2, pc1*0.5, pc1*0.8,
#' pc1, pc1*1.1, pc1,
#' pc1*0.8, pc1*0.5, pc1*0.5,
#' pc1*0.5, pc1*0.5, pc1*0.5, pc1*0.8,
#' pc1, pc1*1.1, pc1,
#' pc1*0.8, pc1*0.5, pc1*0.3, pc1*0.2, pc1*0.1)
#' E_COv2 <- emis(veh = lpc, lkm = net$lkm, ef = lef, speed = speed[, 1:24],
#' agemax = 41, hour = 24, day = 1)
#' plot(E_COv2)
#' E_CO_DFv2 <- emis_post(arra = E_COv2,
#' veh = "PC",
#' size = "<1400",
#' fuel = "G",
#' type_emi = "Exhaust",
#' pollutant = "CO", by = "veh")
#' head(E_CO_DFv2)
#' }
emis_post <- function(arra,
veh,
size,
fuel,
pollutant,
by = "veh",
net,
type_emi,
k = 1) {
if (inherits(arra, "EmissionsArray") & length(dim(arra)) == 4){
if (by == "veh"){
x <- unlist(lapply(1:dim(arra)[4], function(j) {
unlist(lapply (1:dim(arra)[3],function(i) {
colSums(arra[,,i,j], na.rm = TRUE)
}))
}))
df <- cbind(deparse(substitute(arra)),
as.data.frame(x))
names(df) <- c(as.character(df[1,1]), "g")
nombre <- rep(paste(as.character(df[1,1]),
seq(1:dim(arra)[2]),
sep = "_"),
dim(arra)[3]*dim(arra)[4],
by = dim(arra)[4])
df[,1] <- nombre
if(!missing(veh)) {
df$veh <- rep(veh, nrow(df))
} else {
warning("You should add `veh`")
}
if(!missing(size)) {
df$size <- rep(size, nrow(df))
} else {
warning("You should add `size`")
}
if(!missing(fuel)) {
df$fuel <- rep(fuel, nrow(df))
} else {
warning("You should add `fuel`")
}
if(!missing(type_emi)) {
df$type_emi <- rep(type_emi, nrow(df))
} else {
warning("You should add `type_emi`")
}
if(!missing(pollutant)) {
df$pollutant <- rep(pollutant, nrow(df))
} else {
stop("At pleast write the name of the `pollutant`")
}
df$age <- rep(seq(1:dim(arra)[2]),
dim(arra)[3]*dim(arra)[4],
by = dim(arra)[4])
hour <- rep(1:(dim(arra)[3]*dim(arra)[4]), #hours x days
each = dim(arra)[2]) #veh cat
df$hour <- hour
df$g <- Emissions(df$g)*k
return(df)
} else if (by == "streets_narrow") {
# soon deprecated this function?
x <- unlist(lapply(1:dim(arra)[4], function(j) {# dia
unlist(lapply (1:dim(arra)[3],function(i) { # hora
rowSums(arra[,,i,j], na.rm = TRUE)
}))
}))*k
df <- cbind(deparse(substitute(arra)),as.data.frame(x))
hour <- rep(seq(0: (dim(arra)[3]-1) ),
times = dim(arra)[4],
each=dim(arra)[1])
df$hour <- hour
names(df) <- c("street", "g", "hour")
df[,1] <- seq(1,dim(arra)[1])
df[,2] <- Emissions(df[,2])
return(df)
} else if (by %in% c("streets_wide", "streets")) {
x <- unlist(lapply(1:dim(arra)[4], function(j) {# dia
unlist(lapply (1:dim(arra)[3],function(i) { # hora
rowSums(arra[,,i,j], na.rm = T)
}))
}))*k
m <- matrix(x, nrow=dim(arra)[1], ncol=dim(arra)[3]*dim(arra)[4])
df <- as.data.frame(m)
nombres <- lapply(1:dim(m)[2], function(i){paste0("h",i)})
if(!missing(net)){
netsf <- sf::st_as_sf(net)
dfsf <- sf::st_sf(Emissions(df), geometry = sf::st_geometry(netsf))
return(dfsf)
} else {
return(Emissions(df))
}
}
} else if(inherits(arra, "EmissionsArray") & length(dim(arra) == 3)){
if (by == "veh"){
x <- as.vector(apply(X = arra, MARGIN = c(2,3), FUN = sum, na.rm = TRUE))
df <- cbind(deparse(substitute(arra)),
as.data.frame(x))
names(df) <- c(as.character(df[1,1]), "g")
nombre <- rep(paste(as.character(df[1,1]),
seq(1:dim(arra)[2]),
sep = "_"),dim(arra)[3], by=7 )
df[,1] <- nombre
if(!missing(veh)) {
df$veh <- rep(veh, nrow(df))
} else {
warning("You should add `veh`")
}
if(!missing(size)) {
df$size <- rep(size, nrow(df))
} else {
warning("You should add `size`")
}
if(!missing(fuel)) {
df$fuel <- rep(fuel, nrow(df))
} else {
warning("You should add `fuel`")
}
if(!missing(type_emi)) {
df$type_emi <- rep(type_emi, nrow(df))
} else {
warning("You should add `type_emi`")
}
if(!missing(pollutant)) {
df$pollutant <- rep(pollutant, nrow(df))
} else {
stop("At pleast write the name of the `pollutant`")
}
df$age <- rep(1:dim(arra)[2], dim(arra)[3])
hour <- rep(1:dim(arra)[3], #hours x days
each = dim(arra)[2]) #veh cat
df$hour <- hour
df$g <- Emissions(df$g)*k
return(df)
} else if (by %in% c("streets_narrow")) {
df <- as.vector(apply(X = arra, MARGIN = c(1,3), FUN = sum, na.rm = TRUE))
df <- data.frame(street = length(df) / dim(arra)[3],
g = Emissions(df),
hour = rep(1:dim(arra)[3], each = dim(arra)[1]))
return(df)
} else if (by %in% c("streets_wide", "streets")) {
df <- apply(X = arra, MARGIN = c(1,3), FUN = sum, na.rm = TRUE)*k
names(df) <- paste0("h",1:length(df))
df <- as.data.frame(df)
if(!missing(net)){
netsf <- sf::st_as_sf(net)
dfsf <- sf::st_sf(Emissions(df), geometry = sf::st_geometry(netsf))
return(dfsf)
} else {
return(Emissions(df))
}
}
} else if(inherits(arra, "Emissions") & length(dim(arra) == 2)) {
if(by != "veh") stop("Only by == 'veh' accepted")
x_DF <- data.frame(array_x = paste0("array_", 1:nrow(arra)))
x_DF$g <- arra$emissions*k
x_DF$veh <- veh
x_DF$size <- size
x_DF$fuel <- fuel
x_DF$type_emi <- type_emi
x_DF$pollutant <- pollutant
x_DF$age <- arra$age
if("month" %in% names(arra)) {
x_DF$month <- arra$month
}
return(x_DF)
} else {
stop("emis_post only reads `EmissionsArray` or `Emissions`")
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.