Ero sivun ”Ympäristöterveysindikaattori” versioiden välillä

Versio 8. heinäkuuta 2018 kello 20.56

Tämä sivu on tietokide alatyypiltään metodi. Sivutunniste: Op_fi5810
Moderaattori:Jouni (katso kaikki) Sivun edistymistä ei ole arvioitu. Arvostuksen määrää ei ole arvioitu (ks. peer review).
Lisää dataa {{#opasnet_base_link:Op_fi5810}}

Ympäristöterveysindikaattori on elinympäristön tiettyä ominaisuutta mittaava asia, joka kertoo ympäristön terveellisyydestä ihmiselle.

Kysymys

Mitkä ovat hyödyllisiä indikaattoreita Suomen ympäristöterveystilanteen seuraamiseksi ja parantamiseksi?

Vastaus

Nämä indikaattorit ovat olemassa tai suunnitteilla:

Pienhiukkaspitoisuuden väestöpainotettu vuosikeskiarvo (Yhteistyötilat)
Sisätilaongelmista koulussa raportoivat koululaiset
Vesivälitteisten epidemioiden lukumäärät ja sairastuneiden lukumäärät
Elintarvikevälitteisten epidemioiden lukumäärät ja sairastuneiden lukumäärät

Perustelut

Ohje indikaattorin julkaisemiseksi Sotkanetissä
Ohje datan viemisestä Sotkanettiin
THL:n tietotuotannon käsikirja
Ympäristöterveyden indikaattorihanke (STM:n maksama hanke toukokuu-lokakuu 2018)

Data

Näkemysverkkojen tietotauluja

Data on muodostettu koodilla:

+ Näytä koodi - Piilota koodi

# Tämä on koodi Op_fi5810/ sivulla [[Ympäristöterveysindikaattori]]
library(OpasnetUtils)
library(gsheet)
library(rvest)

types <- opbase.data("Op_en3861", subset="Table types")
meta <- html_table(read_html("https://yhteistyotilat.fi/wiki08/x/1oGxAg"))[[3]]


for(i in 1:nrow(meta)) {
  if(grepl("google.com", meta$URL[i])) {
    out <- gsheet2tbl(meta$URL[i])[-(1:(meta$Alkurivi[i]-2)) , ]
  } else {
    out <- html_table(read_html(meta$URL[i]),fill=TRUE)[[meta$Taulu[i]]]
  }
  coln <- as.character(types$`Column names`[types$Type==meta$Tyyppi[i]])
  if(colnames(out)[1]=="Obs") coln <- paste0("Obs,",out)
  colnames(out) <- trimws(strsplit(coln,split=",")[[1]])
  write.csv(out, gsub("[Öö]","o",gsub("[ÄÅäå]","a",paste0(meta$Ilmio[i],".csv"))))
}
write.csv(meta, "meta.csv")
# Zippaus ei jostain syystä toimi minun koneella
zip("Näkemysverkkojen tietotaulut.zip", paste0(c("meta",meta$Ilmio),".zip"))

Työlista

Tee Google sheet, jonne listataan kaikki Sitran 100 fiksua tekoa siten, että sarakkeisiin tulevat
- Nimi (arjen teon nimi)
- Suuruus (onko vaikutus pieni, keskisuuri vai suuri)
- Aihepiiri (liittyykö teko asumiseen, matkustamiseen jne)
- URL sivulle, jossa teko esitellään
Tutustu uuteen kuvaukseen Helsingin ilmastopolitiikasta:
- Hiilineutraali Helsinki 2035 ohjelman sivu Opasnetissä
- [ja kustannukset (tämä linkki lähetetään whatsappissa koska ei vielä julkinen) Kuvaus toimenpidetyökalusta] (luonnos)
- Esimerkkisivuja toimenpiteistä Toimenpide 1, Toimenpide 2
- ilmasto-ohjelman toimepiteet ja kustannukset (tämä linkki lähetetään whatsappissa koska ei vielä julkinen)
Tutustu kuvaukseet ruuhkamaksuista (Decision analysis and risk management 2017 -kurssilla tehty)
- op_en:Congestion charge pääsivu Opasnetissä. Kommentit ja kehitysideat tänne.
- Google drive, jossa gsheet olioista ja niiden relaatioista ja syykaavio aiemman keskustelun pohjalta.
Tutustu sanastoon sivulla op_en:Structure of shared understanding ja kommentoi kummallisuuksia ja epäselvyyksiä.
Tutustu kaavioiden muotoiluihin sivulla op_en:Extended causal diagram ja kommentoi kummallisuuksia ja epäselvyyksiä. Kaavioiden toteutus R-paketilla DiagrammeR nettisivu, dokumentaatio.
Tutustu ympäristöterveyden indikaattoreihin sivulla Ympäristöterveys

Käytä näitä keskustelumuotoiluja kun haluat kommentoida sivun sisältöä Opasnetissä:

Kommentti:

{{comment|# (tarvittaessa argumentin numero)|Kommentoiva argumentti.|--~~~~}}

Puolusta:

{{defend|# (tarvittaessa argumentin numero)|Puolustava argumentti.|--~~~~}}

Kommentti:

{{attack|# (tarvittaessa argumentin numero)|Hyökkäävä argumentti.|--~~~~}}

Syykaaviot

Ehdotus sosiaali- ja terveyspalveluiden uudeksi kansalliseksi mittaristoksi VN-TEAS 15.3.2017 http://tietokayttoon.fi/julkaisu?pubid=18701
http://alueuudistus.fi/tietojohtaminen
KUVA-mittaristo 23.4.2018 http://alueuudistus.fi/documents/1477425/4439893/Sote-KUVA-mittaristoluonnos+23.4.+2018.xlsx/3ffc2fce-04c9-4c96-a21d-fb217310dbd5
Kuva-indikaattorit drivessä https://docs.google.com/spreadsheets/d/1OJntWc-ivrCDi9RkCAyWdggA3VCm-BM98rp6H5u3diI/edit#gid=0
Hyte-indikaattorit drivessä https://docs.google.com/spreadsheets/d/1mVlLcvsDFHKivD8rSDyn3ijfvoUAjxnXOGb-nujLDak/edit#gid=0
Tietoikkuna https://proto.thl.fi/tietoikkuna/#/chart?indicatorId=3775&regionId=953
Sotkanet https://www.sotkanet.fi/sotkanet/fi/metadata/indicators/3775
Kouluterveyskysely https://sampo.thl.fi/pivot/prod/fi/ktk/ktk1/fact_ktk_ktk1/199464

+ Näytä koodi - Piilota koodi

# Tämä on koodi Op_fi5810/ sivulla [[Ympäristöterveysindikaattori]]
library(OpasnetUtils)
library(gsheet)

objects.latest("Op_en3861",code_name="ecd_create")

sotkanet <- "http://www.sotkanet.fi/sotkanet/fi/metadata/indicators/"
kouluterveyskysely <- "https://sampo.thl.fi/pivot/prod/fi/ktk/ktk1/summary_perustulokset?alue_0=87869&mittarit_0=200138&mittarit_1=187196&mittarit_2=199373&vuosi_2017_0=v2017"
kouluterveyskysely <- "https://sampo.thl.fi/pivot/prod/fi/ktk/ktk1/fact_ktk_ktk1?row=measure-200346.199405.199681.199445.199678.199701.199935.200120.199469.199308.199973.200279.200316.199604.&column=time-199465&column=stage_of_stady-161293.161123.161219.#" # Keskeiset ympäristöterveyden oire- ja olosuhdeindikaattorit eri kouluasteilla
tietoikkuna <- "https://proto.thl.fi/tietoikkuna/#/chart?indicatorId="
# Sotkanet.ID = tietoikkuna.indicatorID

meta <- opasnet.csv(
  "3/3e/N%C3%A4kemysverkkojen_tietotauluja.zip",
  wiki="opasnet_fi",
  unzip="meta.csv",
  sep=",",header=TRUE,stringsAsFactors=FALSE
) 

out <- list()
for(i in 1:nrow(meta)) {
  temp  <- opasnet.csv(
    "3/3e/N%C3%A4kemysverkkojen_tietotauluja.zip",
    wiki="opasnet_fi",
    unzip=gsub("[Öö]","o",gsub("[ÄÅäå]","a",paste0(meta$Ilmio[i],".csv"))),
    sep=",",header=TRUE,stringsAsFactors=FALSE
  )

  # Convert structural names to English
  colnames(temp)[colnames(temp)=="Lyhenne"] <- "label" # Columns defined by DiagrammeR start with small letter
  colnames(temp)[colnames(temp)=="Luokka"] <- "type"
  colnames(temp)[colnames(temp)%in% c("Toimenpide","Nimi","Asia")] <- "Item"
  colnames(temp)[colnames(temp) %in% c("Predikaatti","Relaatio")] <- "Relation"
  colnames(temp)[colnames(temp) %in% c("Objekti","Kohde")] <- "Object"
  colnames(temp)[colnames(temp) %in% c("Kuvaus","Lisatietoa","Kommentteja")] <- "Description"
  colnames(temp)[colnames(temp) %in% c("Aihe1","Tehtavakokonaisuus")] <- "Teema"
  colnames(temp)[colnames(temp) %in% c("Tunnistenumero","Obs")] <- "Nro"
  if(!"label" %in% colnames(temp)) temp$label <- NA
  temp$label <- ifelse(is.na(temp$label), substr(temp$Item,1,50), temp$label)
  temp$Oldid = paste(meta$Id[i],{if("Nro" %in% colnames(temp)) temp$Nro else 1:nrow(temp)},sep=".")
  out[[i]] <- temp
}

#  Table-specific adjustments

out[[5]] <- splizzeria(out[[5]], cols = c("Ulottuvuus","Osiotyyppi","JHS.luokka"), split = "/") # HYTE
out[[6]] <- splizzeria(out[[6]], cols = c("JHS.luokka"), split = ",") # LAPE
#  temp$Object <- tolower(temp$Object) # Tämä ei haluta tehdä kaikille. mutta mille?

# Aikuisten lihavuuden säätöjä
#for(i in 1:4) out[[7]][[i]] <- tolower(out[[7]][[i]])

# HYTE JA LAPE ELI SOTEARV

d3 <- data.frame()
for(i in (1:nrow(meta))[meta$Tyyppi=="sotearv"]) {
  if(nrow(d3)==0) d3 <- out[[i]] else d3 <- orbind(d3, out[[i]])
}

d3 <- orbind(orbind(orbind(
  data.frame(
    Oldid = d3$Oldid,
    type = paste(d3$Tehtavakokonaisuus, "indikaattori",sep="-"),
    Item = d3$Item,
    Relation = "ulottuvuus",
    Object = d3$Ulottuvuus,
    URL = ifelse(
      is.na(as.numeric(substr(d3$Sotkanet.id,1,4))),
      NA,
      paste0(sotkanet, substr(d3$Sotkanet.id,1,4))
    ),
    Description = d3$Ryhman.perustelut,
    label = ifelse(is.na(d3$label),substr(d3$Item,1,30),d3$label),
    stringsAsFactors = FALSE
  ),
  data.frame(
    Item = d3$Item,
    Relation = "osiotyyppi",
    Object = d3$Osiotyyppi,
    stringsAsFactors = FALSE
  )),
  data.frame(
    Item = d3$Item,
    Relation = "discussed in",
    Object = d3$Tietolahde,
    stringsAsFactors = FALSE
  )),
  data.frame(
    Item = d3$Item,
    Relation = "JHS-luokka",
    Object = d3$JHS.luokka,
    stringsAsFactors = FALSE
  )
) 

## Oletusmuotoiset taulut (Ympäristöterveys, Lasten ja aikuisten lihavuus, Yleiset ja erityiset luokittelut)

d2 <- data.frame()
for(i in (1:nrow(meta))[meta$Tyyppi=="oletus"]) {
  if(nrow(d2)==0) d2 <- out[[i]] else d2 <- orbind(d2, out[[i]])
}

#' @title fillprev fills empty cells in a data.frame by using content from the previous row.
#' @param df data.frame to be filled
#' @param cols vector of column names or positions to be filled.
#' @return Returns a data.frame with the same shape as df.
fillprev <- function(df, cols) {
  out <- df
  for(i in cols) { 
    for(j in 2:nrow(out)) {
      if(out[j,i] %in% c("", NA)) out[j,i] <- out[j-1,i]
    }
  }
  return(out)
}

d2 <- fillprev(d2, cols=c("type","Relation","Object"))
d2 <- splizzeria(d2, cols="Object", split=",")
d2$URL <- ifelse(
  is.na(as.numeric(substr(d2$URL,1,4))),
  NA,
  paste0(sotkanet, substr(d2$URL,1,4))
)

####### HNH2035-toimenpiteet

# Tämä koodi on tilapäinen ja pitäisi korjata alkuperäiseen taulukkoon. Sano Sonjalle.
repl <- array(c(
  "S&C säätiö","Smart&Clean",
  "yhteistyössä","",
  "yhteistyö","",
  "Yhteistyö:","",
  "ja","",
  "HSY Ilmastoinfo","HSY/Ilmastoinfo",
  "HSY:n Ilmastoinfo","HSY/Ilmastoinfo",
  "Kanslia ELO/Hanki","Kanslia/ELO",
  "GEO","Geo",
  "kasko","Kasko",
  "sote","Sote",
  "palvelukeskus","Palvelukeskus",
  "ympa","Ympa",
  "RYA","Rya",
  "PALU","Palu",
  "YMPA","Ympa",
  "MAKA","Maka",
  "KYMP","Kymp",
  "Smart&Clean -säätiö","Smart&Clean",
  "Smart & Clean -säätiö","Smart&Clean",
  "virium","Virium",
  "nuorisopalvelur","Nuorisopalvelut",
  "kanslia","Kanslia",
  "Kaupunginkanslia","Kanslia",
  "kaupunginkanslia","Kanslia",
  "(HSL), (HSY)",",",
  "ympa","Ympa",
  "Palu/Ympa","Ympa"
),
dim=c(2,28)
)

d1 <- out[[8]]
for(i in 1:ncol(repl)) {
  d1$Vastuu <- gsub(repl[1,i],repl[2,i],d1$Vastuu)
}
d1 <- fillprev(d1,"Teema")
d1 <- d1[!is.na(d1$Nro) , ]

# d1 <- splizzeria(d1, cols="Kustannukset", split="/") # Not used because doubles relations

temp <- splizzeria(d1, cols="Vastuu", split=",")

d1 <- orbind(
  cbind(
    Oldid=paste0("HNH2035/tp.", d1$Nro),
    type="HNH2035-toimenpide",
    Item=d1$Item,
    label=substr(d1$Item,1,30),
    Relation="teema",
    Object=d1$Teema,
    Description = paste(d1$Aikajanne, d1$Vaativuus, d1$Kustannukset, sep=". ")
  ),
  data.frame(
    Item=temp$Item,
    Relation="vastuullisena",
    Object=temp$Vastuu
  )
)

# Hiilineutraalin Helsingin toimijalistaus

d0 <- out[[13]]
d0$type=tolower(d0$type)
d0$label=substr(d0$Item,1,30)

########################### Create ecd_graph

d <- orbind(orbind(orbind(d3, d2), d1), d0)
d$label <- ifelse(is.na(d$label), substr(d$Item,1,30), d$label)

gr <- ecd_create(d)

gr <- deselect_edges(gr, get_selection(gr))
gr <- select_edges(gr, conditions = grepl("Hyte", gr$edges_df$Oldid))

gr <- deselect_nodes(gr, get_selection(gr))
gr <- select_nodes(gr, conditions = grepl("HNH2035", gr$nodes_df$Oldid))

#gr <- select_nodes_in_neighborhood(
#  gr,
#  node=gr$nodes_df$id[gr$nodes_df$label=="koulutervhuolto"][1],
#  distance=2
#)
#get_selection(gr)

#render_graph(gr)
render_graph(transform_to_subgraph_ws(gr))
export_graph(transform_to_subgraph_ws(gr), "test7.svg")
#export_graph(gr, "test7.pdf")

Sisäilma kouluissa

Kouluterveyskysely tuottaa jotakin tietoa myös sisäilmasta, oppimisympäristöstä yleensä ja oppilaiden raportoimista yleisistä oireista. Katso lisätietoa näistä linkeistä:

+ Näytä koodi - Piilota koodi

# This is code Op_fi5810/koulukysely on page [[Ympäristöterveysindikaattori]]

url <- "https://sampo.thl.fi/pivot/prod/fi/ktk/ktk1/fact_ktk_ktk1.csv?row=area-87869.161055.235597.235713.236211.259770.259803.259692.259710.236112.259753.259815.235780.236146.236002.259679.259682.236133.236222.259675.259733.236051.235920.235827.235885.236295.259709.236200.235707.259808.259713.235708.235976.236233.259789.235797.236081.259685.235622.235906.259723.259810.235955.235793.236073.259787.235869.235881.235892.259725.259765.235947.236255.259697.235616.236189.235907.236122.259744.236140.235580.235913.259712.235685.235812.235714.161061.235679.259773.259783.235940.259737.235805.259807.235657.259730.235829.259800.236015.259740.235857.235639.259711.259772.236190.235592.259729.235832.235769.259680.259742.236283.235993.259700.236239.235721.259721.235701.235643.259797.236117.259818.235924.259688.259795.259708.235799.236240.259761.161009.235959.259793.259724.259756.259776.235678.259813.236155.259678.259769.235854.259821.259747.236173.259781.235649.236205.235731.259762.236066.259757.235742.236187.235781.235876.259739.259716.259718.236025.235866.235610.259774.259734.236287.235801.236159.236033.259771.259767.259806.236041.259704.236291.259727.259754.235871.259746.259811.161075.235939.235737.236149.259804.235662.259683.236171.259707.235962.235579.235659.235603.235589.259798.259715.259749.235933.235794.259705.235971.235951.235689.259743.236215.235979.259817.235875.259694.259720.236142.235824.259695.259684.236286.259696.259703.259759.259699.259825.236069.259755.259690.236281.259701.236271.259676.259750.235686.235994.235918.259792.235606.236032.259731.236191.235833.235877.236144.236213.235909.235992.259686.259717.235675.235915.236244.236258.259782.236253.259748.235647.235922.235998.259814.259736.259677.236027.259784.259780.259691.259766.235680.235849.235646.235740.236265.235811.161092.236127.259819.235984.235851.259763.259790.259732.236262.236214.235658.259778.235786.235691.259752.259758.235599.236096.236139.259791.235963.259760.259751.235848.235577.235956.236237.236277.259805.235820.259777.235784.259801.259809.236124.236249.236034.259702.259681.259714.235620.161039.235602.259802.235738.236102.236076.236030.236116.235896.236045.259738.236090.259706.259689.235850.259687.259785.236279.235926.235637.235739.259820.236288.161044.235598.259741.259726.259812.235732.259779.259698.236174.266765.&column=time-199465.&column=stage_of_stady-161293.161123.161219.&filter=measure-"
measure <- matrix(
  c(
    "199935#", "Kuuma",
    "200120#", "Kylmä",
    "199915#", "Tunkkaisuus",
    "199469#", "Haju",
    "199308#", "Ahtaus",
    "199973#", "Melu",
    "200279#", "Valoisuus",
    "200316#", "Epämukavuus",
    "199604#", "Huonot WCt"
  ),
  nrow=2
)
d <- data.frame()
for(i in 1:ncol(measure)) {
  d <- rbind(
    d,
    cbind(
      Kys = measure[2,i],
      read.csv(paste(url,measure[1,i],sep=""),sep=";",encoding="UTF-8")
    )
  )
}
d$val <- as.numeric(as.character(d$val))
d_ilma <- d[d$Kys %in% c("Kuuma","Kylmä","Tunkkaisuus","Haju"),]
d_ilma <- aggregate(
  d_ilma["val"], 
  by = d_ilma[c("Kyselyvuosi","Alue")],
  FUN=function(x) mean(x, na.rm=TRUE)
)
d_ergo <- d[!d$Kys %in% c("Kuuma","Kylmä","Tunkkaisuus","Haju"),]
d_ergo <- aggregate(
  d_ergo["val"], 
  by = d_ergo[c("Kyselyvuosi","Alue")],
  FUN=function(x) mean(x, na.rm=TRUE)
)
d_kaikki <- aggregate(
  d["val"], 
  by = d[c("Kyselyvuosi","Alue")],
  FUN=function(x) mean(x, na.rm=TRUE)
)
d_kaikki <- merge(merge(d_ilma, d_ergo, by=c("Kyselyvuosi","Alue")),d_kaikki)
colnames(d_kaikki)[3:5] <- c("Ilma","Ergo","Kaikki")
print(d_kaikki)

Indikaattorien lataus Sotkanettiin

+ Näytä koodi - Piilota koodi

# This is code Op_fi5810/ on page [[Ympäristöterveysindikaattori]].
# Vanha versio käytti suoraan CREATE TABLE ja INSERT INTO. Uusi versio käyttää peaJdbcWrite.

library(pea)
library(tcltk2)
library(rvest) # For html import

# Fetch data from Yhteistyötilat.
dat <- html_table(read_html("https://yhteistyotilat.fi/wiki08/x/SLHFAg"))[[3]] # Pienhiukkaspitoisuuden väestöpainotettu vuosikeskiarvo
dat <- data.frame(
  Vuosi = 2015,
  Alue = dat$Alue,
  Aluekoodi = dat[[2]],
  Sukupuoli = 4,
  Mittari = 678,
  Mittarin_arvo = dat[[7]],
  Paivamaara = "31.5.2018",
  stringsAsFactors = FALSE
)

con <- peaJdbcConnect("common") # Tässä kohdassa kysytään käyttäjätunnus ja salasana

# Useful queries that you may need.
# View(dbGetQuery(con, "select * from pg_catalog.pg_tables where schemaname = 'sotkanet_lataus';"))
# View(dbGetQuery(con, "select distinct schemaname from pg_catalog.pg_tables;")) # Listaa skeemat
# koo <- peaGetKoodisto('d_alue_2_sote')$data # Kuntien ja maakuntien aluekoodit. 
# d_alue_2_sote sisältää HE2017-esityksen mukaiset maakunnat, d_alue_2 puolestaan 2018 voimassa olleet.

# Luodaan taulu ja kirjoitetaan datat siihen.
# Taulun nimi on muotoa indikaattori_XXXX, jossa XXXX  on indikaattorin Sotkanet_id.

peaJdbcWrite(
  con,
  dat=dat,
  tablename="indikaattori_678",
  schema="sotkanet_lataus",
  batch_size=10000,
  role="public_sotkanet_reader",
  grant="select"
)

Sotearvioinnin koodi liittyen ympäristöterveyteen

+ Näytä koodi - Piilota koodi

# This is code Op_fi5810/ on page [[Ympäristöterveysindikaattori]]

library(rvest) # For html import

tx <- function(x, prec = 2) gsub("\\.", ",", as.character(signif(x, prec))) # Converts numbers to nice Finnish format
write(
  "Sote-arviointi, hyvinvointi ja terveys: ympäristöterveyden osa-alue\n\n",
  file="sotearviointi.txt"
)
# Fetch data from Yhteistyötilat.
dat <- html_table(read_html("https://yhteistyotilat.fi/wiki08/x/SLHFAg"))[[3]] # Pienhiukkaspitoisuuden väestöpainotettu vuosikeskiarvo
colnames(dat) <- c("Alue","Mid","Municipality","Pid","Province","Pop","PM",
                   "Daly","Comment","Genetive","Adessive")

for(i in c(2,4,6,7,8)) dat[[i]] <- as.numeric(gsub(" ", "", dat[[i]]))

# Data about disease burden of PM2.5 from Lehtomäki et al 2018 https://doi.org/10.3390/ijerph15040736
mort <- "1600 - 2000"
daly <- 26000

for(i in sort(unique(dat$Pid))) {
  j <- (1:nrow(dat))[dat$Pid==i & dat$Alue=="HE-maakunta"]
  mk <- dat$Province[j]
  ka <- sum(dat$Pop * dat$PM / sum(dat$Pop))
  kam <- dat$PM[j]
  s1 <- paste("Pienhiukkaset ovat Suomessakin kaikkein merkittävin ympäristötekijä, joka aiheuttaa ",
  "terveyshaittaa. Pienhiukkaset ovat pääasiassa peräisin liikenteestä ja puun pienpoltosta. ",
  "Myös energiantuotanto ja teollisuus ovat suurehkoja lähteitä mutta niiden ominaispäästöt ",
  "ovat pienet (eli tuotantolaitokset puhdistavat jo tehokkaasti päästöjään) ja päästöt ",
  "tyypillisesti leviävät korkeista piipuista laajalle aiheuttamatta asutuskeskuksiin korkeita ",
  "pitoisuuksia. Muita kuin polttoperäisiä päästölähteitä ovat mm. katupöly varsinkin keväisin, ",
  "maatalouden pölyt sekä monista hajalähteistä syntyvät orgaaniset hiilivedyt, jotka ",
  "muuttuvat hiukkasiksi vasta ilmakehässä.\n",
  sep="")
  
  s2 <- paste(
    "Pienhiukkaspitoisuuksien vuosikeskiarvo on arvioitu kunnittain THL:n koordinoimassa ",
    "tutkimushankkeessa vuodelle 2015. Tämä on hyvä haitan mittari, koska tyypilliset ",
    "terveyshaitat kuten sydäntaudit, krooninen bronkiitti ja keuhkosyöpä kehittyvät ",
    "pitkäaikaisen altistuksen seurauksena. Kansainvälisesti verrattuna Suomen ",
    "pienhiukkaspitoisuudet ovat pienet, mutta silti niiden arvioidaan aiheuttavan ",
    tx(daly),
    " terveen elinvuoden menetyksen tai vastaavasti ",
    mort,
    " kuolemantapausta ",
    "(Lehtomäki ym., 2018 https://doi.org/10.3390/ijerph15040736).\n",
    sep=""
  )
  
  s3 <- "Väestöpainotettu pienhiukkaspitoisuus oli "
  s4 <- paste(
    dat$Adessive[j],
    ifelse(
      kam < 0.8*ka ," pieni ", 
      ifelse(kam < 1.2*ka, 
             " keskimääräinen ", 
             " suomalaisittain suurehko "
      )
    ),
    " (", tx(kam), " µg/m3)",
    sep=""
  )
  s5 <- paste(", kun koko maan keskiarvo oli ", tx(ka), " µg/m3 (Sotkanet, id=678)", sep="")
  s6 <- ". Päästölähteet ja asutus keskittyvät tyypillisesti samoille alueille. Koko maan keskiarvo ylittyi "
  s7 <- dat[dat$PM > ka & dat$Alue=="HE-maakunta",]
  s7 <- s7[order(-s7$PM),]#[1:min(4,nrow(s7)),]
  s7 <- paste(s7$Adessive, " (", tx(s7$PM)," µg/m3)",sep="")
  s7 <- paste(s7, c(rep(", ", length(s7)-2), " ja ", ""), sep="", collapse="")
  s7 <- paste(s7, " (Sotkanet, id=678). ", sep="")
  
  s8 <- paste(
    dat$Genetive[j],
    " kunnista korkeimmat pitoisuudet olivat ",
    sep=""
  )
  s9 <- dat[dat$Pid == i & dat$Alue=="Kunta", ]
  s9 <- s9[order(-s9$PM),][1:4,]
  s9 <- paste(s9$Adessive, " (", tx(s9$PM)," µg/m3)",sep="")
  s9 <- paste(s9, c(rep(", ", length(s9)-2), " ja ",""), sep="", collapse="")
  s9 <- paste(s9, " (Sotkanet, id=678). ", sep="")
  
  s10 <- "Valtakunnallisesti suurin pitoisuus oli "
  s11 <- dat[dat$Alue=="Kunta",]
  s11 <- s11[order(-s11$PM)[1],]
  s11 <- paste(s11$Adessive, " (", tx(s11$PM)," µg/m3).",sep="")
  
  s12 <- paste(" ", dat$Comment[j], " ")
  
  expofr <- dat$Pop[j]*dat$PM[j]/sum(dat$Pop[dat$Alue=="HE-maakunta"]*dat$PM[dat$Alue=="HE-maakunta"])
#  s13 <- dat$Daly[j]/sum(dat$Daly[dat$Alue=="HE-maakunta"])
  s13 <- paste(
    "\nSuomessa pienhiukkasten aiheuttamasta tautitaakasta ",
    cut(expofr, breaks=c(0,0.03,0.06,0.09,0.12,0.18,0.23,0.29,0.39,0.54,0.7,1),labels=c(
      "alle kolmaskymmenesosa",
      "kahdeskymmenesosa",
      "alle kymmenesosa",
      "noin kymmenesosa",
      "noin seitsemäsosa",
      "noin viidesosa",
      "noin neljäsosa",
      "noin kolmasosa",
      "noin puolet",
      "yli puolet",
      "suurin osa"
    )), " (", tx(expofr*100), " %) syntyy ", dat$Adessive[j],
    ", eli siellä menetetään noin ",
    tx(expofr*daly),
    " tervettä elinvuotta pienhiukkasten takia. ",
    sep="")
  hel <- (1:nrow(dat))[dat$Municipality=="Helsinki"]
  s14 <- paste(
    "Helsingissä tämä luku on noin ",
    tx(daly*dat$Pop[hel]*dat$PM[hel]/sum(dat$Pop[dat$Alue=="Kunta"]*dat$PM[dat$Alue=="Kunta"])),
    " eli merkittävä osa koko Suomen tautitaakasta (",
    tx(daly),
    " haittapainotettua elinvuotta). ",
    "Tautitaakka on arvioitu syyosuusmenetelmällä (http://en.opasnet.org/w/HIA). ",
    "Epävarmuudet ovat melko suuria ja liittyvät annosvasteen muotoon pienillä pitoisuuksilla, ",
    "kilpailevien syytekijöiden rooliin kokonaisuudessa sekä pienhiukkaspitoisuuden ",
    "arviointiin käytettyjen mallien epävarmuuksiin. Siitä ei kuitenkaan ",
    "ole epävarmuutta, etteivätkö pienhiukkasten haittavaikutukset Suomessa olisi merkittäviä ",
    "ja niiden vähentäminen tarpeellista.",
    sep=""
  )
  
  write(
    paste("\n\n",mk,"\n",s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14,sep=""),
    file="sotearviointi.txt",
    append=TRUE
  )
}

Katso myös

Ero sivun ”Ympäristöterveysindikaattori” versioiden välillä

Versio 8. heinäkuuta 2018 kello 20.56

Sisällys

Kysymys

Vastaus

Perustelut

Data

Työlista

Syykaaviot

Sisäilma kouluissa

Indikaattorien lataus Sotkanettiin

Sotearvioinnin koodi liittyen ympäristöterveyteen

Katso myös

Navigointivalikko