ANLY 505 - Simulated Data and Linear Mixed Models

The statistical model:

\(y_t = \beta_0 + \beta_1 * (Elevation_s)_t + \beta_2 * Slope_t + (b_s)_t + \epsilon_t\)

Where:

\(\beta_0\) is the mean response when both Elevation and Slope are 0
\(\beta_1\) is the change in mean response for a 1-unit change in elevation. Elevation is measured at the stand level, so all plots in a stand share a single value in elevation.
\(\beta_2\) is the change in mean response for a 1-unit change in slope. Slope is measured at the plot level, so every plot potentially has a unique value of slope.

Let’s define the parameters:

the intercept \((\beta_0)\) will be -1
the coefficient for elevation \((\beta_1)\) will be set to 0.005
the coefficient for slope \((\beta_2)\) will be set to 0.1

nstand = 5
nplot = 4
b0 = -1
b1 = .005
b2 = .1
sds = 2
sd = 1

Simulate other variables:

set.seed(16)
stand = rep(LETTERS[1:nstand], each = nplot)
standeff = rep( rnorm(nstand, 0, sds), each = nplot)
ploteff = rnorm(nstand*nplot, 0, sd)

Simulate elevation and slope:

elevation = rep( runif(nstand, 1000, 1500), each = nplot)
slope = runif(nstand*nplot, 2, 75)

Simulate response variable:

resp2 = b0 + b1*elevation + b2*slope + standeff + ploteff

Your tasks (complete each task in its’ own code chunk, make sure to use echo=TRUE so I can see your code):

Fit a linear mixed model with the response variable as a function of elevation and slope with stand as a random effect. Are the estimated parameters similar to the intial parameters as we defined them?

# use this chunk to answer question 1
library(lme4)

## Loading required package: Matrix

library(lmerTest)

## 
## Attaching package: 'lmerTest'

## The following object is masked from 'package:lme4':
## 
##     lmer

## The following object is masked from 'package:stats':
## 
##     step

p1 <- lmer(resp2 ~ 1 + elevation + slope + (1|stand))
summary(p1)

## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: resp2 ~ 1 + elevation + slope + (1 | stand)
## 
## REML criterion at convergence: 82
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -1.65583 -0.62467 -0.01693  0.53669  1.41736 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  stand    (Intercept) 1.208    1.099   
##  Residual             1.358    1.165   
## Number of obs: 20, groups:  stand, 5
## 
## Fixed effects:
##               Estimate Std. Error         df t value Pr(>|t|)    
## (Intercept) -21.314628   6.602053   3.001313  -3.228   0.0482 *  
## elevation     0.020600   0.004916   3.113482   4.190   0.0230 *  
## slope         0.095105   0.016441  15.868032   5.785 2.88e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##           (Intr) elevtn
## elevation -0.991       
## slope      0.049 -0.148

cat("b0 = ", b0, sep = "")

## b0 = -1

cat("b1 = ", b1, sep = "")

## b1 = 0.005

cat("b2 = ", b2, sep = "")

## b2 = 0.1

Create a function for your model and run 1000 simulations of that model.

# use this chunk to answer question 2
ta<-function(nstand = 5,nplot = 4,b0 = -1,b1 = .005,b2 = .1,sds = 2,sd = 1)
{
        stand = rep(LETTERS[1:nstand], each = nplot)
        standeff = rep( rnorm(nstand, 0, sds), each = nplot)
        ploteff = rnorm(nstand*nplot, 0, sd)
        elevation = rep( runif(nstand, 1000, 1500), each = nplot)
        slope = runif(nstand*nplot, 2, 75)
        resp2 = b0 + b1*elevation + b2*slope + standeff + ploteff 
        fit1=lm(resp2~ elevation + slope)
}
set.seed(8)
sim=ta()
#for some reasons, rerun functon cannot run #
sims=replicate(1000,ta())

Extract the stand and residual variances from this simulation run. Print the first 6 rows of the data.

# use this chunk to answer question 3
library(broom)

Choose three different sample sizes (your choice) and run 1000 model simulations with each sample size. Create 3 visualizations that compare distributions of the variances for each of the 3 sample sizes. Make sure that the axes are labelled correctly. What do these graphs say about the relationship between sample size and variance?

# use this chunk to answer question 4
library(ggplot2)
set.seed(15)
x1=ta(5)
x2=ta(15)
x3=ta(100)

ggplot(x1,aes(x=elevation))+
  geom_density(fill ="red",alpha=0.25)

ggplot(x2,aes(x=elevation))+
  geom_density(fill ="red",alpha=0.25)

ggplot(x3,aes(x=elevation))+
  geom_density(fill ="red",alpha=0.25)

Plot the coefficients of the estimates of elevation and slope. Hint: the x-axis should have 1000 values. Discuss the graphs.

# use this chunk to answer question 5
#library(furrr)
#simsest <- sims %>% 
  #future_map(tidy, effects = "fixed") %>% 
  #bind_rows()

#simsest %>% 
  #dplyr::filter(term %in% c("elevation", "slope")) %>% 
  #group_by(term) %>% 
  #mutate(x = 1 : 1000) %>%
  #ungroup() %>% 
  #mutate(real_value = ifelse(term == "elevation", 0.005, 0.1)) %>% 
  #ggplot(aes(x = x, y = estimate)) +
  #geom_line() +
  #facet_wrap(~term) +
  #geom_hline(aes(yintercept = real_value, color = term), linetype = 4, size = 0.5) +
  #theme_bw()

Submit a link to this document in R Pubs to your Moodle. This assignment is worth 25 points.

ANLY 505 - Simulated Data and Linear Mixed Models

Week 2

Neha Katti

2019-11-10