Merge pull request #89 from R-Lum/dev_various

RLumSK · web-flow · commit 331a3ae0972e · 2025-12-16T07:54:41.000+01:00
various fixes and compatibility with Luminescence 1.1.2 and a big thanks to @mcol. Should @tzerk start a new release? I guess so, right?
diff --git a/.github/workflows/GitHub_Actions_CI.yaml b/.github/workflows/GitHub_Actions_CI.yaml
@@ -2,7 +2,6 @@
 on:
   push:
     branches:
-      - dev_*
       - master
   pull_request:
     branches:
diff --git a/.github/workflows/test-coverage.yml b/.github/workflows/test-coverage.yml
@@ -3,7 +3,7 @@
 # https://github.com/r-lib/actions/issues/834
 on:
   push:
-    branches: [master, dev_*]
+    branches: [master]
   pull_request:
     branches: [master, dev_*]
 
@@ -28,7 +28,7 @@ jobs:
 
       - uses: r-lib/actions/setup-r@v2
         with:
-          r-version: '4.3.3'
+          r-version: 'release'
           use-public-rspm: true
 
       - uses: r-lib/actions/setup-r-dependencies@v2
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -21,20 +21,20 @@ Description: A collection of 'shiny' applications for the R package
 License: GPL-3 | file LICENSE
 Encoding: UTF-8
 Depends:
- R (>= 4.3)
+ R (>= 4.4)
 Imports:
- Luminescence (>= 1.1.0),
+ Luminescence (>= 1.1.2),
  shiny (>= 1.11.1),
  rhandsontable (>= 0.3.8),
  data.table (>= 1.17.6),
  googleVis (>= 0.7.3),
- leaflet (>= 2.2.2),
+ leaflet (>= 2.2.3),
  shinydashboard (>= 0.7.3),
  RCarb (>= 0.1.6),
- markdown (>= 1.13),
+ markdown (>= 2.0),
  readxl (>= 1.4.5),
- DT (>= 0.33),
+ DT (>= 0.34),
  knitr (>= 1.50)
 URL: https://tzerk.github.io/RLumShiny/
 BugReports: https://github.com/tzerk/RLumShiny/issues
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3
diff --git a/LICENSE b/LICENSE
diff --git a/NEWS.Rmd b/NEWS.Rmd
@@ -5,6 +5,8 @@ output: github_document
 
 ## Current development version (`r Sys.Date()`)
 
+**This package version requires R > 4.4!**
+
 * New application to plot a dose-response curve for luminescence data.
   Base function: `Luminescence::plot_DoseResponseCurve()`.
   Keyword for `app_RLum()`: 'doseresponsecurve'.
diff --git a/NEWS.md b/NEWS.md
@@ -1,7 +1,9 @@
 
 <!-- NEWS.md was auto-generated by NEWS.Rmd. Please DO NOT edit by hand!-->
 
-## Current development version (2025-11-12)
+## Current development version (2025-12-15)
+
+**This package version requires R \> 4.4!**
 
 - New application to plot a dose-response curve for luminescence data.
   Base function: `Luminescence::plot_DoseResponseCurve()`. Keyword for
diff --git a/inst/shiny/KDE/server.R b/inst/shiny/KDE/server.R
@@ -19,7 +19,7 @@ function(input, output, session) {
       return(NULL) # if no file was uploaded return NULL
 
     values$data_primary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
-    if (ncol(values$data_primary > 2))
+    if (ncol(values$data_primary) > 2)
       values$data_primary <- values$data_primary[, 1:2]
   })
 
@@ -31,7 +31,7 @@ function(input, output, session) {
       return(NULL) # if no file was uploaded return NULL
 
     values$data_secondary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
-    if (ncol(values$data_secondary > 2))
+    if (ncol(values$data_secondary) > 2)
       values$data_secondary <- values$data_secondary[, 1:2]
   })
 
@@ -141,7 +141,7 @@ function(input, output, session) {
       summary = summary,
       summary.pos = input$sumpos,
       summary.method = input$summary.method,
-      bw = input$bw,
+      bw = as.numeric(input$bw),
       xlim = input$xlim,
       col = c(color, color2))
   })
diff --git a/inst/shiny/abanico/server.R b/inst/shiny/abanico/server.R
@@ -91,7 +91,7 @@ function(input, output, session) {
       return(NULL) # if no file was uploaded return NULL
 
     values$data_primary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
-    if (ncol(values$data_primary > 2))
+    if (ncol(values$data_primary) > 2)
       values$data_primary <- values$data_primary[, 1:2]
   })
 
@@ -103,7 +103,7 @@ function(input, output, session) {
       return(NULL) # if no file was uploaded return NULL
 
     values$data_secondary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
-    if (ncol(values$data_secondary > 2))
+    if (ncol(values$data_secondary) > 2)
       values$data_secondary <- values$data_secondary[, 1:2]
   })
 
diff --git a/inst/shiny/cosmicdose/server.R b/inst/shiny/cosmicdose/server.R
@@ -34,26 +34,26 @@ function(input, output, session) {
     }
 
     # return data frame
-    d <- data.frame(Lat = LatLong[1], Long = LatLong[2], tip = "Site")
-    return(d)
+    data.frame(Lat = LatLong[1], Long = LatLong[2])
   })
 
   # render OpenStreetMap
   output$map <- leaflet::renderLeaflet({
     # refresh plot on button press
     input$refresh
 
-    m <- leaflet::leaflet() |>
+    coords <- coords()
+    leaflet::leaflet() |>
       leaflet::addTiles() |>
-      leaflet::setView(coords()$Long, coords()$Lat, zoom = 17) |>
-      leaflet::addPopups(coords()$Long, coords()$Lat, 'Sampling site')
+      leaflet::setView(coords$Long, coords$Lat, zoom = 17) |>
+      leaflet::addPopups(coords$Long, coords$Lat, 'Sampling site')
   })
 
 
   # get results from calc_CosmicDoseRate() function
   get_results<- reactive({
     # get coordinates
-    coords<- as.vector(coords()[,1:2])
+    coords<- coords()
     lat <- coords$Lat
     long <- coords$Long
 
diff --git a/inst/shiny/cosmicdose/ui.R b/inst/shiny/cosmicdose/ui.R
@@ -11,7 +11,7 @@ function(request) {
 
   fluidPage(
     titlePanel("Cosmic Dose", windowTitle = "RLumShiny - Cosmic Dose"),
-    includeCSS("./www/style.css"),
+
     fluidRow(
       column(width = 3,
              div(align = "center", span(class="label label-info", "Site")),
@@ -34,23 +34,23 @@ function(request) {
                                          numericInput(inputId = "degN_1", label = p(class="h","N: \uB0"), value = 50, step = 1),
                                          numericInput(inputId = "degE_1", label = p(class="h","E: \uB0"), value = 6, step = 1)
                                   ),
-                                  column(width = 4, offset = 2,
+                                  column(width = 6, offset = 1,
                                          numericInput(inputId = "decMinN", label = p(class="h","Decimal \u27"), value = 55.61417, step = 0.000001),
                                          numericInput(inputId = "decMinE", label = p(class="h","Decimal \u27"), value = 56.24717, step = 0.000001)
                                   )
                                 )
                ),
                conditionalPanel(condition = "input.coords == 'degMinSec'",
                                 fluidRow(
-                                  column(width = 3, offset = 0,
+                                  column(width = 4,
                                          numericInput(inputId = "degN_2", label = p(class="h","N: \uB0"), value = 50, step = 1),
                                          numericInput(inputId = "degE_2", label = p(class="h","E: \uB0"), value = 6, step = 1)
                                   ),
-                                  column(width = 3,  offset = 1,
+                                  column(width = 4,
                                          numericInput(inputId = "minN", label = p(class="h","\u27"), value = 55, step = 1),
                                          numericInput(inputId = "minE", label = p(class="h","\u27"), value = 56, step = 1)
                                   ),
-                                  column(width = 3, offset = 1,
+                                  column(width = 4,
                                          numericInput(inputId = "secN", label = p(class="h","\u27\u27"), value = 36.85, step = 0.01),
                                          numericInput(inputId = "secE", label = p(class="h","\u27\u27"), value = 14.83, step = 0.01)
                                   )
diff --git a/inst/shiny/doserecovery/server.R b/inst/shiny/doserecovery/server.R
@@ -16,24 +16,24 @@ function(input, output, session) {
   # check and read in file (DATA SET 1)
   observeEvent(input$file1, {
     inFile<- input$file1
-    
-    if(is.null(inFile)) 
+
+    if(is.null(inFile))
       return(NULL) # if no file was uploaded return NULL
 
     values$data_primary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
-    if (ncol(values$data_primary > 2))
+    if (ncol(values$data_primary) > 2)
       values$data_primary <- values$data_primary[, 1:2]
   })
 
   # check and read in file (DATA SET 2)
   observeEvent(input$file2, {
     inFile<- input$file2
-    
-    if(is.null(inFile)) 
+
+    if(is.null(inFile))
       return(NULL) # if no file was uploaded return NULL
 
     values$data_secondary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
-    if (ncol(values$data_secondary > 2))
+    if (ncol(values$data_secondary) > 2)
       values$data_secondary <- values$data_secondary[, 1:2]
   })
 
@@ -83,7 +83,7 @@ function(input, output, session) {
     n <- max(sapply(data, nrow))
 
     sliderInput(inputId = "xlim", label = "Range x-axis",
-                min = 0, max = n*2,
+                min = 0, max = n + 1,
                 value = c(0, n) + 0.5)
   })
 
diff --git a/inst/shiny/doseresponsecurve/server.R b/inst/shiny/doseresponsecurve/server.R
@@ -26,6 +26,8 @@ function(input, output, session) {
       return(NULL) # if no file was uploaded return NULL
 
     values$data_primary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
+    if (ncol(values$data_primary) > 4)
+      values$data_primary <- values$data_primary[, 1:4]
   })
 
   observeEvent(input$table_in_primary, {
diff --git a/inst/shiny/fading/server.R b/inst/shiny/fading/server.R
@@ -17,8 +17,8 @@ function(input, output, session) {
   # check and read in file (DATA SET 1)
   observeEvent(input$file, {
     inFile<- input$file
-    
-    if(is.null(inFile)) 
+
+    if(is.null(inFile))
       return(NULL) # if no file was uploaded return NULL
 
     removeNotification("invalid_input")
@@ -30,7 +30,7 @@ function(input, output, session) {
                        duration = NULL)
       return(NULL)
     }
-    if (ncol(values$data_primary > 3))
+    if (ncol(values$data_primary) > 3)
       values$data_primary <- values$data_primary[, 1:3]
   })
 
@@ -94,7 +94,9 @@ function(input, output, session) {
       n.MC = 1000
     )
 
-    values$results_corr <- try(do.call(calc_FadingCorr, values$args_corr))
+    res <- tryNotify(do.call(calc_FadingCorr, values$args_corr))
+    if (inherits(res, "RLum.Results"))
+      values$results_corr <- res
   })
 
   observe({
@@ -146,7 +148,7 @@ function(input, output, session) {
     rho <- get_RLum(values$results, "rho_prime")
 
     HTML(paste0(
-        tags$hr(), 
+        tags$hr(),
         tags$b("g-value: "), signif(gval$FIT, 3), " &plusmn; ", signif(gval$SD, 3), " %/decade", tags$br(),
         tags$b("g-value"), tags$sub("2days"), ": ", signif(gval$G_VALUE_2DAYS, 3), " &plusmn; ", signif(gval$G_VALUE_2DAYS.ERROR, 3), " %/decade", tags$br(),
         tags$b("t"), tags$sub("c"), ": ", gval$TC, tags$br(),
diff --git a/inst/shiny/fastratio/server.R b/inst/shiny/fastratio/server.R
@@ -27,7 +27,7 @@ function(input, output, session) {
                                                 data.table = FALSE)
                                   )
     if (inherits(values$data_primary, "data.frame") &&
-        ncol(values$data_primary > 2))
+        ncol(values$data_primary) > 2)
       values$data_primary <- values$data_primary[, 1:2]
 
     updateSliderInput(session, "deadchannels", value = c(1, nrow(values$data_primary)), max = nrow(values$data_primary))
diff --git a/inst/shiny/finitemixture/server.R b/inst/shiny/finitemixture/server.R
@@ -24,7 +24,7 @@ function(input, output, session) {
       return(NULL) # if no file was uploaded return NULL
 
     values$data_primary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
-    if (ncol(values$data_primary > 2))
+    if (ncol(values$data_primary) > 2)
       values$data_primary <- values$data_primary[, 1:2]
   })
 
diff --git a/inst/shiny/histogram/server.R b/inst/shiny/histogram/server.R
@@ -13,12 +13,12 @@ function(input, output, session) {
   # check and read in file (DATA SET 1)
   observeEvent(input$file1, {
     inFile<- input$file1
-    
-    if(is.null(inFile)) 
+
+    if(is.null(inFile))
       return(NULL) # if no file was uploaded return NULL
-    
-    values$data <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath 
-    if (ncol(values$data > 2))
+
+    values$data <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
+    if (ncol(values$data) > 2)
       values$data <- values$data[, 1:2]
   })
 
diff --git a/inst/shiny/huntley2006/server.R b/inst/shiny/huntley2006/server.R
@@ -24,7 +24,7 @@ function(input, output, session) {
       return(NULL) # if no file was uploaded return NULL
 
     values$data_primary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
-    if (ncol(values$data_primary > 3))
+    if (ncol(values$data_primary) > 3)
       values$data_primary <- values$data_primary[, 1:3]
   })
 
diff --git a/inst/shiny/lmcurve/server.R b/inst/shiny/lmcurve/server.R
@@ -26,7 +26,7 @@ function(input, output, session) {
       return(NULL) # if no file was uploaded return NULL
 
     values$data_primary <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
-    if (ncol(values$data_primary > 2))
+    if (ncol(values$data_primary) > 2)
       values$data_primary <- values$data_primary[, 1:2]
   })
 
@@ -37,7 +37,7 @@ function(input, output, session) {
       return(NULL) # if no file was uploaded return NULL
 
     values$data_bg <- fread(file = inFile$datapath, data.table = FALSE) # inFile[1] contains filepath
-    if (ncol(values$data_bg > 2))
+    if (ncol(values$data_bg) > 2)
       values$data_bg <- values$data_bg[, 1:2]
   })
 
diff --git a/inst/shiny/radialplot/server.R b/inst/shiny/radialplot/server.R
diff --git a/inst/shiny/transformCW/server.R b/inst/shiny/transformCW/server.R
diff --git a/man/app_RLum.Rd b/man/app_RLum.Rd
