tests/testthat/test-SmoothedPG.R

In quantspec: Quantile-Based Spectral Analysis of Time Series

context("SmoothedPG")

test_that("smoothedPG works as expected- compare to naively computed estimator",{
      
      set.seed(2581)
      Y <- rnorm(64)
      
      freq <- 2*pi*(0:63)/64
      levels <- c(0.25,0.5)
      
      qPG <- quantilePG(Y, frequencies = freq, levels.1 = levels)
      
			weight <- kernelWeight(N=64, W=W0, bw=0.1)
			#weight <- kernelWeight(W=W0, bw=0.1)
			
			#sPG <- smoothedPG(Y, frequencies = freq, levels.1 = levels, weight=weight)
      sPG <- smoothedPG(qPG, weight=weight, frequencies=freq)
      
      # perform smoothing 'by hand':
      
      # weight function
      Wn <- function(x) {
        start <- ceiling(-weight@bw-x/(2*pi))
        end <- floor(weight@bw-x/(2*pi))
        result <- 0
        for (j in start:end) {
          result <- result + weight@bw^(-1) * weight@W(weight@bw^(-1)*(x+2*pi*j))
        }
        result
      }
      
      Q <- getValues(qPG)

      ref <- array(0, dim=c(64,2,2,1))
      for (f in 1:length(freq)) {
        for (s in 1:63) {
          ref[f,,,] <- ref[f,,,] + Wn(freq[f]-2*pi*s/64) * Q[s+1,,,] 
        }
        ref[f,,,] <- 2*pi*ref[f,,,]/ (64 * (weight@env$Wnj[c(64,1:63)])[f])
      }
      

      S <- getValues(sPG)

      expect_that(dim(S),equals(c(64,2,2,1)))
      expect_that(S,equals(ref))
    }
)


test_that("smoothedPG (with SpecDistrWeight) works as expected- compare to naively computed estimator",{
			
			set.seed(2581)
			
			Y <- rnorm(64)
			
			freq <- 2*pi*(0:63)/64
			levels <- c(0.25,0.5)
			
			qPG <- quantilePG(Y, frequencies = freq, levels.1 = levels)
			weight <- specDistrWeight()
			sPG <- smoothedPG(qPG, weight=weight, frequencies=freq)
			
			# perform smoothing 'by hand':

			Q <- getValues(qPG)
			
			ref <- array(0, dim=c(64,2,2,1))
			for (f in 1:length(freq)) {
				for (s in 1:63) {
					ref[f,,,] <- ref[f,,,] + (freq[f] >= 2*pi*s/64) * Q[s+1,,,] 
				}
				ref[f,,,] <- 2*pi*ref[f,,,] / 64
			}
			
			
			S <- getValues(sPG)
			
			expect_that(dim(S),equals(c(64,2,2,1)))
			expect_that(S,equals(ref))
		}
)

test_that("smoothedPG works as expected for various levels",{
      
      source("load-ref.R")
      
      lev.ok.all <- c(0.25,0.5,0.75)
      lev.ok.1   <- c(0.25)
      lev.ok.2   <- c(0.5,0.75)
      lev.err.1  <- c("non numeric",0.5)
      lev.err.2  <- c(0.5,1.5)
      
      # Check whether it works for all levels:
      W.qr.ref.1 <- array(W.qr.ref[,,,1], dim=c(64,3,3,1))
      W.fft.ref.1 <- array(W.fft.ref[,,,1], dim=c(64,3,3,1))
      
      weight = kernelWeight(W=W0, N=64, bw=0.2)
			#weight = kernelWeight(W=W0, bw=0.2)
      
      sPG.qr <- smoothedPG(Y, levels.1=lev.ok.all, weight = weight, type="qr")
      W.qr <- getValues(sPG.qr)      
      expect_that(dim(W.qr),equals(c(64,3,3,1)))
      expect_that(W.qr,equals(W.qr.ref.1))
      
      sPG.fft <- smoothedPG(Y, levels.1=lev.ok.all, weight = weight, type="clipped")
      W.fft <- getValues(sPG.fft)
      expect_that(dim(W.fft),equals(c(64,3,3,1)))
      expect_that(W.fft,equals(W.fft.ref.1))

      W.fft.sd <- getSdNaive(sPG.fft)
      expect_that(dim(W.fft.sd),equals(c(64,3,3)))
      expect_that(W.fft.sd,equals(W.fft.sd.ref))
      
    })