meireles / spectrolab / 394

pending completion

Build # 394

Build Type

Pull #9

travis-ci

Committed by

web-flow

Commit Message

<a href="https://github.com/meireles/spectrolab/commit/<a class=hub.com/meireles/spectrolab/commit/<a class="double-link" href="https://git"><a class=hub.com/meireles/spectrolab/commit/<a class="double-link" href="https://git"><a class=hub.com/meireles/spectrolab/commit/<a class="double-link" href="https://git"><a class=hub.com/meireles/spectrolab/commit/2d31ae3e98f2c9a889b4d3335729518b5943b86e">2d31ae3e9">&lt;a href=&quot;https://github.com/meireles/spectrolab/commit/</a><a class="double-link" href="https://github.com/meireles/spectrolab/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://git">&lt;a class=</a>hub.com/meireles/spectrolab/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://git">&lt;a class=</a>hub.com/meireles/spectrolab/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://git">&lt;a class=</a>hub.com/meireles/spectrolab/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://git">&lt;a class=</a>hub.com/meireles/spectrolab/commit/2d31ae3e98f2c9a889b4d3335729518b5943b86e">2d31ae3e9</a><a href="https://github.com/meireles/spectrolab/commit/2d31ae3e98f2c9a889b4d3335729518b5943b86e">&quot;&gt;&amp;lt;a href=&amp;quot;https://github.com/meireles/spectrolab/commit/&lt;/a&gt;&lt;a class=&quot;double-link&quot; href=&quot;https://github.com/meireles/spectrolab/commit/&amp;lt;a class=&amp;quot;double-link&amp;quot; href=&amp;quot;https://git&quot;&gt;&amp;lt;a class=&lt;/a&gt;hub.com/meireles/spectrolab/commit/&amp;lt;a class=&amp;quot;double-link&amp;quot; href=&amp;quot;https://git&quot;&gt;&amp;lt;a class=&lt;/a&gt;hub.com/meireles/spectrolab/commit/&amp;lt;a class=&amp;quot;double-link&amp;quot; href=&amp;quot;https://git&quot;&gt;&amp;lt;a class=&lt;/a&gt;hub.com/meireles/spectrolab/commit/&amp;lt;a class=&amp;quot;double-link&amp;quot; href=&amp;quot;https://git&quot;&gt;&amp;lt;a class=&lt;/a&gt;hub.com/meireles/spectrolab/commit/2d31ae3e98f2c9a889b4d3335729518b5943b86e&quot;&gt;2d31ae3e9&lt;/a&gt;&lt;a href=&quot;https://github.com/meireles/spectrolab/commit/2d31ae3e98f2c9a889b4d3335729518b5943b86e&quot;&gt;&amp;quot;&amp;gt;&amp;amp;lt;a href=&amp;amp;quot;https://github.com/meireles/spectrolab/commit/&amp;lt;/a&amp;gt;&amp;lt;a class=&amp;quot;double-link&amp;quot; href=&amp;quot;https://github.com/meirele... (continued)

Pull Request Pull Request #9: bug fix combine.spectra

Run Details

37 of 37 new or added lines in 2 files covered. (100.0%)

385 of 1022 relevant lines covered (37.67%)

25.54 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

0.0

/R/match_overlap.R

#' Match overlap function
#'
#' \code{match_overlap} Alternative to match_sensors for spectra with multiple
#' repeated wavelengths
#'
#' @param x spectra object
#' @param first Numeric. The first spectrum to plot. Corresponding to a row in a data.frame.
#' @param last Numeric. The last spectrum to plot. Corresponding to a row in a data.frame.
#' @return spectra object
#' @export

#' @author Anna K. Schweiger

match_overlap <- function (x) {
  dat <- as.matrix(x)
  wvl <- wavelengths(x)
  dat1 <- dat[,1:which.max(wvl < cummax(wvl))-1] ### cut when wvls start decreasing
  wvl1 <- as.numeric(colnames(dat1))
  datx <- dat [,which.max (wvl < cummax(wvl)):ncol(dat)]
  wvlx <- as.numeric(colnames(datx))
  dat2 <- datx[,1:which.max (wvlx < cummax(wvlx))-1]
  wvl2 <- as.numeric(colnames(dat2))
  dat3 <- datx [,which.max (wvlx < cummax(wvlx)):length(wvlx)]
  wvl3 <- as.numeric(colnames(dat3))

  wavi <- c(ceiling(wvl1)[1]:floor(wvl1)[length(wvl1)])
  dat11 <- as.data.frame(prospectr::resample(dat1, wvl1, wavi, interpol="spline"))
  wvl11 <- as.numeric(names(dat11))
  wavi <- c(ceiling(wvl2)[1]:ceiling(wvl2)[length(wvl2)])
  dat22 <- as.data.frame(prospectr::resample (dat2, wvl2, wavi, interpol="spline"))
  wvl22 <- as.numeric(names(dat22))
  wavi <- c(floor(wvl3)[1]:floor(wvl3)[length(wvl3)])
  dat33 <- as.data.frame(prospectr::resample (dat3, wvl3, wavi, interpol="spline"))
  wvl33 <- as.numeric(names(dat33))

  datsub1 <- dat11[,which(names(dat11)%in%names(dat22))]
  datsub2 <- dat22 [,which(names(dat22)%in%names(dat11))]
  diff <- colMeans(abs(datsub2-datsub1))
  dat111 <- dat11 [,1:which(colnames(dat11)==names(which(diff== min(diff))))]
  dat222 <- dat22 [,which(diff== min(diff)):ncol(dat22)]
  a <- dat111[,ncol(dat111)]/dat222[,1]
  dat111adj <- dat111/a

  datsub2 <- dat222[,which(names(dat222)%in%names(dat33))]
  datsub3 <- dat33 [,which(names(dat33)%in%names(dat222))]
  diff <- colMeans(abs(datsub3-datsub2))
  dat222 <- dat222 [,1:which(colnames(dat222)==names(which(diff== min(diff))))]
  dat333 <- dat33 [,which(diff== min(diff)):ncol(dat33)]
  b <- dat222[,ncol(dat222)]/ dat333[,1]
  dat333adj <- dat333*b

  spec_corr <- cbind (dat111adj[,1:ncol(dat111adj)-1], dat222, dat333adj[,-1])
  spec_corr <- as.spectra(spec_corr)
  return(spec_corr)
}

1	#' Match overlap function
2	#'
3	#' \code{match_overlap} Alternative to match_sensors for spectra with multiple
4	#' repeated wavelengths
5	#'
6	#' @param x spectra object
7	#' @param first Numeric. The first spectrum to plot. Corresponding to a row in a data.frame.
8	#' @param last Numeric. The last spectrum to plot. Corresponding to a row in a data.frame.
9	#' @return spectra object
10	#' @export
11
12	#' @author Anna K. Schweiger
13
14	match_overlap <- function (x) {
15	dat <- as.matrix(x)	×
16	wvl <- wavelengths(x)	×
17	dat1 <- dat[,1:which.max(wvl < cummax(wvl))-1] ### cut when wvls start decreasing	×
18	wvl1 <- as.numeric(colnames(dat1))	×
19	datx <- dat [,which.max (wvl < cummax(wvl)):ncol(dat)]	×
20	wvlx <- as.numeric(colnames(datx))	×
21	dat2 <- datx[,1:which.max (wvlx < cummax(wvlx))-1]	×
22	wvl2 <- as.numeric(colnames(dat2))	×
23	dat3 <- datx [,which.max (wvlx < cummax(wvlx)):length(wvlx)]	×
24	wvl3 <- as.numeric(colnames(dat3))	×
25
26	wavi <- c(ceiling(wvl1)[1]:floor(wvl1)[length(wvl1)])	×
27	dat11 <- as.data.frame(prospectr::resample(dat1, wvl1, wavi, interpol="spline"))	×
28	wvl11 <- as.numeric(names(dat11))	×
29	wavi <- c(ceiling(wvl2)[1]:ceiling(wvl2)[length(wvl2)])	×
30	dat22 <- as.data.frame(prospectr::resample (dat2, wvl2, wavi, interpol="spline"))	×
31	wvl22 <- as.numeric(names(dat22))	×
32	wavi <- c(floor(wvl3)[1]:floor(wvl3)[length(wvl3)])	×
33	dat33 <- as.data.frame(prospectr::resample (dat3, wvl3, wavi, interpol="spline"))	×
34	wvl33 <- as.numeric(names(dat33))	×
35
36	datsub1 <- dat11[,which(names(dat11)%in%names(dat22))]	×
37	datsub2 <- dat22 [,which(names(dat22)%in%names(dat11))]	×
38	diff <- colMeans(abs(datsub2-datsub1))	×
39	dat111 <- dat11 [,1:which(colnames(dat11)==names(which(diff== min(diff))))]	×
40	dat222 <- dat22 [,which(diff== min(diff)):ncol(dat22)]	×
41	a <- dat111[,ncol(dat111)]/dat222[,1]	×
42	dat111adj <- dat111/a	×
43
44	datsub2 <- dat222[,which(names(dat222)%in%names(dat33))]	×
45	datsub3 <- dat33 [,which(names(dat33)%in%names(dat222))]	×
46	diff <- colMeans(abs(datsub3-datsub2))	×
47	dat222 <- dat222 [,1:which(colnames(dat222)==names(which(diff== min(diff))))]	×
48	dat333 <- dat33 [,which(diff== min(diff)):ncol(dat33)]	×
49	b <- dat222[,ncol(dat222)]/ dat333[,1]	×
50	dat333adj <- dat333*b	×
51
52	spec_corr <- cbind (dat111adj[,1:ncol(dat111adj)-1], dat222, dat333adj[,-1])	×
53	spec_corr <- as.spectra(spec_corr)	×
54	return(spec_corr)	×
55	}

meireles / spectrolab / 394

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous