R-ohjelmointi.org

Tilastotieteellistä ohjelmointia R-kielellä

Kellojen siirtelyn lopettaminen: pysyvä kesäaika vai talviaika?

Euroopan Unionissa ja siten myös Suomessa keskustellaan kellojen siirtämisen lopettamisesta. Suomessa suurin osa vuodesta käytetään kesäaikaa (UTC +3) ja osa vuodesta talviaikaa (UTC +2) eli normaaliaikaa. Tällä hetkellä on auki Liikenneviraston kysely, jossa kansalaiset voivat antaa mielipiteensä siitä, pitäisikö Suomessa jatkossa siirtyä pysyvään kesä- vai talviaikaan, pitäytyä nykyisessä järjestelyssä vai kenties valita jokin muu aikavyöhyke kuin nykyinen. THL on pohtinut asiaa terveyden kannalta ja Liikenneturva on selvittänyt asiaa liikenneturvallisuuden kannalta.

Liikenneviraston kyselyn tausta-aineistossa on tarkempia tietoja kesä- ja talviajan vaikutuksesta valoisan ajan sijoittumiseen eri paikkakunnilla. Katsotaanpa hieman tarkemmin, miltä tilanne näyttää Helsingissä (iski laiskuus, ja jaksoin piirrellä vain Helsingin tuloksen).

Seuraavassa kuvassa on esitetty auringon lasku- ja nousuajankohdat Helsingissä kesä- ja talviajan perusteella sekä nykyinen järjestely. Esimerkiksi tammikuun alussa aurinko nousee 09:30 ja laskee 15:30 nykyjärjestelmässä. Pysyvässä talviajassa aurinko nousisi 09:30 ja laskisi 15:30. Vastaavasti pysyvässä kesäajassa aurinko nousisi 10:30 ja laskisi 16:30.

Aurinko ei kuitenkaan useimmiten singahda horisontin yläpuolelle yhtäkkiä, vaan auringon nousua edeltää aamuhämärä. Illalla auringon laskun jälkeen alkaa iltahämärä. Seuraavassa kuvassa on mustalla kuvattu aika, jolloin on yö, harmaalla hämärä ja vaalealla valoisan aika. Kunkin kuun ensimmäisen päivän tilanne on valittu esitettäväksi kaaviossa.

Kuvat olisi voinut piirtää siten, että akselistot olisivat olleet samat, mutta jäi nyt tältä haavaa sekin tekemättä. Kuvat on tuotettu seuraavalla koodilla, jossa auringon nousu- ja laskuajat on arvioitu paketilla suncalc. Niiden muokkaaminen toimimaan Liikenneviraston kyselyä vastaavilla paikkakunnilla eli Oulun tai Utsjoen korkeudella on tarvittaessa melko suoraviivaista.

library(suncalc)
 
d <- data.frame(date = seq.Date(as.Date("2019-01-01"), as.Date("2019-12-31"), by = "day"),
                lat = 60.190478, lon = 24.938137, place="Helsinki")
hki.eet <- getSunlightTimes(data=d, tz="EET")     # UTC+2 (talviaika)
 
talviaika <- hki.eet
talviaika$sunrise[90:299] <- talviaika$sunrise[90:299]-3600
talviaika$sunset[90:299] <- talviaika$sunset[90:299]-3600
talviaika$dusk[90:299] <- talviaika$dusk[90:299]-3600
talviaika$dawn[90:299] <- talviaika$dawn[90:299]-3600
 
kesäaika <- hki.eet
kesäaika$sunrise[1:89] <- kesäaika$sunrise[1:89]+3600
kesäaika$sunrise[300:365] <- kesäaika$sunrise[300:365]+3600
kesäaika$sunset[1:89] <- kesäaika$sunset[1:89]+3600
kesäaika$sunset[300:365] <- kesäaika$sunset[300:365]+3600
kesäaika$dusk[1:89] <- kesäaika$dusk[1:89]+3600
kesäaika$dusk[300:365] <- kesäaika$dusk[300:365]+3600
kesäaika$dawn[1:89] <- kesäaika$dawn[1:89]+3600
kesäaika$dawn[300:365] <- kesäaika$dawn[300:365]+3600
 
par(mar=c(5,8,3,1))
plot(0, 0, col=0, xlim=c(0,24), ylim=c(0,366), las=1, xlab="Kellonaika", ylab="", axes=F)
mtext(side=2, text="Kuukausi", las=3, line=6)
axis(side=1, at=0:24, labels=0:24, las=1)
mtext(side=2, at=cumsum(c(31,28,31,30,31,30,31,31,30,31,30,31))-15, text=unique(months(hki.eet$sunrise)), las=1, line=1)
abline(v=0:24, col="grey75")
abline(h=cumsum(c(0,31,28,31,30,31,30,31,31,30,31,30,31)), col="grey75")
lines(x=as.numeric(substr(talviaika$sunrise, 12, 13)) + as.numeric(substr(talviaika$sunrise, 15, 16))/60 + as.numeric(substr(talviaika$sunrise, 18, 19))/60/60, y=1:365, col="blue", lwd=5)
lines(x=as.numeric(substr(kesäaika$sunrise, 12, 13)) + as.numeric(substr(kesäaika$sunrise, 15, 16))/60 + as.numeric(substr(kesäaika$sunrise, 18, 19))/60/60, y=1:365, col="green", lwd=5)
lines(x=as.numeric(substr(talviaika$sunset, 12, 13)) + as.numeric(substr(talviaika$sunset, 15, 16))/60 + as.numeric(substr(talviaika$sunset, 18, 19))/60/60, y=1:365, col="blue", lwd=5)
lines(x=as.numeric(substr(kesäaika$sunset, 12, 13)) + as.numeric(substr(kesäaika$sunset, 15, 16))/60 + as.numeric(substr(kesäaika$sunset, 18, 19))/60/60, y=1:365, col="green", lwd=5)
lines(x=as.numeric(substr(hki.eet$sunrise, 12, 13)) + as.numeric(substr(hki.eet$sunrise, 15, 16))/60 + as.numeric(substr(hki.eet$sunrise, 18, 19))/60/60, y=1:365, lwd=3, col="black")
lines(x=as.numeric(substr(hki.eet$sunset, 12, 13)) + as.numeric(substr(hki.eet$sunset, 15, 16))/60 + as.numeric(substr(hki.eet$sunset, 18, 19))/60/60, y=1:365, lwd=3, col="black")
title(main="Helsinki")
legend(x="topright", col=c("blue", "green", "black"), lty=1, lwd=3, legend=c("talviaika", "kesäaika", "nykyinen"), ncol=1, bg="grey75", box.col="grey75")
box()
 
tmp.hki.t <- talviaika[substr(talviaika$date, 9,10) == "01",c("place", "date", "sunrise", "sunset", "dusk", "dawn")]
tmp.hki.k <- kesäaika[substr(kesäaika$date, 9,10) == "01",c("place", "date", "sunrise", "sunset", "dusk", "dawn")]
tmp.hki.t$sunrise <- as.numeric(substr(tmp.hki.t$sunrise, 12, 13)) + as.numeric(substr(tmp.hki.t$sunrise, 15, 16))/60 + as.numeric(substr(tmp.hki.t$sunrise, 18, 19))/60/60
tmp.hki.t$sunset <- as.numeric(substr(tmp.hki.t$sunset, 12, 13)) + as.numeric(substr(tmp.hki.t$sunset, 15, 16))/60 + as.numeric(substr(tmp.hki.t$sunset, 18, 19))/60/60
tmp.hki.k$sunrise <- as.numeric(substr(tmp.hki.k$sunrise, 12, 13)) + as.numeric(substr(tmp.hki.k$sunrise, 15, 16))/60 + as.numeric(substr(tmp.hki.k$sunrise, 18, 19))/60/60
tmp.hki.k$sunset  <- as.numeric(substr(tmp.hki.k$sunset, 12, 13)) + as.numeric(substr(tmp.hki.k$sunset, 15, 16))/60 + as.numeric(substr(tmp.hki.k$sunset, 18, 19))/60/60
 
tmp.hki.k$dusk <- as.numeric(substr(tmp.hki.k$dusk, 12, 13)) + as.numeric(substr(tmp.hki.k$dusk, 15, 16))/60 + as.numeric(substr(tmp.hki.k$dusk, 18, 19))/60/60
tmp.hki.k$dawn  <- as.numeric(substr(tmp.hki.k$dawn, 12, 13)) + as.numeric(substr(tmp.hki.k$dawn, 15, 16))/60 + as.numeric(substr(tmp.hki.k$dawn, 18, 19))/60/60
tmp.hki.t$dusk <- as.numeric(substr(tmp.hki.t$dusk, 12, 13)) + as.numeric(substr(tmp.hki.t$dusk, 15, 16))/60 + as.numeric(substr(tmp.hki.t$dusk, 18, 19))/60/60
tmp.hki.t$dawn <- as.numeric(substr(tmp.hki.t$dawn, 12, 13)) + as.numeric(substr(tmp.hki.t$dawn, 15, 16))/60 + as.numeric(substr(tmp.hki.t$dawn, 18, 19))/60/60
 
 
par(mfrow=c(1,2))
 
tmp <- cbind(0, tmp.hki.t[,c(6,3,4,5)], 24)
tmp <- 
data.frame(tmp[,1],
           tmp[,2],
           tmp[,3]-tmp[,2],
           tmp[,4]-tmp[,3],
           tmp[,5]-tmp[,4],
           tmp[,6]-tmp[,5])
par(mar=c(5,3,3,1))
#b <- barplot(t(as.matrix(tmp))[-1,], col=c("black", "grey75", "grey95", "grey75", "black"), beside=F, border=c("black", "grey75", "grey95", "grey75", "black"), axes=F, names.arg=months(as.Date(tmp.hki.t$date)), cex.names=1)
b <- barplot(t(as.matrix(tmp))[-1,], col=c("black", "grey75", "grey95", "grey75", "black"), beside=F, border=c("black", "grey75", "grey95", "grey75", "black"), axes=F)
abline(h=1:23, col="white")
mtext(side=1, at=b, text=months(as.Date(tmp.hki.t$date)), las=3)
axis(side=2, at=0:24, labels=0:24, las=1)
title(main="Talviaika")
 
tmp <- cbind(0, tmp.hki.k[,c(6,3,4,5)], 24)
tmp <- cbind(0, tmp.hki.k[,c(6,3,4,5)], 24)
tmp <- 
data.frame(tmp[,1],
           tmp[,2],
           tmp[,3]-tmp[,2],
           tmp[,4]-tmp[,3],
           tmp[,5]-tmp[,4],
           tmp[,6]-tmp[,5])
#tmp[7,5] <- 0
par(mar=c(5,3,3,1))
#b <- barplot(t(as.matrix(tmp))[-1,], col=c("black", "grey75", "grey95", "grey75", "black"), beside=F, border=c("black", "grey75", "grey95", "grey75", "black"), axes=F, names.arg=months(as.Date(tmp.hki.t$date)), cex.names=1)
b <- barplot(t(as.matrix(tmp))[-1,], col=c("black", "grey75", "grey95", "grey75", "black"), beside=F, border=c("black", "grey75", "grey95", "grey75", "black"), axes=F)
abline(h=1:23, col="white")
mtext(side=1, at=b, text=months(as.Date(tmp.hki.t$date)), las=3)
axis(side=2, at=0:24, labels=0:24, las=1)
title(main="Kesäaika")


Category