Projektinhallinta/hiekkalaatikko

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'")
Projektinhallinta/hiekkalaatikko

R-koodi

Navigointivalikko
