Projektinhallinta/hiekkalaatikko
Opasnet Suomista
Siirry navigaatioon
Siirry hakuun
R-koodi
library(OpasnetBaseUtils) library(xtable) ###################################################################33 ####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 = "", series_id = NULL) { # Haetaan budjettidata ja lisätään siihen kaikki ne sarakkeet joita taulussa ei ole. out <- op_baseGetData("opasnet_base", page, series_id = series_id)[, -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 ALV-prosentit ja lasketaan ne relevanteille riveille. alv <- tidy(op_baseGetData("opasnet_base", "Op_fi2913")) alv <- merge(out, alv) # ALV laitetaan joka riville, joille se on määritelty. alv$määrä <- alv$määrä * alv$Result alv$Kustannuslaji <- "ALV" alv <- alv[colnames(out)] # Haetaan Projektisopimus eli sopimuskohtaiset tiedot ja sovelletaan niitä yleiskustannuksen ja ALV:n laskemiseen. sopimus <- tidy(op_baseGetData("opasnet_base", "Op_fi2916")) sopimus <- sopimus[sopimus$Projekti == projekti, ] print(sopimus) # Jos on erillislaskutus, ALV lisätään rahoittajan osuuteen. Jos ei, lisätään if(sopimus[sopimus$Havainto == "ALV-laskutus", "Result"] != "Erillislaskutus") {alv$Rahoittaja <- laitos} # Tästä jää nyt erottelematta se, maksaako laitos ALVit budjetti- vai projektirahoista. out <- rbind(out, alv) # 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, 5) == "Palkk" # 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") # Lisätään omat rivit sivukuluille ja yleiskustannuksille, yhteisnimellä epäsuorat. epäsuorat <- if(sopimus[sopimus$Havainto == "YK-peruste", "Result"] == "Kaikki") {out[out$tulomeno == "Menot", ]} else {out[substr(paste(out$Kustannuslaji, " "), 1, 5) == "Palkk", ]} epäsuorat$Kustannuslaji <- "Yleiskustannus" epäsuorat$summa <- epäsuorat$Yleiskustannus out <- rbind(out, epäsuorat) epäsuorat$Kustannuslaji <- "Sivukulu" epäsuorat$summa <- epäsuorat$Sivukulu out <- rbind(out, epäsuorat) # 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 # parametrit: budjettitaulu: budjettilaskenta-funktion tuottama data.frame. # jaottelu: ne selitteet, jotka eritellään (Projekti, Työpaketti, Vuosi, Laitos, Rahoittaja, Kustannuslaji) 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) } ###########################################################################################3 ############ 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) } out <- budjettilaskenta("Op_fi2682", 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'") |
{{#opasnet_base_link:Op_fi2912}}
Noudettu kohteesta ”https://fi.opasnet.org/index.php?title=Projektinhallinta/hiekkalaatikko&oldid=11674”