inst/doc/VisitorCounts.R

In VisitorCounts: Modeling and Forecasting Visitor Counts Using Social Media

## -----------------------------------------------------------------------------
library(VisitorCounts)
data("park_visitation")
data("flickr_userdays")

## ----fig.width = 7, fig.height = 5--------------------------------------------



yellowstone_pud <- park_visitation[park_visitation$park == "YELL",]$pud #photo user days
yellowstone_nps <- park_visitation[park_visitation$park == "YELL",]$nps #national park service counts

yellowstone_pud <- ts(yellowstone_pud, start = 2005, freq = 12)
yellowstone_nps <- ts(yellowstone_nps, start = 2005, freq = 12)

log_yellowstone_pud <- log(yellowstone_pud)
log_yellowstone_nps <- log(yellowstone_nps)

log_flickr_userdays <- log(flickr_userdays)

## ----fig.width = 7, fig.height = 5--------------------------------------------
plot(log_yellowstone_pud, main = "Yellowstone Photo-User-Days (PUD)", ylab = "PUD")
plot(log_yellowstone_nps, main = "Yellowstone National Park Service Visitation Counts (NPS)", ylab = "NPS")
plot(log_flickr_userdays, main = "Log US Flickr user-days", ylab = "UD")

## -----------------------------------------------------------------------------
yell_visitation_model <- visitation_model(log_yellowstone_pud,
                                          log_flickr_userdays, is_output_logged = TRUE, is_input_logged = TRUE)

## -----------------------------------------------------------------------------
yell_visitation_model_nps <- visitation_model(log_yellowstone_pud,
                                              log_flickr_userdays,
                                              ref_series = log_yellowstone_nps, is_output_logged = TRUE, is_input_logged = TRUE)

## ----fig.width = 7, fig.height = 5--------------------------------------------
true_differences <- diff(log_yellowstone_nps)
lower_bound <- min(c(true_differences,diff(yell_visitation_model$visitation_fit)))-1
upper_bound <- max(c(true_differences,diff(yell_visitation_model$visitation_fit)))

plot(yell_visitation_model, ylim = c(lower_bound, upper_bound), lwd = 2)
lines(diff(log_yellowstone_nps), col = "red")
legend("bottom",c("Model Fit","True Differences"),col = c("black","red"),lty = c(1,1))

## ----fig.width = 7, fig.height = 5--------------------------------------------
true_differences <- diff(log_yellowstone_nps)
lower_bound <- min(c(true_differences,diff(yell_visitation_model_nps$visitation_fit)))-1
upper_bound <- max(c(true_differences,diff(yell_visitation_model_nps$visitation_fit)))

plot(yell_visitation_model_nps, ylim = c(lower_bound, upper_bound), 
     lwd = 2,
     main = "Fitted Values for Visitation Model (NPS assisted)", difference = TRUE)
lines(true_differences, col = "red")
legend("bottom",c("Model Fit","True Differences"),col = c("black","red"),lty = c(1,1))

## -----------------------------------------------------------------------------
summary(yell_visitation_model)
summary(yell_visitation_model_nps)

## -----------------------------------------------------------------------------
yellowstone_visitation_forecasts <- predict(yell_visitation_model, n_ahead = 12)
yellowstone_visitation_forecasts_nps <- predict(yell_visitation_model_nps, n_ahead = 12)

yellowstone_visitation_forecasts_withpast <- predict(yell_visitation_model, n_ahead = 12, only_new = FALSE)

## ----fig.width = 7, fig.height = 5--------------------------------------------
plot(yellowstone_visitation_forecasts, difference = TRUE)
plot(yellowstone_visitation_forecasts_nps, main = "Forecasts for Visitation Model (NPS Assisted)", date_label = "%b", date_breaks = "1 month")


plot(yellowstone_visitation_forecasts_withpast, difference = TRUE, date_breaks = "1 year", date_label = "%y")

## -----------------------------------------------------------------------------
summary(yellowstone_visitation_forecasts)
summary(yellowstone_visitation_forecasts_nps)

## -----------------------------------------------------------------------------
yell_pud_decomposition <- auto_decompose(yellowstone_pud)

## ----fig.width = 7, fig.height = 5--------------------------------------------
plot(yell_pud_decomposition, type = "full")
plot(yell_pud_decomposition, type = "period")
plot(yell_pud_decomposition, type = "classical")

## -----------------------------------------------------------------------------
summary(yell_pud_decomposition)

## ----fig.width = 7, fig.height =5---------------------------------------------
plot(predict(yell_pud_decomposition, n_ahead = 12)$forecast, main = "Decomposition 12-ahead Forecast", ylab = "Forecast Value")