+ Näytä koodi- Piilota koodi
# Luetaan liikennemaarat Opasnet Base-tietokannasta, muuttujasta Op_fi2681:
#
library(OpasnetBaseUtils)
risteykset <- op_baseGetData("opasnet_base", "Op_fi2681", series_id = 2953)
#
# Muutetaan tekstitulokset numeroiksi. Jostain syystä Länteen tallentui tekstinä.
risteykset[!is.na(risteykset$Result.Text), "Result"] <- as.numeric(risteykset[!is.na(risteykset$Result.Text), "Result.Text"])
risteykset <- reshape(risteykset[, 3:5], timevar = "Ilmansuunta", idvar = "Risteys", direction = "wide")
risteykset[is.na(risteykset)] <- 0
risteykset <- risteykset[, c(1,2,4,5,3)]
colnames(risteykset) <- c("Risteys","Pohjoiseen","Itään","Etelään","Länteen")
# Eristetaan risteyspisteet omaan vektoriin:
#
risteyspisteet <- risteykset[[1]]; dim(risteyspisteet)<-c(9,13)
# Muodostetaan ylimaaraiset rivit ja sarakkeet lahinaapuritaulukointia varten
# (ita-lansi -suunnassa reunapisteiden nimena "AA" ja pohjois-etela -suunnassa "BB", nurkissa "XX"):
#
test3<-c(1:(15*11)); dim(test3)<-c(11,15); test3<-test3*0;
test3[2:10,2:14]<-as.character(risteyspisteet); test3[1:11,1] <- "AA"; test3[1:11,15] <- "AA"; test3[1,2:14] <- "BB"; test3[11,2:14] <- "BB";
test3[1,1] <- "XX"; test3[1,15] <- "XX"; test3[11,1] <- "XX"; test3[11,15] <- "XX";
test3
#
# Poluksi maaritellaan pistejoukko vertekseja
#
polku<-c("A1","B1","B2")
# Maaritellaan lahinaapurilista kaikille polun pisteille:
#
lahinaapurilista <- list(1:(4*length(polku))); for(i in 1:length(polku)) {apuL <- which(test3 == polku[[i]]);
naapurit <-c(apuL+11,apuL-1,apuL-11,apuL+1); lahinaapurilista[[4*(i-1)+1]] <- naapurit[[1]];
lahinaapurilista[[4*(i-1)+2]] <- naapurit[[2]]; lahinaapurilista[[4*(i-1)+3]] <- naapurit[[3]];
lahinaapurilista[[4*(i-1)+4]] <- naapurit[[4]]}; lahinaapurit <- as.numeric(lahinaapurilista)
#
# Maaritellaan lahinaapuritN-vektori
#
lahinaapuritN <- list(1:length(lahinaapurit));
for(y in 1:length(lahinaapurit)) {lahinaapuritN[[y]] <- which(as.character(risteykset[[1]]) == test3[lahinaapurit][[y]])}
# Poistetaan listasta polun koordinaattipisteet:
#
polkuN <- list(1:length(polku));
for(i in 1:length(polku)) {polkuN[[i]] <- which(test3 == polku[[i]])}; num_polku <- as.numeric(polkuN)
# Maaritellaan apu_kampa, joka kertoo missa poistettavat polun elementit sijaitsevat lahinaapurilistassa:
#
apu_kampa<-as.numeric(lahinaapurit %in% num_polku)*(1:length(lahinaapurit));
# Maaritetaan muuttujan apu_kampa avulla lyhennetty lahinaapurilista, josta on poistettu polun elementit:
#
mod_lahinaapurit <- c(1:length(lahinaapurit));
for(i in 1:length(lahinaapurit)) {if(i==apu_kampa[[i]]) mod_lahinaapurit[[i]] <- 0 else mod_lahinaapurit[[i]] <- lahinaapurit[[i]]};
mod_lahinaapurit <- mod_lahinaapurit[mod_lahinaapurit != 0]
# Poistetaan listasta termit "AA" ja "BB"
#
apu_kampa <- which(test3[mod_lahinaapurit] == "AA" | test3[mod_lahinaapurit] == "BB");
mod_lahinaapurit <- mod_lahinaapurit[-apu_kampa]
# Uuteen muuttujaan nimelta lahinaapuri_risteykset kerataan mod_lahinaapurit-alkioita vastaavat risteyskoordinaatit
# risteykset-listasta (emme suoraan voi valita risteykset-listasta mod_lahinaapurit-alkoiden perusteella,
# koska jalkimmaiset on maaritetty laajemman test3-taulukon perusteella joka sisaltaa ylimaaraisia reunapisteita)
#
lahinaapuri_risteykset <- list(1:length(mod_lahinaapurit)); for(i in 1:length(mod_lahinaapurit)) {lahinaapuri_risteykset[[i]] <- which(risteykset[[1]] == as.list(test3[mod_lahinaapurit])[[i]])}
# Lasketaan painokertoimet kaikille risteyspisteille niiden liikennemaarien perusteella. Painokerroin = sarakkeen
# liikennemaara/kokonaisliikennemaara ja kokonaisliikennemaara = sarakkeen kaikkien arvojen summa.
# Vaikka monet risteykset esiintyvat monta kertaa, ei se haittaa vaikka ne lasketaankin mukaan joka kerran, koska
# jos risteyspiste on lahinaapuripiste useammalle polun pisteelle, pitaa sita painottaakin suuremmalla kertoimella.
#
# Painokerrointen mukainen jaettava eri ilmansuunnille (sarakkeet V2-V5) saadaan laskemalla ensin mitka ovat polun
# kokonaisliikennemaarat eri ilmansuuntiin ja kuinka paljon ne pienenevat esim. pyorakaistan rakentamisen
# yhteydessa.
#
# Ensin haetaan polku-muuttujan risteysten paikat (jarjestysnumerot) risteykset-taulukosta:
#
polku_risteykset <- list(1:length(polku));
for(i in 1:length(polku)) {polku_risteykset[[i]] <- which(risteykset[[1]] == polku[[i]])};
polku_risteykset
# Polun kokonaisliikennemaara (num_polun_liikennemaara) saadaan seuraaavasti
# (risteykset[as.numeric(polku_risteykset),i]-kutsu tuottaa listan liikennemaarista ilmansuuntaan i
# jokaisessa polun pisteessa):
#
polun_liikennemaara <- list(2:5);
for(i in 2:5) {polun_liikennemaara[[i]] <- sum(risteykset[as.numeric(polku_risteykset),i])};
num_polun_liikennemaara <- as.numeric(polun_liikennemaara[2:5]);
# Oletetaan, etta pyorakaistojen vetaminen ja pyorataskujen rakentaminen risteyksiin pienentaa autojen
# (= pikkuautojen ja bussien) liikennemaaria 10% lisaantyneen odotusajan jne. vuoksi (pyorailijoiden on
# paastava lahtemaan taskusta ennen autoilijoita).
#
# Maaritellaan jaettava liikennemaara vektoriin jaettava (= liikennemaara joka taytyy jakaa polun
# lahinaapuriristeyksiin):
#
jaettava <- 0.1*num_polun_liikennemaara;
# Jotta kokonaisliikennesuorite ei olisi sailyva suure maaritetaan jaettava-muuttuja uudella tavalla.
# Yksinkertainen tapa on muuttaa jaettava-muuttujassa P (= Pohjoinen), E (= Etela) ja I (= Ita), L (= Lansi)
# -sarakkeiden paikkaa. Maaritellaan siis jaettava_rotate -muuttuja:
#
jaettava_rotate <- c(1,1,1,1); jaettava_rotate[1] <- jaettava[2];
jaettava_rotate[2] <- jaettava[3]; jaettava_rotate[3] <- jaettava[4];
jaettava_rotate[4] <- jaettava[1]
# Lasketaan painokertoimet kaikille ilmansuunnille kaikissa lahinaapuripisteissa. Maaritetaan ensin
# paljonko liikennemaaraa on eri ilmansuuntiin kaikkien polun lahinaapureiden osalta:
#
lnaapuri_liikennemaara <- list(2:5);
for(i in 2:5) {lnaapuri_liikennemaara[[i]] <- sum(risteykset[as.numeric(lahinaapuri_risteykset),i])};
num_lnaapuri_liikennemaara <- as.numeric(lnaapuri_liikennemaara[2:5])
#
# Seuraavaksi lasketaan painokertoimet:
#
painokertoimet <- list(1:length(lahinaapuri_risteykset));
for(i in 1:length(lahinaapuri_risteykset)) {painokertoimet[[i]] <- risteykset[as.numeric(lahinaapuri_risteykset)[i],2:5]/num_lnaapuri_liikennemaara}
# Paljonko saadaan eri ilmansuuntiin jaettavaa joka risteyksessa on koodattu
# muuttujaan jaettavaa_per_risteys:
#
jaettava_per_risteys <- list(1:length(lahinaapuri_risteykset));
for(i in 1:length(lahinaapuri_risteykset)) {jaettava_per_risteys[[i]] <- painokertoimet[[i]]*jaettava_rotate}
# Viela pitaa vahentaa 'jaettava' jokaisesta risteyksesta polku-muuttujassa ja lisata
# jaettava_per_risteys-maara liikennetta jokaiseen lahinaapuriristeykseen jokaisessa ilmansuunnassa.
# Nain malli SAILYTTAA KOKONAISLIIKENNEMAARAN.
#
# Ensin on maaritettava paljonko polulta liikennemaaraa poistetaan. Talletetaan modifioitu liikennemaaratieto
# taulukkoon risteykset2. Ensin polku-muuttujan osalta:
#
risteykset2 <- risteykset;
for(i in 1:length(polku)) {risteykset2[as.numeric(polku_risteykset),][i,2:5] <- risteykset[as.numeric(polku_risteykset),][i,2:5] - (risteykset[as.numeric(polku_risteykset),][i,2:5]/num_polun_liikennemaara)*jaettava_rotate}
# Tehdaan sama homma polun lahinaapureille (eli sovelletaan samaa kaavaa kuin polulle) ja talletetaan
# muutokset taulukkoon risteykset2. Yo. kaavassa risteykset2-muuttujalle pitaa korvat length(polku) termilla
# length(lahinaapuri_risteykset) ja polku_risteykset -muuttuja lahinaapuri_risteykset -muuttujalla, seka
# summata edellisiin risteykset-muuttujan arvoihin jaettava_per_risteys jokaisessa lahinaapuriristeyksessa:
#
for(i in 1:length(lahinaapuri_risteykset)) {risteykset2[as.numeric(lahinaapuri_risteykset),][i,2:5] <- risteykset[as.numeric(lahinaapuri_risteykset),][i,2:5] + jaettava_per_risteys[[i]]}
# Kokonaisliikennemaarat koko katuverkossa saadaan summaamalla suoritteet jokaisessa hilapisteessa. Linkit
# tulee talloin laskettua kahteen kertaan, mika on oikein siita syysta, etta liikennemaarat ovat 'suunnattuja'.
# Oletuksena on etta molempiin suuntiin kulkee joka linkissa yhta paljon liikennetta ja nettovirta on nolla
# seka linkeissa etta risteyksissa. Lasketaan ensin uusi kokonaisliikennemaara (= kokonaisliikennemaara2)
#
kokonaisliikennemaara2 <- sum(sum(as.numeric(risteykset2[[2]])),sum(as.numeric(risteykset2[[3]])),sum(as.numeric(risteykset2[[4]])),sum(as.numeric(risteykset2[[5]])))
#
# Verrataan sita vanhaan
#
kokonaisliikennemaara <- sum(sum(as.numeric(risteykset[[2]])),sum(as.numeric(risteykset[[3]])),sum(as.numeric(risteykset[[4]])),sum(as.numeric(risteykset[[5]])))
# Liikennesuoritteet sen sijaan muuttuvat. Liikennemaarat pitaa kertoa korttelidimensioilla. P-E-suunnassa
# korttelin sivunpituus on n.135 m (sarakkeet V2 ja V4) ja I-L -suunnassa n. 100 m (sarakkeet V3 ja V5).
# Maaritellaan ensin kokonaisliikennemaarat eri suuntiin:
#
kokonaisliikennemaara_suunta2 <- c(sum(as.numeric(risteykset2[[2]])),sum(as.numeric(risteykset2[[3]])),
sum(as.numeric(risteykset2[[4]])),sum(as.numeric(risteykset2[[5]])))
#
# Verrataan tata vanhaan kokonaisliikennemaara_suunta -muuttujaan
#
kokonaisliikennemaara_suunta <- c(sum(as.numeric(risteykset[[2]])),sum(as.numeric(risteykset[[3]])),sum(as.numeric(risteykset[[4]])),sum(as.numeric(risteykset[[5]])))
# Lasketaan liikennesuorite2 (korttelipituudet muutettu kilometreiksi)
#
liikennesuorite2 <- (kokonaisliikennemaara_suunta2[1] + kokonaisliikennemaara_suunta2[3])*0.135 + (kokonaisliikennemaara_suunta2[2] + kokonaisliikennemaara_suunta2[4])*0.100;
liikennesuorite2
#
# Verrataan tata vanhaan liikennesuoritteeseen (korttelipituudet muutettu kilometreiksi)
#
liikennesuorite <- (kokonaisliikennemaara_suunta[1] + kokonaisliikennemaara_suunta[3])*0.135 + (kokonaisliikennemaara_suunta[2] + kokonaisliikennemaara_suunta[4])*0.100;
liikennesuorite
# Lasketaan vaikutukset henkilökohtaiseen terveyteen
#
emis.factor.PM <- 0.1 # gkm^-1
#
PM.lethality <- c(-7.223e-004, 5.640e-006, 4.228e-005, 5.987e-005, 8.013e-005, 1.150e-004, 2.037e-004, 2.939e-004, 3.598e-004, 4.132e-004, 4.640e-004, 5.139e-004, 5.662e-004, 6.233e-004, 6.854e-004, 7.577e-004, 8.441e-004, 9.519e-004, 1.093e-003, 1.314e-003, 2.805e-003)
#
PM.lethality <- median(PM.lethality) # deaths/kg = # deaths/(1000 g)
#
# Ylimaarainen kuolleisuus/vuosi (liikennemaarat ylla on laskettu per paiva, taytyy siis kertoa 365:lla)
#
kuolleisuus2 <- (PM.lethality/1000)*emis.factor.PM*liikennesuorite2*365
kuolleisuus2
#
# Ylimaarainen BAU-kuolleisuus (eli vanhalla liikennejarjestelylla)
#
kuolleisuus <- (PM.lethality/1000)*emis.factor.PM*liikennesuorite*365
kuolleisuus
| |
