From f29ec63991cf1fe8488abe3110fe063cd3f1a86e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roland=20Holl=C3=B3s?= Date: Tue, 7 Feb 2023 21:18:36 +0100 Subject: [PATCH] add tuner functionality --- RBBGCMuso/DESCRIPTION | 3 +- RBBGCMuso/NAMESPACE | 29 ++++++ RBBGCMuso/R/tuner.R | 173 ++++++++++++++++++++++++++++++++ RBBGCMuso/man/tuneMuso.Rd | 14 +++ RBBGCMuso/man/tuneMusoServer.Rd | 18 ++++ RBBGCMuso/man/tuneMusoUI.Rd | 14 +++ 6 files changed, 250 insertions(+), 1 deletion(-) create mode 100644 RBBGCMuso/R/tuner.R create mode 100644 RBBGCMuso/man/tuneMuso.Rd create mode 100644 RBBGCMuso/man/tuneMusoServer.Rd create mode 100644 RBBGCMuso/man/tuneMusoUI.Rd diff --git a/RBBGCMuso/DESCRIPTION b/RBBGCMuso/DESCRIPTION index a3c46c4..450f974 100644 --- a/RBBGCMuso/DESCRIPTION +++ b/RBBGCMuso/DESCRIPTION @@ -35,9 +35,10 @@ Imports: tcltk, Boruta, rpart, + plotly, rpart.plot Maintainer: Roland Hollo's -RoxygenNote: 7.2.0 +RoxygenNote: 7.2.3 Suggests: knitr, rmarkdown, VignetteBuilder: knitr diff --git a/RBBGCMuso/NAMESPACE b/RBBGCMuso/NAMESPACE index 0fc6ec6..355ad67 100644 --- a/RBBGCMuso/NAMESPACE +++ b/RBBGCMuso/NAMESPACE @@ -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) diff --git a/RBBGCMuso/R/tuner.R b/RBBGCMuso/R/tuner.R new file mode 100644 index 0000000..62336bb --- /dev/null +++ b/RBBGCMuso/R/tuner.R @@ -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(...)) +} diff --git a/RBBGCMuso/man/tuneMuso.Rd b/RBBGCMuso/man/tuneMuso.Rd new file mode 100644 index 0000000..d424cfb --- /dev/null +++ b/RBBGCMuso/man/tuneMuso.Rd @@ -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 +} diff --git a/RBBGCMuso/man/tuneMusoServer.Rd b/RBBGCMuso/man/tuneMusoServer.Rd new file mode 100644 index 0000000..d05e342 --- /dev/null +++ b/RBBGCMuso/man/tuneMusoServer.Rd @@ -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 +} diff --git a/RBBGCMuso/man/tuneMusoUI.Rd b/RBBGCMuso/man/tuneMusoUI.Rd new file mode 100644 index 0000000..25801a9 --- /dev/null +++ b/RBBGCMuso/man/tuneMusoUI.Rd @@ -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 +}