OpasnetUtils/CheckInput: Difference between revisions

From Opasnet
Jump to navigation Jump to search
(Observation column names are now variable specific)
(→‎Code: new version)
Line 34: Line 34:
"Input"
"Input"
)
)
return(finalvar[!colnames(finalvar) %in% c("InpVarRes", "VarRes")])
finalvar@output <- finalvar@output[!colnames(finalvar) %in% c("InpVarRes", "VarRes")]
return(finalvar)
}
}
#variable@output[variable@output$Source,]
#variable@output[variable@output$Source,]
Line 53: Line 54:
colnames(temp)[colnames(temp) %in% "Result"] <- i
colnames(temp)[colnames(temp) %in% "Result"] <- i
}
}
return(
variable@output <- melt(
melt(
temp,  
temp,  
measure.vars = levels(variable@output[,paste(variable@name, "Source", sep = ":")]),  
measure.vars = levels(variable@output[,paste(variable@name, "Source", sep = ":")]),  
variable.name = paste(variable@name, "Source", sep = ":"),  
variable.name = paste(variable@name, "Source", sep = ":"),  
value.name = paste(variable@name, "Result", sep = ":"),  
value.name = paste(variable@name, "Result", sep = ":"),  
...
...
)
)
)
return(variable)
}
}
#cat("No input found for ", variable@name, ". Continuing...\n")
#cat("No input found for ", variable@name, ". Continuing...\n")
return(variable@output)
return(variable)
}
}
</rcode>
</rcode>

Revision as of 13:18, 26 June 2012

Description

Checks if an input variable (with the "Inp" -prefix) of the same name as the given argument (ovariable) exists. If input exists appends or substitutes it to the output and marks the source as "Input". Returns a data.frame.

Code

- Hide code

# CheckInput ################# checks and uses outside input (user inputs in models or decision variables)
# takes an ovariable as argument
# returns an ovariable

CheckInput <- function(variable, substitute = FALSE, ...) { # ... e.g for na.rm
	if (nrow(variable@output) == 0) stop(paste(variable@name, "output not evaluated yet!"))
	if (exists(paste("Inp", variable@name, sep = ""))) {
		inputvar <- get(paste("Inp", variable@name, sep = ""))
		if (substitute) {
			colnames(inputvar@output)[colnames(inputvar@output) == paste(inputvar@name, "Result", sep = ":")] <- "InpVarRes"
			colnames(variable@output)[colnames(variable@output) == paste(variable@name, "Result", sep = ":")] <- "VarRes"
			finalvar <- merge(variable, inputvar)
			finalvar@output[[paste(variable@name, "Result", sep = ":")]] <- ifelse(
				is.na(finalvar@output$InpVarRes), 
				finalvar@output$VarRes, 
				finalvar@output$InpVarRes
			)
			finalvar@output[[paste(variable@name, "Source", sep = ":")]] <- ifelse(
				is.na(finalvar@output$InpVarRes), 
				finalvar@output[[paste(variable@name, "Source", sep = ":")]], 
				"Input"
			)
			finalvar@output <- finalvar@output[!colnames(finalvar) %in% c("InpVarRes", "VarRes")]
			return(finalvar)
		}
		#variable@output[variable@output$Source,]
		j <- levels(variable@output[[paste(variable@name, "Source", sep = ":")]])
		temp <- variable@output[
			variable@output[,paste(variable@name, "Source", sep = ":")] == j[1], 
			!colnames(variable@output) %in% paste(variable@name, "Source", sep = ":")
		]
		colnames(temp)[colnames(temp) %in% "Result"] <- j[1]
		for (i in j[!j == j[1]]) {
			temp <- merge(
				temp, 
				variable@output[
					variable@output[,paste(variable@name, "Source", sep = ":")] == i, 
					!colnames(variable@output) %in% paste(variable@name, "Source", sep = ":")
				]
			)
			colnames(temp)[colnames(temp) %in% "Result"] <- i
		}
		variable@output <- melt(
			temp, 
			measure.vars = levels(variable@output[,paste(variable@name, "Source", sep = ":")]), 
			variable.name = paste(variable@name, "Source", sep = ":"), 
			value.name = paste(variable@name, "Result", sep = ":"), 
			...
		)
		return(variable)
	}
	#cat("No input found for ", variable@name, ". Continuing...\n")
	return(variable)
}

See also