# -------------------------------------
# Script: crop_prices.R
# Author: Hugo Scherer
# Purpose: Preparing crop prices for EU FarmDyn
# Version: 0.0.0
# Date: 09.10.2023
# Notes: Not in use yet
#
# Copyright(c) 2023 Wageningen Economic Research
# -------------------------------------

# Crop prices calculation ----
crop_prices <- function(FADN2) {
    sales_value_var <- unique(
        sub(cropprod$item1, pattern = "PRQ", replacement = "SV")
    )

    crop_sales_quant <- pivot_longer(
        cols = -"ID", crop_sales_quant,
        names_to = "crop_new",
        values_to = "sales_quant"
    )

    crop_sv <- pivot_longer(FADN2[colnames(FADN2) %in% c("ID", sales_value_var)],
        cols = colnames(FADN2)[colnames(FADN2) %in% sales_value_var],
        names_to = c("salesvalue"),
        values_to = "SV"
    )

    sv_crop_new <- FADN2Dyn %>% select(salesvalue, crop_new)

    crop_sv <- merge(crop_sv, sv_crop_new)

    crop_sv <- crop_sv %>% pivot_wider(
        id_cols = c("ID"),
        names_from = "crop_new",
        values_from = "SV",
        values_fn = sum
    )

    crop_sv <- crop_sv %>%
        pivot_longer(
            cols = -"ID",
            names_to = "crop_new",
            values_to = "SV"
        )


    sv_prod <- left_join(crop_sv, crop_sales_quant, by = c("ID", "crop_new"))

    # Divide sales value over sales_quant to get the price
    sv_prod$price <- sv_prod$SV / sv_prod$sales_quant

    # Remove observations with NaNs and infinite values
    sv_prod <- sv_prod %>%
        filter(!is.na(price) & !is.infinite(price) & !is.nan(price))

    crop_prices <- pivot_wider(sv_prod,
        id_cols = c("ID"),
        names_from = "crop_new",
        values_from = "price"
    )

    # Remove outliers by removing the top 10% of all observations
    # for all columns and the bottom 10% of observations for all columns

    crop_prices <- crop_prices %>%
        mutate_if(is.numeric, ~ ifelse(. > quantile(., 0.9, na.rm = TRUE), NA, .)) %>%
        mutate_if(is.numeric, ~ ifelse(. < quantile(., 0.1, na.rm = TRUE), NA, .))

    # Replaces NaNs with NAs
    crop_prices[is.nan(crop_prices)] <- NA

    gdxreshape(crop_prices,
        symDim = 2, order = c(1, 0),
        gdxName = file.path(
            "data", "temp", "prices", "cropprices", "cropPrices_FADNtest"
        ),
        symName = "p_cropPrices"
    )

    id_nuts <- FADN2 %>%
        select("ID",
            "NUTS3", "NUTS2", "NUTS1", "NUTS0",
            Weight = "SYS02"
        )

    crop_prices_nuts <- merge(crop_prices, id_nuts, by = "ID")


    for (i in 0:3) {
        assign(
            paste0("crop_prices_nuts", i),
            crop_prices_nuts %>%
                dplyr::group_by(dplyr::across(paste0("NUTS", i))) %>%
                dplyr::summarise(dplyr::across(
                    everything(),
                    ~ if (is.numeric(.)) {
                        weighted.mean(.,
                            na.rm = TRUE, w = Weight
                        )
                    } else {
                        Modes(.)[1]
                    }
                )) %>%
                select(-"ID", -"Weight")
        )
    }

    # Replace NAs in crop_prices_nuts0 with the mean of the column
    crop_prices_nuts0[] <- lapply(crop_prices_nuts0, function(x) {
        if (is.numeric(x)) {
            x[is.na(x)] <- mean(x, na.rm = TRUE)
        }
        x
    })


    # Replace NAs in crop_prices_nutsX with values
    # from crop_prices_nuts0 that are not NA and have the same NUTS0.
    for (k in 0:3) {
        for (i in seq_len(nrow(get(paste0("crop_prices_nuts", k))))) {
            for (j in seq_along(get(paste0("crop_prices_nuts", k)))) {
                if (is.na(get(paste0("crop_prices_nuts", k)))[i, j]) {
                    df <- get(paste0("crop_prices_nuts", k))
                    df[i, j] <- crop_prices_nuts0[crop_prices_nuts0$NUTS0 == get(paste0("crop_prices_nuts", k))$NUTS0[i], j]
                    assign(paste0("crop_prices_nuts", k), df)
                }
            }
        }
    }

    # Remove superfluous columns
    # (they are just the most commonly appearing NUTS code)
    crop_prices_nuts3 <- crop_prices_nuts3 %>%
        select(-"NUTS0", -"NUTS1", -"NUTS2")

    crop_prices_nuts2 <- crop_prices_nuts2 %>%
        select(-"NUTS0", -"NUTS1", -"NUTS3")

    crop_prices_nuts1 <- crop_prices_nuts1 %>%
        select(-"NUTS0", -"NUTS2", -"NUTS3")

    crop_prices_nuts0 <- crop_prices_nuts0 %>%
        select(-"NUTS2", -"NUTS1", -"NUTS3")


    # Saving crop prices to GDX
    lapply(paste0("crop_prices_nuts", 0:3), function(x) {
        gdxreshape(get(x),
            symDim = 2, order = c(1, 0),
            gdxName = file.path(
                "data", "temp", "prices", "cropprices", paste0("crop_prices_", x)
            ),
            symName = "p_crop_prices",
        )
    })
}