Merge pull request #57 from aberHRML/devel

v2.6.4

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

@@ -18,7 +18,7 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: macOS-latest,   r: 'release'}
+          - {os: macos-latest,   r: 'release'}
           - {os: windows-latest, r: 'release'}
           - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
           - {os: ubuntu-latest,   r: 'release'}
@@ -29,7 +29,7 @@ jobs:
       R_KEEP_PKG_SOURCE: yes
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
 
       - uses: r-lib/actions/setup-pandoc@v2
 

.github/workflows/pkgdown.yaml

@@ -19,8 +19,10 @@ jobs:
       group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    permissions:
+      contents: write
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
 
       - uses: r-lib/actions/setup-pandoc@v2
 
@@ -39,7 +41,7 @@ jobs:
 
       - name: Deploy to GitHub pages 🚀
         if: github.event_name != 'pull_request'
-        uses: JamesIves/[email protected].4
+        uses: JamesIves/github-pages-deploy-action@v4.4.1
         with:
           clean: false
           branch: gh-pages

.github/workflows/test-coverage.yaml

@@ -15,7 +15,7 @@ jobs:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
 
       - uses: r-lib/actions/setup-r@v2
         with:
@@ -27,5 +27,24 @@ jobs:
           needs: coverage
 
       - name: Test coverage
-        run: covr::codecov(quiet = FALSE)
+        run: |
+          covr::codecov(
+            quiet = FALSE,
+            clean = FALSE,
+            install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package")
+          )
         shell: Rscript {0}
+
+      - name: Show testthat output
+        if: always()
+        run: |
+          ## --------------------------------------------------------------------
+          find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload test results
+        if: failure()
+        uses: actions/upload-artifact@v3
+        with:
+          name: coverage-test-failures
+          path: ${{ runner.temp }}/package

DESCRIPTION

@@ -1,10 +1,10 @@
 Package: binneR
 Title: Spectral Processing for High Resolution Flow Infusion Mass Spectrometry
-Version: 2.6.3
+Version: 2.6.4
 Authors@R: person("Jasen", "Finch", email = "[email protected]", role = c("aut", "cre"))
 Description: A spectral binning approach for flow infusion electrospray high resolution mass spectrometry (FIE-HRMS) metabolome fingerprinting data. The methodology for this approach is outlined in Finch et al. (2022) <doi:10.1007/s11306-022-01923-6>.
 biocViews: MassSpectrometry, Metabolomics
-URL: https://aberhrml.github.io/binneR/
+URL: https://aberhrml.github.io/binneR/, http://aberhrml.github.io/binneR/
 BugReports: https://github.com/aberHRML/binneR/issues
 Depends: R (>= 3.5)
 Imports: 
@@ -26,7 +26,7 @@ Imports:
     furrr
 License: GPL-3
 Encoding: UTF-8
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3
 Collate: allGenerics.R allClasses.R binneRlyse.R
     binParameters.R spectralBinning-method.R 
     show-method.R get.R calc.R readFiles.R

NEWS.md

@@ -1,3 +1,7 @@
+# binneR 2.6.4
+
+* Ensure that duplicated files are not aggregated during spectral binning.
+
 # binneR 2.6.3
 
 * Fix the calculation of quartiles in [`binneR::plotTIC`](https://aberhrml.github.io/binneR/reference/plotTIC.html).  

R/binneR.R

@@ -31,5 +31,6 @@ globalVariables(c('.',
 									'centrality',
 									'Purity',
 									'Centrality',
-									'FileName'
+									'FileName',
+									'idx'
 ))

R/calc.R

@@ -1,7 +1,7 @@
 
 calcBinList <- function(pks){
   bins <- pks %>%
-    group_by(fileName,polarity,scan,bin) %>%
+    group_by(idx,fileName,polarity,scan,bin) %>%
     summarise(intensity = sum(intensity),
               .groups = 'drop') %>%
     group_by(polarity,bin) %>%
@@ -16,7 +16,8 @@ calcBinMeasures <- function(pks,cls){
   dp <- binnerDP()
 
   binMeasures <- pks %>%
-    group_by_at(vars(all_of(c('fileName',
+    group_by_at(vars(all_of(c('idx',
+    																										'fileName',
                               cls,
                               'polarity',
                               'bin')))) %>%

R/detect.R

@@ -16,42 +16,35 @@
 detectInfusionScans <- function(files, 
 																thresh = 0.5){
 
+	idx <- tibble(
+		Sample = files
+	) %>% 
+		rowid_to_column(var = 'idx')
+
 	ms <- files %>%
 		future_map(~{
 			ms <- .x %>%
 				openMSfile()
 
 			file_header <- ms %>%
-				header()
+				header() %>% 
+				as_tibble()
 
 			return(file_header)
 		}) %>%
-		set_names(files)
+		set_names(idx$idx) %>% 
+		bind_rows(.id = 'idx') %>%
+		mutate(
+			idx = as.numeric(idx)
+		) %>% 
+		left_join(idx,
+												by = 'idx',
+												relationship = 'many-to-many')
 
-	hd <- ms %>%
-		bind_rows(.id = 'Sample') %>%
-		as_tibble() %>%
-		select(Sample,seqNum,acquisitionNum,polarity,totIonCurrent,filterString) %>%
-		split(.$polarity) %>%
-		map(~{
-			d <- .
-			d %>%
-				split(.$Sample) %>%
-				map(~{
-					a <- .
-					a %>%
-						split(.$filterString) %>%
-						map(~{
-							b <- .
-							b %>%
-								mutate(acquisitionNum = seq_len(nrow(.)))
-						}) %>%
-						bind_rows()
-				}) %>%
-				bind_rows() %>%
-				select(Sample,acquisitionNum,polarity,totIonCurrent,filterString)
-		}) %>%
-		bind_rows() %>%
+	hd <-  ms %>%
+		select(idx,seqNum,acquisitionNum,polarity,totIonCurrent,filterString) %>%
+		group_by(idx,polarity,filterString) %>% 
+		mutate(acquisitionNum = seq_len(n())) %>% 
 		group_by(acquisitionNum) %>%
 		summarise(totIonCurrent = mean(totIonCurrent))
 

R/get.R

@@ -59,11 +59,19 @@ getFile <- function(file,scans){
 
 getPeaks <- function(files,scans){
 
+	idx <- tibble(
+		fileName = files
+	) %>% 
+		rowid_to_column(var = 'idx')
+
 	dp <- binnerDP()
 
 	pks <- future_map(files,getFile,scans = scans) %>%
-		set_names(files) %>%
-		bind_rows(.id = 'fileName') %>%
+		set_names(idx$idx) %>% 
+		bind_rows(.id = 'idx') %>%
+		mutate(idx = as.numeric(idx)) %>% 
+		left_join(idx,
+												by = 'idx') %>% 
 		mutate(fileName = basename(fileName),
 									mz = round(mz,5),bin = round(mz,dp))
 	return(pks)
@@ -73,15 +81,26 @@ getPeaks <- function(files,scans){
 
 getHeaders <- function(files){
 
+	idx <- tibble(
+		FileName = files
+	) %>% 
+		rowid_to_column(var = 'idx')
+
 	available_header_temps <- availableHeaderTemps(files)
 
 	file_headers <- available_header_temps %>% 
 		future_map(readRDS)
 
 	file_headers <- file_headers %>%
-		set_names(files) %>%
-		bind_rows(.id = 'FileName') %>%
-		select(FileName,acquisitionNum,totIonCurrent,polarity,filterString)
+		set_names(idx$idx) %>% 
+		bind_rows(.id = 'idx') %>%
+		mutate(
+			idx = as.numeric(idx)
+		) %>% 
+		left_join(idx,
+												by = 'idx') %>% 
+		select(idx,FileName,acquisitionNum,totIonCurrent,polarity,filterString) %>% 
+		as_tibble()
 
 	return(file_headers)
 }

R/plot.R

@@ -128,30 +128,14 @@ setMethod('plotChromatogram',signature = 'Binalysis',
 						scans <- x %>%
 							scans()
 						chromatograms <- chromatograms %>%
-							dplyr::select(FileName,
+							select(idx,
+																					FileName,
 														acquisitionNum,
 														totIonCurrent,
 														polarity,
 														filterString) %>%
-							split(.$polarity) %>%
-							map(~{
-								f <- .
-								f %>% 
-									split(.$FileName) %>%
-									map(~{
-										a <- .
-										a %>%
-											split(.$filterString) %>%
-											map(~{
-												b <- .
-												b %>%
-													mutate(acquisitionNum = seq_len(nrow(.)))
-											}) %>%
-											bind_rows()
-									}) %>%
-									bind_rows()
-							}) %>% 
-							bind_rows() %>%
+							group_by(polarity,idx,filterString) %>% 
+							mutate(acquisitionNum = seq_len(n())) %>% 
 							group_by(polarity,acquisitionNum) %>%
 							summarise(totIonCurrent = mean(totIonCurrent))
 
@@ -182,19 +166,8 @@ plotChromFromFile <- function(files, scans = c()){
 			openMSfile(.,backend = 'pwiz') %>%
 				header() %>%
 				select(acquisitionNum,totIonCurrent,polarity,filterString) %>%
-				split(.$polarity) %>%
-				map(~{
-					a <- .
-					a %>%
-						split(.$filterString) %>%
-						map(~{
-							b <- .
-							b %>%
-								mutate(acquisitionNum = seq_len(nrow(.)))
-						}) %>%
-						bind_rows()
-				}) %>%
-				bind_rows() %>%
+				group_by(polarity,filterString) %>% 
+				mutate(acquisitionNum = seq_len(n())) %>%
 				group_by(polarity,acquisitionNum) %>%
 				summarise(totIonCurrent = mean(totIonCurrent))
 		}) %>%

R/spectralBinning-method.R

@@ -34,30 +34,34 @@ setMethod("spectralBinning",
 								mutate(class = NA)
 						}
 
+						classes <- classes %>% 
+							rowid_to_column(var = 'idx')
+
 						n_scans <- nScans(x)
 
 						if (isTRUE(verbose)) message('Averaging intensities across scans')
 						binned_data <- pks %>%
-							split(.$fileName) %>%
+							split(.$idx) %>%
 							future_map(~{
 								.x %>%
-									group_by(fileName,polarity,bin,scan) %>%
+									group_by(idx,fileName,polarity,bin,scan) %>%
 									summarise(intensity = sum(intensity),
 														.groups = 'drop')	%>%
-									group_by(fileName,polarity,bin) %>%
+									group_by(idx,fileName,polarity,bin) %>%
 									summarise(intensity = sum(intensity)/n_scans,
 														.groups = 'drop')
 							}) %>%
 							bind_rows()
 
 						pks <- pks %>%
-							left_join(classes,by = "fileName") %>%
-							split(.$fileName) %>%
+							left_join(classes,by = c("idx",'fileName')) %>%
+							split(.$idx) %>%
 							future_map(~{
 								.x %>%
 									group_by_at(
 										vars(
-											all_of(c('fileName',
+											all_of(c('idx',
+																				'fileName',
 															 cls,
 															 'polarity','mz','bin')))) %>%
 									summarise(intensity = sum(intensity)/n_scans,
@@ -71,10 +75,10 @@ setMethod("spectralBinning",
 
 						if (isTRUE(verbose)) message('Calculating accurate m/z')
 						accurate_mz <- pks %>%
-							group_by_at(vars(all_of(c('fileName',cls,'polarity','bin')))) %>%
+							group_by_at(vars(all_of(c('idx','fileName',cls,'polarity','bin')))) %>%
 							filter(intensity == max(intensity)) %>%
 							arrange(bin) %>%
-							left_join(bin_measures,by = c('fileName',cls, "polarity", "bin")) %>%
+							left_join(bin_measures,by = c('idx','fileName',cls, "polarity", "bin")) %>%
 							ungroup()
 
 						mz <- accurate_mz %>%
@@ -94,7 +98,7 @@ setMethod("spectralBinning",
 							future_map(~{
 								.x %>%
 									spread(mz,intensity,fill = 0) %>%
-									select(-fileName,-polarity)
+									select(-idx,-fileName,-polarity)
 							})
 
 						if (isTRUE(verbose)) message('Gathering file headers')

tests/testthat/test-binneRlyse.R

@@ -43,7 +43,7 @@ test_that('binneRlyse works',{
 
 	expect_identical(class(ad),c('tbl_df','tbl','data.frame'))
 	expect_equal(nrow(ad),1896)
-	expect_equal(ncol(ad),8)
+	expect_equal(ncol(ad),9)
 })
 
 test_that('BinParameters class show method works',{

tests/testthat/test-getPeaks.R

@@ -14,7 +14,7 @@ test_that('getPeaks works single core',{
 	pks <- getPeaks(file,5:13)
 
 	expect_s3_class(pks,'tbl_df')
-	expect_equal(ncol(pks),6)
+	expect_equal(ncol(pks),7)
 })
 
 test_that('getHeaders works single core',{