R Under development (unstable) (2023-08-09 r84924 ucrt) -- "Unsuffered Consequences" Copyright (C) 2023 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## ----------------------------------------------------------------------------- > library(piar) > > head(ms_prices) period business product price 1 202001 B1 1 1.14 2 202001 B1 2 NA 3 202001 B1 3 6.09 4 202001 B2 4 6.23 5 202001 B2 5 8.61 6 202001 B2 6 6.40 > > ms_weights business classification weight 1 B1 11 553 2 B2 11 646 3 B3 11 312 4 B4 12 622 5 B5 12 330 > > ## ----------------------------------------------------------------------------- > relative <- with(ms_prices, price_relative(price, period, product)) > > (ms_epr <- with(ms_prices, elemental_index(relative, period, business, na.rm = TRUE))) 202001 202002 202003 202004 B1 1 0.8949097 0.3342939 NaN B2 1 NaN NaN 2.770456 B3 1 2.0200036 1.6353355 0.537996 B4 NaN NaN NaN 4.576286 > > ## ----------------------------------------------------------------------------- > ms_epr[, "202004"] 202004 B1 NaN B2 2.770456 B3 0.537996 B4 4.576286 > ms_epr["B1", ] 202001 202002 202003 202004 B1 1 0.8949097 0.3342939 NaN > > ## ----------------------------------------------------------------------------- > hierarchy <- with(ms_weights, c(expand_classification(classification), list(business))) > > pias <- aggregation_structure(hierarchy, ms_weights$weight) > > ## ----------------------------------------------------------------------------- > (ms_index <- aggregate(ms_epr, pias, na.rm = TRUE)) 202001 202002 202003 202004 1 1 1.3007239 1.0630743 2.734761 11 1 1.3007239 1.0630743 1.574515 12 1 1.3007239 1.0630743 4.576286 B1 1 0.8949097 0.3342939 1.574515 B2 1 1.3007239 1.0630743 2.770456 B3 1 2.0200036 1.6353355 0.537996 B4 1 1.3007239 1.0630743 4.576286 B5 1 1.3007239 1.0630743 4.576286 > > ## ----------------------------------------------------------------------------- > (ms_index_chained <- chain(ms_index)) 202001 202002 202003 202004 1 1 1.3007239 1.3827662 3.7815355 11 1 1.3007239 1.3827662 2.1771866 12 1 1.3007239 1.3827662 6.3279338 B1 1 0.8949097 0.2991629 0.4710366 B2 1 1.3007239 1.3827662 3.8308934 B3 1 2.0200036 3.3033836 1.7772072 B4 1 1.3007239 1.3827662 6.3279338 B5 1 1.3007239 1.3827662 6.3279338 > > ## ----------------------------------------------------------------------------- > t(apply(as.matrix(ms_index), 1, cumprod)) 202001 202002 202003 202004 1 1 1.3007239 1.3827662 3.7815355 11 1 1.3007239 1.3827662 2.1771866 12 1 1.3007239 1.3827662 6.3279338 B1 1 0.8949097 0.2991629 0.4710366 B2 1 1.3007239 1.3827662 3.8308934 B3 1 2.0200036 3.3033836 1.7772072 B4 1 1.3007239 1.3827662 6.3279338 B5 1 1.3007239 1.3827662 6.3279338 > > ## ----------------------------------------------------------------------------- > rebase(ms_index_chained, ms_index_chained[, "202004"]) 202001 202002 202003 202004 1 0.2644428 0.3439671 0.3656626 1 11 0.4593084 0.5974334 0.6351161 1 12 0.1580295 0.2055527 0.2185178 1 B1 2.1229774 1.8998731 0.6351161 1 B2 0.2610357 0.3395354 0.3609514 1 B3 0.5626806 1.1366169 1.8587499 1 B4 0.1580295 0.2055527 0.2185178 1 B5 0.1580295 0.2055527 0.2185178 1 > > ## ----------------------------------------------------------------------------- > rebase(ms_index_chained, rowMeans(as.matrix(ms_index_chained)[, c("202003", "202004")])) 202001 202002 202003 202004 1 0.3872740 0.5037366 0.5355095 1.4644905 11 0.5618052 0.7307535 0.7768452 1.2231548 12 0.2593798 0.3373815 0.3586616 1.6413384 B1 2.5967299 2.3238388 0.7768452 1.2231548 B2 0.3836077 0.4989677 0.5304398 1.4695602 B3 0.3936550 0.7951845 1.3003935 0.6996065 B4 0.2593798 0.3373815 0.3586616 1.6413384 B5 0.2593798 0.3373815 0.3586616 1.6413384 > > ## ----------------------------------------------------------------------------- > (ms_weights <- transform(ms_weights, stratum = c("TS", "TA", "TS", "TS", "TS"))) business classification weight stratum 1 B1 11 553 TS 2 B2 11 646 TA 3 B3 11 312 TS 4 B4 12 622 TS 5 B5 12 330 TS > > ## ----------------------------------------------------------------------------- > (classification_sps <- with(ms_weights, paste0(classification, stratum))) [1] "11TS" "11TA" "11TS" "12TS" "12TS" > > ## ----------------------------------------------------------------------------- > (classification_sps <- expand_classification(classification_sps, width = c(1, 1, 2))) [[1]] [1] "1" "1" "1" "1" "1" [[2]] [1] "11" "11" "11" "12" "12" [[3]] [1] "11TS" "11TA" "11TS" "12TS" "12TS" > pias_sps <- with( + ms_weights, + aggregation_structure(c(classification_sps, list(business)), weight) + ) > > ## ----------------------------------------------------------------------------- > aggregate(ms_epr, pias_sps, na.rm = TRUE) 202001 202002 202003 202004 1 1 1.3007239 1.0630743 2.684412 11 1 1.3007239 1.0630743 1.492443 12 1 1.3007239 1.0630743 4.576286 11TA 1 1.3007239 1.0630743 2.770456 11TS 1 1.3007239 1.0630743 0.537996 12TS 1 1.3007239 1.0630743 4.576286 B1 1 0.8949097 0.3342939 0.537996 B2 1 1.3007239 1.0630743 2.770456 B3 1 2.0200036 1.6353355 0.537996 B4 1 1.3007239 1.0630743 4.576286 B5 1 1.3007239 1.0630743 4.576286 > > ## ----------------------------------------------------------------------------- > ms_epr2 <- ms_epr > ms_epr2["B2", 2:3] <- 1 > ms_epr2 202001 202002 202003 202004 B1 1 0.8949097 0.3342939 NaN B2 1 1.0000000 1.0000000 2.770456 B3 1 2.0200036 1.6353355 0.537996 B4 NaN NaN NaN 4.576286 > > ## ----------------------------------------------------------------------------- > aggregate(ms_epr2, pias, na.rm = TRUE) 202001 202002 202003 202004 1 1 1.1721550 1.0400686 2.626560 11 1 1.1721550 1.0400686 1.398142 12 1 1.1721550 1.0400686 4.576286 B1 1 0.8949097 0.3342939 1.398142 B2 1 1.0000000 1.0000000 2.770456 B3 1 2.0200036 1.6353355 0.537996 B4 1 1.1721550 1.0400686 4.576286 B5 1 1.1721550 1.0400686 4.576286 > > ## ----------------------------------------------------------------------------- > with(ms_prices, elemental_index(relative, period, business, na.rm = TRUE, r = 1)) 202001 202002 202003 202004 B1 1 0.8949097 0.3342939 NaN B2 1 NaN NaN 5.155942 B3 1 23.7480455 2.4900997 0.607197 B4 NaN NaN NaN 9.368610 > > ## ----------------------------------------------------------------------------- > with(ms_prices, elemental_index(relative, period, business, na.rm = TRUE, r = -1)) 202001 202002 202003 202004 B1 1 0.8949097 0.3342939 NaN B2 1 NaN NaN 1.7205750 B3 1 0.6591433 0.8185743 0.4746769 B4 NaN NaN NaN 2.2353790 > > ## ----------------------------------------------------------------------------- > ms_prices2 <- transform(ms_prices, quantity = 10 - price) > > ## ----------------------------------------------------------------------------- > library(gpindex) > > tw <- grouped(index_weights("Tornqvist")) > > ms_prices2[c("back_price", "back_quantity")] <- + ms_prices2[back_period(ms_prices2$period, ms_prices2$product), c("price", "quantity")] > > ms_prices2 <- na.omit(ms_prices2) # can't have NAs for Tornqvist weights > > ms_prices2$weight <- with( + ms_prices2, + tw(price, back_price, quantity, back_quantity, group = interaction(period, business)) + ) > > ## ----------------------------------------------------------------------------- > with(ms_prices2, elemental_index(price / back_price, period, business, weight)) 202001 202002 202003 202004 B1 1 0.8949097 0.3342939 NaN B2 1 NaN NaN 2.165152 B3 1 0.9520982 1.5913929 0.542372 B4 NaN NaN NaN 5.904237 > > ## ----------------------------------------------------------------------------- > ms_epr <- with(ms_prices, elemental_index(relative, period, business, contrib = TRUE, na.rm = TRUE)) > > ## ----------------------------------------------------------------------------- > contrib(ms_epr) 202001 202002 202003 202004 1 0 0.0000000 0.0000000 0 2 NA NA -0.6657061 0 3 0 -0.1050903 NA NA > > ## ----------------------------------------------------------------------------- > ms_prices1 <- subset(ms_prices, period <= "202003") > ms_prices2 <- subset(ms_prices, period >= "202003") > > ## ----------------------------------------------------------------------------- > ms_epr1 <- with( + ms_prices1, + elemental_index(price_relative(price, period, product), period, business, na.rm = TRUE) + ) > > (ms_index1 <- aggregate(ms_epr1, pias, na.rm = TRUE)) 202001 202002 202003 1 1 1.3007239 1.0630743 11 1 1.3007239 1.0630743 12 1 1.3007239 1.0630743 B1 1 0.8949097 0.3342939 B2 1 1.3007239 1.0630743 B3 1 2.0200036 1.6353355 B4 1 1.3007239 1.0630743 B5 1 1.3007239 1.0630743 > > ## ----------------------------------------------------------------------------- > ms_epr2 <- with( + subset(transform(ms_prices2, rel = price_relative(price, period, product)), period > "202003"), + elemental_index(rel, period, business, na.rm = TRUE) + ) > > ## ----------------------------------------------------------------------------- > (ms_index2 <- aggregate(ms_epr2, update(pias, ms_index1), na.rm = TRUE)) 202004 1 2.734761 11 1.574515 12 4.576286 B1 1.574515 B2 2.770456 B3 0.537996 B4 4.576286 B5 4.576286 > > ## ----------------------------------------------------------------------------- > chain(stack(ms_index1, ms_index2)) 202001 202002 202003 202004 1 1 1.3007239 1.3827662 3.7815355 11 1 1.3007239 1.3827662 2.1771866 12 1 1.3007239 1.3827662 6.3279338 B1 1 0.8949097 0.2991629 0.4710366 B2 1 1.3007239 1.3827662 3.8308934 B3 1 2.0200036 3.3033836 1.7772072 B4 1 1.3007239 1.3827662 6.3279338 B5 1 1.3007239 1.3827662 6.3279338 > > ## ----------------------------------------------------------------------------- > (ms_epr2 <- with( + ms_prices, + elemental_index(price_relative(carry_forward(price, period, product), period, product), + period, business, na.rm = TRUE) + ) + ) 202001 202002 202003 202004 B1 1 0.8949097 0.5781816 1.000000 B2 1 1.0000000 0.1777227 2.770456 B3 1 2.0200036 1.6353355 0.537996 B4 NaN NaN NaN 4.576286 > > ## ----------------------------------------------------------------------------- > (ms_index <- aggregate(ms_epr2, pias, na.rm = TRUE)) 202001 202002 202003 202004 1 1 1.1721550 0.8082981 2.2653614 11 1 1.1721550 0.8082981 0.8093718 12 1 1.1721550 0.8082981 4.5762862 B1 1 0.8949097 0.5781816 1.0000000 B2 1 1.0000000 0.1777227 2.7704563 B3 1 2.0200036 1.6353355 0.5379960 B4 1 1.1721550 0.8082981 4.5762862 B5 1 1.1721550 0.8082981 4.5762862 > > ## ----------------------------------------------------------------------------- > ms_prices1 <- subset(ms_prices, business %in% c("B1", "B2", "B3")) > ms_prices2 <- subset(ms_prices, business == "B4") > > ## ----------------------------------------------------------------------------- > ms_epr1 <- with( + ms_prices1, + elemental_index(price_relative(price, period, product), period, business, na.rm = TRUE) + ) > ms_epr1 202001 202002 202003 202004 B1 1 0.8949097 0.3342939 NaN B2 1 NaN NaN 2.770456 B3 1 2.0200036 1.6353355 0.537996 > ms_epr2 <- with( + transform(ms_prices2, period = factor(period, levels = time(ms_epr1))), + elemental_index(price_relative(price, period, product), period, business, na.rm = TRUE) + ) > ms_epr2 202001 202002 202003 202004 B4 NaN NaN NaN 4.576286 > > ## ----------------------------------------------------------------------------- > aggregate(merge(ms_epr1, ms_epr2), pias, na.rm = TRUE) 202001 202002 202003 202004 1 1 1.3007239 1.0630743 2.734761 11 1 1.3007239 1.0630743 1.574515 12 1 1.3007239 1.0630743 4.576286 B1 1 0.8949097 0.3342939 1.574515 B2 1 1.3007239 1.0630743 2.770456 B3 1 2.0200036 1.6353355 0.537996 B4 1 1.3007239 1.0630743 4.576286 B5 1 1.3007239 1.0630743 4.576286 > > ## ----------------------------------------------------------------------------- > ms_prices2 <- subset( + as.data.frame(aggregate(ms_epr, pias, na.rm = TRUE)), + level %in% c("B4", "B5") + ) > ms_prices2 period level value 7 202001 B4 1.000000 8 202001 B5 1.000000 15 202002 B4 1.300724 16 202002 B5 1.300724 23 202003 B4 1.063074 24 202003 B5 1.063074 31 202004 B4 4.576286 32 202004 B5 4.576286 > > ## ----------------------------------------------------------------------------- > ms_epr2 <- with(ms_prices2, elemental_index(value, period, level)) > aggregate(merge(ms_epr1, ms_epr2), pias, na.rm = TRUE) 202001 202002 202003 202004 1 1 1.3007239 1.0630743 2.734761 11 1 1.3007239 1.0630743 1.574515 12 1 1.3007239 1.0630743 4.576286 B1 1 0.8949097 0.3342939 1.574515 B2 1 1.3007239 1.0630743 2.770456 B3 1 2.0200036 1.6353355 0.537996 B4 1 1.3007239 1.0630743 4.576286 B5 1 1.3007239 1.0630743 4.576286 > > ## ----------------------------------------------------------------------------- > weights <- data.frame(period = rep(c("202001", "202002", "202003", "202004"), each = 5), + classification = ms_weights$classification, + weight = 1:20) > head(weights) period classification weight 1 202001 11 1 2 202001 11 2 3 202001 11 3 4 202001 12 4 5 202001 12 5 6 202002 11 6 > > ## ----------------------------------------------------------------------------- > (ms_epr <- unstack(ms_epr)) $`202001` 202001 B1 1 B2 1 B3 1 B4 NaN $`202002` 202002 B1 0.8949097 B2 NaN B3 2.0200036 B4 NaN $`202003` 202003 B1 0.3342939 B2 NaN B3 1.6353355 B4 NaN $`202004` 202004 B1 NaN B2 2.770456 B3 0.537996 B4 4.576286 > > ## ----------------------------------------------------------------------------- > pias <- with( + weights, + Map(aggregation_structure, + list(hierarchy), + split(weight, period)) + ) > > ## ----------------------------------------------------------------------------- > (paasche <- Reduce(stack, Map(aggregate, ms_epr, pias, na.rm = TRUE, r = -1))) 202001 202002 202003 202004 1 1 1.3127080 0.5874490 1.3591916 11 1 1.3127080 0.5874490 0.8839797 12 1 1.3127080 0.5874490 4.5762862 B1 1 0.8949097 0.3342939 0.8839797 B2 1 1.3127080 0.5874490 2.7704563 B3 1 2.0200036 1.6353355 0.5379960 B4 1 1.3127080 0.5874490 4.5762862 B5 1 1.3127080 0.5874490 4.5762862 > > ## ----------------------------------------------------------------------------- > laspeyres <- Reduce(stack, Map(aggregate, ms_epr, pias[c(1, 1, 2, 3)], na.rm = TRUE)) > sqrt(as.matrix(laspeyres) * as.matrix(paasche)) 202001 202002 202003 202004 1 1 1.5107763 0.7956890 1.996688 11 1 1.5107763 0.7956890 1.192826 12 1 1.5107763 0.7956890 4.576286 B1 1 0.8949097 0.3342939 1.192826 B2 1 1.5107763 0.7956890 2.770456 B3 1 2.0200036 1.6353355 0.537996 B4 1 1.5107763 0.7956890 4.576286 B5 1 1.5107763 0.7956890 4.576286 > > > proc.time() user system elapsed 0.20 0.06 0.25