Lab6

library(readr)

Задание №1-2 1. Возьмите любой открытый, доступный датасет на Ваше усмотрение (например iris, cars и т.д.). 2. Проведите небольшой разведочный анализ данных.

data_set <- read_csv("Walmart Data Analysis and Forcasting.csv")

## Rows: 6435 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Date
## dbl (7): Store, Weekly_Sales, Holiday_Flag, Temperature, Fuel_Price, CPI, Un...
## 
## ℹ 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_set

## # A tibble: 6,435 × 8
##    Store Date       Weekly_Sales Holiday_Flag Temperature Fuel_Price   CPI
##    <dbl> <chr>             <dbl>        <dbl>       <dbl>      <dbl> <dbl>
##  1     1 05-02-2010     1643691.            0        42.3       2.57  211.
##  2     1 12-02-2010     1641957.            1        38.5       2.55  211.
##  3     1 19-02-2010     1611968.            0        39.9       2.51  211.
##  4     1 26-02-2010     1409728.            0        46.6       2.56  211.
##  5     1 05-03-2010     1554807.            0        46.5       2.62  211.
##  6     1 12-03-2010     1439542.            0        57.8       2.67  211.
##  7     1 19-03-2010     1472516.            0        54.6       2.72  211.
##  8     1 26-03-2010     1404430.            0        51.4       2.73  211.
##  9     1 02-04-2010     1594968.            0        62.3       2.72  211.
## 10     1 09-04-2010     1545419.            0        65.9       2.77  211.
## # ℹ 6,425 more rows
## # ℹ 1 more variable: Unemployment <dbl>

library(ggplot2)

Переведём данные температуры с Фаренгейта на Цельсии

data_set$Temperature <- (data_set$Temperature - 32) * (5/9)
data_set

## # A tibble: 6,435 × 8
##    Store Date       Weekly_Sales Holiday_Flag Temperature Fuel_Price   CPI
##    <dbl> <chr>             <dbl>        <dbl>       <dbl>      <dbl> <dbl>
##  1     1 05-02-2010     1643691.            0        5.73       2.57  211.
##  2     1 12-02-2010     1641957.            1        3.62       2.55  211.
##  3     1 19-02-2010     1611968.            0        4.41       2.51  211.
##  4     1 26-02-2010     1409728.            0        8.13       2.56  211.
##  5     1 05-03-2010     1554807.            0        8.06       2.62  211.
##  6     1 12-03-2010     1439542.            0       14.3        2.67  211.
##  7     1 19-03-2010     1472516.            0       12.5        2.72  211.
##  8     1 26-03-2010     1404430.            0       10.8        2.73  211.
##  9     1 02-04-2010     1594968.            0       16.8        2.72  211.
## 10     1 09-04-2010     1545419.            0       18.8        2.77  211.
## # ℹ 6,425 more rows
## # ℹ 1 more variable: Unemployment <dbl>

Подготовим анализ по 1 магазину

store_1 <- subset(data_set, data_set$Store == 1)
store_1

## # A tibble: 143 × 8
##    Store Date       Weekly_Sales Holiday_Flag Temperature Fuel_Price   CPI
##    <dbl> <chr>             <dbl>        <dbl>       <dbl>      <dbl> <dbl>
##  1     1 05-02-2010     1643691.            0        5.73       2.57  211.
##  2     1 12-02-2010     1641957.            1        3.62       2.55  211.
##  3     1 19-02-2010     1611968.            0        4.41       2.51  211.
##  4     1 26-02-2010     1409728.            0        8.13       2.56  211.
##  5     1 05-03-2010     1554807.            0        8.06       2.62  211.
##  6     1 12-03-2010     1439542.            0       14.3        2.67  211.
##  7     1 19-03-2010     1472516.            0       12.5        2.72  211.
##  8     1 26-03-2010     1404430.            0       10.8        2.73  211.
##  9     1 02-04-2010     1594968.            0       16.8        2.72  211.
## 10     1 09-04-2010     1545419.            0       18.8        2.77  211.
## # ℹ 133 more rows
## # ℹ 1 more variable: Unemployment <dbl>

ggplot(store_1, aes(x = Temperature, y = Weekly_Sales)) + geom_point() + xlab("Температура окр. среды на неделе") + ylab("Сумма продажи на неделе")

ggplot(store_1, aes(x = CPI, y = Unemployment)) + geom_point() + stat_smooth(method = "lm") + xlab("Покупательская способность") + ylab("Коэффициент бедности")

## `geom_smooth()` using formula = 'y ~ x'

top_market <- data.frame(Number = unique(data_set$Store))
Median_Sales <- sapply(top_market$Number, function(c) { mean(subset(data_set$Weekly_Sales, data_set$Store == c))} ) 
top_market$Median_Sales <- Median_Sales

pal <- colorRampPalette(c(1 : 8))
pal_val <- pal(45)

barplot(top_market$Median_Sales, names.arg=top_market$Number, ylab="Среднее значение продаж за всё время", xlab="Номер магазина", col = pal_val)

Median_CPI <- sapply(top_market$Number, function(c) { mean(subset(data_set$CPI, data_set$Store == c))} ) 
top_market$Median_CPI <- Median_CPI

ggplot(top_market, aes(x = Median_CPI, y = Median_Sales)) + geom_point(colour = pal_val) + xlab("Средняя покупательская способность") + ylab("Среднее значение продаж за всё время")

Задание №4 Адаптируйте и отладьте программу на языке R, реализующую алгоритм бутсрапа, которая представлена на слайде 21 в лекции, добавьте визуализацию (графики). Сделайте выводы.

set.seed(0)
library(boot)

rsq_function <- function(formula, data, indices) {
  d <- data[indices, ]
  fit <- lm(formula, data=d)
  return (summary(fit)$r.square)
}

reps <- boot(data = mtcars, statistic = rsq_function, R = 2000, formula = mpg~disp)
reps

## 
## ORDINARY NONPARAMETRIC BOOTSTRAP
## 
## 
## Call:
## boot(data = mtcars, statistic = rsq_function, R = 2000, formula = mpg ~ 
##     disp)
## 
## 
## Bootstrap Statistics :
##      original      bias    std. error
## t1* 0.7183433 0.003272215  0.06390141

plot(reps)

boot.ci(boot.out = reps, type = "bca")

## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 2000 bootstrap replicates
## 
## CALL : 
## boot.ci(boot.out = reps, type = "bca")
## 
## Intervals : 
## Level       BCa          
## 95%   ( 0.5437,  0.8149 )  
## Calculations and Intervals on Original Scale