Difference between revisions of "OpasnetUtils/Drafts"

library(OpasnetUtils)

ograph <- function( # Määritellään yleisfunktio peruskuvaajan piirtämiseen.
	ovariable, 
	x, 
	y = character(), 
	type = character(), 
	other = character(),
	fill = NA, 
	...
) {
	if(class(ovariable) == "ovariable")  {
		if(nrow(ovariable@output) == 0) ovariable <- EvalOutput(ovariable)
		data <- ovariable@output
		title <- ovariable@name
		if(length(y) == 0) y <- paste(title, "Result", sep = "")
	} else {
		data <- ovariable
		title <- character()
		if(length(y) == 0) y <- "Result"
	}
	if(length(type) == 0) {
		if("Iter" %in% colnames(data)) type <- geom_boxplot() else type <- geom_bar(stat = "identity")
	}
	out <- ggplot(data, aes_string(x = x, y = y, fill = fill)) # Määritellään kuvan sarakkeet
	out <- out + type
	out <- out + theme_grey(base_size=24) # Fontin kokoa suurennetaan
	out <- out + labs(
			title	= title,
			y = paste(unique(data[[paste(title, "Yksikkö", sep = "")]]), sep = "", collapse = ", ")
		)
	out <- out + theme(axis.text.x = element_text(angle = 90, hjust = 1)) # X-akselin tekstit käännetään niin että mahtuvat
	if(length(other) != 0) out <- out + other
	return(out)
}

# fillna takes a data.frame and fills the cells with NA with each level in that column.
# object is the data.frame, marginals is a vector of columns (either column names or positions) that are to be filled.
# This version of fillna accepts column positions (as the previous version) and also column names in marginals.

fillna <- function (object, marginals) {
	a <- dropall(object)
	if(!is.numeric(marginals)) marginals <- match(marginals, colnames(object))
	for (i in marginals) {
		a[[i]] <- as.factor(a[[i]])
		a1 <- a[!is.na(a[[i]]), ]
		a2 <- a[is.na(a[[i]]), ][-i]
		addition <- data.frame(A = levels(a[[i]]))
		colnames(addition) <- colnames(a)[i]
		a2 <- merge(addition, a2)
		a <- rbind(a1, a2)
	}
	return(a)
}

## collapsemarg is a placeholder for a better functionality within CollapseMarginals.
## It takes an ovariable, and summarises all indices in cols using tapply and a user-defined function.
## However, you can also use function "pick" to select locations defined in a list picks found in indices cols.
## Function "unkeep" simply drops the unkept indices without any other operation.
## The output is an ovariable with the same name as the input.
## This was first created for [[:op_fi:Radonin terveysvaikutukset]]

collapsemarg <- function(variable, cols, fun = "sum", picks = list(), ...) { # cols is a character vector, while probs is a list
	out <- dropall(variable@output)
	marginals <- colnames(out)[variable@marginal]

	if(tolower(fun) == "unkeep") { # The function must be a string, otherwise this row will fail.
		out <- out[!colnames(out) %in% cols]
	} else {
		if(tolower(fun) == "pick") {
			for(i in cols) {
				out <- out[out[[i]] %in% picks[[match(i, cols)]] , ]
			}
		} else {
			margtemp <- colnames(out)[colnames(out) %in% marginals & !colnames(out) %in% cols] 
			# You must leave at least one index.

			out <- as.data.frame(as.table(tapply(result(variable), out[margtemp], fun)))
			out <- out[!is.na(out$Freq) , ]

			colnames(out)[colnames(out) == "Freq"] <- ifelse(
				length(variable@name) == 0, 
				"Result", 
				paste(variable@name, "Result", sep = "")
			)
		}
	}

	variable@output <- out
	variable@marginal <- colnames(out) %in% marginals & ! colnames(out) %in% cols
	
	return(variable)
}

objects.store(ograph, fillna, collapsemarg)

cat("The following objects are stored: ograph, fillna, collapsemarg.\n")