OpasnetBaseUtils

This page is just a placeholder for code in op_en:OpasnetBaseUtils so that it can be used in Finnish Opasnet as well.
Rcode generic

Functions: dropall, PTable, opasnet.data, tidy, summary.bring
######################################
## dropall pudottaa data.framesta pois kaikki faktorien sellaiset levelit, joita ei käytetä.
## parametrit: x = data.frame 

dropall <- function(x){
    isFac <- NULL
    for (i in 1:dim(x)[2]){isFac[i] = is.factor(x[ , i])}

    for (i in 1:length(isFac)){
        x[, i] <- x[, i][ , drop = TRUE]
        }
    return(x)
    }
########################################

#########################################
## PTable muuntaa arvioinnin todennäköisyystaulun sopivaan muotoon arviointia varten.
## Parametrit: P = todennäköisyystaulu Opasnet-kannasta kaivettuna.
##             n = iteraatioiden lukumäärä Monte Carlossa
## Todennäköisyystaulun sarakkeiden on oltava: Muuttuja, Selite, Lokaatio, P
## Tuotteena on Monte Carloa varten tehty taulu, jonka sarakkeina ovat
## n (iteraatio) ja kaikki todennäköisyystaulussa olleet selitteet, joiden riveille on arvottu
## lokaatiot niiden todennäköisyyksien mukaisesti, jotka todennäköisyystaulussa oli annettu.

PTable <- function(P, n) {
Pt <- unique(P[,c("Muuttuja", "Selite")])
Pt <- data.frame(Muuttuja = rep(Pt$Muuttuja, n), Selite = rep(Pt$Selite, n), obs = rep(1:n, each = nrow(Pt)), P = runif(n*nrow(Pt), 0, 1))
for(i in 2:nrow(P)){P$Result[i] <- P$Result[i] + ifelse(P$Muuttuja[i] == P$Muuttuja[i-1] & P$Selite[i] == P$Selite[i-1], P$Result[i-1], 0)}
P <- merge(P, Pt)
P <- P[P$P <= P$Result, ]
Pt <- as.data.frame(as.table(tapply(P$Result, as.list(P[, c("Muuttuja", "Selite", "obs")]), min)))
colnames(Pt) <- c("Muuttuja", "Selite", "obs", "Result")
Pt <- Pt[!is.na(P$Result), ]
P <- merge(P, Pt)
P <- P[, !colnames(P) %in% c("Result", "P", "Muuttuja")]
P <- reshape(P, idvar = "obs", timevar = "Selite", v.names = "Lokaatio", direction = "wide")
colnames(P) <- ifelse(substr(colnames(P), 1, 9) == "Lokaatio.", substr(colnames(P), 10,30), colnames(P))
return(P)
}



############### Bring parts of summary table
#   data is the summary table.
summary.bring <- function(data){
	data <- data[, !colnames(data) %in% c("id", "obs")]
	pages <- levels(data$Page)

	## temp contains the additional information that is not on the actual data table.
	temp <- data[data$Observation != "Description", !colnames(data) %in% c("Result", "Observation")]
	temp <- reshape(temp, idvar = "Page", timevar = "Index", direction = "wide")
	colnames(temp) <- ifelse(substr(colnames(temp), 1, 12) == "Result.Text.", substr(colnames(temp), 13, 50), colnames(temp))

	## Get all data tables one at a time and combine them.
	for(i in 1:length(pages)){
		out <- op_baseGetData("opasnet_base", pages[i])
		out <- tidy(out)
	
		cols <- colnames(out)[!colnames(out) %in% c("Observation", "Result")]
		out <- reshape(out, timevar = "Observation", idvar = cols, direction = "wide")
		colnames(out) <- ifelse(substr(colnames(out), 1, 7) == "Result.", substr(colnames(out), 8, 50), colnames(out))

		nam <- colnames(temp)[colnames(temp) != "Page"][1] # nam is needed in the case that the next line drops the colname
		out <- merge(temp[temp$Page == pages[i], colnames(temp) != "Page"], out)
		colnames(out)[colnames(out) == "x"] <- nam

		## Check that all data tables have all the same columns before you combine them with rbind.
		if(i == 1){out2 <- out} else {
			addcol <- colnames(out2)[!colnames(out2) %in% colnames(out)]
			if(length(addcol) > 0) {
				temp <- as.data.frame(array("*", dim = c(1,length(addcol))))
				colnames(temp) <- addcol
				out <- merge(out, temp)}
			addcol <- colnames(out)[!colnames(out) %in% colnames(out2)]
			if(length(addcol) > 0) {
				temp <- as.data.frame(array("*", dim = c(1,length(addcol))))
				colnames(temp) <- addcol
				out2 <- merge(out2, temp)}

			## Combine data tables.
			out2 <- rbind(out2, out)}
		}
		return(out2)
	}
##########
OpasnetBaseUtils

Rcode generic

Navigointivalikko
