Tutorial

class: center, middle, inverse, title-slide

# Tutorial
## Nonlinear mixed models
### 李唐榮 & 童宜箏
### 2020-12-15

---

## Introduction

### {lcmm} Latent class mixed-effect models  
  
### {gamm4} Generalized additive mixed models

---

### Time intensity curves

.pull-left[

```r
dta1 <- read.table("time_intensity.txt", header = TRUE)

ggplot(dta1, aes(Time, Intensity)) +
  geom_point(alpha = .5, size = 1) +
  stat_smooth(aes(group = ID), method = "loess", se = F, lwd = .7) +
  labs(x = "Time (sec)", 
       y = "Intensity") +
  theme_minimal()
```
]

.pull-right[
![](1214tutorial_files/figure-html/plot-label-out-1.png)
]

/* custom.css */
.left-code {
  color: #777;
  width: 35%;
  height: 90%;
  float: left;
}
.right-plot {
  width: 60%;
  float: right;
  padding-left: 2%;
}
---

## What is Delay discounting?

### Delay discounting refers to the fact that temporally proximal rewards are more highly valued than temporally distal rewards.

### small reward available relatively soon (SSR) 
### larger reward available at a relatively distal point in the future (LLR)

---
## Measuring Delay Discounting in Humans Using an Adjusting Amount Task

#### Setting up a Delay Discounting Task

- Choose the range of delays

> for our example,by convention, an approximately exponential progression ( 1 week, 2 weeks, 1 month, 2 months, 6 months, 1 year, 5 years, and 25 years)

- Choose the maximum amount of money

> 100 dollars

- Choose the number of trials

> for our example,we choose six trials.

---

background-image: url(https://github.com/tjlee38081046/newtest/blob/master/choose.png?raw=true)
background-size: 70%
background-position: center

## Trials
---
background-image: url(https://github.com/tjlee38081046/newtest/blob/master/trials.png?raw=true)
background-size: 50%
background-position: center

### Assess a Single Indifference Point

- Indifference points:a point at which the present value of the delayed alternative is equal to that of the immediate alternative.

<br/>

.footnote[  Make the final adjustment to the immediate amount based on the participant's choice. Use this new amount as the indifference point for that delay. ]

---
## Data Analysis
###Call in necessary packages

```r
library(psych) 
```
- For descriptive statistics

```r
library(nlmrt) 
```
- Non-linear regression, especially good for models with residuals that are close to 0. Normal nls command may not work when residuals are close to 0.

```r
library (plyr)
```
- Includes function to run loop for individual fits

---
### Group analysis

```r
describeBy(discounting)[,-1:-2] #Obtain median values for indifference points.
```

```
##              mean    sd median trimmed   mad  min max range  skew kurtosis   se
## Participant 35.65 20.98  35.00   35.68 28.17 1.00  70 69.00 -0.01    -1.34 2.60
## Smoker       0.49  0.50   0.00    0.49  0.00 0.00   1  1.00  0.03    -2.03 0.06
## Money_1      0.83  0.26   0.95    0.88  0.07 0.00   1  1.00 -1.70     1.84 0.03
## Money_2      0.76  0.27   0.90    0.81  0.15 0.00   1  1.00 -1.10     0.12 0.03
## Money_3      0.72  0.30   0.84    0.76  0.22 0.00   1  1.00 -1.01    -0.25 0.04
## Money_4      0.61  0.31   0.69    0.64  0.32 0.01   1  0.99 -0.42    -1.14 0.04
## Money_5      0.39  0.35   0.25    0.36  0.37 0.00   1  1.00  0.41    -1.39 0.04
## Money_6      0.18  0.26   0.06    0.13  0.09 0.00   1  1.00  1.67     1.94 0.03
```

```r
head(discounting)
```

```
##   Participant Smoker Money_1 Money_2 Money_3 Money_4 Money_5 Money_6
## 1           2      0  0.9990  0.9795  0.7490  0.4932  0.0986  0.0400
## 2           3      0  0.9600  0.7490  0.7178  0.2393  0.1807  0.0557
## 3           5      0  0.9912  0.8994  0.9033  0.7295  0.6865  0.1943
## 4           6      0  0.9932  0.9033  0.9385  0.8760  0.5850  0.0029
## 5          10      0  0.9053  0.9014  0.9053  0.8896  0.3994  0.1943
## 6          11      0  0.9756  0.9502  0.9502  0.8994  0.7490  0.4990
```

```r
money_indiff <- c(0.95, 0.90, 0.84, 0.69, 0.25, 0.06)
```
---
### Calculate the median indifference point for each delay for each group.

```r
head(money_df)
```

```
##     time money_indiff
## 1   0.25         0.95
## 2   0.50         0.90
## 3   1.00         0.84
## 4   6.00         0.69
## 5  60.00         0.25
## 6 300.00         0.06
```
---
## Fit the indifference points to a hyperbolic model
### Mazur (1987) 
`$$V=A/(1+kD)$$`
.bottom[ V is the present (discounted) value of a delayed outcome (i.e., the experimentally-determined indifference point), A is the amount of the future outcome, D is the delay to the outcome, and k is a free parameter that quantifies the steepness with which the delayed outcome loses value as a function of delay.]

---

## Mazur (1987) group model fit

```r
Mazur_mod <- money_indiff ~ 1/(1+(k*time))
Mazur_fit <- wrapnls(Mazur_mod, start=list(k=0), data = money_df)

print(Mazur_fit)
```

```
## Nonlinear regression model
##   model: money_indiff ~ 1/(1 + (k * time))
##    data: data
##       k 
## 0.07222 
##  residual sum-of-squares: 0.01809
## 
## Number of iterations to convergence: 0 
## Achieved convergence tolerance: 1.413e-07
```
---
###Calculate r-squared value

```r
RSS <- sum(residuals(Mazur_fit)^2) #Residual sum of squares

TSS <- sum((money_indiff - mean(money_indiff))^2) #Total sum of squares

1 - (RSS/TSS) #R-squared
```

```
## [1] 0.9738256
```
### AIC for model fit

```r
AIC(Mazur_fit, k = 2)
```

```
## [1] -13.79925
```
### predict

```r
predict(Mazur_fit)
```

```
## [1] 0.98226443 0.96514701 0.93264165 0.69767161 0.18749797 0.04411709
```

---

```r
summary(Mazur_fit)
```

```
## 
## Formula: money_indiff ~ 1/(1 + (k * time))
## 
## Parameters:
##   Estimate Std. Error t value Pr(>|t|)   
## k  0.07222    0.01588   4.549  0.00612 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.06014 on 5 degrees of freedom
## 
## Number of iterations to convergence: 0 
## Achieved convergence tolerance: 1.413e-07
```
---
## Plots indifference points

.pull-left[

```r
plot(money_df) 
time_range <- seq(0, 300, length = 1000) 
lines(time_range, predict(Mazur_fit, data.frame(time = time_range))) 
```
]

.pull-right[
![](1214tutorial_files/figure-html/ip-out-1.png)
]

---

---
---

<img src="https://github.com/tjlee38081046/newtest/blob/master/choose.png?raw=true" width="80%" />
---
### Summary

1. It recovers hidden groups from observed data.  
2. Cluster over time (longitudinal).  
3. Random components in regression coefficients.  
4. Response is an unknown smooth function of a number of continuous covariates.

{gamm4} (Fast) versus {lcmm} (Time consume)

---

### Reference

Frye, C. C., Galizio, A., Friedel, J. E., DeHart, W. B., & Odum, A. L. (2016). Measuring Delay Discounting in Humans Using an Adjusting Amount Task. Journal of Visualized Experiments: JoVE, (107).