Allow considering individual mu values for each of the provided group…

…s when applying the global fit functionality.
tzerk · Oct 27, 2019 · 24de0aa · 24de0aa
1 parent 1a887b9
commit 24de0aa
Show file tree

Hide file tree

Showing 5 changed files with 102 additions and 94 deletions.
diff --git a/NEWS.Rmd b/NEWS.Rmd
@@ -5,7 +5,8 @@ output: github_document
 
 ## RLumShiny 0.2.3 (Release date: 2019-xx-xx)
 
-* nothing so far
+* Updated `surfaceexposure` app now allows considering multiple mu values when
+  using the global fit functionality.
 
 ## RLumShiny 0.2.2 (Release date: 2019-01-11)
 

diff --git a/NEWS.md b/NEWS.md
@@ -1,126 +1,82 @@
 
 <!-- NEWS.md was auto-generated by NEWS.Rmd. Please DO NOT edit by hand!-->
+RLumShiny 0.2.3 (Release date: 2019-xx-xx)
+------------------------------------------
 
-## RLumShiny 0.2.3 (Release date: 2019-xx-xx)
+-   Updated `surfaceexposure` app now allows considering multiple mu values when using the global fit functionality.
 
-  - nothing so far
+RLumShiny 0.2.2 (Release date: 2019-01-11)
+------------------------------------------
 
-## RLumShiny 0.2.2 (Release date: 2019-01-11)
+-   **PREVIEW**: New application that scales the gamma dose rate considering layer-to-layer variations in soil radioactivity. Base function: `Luminescence::scale_GammaDose()`. Keyword for `app_RLum()`: 'scalegamma'.
 
-  - **PREVIEW**: New application that scales the gamma dose rate
-    considering layer-to-layer variations in soil radioactivity. Base
-    function: `Luminescence::scale_GammaDose()`. Keyword for
-    `app_RLum()`: ‘scalegamma’.
-
-    **NOTE**: This application will only start if the development
-    version 0.9.x of the R package `Luminescence` is installed as the
-    function `scale_GammaDose()` is still under development.
+**NOTE**: This application will only start if the development version 0.9.x of the R package `Luminescence` is installed as the function `scale_GammaDose()` is still under development.
 
-  - New application to support the new R package `RCarb`. Base function
-    `RCarb::model_DoseRate()`. Keyword for `app_RLum()`: ‘RCarb’
+-   New application to support the new R package `RCarb`. Base function `RCarb::model_DoseRate()`. Keyword for `app_RLum()`: 'RCarb'
 
-  - Removed and updated deprecated links from the “About”-tab in all
-    applications.
+-   Removed and updated deprecated links from the "About"-tab in all applications.
 
-## RLumShiny 0.2.1 (Release date: 2018-06-18)
+RLumShiny 0.2.1 (Release date: 2018-06-18)
+------------------------------------------
 
-  - New application that compares the OSL/IRSL stimulation power of
-    measurements performed on Freiberg Instruments lexsyg devices to
-    check the stability of the stimulation power (Contributed by
-    Sebastian Kreutzer). Keyword for `app_RLum()`:
-    ‘teststimulationpower’.
+-   New application that compares the OSL/IRSL stimulation power of measurements performed on Freiberg Instruments lexsyg devices to check the stability of the stimulation power (Contributed by Sebastian Kreutzer). Keyword for `app_RLum()`: 'teststimulationpower'.
 
-  - New application to calculate the fast ratio of CW-OSL curves after
-    Durcan and Duller (2011). Base function:
-    `Luminescence::calc_FastRatio()`. Keyword for `app_RLum()`:
-    ‘fastratio’.
+-   New application to calculate the fast ratio of CW-OSL curves after Durcan and Duller (2011). Base function: `Luminescence::calc_FastRatio()`. Keyword for `app_RLum()`: 'fastratio'.
 
-  - New application to estimate the g-value from a table of Lx/Tx values
-    with corresponding waiting times since irradiation and to apply a
-    fading after Huntley & Lamothe (2001). Base functions:
-    `Luminescence::analyse_FadingMeasurement()`,
-    `Luminescence::calc_FadingCorr()`. Keyword for `app_RLum()`:
-    ‘fading’.
+-   New application to estimate the g-value from a table of Lx/Tx values with corresponding waiting times since irradiation and to apply a fading after Huntley & Lamothe (2001). Base functions: `Luminescence::analyse_FadingMeasurement()`, `Luminescence::calc_FadingCorr()`. Keyword for `app_RLum()`: 'fading'.
 
-  - New application to fit eq. 1 of Sohbati et al. (2012a) or eq. 12 of
-    Sohbati et al. (2012b) to OSL surface exposure data. Base function:
-    `Luminescence::fit_SurfaceExposure()`. Keyword for `app_RLum()`:
-    ‘surfaceexposure’.
+-   New application to fit eq. 1 of Sohbati et al. (2012a) or eq. 12 of Sohbati et al. (2012b) to OSL surface exposure data. Base function: `Luminescence::fit_SurfaceExposure()`. Keyword for `app_RLum()`: 'surfaceexposure'.
 
-  - Output panel showing the R code to reproduce the plot/calculation is
-    now properly responsive and updates as soon as input widgets change.
+-   Output panel showing the R code to reproduce the plot/calculation is now properly responsive and updates as soon as input widgets change.
 
-  - Internal: server logic of most applications simplified.
+-   Internal: server logic of most applications simplified.
 
-  - Several minor bugfixes.
+-   Several minor bugfixes.
 
-## RLumShiny 0.2.0 (Release date: 2017-06-26)
+RLumShiny 0.2.0 (Release date: 2017-06-26)
+------------------------------------------
 
-  - Major overhaul of the data input panel for most applications.
-    Uploaded text files are now imported via ‘data.table::fread()’,
-    which automatically detects the delimiter and potential headers.
-    Hence, all widgets related to data import are no longer required and
-    were removed (`#14`).
+-   Major overhaul of the data input panel for most applications. Uploaded text files are now imported via 'data.table::fread()', which automatically detects the delimiter and potential headers. Hence, all widgets related to data import are no longer required and were removed (`#14`).
 
-  - The input data can now be directly manipulated in the newly added
-    spreadsheet(s) in the data input panels. The spreadsheets also allow
-    copy and pasting of data, so uploading a file is no longer the only
-    way to provide user data (`#12`).
+-   The input data can now be directly manipulated in the newly added spreadsheet(s) in the data input panels. The spreadsheets also allow copy and pasting of data, so uploading a file is no longer the only way to provide user data (`#12`).
 
-  - New Dashboard addin added. The dashboard provides access to all
-    available applications in the package and can be accessed either (i)
-    through the addin dropdown menu in the RStudio IDE or (ii) by
-    running ‘app\_RLum()’ without any keyword.
+-   New Dashboard addin added. The dashboard provides access to all available applications in the package and can be accessed either (i) through the addin dropdown menu in the RStudio IDE or (ii) by running 'app\_RLum()' without any keyword.
 
-  - Implemented newest shiny feature (v0.14) to bookmark the current app
-    state. All apps now include a bookmark button, which returns a URL
-    query string that can be used to restore the app’s state at any
-    later time.
+-   Implemented newest shiny feature (v0.14) to bookmark the current app state. All apps now include a bookmark button, which returns a URL query string that can be used to restore the app's state at any later time.
 
-  - New application to plot filter combinations along with the optional
-    net transmission. Base function:
-    `Luminescence::plot_FilterCombinations()`. Keyword for `app_RLum()`:
-    ‘filter’. External contribution by Urs Tilmann Wolpert
-    (Justus-Liebig-University Giessen) and Sebastian Kreutzer
-    (Universite Bordeaux Montaigne).
+-   New application to plot filter combinations along with the optional net transmission. Base function: `Luminescence::plot_FilterCombinations()`. Keyword for `app_RLum()`: 'filter'. External contribution by Urs Tilmann Wolpert (Justus-Liebig-University Giessen) and Sebastian Kreutzer (Universite Bordeaux Montaigne).
 
-  - New package dependencies: ‘shinydashboard’, ‘rhandsontable’,
-    ‘data.table’, ‘readxl’
+-   New package dependencies: 'shinydashboard', 'rhandsontable', 'data.table', 'readxl'
 
-  - transformCW-app:
-
-      - the plot now also shows the CW-OSL data curve
-      - improved error handling
+-   transformCW-app:
+    -   the plot now also shows the CW-OSL data curve
+    -   improved error handling
+-   Internal: R dcoumentation re-written in Markdown using 'roxygen2 &gt;=6.0.0'
 
-  - Internal: R dcoumentation re-written in Markdown using ‘roxygen2
-    \>=6.0.0’
+-   Several minor bugfixes.
 
-  - Several minor bugfixes.
+RLumShiny 0.1.1 (Release date: 2016-07-20)
+------------------------------------------
 
-## RLumShiny 0.1.1 (Release date: 2016-07-20)
+-   New application to transform CW OSL curves (keyword 'transformCW') using the functions 'CW2pHMi', 'CW2pLM', 'CW2pLMi' and 'CW2pPMi' of the R package 'Luminescence'.
 
-  - New application to transform CW OSL curves (keyword ‘transformCW’)
-    using the functions ‘CW2pHMi’, ‘CW2pLM’, ‘CW2pLMi’ and ‘CW2pPMi’ of
-    the R package ‘Luminescence’.
+-   Removed UI elements that used now deprecated function arguments.
 
-  - Removed UI elements that used now deprecated function arguments.
+-   Added new UI elements for arguments added to functions after version 0.4.2 of the 'Luminescence' package.
 
-  - Added new UI elements for arguments added to functions after version
-    0.4.2 of the ‘Luminescence’ package.
+-   Removed the database feature in the abanico plot application.
 
-  - Removed the database feature in the abanico plot application.
+-   Removed dependencies on 'digest' and 'RCurl'.
 
-  - Removed dependencies on ‘digest’ and ‘RCurl’.
+-   Removed all 'Exit' buttons.
 
-  - Removed all ‘Exit’ buttons.
+-   Code output to reproduce the plots is now generated dynamically and should be more reliable.
 
-  - Code output to reproduce the plots is now generated dynamically and
-    should be more reliable.
+-   R Luminescence Package Team now properly mentioned as contributors.
 
-  - R Luminescence Package Team now properly mentioned as contributors.
+-   Fixed many typos.
 
-  - Fixed many typos.
+RLumShiny 0.1.0 (Release date: 2015-03-31)
+------------------------------------------
 
-## RLumShiny 0.1.0 (Release date: 2015-03-31)
-
-  - Initial release
+-   Initial release
diff --git a/inst/shiny/surfaceexposure/server.R b/inst/shiny/surfaceexposure/server.R
@@ -10,6 +10,7 @@ function(input, output, session) {
     # by default tabs are suspended and input variables are hence
     # not available
     outputOptions(x = output, name = "global_fit_ages", suspendWhenHidden = FALSE)
+    outputOptions(x = output, name = "global_fit_mus", suspendWhenHidden = FALSE)
   })
 
   session$onSessionEnded(function() {
@@ -82,6 +83,18 @@ function(input, output, session) {
     }
   })
 
+  output$global_fit_mus <- renderUI({
+    if (input$global_fit && inherits(values$data_used, "list") && input$override_mu) {
+      if (input$individual_mus)
+        n <- length(values$data_used)
+      else 
+        n <- 1
+      lapply(1:n, function(i) {
+        numericInput(paste0("mus_", i), paste("\\( \\mu \\)", i), value = 0.9, step = 0.1)
+      })
+    }
+  })
+
   observeEvent(input$coord_flip, {
     tmp <- isolate(input$xlab)
     updateTextInput(session, "xlab", value = isolate(input$ylab))
@@ -168,6 +181,21 @@ function(input, output, session) {
         age <- NULL
     }
 
+    # Mu
+    if (input$global_fit) {
+      if (input$individual_mus && input$override_mu) 
+        mu <- sapply(1:length(values$data_used), function(i) as.numeric(input[[paste0("mus_", i)]]))
+      else if (input$override_mu)
+        mu <- as.numeric(input[["mus_1"]])
+      else
+        mu <- NULL
+    } else {
+      if (input$override_mu)
+        mu <- input$mu
+      else
+        mu <- NULL
+    }
+
     # fitting line color
     if (input$line_col == "custom")
       line_col <- input$jscol
@@ -181,7 +209,7 @@ function(input, output, session) {
       age = age,
       weights = if (input$global_fit) FALSE else input$weights,
       sigmaphi = if (input$override_sigmaphi) input$sigmaphi_base * 10^-(abs(input$sigmaphi_exp)) else NULL,
-      mu = if (input$override_mu) input$mu else NULL,
+      mu = mu,
       Ddot = if (input$doserate) input$ddot else NULL,
       D0  = if (input$doserate) input$d0 else NULL,
       verbose = FALSE,

diff --git a/inst/shiny/surfaceexposure/ui.R b/inst/shiny/surfaceexposure/ui.R
@@ -30,11 +30,25 @@ function(request) {
                                ),##EndOf::Tab_1
 
                                tabPanel("Parameters",
-                                        checkboxInput(inputId = "global_fit", "Global fit", TRUE),
+                                        fluidRow(
+                                          column(width = 6,
+                                                 checkboxInput(inputId = "global_fit", "Global fit", TRUE)
+                                                 ),
+                                          column(width = 6,
+                                                 checkboxInput(inputId = "individual_mus", "Individual \\( \\mu \\) values", TRUE)
+                                                 )
+                                        ),
                                         conditionalPanel(condition = "input.global_fit == true",
                                                          helpText(HTML(paste(tags$b("NOTE:"), "Weighting is not available for global fitting.")))
                                         ),
-                                        uiOutput("global_fit_ages"),
+                                        fluidRow(
+                                          column(width = 6,
+                                                 uiOutput("global_fit_ages")
+                                                 ),
+                                          column(width=6,
+                                                 uiOutput("global_fit_mus")
+                                                 )
+                                        ),
                                         conditionalPanel(condition = "input.global_fit == false",
                                                          checkboxInput(inputId = "weights", HTML("Error weighted fitting (1/&sigma;<sup>2</sup>)"), FALSE)
                                         ),
@@ -67,7 +81,12 @@ function(request) {
                                           column(1,
                                                  checkboxInput(inputId = "override_mu", "", value = TRUE)),
                                           column(10,
-                                                 numericInput(inputId = "mu", "\\( \\mu \\)", value = 0.90, step = 0.01)
+                                                 conditionalPanel(condition = "input.global_fit == false",
+                                                                  numericInput(inputId = "mu", "\\( \\mu \\)", value = 0.90, step = 0.01)
+                                                 ),
+                                                 conditionalPanel(condition = "input.global_fit == true",
+                                                                  helpText(paste("Provide \\( \\mu \\) values"))
+                                                 )
                                           )
                                         )
                                ),

diff --git a/inst/shiny/surfaceexposure/www/style.css b/inst/shiny/surfaceexposure/www/style.css
@@ -68,3 +68,7 @@ input,textarea,.uneditable-input{
 	width: auto;
 	}
 
+.help-block {
+  margin-top: 13px;
+  margin-bottom: 0px;
+}