Fix online function for edge cases

* Fixed online() function for cases where the regret is exactly zero. This can happen if:
* * Only a single expert is used
* * Only two experts are provided and they both have the same predictions (in the beginning).

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: profoc
 Type: Package
 Title: Probabilistic Forecast Combination Using CRPS Learning
-Version: 1.3.0
+Version: 1.3.1
 Date: 2024-01-09
 Authors@R: c(
     person(given = "Jonathan",

NEWS.md

@@ -1,3 +1,15 @@
+profoc 1.3.1
+==============
+
+## Improvements
+* Adjusted the clock.h code so that a larger share of code can be shared between the R and Python versions of that file.
+
+## Fixes
+* Fixed an integer overflow in the clock.h code which caused the package to fail on some systems.
+* Fixed online() function for cases where the regret is exactly zero. This can happen if:
+* * Only a single expert is used
+* * Only two experts are provided and they both have the same predictions (in the beginning).
+
 profoc 1.3.0
 ==============
 

src/conline.cpp

@@ -380,12 +380,13 @@ void conline::learn()
                     {
                         V(x).tube(dr, pr) = vectorise(V(x).tube(dr, pr)).t() * (1 - params["forget_regret"](x)) + square(r.t());
 
-                        E(x).tube(dr, pr) = max(vectorise(E(x).tube(dr, pr)).t() * (1 - params["forget_regret"](x)), abs(r.t()));
+                        E(x).tube(dr, pr) = pmax_arma(max(vectorise(E(x).tube(dr, pr)).t() * (1 - params["forget_regret"](x)), abs(r.t())), exp(-350));
 
-                        eta(x).tube(dr, pr) =
+                        eta(x)
+                            .tube(dr, pr) =
                             pmin_arma(
                                 min(1 / (2 * vectorise(E(x).tube(dr, pr))),
-                                    sqrt(-log(vectorise(beta0field(x).tube(dr, pr))) / vectorise(V(x).tube(dr, pr)))),
+                                    sqrt(-log(vectorise(beta0field(x).tube(dr, pr))) / pmax_arma(vectorise(V(x).tube(dr, pr)), exp(-350)))),
                                 exp(350));
 
                         vec r_reg = r - vectorise(eta(x).tube(dr, pr)) % square(r);

tests/testthat/test-single_same_experts.R

@@ -0,0 +1,40 @@
+skip_if(debug_mode)
+# %% Test online "combination" of a single expert
+set.seed(1)
+
+mod <- online(
+    y = array(rnorm(30),
+        dim = c(5, 3)
+    ), array(rnorm(30),
+        dim = c(5, 3, 1)
+    ),
+    tau = .5,
+    trace = FALSE
+)
+
+expect_true(all(mod$weights == 1))
+# %%
+
+
+# %% Test online "combination" of two experts that are the same
+set.seed(1)
+
+experts <- array(NA,
+    dim = c(5, 3, 2)
+)
+
+experts[, , 1] <- array(rnorm(30),
+    dim = c(5, 3)
+)
+experts[, , 2] <- experts[, , 1]
+
+mod <- online(
+    y = array(rnorm(30),
+        dim = c(5, 3)
+    ), experts,
+    tau = .5,
+    trace = FALSE
+)
+
+expect_true(all(mod$weights == 0.5))
+# %%