Load Libraries and connect to board

library(tidyverse)
## ── Attaching packages ────────────────────────────────── tidyverse 1.2.1 ──
## ✔ ggplot2 3.2.0     ✔ purrr   0.3.2
## ✔ tibble  2.1.3     ✔ dplyr   0.8.3
## ✔ tidyr   0.8.3     ✔ stringr 1.4.0
## ✔ readr   1.3.1     ✔ forcats 0.4.0
## ── Conflicts ───────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
library(tidymodels)
## This version of Shiny is designed to work with 'htmlwidgets' >= 1.5.
##     Please upgrade via install.packages('htmlwidgets').
## Registered S3 method overwritten by 'xts':
##   method     from
##   as.zoo.xts zoo
## ── Attaching packages ───────────────────────────────── tidymodels 0.0.2 ──
## ✔ broom     0.5.2       ✔ recipes   0.1.6  
## ✔ dials     0.0.2       ✔ rsample   0.0.5  
## ✔ infer     0.4.0.1     ✔ yardstick 0.0.3  
## ✔ parsnip   0.0.2
## ── Conflicts ──────────────────────────────────── tidymodels_conflicts() ──
## ✖ scales::discard() masks purrr::discard()
## ✖ dplyr::filter()   masks stats::filter()
## ✖ recipes::fixed()  masks stringr::fixed()
## ✖ dplyr::lag()      masks stats::lag()
## ✖ yardstick::spec() masks readr::spec()
## ✖ recipes::step()   masks stats::step()
library(bikeHelpR)
library(xgboost)
## 
## Attaching package: 'xgboost'
## The following object is masked from 'package:dplyr':
## 
##     slice

Get data

con <- DBI::dbConnect(odbc::odbc(), "Content DB")
pins::board_register_rsconnect(server = "https://colorado.rstudio.com/rsc",
                               key = Sys.getenv("RSTUDIOCONNECT_API_KEY"))
df <- tbl(con, "bike_model_data") 
model_params <- pins::pin_get("bike_model_params", board = "rsconnect")

train <- bike_train_dat(con, model_params$split_date)
## Using data on or before 2020-11-17 for training.

Make recipe for model

# downsample if working interactively
if (interactive()) {
  train <- dplyr::sample_frac(train, 0.5)
}

train_mat <- model_params$recipe %>%
  bake(train)

Train and Save Model

mod <- parsnip::xgb_train(
  train_mat %>% select(-n_bikes, -id, -date), 
  train_mat %>% pull(n_bikes), 
  nrounds = ifelse(interactive(), 50, 500)
)

Save model as pin with some metadata

list(model = mod,
     train_date = model_params$train_date, 
     split_date = model_params$split_date, 
     recipe = model_params$recipe) %>%
pins::pin("bike_model_rxgb", 
          "Model of Capitol Citybikes Available per Station", 
          board = "rsconnect")
## $model
## ##### xgb.Booster
## Handle is invalid! Suggest using xgb.Booster.complete
## raw: 2.2 Mb 
## call:
##   xgboost::xgb.train(params = list(eta = 0.3, max_depth = 6, gamma = 0, 
##     colsample_bytree = 1, min_child_weight = 1, subsample = 1), 
##     data = x, nrounds = 500, objective = "reg:linear")
## params (as set within xgb.train):
##   eta = "0.3", max_depth = "6", gamma = "0", colsample_bytree = "1", min_child_weight = "1", subsample = "1", objective = "reg:linear", silent = "1"
## callbacks:
##   cb.print.evaluation(period = print_every_n)
## # of features: 10 
## niter: 500
## nfeatures : 10 
## 
## $train_date
## [1] "2020-11-19"
## 
## $split_date
## [1] "2020-11-17"
## 
## $recipe
## Data Recipe
## 
## Inputs:
## 
##       role #variables
##    outcome          1
##  predictor          7
## 
## Training data contained 2538723 data points and no missing data.
## 
## Operations:
## 
## Dummy variables from dow [trained]