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

+ Näytä koodi- Piilota koodi ###################################### ## 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) } ###################################### ## opasnet.data downloads a file from Finnish Opasnet wiki, English Opasnet wiki, or Opasnet File. ## Parameters: filename is the URL without the first part (see below), wiki is "opasnet_en", "opasnet_fi", or "M-files". ## If table is TRUE then a table file for read.table function is assumed; all other parameters are for this read.table function. opasnet.data <- function(filename, wiki = "opasnet_en", table = FALSE, ...) { if (wiki == "opasnet_en") { file <- paste("http://en.opasnet.org/en-opwiki/images/", filename, sep = "") } if (wiki == "opasnet_fi") { file <- paste("http://fi.opasnet.org/fi_wiki/images/", filename, sep = "") } if (wiki == "M-files") { file <- paste("http://http://fi.opasnet.org/fi_wiki/extensions/mfiles/", filename, sep = "") } #if(table == TRUE) { #file <- re#ad.table(file, header = FALSE, sep = "", quote = "\"'", # dec = ".", row.names, col.names, # as.is = !stringsAsFactors, # na.strings = "NA", colClasses = NA, nrows = -1, # skip = 0, check.names = TRUE, fill = !blank.lines.skip, # strip.white = FALSE, blank.lines.skip = TRUE, # comment.char = "#", # allowEscapes = FALSE, flush = FALSE, # stringsAsFactors = default.stringsAsFactors(), # fileEncoding = "", encoding = "unknown") #return(file) #} #else {return(ge#tURL(file))} } ############ tidy: a function that cleans the tables from Opasnet Base # data is a table from op_baseGetData function tidy <- 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")] return(data) } ############### 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) } ##########

⇤--#: . Opasnet.data() does not work. Problems: 1) it seems to be unable to download files from M-files; 2) the read.table part does not work (error: line 2 did not have 7 elements (there were 29 columns!)), 3) error: could not find function getURL (this is maybe a problem with my own computer, as getURL has worked correctly in R-tools.) --Jouni 23:54, 28 December 2011 (EET) (type: truth; paradigms: science: attack)