FK83 / scoringRules

scoring rules to evaluate probabilistic forecasts
53 stars 16 forks source link

vs_sample #48

Closed ciaran-g closed 3 years ago

ciaran-g commented 3 years ago

Hi, I've been using this package in lots of projects over the past few years - so thanks!

I think the `vs_sample' function could be sped up in a simple manner by

I couldn't figure out how to make a pull request here so just pasted code below.

Cheers!


vs_sample <- function(y, dat, w_vs = NULL,  p = 0.5) {
  input <- list(y = y, dat = dat)
  check.multivsample(input)
  d <- length(y)

  # additional input checks for weighting matrix w and order p
  if (!is.null(w_vs)) {
    if (!is.matrix(w_vs)) {
      stop("'w_vs' is not a matrix ")
    }
    if (any(dim(w_vs) != d)) {
      stop("Dimensions of 'w_vs' do not fit")
    }
    if (any(w_vs < 0)) {
      stop("Weighting matrix 'w_vs' contains negative values")
    }
  }

  if (!is.numeric(p) || length(p) != 1 ){
    stop("Order 'p' must be numeric of length 1")
  } else if (p < 0) {
    stop("Order 'p' must be positive")
  }

  out <- 0
  for (i in 1:d) {
    for (j in 1:i) {
      vdat <- mean(abs(dat[i, ] - dat[j, ])^p)
      vy <- abs(y[i] - y[j])^p
      if (is.null(w_vs)) {
        out <- out + (vy - vdat)^2
      } else {
        out <- out + w_vs[i, j] * (vy - vdat)^2

      }
    }
  }

  return(2*out)
}
FK83 commented 3 years ago

Good points, thanks! I incorporated them and re-wrote the loop part in Cpp.