Difference between revisions of "Sandbox"
From Testiwiki
(Wikipedia donation button added) |
(→R-tools code include example) |
||
Line 19: | Line 19: | ||
<rcode include="page:R-tools|name:xample" variables="name:a|type:hidden|default:'aaa'| name:b|type:hidden|default:'bee'| name:c|type:hidden|default:'cee'| name:d|type:hidden|default:'dee'"> | <rcode include="page:R-tools|name:xample" variables="name:a|type:hidden|default:'aaa'| name:b|type:hidden|default:'bee'| name:c|type:hidden|default:'cee'| name:d|type:hidden|default:'dee'"> | ||
cat("Above should be included code\n") | cat("Above should be included code\n") | ||
+ | </rcode> | ||
+ | |||
+ | <rcode | ||
+ | graphics="1" | ||
+ | include="page:Sandbox|name:generic" | ||
+ | variables="name:ala|default:900000|description:Jatropan viljelyala (ha)| | ||
+ | name:n|default:10| | ||
+ | name:divisions|description:Mitkä tekijät halua eritellä tuloksessa?|type:checkbox|options:'Katalyytin määrä';Katalyytin määrä;'Ikä';Ikä;'Kastelu';Kastelu;'Käytetty puristin';Käytetty puristin|default:'Kastelu'| | ||
+ | name:divisions2|description:Minkä yhden tekijän halua eritellä kuvaajassa?|type:selection|options:'Katalyytin määrä';Katalyytin määrä;'Ikä';Ikä;'Kastelu';Kastelu;'Käytetty puristin';Käytetty puristin|default:'Kastelu' | ||
+ | "> | ||
+ | library(OpasnetBaseUtils) | ||
+ | library(ggplot2) | ||
+ | library(xtable) | ||
+ | |||
+ | saanto.siemenet <- op_baseGetData("opasnet_base", "Op_fi2633")[,-c(1,2,7)] # Jatropan siementen saanto viljelystä | ||
+ | saanto.öljy <- op_baseGetData("opasnet_base", "Op_fi2634")[,-c(1,2,5)] # Öljyn saanto jatropan siemenistä | ||
+ | saanto.diesel <- op_baseGetData("opasnet_base", "Op_fi2632")[,-c(1,2,5)] # Biodieselin saanto jatropaöljystä | ||
+ | viljelyala <- op_baseGetData("opasnet_base", "Op_fi2642")[,-c(1,2)] # Jatropan viljelyalueet | ||
+ | päästö.ilmasto <- op_baseGetData("opasnet_base", "Op_fi2547")[,-c(1,2)] # Jatropan viljelyn ilmastovaikutukset | ||
+ | päästö.sosiaali <- op_baseGetData("opasnet_base", "Op_fi2552")[,-c(1,2)] # Jatropan viljelyn sosiaaliset vaikutukset | ||
+ | päästö.ekosyst <- op_baseGetData("opasnet_base", "Op_fi2548")[,-c(1,2)] # Jatropan viljelyn ekosysteemivaikutukset | ||
+ | P <- op_baseGetData("opasnet_base", "Op_fi2539")[,-c(1,2,7)] # Jatropan käyttö bioenergian lähteenä | ||
+ | |||
+ | colnames(saanto.siemenet)[4] <- "siemenet" | ||
+ | colnames(saanto.öljy)[2] <- "öljy" | ||
+ | colnames(saanto.diesel)[2] <- "diesel" | ||
+ | saanto <- merge(saanto.siemenet, saanto.öljy) | ||
+ | saanto <- merge(saanto, saanto.diesel) | ||
+ | saanto[,9] <- saanto$siemenet * saanto$öljy * saanto$diesel * ala | ||
+ | colnames(saanto)[9] <- "saanto (kg/a)" | ||
+ | |||
+ | P <- PTable(P, n) | ||
+ | saanto <- merge(P, saanto) | ||
+ | |||
+ | if(length(divisions)>1) divisions <- as.list(saanto[, divisions]) else divisions <- saanto[, divisions] | ||
+ | out1 <- as.data.frame(as.table(tapply(saanto[, 10], divisions, mean))) | ||
+ | out1 <- dropall(out1[!is.na(out1$Freq), ]) | ||
+ | |||
+ | print(xtable(out1), type = 'html') | ||
+ | |||
+ | out2 <- as.data.frame(as.table(tapply(saanto[, 10], list(saanto[, divisions2], saanto$obs), mean))) | ||
+ | out2 <- dropall(out2[!is.na(out2$Freq), ]) | ||
+ | out2[1:10, ] | ||
+ | ggplot(out2, aes(x = Freq, weight = 1, fill = Var1)) +geom_density() | ||
+ | ## Jostain syystä vain osa kuvista piirtyy oikein, riippuen mitä parametreja valitaan. En ymmärrä syytä. | ||
+ | </rcode> | ||
+ | |||
+ | <rcode name="generic"> | ||
+ | ###################################### | ||
+ | ## 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) | ||
+ | } | ||
+ | ###################################### | ||
+ | |||
</rcode> | </rcode> |
Revision as of 10:14, 11 December 2011
<a href="http://wikimediafoundation.org/wiki/Support_Wikipedia/en"><img border="0" alt="Support Wikipedia" src="//upload.wikimedia.org/wikipedia/commons/4/4b/Fundraising_2009-square-treasure-en.png" /></a>
Failed to parse (Missing <code>texvc</code> executable. Please see math/README to configure.): \alpha 444 + 9999 / 123
Hello
- this works
Bluebox
- works
- ok