add tuner functionality
This commit is contained in:
Roland Hollós
parent
b77facfedb
commit
f29ec63991
@ -35,9 +35,10 @@ Imports:
|
||||
tcltk,
|
||||
Boruta,
|
||||
rpart,
|
||||
plotly,
|
||||
rpart.plot
|
||||
Maintainer: Roland Hollo's <hollorol@gmail.com>
|
||||
RoxygenNote: 7.2.0
|
||||
RoxygenNote: 7.2.3
|
||||
Suggests: knitr,
|
||||
rmarkdown,
|
||||
VignetteBuilder: knitr
|
||||
|
||||
@ -43,6 +43,9 @@ export(saveAllMusoPlots)
|
||||
export(setupMuso)
|
||||
export(spinupMuso)
|
||||
export(supportedMuso)
|
||||
export(tuneMuso)
|
||||
export(tuneMusoServer)
|
||||
export(tuneMusoUI)
|
||||
export(updateMusoMapping)
|
||||
import(ggplot2)
|
||||
import(utils)
|
||||
@ -87,12 +90,38 @@ importFrom(lubridate,leap_year)
|
||||
importFrom(magrittr,'%<>%')
|
||||
importFrom(magrittr,'%>%')
|
||||
importFrom(openxlsx,read.xlsx)
|
||||
importFrom(plotly,add_trace)
|
||||
importFrom(plotly,plot_ly)
|
||||
importFrom(plotly,plotlyOutput)
|
||||
importFrom(plotly,renderPlotly)
|
||||
importFrom(rmarkdown,pandoc_version)
|
||||
importFrom(rmarkdown,render)
|
||||
importFrom(rpart,rpart)
|
||||
importFrom(rpart,rpart.control)
|
||||
importFrom(rpart.plot,rpart.plot)
|
||||
importFrom(scales,percent)
|
||||
importFrom(shiny,HTML)
|
||||
importFrom(shiny,actionButton)
|
||||
importFrom(shiny,checkboxInput)
|
||||
importFrom(shiny,fluidPage)
|
||||
importFrom(shiny,getShinyOption)
|
||||
importFrom(shiny,isolate)
|
||||
importFrom(shiny,mainPanel)
|
||||
importFrom(shiny,numericInput)
|
||||
importFrom(shiny,observeEvent)
|
||||
importFrom(shiny,radioButtons)
|
||||
importFrom(shiny,reactiveValues)
|
||||
importFrom(shiny,selectInput)
|
||||
importFrom(shiny,shinyApp)
|
||||
importFrom(shiny,shinyOptions)
|
||||
importFrom(shiny,sidebarLayout)
|
||||
importFrom(shiny,sidebarPanel)
|
||||
importFrom(shiny,tabPanel)
|
||||
importFrom(shiny,tabsetPanel)
|
||||
importFrom(shiny,tagList)
|
||||
importFrom(shiny,tags)
|
||||
importFrom(shiny,textAreaInput)
|
||||
importFrom(shiny,titlePanel)
|
||||
importFrom(stats,approx)
|
||||
importFrom(tcltk,tk_choose.files)
|
||||
importFrom(tibble,rownames_to_column)
|
||||
|
||||
173
RBBGCMuso/R/tuner.R
Normal file
173
RBBGCMuso/R/tuner.R
Normal file
@ -0,0 +1,173 @@
|
||||
#' tuneMusoUI
|
||||
#'
|
||||
#' This is a simple parameter tuner function which works great in a flat directory systemj
|
||||
#'
|
||||
#' @param parameterFile optional, the parameter csv file
|
||||
#' @importFrom plotly plotlyOutput
|
||||
#' @importFrom shiny tags actionButton numericInput HTML checkboxInput titlePanel radioButtons textAreaInput fluidPage sidebarLayout sidebarPanel mainPanel getShinyOption tabsetPanel tabPanel tagList selectInput
|
||||
#' @usage ...
|
||||
#' @export
|
||||
|
||||
tuneMusoUI <- function(parameterFile = NULL, ...){
|
||||
setwd(getShinyOption("musoRoot"))
|
||||
dir.create("bck",showWarnings = FALSE)
|
||||
file.copy("n.ini","bck/n.ini", overwrite=FALSE)
|
||||
if(is.null(parameterFile)){
|
||||
parameterFile <- "parameters.csv"
|
||||
}
|
||||
parameters <- read.csv(parameterFile, stringsAsFactors=FALSE)
|
||||
settings <- setupMuso(...)
|
||||
defaultValues <- musoGetValues(settings$epcInput[2],parameters[,2])
|
||||
fluidPage(
|
||||
# tags$head(tags$style(HTML("#iniContainer {width: 80vw;}"))),
|
||||
tags$head(tags$style(HTML("#contolp {height: 80vh;overflow-y:scroll;}"))),
|
||||
titlePanel("Biome-BGCMuSo parameter tuner"),
|
||||
sidebarLayout(
|
||||
sidebarPanel(tabsetPanel(type="tabs",
|
||||
tabPanel("params",
|
||||
checkboxInput("autoupdate","Automatic update"),
|
||||
tags$div(id="controlp",selectInput("ovar",
|
||||
label="Select output Variable",
|
||||
choices=settings$dailyOutputTable$name,
|
||||
width="40%"
|
||||
),
|
||||
do.call(tagList,lapply(1:nrow(parameters),function(x){
|
||||
numericInput(paste0("param_",x),
|
||||
parameters[x,1],
|
||||
defaultValues[x],
|
||||
step=defaultValues[x]/10,
|
||||
width="40%"
|
||||
)
|
||||
}))),
|
||||
tags$div(actionButton(inputId="runModel","Run MuSo"),
|
||||
radioButtons(inputId="destination",
|
||||
label="reference or modified",
|
||||
choiceValues=c("auto","prev","next"),
|
||||
choiceNames=c("automatic","reference","modified")))),
|
||||
tabPanel("ini",tags$div(id="iniContainer",
|
||||
textAreaInput("inifile","Normal Ini file",
|
||||
value=paste(readLines(settings$iniInput[2]),
|
||||
collapse="\n"))),
|
||||
actionButton(inputId="getOriginalIni", "Load original"),
|
||||
actionButton(inputId="overwriteIni", "overwrite")
|
||||
|
||||
)
|
||||
)),
|
||||
mainPanel(plotlyOutput(outputId="Result"))
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
#' tuneMusoServer
|
||||
#'
|
||||
#' Server program for tumeMuso
|
||||
#'
|
||||
#' @param input shiny input
|
||||
#' @param output shiny output
|
||||
#' @param session dinamic session management for shiny
|
||||
#' @importFrom shiny reactiveValues isolate observeEvent
|
||||
#' @importFrom plotly renderPlotly plot_ly add_trace
|
||||
#' @usage ...
|
||||
#' @export
|
||||
|
||||
tuneMusoServer <- function(input, output, session){
|
||||
|
||||
settings <- setupMuso()
|
||||
dates <- as.Date(musoDate(settings$startYear, numYears=settings$numYears),"%d.%m.%Y")
|
||||
|
||||
parameters <- read.csv("parameters.csv", stringsAsFactors=FALSE)
|
||||
|
||||
outputList <- vector(mode = "list", length = 2)
|
||||
outputList <- reactiveValues()
|
||||
outputList[['prev']] <- character(0)
|
||||
outputList[['next']] <- character(0)
|
||||
|
||||
|
||||
observeEvent(input$runModel,{
|
||||
|
||||
paramVal <- sapply(1:nrow(parameters),function(x){
|
||||
input[[paste0("param_", x)]]
|
||||
})
|
||||
|
||||
|
||||
if(isolate(input$destination) == "auto"){
|
||||
outputList[['prev']] <- isolate(outputList[['next']])
|
||||
outputList[['next']] <- calibMuso(settings = settings,
|
||||
calibrationPar = parameters[,2],
|
||||
parameters = paramVal)
|
||||
} else {
|
||||
outputList[[isolate(input$destination)]] <- calibMuso(settings = settings,
|
||||
calibrationPar = parameters[,2],
|
||||
parameters = paramVal)
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
})
|
||||
|
||||
observe({
|
||||
if(input$autoupdate){
|
||||
paramVal <- sapply(1:nrow(parameters),function(x){
|
||||
input[[paste0("param_", x)]]
|
||||
})
|
||||
|
||||
|
||||
if(isolate(input$destination) == "auto"){
|
||||
outputList[['prev']] <- isolate(outputList[['next']])
|
||||
outputList[['next']] <- calibMuso(settings = settings,
|
||||
calibrationPar = parameters[,2],
|
||||
parameters = paramVal)
|
||||
} else {
|
||||
outputList[[isolate(input$destination)]] <- calibMuso(settings = settings,
|
||||
calibrationPar = parameters[,2],
|
||||
parameters = paramVal)
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
})
|
||||
|
||||
|
||||
observe({
|
||||
if(length(outputList[['next']])!=0){
|
||||
output$Result <- renderPlotly(
|
||||
{
|
||||
p <- plot_ly()
|
||||
if(length(outputList[['prev']])!=0){
|
||||
p <- add_trace(p, x=dates, y=outputList[['prev']][,input$ovar], type='scatter',
|
||||
mode='lines')
|
||||
}
|
||||
add_trace(p, x=dates, y=outputList[['next']][,input$ovar], color="red", type='scatter',
|
||||
mode='lines')
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
}
|
||||
})
|
||||
|
||||
observeEvent(input$getOriginalIni,{
|
||||
updateTextAreaInput(session, "inifile", value=paste(readLines("bck/n.ini"),
|
||||
collapse="\n") )
|
||||
})
|
||||
|
||||
}
|
||||
|
||||
|
||||
#' tuneMuso
|
||||
#'
|
||||
#' launchApp launch the shiny app
|
||||
#' @param ... Other parameters for shinyApp function
|
||||
#' @importFrom shiny shinyApp shinyOptions
|
||||
#' @export
|
||||
tuneMuso <- function(directory = NULL,...){
|
||||
shinyOptions(workdir = getwd())
|
||||
if(is.null(directory)){
|
||||
shinyOptions(musoRoot = ".")
|
||||
} else {
|
||||
shinyOptions(musoRoot = normalizePath(directory))
|
||||
}
|
||||
shinyApp(ui = tuneMusoUI(), server = tuneMusoServer, options = list(...))
|
||||
}
|
||||
14
RBBGCMuso/man/tuneMuso.Rd
Normal file
14
RBBGCMuso/man/tuneMuso.Rd
Normal file
@ -0,0 +1,14 @@
|
||||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/tuner.R
|
||||
\name{tuneMuso}
|
||||
\alias{tuneMuso}
|
||||
\title{tuneMuso}
|
||||
\usage{
|
||||
tuneMuso(directory = NULL, ...)
|
||||
}
|
||||
\arguments{
|
||||
\item{...}{Other parameters for shinyApp function}
|
||||
}
|
||||
\description{
|
||||
launchApp launch the shiny app
|
||||
}
|
||||
18
RBBGCMuso/man/tuneMusoServer.Rd
Normal file
18
RBBGCMuso/man/tuneMusoServer.Rd
Normal file
@ -0,0 +1,18 @@
|
||||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/tuner.R
|
||||
\name{tuneMusoServer}
|
||||
\alias{tuneMusoServer}
|
||||
\title{tuneMusoServer}
|
||||
\usage{
|
||||
...
|
||||
}
|
||||
\arguments{
|
||||
\item{input}{shiny input}
|
||||
|
||||
\item{output}{shiny output}
|
||||
|
||||
\item{session}{dinamic session management for shiny}
|
||||
}
|
||||
\description{
|
||||
Server program for tumeMuso
|
||||
}
|
||||
14
RBBGCMuso/man/tuneMusoUI.Rd
Normal file
14
RBBGCMuso/man/tuneMusoUI.Rd
Normal file
@ -0,0 +1,14 @@
|
||||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/tuner.R
|
||||
\name{tuneMusoUI}
|
||||
\alias{tuneMusoUI}
|
||||
\title{tuneMusoUI}
|
||||
\usage{
|
||||
...
|
||||
}
|
||||
\arguments{
|
||||
\item{parameterFile}{optional, the parameter csv file}
|
||||
}
|
||||
\description{
|
||||
This is a simple parameter tuner function which works great in a flat directory systemj
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user