|
|
Line 11: |
Line 11: |
|
| |
|
| ==Code== | | ==Code== |
| {{comment|# |Tidy should widen the "Parameter" index as well as "Observation". Also it should enable marginal recognition of the widened variables.|--[[User:Teemu R|Teemu R]] 15:57, 18 June 2012 (EEST)}}
| | |
| :{{comment|# |Recognition could be achieved by adding a "variable name" -prefix to every location under the involved indices.|--[[User:Teemu R|Teemu R]] 15:57, 18 June 2012 (EEST)}} | | https://www.opasnet.org/svn/opasnet_utils/trunk/R/Tidy.r |
| <rcode
| |
| name="Tidy"
| |
| label="Initiate functions"
| |
| graphics="1"
| |
| showcode="1"
| |
| >
| |
| # TIDY ########### tidy: a function that cleans the tables from Opasnet Base
| |
| # data is a table from op_baseGetData function
| |
| tidy <- function (data, objname = "", idvar = "obs", direction = "wide") {
| |
| data$Result <- ifelse(!is.na(data$Result.Text), data$Result, as.character(data$Result.Text))
| |
| #data <- data[
| |
| # ifelse("Observation" %in% colnames(data),
| |
| # data$Observation != "Description",
| |
| # TRUE
| |
| # ),
| |
| # !colnames(data) %in% c("id", "Result.Text")
| |
| #]
| |
| data <- data[, !colnames(data) %in% c("id", "Result.Text")]
| |
| if("obs.1" %in% colnames(data)) { # this line is temporarily needed until the obs.1 bug is fixed.
| |
| data[, "obs"] <- data[, "obs.1"]
| |
| data <- data[, colnames(data) != "obs.1"]
| |
| }
| |
| if("Row" %in% colnames(data)) { # If user has given Row, it is used instead of automatic obs.
| |
| data <- data[, colnames(data) != "obs"]
| |
| colnames(data)[colnames(data) == "Row"] <- "obs"
| |
| }
| |
| if (objname != "") objname <- paste(objname, ":", sep = "")
| |
| if (direction == "wide") {
| |
| if("Observation" %in% colnames(data)) {
| |
| cols <- levels(data$Observation)
| |
| data <- reshape(data, idvar = idvar, timevar = "Observation", v.names = "Result", direction = "wide")
| |
| data <- data[colnames(data) != "obs"]
| |
| colnames(data) <- gsub("^Result.", objname, colnames(data))
| |
| for (i in paste(objname, cols, sep = "")) {
| |
| a <- suppressWarnings(as.numeric(data[, i]))
| |
| if (sum(is.na(a)) == 0) data[, i] <- a else data[, i] <- factor(data[, i])
| |
| }
| |
| colnames(data)[grepl(paste("^", objname, "result", sep = ""), colnames(data))] <- paste(objname, "Result", sep = "")
| |
| colnames(data)[grepl(paste("^", objname, "Amount", sep = ""), colnames(data))] <- paste(objname, "Result", sep = "")
| |
| return(data)
| |
| }
| |
| if("Parameter" %in% colnames(data)) {
| |
| cols <- levels(data$Parameter)
| |
| data <- reshape(data, idvar = idvar, timevar = "Parameter", v.names = "Result", direction = "wide")
| |
| data <- data[colnames(data) != "obs"]
| |
| colnames(data) <- gsub("^Result.", objname, colnames(data))
| |
| for (i in paste(objname, cols, sep = "")) {
| |
| a <- suppressWarnings(as.numeric(data[, i]))
| |
| if (sum(is.na(a)) == 0) data[, i] <- a else data[, i] <- factor(data[, i])
| |
| }
| |
| colnames(data)[grepl(paste("^", objname, "result", sep = ""), colnames(data))] <- paste(objname, "Result", sep = "")
| |
| colnames(data)[grepl(paste("^", objname, "Amount", sep = ""), colnames(data))] <- paste(objname, "Result", sep = "")
| |
| return(data)
| |
| }
| |
| }
| |
| data <- data[,colnames(data) != "obs"]
| |
| colnames(data)[colnames(data)=="Result"] <- paste(objname, "Result", sep = "")
| |
| return(data)
| |
| }
| |
| </rcode>
| |
|
| |
|
| ==See also== | | ==See also== |