---
title: "Advanced: Custom loss functions and prediction intervals"
author: "Maximilian Pichler"
date: "2023-09-29"
abstract: "This vignette shows how cito can be used for advanced techniques such as custom loss functions."
output:
 rmarkdown::html_vignette:
    toc: true
    toc_depth: 4
    html_document:
      toc: true
      theme: cerulean
vignette: >
  %\VignetteIndexEntry{Advanced: Custom loss functions and prediction intervals}
  %\VignetteEncoding{UTF-8}
  %\VignetteEngine{knitr::rmarkdown}
editor_options:
  chunk_output_type: console
---



## Custom loss functions

We can pass custom loss functions to cito. R variables/values that are used within the loss function and that should be additionally optimized must be passed to cito via the custom_parameters argument in `dnn(...custom_parameters = list(name_of_parameter=...))`

Examples:

-   (Complex) likelihood functions
-   Advanced: Quantile regression

Requirements: - Complex calculations have to be written in torch - All functions/calls must have derivatives.

### Example 1: Custom (likelihood/loss) functions

Gaussian likelihood (already implemented, but still a nice example). Custom parameters must be passed as a list to the custom_parameters function. The names must match the names of the parameters in the custom loss function. The values of the named custom parameters will be the initial values. Cito will automatically convert them to torch tensors:


```r
library(cito)
library(torch)
gaussian_ll = function(pred, true, ...) {
  loss = -torch::distr_normal(pred, scale = torch::torch_exp(scale_par))$log_prob(true)
  return(loss$mean())
}

# Simulate some data
X = runif(200)
Y = 2*X + rnorm(200, sd = 0.4)
df = data.frame(X = X, Y = Y)

m = dnn(Y~X, data = df,
        loss = gaussian_ll, # custom function
        custom_parameters = list(scale_par = 0.0) # custom parameter that should be addtionally optimized
        )
#> Loss at epoch 1: 1.515620, lr: 0.01000
```

<div class="figure" style="text-align: center">
<img src="D/D-unnamed-chunk-2-1.png" alt="plot of chunk unnamed-chunk-2"  />
<p class="caption">plot of chunk unnamed-chunk-2</p>
</div>

```
#> Loss at epoch 2: 1.395304, lr: 0.01000
#> Loss at epoch 3: 1.309052, lr: 0.01000
#> Loss at epoch 4: 1.258372, lr: 0.01000
#> Loss at epoch 5: 1.156394, lr: 0.01000
#> Loss at epoch 6: 1.133306, lr: 0.01000
#> Loss at epoch 7: 1.089422, lr: 0.01000
#> Loss at epoch 8: 1.049361, lr: 0.01000
#> Loss at epoch 9: 1.009320, lr: 0.01000
#> Loss at epoch 10: 1.023666, lr: 0.01000
#> Loss at epoch 11: 0.978906, lr: 0.01000
#> Loss at epoch 12: 0.963037, lr: 0.01000
#> Loss at epoch 13: 0.943840, lr: 0.01000
#> Loss at epoch 14: 0.939929, lr: 0.01000
#> Loss at epoch 15: 0.918484, lr: 0.01000
#> Loss at epoch 16: 0.949027, lr: 0.01000
#> Loss at epoch 17: 0.889540, lr: 0.01000
#> Loss at epoch 18: 0.868169, lr: 0.01000
#> Loss at epoch 19: 0.836739, lr: 0.01000
#> Loss at epoch 20: 0.821653, lr: 0.01000
#> Loss at epoch 21: 0.788032, lr: 0.01000
#> Loss at epoch 22: 0.789839, lr: 0.01000
#> Loss at epoch 23: 0.764014, lr: 0.01000
#> Loss at epoch 24: 0.752003, lr: 0.01000
#> Loss at epoch 25: 0.739545, lr: 0.01000
#> Loss at epoch 26: 0.716911, lr: 0.01000
#> Loss at epoch 27: 0.719905, lr: 0.01000
#> Loss at epoch 28: 0.679905, lr: 0.01000
#> Loss at epoch 29: 0.681771, lr: 0.01000
#> Loss at epoch 30: 0.653191, lr: 0.01000
#> Loss at epoch 31: 0.621209, lr: 0.01000
#> Loss at epoch 32: 0.634578, lr: 0.01000
#> Loss at epoch 33: 0.591748, lr: 0.01000
#> Loss at epoch 34: 0.585131, lr: 0.01000
#> Loss at epoch 35: 0.564346, lr: 0.01000
#> Loss at epoch 36: 0.587230, lr: 0.01000
#> Loss at epoch 37: 0.584015, lr: 0.01000
#> Loss at epoch 38: 0.544748, lr: 0.01000
#> Loss at epoch 39: 0.564282, lr: 0.01000
#> Loss at epoch 40: 0.601760, lr: 0.01000
#> Loss at epoch 41: 0.533758, lr: 0.01000
#> Loss at epoch 42: 0.541448, lr: 0.01000
#> Loss at epoch 43: 0.521584, lr: 0.01000
#> Loss at epoch 44: 0.537797, lr: 0.01000
#> Loss at epoch 45: 0.507872, lr: 0.01000
#> Loss at epoch 46: 0.557190, lr: 0.01000
#> Loss at epoch 47: 0.606297, lr: 0.01000
#> Loss at epoch 48: 0.604647, lr: 0.01000
#> Loss at epoch 49: 0.547326, lr: 0.01000
#> Loss at epoch 50: 0.531875, lr: 0.01000
#> Loss at epoch 51: 0.559819, lr: 0.01000
#> Loss at epoch 52: 0.541788, lr: 0.01000
#> Loss at epoch 53: 0.567545, lr: 0.01000
#> Loss at epoch 54: 0.524311, lr: 0.01000
#> Loss at epoch 55: 0.551780, lr: 0.01000
#> Loss at epoch 56: 0.560110, lr: 0.01000
#> Loss at epoch 57: 0.581988, lr: 0.01000
#> Loss at epoch 58: 0.560242, lr: 0.01000
#> Loss at epoch 59: 0.546711, lr: 0.01000
#> Loss at epoch 60: 0.534865, lr: 0.01000
#> Loss at epoch 61: 0.519736, lr: 0.01000
#> Loss at epoch 62: 0.544029, lr: 0.01000
#> Loss at epoch 63: 0.535806, lr: 0.01000
#> Loss at epoch 64: 0.527457, lr: 0.01000
#> Loss at epoch 65: 0.515996, lr: 0.01000
#> Loss at epoch 66: 0.560176, lr: 0.01000
#> Loss at epoch 67: 0.577645, lr: 0.01000
#> Loss at epoch 68: 0.529065, lr: 0.01000
#> Loss at epoch 69: 0.543513, lr: 0.01000
#> Loss at epoch 70: 0.516313, lr: 0.01000
#> Loss at epoch 71: 0.543963, lr: 0.01000
#> Loss at epoch 72: 0.554372, lr: 0.01000
#> Loss at epoch 73: 0.535363, lr: 0.01000
#> Loss at epoch 74: 0.520328, lr: 0.01000
#> Loss at epoch 75: 0.503821, lr: 0.01000
#> Loss at epoch 76: 0.537065, lr: 0.01000
#> Loss at epoch 77: 0.572082, lr: 0.01000
#> Loss at epoch 78: 0.528110, lr: 0.01000
#> Loss at epoch 79: 0.568486, lr: 0.01000
#> Loss at epoch 80: 0.539701, lr: 0.01000
#> Loss at epoch 81: 0.559193, lr: 0.01000
#> Loss at epoch 82: 0.491542, lr: 0.01000
#> Loss at epoch 83: 0.579737, lr: 0.01000
#> Loss at epoch 84: 0.548308, lr: 0.01000
#> Loss at epoch 85: 0.551581, lr: 0.01000
#> Loss at epoch 86: 0.558790, lr: 0.01000
#> Loss at epoch 87: 0.504470, lr: 0.01000
#> Loss at epoch 88: 0.547506, lr: 0.01000
#> Loss at epoch 89: 0.557162, lr: 0.01000
#> Loss at epoch 90: 0.577531, lr: 0.01000
#> Loss at epoch 91: 0.541850, lr: 0.01000
#> Loss at epoch 92: 0.560345, lr: 0.01000
#> Loss at epoch 93: 0.541367, lr: 0.01000
#> Loss at epoch 94: 0.547881, lr: 0.01000
#> Loss at epoch 95: 0.530327, lr: 0.01000
#> Loss at epoch 96: 0.563517, lr: 0.01000
#> Loss at epoch 97: 0.574710, lr: 0.01000
#> Loss at epoch 98: 0.523392, lr: 0.01000
#> Loss at epoch 99: 0.545521, lr: 0.01000
#> Loss at epoch 100: 0.533824, lr: 0.01000
```

The optimized parameters are saved in the parameter field:


```r
exp(m$parameter$scale_par) # true scale parameter: 0.4!
#> [1] 0.4177748
```

### Example 2: Quantile regression

The bootstrapping approach provides confidence intervals, but not prediction intervals. We could use likelihoods, such as the Gaussian likelihood, to fit a constant prediction interval. However, we often use loss functions, such as the mean squared error in ML/DL, which don't have an intrinsic parametrization for prediction intervals. We can approximate prediction intervals with quantile regression (a form of conformal prediction), which has the advantage of providing constant prediction intervals, which can be beneficial in certain situations (e.g., heteroscedasticity):

Simulate data:


```r
sim_in = function(n = 5) {
  S = diag(1., 3)
  S[1,2]=S[2,1]=0.0
  X = mvtnorm::rmvnorm(n, sigma = S)
  X1 = X[,1]
  C = X[,2]
  X2 = X[,3]
  Y = 1*X1 + 0.1*X2 + 0.0*C + rnorm(n, sd = 0.3+2*1.8^(X1+1))
  return(data.frame(Y = Y, X1 = X1, X2 = X2, C = C))
}

data = sim_in(500L)
plot(data$X1, data$Y)
```

<div class="figure" style="text-align: center">
<img src="D/D-unnamed-chunk-4-1.png" alt="plot of chunk unnamed-chunk-4"  />
<p class="caption">plot of chunk unnamed-chunk-4</p>
</div>

The variance increases with higher feature values

Quantile Regression:


```r
library(torch)

q1 = torch_tensor(0.05)
q2 = torch_tensor(0.5)
q3 = torch_tensor(0.95)
loss_func = function(pred, true,...) {
  l1 = torch_max(q1*(true[,1,drop=FALSE]-pred[,1,drop=FALSE]), other = (1.0-q1)*(pred[,1,drop=FALSE]-true[,1,drop=FALSE]))
  l2 = torch_max(q2*(true[,2,drop=FALSE]-pred[,2,drop=FALSE]), other = (1.0-q2)*(pred[,2,drop=FALSE]-true[,2,drop=FALSE]))
  l3 = torch_max(q3*(true[,3,drop=FALSE]-pred[,3,drop=FALSE]), other = (1.0-q3)*(pred[,3,drop=FALSE]-true[,3,drop=FALSE]))
  return(l1+l2+l3)
}


m = dnn(cbind(Y, Y, Y)~., data = data,
        lr = 0.01,
        loss = loss_func,
        lambda = 0.000, alpha = 0.5,
        epochs = 70L, hidden = c(30L, 30L),
        activation = "selu", verbose = TRUE, plot = FALSE)
#> Loss at epoch 1: 5.888834, lr: 0.01000
#> Loss at epoch 2: 5.591826, lr: 0.01000
#> Loss at epoch 3: 5.341350, lr: 0.01000
#> Loss at epoch 4: 5.094756, lr: 0.01000
#> Loss at epoch 5: 4.849181, lr: 0.01000
#> Loss at epoch 6: 4.593567, lr: 0.01000
#> Loss at epoch 7: 4.282295, lr: 0.01000
#> Loss at epoch 8: 3.962109, lr: 0.01000
#> Loss at epoch 9: 3.730334, lr: 0.01000
#> Loss at epoch 10: 3.517436, lr: 0.01000
#> Loss at epoch 11: 3.389656, lr: 0.01000
#> Loss at epoch 12: 3.300763, lr: 0.01000
#> Loss at epoch 13: 3.258910, lr: 0.01000
#> Loss at epoch 14: 3.187895, lr: 0.01000
#> Loss at epoch 15: 3.139322, lr: 0.01000
#> Loss at epoch 16: 3.072943, lr: 0.01000
#> Loss at epoch 17: 3.049862, lr: 0.01000
#> Loss at epoch 18: 3.055812, lr: 0.01000
#> Loss at epoch 19: 3.037665, lr: 0.01000
#> Loss at epoch 20: 3.034843, lr: 0.01000
#> Loss at epoch 21: 2.993039, lr: 0.01000
#> Loss at epoch 22: 3.029911, lr: 0.01000
#> Loss at epoch 23: 3.016335, lr: 0.01000
#> Loss at epoch 24: 2.999973, lr: 0.01000
#> Loss at epoch 25: 2.997170, lr: 0.01000
#> Loss at epoch 26: 2.979195, lr: 0.01000
#> Loss at epoch 27: 2.960698, lr: 0.01000
#> Loss at epoch 28: 3.024710, lr: 0.01000
#> Loss at epoch 29: 2.963467, lr: 0.01000
#> Loss at epoch 30: 2.964932, lr: 0.01000
#> Loss at epoch 31: 3.002780, lr: 0.01000
#> Loss at epoch 32: 2.972047, lr: 0.01000
#> Loss at epoch 33: 2.969632, lr: 0.01000
#> Loss at epoch 34: 2.974920, lr: 0.01000
#> Loss at epoch 35: 2.956212, lr: 0.01000
#> Loss at epoch 36: 3.026191, lr: 0.01000
#> Loss at epoch 37: 2.958736, lr: 0.01000
#> Loss at epoch 38: 2.970557, lr: 0.01000
#> Loss at epoch 39: 2.968193, lr: 0.01000
#> Loss at epoch 40: 2.970334, lr: 0.01000
#> Loss at epoch 41: 2.963888, lr: 0.01000
#> Loss at epoch 42: 2.960575, lr: 0.01000
#> Loss at epoch 43: 2.975962, lr: 0.01000
#> Loss at epoch 44: 2.986119, lr: 0.01000
#> Loss at epoch 45: 2.969117, lr: 0.01000
#> Loss at epoch 46: 2.968599, lr: 0.01000
#> Loss at epoch 47: 2.979469, lr: 0.01000
#> Loss at epoch 48: 2.961382, lr: 0.01000
#> Loss at epoch 49: 2.961033, lr: 0.01000
#> Loss at epoch 50: 2.976546, lr: 0.01000
#> Loss at epoch 51: 2.941517, lr: 0.01000
#> Loss at epoch 52: 2.951265, lr: 0.01000
#> Loss at epoch 53: 2.955796, lr: 0.01000
#> Loss at epoch 54: 2.943864, lr: 0.01000
#> Loss at epoch 55: 2.940066, lr: 0.01000
#> Loss at epoch 56: 2.949237, lr: 0.01000
#> Loss at epoch 57: 2.943916, lr: 0.01000
#> Loss at epoch 58: 2.942507, lr: 0.01000
#> Loss at epoch 59: 2.961354, lr: 0.01000
#> Loss at epoch 60: 2.981447, lr: 0.01000
#> Loss at epoch 61: 2.959459, lr: 0.01000
#> Loss at epoch 62: 2.931861, lr: 0.01000
#> Loss at epoch 63: 2.930637, lr: 0.01000
#> Loss at epoch 64: 2.947635, lr: 0.01000
#> Loss at epoch 65: 2.955172, lr: 0.01000
#> Loss at epoch 66: 2.947920, lr: 0.01000
#> Loss at epoch 67: 2.935133, lr: 0.01000
#> Loss at epoch 68: 2.940571, lr: 0.01000
#> Loss at epoch 69: 2.917623, lr: 0.01000
#> Loss at epoch 70: 2.971692, lr: 0.01000

plot(data$X1, data$Y)
lines(smooth.spline(data$X1, predict(m)[,1], spar = 0.01), col = "blue")
lines(smooth.spline(data$X1, predict(m)[,3], spar = 0.01), col = "blue")
lines(smooth.spline(data$X1, predict(m)[,2], spar = 0.01), col = "red")
```

<div class="figure" style="text-align: center">
<img src="D/D-unnamed-chunk-5-1.png" alt="plot of chunk unnamed-chunk-5"  />
<p class="caption">plot of chunk unnamed-chunk-5</p>
</div>

### Example 3: Using cito for optimization / active learning

Neural networks can be used in an unconventional way to optimize arbitrary functions (which is sometimes called active learning, it is related to reinforcement learning) - the only prerequiste is that the analytic derivative of the function using torch must be available. We provide the function to be optimized as a series of Torch operations. First, our model will predict the parameters (based on noise, the inputs don't matter) which are passed to the custom loss function and then we will then use the model function (which we optimize) to compute the loss and return it to the optimizer. In that way we overfit to the noisy inputs and the DNN will learn to predict the optimal set of parameters - independent of the input.


```r
X = runif(200)
Y = 2*X + rnorm(200, sd = 0.4)
df = data.frame(X = X, Y = Y)

# Function we want to optimize (linear model)
Xt = torch_tensor(matrix(X))
Yt = torch_tensor(matrix(Y))

model_lm = function(par) {
  pred = Xt$matmul(par[,1,drop=FALSE])
  loss = -torch::distr_normal(pred, scale = torch::torch_exp(par[,2,drop=FALSE]))$log_prob(Yt)
  return(loss$mean())
}

custom_loss = function(pred, true, ...) {
  if(nrow(pred) > 1) return(torch_zeros(1L)) # disable loss calculation
  loss = model_lm(pred)
  return(loss)
}

# X and Y values don't matter, number of columns in Y has to match the number of parameters we want to optimize
noise = matrix(runif(300*5), 300, 5)
noise_y = matrix(runif(300*2), 300, 2)
df = data.frame(y1 = noise_y[,1], y2 = noise_y[,2], noise)

m = dnn(cbind(y1, y2)~., data = df, loss = custom_loss, batchsize = 1L, epochs = 20L, verbose = FALSE)
```

<div class="figure" style="text-align: center">
<img src="D/D-unnamed-chunk-6-1.png" alt="plot of chunk unnamed-chunk-6"  />
<p class="caption">plot of chunk unnamed-chunk-6</p>
</div>

```r
# Effect:
mean(predict(m)[,1])
#> [1] 1.936987
# SD
mean(exp(predict(m)[,2]))
#> [1] 0.3652849
```
