# Obliczenie emisji według charakterystyk - opis kodu dla F1B_OR
lokalizacja: `/mnt/array0/lgawuc/struktura/emisje/obliczenia_e01/liniowka/yanosik/przetwarzanie/Yanosik_odnowa_lech_zima2020/runs/run_43_major_roads_gdal_grid/quantiled_Yan_APRs_data/major_i_minor_po_woj`
zbiór:`rprog_SmartYan_faza_1b_licz_emisje_licz_v1.R`
Poniżej opis kodu:
---
```r
rm(list=ls())
library('sf')
library('dplyr')
```
Ustawienie parametru r daje możliwość odgórnego skalowania danych przez stały wspólczynnik. Nie mylić ze wspólczynnikiem r, który oznacza stosunek pomiędzy danymi Yanosik a danymi referecyjnymi (rzeczywistością). Choc w gruncie rzeczy to jest prawie to samo.
```r
#=========>>>ustawienie parametru r:<<<========================
r <- 1
#=========>>>ustawienie parametru </><<<========================
```
Zbiór `spis.dat` zawiera nazwy plików z danymi (obliczonymi wcześniej), tj.:
head spis.dat
yanosik_by_SmartYan_faza_1b__minor_AND_major_roads__02_dolnoslaskie.shp
yanosik_by_SmartYan_faza_1b__minor_AND_major_roads__04_kuj_pom.shp
yanosik_by_SmartYan_faza_1b__minor_AND_major_roads__06_lubelskie.shp
..itd
```r
ls <- read.table('spis.dat')
```
Ustawie nazw zanieczyszczen jako kolumny:
```r
n <- c('CO','CO2','SOx','NOx','PM10','PM25','PMEX','VOC','BaP','NH3','CH4','Ni','Hg','Cd','Pb','As')
for (ll in 1:nrow(ls)){
netIN <- st_read(ls[ll,]) #wczytanie danych o aktywnosci
netIN$dlg <- round(as.numeric(st_length(netIN$geometry)) * 0.001,4) #[km] obliczenie dlugosci drogi w km
dlg <- netIN$dlg
netIN$rcl <- as.numeric(netIN$rcl)
mspd <- ifelse(netIN$maxspeed == 0, 45 ,netIN$maxspeed ) #kolumna 'maxspeed' pochodzi z danymi OSM dla nowopowstalych dróg wiec tutaj następuje zabezpieczenie jeśli coś jest nie tak
vr <- ifelse(mspd != -999, mspd , netIN$v_sr_rok )
netIN$vr <- vr
iYan <- netIN # zamiana nazwy gdyż wielomiany czytane ze zrobioru niżej >>source<< używaja zmiennej 'iYan'
users <- netIN$trf24h*300 # przejście z ruchu dobowego na roczny
source('/home/lgawuc/yanosik/multicores/emisje_licz/model_v1.0/input_wielomiany_v8_charakterystyki_za2021__modified_apr23.R')
```
Charakterystyki zawarte w zbiorze powyżej są opracowywane przez dr inż. Magda Zimakowską - Laskowską z ZIRE - [opis tutaj](https://hackmd.io/@yanosik/SykgRhTD2).
Dalej, po wykonaniu kodu z >>source<< :
```r
gkg <- 10**(-3) # gramy na kiloramy
mgkg <- 10**(-6) # miligramy na kiloramy
dzRok <- 1 # bo uu jest juz roczne wiec nie dajemy 300
e$CO <- e$CO * gkg * dzRok * dlg #[g > kg ; dzien > rok]
e$CO2 <- e$CO2 * gkg * dzRok * dlg #[g > kg ; dzien > rok]
e$SO2 <- e$SO2 * gkg * dzRok * dlg #[g > kg ; dzien > rok]
e$NOx <- e$NOx * gkg * dzRok * dlg #[g > kg ; dzien > rok]
e$PMEX <- e$PMEX * gkg * dzRok * dlg #[g > kg ; dzien > rok]
e$PM10 <- e$PM10 * gkg * dzRok * dlg #[g > kg ; dzien > rok]
e$PM25 <- e$PM25 * gkg * dzRok * dlg #[g > kg ; dzien > rok]
e$NMVOC <- e$NMVOC * gkg * dzRok * dlg #[g > kg ; dzien > rok]
e$BaP <- e$BaP * mgkg * dzRok * dlg #[mg > kg ; dzien > rok]
e$NH3 <- e$NH3 * gkg * dzRok * dlg #[mg > kg ; dzien > rok]
e$CH4 <- e$CH4 * gkg * dzRok * dlg #[mg > kg ; dzien > rok]
e$Hg <- e$Hg * mgkg * dzRok * dlg #[mg > kg ; dzien > rok]
e$Ni <- e$Ni * mgkg * dzRok * dlg #[mg > kg ; dzien > rok]
e$Cd <- e$Cd * mgkg * dzRok * dlg #[mg > kg ; dzien > rok]
e$Pb <- e$Pb * mgkg * dzRok * dlg #[mg > kg ; dzien > rok]
e$As <- e$As * mgkg * dzRok * dlg #[mg > kg ; dzien > rok]
```
nazwa wynikowa i zapis:
```r
nazOut <- paste0('emisje_vct_',ls[ll,])
netOUT <- cbind(iYan,e)
st_write(netOUT,dsn='.',layer=nazOut,driver='ESRI Shapefile',append=F)
```
JEDNOSTKI charaktetystyk to: [g/km]
Poniżej obliczenie sumy emisji i zapis do pliku:
```r
sume <- as.data.frame(array(,dim=c(1,1)))
sume$CO <- sum( e$CO,na.rm=T )
sume$NMVOC <- sum( e$NMVOC,na.rm=T )
sume$CH4 <- sum( e$CH4,na.rm=T )
sume$NOx <- sum( e$NOx,na.rm=T )
sume$PMEX <- sum( e$PMEX,na.rm=T)
sume$PM10 <- sum( e$PM10,na.rm=T)
sume$PM25 <- sum( e$PM25,na.rm=T)
sume$CO2 <- sum( e$CO2,na.rm=T )
sume$SO2 <- sum( e$SO2,na.rm=T )
sume$NH3 <- sum( e$NH3,na.rm=T )
sume$Hg <- sum( e$Hg,na.rm=T )
sume$Ni <- sum( e$Ni,na.rm=T )
sume$Cd <- sum( e$Cd,na.rm=T )
sume$Pb <- sum( e$Pb,na.rm=T )
sume$BaP <- sum( e$BaP,na.rm=T )
sume$As <- sum( e$As,na.rm=T )
sume <-select(sume,!V1)
write.table(sume,paste0('sumy__',nazOut,'.csv'),row.names=F,quote=F,sep=';')
}
```