working on argentina

projects/argentina/estimation/2019/notes/README_2024-07-10_220703.75018.txt → projects/argentina/estimation/2019/notes/README_2024-07-11_204342.213879.txt

@@ -4,7 +4,7 @@ Brazil by state 2019
 
 Directory: /media/sergio/ext4/models/vein/projects/argentina/estimation/2019
 
-Local Time: 2024-07-10 22:07:03.750537
+Local Time: 2024-07-11 20:43:42.214292
 Inventory compiler: sergio
 ========================================
 
@@ -60,10 +60,9 @@ BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.12.0
 LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.12.0
 
 locale:
- [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C               LC_TIME=en_US.UTF-8       
- [4] LC_COLLATE=en_US.UTF-8     LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
- [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                  LC_ADDRESS=C              
-[10] LC_TELEPHONE=C             LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       
+ [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C               LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
+ [5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8    LC_PAPER=en_US.UTF-8       LC_NAME=C                 
+ [9] LC_ADDRESS=C               LC_TELEPHONE=C             LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       
 
 time zone: America/Denver
 tzcode source: system (glibc)
@@ -72,22 +71,18 @@ attached base packages:
 [1] stats     graphics  grDevices utils     datasets  methods   base     
 
 other attached packages:
-[1] eixport_0.6.0     stars_0.6-4       abind_1.4-5       units_0.8-5       data.table_1.15.4
-[6] ggplot2_3.5.1     cptcity_1.0.6     sf_1.0-16         vein_1.1.3       
+[1] eixport_0.6.0     stars_0.6-4       abind_1.4-5       units_0.8-5       data.table_1.15.4 ggplot2_3.5.1    
+[7] cptcity_1.0.6     sf_1.0-16         vein_1.1.3       
 
 loaded via a namespace (and not attached):
- [1] utf8_1.2.4         generics_0.1.3     class_7.3-22       KernSmooth_2.23-22
- [5] lattice_0.22-5     magrittr_2.0.3     grid_4.3.3         pkgload_1.3.3     
- [9] cellranger_1.1.0   rprojroot_2.0.4    e1071_1.7-14       brio_1.1.5        
-[13] DBI_1.2.3          fansi_1.0.6        scales_1.3.0       codetools_0.2-19  
-[17] cli_3.6.3          crayon_1.5.2       rlang_1.1.4        munsell_0.5.0     
-[21] withr_3.0.0        tools_4.3.3        raster_3.6-26      parallel_4.3.3    
-[25] dplyr_1.1.4        colorspace_2.1-0   ncdf4_1.22         vctrs_0.6.5       
-[29] R6_2.5.1           proxy_0.4-27       lifecycle_1.0.4    classInt_0.4-10   
-[33] pkgconfig_2.0.3    desc_1.4.3         terra_1.7-78       pillar_1.9.0      
-[37] gtable_0.3.4       glue_1.7.0         Rcpp_1.0.12        tibble_3.2.1      
-[41] tidyselect_1.2.0   farver_2.1.1       labeling_0.4.3     testthat_3.2.0    
-[45] dotCall64_1.1-1    compiler_4.3.3     readxl_1.4.3       sp_2.1-3          
+ [1] utf8_1.2.4         generics_0.1.3     class_7.3-22       KernSmooth_2.23-22 lattice_0.22-5     magrittr_2.0.3    
+ [7] grid_4.3.3         cellranger_1.1.0   e1071_1.7-14       DBI_1.2.3          fansi_1.0.6        scales_1.3.0      
+[13] codetools_0.2-19   cli_3.6.3          rlang_1.1.4        crayon_1.5.2       munsell_0.5.0      withr_3.0.0       
+[19] tools_4.3.3        raster_3.6-26      parallel_4.3.3     dplyr_1.1.4        colorspace_2.1-0   ncdf4_1.22        
+[25] vctrs_0.6.5        R6_2.5.1           proxy_0.4-27       lifecycle_1.0.4    classInt_0.4-10    pkgconfig_2.0.3   
+[31] terra_1.7-78       pillar_1.9.0       gtable_0.3.4       glue_1.7.0         Rcpp_1.0.12        tibble_3.2.1      
+[37] tidyselect_1.2.0   farver_2.1.1       labeling_0.4.3     dotCall64_1.1-1    compiler_4.3.3     readxl_1.4.3      
+[43] sp_2.1-3          
 
 ========================================
 

projects/argentina/estimation/2019/scripts/main_01_config.R

@@ -41,7 +41,7 @@ im_hc <- readxl::read_xlsx(path = path, sheet = "im_hc")
 im_nox <- readxl::read_xlsx(path = path, sheet = "im_nox")
 im_pm <- readxl::read_xlsx(path = path, sheet = "im_pm25")
 
-source("config/config.R", echo = T)
+source("config/config.R")
 
 rm(list = ls())
 gc()

projects/argentina/estimation/2019/scripts/traffic.R

@@ -0,0 +1,263 @@
+year_selected <- as.numeric(basename(getwd()))
+
+# n_veh
+n_PC <- metadata$vehicles[grep(pattern = "PC", x = metadata$vehicles)]
+n_LCV <- metadata$vehicles[grep(pattern = "LCV", x = metadata$vehicles)]
+n_TRUCKS <- metadata$vehicles[grep(pattern = "TRUCKS", x = metadata$vehicles)]
+n_BUS <- metadata$vehicles[grep(pattern = "BUS", x = metadata$vehicles)]
+n_MC <- metadata$vehicles[grep(pattern = "MC", x = metadata$vehicles)]
+n_veh <- list(PC = n_PC, 
+              LCV = n_LCV, 
+              TRUCKS = n_TRUCKS, 
+              BUS = n_BUS, 
+              MC = n_MC)
+
+inte <- intersect(metadata$vehicles, names(veh))
+
+if(length(inte) != length(metadata$vehicles)){
+
+  switch (language,
+          "portuguese" = cat( "veh precisa ter mesmos veiculos de metadata$vehicles:\n"),
+          "english" = cat( "veh needs the same vehicles as metadata$vehicles:\n"),
+          "spanish" = cat( "veh necesita los mismos vehiculos de metadata$vehicles:\n"))
+
+
+  stop()
+}
+
+# apagando arquivos
+switch (language,
+        "portuguese" = message("Apagando veh/*.rds\n"),
+        "english" = message("Deleting veh/*.rds\n"),
+        "spanish" = message("Borrando veh/*.rds\n"))
+
+arquivos <- list.files(path = "veh", pattern = ".rds", full.names = TRUE)
+file.remove(arquivos)
+
+# fleet age
+veh[is.na(veh)] <- 0
+
+# plotting
+switch (language,
+        "portuguese" = cat("Plotando fluxos\n"),
+        "english" = cat("Plotting traffic flows\n"),
+        "spanish" = cat("Plotando flujos\n"))
+
+# identicar nomes de grupos
+nveh <- names(veh)
+n_PC <- nveh[grep(pattern = "PC", x = nveh)]
+n_LCV <- nveh[grep(pattern = "LCV", x = nveh)]
+n_TRUCKS <- nveh[grep(pattern = "TRUCKS", x = nveh)]
+n_BUS <- nveh[grep(pattern = "BUS", x = nveh)]
+n_MC <- nveh[grep(pattern = "MC", x = nveh)]
+
+setDT(veh)
+setorderv(veh, 
+          cols = c( "Year"), 
+          order = c( -1))
+
+if(survival) {
+
+  if(any(grepl("region", names(veh)))) {
+    cat("Identified `region` in `veh`\n")
+
+    lv <- split(veh, veh[["region"]])
+
+    for(j in seq_along(lv)) {
+
+      for(i in seq_along(metadata$vehicles)) {
+        lv[[j]][[metadata$vehicles[i]]] <-   age(x = lv[[j]][[metadata$vehicles[i]]], 
+                                                 type = metadata$survival[i], 
+                                                 a = metadata$survival_param_a[i],
+                                                 b = metadata$survival_param_b[i])
+      }  
+    }  
+      veh <- rbindlist(lv)
+
+  } else {
+    cat("No `region` in `veh`\n")
+
+      for(i in seq_along(metadata$vehicles)) {
+        veh[[metadata$vehicles[i]]] <-   age(x = veh[[metadata$vehicles[i]]], 
+                                             type = metadata$survival[i], 
+                                             a = metadata$survival_param_a[i],
+                                             b = metadata$survival_param_b[i])      
+  }}
+}
+
+# lleguehasta aqui
+
+# veh ####
+#
+v <- metadata$vehicles
+
+reg <- unique(fuel[["region"]])
+
+if(any(grepl("region", names(veh)))) {
+  cat("Identified `region` in `veh`\n")
+
+  lv <- split(veh, veh[["region"]])
+
+  lf <- split(fuel, fuel[["region"]])
+
+  for(j in seq_along(lv)) {
+
+    rbindlist(lapply(seq_along(v), function(i) {
+
+      if(verbose){
+
+      cat(
+        "\n", metadata$vehicles[i],
+        rep("", max(nchar(metadata$vehicles) + 1) - nchar(metadata$vehicles[i]))
+      )
+    }
+
+      rbindlist(lapply(seq_along(reg), function(j) {
+        x <- lv[[reg[j]]][[v[i]]]*lf[[reg[j]]][fuel == metadata$fuel[i]]$kinitial
+        x <- remove_units(x)[1:metadata$maxage[i]]
+        x <- Vehicles(matrix(x, ncol = metadata$maxage[i]))
+        x$"region" <- reg[j]
+        x
+    })) -> dt
+    # print(dt)
+    saveRDS(dt, paste0("veh/", v[i], ".rds"))
+
+    df <- melt.data.table(dt, 
+                          id.vars = "region", 
+                          measure.vars = paste0("V", 1:metadata$maxage[i]), 
+                          variable.name = "age", 
+                          value.name = "veh")
+    df$vehicles <- v[i]
+    df
+    })) -> vv
+  }  
+    veh <- rbindlist(lv)
+
+} else {
+  cat("No `region` in `veh`\n")
+
+  rbindlist(lapply(seq_along(v), function(i) {
+    if(verbose){
+      cat("\n", metadata$vehicles[i],
+        rep("", max(nchar(metadata$vehicles) + 1) - nchar(metadata$vehicles[i]))
+      )
+    }
+      rbindlist(lapply(seq_along(reg), function(j) {
+
+        if(verbose) cat(reg[j], " " )
+
+
+       x <- veh[[v[i]]]*fuel[region == reg[j] & 
+                             fuel == metadata$fuel[i]]$kinitial
+        x <- remove_units(x)[1:metadata$maxage[i]]
+        x <- Vehicles(matrix(x, ncol = metadata$maxage[i]))
+        x$"region" <- reg[j]
+        x
+      })) -> dt
+
+      saveRDS(dt, paste0("veh/", v[i], ".rds"))
+
+    df <- melt.data.table(dt, 
+                          id.vars = "region", 
+                          measure.vars = paste0("V", 1:metadata$maxage[i]), 
+                          variable.name = "age", 
+                          value.name = "veh")
+    df$vehicles <- v[i]
+    df
+      })) -> vv
+  }  
+
+
+cat("\n")
+
+# plots ####
+switch (language,
+        "portuguese" = cat("Plotando frota \n"),
+        "english" = cat("Plotting fleet \n"),
+        "spanish" = cat("Plotando flota \n"))
+names(vv)
+
+vv <- merge(vv, 
+            metadata,
+            by = "vehicles",
+            all.x = TRUE)
+
+vv$age <- as.numeric(gsub("V", "", vv$age))
+vv$Year <- year_selected - vv$age + 1
+vv$sf <- paste(vv$size, vv$fuel)
+fam <- unique(metadata$family)
+
+vv <- remove_units(vv)
+
+for(i in seq_along(fam)) {
+
+ggplot(vv[family == fam[i] &
+                as.numeric(veh)> 0], 
+           aes(x = Year,
+               y = veh,
+               colour = vehicles)) +
+      geom_line() +
+      facet_wrap(~ region, 
+                 scales = "free_y") +
+      theme_bw(base_size = 10)+
+      theme(axis.text.x = element_text(angle = 90)) -> p
+
+  png(paste0("images/FLEET_CIRCULATING_", fam[i], ".png"), 
+      width = 3000, 
+      height = 2500, 
+      "px",
+      res = 300)
+  print(p)  
+  dev.off()  
+}
+
+# hast aqui
+# ggplot2
+
+dx <- vv[,
+         sum(veh, na.rm = T),
+         by = .(vehicles, 
+                family,
+                region
+         )]
+names(dx)[4] <- "veh"
+
+p <- ggplot(dx, 
+            aes(x = vehicles, 
+                y = veh, 
+                fill = family)) +
+  geom_bar(stat = "identity", 
+           col = "black")+
+  labs(y = "veh", 
+       title = "Vehicles") +
+  facet_wrap(~ region,
+             scales = "free_x", 
+             nrow = 2) +
+  theme_bw() +
+  scale_y_sqrt() +
+  coord_flip()+
+  scale_x_discrete(limits = rev(metadata$vehicles)) +
+  theme(axis.text.x = element_text(angle=90,
+                                   hjust=1)) 
+
+p
+
+png(filename =  paste0("images/VEHICLES_INITIAL.png"),
+    width = 2500, height = 2500, units = "px", pointsize = 12,
+    bg = "white",  res = 300)
+print(p)
+dev.off()
+
+switch (language,
+        "portuguese" = message("\nArquivos em:"),
+        "english" = message("\nFiles in:"),
+        "spanish" = message("\nArchivos en:"))
+
+message("veh/*\n")
+
+switch (language,
+        "portuguese" = message("\nFiguras em"),
+        "english" = message("\nFigures in"),
+        "spanish" = message("\nFiguras en"))
+message("/images")
+