🩹 Fix issues reported by CRAN (#8)

This PR addresses recent warnings in the building of the package as reported on [CRAN](https://cran.r-project.org/web/packages/TIMP/index.html).

### Change summary
Relevant changes:
- ♻️ Refactor c function to conform to modern standards
- Fixes: `(warning: a function definition without a prototype is
deprecated in all versions of C and is not supported in C2x
[-Wdeprecated-non-prototype])`
- ♻️Uses is(x,"name") instead of class(x)=="name" comparison
- Other changes:
- 🛡️Update URLs from http to https
- 📚Update DOI urls to use \doi command
- 🧹Remove unused NEWS file

.Rbuildignore

@@ -1,9 +1,8 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
-.git
-.gitignore
-^\.github$
-LICENSE.md
+^\.git
+^\.gitignore
+^\.vscode
+^\.github
 README.md
-CONTRIBUTING.md
-git-workflow.txt
+Rplots.pdf

.github/workflows/r.yml

@@ -10,6 +10,8 @@
 # https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions
 
 on:
+  schedule:
+    - cron: '30 20 1 1-12 *'
   push:
     branches:
       - main
@@ -33,63 +35,30 @@ jobs:
         config:
           - {os: windows-latest, r: 'release'}
           - {os: macOS-latest, r: 'release'}
-          - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
-          - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
+          - {os: ubuntu-latest, r: 'release'}
+          - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'}
 
     env:
       R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
       RSPM: ${{ matrix.config.rspm }}
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
 
-      - uses: r-lib/actions/setup-r@v1
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
         with:
           r-version: ${{ matrix.config.r }}
+          http-user-agent: ${{ matrix.config.http-user-agent }}
+          use-public-rspm: true
 
-      - uses: r-lib/actions/setup-pandoc@v1
-
-      - name: Query dependencies
-        run: |
-          install.packages('remotes')
-          saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
-          writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version")
-        shell: Rscript {0}
-
-      - name: Cache R packages
-        if: runner.os != 'Windows'
-        uses: actions/cache@v2
+      - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          path: ${{ env.R_LIBS_USER }}
-          key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}
-          restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-
-
-      - name: Install system dependencies
-        if: runner.os == 'Linux'
-        run: |
-          while read -r cmd
-          do
-            eval sudo $cmd
-          done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))')
-
-      - name: Install dependencies
-        run: |
-          remotes::install_deps(dependencies = TRUE)
-          remotes::install_cran("rcmdcheck")
-        shell: Rscript {0}
-
-      - name: Check
-        env:
-          _R_CHECK_CRAN_INCOMING_REMOTE_: false
-        run: |
-          options(crayon.enabled = TRUE)
-          rcmdcheck::rcmdcheck(path = ".", args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check")
-        shell: Rscript {0}
+          extra-packages: any::rcmdcheck
+          needs: check
 
-      - name: Upload check results
-        if: failure()
-        uses: actions/upload-artifact@main
+      - uses: r-lib/actions/check-r-package@v2
         with:
-          name: ${{ runner.os }}-r${{ matrix.config.r }}-results
-          path: check
+          upload-snapshots: true

.gitignore

@@ -20,6 +20,9 @@
 # RStudio files
 .Rproj.user/
 
+# VScode files
+.vscode/
+
 # produced vignettes
 vignettes/*.html
 vignettes/*.pdf
@@ -47,3 +50,9 @@ po/*~
 # build files
 *.o
 *.dll
+
+# Files created by scripts
+_summary.ps
+_selectedtraces.ps
+_paramEst.txt
+Rplots.pdf

DESCRIPTION

@@ -12,7 +12,7 @@ Description: A problem-solving environment (PSE) for fitting
          and chemistry experiments; has been extensively applied to
          time-resolved spectroscopy and FLIM-FRET data.
 License: GPL (>= 2)
-URL: http://timp.r-forge.r-project.org/ http://timpgui.org/
+URL: https://github.com/glotaran/TIMP
 
 
 

R/getResidRet.R

@@ -1,12 +1,12 @@
-"getResidRet" <- 
+"getResidRet" <-
   function(X, psi, rlist, returnX, finished, nnls, algorithm = "nls",
            nnlscrit=list(), group=0)
   {
     if(returnX)  return(as.vector(X))
     if(finished) {
       rlist$QR <- qr(X)
-      rlist$psi <- psi 
-      return(rlist) 
+      rlist$psi <- psi
+      return(rlist)
     }
     if(!nnls) { ## just varpro
       qty.temp <- qr.qty( qr(X) , psi)
@@ -20,12 +20,12 @@
       }
       else {
         sol <- try(nnls(A = X, b = psi))
-        if(class(sol) == "try-error")
+        if(is(sol, "try-error"))
           cp <- rep(0, ncol(X))
         else
           cp <- coef(sol)
       }
-      if(algorithm != "optim") 
+      if(algorithm != "optim")
         retval <- psi - X %*% cp
       else
         retval <-  sum((psi - X %*% cp)^2)

R/getResults.R

@@ -1,12 +1,12 @@
 ## all of these functions act on the output of the fitModel function to
 ## return various results
-getC <- function(result, dataset=1, file=""){ 
+getC <- function(result, dataset=1, file=""){
   C<-getX(result, dataset=dataset, file="",lreturnC=TRUE)
   if(file!="")
     write.table(C, file=paste(file,
                         "_C_dataset_", dataset, ".txt", sep=""),
                 row.names = result$currModel@modellist[[dataset]]@x,
-                quote=FALSE) 
+                quote=FALSE)
   C
 }
 getCLPList <- function(result, getclperr = FALSE, file="") {
@@ -16,26 +16,26 @@ getCLPList <- function(result, getclperr = FALSE, file="") {
       write.table(specList[[i]], file=paste(file,
                                    "_spec_dataset_", i, ".txt", sep=""),
                   row.names = result$currModel@modellist[[i]]@x2,
-                  quote=FALSE) 
+                  quote=FALSE)
   specList
 }
-getCLP <- function(result, getclperr = FALSE, dataset=1, file=""){ 
+getCLP <- function(result, getclperr = FALSE, dataset=1, file=""){
   spec <- getSpecList(result$currModel, result$currTheta, getclperr)[[dataset]]
   if(file!="")
     write.table(spec, file=paste(file,
                         "_spec_dataset_", dataset, ".txt", sep=""),
                 row.names = result$currModel@modellist[[dataset]]@x2,
-                quote=FALSE) 
+                quote=FALSE)
   spec
 }
 getData <- function(result, dataset = 1, weighted = FALSE) {
-  if(weighted)   
+  if(weighted)
     datamat <- result$currModel@data[[dataset]]@psi.weight
   else
     datamat <- result$currModel@data[[dataset]]@psi.df
   datamat
 }
-getDAS <- function(result, getclperr = FALSE, dataset=1, file=""){ 
+getDAS <- function(result, getclperr = FALSE, dataset=1, file=""){
   spec <- getSpecList(result$currModel, result$currTheta, getclperr)[[dataset]]
   if((result$currModel@modellist[[dataset]]@fullk==TRUE)||
   (result$currModel@modellist[[dataset]]@seqmod==TRUE))
@@ -47,11 +47,11 @@ getDAS <- function(result, getclperr = FALSE, dataset=1, file=""){
     write.table(spec, file=paste(file,
                         "_DAS_dataset_", dataset, ".txt", sep=""),
                 row.names = result$currModel@modellist[[dataset]]@x2,
-                quote=FALSE) 
+                quote=FALSE)
   spec
 }
 getSVDData <- function(result, numsing = 2, dataset=1) {
-  datamat <- getData(result, dataset) 
+  datamat <- getData(result, dataset)
   doSVD(datamat, numsing, numsing)
 }
 getResiduals <- function(result, dataset = 1) {
@@ -61,45 +61,45 @@ getResiduals <- function(result, dataset = 1) {
   residmat
 }
 getSVDResiduals <- function(result, numsing = 2, dataset = 1) {
-  residmat <- getResiduals(result, dataset) 
+  residmat <- getResiduals(result, dataset)
   doSVD(residmat, numsing, numsing)
 }
 getTraces <- function(result, dataset=1, file="") {
-  fitted <- result$currModel@fit@resultlist[[dataset]]@fitted 
+  fitted <- result$currModel@fit@resultlist[[dataset]]@fitted
   tracesmat <- unlist(fitted)
   dim(tracesmat) <- c(length(fitted[[1]]), length(fitted) )
   if(file!="")
     write.table(tracesmat, file=paste(file,
                              "fit.txt", sep=""),
                 col.names = result$currModel@modellist[[dataset]]@x2,
                 row.names = result$currModel@modellist[[dataset]]@x,
-                quote=FALSE) 
+                quote=FALSE)
   tracesmat
 }
-getdim1 <- function(result, dataset=1) 
+getdim1 <- function(result, dataset=1)
   result$currModel@modellist[[dataset]]@x
-getdim2 <- function(result, dataset=1) 
+getdim2 <- function(result, dataset=1)
   result$currModel@modellist[[dataset]]@x2
 parEst <- function(result, param = "", dataset = NA, verbose = TRUE,
                    file = "", stderr=TRUE) {
   currTheta <- result$currTheta
   currModel <- result$currModel
   if(stderr && currModel@optlist[[1]]@sumnls) {
     stderr <- TRUE
-    if(class(currModel@fit@nlsres$onls) == "timp.nls.lm") {
-    currErr <- getThetaCl(sumnls(result)$coefficients[,2], currModel) 
+    if(is(currModel@fit@nlsres$onls, "timp.nls.lm")) {
+    currErr <- getThetaCl(sumnls(result)$coefficients[,2], currModel)
     } else {
-    currErr <- getThetaCl(sumnls(result)$parameters[,2], currModel) 
+    currErr <- getThetaCl(sumnls(result)$parameters[,2], currModel)
     }
   }
   else
     stderr <- FALSE
   reslist <- stderrlist <- list()
   if(param == "")
-    param <- slotNames(theta()) 
+    param <- slotNames(theta())
   if(is.na(dataset))
     dataset <- 1:length(currTheta)
-  
+
   for(nm in param) {
     for(j in dataset) {
       if(length( slot(currTheta[[j]], nm)) > 0) {
@@ -118,7 +118,7 @@ parEst <- function(result, param = "", dataset = NA, verbose = TRUE,
         }
         if(verbose) {
           cat("dataset ", j, ": ", toString(slot(currTheta[[j]], nm)),
-              "\n", sep="", file=file)   
+              "\n", sep="", file=file)
           if(stderr)
             cat("    standard errors: ",
                 toString(stderrlist[[nm]][[length(stderrlist[[nm]])]]),
@@ -135,8 +135,8 @@ stdErrTransform <- function(k, err) {
    errl <- log(err)
    for(i in 1:length(k)){
      	      b1 <- abs(exp(kl[i]+errl[i]) - exp(kl[i]))
-	      b2 <- abs(exp(kl[i]-errl[i]) - exp(kl[i])) 
-	      x[i] <- ifelse(b1>b2,b1,b2)              
+	      b2 <- abs(exp(kl[i]-errl[i]) - exp(kl[i]))
+	      x[i] <- ifelse(b1>b2,b1,b2)
         }
    x
 }

R/getStdErrClp.R

@@ -1,17 +1,17 @@
 "getStdErrClp" <- function(group,  multimodel, thetalist,
                            clpindepX, rlist, rawtheta) {
 
-  QR.temp <- rlist$QR 
+  QR.temp <- rlist$QR
   m <- multimodel@modellist
   dset <- group[[1]][2]
   clpind <- group[[1]][1]
   cp <- multimodel@fit@resultlist[[dset]]@cp[[clpind]]
   sigma_2 <- multimodel@fit@nlsres$sumonls$sigma^2
-  if(class(multimodel@fit@nlsres$onls) == "timp.nls") {
+  if(is(multimodel@fit@nlsres$onls, "timp.nls")) {
     R <- multimodel@fit@nlsres$onls$m$Rmat()
-    R_inv <- chol2inv(R) 
+    R_inv <- chol2inv(R)
   }
-  else{ 
+  else{
     R <- multimodel@fit@nlsres$onls$hessian
     R_inv <- solve(R)
   }
@@ -27,23 +27,23 @@
   assign("clpindepX", clpindepX, envir = numenv)
   assign("finished", FALSE, envir = numenv)
   assign("returnX", TRUE, envir = numenv)
-  if(m[[ dset ]]@clpdep) 
+  if(m[[ dset ]]@clpdep)
     s_e <- body(selectMethod("residPart", m[[ dset ]]@mod_type)@.Data)
   else s_e <- body(selectMethod("residPart", m[[ dset ]]@mod_type)@.Data)
-  X_gradient <- attr( numericDeriv(expr=s_e, rho = numenv, 
+  X_gradient <- attr( numericDeriv(expr=s_e, rho = numenv,
                                    theta = c("rawtheta")), "gradient")
-  dim(X_gradient) <- c(dim(QR.temp$qr),length(rawtheta)) 
-  G <- matrix(nrow=length(cp), ncol = length(rawtheta)) 
-  for(i in 1:length(rawtheta)) 
-    G[,i] <- X_pseudo %*%  ( as.matrix(X_gradient[,,i]) %*% cp) 
+  dim(X_gradient) <- c(dim(QR.temp$qr),length(rawtheta))
+  G <- matrix(nrow=length(cp), ncol = length(rawtheta))
+  for(i in 1:length(rawtheta))
+    G[,i] <- X_pseudo %*%  ( as.matrix(X_gradient[,,i]) %*% cp)
   G_R_inv <- G %*% R_inv
-  ## if A R = G, R^T A^T = G^T 
-  ## G R_inv R_inv^T G^T 
-  ## A A^T  
+  ## if A R = G, R^T A^T = G^T
+  ## G R_inv R_inv^T G^T
+  ## A A^T
   A_T <- solve(t(R), t(G))
-  Bloc1 <- tcrossprod(X_pseudo, X_pseudo) 
+  Bloc1 <- tcrossprod(X_pseudo, X_pseudo)
   std_err_clp <- sqrt( sigma_2 * diag(Bloc1 + crossprod(A_T, A_T)))
-  for (i in 1:length(group)) 
-    multimodel@fit@resultlist[[group[[i]][2]]]@std_err_clp[[group[[i]][1]]] <- std_err_clp 
-  multimodel 
+  for (i in 1:length(group))
+    multimodel@fit@resultlist[[group[[i]][2]]]@std_err_clp[[group[[i]][1]]] <- std_err_clp
+  multimodel
 }