## ----setup, include=FALSE------------------------------------------------ knitr::opts_chunk$set(echo = TRUE, collapse=TRUE, messages=FALSE, eval=TRUE) ## ----quiet_package_load, echo=FALSE-------------------------------------- suppressMessages(suppressWarnings(library(hpiR))) suppressMessages(suppressWarnings(library(knitr))) ## ----package_load-------------------------------------------------------- library(hpiR) ## ----load_data----------------------------------------------------------- data(seattle_sales) data(ex_sales) ## ----create_hpidata_obj-------------------------------------------------- sales_hdf <- dateToPeriod(trans_df = ex_sales, date = 'sale_date', periodicity = 'monthly') ## ----expand_time--------------------------------------------------------- salesx_hdf <- dateToPeriod(trans_df = ex_sales, date = 'sale_date', periodicity = 'monthly', min_date = as.Date('2009-12-01'), max_date = as.Date('2016-12-31')) ## ----adj_move------------------------------------------------------------ salesx_hdf <- dateToPeriod(trans_df = ex_sales, date = 'sale_date', periodicity = 'monthly', min_date = as.Date('2010-12-01'), max_date = as.Date('2015-12-31')) ## ----adj_clip------------------------------------------------------------ sales_hdf_clip <- dateToPeriod(trans_df = ex_sales, date = 'sale_date', periodicity = 'monthly', min_date = as.Date('2010-12-01'), max_date = as.Date('2015-12-31'), adj_type = 'clip') ## ----period_table_attr--------------------------------------------------- head(attr(sales_hdf, 'period_table')) ## ----create_rtdata------------------------------------------------------- sales_rtdf <- rtCreateTrans(trans_df = sales_hdf, prop_id = 'pinx', trans_id = 'sale_id', price = 'sale_price', min_period_dist = 12) ## ----rtdata_table, echo=FALSE-------------------------------------------- knitr::kable(head(sales_rtdf), row.names=FALSE) ## ----seq_only_true------------------------------------------------------- sales_rtdf_so <- rtCreateTrans(trans_df = sales_hdf, prop_id = 'pinx', trans_id = 'sale_id', price = 'sale_price', seq_only = TRUE) ## ----rtdata_table_so, echo=FALSE----------------------------------------- knitr::kable(head(sales_rtdf_so), row.names=FALSE) ## ----create_rtmodel------------------------------------------------------ rt_model <- hpiModel(model_type = 'rt', hpi_df = sales_rtdf, estimator = 'base', log_dep = TRUE) ## ----full_rtmodel-------------------------------------------------------- rt_full <- hpiModel(model_type = 'rt', hpi_df = sales_rtdf, estimator = 'base', log_dep = TRUE, trim_model = FALSE) object.size(rt_model) object.size(rt_full) ## ----create_rtindex------------------------------------------------------ rt_index <- modelToIndex(model_obj = rt_model) ## ----rtindex_short------------------------------------------------------- rt_short <- modelToIndex(model_obj = rt_model, max_period = 50) length(rt_short$value) ## ----index_plot, fig.width=7, fig.height=2.5----------------------------- plot(rt_index) ## ----imputation_example-------------------------------------------------- rt_model_imp <- rt_full rt_model_imp$coefficients$coefficient[3:5] <- NA rt_index_imp <- modelToIndex(model_obj = rt_model_imp) rt_index_imp$value[1:6] rt_index_imp$imputed[1:6] ## ----imp_plot, fig.width=7, fig.height=2.5------------------------------- rt_model_imp <- rt_full rt_model_imp$coefficients$coefficient[c(4, 7, 23, 55, 78, 83)] <- NA rt_index_imp <- modelToIndex(model_obj = rt_model_imp) plot(rt_index_imp, show_imputed=TRUE) ## ----rt_smooth----------------------------------------------------------- rt_smooth <- smoothIndex(index_obj = rt_index, order = 5) attr(rt_smooth, 'order') ## ----rtindex_inplace----------------------------------------------------- rt_index <- smoothIndex(index_obj = rt_index, order = 7, in_place = TRUE) names(rt_index) ## ----plot_smooth, fig.width=7, fig.height=3------------------------------ plot(rt_index, smooth=TRUE) ## ----rtindex_opt1-------------------------------------------------------- rt_1 <- rtIndex(trans_df = ex_sales, periodicity = 'monthly', min_date = '2010-06-01', max_date = '2015-11-30', adj_type = 'clip', date = 'sale_date', price = 'sale_price', trans_id = 'sale_id', prop_id = 'pinx', seq_only = TRUE, estimator = 'robust', log_dep = TRUE, trim_model = TRUE, max_period = 48, smooth = FALSE) ## ----rtindex_opt2_create_sales------------------------------------------- sales_hdf <- dateToPeriod(trans_df = ex_sales, date = 'sale_date', periodicity = 'monthly') ## ----rtindex_opt2-------------------------------------------------------- rt_2 <- rtIndex(trans_df = sales_hdf, date = 'sale_date', price = 'sale_price', trans_id = 'sale_id', prop_id = 'pinx', seq_only = FALSE, estimator = 'weighted', log_dep = FALSE, trim_model = FALSE, max_period = 56, smooth = TRUE) ## ----rtindex_opt3_create_sales------------------------------------------- sales_rtdf <- rtCreateTrans(trans_df = sales_hdf, prop_id = 'pinx', trans_id = 'sale_id', price = 'sale_price') ## ----rtindex_opt3-------------------------------------------------------- rt_3 <- rtIndex(trans_df = sales_rtdf, estimator = 'robust', log_dep = TRUE, trim_model = FALSE, max_period = 80, smooth = TRUE, smooth_order = 5) ## ----plot_rt3`, fig.width=7, fig.height=2.5------------------------------ plot(rt_3, smooth=TRUE) ## ----create_heddata------------------------------------------------------ sales_hhdf <- hedCreateTrans(trans_df = ex_sales, prop_id = 'pinx', trans_id = 'sale_id', price = 'sale_price', date= 'sale_date', periodicity = 'monthly') ## ----hedmodel_1---------------------------------------------------------- hed_model <- hpiModel(model_type = 'hed', hpi_df = sales_hhdf, estimator = 'base', dep_var = 'price', ind_var = c('tot_sf', 'beds', 'baths'), log_dep = TRUE) ## ----hedmodel_2---------------------------------------------------------- model_spec <- as.formula('log(price) ~ as.factor(baths) + tot_sf') hed_model <- hpiModel(model_type = 'hed', hpi_df = sales_hhdf, estimator = 'base', mod_spec = model_spec, log_dep = TRUE) ## ----hedmodel_rob-------------------------------------------------------- hed_model_rob <- hpiModel(model_type = 'hed', hpi_df = sales_hhdf, estimator = 'robust', dep_var = 'price', ind_var = c('tot_sf', 'beds', 'baths'), log_dep = TRUE) ## ----hedmodel_wgt-------------------------------------------------------- hed_model_wgt <- hpiModel(model_type = 'hed', hpi_df = sales_hhdf, estimator = 'weighted', dep_var = 'price', ind_var = c('tot_sf', 'beds', 'baths'), log_dep = FALSE, weights = runif(nrow(sales_hhdf), 0, 1)) ## ----hed_to_index-------------------------------------------------------- hed_index <- modelToIndex(model_obj = hed_model) ## ----plot_hedindex, fig.width=7, fig.height=2.5-------------------------- plot(hed_index) ## ----hed_1--------------------------------------------------------------- hed_1 <- hedIndex(trans_df = ex_sales, periodicity = 'monthly', min_date = '2010-06-01', max_date = '2015-11-30', adj_type = 'clip', date = 'sale_date', price = 'sale_price', trans_id = 'sale_id', prop_id = 'pinx', estimator = 'robust', log_dep = TRUE, trim_model = TRUE, max_period = 48, dep_var = 'price', ind_var = c('tot_sf', 'beds', 'baths'), smooth = FALSE) ## ----create_hed2_data---------------------------------------------------- sales_hdf <- dateToPeriod(trans_df = ex_sales, date = 'sale_date', periodicity = 'monthly', min_date = '2010-02-01', max_date = '2015-11-30', adj_type = 'move') ## ----create_hed2--------------------------------------------------------- hed_2 <- hedIndex(trans_df = sales_hdf, date = 'sale_date', price = 'sale_price', trans_id = 'sale_id', prop_id = 'pinx', estimator = 'base', log_dep = FALSE, trim_model = FALSE, max_period = 56, dep_var = 'price', ind_var = c('tot_sf', 'beds', 'baths'), smooth = TRUE) ## ----hed3_create_sales--------------------------------------------------- sales_hhdf <- hedCreateTrans(trans_df = sales_hdf, prop_id = 'pinx', trans_id = 'sale_id', price = 'sale_price') ## ----hed3---------------------------------------------------------------- hed_3 <- hedIndex(trans_df = sales_hhdf, estimator = 'weighted', log_dep = TRUE, trim_model = FALSE, max_period = 80, dep_var = 'price', ind_var = c('tot_sf', 'beds', 'baths'), weights = runif(nrow(sales_hhdf), 0, 1), smooth = TRUE, smooth_order = 5) ## ----plot_hed3, fig.width=7, fig.height=2.5------------------------------ plot(hed_3, smooth=TRUE) ## ----example_hpis-------------------------------------------------------- rt_hpi <- rtIndex(trans_df = sales_rtdf, estimator = 'robust', log_dep = TRUE, trim_model = FALSE, max_period = 84, smooth = TRUE) hed_hpi <- hedIndex(trans_df = sales_hhdf, estimator = 'weighted', log_dep = TRUE, trim_model = FALSE, max_period = 84, dep_var = 'price', ind_var = c('tot_sf', 'beds', 'baths'), weights = runif(nrow(sales_hhdf), 0, 1), smooth = TRUE) ## ----index_vol1---------------------------------------------------------- index_vol <- calcVolatility(index = hed_hpi$index$value, window = 3) names(index_vol) ## ----plot_vol, fig.width=7, fig.height=3.5------------------------------- plot(index_vol) ## ----indexvol_hpiindex--------------------------------------------------- # hpinindex object index_vol <- calcVolatility(index = hed_hpi$index, window = 3) # hpi object index_vol <- calcVolatility(index = hed_hpi, window = 3) ## ----indexvol_smooth----------------------------------------------------- # Direct passing sindex_vol <- calcVolatility(index = hed_hpi$index$smooth, window = 3) # While passing 'hpi' or 'hpiindex' sindex_vol <- calcVolatility(index = hed_hpi$index, window = 3, smooth = TRUE) ## ----indexvol_inplace---------------------------------------------------- # Add it to the 'hpiindex' object hed_hpi$index <- calcVolatility(index = hed_hpi$index, window = 3, in_place = TRUE) # Add it to the full 'hpi' object (to the hpiindex object) hed_hpi <- calcVolatility(index = hed_hpi, window = 3, in_place = TRUE) ## ----indexvol_inplace_smooth--------------------------------------------- hed_hpi <- calcVolatility(index = hed_hpi, window = 3, in_place = TRUE, smooth = TRUE) names(hed_hpi$index) ## ----indexvol_rename----------------------------------------------------- hed_index <- calcVolatility(index = hed_hpi$index, window = 3, in_place = TRUE, in_place_name = 'vol_3') names(hed_index) ## ----rt_is_acc----------------------------------------------------------- rt_is_accr <- calcAccuracy(hpi_obj = rt_hpi, test_type = 'rt', test_method = 'insample') attr(rt_is_accr, 'test_method') ## ----rt_is_accr_smooth--------------------------------------------------- rts_is_accr <- calcAccuracy(hpi_obj = rt_hpi, test_type = 'rt', test_method = 'insample', smooth = TRUE) ## ----rt_is_acc_inplace--------------------------------------------------- # Returns an accuracy object in place hed_hpi <- calcAccuracy(hpi_obj = hed_hpi, test_type = 'rt', test_method = 'insample', pred_df = sales_rtdf, in_place = TRUE, in_place_name = 'is_accuracy') names(hed_hpi) # Returns a smooth accuracy object in place hed_hpi <- calcAccuracy(hpi_obj = hed_hpi, test_type = 'rt', test_method = 'insample', smooth = TRUE, pred_df = rt_hpi$data, in_place = TRUE, in_place_name = 'smooth_is_accuracy') ## ----kf_accr------------------------------------------------------------- rt_kf_accr <- calcAccuracy(hpi_obj = rt_hpi, test_type = 'rt', test_method = 'kfold', k = 10, seed = 123) ## ----kf_accr_smooth------------------------------------------------------ rt_kf_accr_s <- calcAccuracy(hpi_obj = rt_hpi, test_type = 'rt', test_method = 'kfold', k = 10, seed = 123, smooth = TRUE) ## ----kf_accr_inplace----------------------------------------------------- hed_hpi <- calcAccuracy(hpi_obj = hed_hpi, test_type = 'rt', test_method = 'kfold', k = 10, seed = 1, pred_df = rt_hpi$data, in_place = TRUE, in_place_name = 'kf_accuracy') ## ----plot_accr, fig.keep = 'first', fig.width=7, fig.height=3------------ plot(hed_hpi$index$kf_accuracy) ## ----create_series, warning=FALSE, comments=FALSE, message=FALSE--------- rt_series <- createSeries(hpi_obj = rt_hpi, train_period = 24, max_period = 30) ## ----plot_series, fig.width=7, fig.height=3.5---------------------------- plot(rt_series) ## ----smooth_series------------------------------------------------------- rt_series <- smoothSeries(series_obj = rt_series, order = 5) ## ----vol_series---------------------------------------------------------- rt_series <- calcSeriesVolatility(series_obj = rt_series, window = 3, smooth = TRUE) ## ----series_acc_is------------------------------------------------------- rt_sacc <- calcSeriesAccuracy(series_obj = rt_series, test_method = 'insample', test_type = 'rt') class(rt_sacc) ## ----series_acc_smooth_inplace------------------------------------------- rt_series <- calcSeriesAccuracy(series_obj = rt_series, test_method = 'kfold', test_type = 'rt', smooth = TRUE, in_place=TRUE) ## ----summarize_series_acc------------------------------------------------ series_acc_summ <- calcSeriesAccuracy(series_obj = rt_series, test_method = 'insample', test_type = 'rt', summarize = TRUE) nrow(series_acc_summ) nrow(rt_series$accuracy) ## ----fct_accr------------------------------------------------------------ rt_series <- calcSeriesAccuracy(series_obj = rt_series, test_method = 'forecast', test_type = 'rt', smooth = TRUE, in_place = TRUE) ## ----eval=TRUE, messages=FALSE, echo=TRUE, fig.keep = 'first', fig.width=7, fig.height=3---- plot(rt_series$accuracy_smooth) ## ----series_rev---------------------------------------------------------- # Return to a revision object rt_rev <- calcRevision(series_obj = rt_series) # Return in place (with smooth) rt_series <- calcRevision(series_obj = rt_series, in_place = TRUE, smooth = TRUE) names(rt_series) ## ----plot_rtrev, fig.width=7, fig.height=3.5----------------------------- plot(rt_rev, measure='median') ## ----rf_index------------------------------------------------------------ rf_index <- rfIndex(trans_df = sales_hhdf, date = 'sale_date', price = 'sale_price', trans_id = 'sale_id', prop_id = 'pinx', estimator = 'pdp', periodicity = 'monthly', dep_var = 'price', ind_var = c('tot_sf', 'beds', 'baths'), smooth = FALSE, sim_ids = 1:10, ntrees = 16) ## ----plot_rf_index, fig.width=7, fig.height=3.5-------------------------- plot(rf_index)