JNCC/MESO
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Updates to downloads and colour graphics

Browse Source
This commit is contained in:
Steve Pegg
2019-04-10 10:57:37 +01:00
parent b2e7a363cb
commit 9b039297a0
2 changed files with 311 additions and 220 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
Parses.R
View File

@@ -14,7 +14,7 @@ FIRST_NODE_COL <- 3
mappings <- c('TestScenario', 'Map_P_BA', 'Map_BA_OP', 'Map_OP_ES')
nodeTypes <- c('Input.Nodes', 'Internal.Nodes', 'Published.Nodes')
states <- c('impact', 'confidence', 'growth', 'recovery')
states <- c('impact', 'confidence', 'growth', 'recovery', 'layer')
refs <-c(1:length(mappings))
setEmpties <- function(val) {
@@ -46,9 +46,9 @@ buildExpr <- function(pressStatus) {
parseScenario <- function(press, prefix = 'p') {
pressNames <- colnames(press)[2:length(colnames(press))]
coefs <- matrix(data=NA, nrow=length(pressNames), ncol=2, dimnames=list(NULL, c('growth', 'confidence')))
coefs <- matrix(data=NA, nrow=length(pressNames), ncol=3, dimnames=list(NULL, c('growth', 'confidence', 'layer')))
for (col in 2:ncol(press)) {
coefs[col-1,] <- as.numeric(split(press[1, col]))[match(c('growth', 'confidence'), states)]
coefs[col-1,] <- as.numeric(split(press[1, col]))[match(c('growth', 'confidence', 'layer'), states)]
}
press[is.na(press)] <- 0
if (sum(duplicated(pressNames))>0) {
@@ -62,6 +62,7 @@ parseScenario <- function(press, prefix = 'p') {
code=paste0(prefix, seq(1:length(pressNames))),
growth = coefs[,'growth'],
confidence=coefs[,'confidence'],
layer=coefs[,'layer'],
stringsAsFactors = FALSE),
edges=data.frame(input=NULL, output=NULL, impact=NULL)
))
@@ -127,7 +128,7 @@ buildGraph <- function(model, desc) {
edges <- paste0(edges, paste0("[", outNodes[idx], "|", substr(inputsStr, start=1, stop=(nchar(inputsStr)-1)), "]"))
#Make the coefficient of the distribution
coefVal <- setNames(c(model$nodes$growth[nodeRef], model$edges$impact[rows]),
coefVal <- setNames(c(model$nodes$growth[nodeRef], model$edges$values[rows]),
c("(Intercept)", model$edges$input[rows])
)
#str(coefVal)
@@ -136,8 +137,9 @@ buildGraph <- function(model, desc) {
}
print('about to build network')
print(paste0(inputText, edges))
net <- model2network(paste0(inputText, edges))
net <- model2network(paste0(inputText, edges), debug=TRUE)
print('network build successful')
@@ -220,17 +222,20 @@ getValidNodes <- function(mapping, prevOutputs, prefix) {
}
}
coefs <- matrix(data=NA, nrow=length(outNodes), ncol=2, dimnames=list(NULL, c('growth', 'confidence')))
coefs <- matrix(data=NA, nrow=length(outNodes), ncol=3, dimnames=list(NULL, c('growth', 'confidence', 'layer')))
for (idx in 1:length(outNodes)) {
col <- match(outNodes[idx], colnames(mapping))
coefs[idx,] <- as.numeric(split(mapping[1, col]))[match(c('growth', 'confidence'), states)]
coefs[idx,] <- as.numeric(split(mapping[1, col]))[match(c('growth', 'confidence', 'layer'), states)]
}
print(coefs)
return(data.frame(
code=c(prevOutputs$code, paste0(prefix, seq(1:length(outNodes)))),
name=c(prevOutputs$name, outNodes),
growth=c(prevOutputs$growth, coefs[,"growth"]),
confidence=c(prevOutputs$confidence, coefs[,"confidence"]),
layer=c(prevOutputs$layer, coefs[,"layer"]),
stringsAsFactors=FALSE
))
}
@@ -266,14 +271,14 @@ getValidEdges <- function(mapping, nodeDF, prevEdge=NULL, prefix) {
data.frame(
input = edgeM[,"inputNode"],
output = edgeM[,"outputNode"],
impact = as.numeric(edgeM[,"impact"]),
impact = edgeM[,"impact"],
stringsAsFactors = FALSE
)
) else return (
data.frame(
input = c(prevEdge$input, edgeM[,"inputNode"]),
output = c(prevEdge$output, edgeM[,"outputNode"]),
impact = c(prevEdge$impact, as.numeric(edgeM[,"impact"])),
impact = c(prevEdge$impact, edgeM[,"impact"]),
stringsAsFactors = FALSE
)
)
@@ -317,19 +322,20 @@ parseSheet <- function(fName) {
p_op <- parseMapping(readXL(fName,mappings[3], startRow=1), p_ba, prefix='op')
p_es <- parseMapping(readXL(fName,mappings[4], startRow=1), p_op, prefix='es')
print('building graphs')
#print('building graphs')
p_baNet <- buildGraph(p_ba, desc=list(inputCode='p', outputCodes='ba'))
p_opNet <- buildGraph(p_op, desc=list(inputCode='p', outputCodes=c('ba', 'op')))
p_esNet <- buildGraph(p_es, desc=list(inputCode='p', outputCodes=c('ba', 'op', 'es')))
#p_baNet <- buildGraph(p_ba, desc=list(inputCode='p', outputCodes='ba'))
#p_opNet <- buildGraph(p_op, desc=list(inputCode='p', outputCodes=c('ba', 'op')))
#p_esNet <- buildGraph(p_es, desc=list(inputCode='p', outputCodes=c('ba', 'op', 'es')))
print('sheet load completed')
return(
list(
pressBioAss = p_baNet,
pressOpProc = p_opNet,
pressEcoServ = p_esNet
)
#list(
#pressBioAss = p_baNet,
#pressOpProc = p_opNet,
#pressEcoServ = p_esNet,
p_esMap = p_es
#)
)
} else {