litedown::reactor(print = NA)

library(rsmatrix)
library(Matrix)

set.seed(15243)

periods <- seq(as.Date("2010-01-01"), as.Date("2019-12-31"), "day")

prices <- data.frame(
  sale = sample(periods, 5e5, TRUE),
  property = factor(sprintf("%05d", sample(1:5e4, 5e5, TRUE))),
  city = factor(sample(1:5, 1e5, TRUE)),
  price = round(rlnorm(5e5) * 5e5, -3)
)

prices <- prices[order(prices$city, prices$property, prices$sale), ]
row.names(prices) <- NULL

head(prices)

interaction(prices$city, prices$property, drop = TRUE) |>
  tabulate() |>
  quantile()

prices$period <- cut(prices$sale, "month")

sales_pairs <- rs_pairs(prices$sale, interaction(prices$city, prices$property))
prices[c("price_prev", "period_prev")] <- prices[
  sales_pairs,
  c("price", "period")
]

head(prices)

prices$holding_period <- with(
  prices,
  as.numeric(period) - as.numeric(period_prev)
)

prices <- subset(prices, holding_period > 2)

monthly_return <- with(prices, (price / price_prev)^(1 / holding_period))

outlier <- split(monthly_return, prices$city) |>
  lapply(\(x) piar::outliers(x, 2.5, method = "robust-z")) |>
  unsplit(prices$city)

prices <- subset(prices, !outlier)

head(prices)

matrices <- with(
  prices,
  rs_matrix(period, period_prev, price, price_prev, city, sparse = TRUE)
)

Z <- matrices("Z")
y <- matrices("y")

grs <- exp(solve(crossprod(Z), crossprod(Z, y)))
head(grs)

grs_resid <- y - Z %*% log(grs)

mdl <- lm(as.numeric(grs_resid)^2 ~ prices$holding_period)
W <- Diagonal(x = 1 / fitted.values(mdl))

grs_cs <- exp(solve(crossprod(Z, W %*% Z), crossprod(Z, W %*% y)))
head(grs_cs)

X <- matrices("X")
Y <- matrices("Y")

ars <- 1 / solve(crossprod(Z, X), crossprod(Z, Y))
head(ars)

ars_resid <- Y - X %*% (1 / ars)

mdl <- lm(as.numeric(ars_resid)^2 ~ prices$holding_period)
W <- Diagonal(x = 1 / fitted.values(mdl))

ars_cs <- 1 / solve(crossprod(Z, W %*% X), crossprod(Z, W %*% Y))
head(ars_cs)

ars_ew <- with(
  prices,
  1 / solve(crossprod(Z, X / price_prev), crossprod(Z, Y / price_prev))
)

head(ars_ew)

dimensions <- do.call(rbind, strsplit(rownames(grs), ".", fixed = TRUE))
grs_piar <- piar::as_index(
  data.frame(
    period = dimensions[, 2],
    city = dimensions[, 1],
    index =  as.numeric(grs)
  ),
  chainable = FALSE
)

head(grs_piar, c(5, 5))

grs <- c(setNames(rep(1, 5), paste(1:5, "2010-01-01", sep = ".")), grs[, 1])
ars <- c(setNames(rep(1, 5), paste(1:5, "2010-01-01", sep = ".")), ars[, 1])

geometric_contributions <- function(x) {
  (x - 1) * piar::transmute_weights(x, order = 0)
}

grs_contributions <- Map(
  \(df, df_prev) {
    impute_back <- with(
      df,
      price_prev / grs[paste(city, period_prev, sep = ".")]
    )
    names(impute_back) <- row.names(df)
    impute_forward <- with(df_prev, price / grs[paste(city, period, sep = ".")])
    names(impute_forward) <- row.names(df_prev)
    geometric_contributions(
      c(df$price / impute_back, df_prev$price_prev / impute_forward)
    )
  },
  split(prices, interaction(prices$city, prices$period)),
  split(prices, interaction(prices$city, prices$period_prev))
)

all.equal(sapply(grs_contributions, sum) + 1, grs)

range(unlist(grs_contributions))

arithmetic_contributions <- function(x, w) {
  (x - 1) * piar::transmute_weights(x, w, order = 1)
}

ars_contributions <- Map(
  \(df, df_prev) {
    impute_back <- with(
      df,
      price_prev / ars[paste(city, period_prev, sep = ".")]
    )
    names(impute_back) <- row.names(df)
    impute_forward <- with(df_prev, price / ars[paste(city, period, sep = ".")])
    names(impute_forward) <- row.names(df_prev)
    arithmetic_contributions(
      c(df$price / impute_back, df_prev$price_prev / impute_forward),
      c(impute_back, impute_forward)
    )
  },
  split(prices, interaction(prices$city, prices$period)),
  split(prices, interaction(prices$city, prices$period_prev))
)

all.equal(sapply(ars_contributions, sum) + 1, ars)

range(unlist(ars_contributions))