+ Näytä koodi- Piilota koodi
library(OpasnetBaseUtils)
library(xtable)
############ tidy4: a function that cleans the tables from Opasnet Base. Uses S4 class.
# data is a table from op_baseGetData function
tidy4 <- function (data) {
data$Result <- ifelse(!is.na(data$Result.Text), as.character(data$Result.Text), data$Result)
if("Observation" %in% colnames(data)){test <- data$Observation != "Description"} else {test <- TRUE}
if("Havainto" %in% colnames(data)){test <- data$Havainto != "kuvaus"}
data <- data[test, !colnames(data) %in% c("id", "obs", "Result.Text")]
if(sum(is.na(as.numeric(as.character(data$Result)))) == 0) {data$Result <- as.numeric(as.character(data$Result))}
return(data)
}
####Budjettilaskenta: suunnitelluista palkka- ja muista menoista lasketaan kokonaisbudjetti.
# Kehityskohteita: Otetaan vapaakenttärivejä, joiden määrä riippuu jostain vastinrivistä.
budjettilaskenta <- function(page, laitos = "THL", vuosi = "2012", rahoittaja = "Suomen Akatemia",
projekti = "Projekti", työpaketti = "Työpaketti", työpaketti.add = "Työpaketti", vuosi.add = "2012", laitos.add =
"THL", rahoittaja.add = "Suomen Akatamia", kustannuslaji.add = "Palkka VT7", määrä.add = 0, kuvaus.add = "") {
# Haetaan budjettidata ja lisätään siihen kaikki ne sarakkeet joita taulussa ei ole.
out <- op_baseGetData("opasnet_base", page)[, -c(1,2)]
if(!"Projekti" %in% colnames(out)) {out <- cbind(out, data.frame(Projekti = projekti))}
if(!"Työpaketti" %in% colnames(out)) {out <- cbind(out, data.frame(Työpaketti = työpaketti))}
if(!"Vuosi" %in% colnames(out)) {out <- cbind(out, data.frame(Vuosi = vuosi))}
if(!"Rahoittaja" %in% colnames(out)) {out <- cbind(out, data.frame(Rahoittaja = rahoittaja))}
if(!"Laitos" %in% colnames(out)) {out <- cbind(out, data.frame(Laitos = laitos))}
# Datan kuvaus lisätään jokaisen vuoden riville.
kuvaukset <- out[out$Vuosi == "kuvaus", !colnames(out) %in% c("Result", "Vuosi")]
colnames(kuvaukset)[colnames(kuvaukset) == "Result.Text"] <- "kuvaus"
out <- merge(out, kuvaukset)
# Turhat (tyhjät) sarakkeet ja rivit poistetaan.
out <- out[out$Vuosi != "kuvaus", !colnames(out) %in% c("Result.Text", "obs.1")]
# Sarakkeiden nimet siistitään ja määrä muutetaan faktorista numeroiksi.
colnames(out)[colnames(out) == "Result"] <- "määrä"
out$määrä <- as.numeric(as.character(out$määrä))
# Lisätään rivi, jossa on käyttöliittymän kautta annetut tilapäisen tapahtuman tiedot.
temp <- data.frame(Projekti = projekti, Työpaketti = työpaketti.add, Vuosi = vuosi.add, Laitos = laitos.add,
Rahoittaja = rahoittaja.add, Kustannuslaji = kustannuslaji.add, määrä = määrä.add, kuvaus = kuvaus.add)
out <- rbind(out, temp)
# Haetaan sivukulu- ja yleiskustannuskertoimet Opasnetistä, siistitään ja yhdistetään budjettiin.
kertoimet <- op_baseGetData("opasnet_base", "Op_fi2704")[, 3:8]
kertoimet <- reshape(kertoimet, v.names = "Result", idvar = "obs.1", timevar = "Kerroin", direction = "wide")
kertoimet <- kertoimet[, colnames(kertoimet) != "obs.1"]
colnames(kertoimet)[colnames(kertoimet)=="Result.Yleiskustannus"] <- "Yleiskustannus"
colnames(kertoimet)[colnames(kertoimet)=="Result.sivukulu"] <- "Sivukulu"
out <- merge(out, kertoimet, all.x = TRUE)
# Haetaan laitoksen vaativuusluokkien keskipalkat, siistitään ja yhdistetään budjettiin.
palkka <- op_baseGetData("opasnet_base", "Op_fi2705")[, 3:6]
colnames(palkka)[colnames(palkka)=="Result"] <- "kkpalkka"
colnames(palkka)[colnames(palkka)=="Vaativuusluokka"] <- "Kustannuslaji"
out <- merge(out, palkka, all.x=TRUE)
# Budjetissa on erikseen aktiviteetin määrä (määrä) ja yksikköhinta (kkpalkka).
# Yksikköhinta on kuukausipalkka palkoille ja euromääräisille aktiviteeteille 1.
out$kkpalkka <- ifelse(is.na(out$kkpalkka), 1, out$kkpalkka)
# Muutetaan aktiviteetit euromääräisiksi summiksi. Entinen määrä-sarake muutetaan henkilökuukausiksi.
out$summa <- out$määrä * out$kkpalkka
colnames(out)[colnames(out)=="määrä"] <- "htkk"
# Merkitään joka rivi joko tuloksi tai menoksi.
out$tulomeno <- ifelse(out$Kustannuslaji == "Tulot" | substr(paste(out$kuvaus, " "), 1,4) == "TULO", "Tulot", "Menot")
# Seuraavaksi etsitään sellaiset tulot, jotka automaattisesti skaalataan jonkin määrätyn menon suuruiseksi.
# Vertailukohtana toimiva meno tunnistetaan indeksien arvojen avulla.
# Kehityskohde: kaikkia indeksin arvoja ei tarvitse määritellä, vaan voi käyttää "villiä korttia".
# rahoitus sisältää tiedon siitä, mitä menoja rahoitetaan ja millä prosentilla (osuus 1 tarkoittaa 100%).
rahoitus <- out[substr(paste(out$kuvaus, " "), 1, 9) == "TULOVASTA", ]
rahoitus$osuus <- rahoitus$htkk
rahoitus <- (rahoitus[, c("Projekti", "Työpaketti", "Vuosi", "Laitos", "Kustannuslaji", "tulomeno", "osuus")])
rahoitus$tulomeno <- "Menot"
# temp yhdistää tiedon että rahoitetaan määriteltyihin menoihin. Sen jälkeen tämä summa nimetään tuloksi
# ja lisätään budjettitauluun ja siirrettään summa-sarakkeeseen.
temp <- merge(out, rahoitus)
temp$osuus <- temp$summa * temp$osuus
temp <- temp[, c("Laitos", "Vuosi", "Kustannuslaji", "Työpaketti", "Projekti", "tulomeno", "osuus")]
temp$tulomeno <- "Tulot"
out <- merge(out, temp, all.x = TRUE)
out$summa <- ifelse(is.na(out$osuus), out$summa, out$osuus)
# Lasketaan sivukulut ja yleiskustannukset ja merkitään joka rivi joko tuloksi tai menoksi.
test <- substr(paste(out$Kustannuslaji, " "), 1, 6) == "Palkka" # Onko palkkarivi?
out$htkk <- ifelse(test | substr(paste(out$kuvaus, " "), 1, 4) == "TULO", out$htkk, 0)
out$Sivukulu <- ifelse(test, out$Sivukulu * out$summa, 0)
out$Yleiskustannus <- ifelse(test, out$Yleiskustannus * (out$Sivukulu + out$summa), 0)
out$tulomeno <- ifelse(out$Kustannuslaji == "Tulot" | substr(paste(out$kuvaus, " "), 1,4) == "TULO", "Tulot", "Menot")
# Haetaan ALV-prosentit ja lasketaan ne relevanteille riveille.
alv <- tidy(op_baseGetData("opasnet_base", "Op_fi2913"))
print(alv)
#print(out[!test & out$tulomeno == "Menot", ])
alv <- merge(out[!test & out$tulomeno == "Menot", ], alv, all.x = TRUE)
#out$Result <- ifelse(out[!test & out$tulomeno == "Menot", ], out$Result, 0)
alv$summa <- alv$summa * alv$Result
alv$Kustannuslaji <- "ALV"
alv <- alv[colnames(out)]
print(alv)
# Lisätään omat rivit ALVille, sivukuluille ja yleiskustannuksille.
palkat <- out[substr(paste(out$Kustannuslaji, " "), 1, 6) == "Palkka", ]
palkat$Kustannuslaji <- "Yleiskustannus"
palkat$summa <- palkat$Yleiskustannus
out <- rbind(out, palkat)
palkat$Kustannuslaji <- "Sivukulu"
palkat$summa <- palkat$Sivukulu
out <- rbind(out, palkat)
out <- rbind(out, alv)
# Menot merkitään negatiivisiksi, jotta voidaan laskea tulot ja menot yhteen.
out$summa <- ifelse(out$tulomeno == "Tulot", out$summa, -out$summa)
# Nyt lisätään TULOLOPUT eli tieto siitä, mikä rahoittaja maksaa tietyn osuuden jäljelle jäävästä summasta.
# Summat lasketaan vuoden, työpaketin ja projektin yhdistelmille.
# Ensin tyhjennetään summasarake TULOLOPUT-riveiltä, koska siinä on osuus vaikka pitää olla 0.
out$summa <- ifelse(substr(paste(out$kuvaus, " "), 1,9) == "TULOLOPUT", 0, out$summa)
tarve <- as.data.frame(as.table(tapply(-out$summa, out[, c("Vuosi", "Työpaketti", "Projekti")], sum)))
tarve$Freq <- ifelse(tarve$Freq < 0, 0, tarve$Freq)
out <- merge(out, tarve)
# Rahoitusosuus on htkk-sarakkeessa ja tarvittava työpaketin tilanne (=tarve) Freq-sarakkeessa.
out$summa <- ifelse(substr(paste(out$kuvaus, " "), 1, 9) == "TULOLOPUT", out$htkk * out$Freq, out$summa)
out <- out[, c("Projekti", "Työpaketti", "Vuosi", "Laitos", "Rahoittaja", "Kustannuslaji", "tulomeno", "htkk", "summa", "kuvaus")]
return(out)
}
################### Budjettiyhteenveto laskee erilaisia summatauluja budjettilaskennan tuottamasta taulusta, jossa on jokainen tapahtuma eritelty.
budjettiyhteenveto <- function(budjettitaulu, jaottelu = c(1,2,3), param = "summa") {
out <- budjettitaulu
# Kaikki palkat muutetaan samanlaisiksi.
out$Kustannuslaji <- ifelse(substr(paste(out$Kustannuslaji, " "), 1, 6) == "Palkka", "Palkka", as.character(out$Kustannuslaji))
jaottelu <- c("tulomeno", c("Projekti", "Työpaketti", "Vuosi", "Laitos", "Rahoittaja", "Kustannuslaji")[jaottelu])
out <- as.data.frame(as.table(tapply(out[, param], out[, jaottelu], sum)))
# Tyhjät rivit poistetaan ja otsikoita parannetaan.
colnames(out)[colnames(out) == "Freq"] <- param
out <- out[!is.na(out[param]), ]
return(out)
}
############################# htkk
htkk <- function(budjettitaulu, jaottelu = c(1,2,3)) {
out <- budjettitaulu
out <- out[substr(paste(out$Kustannuslaji, " "), 1, 6) == "Palkka" & out$tulomeno == "Menot", ]
out <- budjettiyhteenveto(out, param = "htkk")
return(out)
}
out <- budjettilaskenta("Op_fi2912", rahoittaja = "STM", projekti = "Tekaisu", työpaketti = "TP1", työpaketti.add = työpaketti.add, rahoittaja.add = rahoittaja.add, kustannuslaji.add = kustannuslaji.add, määrä.add = määrä.add, kuvaus.add = kuvaus.add)
out <- out[out$Työpaketti %in% työpakettirajaus, ]
if(vuosirajaus != "Kaikki") {out <- out[out$Vuosi == vuosirajaus, ]}
print(xtable(out), type = 'html')
print(xtable(budjettiyhteenveto(out, jaottelu)), type='html', html.table.attributes="class='sortable'")
print(xtable(budjettiyhteenveto(out[out$tulomeno == "Tulot", ], jaottelu)), type='html', html.table.attributes="class='sortable'")
print(xtable(budjettiyhteenveto(out[out$tulomeno == "Menot", ], jaottelu)), type='html', html.table.attributes="class='sortable'")
print(xtable(htkk(out, jaottelu)), type = 'html', html.table.attributes="class='sortable'")
tulot <- budjettiyhteenveto(out, c(3,5))
tulot <- data.frame(Kustannuslaji = "", tulot[tulot$tulomeno == "Tulot", ])
menot <- budjettiyhteenveto(out, c(3, 6))
menot <- menot[menot$tulomeno == "Menot", ]
menot$Rahoittaja <- ""
out <- rbind(menot, tulot)
if(vuosirajaus == "Kaikki") {
out$id <- rep(1:(nrow(out)/3), each = 3)
out <- reshape(out, timevar = "Vuosi", varying = list(c("2012", "2013", "2014")), v.names = "Summa", idvar = "id", direction = "wide")
out <- out[, colnames(out) != "id"]
}
print(xtable(out), type='html', html.table.attributes="class='sortable'")
| |