INFO-H510 Week 12 Data Dive

library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.0     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(ggthemes)
library(ggrepel)
library(xts)

## Loading required package: zoo
## 
## Attaching package: 'zoo'
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## 
## 
## ######################### Warning from 'xts' package ##########################
## #                                                                             #
## # The dplyr lag() function breaks how base R's lag() function is supposed to  #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or       #
## # source() into this session won't work correctly.                            #
## #                                                                             #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop           #
## # dplyr from breaking base R's lag() function.                                #
## #                                                                             #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning.  #
## #                                                                             #
## ###############################################################################
## 
## Attaching package: 'xts'
## 
## The following objects are masked from 'package:dplyr':
## 
##     first, last

library(tsibble)

## 
## Attaching package: 'tsibble'
## 
## The following object is masked from 'package:zoo':
## 
##     index
## 
## The following object is masked from 'package:lubridate':
## 
##     interval
## 
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, union

library(ggplot2)

theme_set(theme_minimal())


data <- read_delim("pageviews-20150701-20240407.csv", delim = ",")

## Rows: 3204 Columns: 2
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl  (1): Churning (finance)
## date (1): Date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

data <- data |>
            rename(views = "Churning (finance)")

str(data)

## spc_tbl_ [3,204 × 2] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ Date : Date[1:3204], format: "2015-07-01" "2015-07-02" ...
##  $ views: num [1:3204] 52 48 30 15 26 55 44 48 53 46 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   Date = col_date(format = ""),
##   ..   `Churning (finance)` = col_double()
##   .. )
##  - attr(*, "problems")=<externalptr>

data

## # A tibble: 3,204 × 2
##    Date       views
##    <date>     <dbl>
##  1 2015-07-01    52
##  2 2015-07-02    48
##  3 2015-07-03    30
##  4 2015-07-04    15
##  5 2015-07-05    26
##  6 2015-07-06    55
##  7 2015-07-07    44
##  8 2015-07-08    48
##  9 2015-07-09    53
## 10 2015-07-10    46
## # ℹ 3,194 more rows

In the data the column Churning (finance) represents the number of page visits from the particular day. Let the response variable be Churning (finance) column, which has been renamed to views and the Date column is the explanatory variable.

data_ts <-as_tsibble(data, index=Date)

data_ts

## # A tsibble: 3,204 x 2 [1D]
##    Date       views
##    <date>     <dbl>
##  1 2015-07-01    52
##  2 2015-07-02    48
##  3 2015-07-03    30
##  4 2015-07-04    15
##  5 2015-07-05    26
##  6 2015-07-06    55
##  7 2015-07-07    44
##  8 2015-07-08    48
##  9 2015-07-09    53
## 10 2015-07-10    46
## # ℹ 3,194 more rows

data_ts |>
ggplot() +
  geom_line(mapping = aes(x=Date, y=views)) +
  theme_hc()

data_ts |>
  ggplot(mapping = aes(x = Date, y = views)) +
  geom_point(size=1, shape='O') +
  geom_smooth(span=0.2, color = 'blue', se=FALSE) +
  theme_hc()

## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

From these two information that immediately stands out is that -

During the early days of the page entry the number of views was highly variable, as seen the 1st visualization the longer lines at start and in the 2nd visualization the highly disperse data points at start indicate that a highly variable number of views.
The highest number of views the page received were also during the early days, and a gradual decrease in the number of views can be seen. A downward trend in general can be observed.
Further, the number of views for the page are all-time low at the moment. While there was a period during the year 2018 where the number of views were low, but the current number views is the all-time low.
Due the local minima in the 2018’s and local maxima during the 2020’s the trend was not perfectly downward. So, therefore a linear regression model cannot fit the data perfectly. But it could perform fairly well as there is a downward trend.

Visualizing Multiple Time-windows

2016-20

data_ts |>
  filter_index("2016" ~ "2020") |>
  ggplot() +
    geom_line(mapping = aes(x=Date, y=views)) +
    theme_hc()

data_ts |>
  filter_index("2016" ~ "2020") |>
  ggplot(mapping = aes(x = Date, y = views)) +
  geom_point(size=1, shape='O') +
  geom_smooth(span=0.2, color = 'blue', se=FALSE) +
  theme_hc()

## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

2020-24

data_ts |>
  filter_index("2020" ~ "2024") |>
  ggplot() +
    geom_line(mapping = aes(x=Date, y=views)) +
    theme_hc()

data_ts |>
  filter_index("2020" ~ "2024") |>
  ggplot(mapping = aes(x = Date, y = views)) +
  geom_point(size=1, shape='O') +
  geom_smooth(span=0.2, color = 'blue', se=FALSE) +
  theme_hc()

## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

2018-22

data_ts |>
  filter_index("2018" ~ "2022") |>
  ggplot() +
    geom_line(mapping = aes(x=Date, y=views)) +
    theme_hc()

data_ts |>
  filter_index("2018" ~ "2022") |>
  ggplot(mapping = aes(x = Date, y = views)) +
  geom_point(size=1, shape='O') +
  geom_smooth(span=0.2, color = 'blue', se=FALSE) +
  theme_hc()

## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

Linear Regression Models

Model 1 - Entire Data

model_1 <- lm(views ~ Date, data=data_ts)
summary(model_1)

## 
## Call:
## lm(formula = views ~ Date, data = data_ts)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -23.856  -5.638  -0.799   4.790  73.635 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.686e+02  3.263e+00   51.67   <2e-16 ***
## Date        -8.149e-03  1.789e-04  -45.56   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 9.364 on 3202 degrees of freedom
## Multiple R-squared:  0.3933, Adjusted R-squared:  0.3931 
## F-statistic:  2076 on 1 and 3202 DF,  p-value: < 2.2e-16

From the model coefficients a negative value to the Date variable indicates that the downward trend. But looking at the data it is clear that the slope should have much more negative, this is due to the fact that there are more number of data points in the time period 2020-24, and thereby skewing the model. From this regression a downward trend can be observed and it is a fairly strong trend, as there are periods where the trend isn’t downward.

Since there are multiple trends in the dataset, sub-setting the dataset is essential.

Model 2 - 2020-24

data_ts_2 <- data_ts |>
  filter_index("2020" ~ "2024")

model_2 <- lm(views ~ Date, data=data_ts_2)
summary(model_2)

## 
## Call:
## lm(formula = views ~ Date, data = data_ts_2)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -14.4599  -3.9300  -0.5259   3.5257  31.5902 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.247e+02  6.208e+00    36.2   <2e-16 ***
## Date        -1.105e-02  3.259e-04   -33.9   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5.792 on 1557 degrees of freedom
## Multiple R-squared:  0.4246, Adjusted R-squared:  0.4242 
## F-statistic:  1149 on 1 and 1557 DF,  p-value: < 2.2e-16

From the model coefficients it can be seen that value is Date coefficient is still negative but the value is significantly larger compared to earlier, indicating this period data did skew did original model. Here the trend is much more stronger compared to earlier.

Model 3 - 2018-20

data_ts_2 <- data_ts |>
  filter_index("2018" ~ "2020")

model_3 <- lm(views ~ Date, data=data_ts_2)
summary(model_3)

## 
## Call:
## lm(formula = views ~ Date, data = data_ts_2)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -17.0546  -5.5858  -0.7002   4.9918  31.2232 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -4.704e+01  1.367e+01  -3.442    6e-04 ***
## Date         3.754e-03  7.558e-04   4.967  7.9e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 7.917 on 1094 degrees of freedom
## Multiple R-squared:  0.02205,    Adjusted R-squared:  0.02116 
## F-statistic: 24.67 on 1 and 1094 DF,  p-value: 7.9e-07

In this model the coefficient value if positive indicating a upward trend and 2018-20 is the only period where an upward trend is being observed and this observed trend is fairly upward trend.

data_ts |>
  mutate(views_lag7 = lag(views, 7)) |>
  drop_na()

## # A tsibble: 3,197 x 3 [1D]
##    Date       views views_lag7
##    <date>     <dbl>      <dbl>
##  1 2015-07-08    48         52
##  2 2015-07-09    53         48
##  3 2015-07-10    46         30
##  4 2015-07-11    24         15
##  5 2015-07-12    27         26
##  6 2015-07-13    52         55
##  7 2015-07-14    76         44
##  8 2015-07-15    40         48
##  9 2015-07-16    49         53
## 10 2015-07-17    42         46
## # ℹ 3,187 more rows

acf(data_ts, ci = 0.95, na.action = na.exclude)

The blue dashed line are very low indicating that the autocorrelation is statistically insignificant. From the ACF visualization it is clear there is a daily trend as sinusoidal pattern can be observed every week, since the data being provided to the ACF has week lag, and the pattern indicated 1 unit lag. Hence, a week lag can be observed.

pacf(data_ts, na.action = na.exclude,
     xlab = "Lag (Weekly)")

From the visualization it is clear that the lag of one unit is observer most often, while bi-weekly and monthly lags are un-common. Hence, this visualization also concludes that only a weekly trend (season) in the data is observed.

INFO H-510 Week 12

Sashank

2024-04-08