From 7e9fbdbb4619987f879c4bee8eebf6213c31b953 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Thu, 9 Nov 2023 13:26:32 +0100 Subject: [PATCH 1/2] rework bias_quantile to work with vectors and matrices again instead of data.table --- R/metrics-quantile.R | 78 +++++++++++++++++++++++--------------- tests/testthat/test-bias.R | 4 ++ 2 files changed, 51 insertions(+), 31 deletions(-) diff --git a/R/metrics-quantile.R b/R/metrics-quantile.R index 5f45426ab..4f3774a96 100644 --- a/R/metrics-quantile.R +++ b/R/metrics-quantile.R @@ -149,6 +149,7 @@ interval_coverage_quantile <- function(observed, predicted, quantile, range = 50 #' which predictions were made. If this does not contain the median (0.5) then #' the median is imputed as being the mean of the two innermost quantiles. #' @inheritParams bias_range +#' @param na.rm logical. Should missing values be removed? #' @return scalar with the quantile bias for a single quantile prediction #' @author Nikos Bosse \email{nikosbosse@@gmail.com} #' @examples @@ -167,69 +168,84 @@ interval_coverage_quantile <- function(observed, predicted, quantile, range = 50 #' bias_quantile(observed, predicted, quantile) #' @export #' @keywords metric - -bias_quantile <- function(observed, predicted, quantile) { - +bias_quantile <- function(observed, predicted, quantile, na.rm = TRUE) { assert_input_quantile(observed, predicted, quantile) - n <- length(observed) N <- length(quantile) - - dt <- data.table( - forecast_id = rep(1:n, each = N), - observed = rep(observed, each = N), - predicted = as.vector(t(predicted)), - quantile = quantile - )[order(forecast_id, quantile)] - - dt <- dt[, .(bias = bias_quantile_single(.SD)), by = forecast_id] - - return(dt$bias) + if (is.null(dim(predicted))) { + dim(predicted) <- c(n, N) + } + bias <- sapply(1:n, function(i) { + bias_quantile_single_vector(observed[i], predicted[i,], quantile, na.rm) + }) + return(bias) } -bias_quantile_single <- function(dt) { +#' Compute Bias for a Single Vector of Quantile Predictions +#' @description Internal function to compute bias for a single observed value, +#' a vector of predicted values and a vector of quantiles. +#' @param observed scalar with the observed value +#' @param predicted vector of length N corresponding to the number of quantiles +#' that holds predictions +#' @param quantile vector of corresponding size N with the quantile levels for +#' which predictions were made. If this does not contain the median (0.5) then +#' the median is imputed as being the mean of the two innermost quantiles. +#' @inheritParams bias_quantile +#' @return scalar with the quantile bias for a single quantile prediction +bias_quantile_single_vector <- function(observed, predicted, quantile, na.rm) { - dt <- dt[!is.na(quantile) & !is.na(predicted)] + assert_number(observed) + # other checks should have happend before - observed <- unique(dt$observed) + predicted_has_NAs <- anyNA(predicted) + quantile_has_NAs <- anyNA(quantile) - if (nrow(dt) == 0) { - return(NA_real_) + if(any(predicted_has_NAs, quantile_has_NAs)) { + if (!na.rm) { + return(NA_real_) + } else { + quantile <- quantile[!is.na(predicted)] + predicted <- predicted[!is.na(predicted)] + predicted <- predicted[!is.na(quantile)] + quantile <- quantile[!is.na(quantile)] + } } - if (!all(diff(dt$predicted) >= 0)) { + order <- order(quantile) + predicted <- predicted[order] + if (!all(diff(predicted) >= 0)) { stop("Predictions must not be decreasing with increasing quantile level") } - if (0.5 %in% dt$quantile) { - median_prediction <- dt[quantile == 0.5]$predicted + if (0.5 %in% quantile) { + median_prediction <- predicted[quantile == 0.5] } else { - # if median is not available, compute as mean of two innermost quantiles + # if median is not available, compute as mean of two innermost quantile message( - "Median not available, computing as mean of two innermost quantiles", + "Median not available, computing as mean of two innermost quantile", " in order to compute bias." ) median_prediction <- - 0.5 * dt[quantile == max(quantile[quantile < 0.5])]$predicted + - 0.5 * dt[quantile == min(quantile[quantile > 0.5])]$predicted + 0.5 * predicted[quantile == max(quantile[quantile < 0.5])] + + 0.5 * predicted[quantile == min(quantile[quantile > 0.5])] } if (observed == median_prediction) { bias <- 0 return(bias) } else if (observed < median_prediction) { - if (observed < min(dt$predicted)) { + if (observed < min(predicted)) { bias <- 1 } else { - q <- max(dt[predicted <= observed]$quantile) + q <- max(quantile[predicted <= observed]) bias <- 1 - 2 * q } } else if (observed > median_prediction) { - if (observed > max(dt$predicted)) { + if (observed > max(predicted)) { bias <- -1 } else { - q <- min(dt[predicted >= observed]$quantile) + q <- min(quantile[predicted >= observed]) bias <- 1 - 2 * q } } diff --git a/tests/testthat/test-bias.R b/tests/testthat/test-bias.R index b1e59fd6d..42eefa34f 100644 --- a/tests/testthat/test-bias.R +++ b/tests/testthat/test-bias.R @@ -129,6 +129,10 @@ test_that("bias_quantile() handles NA values", { bias_quantile(observed = 2, predicted, quantiles), -1 ) + expect_equal( + bias_quantile(observed = 2, predicted, quantiles, na.rm = FALSE), + NA_real_ + ) }) test_that("bias_quantile() errors if no predictions", { From e596c4f4a55858df8daa4ed3dbd4402d23237f4f Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Thu, 9 Nov 2023 13:28:57 +0100 Subject: [PATCH 2/2] Update `metrics_quantile` + some documentation --- R/data.R | 4 +++- data/metrics_quantile.rda | Bin 6149 -> 11747 bytes man/bias_quantile.Rd | 4 +++- man/bias_quantile_single_vector.Rd | 27 +++++++++++++++++++++++++++ man/metrics_quantile.Rd | 22 ++++++++++++++++++++++ man/metrics_sample.Rd | 10 ---------- 6 files changed, 55 insertions(+), 12 deletions(-) create mode 100644 man/bias_quantile_single_vector.Rd create mode 100644 man/metrics_quantile.Rd diff --git a/R/data.R b/R/data.R index 9c5569646..48548ffed 100644 --- a/R/data.R +++ b/R/data.R @@ -217,5 +217,7 @@ #' A named list with functions: #' - "wis" = [wis()] #' - "bias" = [bias_quantile()] +#' - "coverage_50" = \(...) {run_safely(..., range = 50, fun = interval_coverage_quantile)} #nolint +#' - "coverage_90" = \(...) {run_safely(..., range = 90, fun = interval_coverage_quantile)} #nolint #' @keywords info -"metrics_sample" +"metrics_quantile" diff --git a/data/metrics_quantile.rda b/data/metrics_quantile.rda index c0217df2cd94171bd8e299d949b5b94cabfc853c..f1e231d773161dc0df58ab5efd8fb8ca1a0741fc 100644 GIT binary patch literal 11747 zcmV<9EgaH9T4*^jL0KkKSuAMxy8y#1fB*mg|NsC0|NsC0|NsC0|NsC0|Np=L|Nrf8 z|NsC0|Nr1NTzrS6-R^?%&vz(B-+9(<+vlCbfabk7GcT?-H`~s|wdZA}JE$6orfRCT z-OhHI?%#YipaP7P*@EZAPW#iFpK<2S01rR_000UF0049*ytLwa7k4}Cc-R7>6dLqs zb-mr^qLKjjkop+_^V0B1BoQ#083RBXWB>q$CMoJ>qY1Q)H9Rz_{-)BWrl#1Y8dLR8 z(^UN)ik?qY@CiJV^)hLM^))>-o~G1zliC#gsgu%po~infdQVKJsM<}G^*p0#sM=vo zU6Ovw^s6C+8cCPqdL2Br~+!2=Ub8)Bw-{rh_M_Y@h~*r~n3l&;V!;D9``_pa-ZuKr#RTM5G`z5M%&NF)>W1vYx5r z#Z8p-+NYq?B6>AFBSzF|w2x7t>SQ!+BTWDR003wJWDNiS0iXZ?007VfNPOUc%1VHL z=wk?>??3&3sYrp!K}?m@3S=*vjD$){%;ExMp%5WdFU87pJb?7E?0Ce*K<3fj$Ch`W z6W!EFT#=A0pnGJrKo3R#a5I2o&8X8q`+{q__ysDdZPFb%6zXGjcBCY+-TWd>uh&ya`)hBq}k zMiaiBIvadI$qHzspqS}qRRr&eofzbrhZCc^>FbTXw%#B8U+0>RaMTL84DY4Ht)N|| zjdWCjg$@z*mI|7t1@dRoFcqgJ9k<1(={njZB1SrnoSedPqdFxQCsn9~B1nLpHNobv z)`yllv`L8A(rcXH9$eJtzu$J;if9=HnkI5Cq49H1WG_h@{I0ZsQVL>}EzB_D#HI}n zvz-8;0vX+S6txREBqLvxQ)LueV{cI5%V+PF#aOl*3cZ1xy2ye6<6UDJDJU@$KY?oF zZy`*m^87&l) z1t1|oF+0Fuhhzt8BLHdm9DP-^za%6*(i9XNxBR{hL#M{kr6q+j3yjAdD_yW}niT^&@L|m6SWLC;5tXM$RhYmy zEwL+_;ISDR26;YK#g`rvOUAqW=DL%H&o-@R=P8TMXfO{8%iI1tW#_!r#i3z)`7wa#?L79nHyop-nH2VToMS;% z8Dc@t!!=bz7lX$ph@P%$-q_m5TA6OTjB^vIgr=R?VzsJ8<6?^ltU6d(-!1N#Y3RER+5lNApnR%AXXqj zT!!a`t&`*K{G$`ZA0_UK^tD4{Zn7|tJsDD>IpB%w z4@r6&^(xYyYm6)P0uVuA>~PX;#agmLGVNoFrfk>vQ)%ZnP}Rg zTlON-Yfc(V3UuAPsNvTOo`$`Hr)j%xPQUZ_Ejd` z{bzO^*@c@385nn-ws@W8jN{L%!{uu3QEl|J$FFcqd{Z&qiIRAK43KL0-FYIzFnBOa z6nZ${pmtmmJ5GftJ7ty-6Ig6t+<0pPO`1ZRLYhqM9gLtnLV|3%1_e3#H5E2z4nS&ayz zV%sIl*rN3v;xUcjXp$Ff7ow%@372r6V?eRYfy*U?VURf1x?31eij9t!7*!();4;*t7O#H% zb2CpW5}mP80o4*w9fTPrNkw_Dc#|rkX40N*7OvlX(}o#_5Vz1xEVuPxV=eIyxe7oK z(27Urwb6mDr(YCNM81Dn&)tTYIdV10`Ef$Q)+OXDsZXR?@J;3@ynyH!pV*Snhy%4!jnw8 zk_a^}#fv*lm98Co+SCWg%T@YVCqVKEWrFPv2~tUOJW{o`Kro3JYEdgzD6bv% z2c@ec1}7BsOk3%BNnLN_#Rbi70BF%{%P%A8N2k}zRTrVdHW1f>l|IeBS^hQ5dN(iG zYtz3bl0TB}QA2u~b}NK)wIi@Qp?fchwdkV6xc8-7dpD0uVHimXCP_TOflx;ha6Qm; z4_%ks9ReYXEUgGa@8e>?Ox#09pmmu~CSE%q@j2 z70S5@Gl@r1fCem3DT)=Il_=9>Zb!O8r%Vt9?br4Up=q;$BWgpeV8^2XSwqn{W_a_&G!u~V8qiPfL@H+T1{QgI`8jOvbQl_2EY-maKeD%eh zatms*Arz8?Ah19_8Cp44`9y7=i~UO|jQ*|%py?b#6mtog6y{JyOp-y|k?Ell$d3#M zG^n|)rN~6iL<})1gSFFMGtxDzTg==unkv*(YsB+hOan-Acxny_?cJ0z;wGFoB-33y)EH)#3p$T%8wb%ru2qaNxGxSXh+`MJ|d5 zQ*dLu1_3+ zI@6ABPenTVrT_HLn=;g@qsb z==$}XZ%gZY`qFr?wRWU9RbiY%xd4nnAeeaB)zH zW`0zA^*xK%;iC0n#_v?M6ZkG-GdYb)-sD4Ao(scEvpB>x;dRifQ&RhaAW{-asE<+_ zbx;c67m128CiuMBski67@V$32lc0(jqthiI5RJ!q#GQ&Z&5wS}U*UIxQGJv43+2tyKAA!O8bx4JJjHMMa9(BVPJp2)%Cqi0{RYHTw48Y8l zI{~E|khu_~a`y!f7C4D5?a$ta@=TXK{-N)t>P|S+kuQp1y4Exlz~GtEIG~Hc&)bQ? zofXJlBT_I)h~#efe3x#~xa6N4&@0*<_+qgdT?69SjwzPHZgi~a1x(9W(i+|^?zSM$ zdgdcJfzaSiQd1ccsx@ zPb_1S#}F4NV7zF|qm@ooO-TF{rMqeX45`&(R)$3#L@|JejUcIDXt}t8COU?uEn(EI z1(ykw<2jerYi9S(8ruN!bgOo>O?ool$eWl%xa0!*3iHKvGH8t$X9jEw4#P1Va5xto z0pRpXK!ok7L?Qs4uj%?`05eeXI~GTuYzKq_Y)~1nKtbDG$Su%Hg`S0L0^wt^BQH3f z(gj^P1_7(tL2R0)C1It;H?ynSp<)F74?ExVV>Q=6tP~n!OiRlT-T`A->AH#TxUvD{ zAPi4g`q@?s5RNzfMdAjmbv3hyLk!(r04S?E38rev9sKxNy`G1W2a0nC$56p4mTK)} zuRuCz7#0PI6IdPH7%A$MR0Az_`5BB%i8N`|Hbvn!@kgOPJyxD=fWw-~AV`=gmX#n9 z(ay)+RkGag6n-OlJAQfN5Z0>p<;mw$76y_$}RR0I-(V*;f+z`&cV~aN0{Kx`nP2lBOK_3LD>VhuLm@lZWfp?`*;1>XhCd2Y~BFa;5dOi)OmOlVF0 zmNA0yL41pf0sRQLGH?XbZO)-ItOe92=L&Pfa6;1^25WVqX~EKlK9v{TV3%Uy##)~| z=5gK4znu5IPE@%H5+V>FI0%KzwM3aXB-}zx%9nhL3GYXAc)~d}_;;mJ?defgxQUZZ zc3(ChSkOy(Qx(Rm=R?${#OTAch9uHL2R#Q(Gb|!9T*&8M1lkiETwp^)Aa4Pk`k$Dt zGdaN2z8MWY3fn@roYZZ(gyDy_@2^DZ(5kYx0VZYL)uXU2LV5@bP~z+bt!@t(B|<_z zpn11@v!psa)oxT_jpAr>P<#lwqpqJ|n?cH!opHBL_Q4_%+dbV}#5ayN}qVF^)#f?xF!$@S@2iUdSV3 zYW91?~M0yj{9GqId>tTTK(^pRBvSNpk&r9

aw~@pW z3k94P+g4;BknfIGJbJd%(DgDsX!stBrQ%-v>QgVEgNY#sLLAZ2DkwRK1w-Byg+w(t zulP7J_F`z+f6Tz%fr;OsQN+<9Az@&G775E=xE`ApNm429wr;+MilRHjA-K7 zIcc}6{Y{Od<6oU`z(S5P3Sw*;~QBCQ}SjUf)+K*{;&QiHKHQV&cxr){k#2d@Jp_$aracK4_* z1;0hUzFwo51}@Hxh(VXJ_NJS+PDzOAXGX=MNCrbIZZaZ;qd`*r(5YSLa6cr6sLr_xS`1t4P zhe<ZQQPUWJI%?9G^0UiS58bSym_aU7NTTSYSXv`ua7%=5Zpf_o& zm~X*@4X|)?6VI~xsB2`jh9LwUSD7@=bacZ^!3PX5_MHmxf$|;)rs)7hd>H_TCg-x~ z)+#Hf1wh9E(m@~sfK-S`y#c1uR>vf)w*@e5+DRi5yGE5aXhse~Fl=oDZb>Az{)%I6 zvd~j*t@9=@z{0lf^lNN0FvuusiYm-9y4Ymf_j)x^Rd1Oz6g1mmk#pujRZDAq8j7Nd zYN!fnjz(cIF%dJ4V@%9X2Qh|eqA98cPK86n$O-x~2(IFSCXgW*g8j<|!){5_@%wLy zZh3|8N0ERV>rdaYa7ki~zoJu;G0HI|AqD>$qO+?nZnAyuxVPv%u3u2lv_EOkLkpbe zj_M?V(8CNcvqKDDZ_|Slzxr_`#`CwIUQb~;-rTB>=A-x{(SCZGk8(R|^>IZnBoIdwFvO5GNUeTMyoviC3ANl#?JVVZ_g#`m zcBwq2STNqN4R~Dj8{)&3JR?FH}3e{Vat}bn^mBP6$ zZm!ZVvRRp##rq@}J!7|w8`oxNIX=6t3zNtMVn8Aa1p|nu2=*C%=g9qsqV!*Xz(b4- zLL@@O3R2^#U3fHA0*Tf2*Zz|lUU=T$O^&ASu_StZU@db;4k@kX#sE@d2DL@HOF?rt zaVucc+F1Lbp$1NeOW8#UB$8oOF_&|SjG!o-1S03+$w*N^HOk_+hzWfdQ4!OwEv^%b zON7rQ&UUoy3Iu*Gn{r+hP&CA}63^qvG?CgOE`*L6!cV!0R(K=wsyGN4M^ z#2BI|eB^=$>_EN}P#RF~SE#s%=#>;hn1KZS`B5`M;wY<>U`B|6+8_vXb*%NT+P+hj z=QhtPr;zlAuq(qnps5H^@*@o{Qd}Uk4ickWCHNOme>p0z7sY!?O(YBuF5M7h1*EOImJTQJ(85 zoN-Q&Sw3|;Y0kgixkW=zhy!)?PDfF@p;6R-Ew1d|xrF+QIZO|}5XElDo_f!el$|m! zksREck%>Tc;9sjX(1n;|oDx@A_4yBYAt*c*^_PN=ypIWBDAZZ}2W}MAxLkF=IgT8o zw-j$7ilLAI5tL%8WB?S12}p^C3Q3Bi@WSg65VWo$ree5)87hEKB2pt6h^{~-C=DV3 zN})0W%mPLPV67?fXvG^!K{N~=O80I#Kc_^u(`XPI3gx-b%~ z@P(ivN(Lr@nGyC~#8WhdwipBuQb7bc0zr$05r9PrM0^g)3TE30MF_!$IRgY_6DDR8 z4b5UxXvQ-PAc?Dgc?(E@^MZgTr3Dc<%qUW%%8Vp{t0IIbK_Vd`C_y7Y(14WC zQqv5K5KStgpg4+=Bmg~9A%TWUf~imQVc@SB*YO>149u?M6{F? z6g3qs6G2i`%27i>N(}`F1l2J~6cp6e5Y12?#=hFoMcZkR*gj3qr~wB(lVWO0y+I#LP7^6fg zjKCrR!lV@d@o5Oyn7~U9HJBXms2bm`(yhpD9xA}!QTkd6XFbEXv&nuJ;^-H$fF9O5 z&<3O_6+;*lJ40*{3?Tv3D)x+~%Q(QPsYGZ3B4A2NKuQs!l>mup5`mzI8bzSo(~1a& znKuFyL#q$az#{DmuF?Y%0EY0hA`UQ$fJ~s^!UBZSIjblD4LWGBb*K;+E#m3-TWbKE zi3E$4#gR0mA}q?`5h4kxRMP;a3JC)wFask9g&-(QGYt|D1gOzN5lj*=QACkrVJj3- zMHEptwcsL{lC-JUfWU(w!UbTJ1HDcBE0ZzqY!op zQ3!xwgdA0mw&ul6p;J%>GBlGYJRqRlN(3YWNeYCJrKHIxv=1B|+1PwT#!8&zHt17S zzAdb6i4rI*NU14AnE=3%SRm*mi9Au_&X{Y10PvJw+2Ugw!)xfsH3FI&snx?|fS3e^ zZUAG~>~T#Z`=lelBti&8G)TA*FhUJ5%7ifbr+|3VTf(irTAH3ojH}vV*{Eoc7bp-g zZqT6t3fQrTR>n02EP~b$QU=w5Q9=y^J^lSznq#5S| zjE}TZ(JjCV7_T^tL@Qd*(C!1c?)$OvGr0m_B9%PrpS_);U~i*Cpc)pDJWV zm?$2AsCbGC*{VUK07d}P#nvHV9~LYg0cioG7ha79_j^^r+rnG`yfxpwT92>5CGotq zfrb~aUrLm2gMY>!7;C+LgJstJ`s!e<@FT`{IcPTtLI@5Lrvef<;=YV{VC#GraviP? z*kdcdh`>P;L9MjtA$&}8ocy@(+*c5F{0KIQ*v274ATact5GwwwHnHEiaz=M}H@elJ z7XY~7sa8Nz)CmX*LXaq+PiFfzl_6e zxdq)VG2WPT*AcVg4Q6aPNTxJ=bF)LjZRPi$dej#wqlifmwJE8g+n>@P=coE?C&S4fyrJ7Ns@rq+T#iljrA5n-6}suLmp$!YKI(c3?r9ZN7g7>S zmz0a_hK+zkmoUckDMMgu^TSwz7D2g$n%cGlX2u7>tQ=?v9C`Z}eL?~q_R$^_h2z&z z0i8Dt)B{>8(S*nE*)+D^ok&@3^1uK$`sNG1V8N#zoE)oUI^C@>qLyo3rqcxsTAHAc zB0x;=ofhfQ$5Z2P2qK}ijbG>jqP*qw zq=iI_*bXCoRb&^zL7LTRY-Z5TCVY_qEijpa2&7Ri>DiBn+3~Juz>ts#Kn!GDGN_tx zTp4W>S5y@cGhy2p277O>Ei@Q-7X>r28?li^!1^K=P=Es9DhNX9M*~Bqx2z>3!Fiby z5Ne-F=$JSQb@u>tHvrr84}fmME-z69)zqR3jG;1y1VT1(s5&U?ma_Cy!t$-y-ruad z3x|K%QuYw8A&CJ3mcqE*&zh`+ZX_;5Lpqnxu;;DfGuDEI>&1jF+fWsP?P8Y&43(G7 zN0X(l_a{U!>Ko>V2Q*y;OAVrkC|6s6*r1q^m|&r{4MqJ`E!4Ma_f&dY6%)QD5;X7M zz$|GIn0=Mfy9<-n!~ODBj@4(9GWU^M0Ali&_H>h02%Ez zE=z(4XpZ%cft-NdP;IPeWV2AwptcYffBT97TuRl~%YOBn_VVy=NqVc6U4>VJ_vxf>8whlwgost94uBcp zj-HOBUbX%nZTGlR#~S8_is89i7DTKBpc-rzJ{CZR%fyV(5 ztPxGQO|FiWMx9^jDO@Zpu}K#OT{MOl7_^YslM%2)hIUd=Frm&mmDUb@;2%#6GODT7 zP(}RF0xt>yx&J-RQANl0cd^NjkbNt4ilZR>$ovli;1r5U1P&;AdFP$2Y;g8|zM%5} zJM4yC1TYL=)uh- z>pA#YB=hbBX(tAAXvaf4y6{kxULlsDC|nZpiVQmwr+9`89lGrh(F{Uy z958$Rj@ou3Vj~=4F%L)bc!t~91?4bIc@cw-1_?q$1f2C<5{#x;Nz;H;Dg$?5D7BRW zqAr1?WU?$O5e0OBHUrl*q6+XLqL5ZP4FQ-24J5F~2`~)6DB5&7Qw#$fXafQkEGJMN zep9O&lfZ+Lk^#9U&L$=)jXVt^I*=$LRHYF-B%(VzVgiK@4rT^rV3RIj>{w!sAcmFz zL2#kGHV#FGISbd20w8eKDh?3@F%VE81W7E?6bab0L`s23B`6vsg-MYLKpBJvfK{Xd zkx@!P5b!;l!*`xr^?E-yt>=B8d)(^3vQF%Gi7WgM6T5remFRjgF3-9|UL1lmI}pR^ zr1X6Z665IDFTw96D{yzCB*NgHi=puEXcQq>SM-Dn5JQ`{waEV_mTCR>|7+7+Yj<>i z3w`@Tg*dZ(l4AA5%;lLo%^qpBp#aQ=_Wm)c1`?-zbO9XzO^ zj7RmK#(T)`xvwe8DtG%cI`vmdB_HzG!4!x!WF)c`$mbA|4`%!JN^|}u3~P%6<1ozW zdU&jqh>Hfjl**ZM_4cYzv%^U)&UWL*spAh-{lwx>cjfP}@+1U$rr6%?5lhX;yNH6~ zBTuAr1-k9`^3thw zyBKycIZdBo+T;vd&aG?@B3FmJa=0LOU&jJ}5bgmwT`Vcp1ocyCQ*Qe2eAxM2s@~;x z!L_yG@Kc`CRr|jWdB*%6Z{_(t-&^x*Eb?&=CYHl*()k^=hDV#Z(6-^)($Yow%`3Os z=5d-&m3dDCtlv9BU&{5byVNI-`O^z%F?;20BQdc1G~ zcW=aWni*=Sb6&p#{4d1&@4oj;&%XbKnOUM}Z_UNGv1zQPJ+|%{t31d~Jh_cCv-dCd zT<31g$M!Cy^jr9ux43!!kIx~`BkkGmrQP?1PNRjX;+3#=9e46ocGfv`ll!TBnO~Ct z?4`@%!CQZO4ta zl}}?$8cd&JMxWY-pN(bOztYJ0J*$gS!7V zq5uE@0000000E!?02!zxlqOPQX`!GE8X9_rjG6!d8fl0C001=500003KmZy500000 z00000i6kINlM_ut(?ru~r|GI`h#sR)X#-PDG|{G-X`!Gr(V)-+Kn(*xGynhwng9R* zXaE2J^nuT)h8+^1c-}?=0lTtBBB@i%mz{*`uBJy3tUbe-C0wZl&vw2yJFwVn%((hyo68Ei{s*A8L#pk^Dv2qW z>e3i)P8QC84Y8_G5s>5&6jc>eF&5szokla2;eW5)7XUEfaP-EqS{;+9`&&X`%wEc; zlps`!y20J=vTK{#CL?^iMEZDmlU&L&o7y7bnZPoi<|k5k!d9g7EJi^uHE$=jjpqc|%af1LZ-uf3Kv09j1H%!uF~ z9%RfhhkI@41FGfEZ)wM|g-vchdDrN0!fH&LjXP~j_hE)AJM?Tsj6y~1aF_@%r8>!$ zVTVdE1jeAHMlNUtBf3n2ML0WKIJ2ioRKuOBGKwU_0v3*N;ln}9L@s#XaF#Hc4o_p{ zEb#WcJS*1O-yLjnwWn;g2!L zzrDiB`w4Yq>JO;mEz&lMKFWltnRj1_@azCoI?&9 z=MI;Zg=#Ynz?Gr4XGvcWmQxuZ3hNn`TJrj4WJhR;IMKC;!=m4&Jwj{d6X#Yl9G|UN4PUUr9!Z<9d-Hz|Q!!A<#=N|iOlu(+wn~imzJ9-Z)w$y2 zlDYSb<%;XEZRlye?d6AS+|q0{);YXBE`K&+$rk?foRYx2%f4KF9vOKf_V}?j9D|Oh zR~Y#mY|W2rslZy*yN%TIHo5%^ns=y%#j9`oi&wKxxb#!#r@Oh{%WIW4Do+7U<^ES5 zm~Y_e7?{4b!cJP`8jT#`tnR*PUvMFQ5o&0%~lUkMLP*euErPLV{aLX^M-##I9; z*9ek-V%Yp$Xoyk#zY`B%auZ&Dg>@S>L|gzTWJry5CJiuE)tgLv1<;<^dqm@@NeOHY zU`a6u#K9O4C}U!f{*sQiLr&ERu?Y#zDjxe?T*B*Ci+@90Qs!<6yqH6xVuaU|tT)6G$(9STjy>=W! z#wVebLgT-|^}h=QKN1je-DKnAOkm6gdo>Rh;h&D<&OM$K8rqKZ$YkS5EW;{{Dnvdx zgA?xOmYs%bRth@tuU0{Uu;ZP+MfLtAe85~c)Ev-EAvjV67%+Zd0hV6`N>kr4`z(BR zi%}5y`zJ?OoM6btM0LlqkC@mO4i7W6YhgH2-A=8uLmv{8p5;MvPf-vqCZcz~KBbEm ziO(gCH$#5B%x`e>A+-b6Am=xeHzk>E;{@$b5#lYCn(#HtC0hDpf2HdDHab3&x-+@n z^LpLTnsU*x0~WDrkLY7oBRr4XnR%`y+j-+8#914)#d)VJR6auR;sKpys0BiK1qpz1kp0w& z4&t7I?4FmX;ZqeuiIpS~(C=T~Wazd3XX}Te%G(SfihejC;9)uzK_wz|!vYA`zGgQA z6)J$mTZ)~Ze_v&D7627Bm8cXxjUM^#(%Z5R=!Stp-uL>@>cF{*Q>t?9y)NGB=i*W zpQ{EXRiBmUQbvjQg0@1nc4wA!L%|-&F81WQ9)X3n+iwv@rI}pcm_;m0wBk&}m;Hzy zvt}y+L>+)At-=uvkq}R7o#uILj~R>Hxk)U_>Z3_VSmN-+(rXdANDIjhcLxjI?&q|Y zv#Q$tpoO_8?4#*X5j-7x4v0poFi)6>Co#y*H%4C6)W-JFW{XIXk2`(QG|Y98 zHXM)WN>F%b6ZZ8SLc|OEN1 z13d zFouU|nDti%SdWXNXhV8YAi*h$k|Zf1Fu+w5B#>21kh3u;(6AE{P*fCB)R8n)F;i5P z6$DKY41@0t-32eY-d3vShM+JEN)+kPrsdGO?zP=E<{F!}X(Xbc&SKmhHA0&e7WFfw z!b`awPNWOB@PPqyW1$LyS|DVu$ud(|vl55jL%e~~7i^r(woPgWCnI$haCF-nBsD4% z{Mo>R9e3gAwcv=No=4NCyW(H;%Ay#H)X3hSArBsDAKnCeUhbkPjqNeE-WDqepNE;9} z%CG&cvHvdru{PqoExBtjIq4ULA9=; zBUm)fs7AG{Y_W`#E^c4IwyIiNA%%4GbFrti9CRD>)V_qn-eXp;IxH~fh~nODmS<-k zvd;5cTU&Xqy+-;;B^_)-r{=4N17@lE-RhevGASSd2?UcN48fk$x&qzyCf!>{948`D zpRsOaMcSu}8+)2%_=u+JABtm-cEaBqo$-?0tgA{eK@XkY@+b|E7o&h4$5?0)9rlY~ zmIAJ?7p~h+ew<<+c@DRUtPw}D8+Fkmh(Svk;TJTDyD@$0SitKphRt#n7J(x$5Xn-63RP)FWkO_dGZvAI#T%K-{DTBm!XtBuP*p zf`y?Fk_MmzQ4CNbl@0j`4N(vbkjPOm2(&;{QzS&y6BM-+#6=}Z1yT@DNP|%zMNL67 zF%uO`N+lH%M2gIU6{S)WEfE7iu`?^CDnS8FAw^Weq!i2%DG>^e_EZvuP|+9(6lDS$ zND@L8g_S{)MqwhVnMefIR6&ME)7-Yx1RaEiNFZ`S0BD4YPznRK=O7eal^~*cvH`P- z9RDVM3*6B7GVY#NHQ4w|Am~FvC}>0^5l>?P0j!7`%ZS1$gb2_D6a^sC(LhiIse%d| z2m}E-CQ5aXmm!6CT6=7p$s{EM0zkqNV4@I)L1|E;2xLkrq=+H_iXwqoAYK&UO8Gbg zO%oN~jN}zWMJ|ww({&6`)~J;RBodkt69T4ST_Es~=nMcr$Wj8D&M-S*McJW(goy$$ zGA6Qyk)RR-@Mj4fWL%I8%uq^65>r@Bl9?)52qIQ^b)n0g2iCjtSy zK|P;sLR}*PU4w#Wg|1=-D1$1Bh&u4FO$e!U;M~$b4hj@S9;zyE_Kl*~!9#c0nTvUj zQjsv%qKFG6py=Vg(=r&a_=JRY*cJ0fCzc!p)WK25`PhczU^Y11QS7vh#OuURd22P; ze5K(V!K@Tky`X2HK+Z=3Q9>LQG*}%M0Yt(}ras?$yE{9&;lLdjG0w?EC?ihwG!rK& zM>pCGGz0JVp>jgD8x9{4mIz;cf)MCJ_^`-AB=m9Ez+!tzeb?DC3DXZqHpP;hc(K_| z3EZ%DezB0U5HmF6M$i0a1;zB<@M#E!pR{roCMoW&Xzh7? zx!Friz~jl0aDsx@86+5$8$nGs+Cn3zRr?&QCvIE<8HC9^&ezd3vexzL@D!zK_dd+c z5TRdsCqM%_i+?kfrHkC~@E+Hqw!;indEL z4LtTRsdW-zAl2X_sx5{J5L6y8p0^8-l$98=X|GOf&=89c4$2r9;u9k(jg$#UpB`U% z$+%sjIk{u%)g+8YArWNH&v11n#(q^5JR>i2ko5`3*k(*5m1^J`OO(*54f4pXU@h9V zEIBn@wUZXXjv+=U%7!Ootvxn_2ZqG9nI%IrBFhO&GA`&7h3jD7Fl^%0wI4E))i)-w z12ZU?1%ffm^}BE@=}(5YqD7qeiJvFEyYim}WwbGB!$`#p{z1XHiNq&ilrqOmw{m5M z1Fgg;r3sLdAeohSoIDId$qKPWQM~?_kdlOWVhLUXFbo6&K|{r6#*6E8$yusZ*3628 zVi^f1o+QBFCsMf~V+8cqMO+$0$!#bz+qze_JCCVi?CLFzSqL(gA>HcX6i+0C`>bLn zvSu1=3OM2pyJ4r3VAtZ;47EKg&<3~$spRP1~yg_%p?nqgn~l= z_z6?Nuv=vy2%0fEm@W(_#sJU#1Aw^Ch@>8Mm8jK7OmR_7Vlp_?$=Z-cgQyxfjUa{$ zL{tW@4#?RI;lwz`V$H4&F&PFVks}x^78b;rVKUT)pz}Q6j`@CfgKOSiNg$fYWXrF- ztyam-{4qbRp4J2pq=kT2R)8#`BSH`-2?Y?dB!vh$Ih;FiSd229?k*o6 zti5`Wz|cdT&n2EpCY1!Hy`ek+@)F^RE=&p1l&U6b6VT-N+`sJrvMCCrC3e!SH%)5Y zmwCdotz$WW4R!>~m95~Y2JAROv3Zh4;_ zU`YgKHv0o6=ssp_)pH`4mzc~A7Ut&y2uf|-CJv_~95moTl2(FdDO%x^XeERW21OuW z3Nq_j&Gb-4F$hCHs;#^$nE6GroreFb&36yiXO%74y-p>`M=uGrB{qo&(!{E)QbGtd zb5THYa120>gAkC=9eO}=30aY56&ga7Km=m~0D$p+?si8%qsrsI&ET&nSPldL#B;Ql zt_wM!2iDrBPkoKQ^E8t8^!-t|wmW{5xS8U#LM0p5HzXQRH*0}5#@iy6-JRp!?R#y0 z{aBk=y+=7ZUac&5+^HC9RNAt|fFeP3gki%E$@n?0_%$>Vtr!_$qvMbf1R{b}LBME* z+QN1>p>YKPh&z$86XD1kG1T=Rmab1U!ys%_Lol6+Z0e#5EVh}1{R6}hd?A^sw(r5# zsjwQv`;hh?c)9!^_>oWJwpi?+20@l z07oICMc*`77>L@AMi?Puu(F)Eqg%2<5R57}wZhatlfID`cy|sQeA?>)RkF&j6?Qh8 z0N;@`HP)%*_YTtkN4K`VfGx9j+eCZwpFQkFzqIM`ur)JM;~FL|HZJEX94fod2gHpA zIXRP24|F!I5}8B`_C?3_Qu;~cU}N;T2zK{&bXMl)BTQ6!2neD`OgQs{sYa7FX*}hx X4>phrbUm&hcm6Kqig2MJ=gGz>sKyLa diff --git a/man/bias_quantile.Rd b/man/bias_quantile.Rd index 4cbeb0338..a5f4b6492 100644 --- a/man/bias_quantile.Rd +++ b/man/bias_quantile.Rd @@ -4,7 +4,7 @@ \alias{bias_quantile} \title{Determines Bias of Quantile Forecasts} \usage{ -bias_quantile(observed, predicted, quantile) +bias_quantile(observed, predicted, quantile, na.rm = TRUE) } \arguments{ \item{observed}{a single observed value} @@ -15,6 +15,8 @@ that holds predictions} \item{quantile}{vector of corresponding size with the quantile levels for which predictions were made. If this does not contain the median (0.5) then the median is imputed as being the mean of the two innermost quantiles.} + +\item{na.rm}{logical. Should missing values be removed?} } \value{ scalar with the quantile bias for a single quantile prediction diff --git a/man/bias_quantile_single_vector.Rd b/man/bias_quantile_single_vector.Rd new file mode 100644 index 000000000..26ac893b5 --- /dev/null +++ b/man/bias_quantile_single_vector.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/metrics-quantile.R +\name{bias_quantile_single_vector} +\alias{bias_quantile_single_vector} +\title{Compute Bias for a Single Vector of Quantile Predictions} +\usage{ +bias_quantile_single_vector(observed, predicted, quantile, na.rm) +} +\arguments{ +\item{observed}{scalar with the observed value} + +\item{predicted}{vector of length N corresponding to the number of quantiles +that holds predictions} + +\item{quantile}{vector of corresponding size N with the quantile levels for +which predictions were made. If this does not contain the median (0.5) then +the median is imputed as being the mean of the two innermost quantiles.} + +\item{na.rm}{logical. Should missing values be removed?} +} +\value{ +scalar with the quantile bias for a single quantile prediction +} +\description{ +Internal function to compute bias for a single observed value, +a vector of predicted values and a vector of quantiles. +} diff --git a/man/metrics_quantile.Rd b/man/metrics_quantile.Rd new file mode 100644 index 000000000..e96dcc836 --- /dev/null +++ b/man/metrics_quantile.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{metrics_quantile} +\alias{metrics_quantile} +\title{Default metrics for quantile-based forecasts.} +\format{ +An object of class \code{list} of length 4. +} +\usage{ +metrics_quantile +} +\description{ +A named list with functions: +\itemize{ +\item "wis" = \code{\link[=wis]{wis()}} +\item "bias" = \code{\link[=bias_quantile]{bias_quantile()}} +\item "coverage_50" = \(...) {run_safely(..., range = 50, fun = interval_coverage_quantile)} #nolint +\item "coverage_90" = \(...) {run_safely(..., range = 90, fun = interval_coverage_quantile)} #nolint +} +} +\keyword{info} diff --git a/man/metrics_sample.Rd b/man/metrics_sample.Rd index 90aa265f7..5231f4ae7 100644 --- a/man/metrics_sample.Rd +++ b/man/metrics_sample.Rd @@ -5,13 +5,9 @@ \alias{metrics_sample} \title{Default metrics for sample-based forecasts.} \format{ -An object of class \code{list} of length 7. - An object of class \code{list} of length 7. } \usage{ -metrics_sample - metrics_sample } \description{ @@ -26,11 +22,5 @@ A named list with functions: \item "ae_median" = \code{\link[=ae_median_sample]{ae_median_sample()}} \item "se_mean" = \code{\link[=se_mean_sample]{se_mean_sample()}} } - -A named list with functions: -\itemize{ -\item "wis" = \code{\link[=wis]{wis()}} -\item "bias" = \code{\link[=bias_quantile]{bias_quantile()}} -} } \keyword{info}