Welcome	Data	Analyses	Discussion	Maps

			Analyses
Urban Heat	All Areas	Portland	Tacoma	King County	iNaturalist	City Inventories

library(tidyverse)
library(corrplot)
library(knitr)
library(kableExtra)
library(gghalves)
library(patchwork)
library(scales)
library(glmmTMB)
library(bbmle)
library(DHARMa)

PORTLAND

Purpose

The purpose of this page is to summarize an investigation of tree health categories as a binary response to urban heat (temperatures).

Response variables Binary health: healthy, unhealthy Binary dead top: no top dieback, top dieback Binary thinning: no thinning, thinning

Read Data

data <- read.csv('https://raw.githubusercontent.com/jmhulbert/redhot/main/data/urban-data-modified.csv')

Wrangle Data

Remove dead trees

# Remove Dead Trees
data.w.dead <- data 
data <- data %>% filter(field.tree.canopy.symptoms!="Tree is dead") %>% filter(field.dieback.percent<100) %>% droplevels()

53 trees were dead

data$binary.tree.canopy.symptoms <- as.factor(data$binary.tree.canopy.symptoms)
levels(data$binary.tree.canopy.symptoms)

## [1] "Healthy"   "Unhealthy"

Filter to Portland Data

Observations from Hoyt

hoyt.data <- data %>% filter(str_detect(place_guess, "Hoyt") |str_detect(place_guess, "hoyt"))

101 trees were from hoyt

Remove observations from Hoyt

data <- data %>% filter(!str_detect(place_guess, "Hoyt") & !str_detect(place_guess, "hoyt"))

data <- data %>% filter(Area=="Portland") %>% droplevels()

341 trees were included in portland

Visualize Portland Data

ggplot(data,aes(binary.tree.canopy.symptoms,DN_AF1))+geom_violin()+coord_flip()+theme_bw()

p1 <- ggplot(data,aes(binary.tree.canopy.symptoms))+geom_histogram(stat="count")+theme_bw()+coord_flip()

## Warning in geom_histogram(stat = "count"): Ignoring unknown parameters:
## `binwidth`, `bins`, and `pad`

p2 <- ggplot(data,aes(reclassified.tree.canopy.symptoms))+geom_histogram(stat="count")+theme_bw()+coord_flip()

## Warning in geom_histogram(stat = "count"): Ignoring unknown parameters:
## `binwidth`, `bins`, and `pad`

p1 + p2

p3 <- ggplot(data,aes(binary.tree.canopy.symptoms)) +facet_wrap(~field.optional...tree.size) +geom_histogram(stat="count")+theme_bw()+coord_flip()

## Warning in geom_histogram(stat = "count"): Ignoring unknown parameters:
## `binwidth`, `bins`, and `pad`

p3

p4 <- ggplot(data,aes(binary.tree.canopy.symptoms)) +facet_wrap(~field.optional...site.location.description) +geom_histogram(stat="count")+theme_bw()+coord_flip()

## Warning in geom_histogram(stat = "count"): Ignoring unknown parameters:
## `binwidth`, `bins`, and `pad`

p4

p3 <-ggplot(data,aes(binary.tree.canopy.symptoms,DN_AF1, fill=binary.tree.canopy.symptoms ))+geom_boxplot(alpha=0.5)+theme_bw()+coord_flip() + scale_fill_manual(name="Tree Condition",values=c("#7fcdbb","#fe9929"))+guides(fill=FALSE) +labs(x="Tree Condition",y=NULL)

## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

p4 <-ggplot(data,aes(DN_AF1,fill=binary.tree.canopy.symptoms))+geom_density(alpha=0.5) + scale_fill_manual(name="Tree Condition",values=c("#7fcdbb","#fe9929")) +theme_bw() +labs(x="Afternoon Temperature") +guides(fill=FALSE)

p3 / p4

data$top.dieback <- as.factor(data$top.dieback)
data$thinning <- as.factor(data$thinning)

Analyses

Models were created with data after removing hoyt

Temperature Time Periods

binomial.daily <- glmmTMB(binary.tree.canopy.symptoms ~ mean.temp.daily ,family=binomial,data=data)
binomial.am <- glmmTMB(binary.tree.canopy.symptoms ~ DN_AM1 ,data=data,family=binomial)
binomial.af <- glmmTMB(binary.tree.canopy.symptoms ~ DN_AF1 ,data=data,family=binomial)
binomial.pm <- glmmTMB(binary.tree.canopy.symptoms ~ DN_PM1,data=data,family=binomial)

Best Fit Comparison

AICtab(binomial.daily,binomial.am,binomial.af,binomial.pm)

##                dAIC df
## binomial.af     0.0 2 
## binomial.daily  8.7 2 
## binomial.pm    16.1 2 
## binomial.am    16.8 2

Afternoon heat was the best fit

Response 1.0: healthy / unhealthy

binomial.af <- glmmTMB(binary.tree.canopy.symptoms ~ DN_AF1 ,data=data,family=binomial)

Summary

summary(binomial.af)

##  Family: binomial  ( logit )
## Formula:          binary.tree.canopy.symptoms ~ DN_AF1
## Data: data
## 
##      AIC      BIC   logLik deviance df.resid 
##    360.8    368.5   -178.4    356.8      339 
## 
## 
## Conditional model:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -14.53764    3.42101  -4.250 2.14e-05 ***
## DN_AF1        0.15603    0.03966   3.934 8.35e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Tree health is associated with urban heat. The probability of success (tree categorized as unhealthy) increases with urban heat

Unhealthy trees are considered success (1) because it is the second level. The probability of failure (0) is the first level (Healthy).

levels(data$binary.tree.canopy.symptoms)

## [1] "Healthy"   "Unhealthy"

The probability of a tree being classified as unhealthy increases with urban temperature.

Visualize effects of predictors

First, generate predictions from model

# Create a data frame for predictions
new.data <- expand.grid(
  DN_AF1 = seq(min(data$DN_AF1), max(data$DN_AF1), length.out = 100)  # keeping predictor2 constant at its mean
)

head(new.data)

##     DN_AF1
## 1 79.48087
## 2 79.59285
## 3 79.70483
## 4 79.81680
## 5 79.92878
## 6 80.04076

new.data$predicted_response <- predict(binomial.af, newdata = new.data, type = "response")

head(new.data)

##     DN_AF1 predicted_response
## 1 79.48087          0.1055905
## 2 79.59285          0.1072519
## 3 79.70483          0.1089363
## 4 79.81680          0.1106438
## 5 79.92878          0.1123748
## 6 80.04076          0.1141293

ggplot(new.data, aes(x = DN_AF1, y = predicted_response)) +
  geom_line() +
  labs(x = "Afternoon Temperature", y = "Predicted Response") +
  theme_bw()

The probability of tree being classified as unhealthy increases with afternoon temperature

Response 2.0: healthy / top-dieback

data.top <- data %>% filter(reclassified.tree.canopy.symptoms=="Healthy"|reclassified.tree.canopy.symptoms=="Dead Top") %>% droplevels()

top.dieback.binomial.af <- glmmTMB(top.dieback ~ DN_AF1,data=data.top,family=binomial)

Summary

summary(top.dieback.binomial.af)

##  Family: binomial  ( logit )
## Formula:          top.dieback ~ DN_AF1
## Data: data.top
## 
##      AIC      BIC   logLik deviance df.resid 
##    106.8    114.0    -51.4    102.8      273 
## 
## 
## Conditional model:
##             Estimate Std. Error z value Pr(>|z|)   
## (Intercept) -33.2420    10.7530  -3.091  0.00199 **
## DN_AF1        0.3507     0.1222   2.870  0.00411 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

levels(data$top.dieback)

## [1] "No"  "Yes"

The probability of a tree having top dieback increases with urban temperature.

Visualize effects of predictors

First, generate predictions from model

# Create a data frame for predictions
new.data.2 <- expand.grid(
  DN_AF1 = seq(min(80), max(150), length.out = 1000)  # keeping predictor2 constant at its mean
)

head(new.data.2)

##     DN_AF1
## 1 80.00000
## 2 80.07007
## 3 80.14014
## 4 80.21021
## 5 80.28028
## 6 80.35035

new.data.2$predicted_response <- predict(top.dieback.binomial.af, newdata = new.data.2, type = "response")

# Create a data frame for predictions
new.data.2.inf <- expand.grid(
  DN_AF1 = seq(min(data.top$DN_AF1), max(150), length.out = 1000)  # keeping predictor2 constant at its mean
)

new.data.2.inf$predicted_response <- predict(top.dieback.binomial.af, newdata = new.data.2.inf, type = "response")

p <- ggplot(new.data.2.inf, aes(x = DN_AF1, y = predicted_response)) + geom_line() + labs(x = "Afternoon temperature (F)", y = "Dieback Probability") + scale_x_continuous(limits = c(80, 115)) +theme_minimal()

p

## Warning: Removed 504 rows containing missing values or values outside the scale range
## (`geom_line()`).

Calculate Dieback Probability Categories

head(new.data.2[new.data.2$DN_AF1<85.5 & new.data.2$DN_AF1>84.75,])

##      DN_AF1 predicted_response
## 69 84.76476         0.02894337
## 70 84.83483         0.02964213
## 71 84.90490         0.03035723
## 72 84.97497         0.03108902
## 73 85.04505         0.03183788
## 74 85.11512         0.03260417

Portland redcedar at 85 degrees had a 0.03 probability

head(new.data.2[new.data.2$predicted_response>0.023 & new.data.2$predicted_response<0.027,])

##      DN_AF1 predicted_response
## 60 84.13413         0.02333430
## 61 84.20420         0.02390097
## 62 84.27427         0.02448106
## 63 84.34434         0.02507487
## 64 84.41441         0.02568270
## 65 84.48448         0.02630487

Portland redcedar at 84.32 degrees had a 0.025 probability

head(new.data.2[new.data.2$predicted_response>0.048 & new.data.2$predicted_response<0.052,])

##      DN_AF1 predicted_response
## 91 86.30631         0.04868891
## 92 86.37638         0.04983990
## 93 86.44645         0.05101664

Portland trees at 86.48 had about a 0.05 probability

head(new.data.2[new.data.2$predicted_response>0.09,])

##       DN_AF1 predicted_response
## 118 88.19820         0.09039181
## 119 88.26827         0.09243285
## 120 88.33834         0.09451519
## 121 88.40841         0.09663945
## 122 88.47848         0.09880624
## 123 88.54855         0.10101617

Portland redcedar at about 88.5 degrees had a 0.1 predicted response.

head(new.data.2[new.data.2$predicted_response>0.195 & new.data.2$predicted_response<0.205,])

##       DN_AF1 predicted_response
## 155 90.79079          0.1978829
## 156 90.86086          0.2018126

Portland redcedar at about 91.66 degrees had a 0.25 predicted response.

Portland Dieback Probability Categories (25%)
- Most Concern (>25%): >91.66
- Moderate Concern (3-25%): 86.48- 91.66
- Lowest Concern (<5%): <86.48
Portland Top-Dieback Probability Categories (10%)
- Most Concern (>10%): > 88.5
- Moderate Concern (5-10%): 84.32-88.5
- Lowest Concern (<2.5%): DN_AF <84.32

p <- ggplot(new.data.2, aes(x = DN_AF1, y = predicted_response)) + geom_line() + labs(x = "Afternoon temperature (F)", y = "Dieback Probability") + scale_x_continuous(limits = c(80, 92.5),breaks=c(80,82.5,85,87.5,90,92.5)) + scale_y_continuous(limits = c(0, .3)) +theme_minimal()

p2 <- p + annotate(geom="rect",ymin = -Inf, ymax = Inf, 
              xmin = -Inf, xmax = 84.32, fill = alpha('#DDA0DD',0.5)) +
    annotate(geom="rect",ymin = -Inf, ymax = Inf, 
              xmin = 84.32, xmax = 88.5, fill = alpha('#7fcdbb',0.5)) + 
    annotate(geom="rect",ymin = -Inf, ymax = Inf, 
          xmin = 88.5, xmax = Inf, fill = alpha('#fe9929',0.5))
p3 <- p2 + annotate("text", x=82, y=.15, label= "Lowest\nConcern") + annotate("text", x=86.8, y=.15, label= "Moderate\nConcern") + annotate("text", x=91, y=.15, label= "Most\nConcern")
p3

## Warning: Removed 823 rows containing missing values or values outside the scale range
## (`geom_line()`).

The probability of a tree having top dieback increases with afternoon temperature

p <- ggplot(data.top, aes(x=DN_AF1))+geom_histogram() +theme_bw() +labs(y="Number of Trees",x="Afternoon Temperature (F)")
p2 <- p + annotate(geom="rect",ymin = -Inf, ymax = Inf, 
              xmin = -Inf, xmax = 84.32, fill = alpha('#DDA0DD',0.5)) +
    annotate(geom="rect",ymin = -Inf, ymax = Inf, 
              xmin = 84.32, xmax = 88.5, fill = alpha('#7fcdbb',0.5)) + 
    annotate(geom="rect",ymin = -Inf, ymax = Inf, 
          xmin = 88.5, xmax = Inf, fill = alpha('#fe9929',0.5))
p3 <- p2 + annotate("text", x=82.3, y=30, label= "Lowest\nConcern") + annotate("text", x=86.8, y=30, label= "Moderate\nConcern") + annotate("text", x=90.1, y=30, label= "Most\nConcern")
p3

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Response 3.0: healthy / thinning

data.thin <- data %>% filter(reclassified.tree.canopy.symptoms=="Healthy"|reclassified.tree.canopy.symptoms=="Thinning Canopy") %>% droplevels()

thinning.binomial.af <- glmmTMB(thinning ~ DN_AF1,data=data.thin,family=binomial)

Summary

summary(thinning.binomial.af)

##  Family: binomial  ( logit )
## Formula:          thinning ~ DN_AF1
## Data: data.thin
## 
##      AIC      BIC   logLik deviance df.resid 
##    197.5    204.9    -96.8    193.5      289 
## 
## 
## Conditional model:
##              Estimate Std. Error z value Pr(>|z|)  
## (Intercept) -11.37407    4.85235  -2.344   0.0191 *
## DN_AF1        0.10825    0.05641   1.919   0.0550 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

levels(data.thin$thinning)

## [1] "No"  "Yes"

str(data.thin$thinning)

##  Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...

There was no evidence the probability of a tree being classified as thinning is related to afternoon heat.

Visualize effects of predictors

First, generate predictions from model

# Create a data frame for predictions
new.data.3 <- expand.grid(
  DN_AF1 = seq(min(data.thin$DN_AF1), max(data.thin$DN_AF1), length.out = 100),  # keeping predictor2 constant at its mean
  Area = 0  # assuming random effect is zero for prediction
)

new.data.3$predicted_response <- predict(thinning.binomial.af, newdata = new.data.3, type = "response")

ggplot(new.data.3, aes(x = DN_AF1, y = predicted_response)) +
  geom_line() +
  labs(x = "Distance from Mean Temperature", y = "Dieback Probability") +
  theme_minimal()

Results Summary

The probability of a tree having top dieback or being classified as unhealthy increased with afternoon temperature, but there was no evidence the probability of a tree being classified as thinning is related to afternoon heat.

Estimate Std. Error z value Pr(>|z|)

Area	Response	Explanatory	df.resid	Estimate	Std.Error	z-val	Pr(>z)	Signif.
Portland	healthy/unhealthy	DN_AF	339	0.15603	0.03966	3.934	8.35e-05	***
Portland	no/dead-top	DN_AF	273	0.3507	0.1222	2.870	0.00411	**
Portland	no/thinning	DN_AF	289	0.10825	0.05641	1.919	0.0550	.

Binomial Distribution Response to Urban Heat in Portland

Joey Hulbert

Last Update: 2024-06-18

PORTLAND

Purpose

Read Data

Wrangle Data

Remove dead trees

Filter to Portland Data

Observations from Hoyt

Remove observations from Hoyt

Visualize Portland Data

Analyses

Temperature Time Periods

Best Fit Comparison

Response 1.0: healthy / unhealthy

Summary

Visualize effects of predictors

Response 2.0: healthy / top-dieback

Summary

Visualize effects of predictors

Calculate Dieback Probability Categories

Response 3.0: healthy / thinning

Summary

Visualize effects of predictors

Results Summary