From 92cbd78854cb972902880823f2268238ec832cfd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roland=20Holl=C3=B3s?= Date: Tue, 22 Nov 2022 10:18:50 +0100 Subject: [PATCH 1/5] warning fixed in GLUE results, more messages for the users --- RBBGCMuso/R/calibration.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/RBBGCMuso/R/calibration.R b/RBBGCMuso/R/calibration.R index d8f76fd..c3c8e45 100644 --- a/RBBGCMuso/R/calibration.R +++ b/RBBGCMuso/R/calibration.R @@ -270,10 +270,13 @@ musoGlue <- function(presCalFile, w, delta = 0.17, settings=setupMuso(), paramet par(pari) dev.off() - maxParValues <- preservedCalibtop5[which.max(preservedCalibtop5$combined),] + maxParValues <- unlist(preservedCalibtop5[which.max(preservedCalibtop5$combined),])[1:length(paramIndex)] maxParIndexes <- paramIndex + maxLikelihoodParameters <- data.frame(parameter_index=maxParIndexes,parameter_value=maxParValues) write.csv(cbind.data.frame(calibrationPar=maxParValues,parameters=maxParIndexes),"maxLikelihood.csv") + cat("\n\n- A file containing the parameters with the maximum likelihood (maxlikelihood_parameters.csv) has been created.\n") write.csv(optRanges,"optRanges.csv") + cat("- GLUE interval values have been written into optRanges.csv\n") # browser() # There are some serious problems with this implementation. The uncertainity bouns are not for the parameters, but for the output values. The median is pointwise median for all simulation. # And the 95 and 5 percentile also. From 2607a1974162203cb503b6389c3d20ba39d4a032 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roland=20Holl=C3=B3s?= Date: Tue, 22 Nov 2022 12:21:32 +0100 Subject: [PATCH 2/5] genEpc, changemulline -> creation, bugfix --- RBBGCMuso/DESCRIPTION | 2 +- RBBGCMuso/NAMESPACE | 1 + RBBGCMuso/R/calibration.R | 3 ++- RBBGCMuso/R/changeMuso.R | 2 +- RBBGCMuso/R/genEpc.R | 15 +++++++++++++++ RBBGCMuso/R/plotMuso.R | 27 ++++++++++++++------------- RBBGCMuso/man/calibrateMuso.Rd | 2 +- RBBGCMuso/man/changemulline.Rd | 8 +++++++- RBBGCMuso/man/readObservedData.Rd | 4 +++- 9 files changed, 45 insertions(+), 19 deletions(-) diff --git a/RBBGCMuso/DESCRIPTION b/RBBGCMuso/DESCRIPTION index d7a790b..a3c46c4 100644 --- a/RBBGCMuso/DESCRIPTION +++ b/RBBGCMuso/DESCRIPTION @@ -37,7 +37,7 @@ Imports: rpart, rpart.plot Maintainer: Roland Hollo's -RoxygenNote: 7.1.0 +RoxygenNote: 7.2.0 Suggests: knitr, rmarkdown, VignetteBuilder: knitr diff --git a/RBBGCMuso/NAMESPACE b/RBBGCMuso/NAMESPACE index 448280f..d4fd11c 100644 --- a/RBBGCMuso/NAMESPACE +++ b/RBBGCMuso/NAMESPACE @@ -11,6 +11,7 @@ export(copyMusoExampleTo) export(corrigMuso) export(createSoilFile) export(flatMuso) +export(genEpc) export(getAnnualOutputList) export(getConstMatrix) export(getDailyOutputList) diff --git a/RBBGCMuso/R/calibration.R b/RBBGCMuso/R/calibration.R index c3c8e45..db6e4af 100644 --- a/RBBGCMuso/R/calibration.R +++ b/RBBGCMuso/R/calibration.R @@ -273,7 +273,8 @@ musoGlue <- function(presCalFile, w, delta = 0.17, settings=setupMuso(), paramet maxParValues <- unlist(preservedCalibtop5[which.max(preservedCalibtop5$combined),])[1:length(paramIndex)] maxParIndexes <- paramIndex maxLikelihoodParameters <- data.frame(parameter_index=maxParIndexes,parameter_value=maxParValues) - write.csv(cbind.data.frame(calibrationPar=maxParValues,parameters=maxParIndexes),"maxLikelihood.csv") + write.csv(cbind.data.frame(parameters=maxParIndexes, calibrationPar=maxParValues), + "maxlikelihood_parameters.csv") cat("\n\n- A file containing the parameters with the maximum likelihood (maxlikelihood_parameters.csv) has been created.\n") write.csv(optRanges,"optRanges.csv") cat("- GLUE interval values have been written into optRanges.csv\n") diff --git a/RBBGCMuso/R/changeMuso.R b/RBBGCMuso/R/changeMuso.R index 9a34a0c..d6a156c 100644 --- a/RBBGCMuso/R/changeMuso.R +++ b/RBBGCMuso/R/changeMuso.R @@ -5,7 +5,7 @@ #' @author Roland Hollos #' @export -changemulline <- function(filePaths, calibrationPar, contents, src, outFiles=filePaths){ +changemulline <- function(filePaths, calibrationPar, contents, src=NULL, outFiles=filePaths){ # browser() if(is.null(src)){ src <- filePaths diff --git a/RBBGCMuso/R/genEpc.R b/RBBGCMuso/R/genEpc.R index 0543f8e..dd65ef2 100644 --- a/RBBGCMuso/R/genEpc.R +++ b/RBBGCMuso/R/genEpc.R @@ -33,3 +33,18 @@ randEpc <- function(parameterFile = "parameters.csv", location = "./epcDir", } setwd(currDir) } + +#' genEpc +#' +#' randEpc is a random epc creator based on musoMonte +#' @author Roland HOLLOS +#' @param sourceEpc the original epc file-the template +#' @param parameters dataframe where in the first column there are the indices and the second column the values +#' @param location output location directory +#' @export + +genEpc <- function (sourceEpc, targetEpc, parameters) { + changemulline(filePaths=sourceEpc,outFiles=targetEpc, + calibrationPar=parameters[,1],contents=parameters[,2]) +} + diff --git a/RBBGCMuso/R/plotMuso.R b/RBBGCMuso/R/plotMuso.R index 2976e47..a6c6863 100644 --- a/RBBGCMuso/R/plotMuso.R +++ b/RBBGCMuso/R/plotMuso.R @@ -275,28 +275,29 @@ plotMusoWithData <- function(mdata, plotName=NULL, modellSettings = settings, startDate = startDate, endDate = endDate, leapYear = leapYearHandling, continious = continious),envir=environment()) - mesData <- numeric(settings$numYears*365) - k <- 1 - for(i in seq(mesData)){ - if(i %in% modIndex){ - mesData[i] <- measuredData[k] - k <- k + 1 - } else { - mesData[i] <- NA - } - } - rm(k) + # mesData <- numeric(settings$numYears*365) + # k <- 1 + # for(i in seq(mesData)){ + # if(i %in% modIndex){ + # mesData[i] <- measuredData[k] + # k <- k + 1 + # } else { + # mesData[i] <- NA + # } + # } + # rm(k) # modIndex and measuredData are created. ## measuredData is created ## baseData <- calibMuso(settings = settings, silent = silent, prettyOut = TRUE)[modIndex,] - baseData <- calibMuso(settings = settings, silent = silent, prettyOut = TRUE) + baseData <- calibMuso(settings = settings, silent = silent, prettyOut = TRUE)[modIndex,] baseData[,1] <- as.Date(baseData[,1],format = "%d.%m.%Y") selVarName <- colnames(baseData)[selVar] if(!all.equal(colnames(baseData),unique(colnames(baseData)))){ notUnique <- setdiff((unlist(settings$dailyVarCodes)),unique(unlist(settings$dailyVarCodes))) stop(paste0("Error: daily output variable list in the ini file must contain unique numbers. Check your ini files! Not unique codes: ",notUnique)) } - mesData<-cbind.data.frame(baseData[,1],mesData) + # mesData<-cbind.data.frame(baseData[,1],mesData) + mesData<-cbind.data.frame(baseData[,1],measuredData) colnames(mesData) <- c("date", "measured") p <- baseData %>% ggplot(aes_string("date",selVarName)) + diff --git a/RBBGCMuso/man/calibrateMuso.Rd b/RBBGCMuso/man/calibrateMuso.Rd index b352155..35a3091 100644 --- a/RBBGCMuso/man/calibrateMuso.Rd +++ b/RBBGCMuso/man/calibrateMuso.Rd @@ -24,7 +24,7 @@ calibrateMuso( naVal = NULL, postProcString = NULL, thread_prefix = "thread", - numCores = (parallel::detectCores() - 1), + numCores = max(c(parallel::detectCores() - 1, 1)), pb = txtProgressBar(min = 0, max = iterations, style = 3), maxLikelihoodEpc = TRUE, pbUpdate = setTxtProgressBar, diff --git a/RBBGCMuso/man/changemulline.Rd b/RBBGCMuso/man/changemulline.Rd index 3676348..8b87c06 100644 --- a/RBBGCMuso/man/changemulline.Rd +++ b/RBBGCMuso/man/changemulline.Rd @@ -4,7 +4,13 @@ \alias{changemulline} \title{changemulline} \usage{ -changemulline(filePaths, calibrationPar, contents, src, outFiles = filePaths) +changemulline( + filePaths, + calibrationPar, + contents, + src = NULL, + outFiles = filePaths +) } \description{ The function uses the previous changspecline function to operate. diff --git a/RBBGCMuso/man/readObservedData.Rd b/RBBGCMuso/man/readObservedData.Rd index e079014..542daf8 100644 --- a/RBBGCMuso/man/readObservedData.Rd +++ b/RBBGCMuso/man/readObservedData.Rd @@ -11,7 +11,9 @@ readObservedData( leapYearHandling = TRUE, convert.var = NULL, convert.scalar = 1, - convert.fun = (function(x) { x * convert.scalar }), + convert.fun = (function(x) { + x * convert.scalar + }), convert.file = NULL, filterCol = NULL, filterVal = 1, From 9bb19a3336787898511c6063cc57620c83723b4f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roland=20Holl=C3=B3s?= Date: Tue, 22 Nov 2022 14:16:38 +0100 Subject: [PATCH 3/5] new functionality: musoGetValues, musoCompareFiles --- RBBGCMuso/NAMESPACE | 2 ++ RBBGCMuso/R/changeMuso.R | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 37 insertions(+) diff --git a/RBBGCMuso/NAMESPACE b/RBBGCMuso/NAMESPACE index d4fd11c..0fc6ec6 100644 --- a/RBBGCMuso/NAMESPACE +++ b/RBBGCMuso/NAMESPACE @@ -20,7 +20,9 @@ export(getFilesFromIni) export(getyearlycum) export(getyearlymax) export(multiSiteCalib) +export(musoCompareFiles) export(musoDate) +export(musoGetValues) export(musoGlue) export(musoMapping) export(musoMappingFind) diff --git a/RBBGCMuso/R/changeMuso.R b/RBBGCMuso/R/changeMuso.R index d6a156c..a0b4789 100644 --- a/RBBGCMuso/R/changeMuso.R +++ b/RBBGCMuso/R/changeMuso.R @@ -31,3 +31,38 @@ changeByIndex <- function (rowIndex, parameter, fileStringVector){ fileStringVector[i] <- changeNth(fileStringVector[i], h, parameter) fileStringVector } + + +#' musoGetValues +#' +#' Get values from a musofile by supplying muso indices +#' +#' @param filename The name of the musofile we want the value from (e.g. epc file) +#' @param indices muso indices +#' @usage musoGetValues(filename, indices) +#' @export + +musoGetValues <- function(filename, indices){ + sapply(indices, function(index){ + colIndex <- round((index*100) %% 10) + 1 + rowIndex <- as.integer(index) + as.numeric(unlist(strsplit(readLines(filename)[rowIndex],split="\\s+"))[colIndex]) + +}) +} + +#' musoCompareFiles +#' +#' A simple wrapper function based on musoGetValues where you can get multiple values from multiple files +#' using the supplied indices. It is useful for comparing files. +#' +#' @param filenames The name of the files where you can get the data from +#' @param indices muso indices +#' @usage musoCompareFiles(filenames, indices) +#' @export + +musoCompareFiles <- function(filenames, indices){ + sapply(filenames, function(fn){ + musoGetValues(fn,indices) + }) +} From d18c10648f3f8c79b3d2f4de7b470248629e9336 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roland=20Holl=C3=B3s?= Date: Tue, 22 Nov 2022 18:10:09 +0100 Subject: [PATCH 4/5] Documentation for genEpc, musoCompareFiles, musoGetValues --- RBBGCMuso/man/genEpc.Rd | 21 +++++++++++++++++++++ RBBGCMuso/man/musoCompareFiles.Rd | 17 +++++++++++++++++ RBBGCMuso/man/musoGetValues.Rd | 16 ++++++++++++++++ 3 files changed, 54 insertions(+) create mode 100644 RBBGCMuso/man/genEpc.Rd create mode 100644 RBBGCMuso/man/musoCompareFiles.Rd create mode 100644 RBBGCMuso/man/musoGetValues.Rd diff --git a/RBBGCMuso/man/genEpc.Rd b/RBBGCMuso/man/genEpc.Rd new file mode 100644 index 0000000..93b6ea1 --- /dev/null +++ b/RBBGCMuso/man/genEpc.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/genEpc.R +\name{genEpc} +\alias{genEpc} +\title{genEpc} +\usage{ +genEpc(sourceEpc, targetEpc, parameters) +} +\arguments{ +\item{sourceEpc}{the original epc file-the template} + +\item{parameters}{dataframe where in the first column there are the indices and the second column the values} + +\item{location}{output location directory} +} +\description{ +randEpc is a random epc creator based on musoMonte +} +\author{ +Roland HOLLOS +} diff --git a/RBBGCMuso/man/musoCompareFiles.Rd b/RBBGCMuso/man/musoCompareFiles.Rd new file mode 100644 index 0000000..1f959f8 --- /dev/null +++ b/RBBGCMuso/man/musoCompareFiles.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/changeMuso.R +\name{musoCompareFiles} +\alias{musoCompareFiles} +\title{musoCompareFiles} +\usage{ +musoCompareFiles(filenames, indices) +} +\arguments{ +\item{filenames}{The name of the files where you can get the data from} + +\item{indices}{muso indices} +} +\description{ +A simple wrapper function based on musoGetValues where you can get multiple values from multiple files +using the supplied indices. It is useful for comparing files. +} diff --git a/RBBGCMuso/man/musoGetValues.Rd b/RBBGCMuso/man/musoGetValues.Rd new file mode 100644 index 0000000..44764d2 --- /dev/null +++ b/RBBGCMuso/man/musoGetValues.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/changeMuso.R +\name{musoGetValues} +\alias{musoGetValues} +\title{musoGetValues} +\usage{ +musoGetValues(filename, indices) +} +\arguments{ +\item{filename}{The name of the musofile we want the value from (e.g. epc file)} + +\item{indices}{muso indices} +} +\description{ +Get values from a musofile by supplying muso indices +} 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 5/5] 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 +}