Hiekkalaatikko

Päivitetty

$123 + α - 555 - 666$

Terveysvaikutukset

HUOM! Tällä hetkellä malli laskee ainoastaan murskausprosessin pölypäästöt ja niiden leviämisen 10-15 km:n säteellä olevaan väestöön. Mallia päivitetään jatkuvasti.

[vaihdetaan.kapsi.fi]

fckLRlibrary(OpasnetBaseUtils)fckLRlibrary(ggplot2)fckLRfckLRearth.radius <- 6372.8 # quadratic mean or root mean square approximation of the average great-circle fckLR # circumference derives a radius of about 6372.8 km (Wikipedia)fckLRcentral.angle <- function(s.la, s.lo, f.la, f.lo) 2 * asin((sin((s.la - f.la) / 2)^2 + cos(s.la) * cos(f.la) * sin((s.lo - f.lo) / 2)^2)^0.5)fckLRfckLRdtheta.y <- 1/earth.radius*180/pi # central angle increase per 1 kilometer north from a given point assuming no displacement on x axisfckLRdtheta.x <- 2*asin(sin(1/(2*earth.radius))/cos(LA/180*pi))*180/pi # central angle increase per 1 kilometer east from a given point fckLR# - assuming no displacement on y axisfckLRfckLR# Populaatio datafckLRfckLRpop.locs <- op_baseGetLocs("heande_base", "Heande3182", apply.utf8 = FALSE)fckLRhead(pop.locs)fckLRpop.slice.la <- pop.locs[pop.locs$ind == "Latitude", "loc_id"][pop.locs[pop.locs$ind == "Latitude", "loc"] < LA + 10.5 * dtheta.y & fckLR pop.locs[pop.locs$ind == "Latitude", "loc"] > LA - 10.5 * dtheta.y]fckLRpop.slice.lo.inverse <- pop.locs[pop.locs$ind == "Longitude", "loc_id"][pop.locs[pop.locs$ind == "Longitude", "loc"] > LO + 10.5 * dtheta.x | fckLR pop.locs[pop.locs$ind == "Longitude", "loc"] < LO - 10.5 * dtheta.x]fckLRfckLRpop <- op_baseGetData("heande_base", "Heande3182", include = pop.slice.la, exclude = pop.slice.lo.inverse)fckLRfckLRhead(pop)fckLRfckLRpop$Longitude <- as.numeric(as.character(pop$Longitude))fckLRpop$Latitude <- as.numeric(as.character(pop$Latitude))fckLRfckLRpop$LObin <- cut(pop$Longitude, breaks = LO + ((-11:10) + 0.5 ) * dtheta.x)fckLRpop$LAbin <- cut(pop$Latitude, breaks = LA + ((-11:10) + 0.5 ) * dtheta.y)fckLRfckLR# Pitoisuus datafckLRfckLRpitoisuus <- function(n, paasto, L.matrix) { #, X_coord, Y_coord) {fckLR ID.list <- tapply(1:nrow(L.matrix), L.matrix[,c("Kaupunki", "Vuosi", "Tyyppi")], list)fckLR ID.list.samples <- sample(ID.list, n, replace = TRUE)fckLR ID.vec <- unlist(ID.list.samples)fckLRprint(ID.vec)fckLRprint(ID.list)fckLR #c.matrix <- pitoisuus(L.matrix, Paasto) #, X_coord, Y_coord)fckLR l.matrix <- L.matrix[ID.vec,]fckLR l.matrix$obs <- rep(1:n, each = length(ID.vec)/n)fckLRprint(head(l.matrix)) fckLR c.matrix <- merge(l.matrix, paasto)fckLR c.matrix <- model.frame(I(Paasto * k) ~., data = c.matrix)fckLR colnames(c.matrix)[1] <- "Pitoisuus"fckLRprint(head(c.matrix))fckLR return(c.matrix)fckLR}fckLRfckLRPILTTI.matrix <- op_baseGetData("heande_base", "Heande3181")[,-c(1,2,9)] # unit: ugm^-3/Mga^-1fckLRfckLRPILTTI.matrix$dy <- as.numeric(as.character(PILTTI.matrix$dy))fckLRPILTTI.matrix$dx <- as.numeric(as.character(PILTTI.matrix$dx))fckLRfckLRcolnames(PILTTI.matrix)[colnames(PILTTI.matrix)=="Result"] <- "k"fckLRfckLRhead(PILTTI.matrix)fckLRfckLRPaasto <- data.frame(Paasto = murskaus.maara * paasto.kerroin / 1e6) # unit: Mga^-1fckLRfckLRhead(Paasto)fckLRfckLRC.matrix <- pitoisuus(N, Paasto, PILTTI.matrix) # unit: ugm^-3fckLRNfckLRhead(C.matrix)fckLRfckLRC.matrix$LObin <- cut(C.matrix$dx / 1000 * dtheta.x + LO, breaks = LO + ((-11:10) + 0.5 ) * dtheta.x)fckLRC.matrix$LAbin <- cut(C.matrix$dy / 1000 * dtheta.y + LA, breaks = LA + ((-11:10) + 0.5 ) * dtheta.y)fckLRfckLR# YhdistysfckLRfckLRhead(C.matrix)fckLRfckLRpop.paasto <- merge(C.matrix, pop[,-c(1,2,6)])fckLRfckLRpop.paasto.korjaus <- data.frame(Pitoisuus = pop.paasto$Pitoisuus, Vaesto = pop.paasto$Result / N)fckLRfckLRhead(pop.paasto.korjaus)fckLRfckLRplot1 <- ggplot(pop.paasto.korjaus, aes(x = Pitoisuus, weight = Vaesto)) + geom_histogram(binwidth = fckLR(max(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]) - fckLRmin(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]))/100) + fckLRxlim(min(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]) - 0.000001, fckLRmax(pop.paasto.korjaus$Pitoisuus[pop.paasto.korjaus$Vaesto!=0]) + 0.000001)fckLRfckLRplot1 + geom_vline(xintercept = 40, colour = "red") # OhjearvofckLRfckLRexposure.pop <- tapply(pop.paasto$Pitoisuus * pop.paasto$Result, pop.paasto[,c("obs")], sum)fckLRfckLRbg.mort <- 45182/5203826 # same values as used in PILTTIfckLRfckLRerf <- 0.0097 # J. T. Tuomisto, A. Wilson, et al. Uncertainty in mortality response to airborne fine particulate matter... 2008fckLR# unit: 1/ugm^-3fckLRfckLRmort.out <- erf * bg.mort * exposure.popfckLRfckLRqplot(mort.out, geom="density")fckLRfckLRcat("Odotusarvo kuolemille vuodessa:", mean(mort.out), "\n")fckLRfckLRcat("Ohjearvon 40 ugm^-3 mukaisen altistusrajan ylitti", sum(pop.paasto.korjaus$Vaesto[pop.paasto.korjaus$Pitoisuus>40]), "asukasta.\n")fckLR

Oletusarvot Siilinjärven Yaralle, yhdelle tonnille murskattua malmia vuodessa olettaen että murskaustapa on kuivaseulonta ilman avulla (suurin päästökerroin). Katso: <a _fcknotitle="true" href=":op fi:Metallimalmin murskausprosessin kokonais- (TSP) ja hengittyvien hiukkasten (PM10) päästökertoimet">:op fi:Metallimalmin murskausprosessin kokonais- (TSP) ja hengittyvien hiukkasten (PM10) päästökertoimet</a>.
Havainnollisia lähtöarvojen muutoksia:
- Luikonlahden koordinaatit (pienempi väestö kaivoksen ympärillä): latitude=62.936836, longitude=28.70749
- Hienomurskaus kostealle malmille: päästökerroin 9.1 (oletus: kuiva malmi 72.6)

R-testi

fckLR######## Haetaan R-koodi generic sivulta Projektinhallinta. Sisältää funktiot dropall ja PTable.fckLR######## Ladataan tarvittavat paketitfckLRlibrary(OpasnetBaseUtils)fckLRlibrary(ggplot2)fckLRlibrary(xtable)fckLRfckLRprint("Haetaan tarvittava data Opasnet-kannasta")fckLRsaanto.siemenet <- op_baseGetData("opasnet_base", "Op_fi2633")[,-c(1,2,7)] # Jatropan siementen saanto viljelystäfckLRsaanto.öljy <- op_baseGetData("opasnet_base", "Op_fi2634")[,-c(1,2,5)] # Öljyn saanto jatropan siemenistäfckLRsaanto.diesel <- op_baseGetData("opasnet_base", "Op_fi2632")[,-c(1,2,5)] # Biodieselin saanto jatropaöljystäfckLRviljelyala <- op_baseGetData("opasnet_base", "Op_fi2642")[,-c(1,2)] # Jatropan viljelyalueetfckLRpäästö.ilmasto <- op_baseGetData("opasnet_base", "Op_fi2547")[,-c(1,2)] # Jatropan viljelyn ilmastovaikutuksetfckLRpäästö.sosiaali <- op_baseGetData("opasnet_base", "Op_fi2552")[,-c(1,2)] # Jatropan viljelyn sosiaaliset vaikutuksetfckLRpäästö.ekosyst <- op_baseGetData("opasnet_base", "Op_fi2548")[,-c(1,2)] # Jatropan viljelyn ekosysteemivaikutuksetfckLRP <- op_baseGetData("opasnet_base", "Op_fi2539")[,-c(1,2,7)] # Jatropan käyttö bioenergian lähteenäfckLRfckLRprint("Ajetaan malli")fckLRfckLR### Muutetaan sarakkeiden nimet sopiviksi yhdistämistä varten.fckLRcolnames(saanto.siemenet)[4] <- "siemenet"fckLRcolnames(saanto.öljy)[2] <- "öljy"fckLRcolnames(saanto.diesel)[2] <- "diesel"fckLRfckLR## Yhdistetään tiedot toisiinsa yhdeksi data.frameksi. Lasketaan saanto.fckLRsaanto <- merge(saanto.siemenet, saanto.öljy)fckLRsaanto <- merge(saanto, saanto.diesel)fckLRsaanto[,9] <- saanto$siemenet * saanto$öljy * saanto$diesel * alafckLRcolnames(saanto)[9] <- "saanto (kg/a)"fckLRfckLR## Muutetaan tulos jakaumaksi Monte Carlolla.fckLRP <- PTable(P, n)fckLRsaanto <- merge(P, saanto)fckLRfckLR## Lasketaan tulostaulu.fckLRif(length(divisions)>1) divisions <- as.list(saanto[, divisions]) else divisions <- saanto[, divisions]fckLRout1 <- as.data.frame(as.table(tapply(saanto[, 10], divisions, mean))) fckLRout1 <- dropall(out1[!is.na(out1$Freq), ])fckLRfckLRprint(xtable(out1), type = 'html')fckLRfckLR## Lasketaan tuloskuvaaja.fckLRout2 <- as.data.frame(as.table(tapply(saanto[, 10], list(saanto[, divisions2], saanto$obs), mean))) fckLRout2 <- dropall(out2[!is.na(out2$Freq), ])fckLRggplot(out2, aes(x = Freq, weight = 1, fill = Var1)) +geom_density() fckLR## Jostain syystä vain osa kuvista piirtyy oikein, riippuen mitä parametreja valitaan. En ymmärrä syytä.fckLR

{{{1}}}

fckLRJEPJEJPKEPKEfckLRfckLRJOOfckLR

fwae

JEPULISTA

fckLRcategory = THL:n julkaisuja vuonna 2010fckLRmode = orderedfckLRinclude = {julkaisu}fckLRordermethod=titlefckLRformat = ,\n<big><a href="%PAGE%">%TITLE%</a></big>,,fckLRnotcategory = glossaryfckLRorder = ascendingfckLR

Malline:BudjettirajapintafckLR

<a _fcknotitle="true" href="Category:Testi">Testi</a>

<a href="op en:Sandbox">op en:Sandbox</a>

Hiekkalaatikko

Terveysvaikutukset

R-testi

Navigointivalikko