Data Overview

Column

Project Description


* From 1991-1996, Jeffrey pine beetles (JPB) caused tree mortality throughout 
  the Lake Tahoe Basin during a severe drought. 


* Census data were collected annually on 10,721 trees to assess patterns of 
  JPB-caused mortality. 


* The motivation for this analysis is to predict the minimum linear distance 
  to the nearest brood tree (DeadDist).


* This dashboard provides a visual overview of the analysis by communicating 
  key features of the project.
  

Table of Selected Data Variables

Groups Variables Description
Tree Diameter TreeDiam Tree diameter/size
Infestation Severity Infest_Serv1 Infestation severity nearest to response
Nearest brood tree DeadDist Minimum linear distance to nearest brood tree
Forest density SDI_20th Stand Density Index @ 1/20th-acre neighborhood surrounding response
Beetle population pressure BA_20th Basal area total for all infested trees within 1/20th-acre neighborhood

Column

JPB-Attacked Trees

Models

Column

Linear Regression Model Assumptions

Column

Ridge Regression Model Tuning Parameters

Results

Row

Linear Regression Coefficient Summary

# A tibble: 4 × 5
  term         estimate std.error statistic   p.value
  <chr>           <dbl>     <dbl>     <dbl>     <dbl>
1 (Intercept)   38.5      0.558      68.9   0        
2 TreeDiam       0.0216   0.0298      0.726 4.68e-  1
3 Infest_Serv1  -0.0616   0.00987    -6.24  4.59e- 10
4 BA_20th       -0.847    0.0224    -37.8   3.02e-292

Linear Regression Residual Plot

Row

Ridge Regression Coefficient Summary

# A tibble: 4 × 3
  term         estimate penalty
  <chr>           <dbl>   <dbl>
1 (Intercept)    24.1     0.163
2 TreeDiam        0.203   0.163
3 Infest_Serv1   -0.983   0.163
4 BA_20th        -6.71    0.163

Ridge Regression Predictions

.pred TreeDiam Infest_Serv1 SDI_20th BA_20th
26.90186 7 15 18.217140 12.647826
27.58814 14 15 17.077682 12.102426
30.80783 8 9 13.365977 8.382798
35.73725 8 9 4.994405 2.459754
30.16158 10 9 14.689402 9.239076
34.80959 10 9 7.005611 3.654180
32.96415 5 9 10.631191 5.672160
30.45351 11 9 16.575938 8.928198
31.60643 11 9 14.047689 7.542882
---
title: "Jeffrey Pine Beatle Outbreak 1991-1996"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: fill
    theme: "sandstone"
    logo: "img/beetle-logo-resized.jpg"
    source_code: embed
---

```{r setup, include=FALSE}

# Libraries --------------------------------------------------------------------
library(flexdashboard)
library(tidyverse)
library(readxl)
library(broom)
library(car)
library(ggfortify)
library(tidymodels)
library(performance) 
library(ggplot2)
library(glmnet)


# Data -------------------------------------------------------------------------
beetle_tbl <-
  read_excel("data/Data_1993.xlsx")


# Linear Regression ------------------------------------------------------------

# Create training/testing data
beetle_split <- initial_split(beetle_tbl)
beetle_train <- training(beetle_split)
beetle_test <- testing(beetle_split)

beetle_rec <- beetle_tbl %>% 
  recipe(DeadDist ~ TreeDiam + Infest_Serv1 +  SDI_20th + BA_20th) %>% 
  # step_sqrt(all_outcomes()) %>%
  step_corr(all_predictors())

# View feature engineered data
beetle_rec %>% 
  prep() %>% 
  bake(new_data = NULL)   

# Create model 
lm_mod <- 
  linear_reg() %>% 
  set_engine("lm")

# Create workflow 
beetle_wflow <- 
  workflow() %>% 
  add_model(lm_mod) %>% 
  add_recipe(beetle_rec)

beetle_fit <- 
  beetle_wflow %>% 
  fit(data = beetle_tbl)


# Ridge Regression -------------------------------------------------------------

# Create training/testing data
beetle_split <- initial_split(beetle_tbl)
beetle_train <- training(beetle_split)
beetle_test <- testing(beetle_split)

# Use Dr. Smirnova's best lambda estimate
ridge_mod <-
  linear_reg(mixture = 0, penalty = 0.1629751) %>%
  set_engine("glmnet")

# Verify what we are doing
ridge_mod %>% 
  translate()

# Create a new recipe
beetle_rec <- beetle_train %>% 
  recipe(DeadDist ~ TreeDiam + Infest_Serv1 + SDI_20th + BA_20th) %>% 
  # step_sqrt(all_outcomes()) %>%
  step_corr(all_predictors()) %>% 
  step_normalize(all_numeric(), -all_outcomes()) %>% 
  step_zv(all_numeric(), -all_outcomes()) 

beetle_ridge_wflow <- 
  workflow() %>% 
  add_model(ridge_mod) %>% 
  add_recipe(beetle_rec)

beetle_ridge_wflow

beetle_ridge_fit <- 
  beetle_ridge_wflow %>% 
  fit(data = beetle_train)

```

Data Overview {data-orientation=columns}
=====================================

Column {data-width=500}
-----------------------------------------------------------------------

### Project Description

```

* From 1991-1996, Jeffrey pine beetles (JPB) caused tree mortality throughout 
  the Lake Tahoe Basin during a severe drought. 


* Census data were collected annually on 10,721 trees to assess patterns of 
  JPB-caused mortality. 


* The motivation for this analysis is to predict the minimum linear distance 
  to the nearest brood tree (DeadDist).


* This dashboard provides a visual overview of the analysis by communicating 
  key features of the project.
  

```

### Table of Selected Data Variables

```{r}

data <- data.frame(
  Groups = c("Tree Diameter", "Infestation Severity", "Nearest brood tree", "Forest density", "Beetle population pressure"),
  Variables = c("TreeDiam", "Infest_Serv1", "DeadDist", "SDI_20th", "BA_20th"),
  Description = c("Tree diameter/size", "Infestation severity nearest to response", "Minimum linear distance to nearest brood tree", "Stand Density Index @ 1/20th-acre neighborhood surrounding response", "Basal area total for all infested trees within 1/20th-acre neighborhood")
)

knitr::kable(data)

```

Column {data-width=500}
-----------------------------------------------------------------------

### JPB-Attacked Trees

```{r}

p.all <-ggplot(data = beetle_tbl,aes(x = Easting, y = Northing)) +
  geom_point(aes(color =factor(Response), alpha =factor(Response))) +
  scale_alpha_discrete(range =c(0.5, 1), guide=FALSE) +
  scale_color_manual("",values=c("yellowgreen", "red"),
  labels =c("Alive", "JPB-attacked")) + theme_bw() + xlab("UTM X")+ ylab("UTM Y") +
  theme(legend.position =c(0,1), legend.text=element_text(size=15))
p.all

```


Models {data-orientation=columns}
=====================================     
   
Column {data-width=500}
-------------------------------------

### Linear Regression Model Assumptions

```{r}

beetle_fit %>%
  extract_fit_parsnip() %>%
  check_model()

```

Column {data-width=500}
-------------------------------------
   
### Ridge Regression Model Tuning Parameters

```{r}


# Convert x into a matrix of predictors and
# Transform any qualitative variables into a dummy variable
fm <- as.formula("DeadDist~TreeDiam +  Infest_Serv1+ SDI_20th +BA_20th")
x=model.matrix(fm, beetle_tbl)[,-1]
y = beetle_tbl$DeadDist

# Set possible values of tuning parameter lambda
grid=10^seq(10,-2,length=100)
# Fit the model
ridge.mod=glmnet(x,y,alpha=0,lambda=grid)

cv.fit <- cv.glmnet(x,y,alpha=0, lambda=grid)
plot(cv.fit)

```


Results {data-orientation=rows}
=====================================     
   
Row
-------------------------------------

### Linear Regression Coefficient Summary

```{r}

beetle_fit %>% 
  extract_fit_parsnip() %>% 
  tidy()

```

### Linear Regression Residual Plot

```{r}

beetle_pred <- 
  predict(beetle_fit, beetle_test, type = "numeric") %>%
  bind_cols(beetle_test %>% select(DeadDist, TreeDiam, Infest_Serv1, SDI_20th, BA_20th))

ggplot(beetle_pred, aes(x = .pred, y = DeadDist - .pred)) +
  geom_point(alpha = 0.6, color = "blue") +
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  labs(title = "Residual Plot",
       x = "Predicted Values",
       y = "Residuals (Actual - Predicted)") +
  theme_minimal()

```

Row
-------------------------------------
   
### Ridge Regression Coefficient Summary

```{r}

beetle_ridge_fit %>% 
  extract_fit_parsnip() %>% 
  tidy()

```   
    
### Ridge Regression Predictions

```{r}

beetle_pred <- 
  predict(beetle_ridge_fit, beetle_test, type = "numeric") %>%
  bind_cols(beetle_test %>% select(TreeDiam, Infest_Serv1, SDI_20th, BA_20th))

  knitr::kable(head(beetle_pred, 9))
  
```