0b-solutions-exercise.qmd

# Exercise solutions {#sec-exr-sol}

```{r}
#| warning: false
#| message: false

library(titanic)
library(tidyverse)
library(moderndive)
library(lubridate)
library(patchwork)
library(ISLR2)
library(openintro)
```

## Chapter 1 {#sec-ex01-sol}


@exr-ch01-c01 b. Quarto Document

@exr-ch01-c02 a. error

@exr-ch01-c03 a. TRUE

@exr-ch01-c04 a. TRUE

@exr-ch01-c05 b. FALSE

@exr-ch01-c06 e. 15

@exr-ch01-c07 b. Data on a flight

@exr-ch01-c08 c. quantitative

@exr-ch01-app1

```{r}
z <- 12*31
add_on <- 12
z + add_on
```

@exr-ch01-app2

```{r}
#| eval: false
glimpse(titanic_train)
```

The dataset has 891 rows (passengers) and 12 variables. The variables identify various passenger information such as name, age, sex, ticket class, number of siblings/spouses on board, fare cost, port the left from, and whether or not they survived.


@exr-ch01-adv1

```{r}
head(titanic_train)
```

The `head()` function shows the first 6 rows of the dataset. Based on this, I expect the `tail()` function to show the last 6 rows of the dataset.

@exr-ch01-adv2

```{r}
unique(titanic_train$Embarked)
```

There are 3 unique ports of embarkation: Q, S, C (Queenstown, Southampton, Cherbourg). 

## Chapter 2 {#sec-ex02-sol}

@exr-ch02-c01 b. geom_line(), c. geom_col(), e. geom_histogram()

@exr-ch02-c02 d. geom_point()

@exr-ch02-c03 b. changing the transparency, e. jittering the points

@exr-ch02-c04 b. When you want to split a particular visualization of variables by another variable

@exr-ch02-c05 b. geom_col()

@exr-ch02-c06 a. grouped boxplot

@exr-ch02-c07 b. linegraph

@exr-ch02-c08 c. scatterplot

@exr-ch02-c09 d. boxplot

@exr-ch02-c10 There is a strong positive non-linear (exponential) relationship. We can see by the blue line (line of best fit) that the data does not match a linear line. This tells us that as someone spends more time in the grocery store, they also spend more money.

@exr-ch02-c11 The histogram is unimodal and left skewed.

@exr-ch02-c12 a.

@exr-ch02-app1

```{r}
ggplot(
  Bikeshare, 
  aes(x = bikers, y = atemp)
  ) +
  geom_point(alpha = 0.2)
```

There is a moderate positive linear relationship between the number of bikers each hour and temperature. Meaning as temperature increases so does the number of bikers.

@exr-ch02-app2

```{r}
ggplot(Bikeshare, aes(x = bikers) ) +
  geom_histogram(color = "white", bins = 35) +
  facet_wrap(~ weathersit, scales = "free")
```

There was only one observation with heavy rain/snow. The distribution of bikers for all other weather conditions are right skewed. The main peak for each weather condition is similar at around 20. The "clear" and "light rain/snow" conditions are fairly unimodal and "cloudy/misty" appears bi-modal with a minor peak around 80. The spread in terms of range is 600 for all three conditions. 

@exr-ch02-app3

```{r}
ggplot(Bikeshare, aes(x = factor(season), y = bikers)) +
  geom_boxplot()
```

Season 1 corresponds to winter and has the lowest median around 60 bikers and lowest spread in terms of IQR estimated around 80. Season 3 corresponds to summer with the highest median estimated around 175 bikers and largest spread in terms of IQR estimated around 225. The distribution for spring and fall are similar with a median around 125 and IQR of around 200. All seasons have high outliers resulting in a right skew.


@exr-ch02-app4

```{r}
ggplot(titanic_train, 
       aes(x = factor(Survived), fill = Sex)
       ) +
  geom_bar(position = "dodge")
```

There were more males than females in our sample of data from the titanic. Roughly 240 female passengers and 105 male passengers survived while around 80 female passengers and 460 male passengers died. Meaning in total more passengers died (~540) than survived(~345). Due to the imbalanced counts between genders it would be more informative to compare the rate of survival.

```{r}
ggplot(titanic_train, 
       aes(x = factor(Survived), fill = Sex)
       ) +
  geom_bar(position = "fill")
```

Of the passengers that survived, roughly 30% were male and 70% female. Of the passengers that died, roughly 80% were male and 20% female.

@exr-ch02-adv1

```{r}
#| include: false
library(ggplot2)
library(dplyr)
library(ISLR2)

bike_daily <- Bikeshare %>% 
  mutate(
    # create date from day variable
    date = parse_date_time(x = paste(2011, day), orders = "yj")
    ) %>% 
  group_by(date) %>% 
  # calculate summary stats by date
  summarize(casual = sum(casual),
            registered = sum(registered),
            bikers = sum(bikers),
            pct_casual = casual/bikers)
```

```{r}
ggplot(
  bike_daily, 
  aes(x = date, y = bikers)
  ) +
  geom_line() +
  geom_line(aes(y = registered), color = "blue") +
  geom_line(aes(y = casual), color = "red")
```

There are more registered bikers than casual bikers and the registered and casual bikers sum to the total bikers (black line). In general, the line trends upwards from January until July where the number of bikers peak and trends downward the rest of the year. This makes sense because people generally bike when the weather is nicer in the summer months. Although August is a summer month it has a lower number of bikers than July likely due to the school year starting back up.

@exr-ch02-adv2

```{r}
ggplot(
  bike_daily, 
  aes(x = date, y = pct_casual)
  ) +
  geom_line() +
  theme_minimal() +
  labs(x = NULL) +
  theme(axis.text.x = element_text(angle = 45, 
                                   hjust = 1)) +
  scale_y_continuous(labels = scales::percent)
```


## Chapter 3 {#sec-ex03-sol}

@exr-ch03-c01 c.  `x %>% c() %>% b() %>% a()`

@exr-ch03-c02 d. `arrange()` , g. `filter()` , c. `mutate()`

@exr-ch03-c03 a. 12 row and 5 columns

@exr-ch03-c04 b.  To make exploring a data frame easier by only outputting the variables of interest

@exr-ch03-c05 a.  increase

@exr-ch03-c06 c.  median and interquartile range; mean and standard deviation

@exr-ch03-c07 b.  $mean < median$

@exr-ch03-c08 a. These key variables uniquely identify the observational units

@exr-ch03-c09 d.

@exr-ch03-c10 e.

@exr-ch03-c11 a. e. (there is no variable called `passenger`)

@exr-ch03-app1

```{r}
Bikeshare %>%
  filter(hr == 12) %>% 
  group_by(mnth) %>%
  summarize(avg_bikers= mean(bikers, na.rm=TRUE))
```

@exr-ch03-app2
```{r}
Auto %>%
  mutate(pwr = horsepower/weight ) %>%
  slice_max(pwr) %>% 
  select(name, pwr, horsepower, weight)
```
The buick estate wagon (sw) has the largest power weight ratio of 0.0729.

@exr-ch03-app3
```{r}
titanic_train %>%
  group_by(Pclass) %>% 
  summarize(fare_calc= sum(Fare, na.rm=TRUE)) %>%
  arrange(desc(fare_calc))
```

@exr-ch03-app4

```{r}
titanic_train %>%
  count(Survived, Sex)

# Alternate code
titanic_train %>%
  group_by(Survived, Sex) %>% 
  summarize(count = n())
```

@exr-ch03-adv1

```{r}
bike_summer <- Bikeshare %>% 
  filter(mnth %in% c("June", "July", "Aug"))
```



## Chapter 4 {#sec-ex04-sol}

@exr-ch05-c01 Yes it is tidy.

@exr-ch05-c02 a, b, c, d

@exr-ch05-app1

```{r}
#| eval: false
wine_qt <- read_csv("data/WineQT")
```

@exr-ch05-app2

```{r}
table_tidy <- table4a %>% 
  pivot_longer(c(`1999`, `2000`), 
               names_to = "year", 
               values_to = "cases")

table_tidy
```

@exr-ch05-adv1

```{r}
DD_vs_SB %>% 
  pivot_wider(id_cols = c(FIPS, median_income, population), 
               names_from = "shop_type", 
               values_from = "shops")

```


## Chapter 5 {#sec-ex05-sol}

@exr-ch05-c01 c) -0.7

@exr-ch05-c02 e) Exactly 1

@exr-ch05-c03 b) Between -1 and 0

@exr-ch05-c04 a) explanatory variable & b) predictor variable & d) independent variable f) covariate

@exr-ch05-c05  c) outcome variable & e) dependent variable

@exr-ch05-c06 c) $b_0$ & e) the value of $\hat{y}$ when $x=0$ & f) intercept

@exr-ch05-c07 d) For every increase of 1 unit in x, there is an associated increase of, on average, 3.86 units of y.

@exr-ch05-c08 a) TRUE

@exr-ch05-c09 b) FALSE

@exr-ch05-c10 a) TRUE

@exr-ch05-c11 d) No, the positive correlation does not necessarily imply causation.


@exr-ch05-app1

**a)**

```{r}
#| eval: false
skim(Auto)
```


**b)**

```{r}
Auto %>% 
  select(horsepower, mpg) %>% 
  cor(use = "complete.obs")
```
The correlation is -0.778.


**c)**

```{r}
ggplot(Auto, aes(x = horsepower, y = mpg)) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE)
```

**d)**
```{r}
model_mpg <- lm(mpg ~ horsepower, data = Auto)

summary(model_mpg)$coefficients
```
$$\widehat{mpg} = 39.94 - 0.158*horsepower$$
**e)**

**Intercept**: When a vehicle has 0 horsepower, we expect the car to have on average 39.94 miles per gallon.

**Slope:**: For every 1 additional unit of horsepower, we expect the miles per gallon of the vehicle to decrease on average by 0.158.


**f)**
```{r}
39.94 - 0.158*150
```
We would expect the vehicle to have 16.24 miles per gallon.

@exr-ch05-app2
```{r}
model_bike <- lm(bikers ~ temp, data = Bikeshare)

summary(model_bike)
```

**a)** 0.451
```{r}
Bikeshare %>% 
  summarize(cor = cor(bikers, temp, use = "complete.obs"))
```

**b)**
```{r}
ggplot(Bikeshare, aes(x = temp, y = bikers)) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE)
```

**c)**
$$\widehat{bikers} = -5.374 + 305.006*temp$$
**d)**

**Intercept**: When the normalized temperature in celsius in 0, we expect there to be -5.374 bikers.

**Slope:**: For every 1 additional increase in temperature, we expect the number of bikers to increase by 305.

**e)** We predict the number of bikers to be 147.
```{r}
-5.374 + 305.006*0.5
```


@exr-ch05-app3

```{r}
model_season <- lm(bikers ~ factor(season), data = Bikeshare)

summary(model_season)$coefficients
```
**a)** $$\widehat{bikers} = 72.53 + 85.12*1_season2(x)+114.81*1_season3(x)+80.30*1_season4(x)$$

**b)** The expected number of bikers during winter is 72.53.

**c)** On average, summer (season3) had the highest number of bikers.

**d)**

```{r}
bike_error <- Bikeshare %>% 
  filter(!is.na(bikers)) %>% 
  mutate(residuals = residuals(model_season),
         fitted = fitted.values(model_season)) %>% 
  select(mnth, day, hr, season, bikers, residuals, fitted)

bike_error %>% 
  slice_max(residuals, n=1)
bike_error %>% 
  slice_min(residuals, n=1)
```

The worst prediction will be the residual that is farthest from 0. We checked both the min (farthest negative) and max (farthest positive) residual. The 166th day of the year at hour 17 had the worst prediction with an observed value of 638 and predicted value of 157 (residual of 480.3).

@exr-ch05-adv1

```{r}
#| warning: false
#| message: false

# coefficients
summary(model_mpg)$coefficients
# or
model_mpg$coefficients

# r.squared
summary(model_mpg)$r.squared
```


## Chapter 6 {#sec-ex06-sol}

@exr-ch06-c01 c. The parallel slopes model. Since two models are very similar, the additional complexity of the interaction model isn’t necessary

@exr-ch06-c02 d. 0.47

@exr-ch06-c03 b. FALSE

@exr-ch06-c04 a. TRUE

@exr-ch06-c05 a. Splitting up your data can result in unequal balance in representation of some groups compared to others. & d. Splitting up your data by a confounding variable can allow you to see trends in the data that were hidden in the aggregated version of the data.


@exr-ch06-app1

```{r}
mod_auto <- lm(mpg ~ displacement + weight, data = Auto)

summary(mod_auto)$coefficients
```

@exr-ch06-app2

```{r}
biker_parallel <- lm(bikers ~ temp + factor(workingday), 
                  data = Bikeshare)

summary(biker_parallel)$coefficients

ggplot(Bikeshare, 
       aes(x = temp, y = bikers, 
           color = factor(workingday))
       ) +
  geom_point() +
  geom_parallel_slopes(se = FALSE)
```

**b_0** When the normalized temperature is 0 degrees celsius and it is not a work day (ie: the weekend), the number of bikers is predicted to be -3.15.

**b_1** For every one additional degree of normalized temperature, the associated expected increase in bikers is 305.45, regardless if it is a work or weekday.

**b_2** The number of bikers on average is 3.57 less on a work day than on the weekend.


@exr-ch06-app3

```{r}
#| warning: false
#| message: false
#| 
biker_int <- lm(bikers ~ temp * factor(workingday), 
                  data = Bikeshare)

summary(biker_int)$coefficients

ggplot(Bikeshare, 
       aes(x = temp, y = bikers, 
           color = factor(workingday))
       ) +
  geom_point() +
  geom_smooth(se = FALSE)
```

**b_0** When the normalized temperature is 0 degrees celsius and it is not a work day (ie: the weekend), the number of bikers is predicted to be -34.82.

**b_1** For every one additional degree of normalized temperature, the associated expected increase in bikers is 372.33 on the weekend (non working day).

**b_2** When the normalized temperature is 0 degrees celsius, the number of bikers on average is 43.77 more on a work day than on the weekend.

**b_3** For every one additional degree of normalized temperature, the associated expected increase in number of bikers is 98.47 less on working days than on the weekend.


@exr-ch06-adv1

**One possible answer**

```{r}
#| warning: false
#| message: false

# rmse to beat
mean(mod_auto$residuals^2)

# new model
model_better <- lm(mpg ~ horsepower + weight, 
                   data = Auto)

mean(model_better$residuals^2)
```
This model which uses the opponents points and star player points has an MSE of 116.9 which is better.

@exr-ch06-adv2

```{r}
#| warning: false
#| message: false

# parallel slopes
sqrt(mean(biker_parallel$residuals^2))

# interaction
sqrt(mean(biker_int$residuals^2))
```
The RMSE of the parallel slopes is 119.38 and the RMSE of the interaction is 119.04. Since the RMSE for the interaction model is smaller it appears to be slightly better (though not significantly).


## Chapter 7 {#sec-ex07-sol}


@exr-ch07-c01 a) There is a non-zero probability of being selected into the treatment or control group for every unit & c) A random process is used for selection & e) A random process is used for administration of the treatments

@exr-ch07-c02 d) rbernoulli(n = 1000, p = 0.25)

@exr-ch07-c03 b) FALSE

@exr-ch07-c04 a) TRUE

@exr-ch07-c05 a) Try to ensure that treatment and control groups are as similar as possible on all variables related to treatment assignment & c) Look for variables you can use to control for confounding & d) State your assumptions and limitations

@exr-ch07-c06 b) private colleges are only correlated with higher GPAs, because this would be an observational study

@exr-ch07-c07 b) video games are only correlated with violent behavior, because this would be an observational study

@exr-ch07-c08 Perhaps class size is a confounding variable for gpa, smaller sizes could lead to more individualized attention and higher grades. Perhaps parental control is a confounding variable for video games, children that play violent video games probably have less parental guidance or household rules leading to poor behavior choices.

@exr-ch07-c09 d) No, because the treatment and control groups were not randomized

@exr-ch07-c10 a confounding (or lurking) variable


@exr-ch07-app1 No the administration cannot conclude the after-school program caused student improvement. While this was a randomized selection of a subset of students we cannot generalize to all students because all students were not considered. Also, this was a before and after study where it is likely the material from the fall semester is likely different from the material in the spring semester. Perhaps these students were just better at the topics covered in the spring.


@exr-ch07-app2 Geography might impact the results because maybe the west has more rural cities than the east or perhaps there are different demographics of people that live in each region. Certain types of people/demographics might favor the 'traditional' label and deter from the new label because they don't recognize it while other types of people will see the new label and but it because it is 'new'. A way to reduce the impact of geography is to use "matching". Find a list of cities in the east that match on average with the cities in the west (perhaps New York City is very similar on average to Los Angeles etc.). Then randomly sample these pairs of cities to compare sales results (to measure if it is receptive).


## Chapter 8 {#sec-ex08-sol}


@exr-ch08-c01 d) a population parameter

@exr-ch08-c02 
b) $\hat{\mu}$ & d) $\bar{x}$ & f) $\hat{\pi}$ & g) $p$ & h) $\hat{p}$ & i) $s$ & k) $\hat{\sigma}$  

<!-- @exr-ch08-c03  -->
<!-- a) $\mu$ &  e) $\pi$ & j) $\sigma$ -->

@exr-ch08-c03 all of them (a, b, c, d)

@exr-ch08-c04 b) Cluster sampling

@exr-ch08-c05 d) Systematic sampling

@exr-ch08-c06 c) Stratified sampling

@exr-ch08-c07 c) Cluster sampling (with unequal probability) choosing towns is based on random cluster selection

@exr-ch08-c08 b) FALSE

@exr-ch08-c09 c) An observational study with random sampling but no random assignment

@exr-ch08-c10 d) No, you cannot make causal or generalizable claims from the results of your survey


@exr-ch08-app1
population: US citizens

parameter: proportion (most likely a Yes or No question)

undercoverage: citizens that do not own a house, if there are multiple citizens in one household only one person will receive the survey.


@exr-ch08-app2

sampling method: stratified sampling

Compared to simple random sampling, stratified sample is guaranteed to represent people from all 50 states. 

While the stratified sampling would allow for better representation of people in different states, the same limitations in regards to citizens without addresses or if multiple citizens live in one household.


## Chapter 9 {#sec-ex09-sol}


@exr-ch09-c01
b) unimodal & h) symmetric

@exr-ch09-c02
b) FALSE

@exr-ch09-c03
c) `1 - pnorm(q = 60, mean = 64, sd = 3, lower.tail = FALSE)`

@exr-ch09-c04
b) `pnorm(q = 72, mean = 64, sd = 3) - pnorm(q = 60, mean = 64, sd = 3)`
c) `1 - pnorm(q = -1.33) - pnorm(q = 2.67, lower.tail = FALSE)`

@exr-ch09-c05
b) orange

@exr-ch09-c06
a) TRUE

@exr-ch09-c07

d) The sampling distribution of the sample mean and the sampling distribution of the difference in sample means both follow the T distribution

f) The regression slope and regression intercept both follow the T distribution

@exr-ch09-c08
a) TRUE

@exr-ch09-c09
b) FALSE

@exr-ch09-c10
d) unbiased and precise

@exr-ch09-c11

b) FALSE

@exr-ch09-c12

- normal/t distribution
- normal/t distribution
- chi-squared distribution


@exr-ch09-app1

a) 99.7% (3 standard deviations)

b)
```{r}
pnorm(q = 13, mean = 10.5, sd = 1.5, 
      lower.tail = FALSE)
```
4.78% of men have a shoe size larger than 13.

c) 
```{r}
pnorm(q = 12, mean = 10.5, sd = 1.5) - pnorm(q = 10, mean = 10.5, sd = 1.5)
```
47.19% of males have a shoe size between 10 and 12. So assuming this is a random male where everyone has an equal chance of selection there is a 47.19% chance.

d) 
```{r}
qnorm(p = 0.6, mean = 10.5, sd = 1.5, lower.tail = FALSE)
```
His shoe size is 10.12 (which is not an actual shoe size so his shoe size would be 10)

@exr-ch09-app2

We have a sample mean and sample standard deviation so will use the t-distribution

a) 
```{r}
stat = (6-6.02)/0.03
pt(q = stat, df = 17)
```

b)
```{r}
qt(p = 0.1, df = 17, lower.tail = FALSE)

# Solve for x in STAT = (x-mean)/s
1.333379*0.03+6.02

```


c) 
```{r}
stat_5.95 = (5.95-6.02)/0.03
pt(q = stat_5.95, df = 17)

stat_6.05 = (6.05-6.02)/0.03
pt(q = stat_6.05, df = 17, lower.tail= FALSE)

#under 5.95 or over 6.05
0.01608422 + 0.1656664
```

@exr-ch09-adv1

```{r}
weather <- tibble(
  daily_weather = c(rep("sunny",476), 
                    rep("cloudy",558), 
                    rep("partly cloudy",487), 
                    rep("rainy",312), 
                    rep("thuderstorms",28), 
                    rep("snowy",329))
  )
```

```{r}
set.seed(52)
samples_1 <- weather %>% 
  rep_sample_n(size = 30, reps = 50)

samples_2 <- weather %>% 
  rep_sample_n(size = 30, reps = 5000)

samples_3 <- weather %>% 
  rep_sample_n(size = 50, reps = 5000)
```

```{r}
summary_1 <- samples_1 %>% 
  group_by(replicate) %>% 
  summarize(sunny = sum(daily_weather == "sunny"),
            prop = sunny/n())

summary_2 <- samples_2 %>% 
  group_by(replicate) %>% 
  summarize(sunny = sum(daily_weather == "sunny"),
            prop = sunny/n())

summary_3 <- samples_3 %>% 
  group_by(replicate) %>% 
  summarize(sunny = sum(daily_weather == "sunny"),
            prop = sunny/n())
```

```{r}
plot_1 <- ggplot(summary_1, aes(x = prop)) +
  geom_histogram(color = "white", bins = 5)

plot_2 <- ggplot(summary_2, aes(x = prop)) +
  geom_histogram(color = "white", bins = 17)

plot_3 <- ggplot(summary_3, aes(x = prop)) +
  geom_histogram(color = "white", bins = 22)

plot_1 + plot_2 + plot_3
```

## Chapter 10 {#sec-ex10-sol}

@exr-ch10-c01
Estimate $\\pm$ Critical Value*SE(Estimate)

@exr-ch10-c02
a) We are 90% confident that the true mean is within any given 90% confidence interval

d) Approximately 90% of confidence intervals contain the true mean

@exr-ch10-c03
b) FALSE

@exr-ch10-c04
a)

@exr-ch10-c05
a) decrease

@exr-ch10-c06
c)

@exr-ch10-c07
d) qt(p = 0.05, df = 14)

@exr-ch10-c08
d) qnorm(p = 0.015)

@exr-ch10-c09
0.01804

@exr-ch10-app1

```{r}
lego_city <- lego_sample %>% 
  filter(theme == "City")

t.test(lego_city$pieces, conf.level = 0.85)
```

We are 85% confident that the average number of pieces in a City themed LEGO set is between 205 and 344 pieces.

@exr-ch10-app2

```{r}
lego_sample %>% 
  count(pieces > 100)

prop.test(x = 36, n = (39 + 36), 
          conf.level = 0.99, correct = FALSE)
```
We are 99% confident that the proportion of LEGO sets that have over 100 pieces is between 0.339 and 0.624.

@exr-ch10-app3

```{r}
lego_city <- lego_sample %>% 
  filter(theme == "City")

lego_friends <- lego_sample %>% 
  filter(theme == "Friends")

t.test(x = lego_city$amazon_price, 
       y = lego_friends$amazon_price, 
       conf.level = 0.90)

```
We are 90% confident that the difference in average Amazon price between City themed and Friends themed LEGO sets is between -9.95 and 23.19. Since the confidence interval contains zero there is no statistical difference in average Amazon price.

@exr-ch10-app4

```{r}
lego_sample %>%  
  filter(theme == "City") %>%
  count(ages)
# For City, the categories "Ages_4+", "Ages_5+", and "Ages_5-12" are suitable for a 5 year old

lego_sample %>%  
  filter(theme == "Friends") %>%
  count(ages)
# For Frinds the category "Ages_4+" is suitable for a 5 year old (all others you should be over 5)

# quick denominator count
lego_sample %>% 
  count(theme)

prop.test(x = c(1 + 13 + 7, 1), 
          n = c(25, 25), 
          conf.level = 0.95, correct = FALSE)
```

We are 95% confident that the difference in proportion of City themed and Friends themed LEGO sets suitable for a 5 year old is between 0.637 and 0.962. Our confidence interval supports that City themed legosets have a higher proportion of LEGO sets suitable for a 5 year old because the interval is strictly positive.

@exr-ch10-adv1

Let's consider the difference between `amazon_price` and `price` to be the amount that a LEGO set is "over-priced".

We will use the 95% confidence level to compare the difference in means.

```{r}
lego_price <- lego_sample %>% 
  mutate(overprice = amazon_price - price) %>% 
  select(theme, overprice)

city_price <- lego_price %>% 
  filter(theme == "City")

friends_price <- lego_price %>% 
  filter(theme == "Friends")

duplo_price <- lego_price %>% 
  filter(theme != "Friends", theme != "City")

t.test(city_price$overprice, friends_price$overprice)
# no statistical difference between city and friends
t.test(duplo_price$overprice, friends_price$overprice)
# no statistical difference between duplo and friends
t.test(city_price$overprice, duplo_price$overprice)
# no statistical difference between city and duplo
```

There is no statistical difference in the average amount in which a LEGO set theme is overpriced.


## Chapter 11 {#sec-ex11-sol}

See Chapter 12 practice problems for calculating and interpreting a p-value.

<!-- ::: callout-caution -->
<!-- ## Under Construction -->

<!-- Currently working on exercise solutions. -->
<!-- ::: -->


## Chapter 12 {#sec-ex12-sol}

@exr-ch12-c01
a) Type I Error

@exr-ch12-c02
d) No, one type of error will be minimized at the expense of the other type

@exr-ch12-c03
b) FALSE

@exr-ch12-c04
a) TRUE

@exr-ch12-c05
a) $\alpha$
b) $n$

@exr-ch12-c06
b) Type II Error

@exr-ch12-c07

d) Reject the null, there is a difference between the proportions.

@exr-ch12-c08

b) becomes smaller

@exr-ch12-c09

c)

@exr-ch12-c10

$$H_0:$$ the person does not have HIV

$$H_A:$$ the person has HIV

Scenario 1: The person tests positive for HIV and has HIV
Scenario 2: The person tests positive for HIV but does not actually have HIV (Type I error)
Scenario 3: The person tests negative for HIV but actually has HIV (Type II error)
Scenario 4: The person tests negative for HIV and does not have HIV

@exr-ch12-app1

$$H_0: \mu_{pieces} = 350$$

$$H_A: \mu_{pieces} \ne 350$$

```{r}
lego_city <- lego_sample %>% 
  filter(theme == "City")

t.test(lego_city$pieces, mu = 350, conf.level = 0.98)
```

Assuming the average number of pieces in LEGO sets with the `City` `theme` is equal to 350, there is an 11.73% chance of observing data as extreme as our sample. At the 2% significance level, we fail to reject the null hypothesis. There is not statistically significant evidence to suggest the average number of pieces is **not** 350.


@exr-ch12-app2

$$H_0: \pi_{pieces} = 0.5$$

$$H_A: \pi_{pieces} \ne 0.5$$

```{r}
lego_sample |> 
  filter(theme == "Friends") %>%
  mutate(over100 = pieces > 100) |> 
  count(over100)

prop.test(x = 17, n = 25, p = 0.5, correct = FALSE)
```


Assuming the proportion of LEGO sets with the Friends theme that have over 100 `pieces` is equal to 50%, there is a 7.19% chance of observing data as extreme as our sample. At the 10% significance level, we reject the null hypothesis. There is statistically significant evidence to suggest the proportion of LEGO sets with the Friends theme that have over 100 `pieces` is NOT equal to 50%. Our sample statistic of 68% and rejection of the null supports that a majority of Friends LEGO sets have over 100 pieces.

@exr-ch12-app3

$$H_0: \mu_{city} - \mu_{friends} = 0$$

$$H_A: \mu_{city} - \mu_{friends} \ne 0$$


```{r}
lego_city <- lego_sample %>% 
  filter(theme == "City")

lego_friends <- lego_sample %>% 
  filter(theme == "Friends")

# no need to set mu because checking if difference is 0
t.test(x = lego_city$amazon_price, 
       y = lego_friends$amazon_price, 
       conf.level = 0.90)
```


@exr-ch12-app4

$$H_0: \pi_{city} - \pi_{friends} = 0$$

$$H_A: \pi_{city} - \pi_{friends} \ne 0$$


```{r}
lego_sample %>%  
  filter(theme == "City") %>%
  count(ages)
# For City, the categories "Ages_4+", "Ages_5+", and "Ages_5-12" are suitable for a 5 year old

lego_sample %>%  
  filter(theme == "Friends") %>%
  count(ages)
# For Frinds the category "Ages_4+" is suitable for a 5 year old (all others you should be over 5)

# quick denominator count
lego_sample %>% 
  count(theme)

# no need to set p because checking if difference is 0
prop.test(x = c(1 + 13 + 7, 1), 
          n = c(25, 25), 
          conf.level = 0.95, correct = FALSE)
```


@exr-ch12-adv1


$$H_0: \beta_{1} = 0$$

$$H_A: \beta_{1} \ne 0$$

```{r}
price_model <- lm(price ~ pieces, data = lego_sample)

summary(price_model)
```

The p-value of 1.02e-14, leads us to conclude there is a relationship between price and pieces at the .05 significance level.

```{r}
confint(price_model)
```

We are 95% confident that for every one additional piece in a LEGO set the price on average increases somewhere between 0.077 and 0.117 dollars.