Merge branch 'main' of https://github.com/nickmckay/lipdR

.github/workflows/R-CMD-check.yaml

@@ -8,6 +8,8 @@ on:
 
 name: R-CMD-check
 
+permissions: read-all
+
 jobs:
   R-CMD-check:
     runs-on: ${{ matrix.config.os }}
@@ -29,7 +31,7 @@ jobs:
       R_KEEP_PKG_SOURCE: yes
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-pandoc@v2
 
@@ -47,3 +49,4 @@ jobs:
       - uses: r-lib/actions/check-r-package@v2
         with:
           upload-snapshots: true
+          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'

.github/workflows/pkgdown.yaml

@@ -9,7 +9,9 @@ on:
     types: [published]
   workflow_dispatch:
 
-name: pkgdown
+name: pkgdown.yaml
+
+permissions: read-all
 
 jobs:
   pkgdown:

DESCRIPTION

@@ -55,6 +55,5 @@ Suggests:
     rmarkdown,
     testthat,
     googlesheets4
-Remotes: 
 VignetteBuilder: knitr
 LazyData: true

R/changelog.R

@@ -849,7 +849,7 @@ updateChangelog <- function(L,
       vers[[1,1]] <- lastVers[[1,1]]+1
       vers[[1,2:3]] <- 0
     }else{
-      vers <- as.numeric_version(version)
+      vers <- as.numeric_version(as.character(version))
     }
   }
 
@@ -902,7 +902,7 @@ getChangelog <- function(L,version = "newest"){
     wv <- which(allvers == min(allvers))
     if(length(wv)>1){wv <- length(allvers)}
   }else{#try to match the version
-    wv <- which(allvers == as.numeric_version(version))
+    wv <- which(allvers == as.numeric_version(as.character(version)))
     if(length(wv)>1){stop("multiple version matches")}
   }
 
@@ -1012,7 +1012,7 @@ createMarkdownChangelog <- function(L){
 
 createSingleMarkdownChangelog<- function(scl){
   #don;t show fourth digit version
-  printvers <- as.numeric_version(scl$version)[1,1:3]
+  printvers <- as.numeric_version(as.character(scl$version)[1,1:3])
   scl$version <- NULL
 
   clmd <-  glue::glue("### Version: {printvers} \n") %>%

R/inCompilation.R

@@ -0,0 +1,50 @@
+# checkfun <- function(cn,cv,compName,compVers){
+#   if(is.list(cv)){
+#     anycvm <- purrr::map_lgl(cv,function(x){any(x == compVers)})
+#   }else{
+#     cvm <- t(as.matrix(cv))
+#     anycvm <- apply(cvm,1,function(x){any(x == compVers)})
+#   }
+#
+#   # old code here:
+#   # bothMatch <- (cn==compName & purrr::map_lgl(cv,function(x){any(x == compVers)}))
+#   bothMatch <- (cn==compName & anycvm)
+#
+#   #put NAs back in for compName
+#   incn <- which(is.na(cn))
+#   bothMatch[incn] <- NA
+#   out <- data.frame(bothMatch)
+#   out <- setNames(out, createTSid())
+#   return(out)
+# }
+#
+#
+# inThisCompilation <- function(TS,compName,compVers){
+#   TS <- as.lipdTs(TS)
+#   allNames <- sort(unique(unlist(sapply(TS,names))))#get all names in TS
+#   #get all the names of the compilations
+#   allComps <- allNames[grepl(pattern = "inCompilationBeta[0-9]+_compilationName",allNames)]
+#   allVers <- allNames[grepl(pattern = "inCompilationBeta[0-9]+_compilationVersion",allNames)]
+#
+#   if(length(allComps) == 0){
+#     return(matrix(NA,nrow = length(TS)))
+#
+#   }
+#   allCompNames <- vector(mode = "list",length=length(allComps))
+#   allCompVersions <- vector(mode = "list",length=length(allComps))
+#
+#   #get all the data
+#   for(i in 1:length(allComps)){
+#     allCompNames[[i]] <- pullTsVariable(TS,allComps[i])
+#     allCompVersions[[i]] <- pullTsVariable(TS,allVers[i])
+#   }
+#
+#   #check for each compilation
+#   compCheck <- purrr::map2_dfc(allCompNames,allCompVersions,checkfun,compName,compVers)
+#
+#   #check across rows
+#   unify <- as.matrix(apply(compCheck,1,any))
+#
+#   return(unify)
+#
+# }

R/neotoma2lipd.R

@@ -375,10 +375,11 @@ getPaleoDataNeotoma2 <- function(site){
 #'
 #' @examples
 #'
+#' \dontrun{
 #' B <- neotoma2::get_sites(sitename = "Bambili 2")
 #' D <- neotoma2::get_downloads(B)
 #' L <- neotoma2lipd(D)
-#'
+#' }
 neotoma2lipd <- function(site){
 
   if (!requireNamespace("neotoma2", quietly = TRUE)) {

vignettes/lipd2neotoma.Rmd

@@ -19,9 +19,10 @@ The example file (site) used is Bambili 2. Bambili 2 is loaded using Neotoma and
 first translated to LiPD. This makes for a simple use case
 
 ```{r}
-B <- neotoma2::get_sites(sitename = "Bambili 2")
-D <- neotoma2::get_downloads(B)
-L <- lipdR:::neotoma2lipd(D)
+#Neotoma2 down as of 7/8/24
+#B <- neotoma2::get_sites(sitename = "Bambili 2")
+#D <- neotoma2::get_downloads(B)
+#L <- lipdR:::neotoma2lipd(D)
 
-summary(L)
+#summary(L)
 ```