---
title: "Traditional AHG fitting"
description: |
  "Traditional AHG fitting using OLS"
author:
  - name: "Mike Johnson"
    url: https://github.com/mikejohnson51
    affiliation: Lynker, NOAA-Affilate
    affiliation_url: https://lynker.com
output: distill::distill_article
vignette: >
  %\VignetteEngine{knitr::knitr}
  %\VignetteIndexEntry{ols}
  %\usepackage[UTF-8]{inputenc}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  out.width = "100%",
  dev = "jpeg"
)

library(ggplot2)
library(dplyr)
library(AHGestimation)
```

# The AHG relationships

The idea of hydraulic geometry was introduced by Leopold and Maddock (1953) and the concept of 'at-a-station hydraulic geometry' (AHG) provides three power laws that relate water-surface width (TW), average depth (Y), and average velocity (V) to the stream flow (Q) in a given river cross section:

$$
TW = a  \cdot Q^b
$$
$$
Y = c \cdot Q^f
$$
$$
V = k \cdot Q^m
$$

A  set of AHG relations applies to within-bank flows at a
specific cross section and assumes the channel characteristics do not change sensibly with discharge. Under these assumptions, continuity dictates that no water is gained or lost in the system such that:

$$
Q = TW·Y·V
$$

and therefore:

$$
b + f + m =  a·c·k = 1 
$$

In practice, the enforcement of continuity is determined by the quality of the data, and is not enforced in the estimation of the AHG relationships.

## Traditonal Fitting Technique

While the AHG power laws provide an elegant theory for representing a mass-constrained hydraulic system, the data available to determine these relations are rarely as clean. In most cases, hydraulic data is reported as a table(s) relating values of Q to values of one or more hydraulic variables. Thus, the relationships require the power law relationships to be fit,

AHG relations are historically fit using OLS on the logarithmic transformation of the variables, where the exponential of the intercept provides the power law coefficient, and the slope of the linear model provides the exponent. Several studies have highlighted the potential problem of using this approach given that when the log transformed values are back-transformed, the estimates are effectively medians, and not means of the estimates, resulting in a general low bias.

## Example: 

```{r}
data <- setNames(
  AHGestimation::nwis[c("date", "Q_cms", "Y_m", "TW_m", "V_ms")],
  c("date", "Q", "Y", "TW", "V")
)
fit <- lm(log(data$Y) ~ log(data$Q))
  
(coef <- exp(fit$coefficients[1]))

(exp  <- fit$coefficients[2])
```

```{r, echo = FALSE}

data$Yp <- coef * (data$Q ^ exp)

ggplot(data) + 
  geom_point(aes(x = Q, y = Y)) + 
  geom_line(aes(x = Q, y = Yp), color = "red") + 
  theme_light() + 
  labs(x = "Q", y  = "Y")
```


### Full Fits

```{r}
ols <- function(X, Y, name = NA){
  fit <- lm(log(Y) ~ log(X))
  data.frame(coef = exp(fit$coefficients[1]),
             exp  = fit$coefficients[2],
             name = name,
             row.names = NULL)
}

(x <- bind_rows(
        ols(data$Q, data$Y, "Y"),
        ols(data$Q, data$TW, "TW"),
        ols(data$Q, data$V, "V")))
```

###  Continuity check

```{r}
sum(x$exp) 
prod(x$coef)
```

### System Error

```{r}
data <- data %>% 
  mutate(Yp  = x$coef[1] * (Q ^ x$exp[1]),
         TWp = x$coef[2] * (Q ^ x$exp[2]),
         Vp  = x$coef[3] * (Q ^ x$exp[3]))
         
err <- data.frame(
  Ye  = nrmse(data$Y, data$Yp),
  TWe = nrmse(data$TW, data$TWp),
  Ve  = nrmse(data$V, data$Vp)
) %>% 
  mutate(tot_error = Ye + TWe + Ve, type = "OLS") 
```

```{r, echo = FALSE}
err <- err %>% 
  tidyr::pivot_longer(-type)


ggplot() + 
  geom_col(data = err, aes(x = name, y = value)) + 
  theme_light() + labs(x = "Relationship", y = "nRMSE")
```
