Widely-used fungicide Pristine® causes sub-lethal effects in common eastern bumble bee (Bombus impatiens) microcolonies
Emily Runnion
Data Collected 2022, Data Analyzed 2023
Input Data
brood <- read_csv("brood.csv")
brood$colony <- as.factor(brood$colony)
brood$treatment <- as.factor(brood$treatment)
brood$replicate<- as.factor(brood$replicate)
brood$qro <- as.factor(brood$qro)
drone.ce <- read_csv("drone.count.emerge.csv")
drone.ce$colony <- as.factor(drone.ce$colony)
drone.ce$treatment <- as.factor(drone.ce$treatment)
drone.ce$replicate<- as.factor(drone.ce$replicate)
drone.ce$qro <- as.factor(drone.ce$qro)
drone.h <- read_csv("drone.health.csv")
drone.h$colony <- as.factor(drone.h$colony)
drone.h$treatment <- as.factor(drone.h$treatment)
drone.h$replicate<- as.factor(drone.h$replicate)
drone.h$qro <- as.factor(drone.h$qro)
pollen <- read_csv("pollen.csv")
pollen$colony <- as.factor(pollen$colony)
pollen$treatment <- as.factor(pollen$treatment)
pollen$replicate<- as.factor(pollen$replicate)
qro <- read_csv("qro.csv")
qro$colony <- as.factor(qro$colony)
qro$qro <- as.factor(qro$qro)
pollen <- merge(pollen, qro, by.x = "colony")
pollen <- na.omit(pollen)
pollen$qro <- as.factor(pollen$qro)
# get rid of negative numbers
pollen$difference[pollen$difference < 0] <- NA
pollen <- na.omit(pollen)
range(pollen$difference)## [1] 0.002715 1.565420weights <- read_csv("weights.csv")
weights$colony <- as.factor(weights$colony)
weights$treatment <- as.factor(weights$treatment)
weights$replicate<- as.factor(weights$replicate)
weights$qro <- as.factor(weights$qro)
workers <- read_csv("workers.csv")
workers$colony <- as.factor(workers$colony)
workers$treatment <- as.factor(workers$treatment)
workers$replicate<- as.factor(workers$replicate)
workers$qro <- as.factor(workers$qro)
workers$alive_at_end <- as.logical(workers$alive_at_end)
workers$dead_at_end <- as.logical(workers$dead_at_end)
cbindworkers <- read.csv("cbindworkers.csv")
cbindworkers$colony <- as.factor(cbindworkers$colony)
cbindworkers$treatment <- as.factor(cbindworkers$treatment)
cbindworkers$replicate <- as.factor(cbindworkers$replicate)Check for collinearity
brood.col <- lm(brood_cells~ treatment + whole.mean + alive + duration + replicate + mean.dose + qro, data = brood)
drop1(brood.col, test = "Chisq")## Single term deletions
##
## Model:
## brood_cells ~ treatment + whole.mean + alive + duration + replicate +
## mean.dose + qro
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 2214.2 209.32
## treatment 4 222.5 2436.7 205.63 0.3657
## whole.mean 1 4144.5 6358.6 254.79 5.579e-12 ***
## alive 1 4.9 2219.0 207.42 0.7532
## duration 1 3.7 2217.9 207.39 0.7836
## replicate 5 69.9 2284.1 200.72 0.9244
## mean.dose 1 22.5 2236.7 207.77 0.4995
## qro 0 0.0 2214.2 209.32
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1b1 <- update(brood.col, .~. -qro)
vif(b1)## GVIF Df GVIF^(1/(2*Df))
## treatment 8.553798 4 1.307735
## whole.mean 3.449268 1 1.857220
## alive 2.500432 1 1.581275
## duration 1.688360 1 1.299369
## replicate 4.411960 8 1.097209
## mean.dose 6.951638 1 2.636596b2 <- update(b1, .~. -mean.dose)
vif(b2)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.416097 4 1.044448
## whole.mean 3.269164 1 1.808083
## alive 2.457681 1 1.567699
## duration 1.650178 1 1.284593
## replicate 4.033123 8 1.091070b3 <- update(b2, .~. -replicate)
vif(b3)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.240985 4 1.027356
## whole.mean 1.283871 1 1.133080
## alive 1.356444 1 1.164665
## duration 1.182338 1 1.087354anova(b2, b3)## Analysis of Variance Table
##
## Model 1: brood_cells ~ treatment + whole.mean + alive + duration + replicate
## Model 2: brood_cells ~ treatment + whole.mean + alive + duration
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 29 2236.7
## 2 37 2530.7 -8 -293.98 0.4765 0.8627AIC(b2, b3)## df AIC
## b2 17 337.4788
## b3 9 327.0358brood.col <- lm(honey_pot~ treatment + whole.mean + alive + duration + replicate + mean.dose + qro, data = brood)
drop1(brood.col, test = "Chisq")## Single term deletions
##
## Model:
## honey_pot ~ treatment + whole.mean + alive + duration + replicate +
## mean.dose + qro
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 278.31 115.99
## treatment 4 54.878 333.19 116.09 0.088029 .
## whole.mean 1 72.743 351.06 124.44 0.001227 **
## alive 1 3.503 281.82 114.56 0.453092
## duration 1 0.295 278.61 114.04 0.827199
## replicate 5 53.449 331.76 113.90 0.161535
## mean.dose 1 7.429 285.74 115.18 0.276262
## qro 0 0.000 278.31 115.99
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1b1 <- update(brood.col, .~. -qro)
vif(b1)## GVIF Df GVIF^(1/(2*Df))
## treatment 8.553798 4 1.307735
## whole.mean 3.449268 1 1.857220
## alive 2.500432 1 1.581275
## duration 1.688360 1 1.299369
## replicate 4.411960 8 1.097209
## mean.dose 6.951638 1 2.636596b2 <- update(b1, .~. -mean.dose)
vif(b2)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.416097 4 1.044448
## whole.mean 3.269164 1 1.808083
## alive 2.457681 1 1.567699
## duration 1.650178 1 1.284593
## replicate 4.033123 8 1.091070b3 <- update(b2, .~. -replicate)
vif(b3)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.240985 4 1.027356
## whole.mean 1.283871 1 1.133080
## alive 1.356444 1 1.164665
## duration 1.182338 1 1.087354anova(b2, b3)## Analysis of Variance Table
##
## Model 1: honey_pot ~ treatment + whole.mean + alive + duration + replicate
## Model 2: honey_pot ~ treatment + whole.mean + alive + duration
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 29 285.74
## 2 37 345.58 -8 -59.844 0.7592 0.6404AIC(b2, b3)## df AIC
## b2 17 244.8835
## b3 9 237.4403brood.col <- lm(eggs~ treatment + whole.mean + alive + duration + replicate + mean.dose + qro, data = brood)
drop1(brood.col, test = "Chisq")## Single term deletions
##
## Model:
## eggs ~ treatment + whole.mean + alive + duration + replicate +
## mean.dose + qro
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 5029.6 246.24
## treatment 4 605.19 5634.8 243.35 0.27591
## whole.mean 1 352.03 5381.6 247.28 0.08102 .
## alive 1 0.52 5030.1 244.24 0.94563
## duration 1 117.12 5146.7 245.28 0.30879
## replicate 5 248.55 5278.1 238.41 0.82507
## mean.dose 1 149.62 5179.2 245.56 0.25074
## qro 0 0.00 5029.6 246.24
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1b1 <- update(brood.col, .~. -qro)
vif(b1)## GVIF Df GVIF^(1/(2*Df))
## treatment 8.553798 4 1.307735
## whole.mean 3.449268 1 1.857220
## alive 2.500432 1 1.581275
## duration 1.688360 1 1.299369
## replicate 4.411960 8 1.097209
## mean.dose 6.951638 1 2.636596b2 <- update(b1, .~. -mean.dose)
vif(b2)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.416097 4 1.044448
## whole.mean 3.269164 1 1.808083
## alive 2.457681 1 1.567699
## duration 1.650178 1 1.284593
## replicate 4.033123 8 1.091070b3 <- update(b2, .~. -replicate)
vif(b3)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.240985 4 1.027356
## whole.mean 1.283871 1 1.133080
## alive 1.356444 1 1.164665
## duration 1.182338 1 1.087354anova(b2, b3)## Analysis of Variance Table
##
## Model 1: eggs ~ treatment + whole.mean + alive + duration + replicate
## Model 2: eggs ~ treatment + whole.mean + alive + duration
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 29 5179.2
## 2 37 6388.3 -8 -1209.1 0.8462 0.5708AIC(b2, b3)## df AIC
## b2 17 375.2628
## b3 9 368.7044brood.col <- lm(dead_larvae~ treatment + whole.mean + alive + duration + replicate + mean.dose + qro, data = brood)
drop1(brood.col, test = "Chisq")## Single term deletions
##
## Model:
## dead_larvae ~ treatment + whole.mean + alive + duration + replicate +
## mean.dose + qro
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 1284.6 184.82
## treatment 4 101.94 1386.5 180.25 0.487620
## whole.mean 1 280.55 1565.1 191.71 0.002869 **
## alive 1 23.38 1308.0 183.63 0.367610
## duration 1 1.85 1286.4 182.88 0.799325
## replicate 5 392.72 1677.3 186.82 0.034734 *
## mean.dose 1 39.79 1324.4 184.19 0.241352
## qro 0 0.00 1284.6 184.82
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1b1 <- update(brood.col, .~. -qro)
vif(b1)## GVIF Df GVIF^(1/(2*Df))
## treatment 8.553798 4 1.307735
## whole.mean 3.449268 1 1.857220
## alive 2.500432 1 1.581275
## duration 1.688360 1 1.299369
## replicate 4.411960 8 1.097209
## mean.dose 6.951638 1 2.636596b2 <- update(b1, .~. -mean.dose)
vif(b2)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.416097 4 1.044448
## whole.mean 3.269164 1 1.808083
## alive 2.457681 1 1.567699
## duration 1.650178 1 1.284593
## replicate 4.033123 8 1.091070b3 <- update(b2, .~. -replicate)
vif(b3)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.240985 4 1.027356
## whole.mean 1.283871 1 1.133080
## alive 1.356444 1 1.164665
## duration 1.182338 1 1.087354anova(b2, b3)## Analysis of Variance Table
##
## Model 1: dead_larvae ~ treatment + whole.mean + alive + duration + replicate
## Model 2: dead_larvae ~ treatment + whole.mean + alive + duration
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 29 1324.4
## 2 37 1845.8 -8 -521.41 1.4272 0.2273AIC(b2, b3)## df AIC
## b2 17 313.8957
## b3 9 312.8342brood.col <- lm(live_larvae~ treatment + whole.mean + alive + duration + replicate + mean.dose + qro, data = brood)
drop1(brood.col, test = "Chisq")## Single term deletions
##
## Model:
## live_larvae ~ treatment + whole.mean + alive + duration + replicate +
## mean.dose + qro
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 4066.3 236.67
## treatment 4 2114.58 6180.9 247.51 0.0008438 ***
## whole.mean 1 2890.43 6956.7 258.84 8.847e-07 ***
## alive 1 39.07 4105.4 235.10 0.5118234
## duration 1 2.10 4068.4 234.69 0.8787392
## replicate 5 490.08 4556.4 231.79 0.4013195
## mean.dose 1 316.30 4382.6 238.04 0.0663589 .
## qro 0 0.00 4066.3 236.67
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1b1 <- update(brood.col, .~. -qro)
vif(b1)## GVIF Df GVIF^(1/(2*Df))
## treatment 8.553798 4 1.307735
## whole.mean 3.449268 1 1.857220
## alive 2.500432 1 1.581275
## duration 1.688360 1 1.299369
## replicate 4.411960 8 1.097209
## mean.dose 6.951638 1 2.636596b2 <- update(b1, .~. -mean.dose)
vif(b2)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.416097 4 1.044448
## whole.mean 3.269164 1 1.808083
## alive 2.457681 1 1.567699
## duration 1.650178 1 1.284593
## replicate 4.033123 8 1.091070b3 <- update(b2, .~. -replicate)
vif(b3)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.240985 4 1.027356
## whole.mean 1.283871 1 1.133080
## alive 1.356444 1 1.164665
## duration 1.182338 1 1.087354anova(b2, b3)## Analysis of Variance Table
##
## Model 1: live_larvae ~ treatment + whole.mean + alive + duration + replicate
## Model 2: live_larvae ~ treatment + whole.mean + alive + duration
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 29 4382.6
## 2 37 5541.8 -8 -1159.2 0.9588 0.4861AIC(b2, b3)## df AIC
## b2 17 367.7473
## b3 9 362.3079brood.col <- lm(dead_pupae~ treatment + whole.mean + alive + duration + replicate + mean.dose + qro, data = brood)
drop1(brood.col, test = "Chisq")## Single term deletions
##
## Model:
## dead_pupae ~ treatment + whole.mean + alive + duration + replicate +
## mean.dose + qro
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 1067.2 176.47
## treatment 4 212.32 1279.5 176.64 0.08571 .
## whole.mean 1 21.94 1089.1 175.39 0.33860
## alive 1 2.54 1069.7 174.58 0.74366
## duration 1 53.77 1120.9 176.69 0.13693
## replicate 5 320.42 1387.6 178.29 0.03741 *
## mean.dose 1 13.40 1080.6 175.04 0.45372
## qro 0 0.00 1067.2 176.47
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1b1 <- update(brood.col, .~. -qro)
vif(b1)## GVIF Df GVIF^(1/(2*Df))
## treatment 8.553798 4 1.307735
## whole.mean 3.449268 1 1.857220
## alive 2.500432 1 1.581275
## duration 1.688360 1 1.299369
## replicate 4.411960 8 1.097209
## mean.dose 6.951638 1 2.636596b2 <- update(b1, .~. -mean.dose)
vif(b2)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.416097 4 1.044448
## whole.mean 3.269164 1 1.808083
## alive 2.457681 1 1.567699
## duration 1.650178 1 1.284593
## replicate 4.033123 8 1.091070b3 <- update(b2, .~. -replicate)
vif(b3)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.240985 4 1.027356
## whole.mean 1.283871 1 1.133080
## alive 1.356444 1 1.164665
## duration 1.182338 1 1.087354anova(b2, b3)## Analysis of Variance Table
##
## Model 1: dead_pupae ~ treatment + whole.mean + alive + duration + replicate
## Model 2: dead_pupae ~ treatment + whole.mean + alive + duration
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 29 1080.6
## 2 37 1488.4 -8 -407.84 1.3682 0.2515AIC(b2, b3)## df AIC
## b2 17 304.7401
## b3 9 303.1500brood.col <- lm(live_pupae~ treatment + whole.mean + alive + duration + replicate + mean.dose + qro, data = brood)
drop1(brood.col, test = "Chisq")## Single term deletions
##
## Model:
## live_pupae ~ treatment + whole.mean + alive + duration + replicate +
## mean.dose + qro
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 442.66 136.88
## treatment 4 39.161 481.82 132.69 0.431664
## whole.mean 1 70.826 513.49 141.56 0.009756 **
## alive 1 10.785 453.45 135.96 0.297978
## duration 1 1.704 444.36 135.05 0.677528
## replicate 5 41.770 484.43 130.93 0.541147
## mean.dose 1 18.130 460.79 136.68 0.178946
## qro 0 0.000 442.66 136.88
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1b1 <- update(brood.col, .~. -qro)
vif(b1)## GVIF Df GVIF^(1/(2*Df))
## treatment 8.553798 4 1.307735
## whole.mean 3.449268 1 1.857220
## alive 2.500432 1 1.581275
## duration 1.688360 1 1.299369
## replicate 4.411960 8 1.097209
## mean.dose 6.951638 1 2.636596b2 <- update(b1, .~. -mean.dose)
vif(b2)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.416097 4 1.044448
## whole.mean 3.269164 1 1.808083
## alive 2.457681 1 1.567699
## duration 1.650178 1 1.284593
## replicate 4.033123 8 1.091070b3 <- update(b2, .~. -replicate)
vif(b3)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.240985 4 1.027356
## whole.mean 1.283871 1 1.133080
## alive 1.356444 1 1.164665
## duration 1.182338 1 1.087354anova(b2, b3)## Analysis of Variance Table
##
## Model 1: live_pupae ~ treatment + whole.mean + alive + duration + replicate
## Model 2: live_pupae ~ treatment + whole.mean + alive + duration
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 29 460.79
## 2 37 526.97 -8 -66.179 0.5206 0.8311AIC(b2, b3)## df AIC
## b2 17 266.3872
## b3 9 256.4261# Variables to keep for brood production models = treatment + whole.mean + alive + duration
drone.ce.col <- lm(emerge~ treatment + whole.mean + alive + replicate + mean.dose + qro, data = drone.ce)
d1 <- update(drone.ce.col, .~. -qro)
vif(d1)## GVIF Df GVIF^(1/(2*Df))
## treatment 11.065311 4 1.350503
## whole.mean 2.741920 1 1.655874
## alive 1.945499 1 1.394812
## replicate 5.791834 8 1.116030
## mean.dose 8.660495 1 2.942872d2 <- update(d1, .~. -mean.dose)
vif(d2)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.522758 4 1.053971
## whole.mean 2.679428 1 1.636896
## alive 1.932432 1 1.390119
## replicate 5.091336 8 1.107075d3 <- update(d2, .~. -replicate)
vif(d3)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.132923 4 1.015722
## whole.mean 1.024170 1 1.012013
## alive 1.106926 1 1.052106anova(d2, d3)## Analysis of Variance Table
##
## Model 1: emerge ~ treatment + whole.mean + alive + replicate
## Model 2: emerge ~ treatment + whole.mean + alive
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 25 353.60
## 2 33 540.38 -8 -186.78 1.6506 0.1607drone.ce.col <- lm(count~ treatment + whole.mean + alive + duration + replicate + mean.dose + qro, data = drone.ce)
d1 <- update(drone.ce.col, .~. -qro)
vif(d1)## GVIF Df GVIF^(1/(2*Df))
## treatment 9.467065 4 1.324424
## whole.mean 2.965415 1 1.722038
## alive 3.437075 1 1.853935
## duration 2.986680 1 1.728201
## replicate 5.721855 8 1.115183
## mean.dose 6.797842 1 2.607267d2 <- update(d1, .~. -mean.dose)
vif(d2)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.645456 4 1.064231
## whole.mean 2.868172 1 1.693568
## alive 3.367939 1 1.835194
## duration 2.985180 1 1.727767
## replicate 5.066066 8 1.106731d3 <- update(d2, .~. -replicate)
vif(d3)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.347318 4 1.037968
## whole.mean 1.526755 1 1.235619
## alive 1.824988 1 1.350921
## duration 1.702754 1 1.304896anova(d2, d3)## Analysis of Variance Table
##
## Model 1: count ~ treatment + whole.mean + alive + duration + replicate
## Model 2: count ~ treatment + whole.mean + alive + duration
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 29 505.70
## 2 37 807.08 -8 -301.38 2.1603 0.06176 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1AIC(d2, d3) #keep d2## df AIC
## d2 17 270.5724
## d3 9 275.6087# Variables to keep for emergence model = treatment + whole.mean + alive
#drone count model = treatment + whole.mean + alive + duration + replicate
drone.h.col <- lm(relative_fat~ treatment + whole.mean + alive + duration + replicate + mean.dose + qro, data = drone.h)
drop1(drone.h.col, test = "Chisq")## Single term deletions
##
## Model:
## relative_fat ~ treatment + whole.mean + alive + duration + replicate +
## mean.dose + qro
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 0.00024331 -5415.8
## treatment 4 1.0639e-05 0.00025395 -5407.5 0.002585 **
## whole.mean 1 1.0550e-06 0.00024437 -5416.2 0.198582
## alive 1 1.3411e-06 0.00024465 -5415.7 0.147315
## duration 1 2.5591e-06 0.00024587 -5413.8 0.045587 *
## replicate 5 3.0993e-06 0.00024641 -5421.0 0.436325
## mean.dose 1 4.7612e-06 0.00024807 -5410.4 0.006512 **
## qro 0 0.0000e+00 0.00024331 -5415.8
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1d1 <- update(drone.h.col, .~. -qro)
vif(d1)## GVIF Df GVIF^(1/(2*Df))
## treatment 27.849721 4 1.515663
## whole.mean 3.600649 1 1.897538
## alive 1.098859 1 1.048265
## duration 1.882540 1 1.372057
## replicate 6.455871 8 1.123627
## mean.dose 14.370191 1 3.790804d2 <- update(d1, .~. -mean.dose)
vif(d2)## GVIF Df GVIF^(1/(2*Df))
## treatment 2.216516 4 1.104610
## whole.mean 3.449427 1 1.857263
## alive 1.094689 1 1.046274
## duration 1.877555 1 1.370239
## replicate 5.632877 8 1.114091d3 <- update(d2, .~. -replicate)
vif(d3)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.284692 4 1.031810
## whole.mean 1.191791 1 1.091692
## alive 1.025505 1 1.012672
## duration 1.214062 1 1.101845anova(d2, d3, test = "Chisq")## Analysis of Variance Table
##
## Model 1: relative_fat ~ treatment + whole.mean + alive + duration + replicate
## Model 2: relative_fat ~ treatment + whole.mean + alive + duration
## Res.Df RSS Df Sum of Sq Pr(>Chi)
## 1 366 0.00024807
## 2 374 0.00025780 -8 -9.7265e-06 0.07308 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1AIC(d2, d3)## df AIC
## d2 17 -4324.366
## d3 9 -4325.675drone.h.col <- lm(dry_weight~ treatment + whole.mean + alive + duration + replicate + mean.dose + qro, data = drone.h)
drop1(drone.h.col, test = "Chisq")## Single term deletions
##
## Model:
## dry_weight ~ treatment + whole.mean + alive + duration + replicate +
## mean.dose + qro
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 0.026784 -3980.7
## treatment 4 0.00223730 0.029022 -3955.3 1.002e-06 ***
## whole.mean 1 0.00019567 0.026980 -3979.6 0.08184 .
## alive 1 0.00034304 0.027128 -3977.4 0.02140 *
## duration 1 0.00002224 0.026807 -3982.3 0.55676
## replicate 5 0.00061654 0.027401 -3981.2 0.09182 .
## mean.dose 1 0.00005569 0.026840 -3981.8 0.35259
## qro 0 0.00000000 0.026784 -3980.7
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1d1 <- update(drone.h.col, .~. -qro)
vif(d1)## GVIF Df GVIF^(1/(2*Df))
## treatment 28.361446 4 1.519116
## whole.mean 3.635553 1 1.906713
## alive 1.087236 1 1.042706
## duration 1.937229 1 1.391844
## replicate 6.566066 8 1.124816
## mean.dose 14.430725 1 3.798779d2 <- update(d1, .~. -mean.dose)
vif(d2)## GVIF Df GVIF^(1/(2*Df))
## treatment 2.250439 4 1.106709
## whole.mean 3.496936 1 1.870010
## alive 1.083447 1 1.040888
## duration 1.934177 1 1.390747
## replicate 5.736855 8 1.115365d3 <- update(d2, .~. -replicate)
vif(d3)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.281142 4 1.031454
## whole.mean 1.209902 1 1.099956
## alive 1.023663 1 1.011762
## duration 1.209712 1 1.099869anova(d2, d3, test = "Chisq")## Analysis of Variance Table
##
## Model 1: dry_weight ~ treatment + whole.mean + alive + duration + replicate
## Model 2: dry_weight ~ treatment + whole.mean + alive + duration
## Res.Df RSS Df Sum of Sq Pr(>Chi)
## 1 400 0.026840
## 2 408 0.028045 -8 -0.001205 0.02154 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1AIC(d2, d3)## df AIC
## d2 17 -2799.235
## d3 9 -2796.965drone.h.col <- lm(radial~ treatment + whole.mean + alive + duration + replicate + mean.dose + qro, data = drone.h)
drop1(drone.h.col, test = "Chisq")## Single term deletions
##
## Model:
## radial ~ treatment + whole.mean + alive + duration + replicate +
## mean.dose + qro
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 15.088 -1307.0
## treatment 4 0.63081 15.718 -1298.4 0.00224 **
## whole.mean 1 0.00326 15.091 -1309.0 0.76672
## alive 1 0.21488 15.302 -1303.3 0.01644 *
## duration 1 0.03616 15.124 -1308.1 0.32362
## replicate 5 0.28737 15.375 -1309.4 0.17482
## mean.dose 1 0.01108 15.099 -1308.7 0.58469
## qro 0 0.00000 15.088 -1307.0
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1d1 <- update(drone.h.col, .~. -qro)
vif(d1)## GVIF Df GVIF^(1/(2*Df))
## treatment 28.709844 4 1.521437
## whole.mean 3.619228 1 1.902427
## alive 1.087820 1 1.042986
## duration 1.927802 1 1.388453
## replicate 6.392157 8 1.122931
## mean.dose 14.496093 1 3.807373d2 <- update(d1, .~. -mean.dose)
vif(d2)## GVIF Df GVIF^(1/(2*Df))
## treatment 2.274335 4 1.108171
## whole.mean 3.471038 1 1.863072
## alive 1.083927 1 1.041118
## duration 1.923363 1 1.386854
## replicate 5.562241 8 1.113213d3 <- update(d2, .~. -replicate)
vif(d3)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.295445 4 1.032886
## whole.mean 1.218756 1 1.103973
## alive 1.024674 1 1.012262
## duration 1.224079 1 1.106381anova(d2, d3, test = "Chisq")## Analysis of Variance Table
##
## Model 1: radial ~ treatment + whole.mean + alive + duration + replicate
## Model 2: radial ~ treatment + whole.mean + alive + duration
## Res.Df RSS Df Sum of Sq Pr(>Chi)
## 1 391 15.099
## 2 399 15.712 -8 -0.6133 0.0441 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1AIC(d2, d3)## df AIC
## d2 17 -151.7277
## d3 9 -151.5224# Variables to include in drone dry weight and radial cell model = treatment + whole.mean + alive + duration + replicate, but in relative fat it is = treatment + whole.mean + alive + duration
weights.col <- lm(difference~ treatment + whole.mean + alive + duration + replicate + mean.dose + qro, data = weights)
drop1(weights.col, test = "Chisq")## Single term deletions
##
## Model:
## difference ~ treatment + whole.mean + alive + duration + replicate +
## mean.dose + qro
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 216.78 104.75
## treatment 4 77.782 294.56 110.55 0.007972 **
## whole.mean 1 172.613 389.40 129.11 2.839e-07 ***
## alive 1 11.928 228.71 105.16 0.120533
## duration 1 0.001 216.78 102.75 0.991206
## replicate 5 31.503 248.29 100.86 0.296057
## mean.dose 1 33.315 250.10 109.18 0.011201 *
## qro 0 0.000 216.78 104.75
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1wtcol1 <- update(weights.col, .~. -qro)
vif(wtcol1)## GVIF Df GVIF^(1/(2*Df))
## treatment 8.553798 4 1.307735
## whole.mean 3.449268 1 1.857220
## alive 2.500432 1 1.581275
## duration 1.688360 1 1.299369
## replicate 4.411960 8 1.097209
## mean.dose 6.951638 1 2.636596wtcol2 <- update(wtcol1, .~. -mean.dose)
vif(wtcol2)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.416097 4 1.044448
## whole.mean 3.269164 1 1.808083
## alive 2.457681 1 1.567699
## duration 1.650178 1 1.284593
## replicate 4.033123 8 1.091070wtcol3 <- update(wtcol2, .~. -replicate)
vif(wtcol3)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.240985 4 1.027356
## whole.mean 1.283871 1 1.133080
## alive 1.356444 1 1.164665
## duration 1.182338 1 1.087354anova(wtcol2, wtcol3, test = "Chisq")## Analysis of Variance Table
##
## Model 1: difference ~ treatment + whole.mean + alive + duration + replicate
## Model 2: difference ~ treatment + whole.mean + alive + duration
## Res.Df RSS Df Sum of Sq Pr(>Chi)
## 1 29 250.10
## 2 37 313.55 -8 -63.45 0.4986#variables to include in weight change model = treatment + whole.mean + alive + duration
workers.col <- lm(dry_weight ~ treatment + whole.mean + alive_at_end + colony_duration + replicate + qro + mean.dose, data = workers)
drop1(workers.col, test = "Chisq")## Single term deletions
##
## Model:
## dry_weight ~ treatment + whole.mean + alive_at_end + colony_duration +
## replicate + qro + mean.dose
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 0.053082 -1835.8
## treatment 4 0.0009874 0.054070 -1839.7 0.3889
## whole.mean 1 0.0082478 0.061330 -1805.5 1.286e-08 ***
## alive_at_end 1 0.0002962 0.053379 -1836.6 0.2642
## colony_duration 1 0.0000256 0.053108 -1837.7 0.7424
## replicate 5 0.0009967 0.054079 -1841.7 0.5257
## qro 0 0.0000000 0.053082 -1835.8
## mean.dose 1 0.0002452 0.053328 -1836.8 0.3096
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1wcol1 <- update(workers.col, .~. -qro)
vif(wcol1)## GVIF Df GVIF^(1/(2*Df))
## treatment 8.676043 4 1.310057
## whole.mean 2.287256 1 1.512368
## alive_at_end 1.724161 1 1.313073
## colony_duration 2.278485 1 1.509465
## replicate 4.017642 8 1.090808
## mean.dose 6.747352 1 2.597567drop1(wcol1, test = "Chisq")## Single term deletions
##
## Model:
## dry_weight ~ treatment + whole.mean + alive_at_end + colony_duration +
## replicate + mean.dose
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 0.053082 -1835.8
## treatment 4 0.0009874 0.054070 -1839.7 0.3889
## whole.mean 1 0.0082478 0.061330 -1805.5 1.286e-08 ***
## alive_at_end 1 0.0002962 0.053379 -1836.6 0.2642
## colony_duration 1 0.0000256 0.053108 -1837.7 0.7424
## replicate 8 0.0098272 0.062910 -1813.8 7.379e-06 ***
## mean.dose 1 0.0002452 0.053328 -1836.8 0.3096
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1wcol2 <- update(wcol1, .~. -mean.dose)
vif(wcol2)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.401437 4 1.043090
## whole.mean 2.119362 1 1.455803
## alive_at_end 1.713279 1 1.308923
## colony_duration 2.246165 1 1.498721
## replicate 3.590072 8 1.083163drop1(wcol2, test = "Chisq")## Single term deletions
##
## Model:
## dry_weight ~ treatment + whole.mean + alive_at_end + colony_duration +
## replicate
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 0.053328 -1836.8
## treatment 4 0.0008043 0.054132 -1841.5 0.5006
## whole.mean 1 0.0080891 0.061417 -1807.2 1.861e-08 ***
## alive_at_end 1 0.0002566 0.053584 -1837.7 0.2998
## colony_duration 1 0.0000487 0.053376 -1838.6 0.6513
## replicate 8 0.0097994 0.063127 -1815.0 8.240e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1wcol3 <- update(wcol2, .~. -replicate)
vif(wcol3)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.255298 4 1.028829
## whole.mean 1.299403 1 1.139914
## alive_at_end 1.340597 1 1.157842
## colony_duration 1.384985 1 1.176854anova(wcol2, wcol3)## Analysis of Variance Table
##
## Model 1: dry_weight ~ treatment + whole.mean + alive_at_end + colony_duration +
## replicate
## Model 2: dry_weight ~ treatment + whole.mean + alive_at_end + colony_duration
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 208 0.053328
## 2 216 0.063127 -8 -0.0097994 4.7777 2.091e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#variables to begin for workers dry weight model --> treatment + whole.mean + alive_at_end + colony_duration + replicate
workers.col <- lm(days_alive~ treatment + whole.mean + colony_duration + replicate + dry_weight + mean.dose + qro, data = workers)
drop1(workers.col, test = "Chisq")## Single term deletions
##
## Model:
## days_alive ~ treatment + whole.mean + colony_duration + replicate +
## dry_weight + mean.dose + qro
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 5990.0 770.11
## treatment 4 215.6 6205.7 770.03 0.0944964 .
## whole.mean 1 335.5 6325.6 780.32 0.0004759 ***
## colony_duration 1 5847.5 11837.5 920.69 < 2.2e-16 ***
## replicate 5 439.3 6429.4 775.96 0.0072727 **
## dry_weight 1 6.9 5996.9 768.37 0.6118325
## mean.dose 1 26.6 6016.6 769.10 0.3193931
## qro 0 0.0 5990.0 770.11
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1wcol1 <- update(workers.col, .~. -qro)
vif(wcol1)## GVIF Df GVIF^(1/(2*Df))
## treatment 8.294744 4 1.302718
## whole.mean 2.400167 1 1.549247
## colony_duration 2.014823 1 1.419445
## replicate 3.697687 8 1.085165
## dry_weight 1.579210 1 1.256666
## mean.dose 6.730579 1 2.594336wcol2 <- update(wcol1, .~. -mean.dose)
vif(wcol2)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.293817 4 1.032724
## whole.mean 2.157729 1 1.468921
## colony_duration 1.965908 1 1.402108
## replicate 3.318903 8 1.077860
## dry_weight 1.573153 1 1.254254drop1(wcol2, test = "Chisq")## Single term deletions
##
## Model:
## days_alive ~ treatment + whole.mean + colony_duration + replicate +
## dry_weight
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 6016.6 769.10
## treatment 4 257.0 6273.6 770.47 0.0524807 .
## whole.mean 1 309.4 6326.0 778.34 0.0008032 ***
## colony_duration 1 5867.8 11884.4 919.58 < 2.2e-16 ***
## replicate 8 888.0 6904.6 783.94 0.0001502 ***
## dry_weight 1 8.7 6025.3 767.43 0.5693793
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#variables to keep for worker days alive model --> treatment + whole.mean + colony_duration + replicate + dry_weight
cbindw.col <- lm(alive ~ treatment + whole.mean + mean.dose + replicate + duration + qro, data =cbindworkers)
cb1 <- update(cbindw.col, .~. -qro)
cb3 <- update(cbindw.col, .~. -replicate)
anova(cb1, cb3)## Analysis of Variance Table
##
## Model 1: alive ~ treatment + whole.mean + mean.dose + replicate + duration
## Model 2: alive ~ treatment + whole.mean + mean.dose + duration + qro
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 29 43.370
## 2 34 57.818 -5 -14.447 1.9321 0.1194AIC(cb1, cb3)## df AIC
## cb1 17 160.0445
## cb3 12 162.9830vif(cb1)## GVIF Df GVIF^(1/(2*Df))
## treatment 7.621680 4 1.289010
## whole.mean 2.242160 1 1.497384
## mean.dose 6.832784 1 2.613959
## replicate 2.398041 8 1.056188
## duration 1.508779 1 1.228324cb2 <- update(cb1, .~. -mean.dose)
vif(cb2)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.174500 4 1.020309
## whole.mean 1.913870 1 1.383427
## replicate 2.225962 8 1.051284
## duration 1.444778 1 1.201989#variables for cbind workers = treatment + whole.mean + replicate + duration
pollen.col <- lm(difference~ treatment + bees_alive + replicate + qro + count, data = pollen)
pcol1 <- update(pollen.col, .~. -qro)
vif(pcol1)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.098006 4 1.011756
## bees_alive 1.393435 1 1.180439
## replicate 1.280304 8 1.015563
## count 1.089723 1 1.043898drop1(pcol1, test = "Chisq")## Single term deletions
##
## Model:
## difference ~ treatment + bees_alive + replicate + count
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 76.499 -2258.1
## treatment 4 1.3050 77.804 -2250.6 0.003666 **
## bees_alive 1 7.0938 83.593 -2178.5 < 2.2e-16 ***
## replicate 8 16.0220 92.521 -2099.2 < 2.2e-16 ***
## count 1 13.1705 89.669 -2114.0 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#variables to keep for pollen model = treatment + bees_alive + replicate + count
dur.col<- lm(duration ~ treatment + whole.mean + alive + replicate + count, data = drone.ce)
vif(dur.col)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.539113 4 1.055380
## whole.mean 4.924833 1 2.219197
## alive 2.266370 1 1.505447
## replicate 4.670255 8 1.101118
## count 4.298387 1 2.073255drop1(dur.col, test = "Chisq")## Single term deletions
##
## Model:
## duration ~ treatment + whole.mean + alive + replicate + count
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 600.30 148.59
## treatment 4 264.82 865.12 157.03 0.002477 **
## whole.mean 1 81.56 681.87 152.32 0.016651 *
## alive 1 294.34 894.64 164.54 2.263e-05 ***
## replicate 8 438.95 1039.26 157.28 0.001749 **
## count 1 30.55 630.85 148.82 0.135058
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1dur1 <- update(dur.col, .~. -count)
vif(dur1)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.192170 4 1.022215
## whole.mean 2.650893 1 1.628156
## alive 2.151770 1 1.466891
## replicate 2.889696 8 1.068571#variables to keep for duration = treatment + whole.mean + alive + replicate Weight Change
w <- weights
range(w$difference)## [1] 3.79 18.50u <- is.na(w)
unique(u)## colony whole.mean mean.dose round dose treatment replicate brood_cells
## [1,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## honey_pot eggs dead_larvae live_larvae dead_pupae live_pupae dead_drones
## [1,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## live_drones drones avg_pollen qro duration dead_lp alive_lp alive dead
## [1,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## first last difference
## [1,] FALSE FALSE FALSEggplot(w, aes(x = difference, fill = treatment)) +
geom_histogram(position = "identity", binwidth = 0.5, col = I("black")) +
scale_fill_viridis_d() + # Use viridis_d() for the color-blind friendly palette
ggtitle("Colony Weight Change") +
labs(y = "Count", x = "Weight (g)")
shapiro.test(w$difference)##
## Shapiro-Wilk normality test
##
## data: w$difference
## W = 0.97975, p-value = 0.6097descdist(w$difference, discrete = FALSE)
## summary statistics
## ------
## min: 3.79 max: 18.5
## median: 10.7
## mean: 10.74422
## estimated sd: 3.708625
## estimated skewness: 0.1757572
## estimated kurtosis: 2.431206wmod.int <- glm(difference ~ treatment*whole.mean + alive + duration, data = w)
wmod1 <- glm(difference ~ treatment + whole.mean + alive + duration, data = w)
anova(wmod.int, wmod1, test = "Chisq")## Analysis of Deviance Table
##
## Model 1: difference ~ treatment * whole.mean + alive + duration
## Model 2: difference ~ treatment + whole.mean + alive + duration
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 33 275.72
## 2 37 313.55 -4 -37.827 0.3393AIC(wmod.int, wmod1)## df AIC
## wmod.int 13 235.2771
## wmod1 9 233.0625drop1(wmod1, test = "Chisq")## Single term deletions
##
## Model:
## difference ~ treatment + whole.mean + alive + duration
## Df Deviance AIC scaled dev. Pr(>Chi)
## <none> 313.55 233.06
## treatment 4 362.38 231.58 6.5133 0.1640
## whole.mean 1 481.05 250.32 19.2613 1.14e-05 ***
## alive 1 317.69 231.65 0.5905 0.4422
## duration 1 320.77 232.09 1.0243 0.3115
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1wmod2 <- update(wmod1, .~. -alive)
anova(wmod1, wmod2, test = "Chisq")## Analysis of Deviance Table
##
## Model 1: difference ~ treatment + whole.mean + alive + duration
## Model 2: difference ~ treatment + whole.mean + duration
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 37 313.55
## 2 38 317.69 -1 -4.1412 0.4845AIC(wmod1, wmod2)## df AIC
## wmod1 9 233.0625
## wmod2 8 231.6529drop1(wmod2, test = "Chisq")## Single term deletions
##
## Model:
## difference ~ treatment + whole.mean + duration
## Df Deviance AIC scaled dev. Pr(>Chi)
## <none> 317.69 231.65
## treatment 4 363.18 229.68 6.0227 0.1975
## whole.mean 1 495.05 249.62 19.9618 7.901e-06 ***
## duration 1 328.93 231.22 1.5641 0.2111
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1wmod3 <- update(wmod2, .~. -duration)
anova(wmod2, wmod3, test = "Chisq")## Analysis of Deviance Table
##
## Model 1: difference ~ treatment + whole.mean + duration
## Model 2: difference ~ treatment + whole.mean
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 38 317.69
## 2 39 328.93 -1 -11.236 0.2463drop1(wmod3, test = "Chisq")## Single term deletions
##
## Model:
## difference ~ treatment + whole.mean
## Df Deviance AIC scaled dev. Pr(>Chi)
## <none> 328.93 231.22
## treatment 4 375.38 229.16 5.9447 0.2033
## whole.mean 1 523.29 250.11 20.8939 4.854e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Anova(wmod3)## Analysis of Deviance Table (Type II tests)
##
## Response: difference
## LR Chisq Df Pr(>Chisq)
## treatment 5.5078 4 0.239
## whole.mean 23.0457 1 1.582e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1wmod3##
## Call: glm(formula = difference ~ treatment + whole.mean, data = w)
##
## Coefficients:
## (Intercept) treatment2 treatment3 treatment4 treatment5 whole.mean
## 3.438 1.484 3.079 2.306 1.442 11.745
##
## Degrees of Freedom: 44 Total (i.e. Null); 39 Residual
## Null Deviance: 605.2
## Residual Deviance: 328.9 AIC: 231.2summary(wmod3)##
## Call:
## glm(formula = difference ~ treatment + whole.mean, data = w)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -8.3141 -1.6206 -0.0015 1.6194 7.0005
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.438 1.464 2.348 0.0240 *
## treatment2 1.484 1.375 1.079 0.2870
## treatment3 3.079 1.381 2.230 0.0316 *
## treatment4 2.306 1.375 1.678 0.1014
## treatment5 1.442 1.370 1.053 0.2989
## whole.mean 11.745 2.447 4.801 2.34e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for gaussian family taken to be 8.433975)
##
## Null deviance: 605.17 on 44 degrees of freedom
## Residual deviance: 328.93 on 39 degrees of freedom
## AIC: 231.22
##
## Number of Fisher Scoring iterations: 2wsum <- w %>%
group_by(treatment) %>%
summarise(m = mean(difference),
sd = sd(difference),
n = length(difference)) %>%
mutate(se = sd/sqrt(n))
wdt <- setDT(as.data.frame(wsum))
wdt## treatment m sd n se
## 1: 1 8.712222 4.019004 9 1.3396681
## 2: 2 10.786667 2.706511 9 0.9021702
## 3: 3 12.644444 4.078943 9 1.3596477
## 4: 4 11.611111 3.522941 9 1.1743136
## 5: 5 9.966667 3.589568 9 1.1965227aw <- setDT(as.data.frame(Anova(wmod3)))
aw## LR Chisq Df Pr(>Chisq)
## 1: 5.507845 4 2.390407e-01
## 2: 23.045699 1 1.581960e-06we <- emmeans(wmod3, "treatment")
wp <- pairs(we)
wp <- as.data.frame(wp)
wp <- setDT(wp)
wp## contrast estimate SE df t.ratio p.value
## 1: treatment1 - treatment2 -1.48367801 1.374540 39 -1.07939953 0.8159169
## 2: treatment1 - treatment3 -3.07899331 1.380509 39 -2.23033139 0.1901671
## 3: treatment1 - treatment4 -2.30634802 1.374573 39 -1.67786469 0.4589569
## 4: treatment1 - treatment5 -1.44181836 1.369577 39 -1.05274751 0.8290717
## 5: treatment2 - treatment3 -1.59531530 1.370112 39 -1.16436888 0.7711973
## 6: treatment2 - treatment4 -0.82267002 1.369020 39 -0.60091875 0.9741158
## 7: treatment2 - treatment5 0.04185964 1.378583 39 0.03036426 0.9999998
## 8: treatment3 - treatment4 0.77264528 1.370097 39 0.56393478 0.9794900
## 9: treatment3 - treatment5 1.63717494 1.386075 39 1.18115899 0.7619078
## 10: treatment4 - treatment5 0.86452966 1.378626 39 0.62709498 0.9697859wtuk.means <- emmeans(object = wmod3,
specs = "treatment",
adjust = "Tukey",
type = "response")
wtuk.means## treatment emmean SE df lower.CL upper.CL
## 1 9.08 0.971 39 6.46 11.7
## 2 10.57 0.969 39 7.95 13.2
## 3 12.16 0.973 39 9.53 14.8
## 4 11.39 0.969 39 8.77 14.0
## 5 10.52 0.975 39 7.89 13.2
##
## Confidence level used: 0.95
## Conf-level adjustment: sidak method for 5 estimateswtkdt <- setDT(as.data.frame(wtuk.means))
wtkdt## treatment emmean SE df lower.CL upper.CL
## 1: 1 9.082055 0.9711042 39 6.460238 11.70387
## 2: 2 10.565733 0.9691369 39 7.949227 13.18224
## 3: 3 12.161048 0.9732666 39 9.533393 14.78870
## 4: 4 11.388403 0.9691545 39 8.771849 14.00496
## 5: 5 10.523873 0.9749772 39 7.891599 13.15615w.cld.model <- cld(object = wtuk.means,
adjust = "Tukey",
Letters = letters,
alpha = 0.05)
w.cld.model## treatment emmean SE df lower.CL upper.CL .group
## 1 9.08 0.971 39 6.46 11.7 a
## 5 10.52 0.975 39 7.89 13.2 a
## 2 10.57 0.969 39 7.95 13.2 a
## 4 11.39 0.969 39 8.77 14.0 a
## 3 12.16 0.973 39 9.53 14.8 a
##
## Confidence level used: 0.95
## Conf-level adjustment: sidak method for 5 estimates
## P value adjustment: tukey method for comparing a family of 5 estimates
## significance level used: alpha = 0.05
## NOTE: If two or more means share the same grouping symbol,
## then we cannot show them to be different.
## But we also did not show them to be the same.wtuk.treatment <- as.data.frame(w.cld.model)
wtuk.treatment## treatment emmean SE df lower.CL upper.CL .group
## 1 9.082055 0.9711042 39 6.460238 11.70387 a
## 5 10.523873 0.9749772 39 7.891599 13.15615 a
## 2 10.565733 0.9691369 39 7.949227 13.18224 a
## 4 11.388403 0.9691545 39 8.771849 14.00496 a
## 3 12.161048 0.9732666 39 9.533393 14.78870 a
##
## Confidence level used: 0.95
## Conf-level adjustment: sidak method for 5 estimates
## P value adjustment: tukey method for comparing a family of 5 estimates
## significance level used: alpha = 0.05
## NOTE: If two or more means share the same grouping symbol,
## then we cannot show them to be different.
## But we also did not show them to be the same.w_max <- w %>%
group_by(treatment) %>%
summarize(maxw = max(mean(difference)))
w_for_plotting <- full_join(wtuk.treatment, w_max,
by="treatment")
wsum## # A tibble: 5 × 5
## treatment m sd n se
## <fct> <dbl> <dbl> <int> <dbl>
## 1 1 8.71 4.02 9 1.34
## 2 2 10.8 2.71 9 0.902
## 3 3 12.6 4.08 9 1.36
## 4 4 11.6 3.52 9 1.17
## 5 5 9.97 3.59 9 1.20ggplot(data = wsum, aes(x = treatment, y = m, fill = treatment)) +
geom_col(col = "black") +
coord_cartesian(ylim = c(0, 20)) +
scale_fill_viridis_d() + # Use viridis_d() for the color-blind friendly palette
geom_errorbar(aes(ymin = m - se, ymax = m + sd),
position = position_dodge(2), width = 0.4, size = 1.5) +
labs(y = "Mean Weight Difference") +
ggtitle("Average Colony Weight Change(g) by Treatment") +
scale_x_discrete(
name = "Treatment",
labels = c("0 PPB", "150 PPB", "1,500 PPB", "15,000 PPB", "150,000 PPB")
) +
theme_classic(base_size = 30) + # Adjust the base_size as needed
annotate(
geom = "text",
x = 1, y = 19,
label = " p = 0.24",
size = 15 # Adjust the size of the annotation text as needed
) +
annotate(
geom = "text",
x = c(1, 5, 2, 4, 3),
y = c(14, 15, 14.5, 16, 18),
label = c("a", "a", "a", "a", "a"),
size = 20 # Adjust the size of the annotation text as needed
) +
theme(legend.position = "none")## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Pollen Consumption
shapiro.test(pollen$difference)##
## Shapiro-Wilk normality test
##
## data: pollen$difference
## W = 0.84265, p-value < 2.2e-16pollen$sq <- (pollen$difference)^(1/3)
pollen$box <- bcPower(pollen$difference, -3, gamma=1)
shapiro.test(pollen$sq)##
## Shapiro-Wilk normality test
##
## data: pollen$sq
## W = 0.9442, p-value < 2.2e-16shapiro.test(pollen$box)##
## Shapiro-Wilk normality test
##
## data: pollen$box
## W = 0.9588, p-value = 2.044e-15ggplot(pollen, aes(x = box, fill = treatment)) +
geom_histogram(position = "identity", binwidth = 0.01, col = I("black")) +
scale_fill_viridis_d() + # Use viridis_d() for the color-blind friendly palette
ggtitle("Pollen Consumption(g)") +
labs(y = "Count", x = "Pollen (g)")
p1 <- aov(box ~ treatment + count + bees_alive + replicate, data = pollen )
drop1(p1, test = "Chisq")## Single term deletions
##
## Model:
## box ~ treatment + count + bees_alive + replicate
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 2.5081 -5402.5
## treatment 4 0.08144 2.5895 -5381.1 6.492e-06 ***
## count 1 0.61649 3.1246 -5202.3 < 2.2e-16 ***
## bees_alive 1 0.24627 2.7543 -5318.3 < 2.2e-16 ***
## replicate 8 0.53402 3.0421 -5240.9 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1summary(p1)## Df Sum Sq Mean Sq F value Pr(>F)
## treatment 4 0.0735 0.0184 6.631 2.92e-05 ***
## count 1 0.3695 0.3695 133.326 < 2e-16 ***
## bees_alive 1 0.1899 0.1899 68.517 4.49e-16 ***
## replicate 8 0.5340 0.0668 24.087 < 2e-16 ***
## Residuals 905 2.5081 0.0028
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1plot(p1)
p2 <- lmer(box ~ treatment + count + bees_alive + replicate + (1|colony), data = pollen )
plot(p2)
Anova(p2)## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: box
## Chisq Df Pr(>Chisq)
## treatment 4.9947 4 0.2878
## count 255.4752 1 < 2.2e-16 ***
## bees_alive 20.6874 1 5.407e-06 ***
## replicate 33.2642 8 5.519e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1qqnorm(resid(p2));qqline(resid(p2)) 
sum <- pollen %>%
group_by(treatment) %>%
summarise(mean = mean(difference),
sd = sd(difference),
n = length(difference)) %>%
mutate(se = sd/sqrt(n))
sum## # A tibble: 5 × 5
## treatment mean sd n se
## <fct> <dbl> <dbl> <int> <dbl>
## 1 1 0.430 0.336 195 0.0240
## 2 2 0.502 0.348 180 0.0259
## 3 3 0.508 0.345 190 0.0250
## 4 4 0.488 0.342 178 0.0256
## 5 5 0.435 0.316 177 0.0238sum## # A tibble: 5 × 5
## treatment mean sd n se
## <fct> <dbl> <dbl> <int> <dbl>
## 1 1 0.430 0.336 195 0.0240
## 2 2 0.502 0.348 180 0.0259
## 3 3 0.508 0.345 190 0.0250
## 4 4 0.488 0.342 178 0.0256
## 5 5 0.435 0.316 177 0.0238emmeans(p2, pairwise ~ "treatment")## $emmeans
## treatment emmean SE df lower.CL upper.CL
## 1 0.193 0.00912 31.1 0.175 0.212
## 2 0.211 0.00917 31.8 0.192 0.230
## 3 0.211 0.00914 31.4 0.192 0.229
## 4 0.212 0.00921 32.4 0.193 0.231
## 5 0.192 0.00924 32.6 0.173 0.211
##
## Results are averaged over the levels of: replicate
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
##
## $contrasts
## contrast estimate SE df t.ratio p.value
## treatment1 - treatment2 -0.017527 0.0129 31.5 -1.355 0.6600
## treatment1 - treatment3 -0.017290 0.0129 31.4 -1.338 0.6701
## treatment1 - treatment4 -0.018596 0.0129 31.6 -1.436 0.6096
## treatment1 - treatment5 0.001705 0.0130 32.0 0.131 0.9999
## treatment2 - treatment3 0.000237 0.0129 31.5 0.018 1.0000
## treatment2 - treatment4 -0.001068 0.0130 32.3 -0.082 1.0000
## treatment2 - treatment5 0.019232 0.0130 32.1 1.479 0.5829
## treatment3 - treatment4 -0.001305 0.0130 32.2 -0.100 1.0000
## treatment3 - treatment5 0.018995 0.0130 31.8 1.464 0.5925
## treatment4 - treatment5 0.020300 0.0131 32.8 1.552 0.5373
##
## Results are averaged over the levels of: replicate
## Degrees-of-freedom method: kenward-roger
## P value adjustment: tukey method for comparing a family of 5 estimatesggplot(data = sum, aes(x=treatment, y = mean, fill = treatment)) +
geom_col(col = "black") +
coord_cartesian(ylim = c(0.40, 0.55)) +
scale_fill_viridis_d() +
geom_errorbar(aes(ymin = mean - se, ymax = mean + se), width = 0.2, position = position_dodge(0.9))
sum1 <- pollen %>%
group_by(colony) %>%
summarise(mean = mean(dose_consumed),
sd = sd(dose_consumed),
n = length(dose_consumed)) %>%
mutate(se = sd/sqrt(n))
sum1## # A tibble: 45 × 5
## colony mean sd n se
## <fct> <dbl> <dbl> <int> <dbl>
## 1 1.11R2 0 0 22 0
## 2 1.12R2 0 0 22 0
## 3 1.1R2 0 0 19 0
## 4 1.2R2 0 0 27 0
## 5 1.3R2 0 0 22 0
## 6 1.4R2 0 0 19 0
## 7 1.5R2 0 0 19 0
## 8 1.7R2 0 0 19 0
## 9 1.9R2 0 0 26 0
## 10 2.11R2 36.0 33.0 20 7.38
## # ℹ 35 more rowsggplot(data = sum1, aes(x=colony, y = mean, fill = colony)) +
geom_col(col = "black") +
coord_cartesian(ylim = c(0, 95000)) +
scale_fill_viridis_d() +
geom_errorbar(aes(ymin = mean - se, ymax = mean + se), width = 0.2, position = position_dodge(0.9)) +
labs(title = "Dose of Pristine Consumed per Colony", y = "Dose(PPM)", x = "Colony")+
theme(legend.position = c(0.2, 0.7)) +
theme(text = element_text(size = 20))
Workers
Dry Weight
ggplot(workers, aes(x = dry_weight, fill = treatment)) +
geom_histogram(position = "identity", binwidth = 0.002, col = I("black")) +
scale_fill_viridis_d() + # Use viridis_d() for the color-blind friendly palette
ggtitle("Worker Dry Weight(g)") +
labs(y = "Count", x = "Weight (g)")
shapiro.test(workers$dry_weight)##
## Shapiro-Wilk normality test
##
## data: workers$dry_weight
## W = 0.906, p-value = 1.153e-10workers$logdry <- log(workers$dry_weight)
shapiro.test(workers$logdry)##
## Shapiro-Wilk normality test
##
## data: workers$logdry
## W = 0.98708, p-value = 0.04033ggplot(workers, aes(x = logdry, fill = treatment)) +
geom_histogram(position = "identity", binwidth = 0.05, col = I("black")) +
scale_fill_viridis_d() + # Use viridis_d() for the color-blind friendly palette
ggtitle("Worker Dry Weight(g)") +
labs(y = "Count", x = "Weight (g)")
wrkdry.int <- lmer(logdry ~ treatment*whole.mean + alive_at_end + colony_duration + days_alive + (1|colony), data = workers)
wrkdry1 <- lmer(logdry ~ treatment + whole.mean + alive_at_end + colony_duration + days_alive + (1|colony), data = workers)
anova(wrkdry.int, wrkdry1)## Data: workers
## Models:
## wrkdry1: logdry ~ treatment + whole.mean + alive_at_end + colony_duration + days_alive + (1 | colony)
## wrkdry.int: logdry ~ treatment * whole.mean + alive_at_end + colony_duration + days_alive + (1 | colony)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## wrkdry1 11 155.32 192.85 -66.662 133.32
## wrkdry.int 15 161.28 212.45 -65.640 131.28 2.0438 4 0.7277drop1(wrkdry1, test = "Chisq")## Single term deletions
##
## Model:
## logdry ~ treatment + whole.mean + alive_at_end + colony_duration +
## days_alive + (1 | colony)
## npar AIC LRT Pr(Chi)
## <none> 155.32
## treatment 4 149.92 2.596 0.6275
## whole.mean 1 185.17 31.842 1.672e-08 ***
## alive_at_end 1 153.44 0.118 0.7312
## colony_duration 1 154.08 0.754 0.3851
## days_alive 1 153.32 0.001 0.9796
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1wd1 <- update(wrkdry1, .~. -alive_at_end)
drop1(wd1, test = "Chisq")## Single term deletions
##
## Model:
## logdry ~ treatment + whole.mean + colony_duration + days_alive +
## (1 | colony)
## npar AIC LRT Pr(Chi)
## <none> 153.44
## treatment 4 148.03 2.584 0.6296
## whole.mean 1 186.67 35.232 2.926e-09 ***
## colony_duration 1 152.12 0.677 0.4106
## days_alive 1 151.51 0.066 0.7966
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1wd2 <- update(wd1, .~. -days_alive)
drop1(wd1, test = "Chisq")## Single term deletions
##
## Model:
## logdry ~ treatment + whole.mean + colony_duration + days_alive +
## (1 | colony)
## npar AIC LRT Pr(Chi)
## <none> 153.44
## treatment 4 148.03 2.584 0.6296
## whole.mean 1 186.67 35.232 2.926e-09 ***
## colony_duration 1 152.12 0.677 0.4106
## days_alive 1 151.51 0.066 0.7966
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1wd3 <- update(wd2, .~. -colony_duration)
drop1(wd3, test = "Chisq")## Single term deletions
##
## Model:
## logdry ~ treatment + whole.mean + (1 | colony)
## npar AIC LRT Pr(Chi)
## <none> 151.81
## treatment 4 146.06 2.247 0.6903
## whole.mean 1 188.94 39.135 3.955e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1wd3## Linear mixed model fit by REML ['lmerMod']
## Formula: logdry ~ treatment + whole.mean + (1 | colony)
## Data: workers
## REML criterion at convergence: 157.7482
## Random effects:
## Groups Name Std.Dev.
## colony (Intercept) 0.09229
## Residual 0.32110
## Number of obs: 224, groups: colony, 45
## Fixed Effects:
## (Intercept) treatment2 treatment3 treatment4 treatment5 whole.mean
## -3.61018 -0.06123 -0.01718 -0.02813 0.04931 1.05864Anova(wd3)## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: logdry
## Chisq Df Pr(>Chisq)
## treatment 1.9987 4 0.736
## whole.mean 54.1859 1 1.824e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1wa <- setDT(as.data.frame(((Anova(wd3)))))
wa## Chisq Df Pr(>Chisq)
## 1: 1.998704 4 7.359973e-01
## 2: 54.185905 1 1.823905e-13workdry <- workers %>%
group_by(treatment) %>%
summarise(a.m= mean(dry_weight),
sd.a = sd(dry_weight),
n.a = length(dry_weight)) %>%
mutate(sea = sd.a / sqrt(n.a))
workdry <- setDT(workdry)
workdry## treatment a.m sd.a n.a sea
## 1: 1 0.04741244 0.02047277 45 0.003051901
## 2: 2 0.04555133 0.01594982 45 0.002377659
## 3: 3 0.04992178 0.02039617 45 0.003040482
## 4: 4 0.04874068 0.02274766 44 0.003429339
## 5: 5 0.04778982 0.01760140 45 0.002623861workdryem <- emmeans(wmod3, ~treatment, type = "response")
workdryem## treatment emmean SE df lower.CL upper.CL
## 1 9.08 0.971 39 7.12 11.0
## 2 10.57 0.969 39 8.61 12.5
## 3 12.16 0.973 39 10.19 14.1
## 4 11.39 0.969 39 9.43 13.3
## 5 10.52 0.975 39 8.55 12.5
##
## Confidence level used: 0.95wp <- as.data.frame(pairs(workdryem))
wp <- setDT(wp)
wp## contrast estimate SE df t.ratio p.value
## 1: treatment1 - treatment2 -1.48367801 1.374540 39 -1.07939953 0.8159169
## 2: treatment1 - treatment3 -3.07899331 1.380509 39 -2.23033139 0.1901671
## 3: treatment1 - treatment4 -2.30634802 1.374573 39 -1.67786469 0.4589569
## 4: treatment1 - treatment5 -1.44181836 1.369577 39 -1.05274751 0.8290717
## 5: treatment2 - treatment3 -1.59531530 1.370112 39 -1.16436888 0.7711973
## 6: treatment2 - treatment4 -0.82267002 1.369020 39 -0.60091875 0.9741158
## 7: treatment2 - treatment5 0.04185964 1.378583 39 0.03036426 0.9999998
## 8: treatment3 - treatment4 0.77264528 1.370097 39 0.56393478 0.9794900
## 9: treatment3 - treatment5 1.63717494 1.386075 39 1.18115899 0.7619078
## 10: treatment4 - treatment5 0.86452966 1.378626 39 0.62709498 0.9697859wde <- as.data.frame(workdryem)
wde2 <- setDT(wde)
wde2## treatment emmean SE df lower.CL upper.CL
## 1: 1 9.082055 0.9711042 39 7.117811 11.04630
## 2: 2 10.565733 0.9691369 39 8.605468 12.52600
## 3: 3 12.161048 0.9732666 39 10.192431 14.12967
## 4: 4 11.388403 0.9691545 39 9.428103 13.34870
## 5: 5 10.523873 0.9749772 39 8.551795 12.49595workcld <- cld(object = workdryem,
adjust = "TUkey",
alpha = 0.05,
Letters = letters)
workcld## treatment emmean SE df lower.CL upper.CL .group
## 1 9.08 0.971 39 6.46 11.7 a
## 5 10.52 0.975 39 7.89 13.2 a
## 2 10.57 0.969 39 7.95 13.2 a
## 4 11.39 0.969 39 8.77 14.0 a
## 3 12.16 0.973 39 9.53 14.8 a
##
## Confidence level used: 0.95
## Conf-level adjustment: sidak method for 5 estimates
## P value adjustment: tukey method for comparing a family of 5 estimates
## significance level used: alpha = 0.05
## NOTE: If two or more means share the same grouping symbol,
## then we cannot show them to be different.
## But we also did not show them to be the same.emmdf2 <- as.data.frame(workcld)
emmdf2## treatment emmean SE df lower.CL upper.CL .group
## 1 9.082055 0.9711042 39 6.460238 11.70387 a
## 5 10.523873 0.9749772 39 7.891599 13.15615 a
## 2 10.565733 0.9691369 39 7.949227 13.18224 a
## 4 11.388403 0.9691545 39 8.771849 14.00496 a
## 3 12.161048 0.9732666 39 9.533393 14.78870 a
##
## Confidence level used: 0.95
## Conf-level adjustment: sidak method for 5 estimates
## P value adjustment: tukey method for comparing a family of 5 estimates
## significance level used: alpha = 0.05
## NOTE: If two or more means share the same grouping symbol,
## then we cannot show them to be different.
## But we also did not show them to be the same.workdry$plot <- workdry$a.m + workdry$sea
ggplot(data = workdry, aes(x = treatment, y = a.m, fill = treatment)) +
geom_col(col = "black") +
coord_cartesian(ylim = c(0, 0.06)) +
scale_fill_viridis_d() + # Use viridis_d() for the color-blind friendly palette
geom_errorbar(aes(ymax = a.m + sea, ymin = a.m - sea),
position = position_dodge(2), width = 0.4, size = 1.5) +
labs(y = "Average Worker Dry Weight(g)") +
ggtitle("Average Worker Dry Weight(g) by Treatment") +
scale_x_discrete(
name = "Treatment",
labels = c("0 PPB", "150 PPB", "1,500 PPB", "15,000 PPB", "150,000 PPB")
) +
theme_classic(base_size = 30) + # Adjust the base_size as needed
annotate(
geom = "text",
x = 1, y = 0.06,
label = " p = 0.74",
size = 15 # Adjust the size of the annotation text as needed
) +
annotate(
geom = "text",
x = c(1, 5, 2, 4, 3),
y = c(0.055, 0.055, 0.054, 0.057, 0.056),
label = c("a", "a", "a", "a", "a"),
size = 20 # Adjust the size of the annotation text as needed
) +
theme(legend.position = "none")
ggplot(workers, aes(x = whole.mean, y = dry_weight, color = treatment)) +
geom_point(size = 5)+
ggtitle("Amount of Pollen Consumed vs. Average Worker Dry Weight")+
xlab("Mean Polen Consumption(g)") +
ylab("Mean Dry Weight(g)") +
scale_fill_viridis_d() +
theme(text = element_text(size = 20)) +
geom_smooth(method = "lm", color = "black")
Worker Survival
Days Alive
workers$survived <- as.logical(workers$survived)
wrkdays1 <- glm.nb(days_alive ~ treatment + whole.mean + colony_duration + replicate + dry_weight, data = workers)## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reachedwrkdays2 <- glm.nb(days_alive ~ treatment*whole.mean + colony_duration + replicate + dry_weight, data = workers)## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reachedAIC(wrkdays1, wrkdays2)## df AIC
## wrkdays1 17 1489.870
## wrkdays2 21 1493.075drop1(wrkdays1, test = "Chisq")## Single term deletions
##
## Model:
## days_alive ~ treatment + whole.mean + colony_duration + replicate +
## dry_weight
## Df Deviance AIC LRT Pr(>Chi)
## <none> 221.08 1487.9
## treatment 4 228.13 1486.9 7.051 0.1332391
## whole.mean 1 241.98 1506.8 20.905 4.825e-06 ***
## colony_duration 1 379.64 1644.4 158.563 < 2.2e-16 ***
## replicate 8 250.64 1501.4 29.566 0.0002521 ***
## dry_weight 1 221.09 1485.9 0.013 0.9082180
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1wd2 <- update(wrkdays1, .~. -dry_weight)## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reacheddrop1(wd2, test = "Chisq")## Single term deletions
##
## Model:
## days_alive ~ treatment + whole.mean + colony_duration + replicate
## Df Deviance AIC LRT Pr(>Chi)
## <none> 221.09 1485.9
## treatment 4 228.14 1484.9 7.046 0.1334757
## whole.mean 1 246.33 1509.1 25.239 5.065e-07 ***
## colony_duration 1 379.79 1642.6 158.696 < 2.2e-16 ***
## replicate 8 251.30 1500.1 30.206 0.0001943 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1qqnorm(resid(wd2));qqline(resid(wd2))
wd3 <- update(wd2, .~. -alive)## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reacheddrop1(wd3, test = "Chisq")## Single term deletions
##
## Model:
## days_alive ~ treatment + whole.mean + colony_duration + replicate
## Df Deviance AIC LRT Pr(>Chi)
## <none> 221.09 1485.9
## treatment 4 228.14 1484.9 7.046 0.1334757
## whole.mean 1 246.33 1509.1 25.239 5.065e-07 ***
## colony_duration 1 379.79 1642.6 158.696 < 2.2e-16 ***
## replicate 8 251.30 1500.1 30.206 0.0001943 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1wd4 <- update(wd3, .~. -whole.mean)## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reacheddrop1(wd4, test = "Chisq")## Single term deletions
##
## Model:
## days_alive ~ treatment + colony_duration + replicate
## Df Deviance AIC LRT Pr(>Chi)
## <none> 246.33 1509.1
## treatment 4 253.85 1508.7 7.525 0.1106111
## colony_duration 1 409.56 1670.4 163.235 < 2.2e-16 ***
## replicate 8 272.83 1519.6 26.498 0.0008628 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1cbind workers
cbw1 <- glm(cbind(alive, dead) ~ treatment + whole.mean + qro + duration, data = cbindworkers, family = binomial("logit"))
cbw2 <- glm(cbind(alive, dead) ~ treatment + whole.mean + replicate + duration, data = cbindworkers, family = binomial("logit"))
anova(cbw1, cbw2, test = "Chisq")## Analysis of Deviance Table
##
## Model 1: cbind(alive, dead) ~ treatment + whole.mean + qro + duration
## Model 2: cbind(alive, dead) ~ treatment + whole.mean + replicate + duration
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 35 55.296
## 2 30 32.655 5 22.641 0.0003953 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1AIC(cbw1, cbw2)## df AIC
## cbw1 10 98.07714
## cbw2 15 85.43635drop1(cbw1, test = "Chisq")## Single term deletions
##
## Model:
## cbind(alive, dead) ~ treatment + whole.mean + qro + duration
## Df Deviance AIC LRT Pr(>Chi)
## <none> 55.296 98.077
## treatment 4 75.837 110.618 20.541 0.0003904 ***
## whole.mean 1 106.167 146.948 50.871 9.865e-13 ***
## qro 3 100.520 137.301 45.224 8.291e-10 ***
## duration 1 72.405 113.186 17.108 3.531e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1plot(cbw1)
plot(cbw2)
cbw1##
## Call: glm(formula = cbind(alive, dead) ~ treatment + whole.mean + qro +
## duration, family = binomial("logit"), data = cbindworkers)
##
## Coefficients:
## (Intercept) treatment2 treatment3 treatment4 treatment5 whole.mean
## 4.9227 1.7801 3.1766 0.6824 3.0456 11.3968
## qroB3 qroB4 qroB5 duration
## -1.1338 -5.8092 -3.3144 -0.1758
##
## Degrees of Freedom: 44 Total (i.e. Null); 35 Residual
## Null Deviance: 143.7
## Residual Deviance: 55.3 AIC: 98.08Anova(cbw1)## Analysis of Deviance Table (Type II tests)
##
## Response: cbind(alive, dead)
## LR Chisq Df Pr(>Chisq)
## treatment 20.541 4 0.0003904 ***
## whole.mean 50.871 1 9.865e-13 ***
## qro 45.224 3 8.291e-10 ***
## duration 17.108 1 3.531e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1acw <- setDT(as.data.frame(Anova(cbw1)))
acw## LR Chisq Df Pr(>Chisq)
## 1: 20.54104 4 3.904029e-04
## 2: 50.87087 1 9.864667e-13
## 3: 45.22428 3 8.290881e-10
## 4: 17.10837 1 3.530640e-05emm1 <- emmeans(cbw1, pairwise ~ treatment, type = "response")
pairs(emm1)## contrast odds.ratio SE df null z.ratio p.value
## treatment1 / treatment2 0.1686 0.1255 Inf 1 -2.391 0.1176
## treatment1 / treatment3 0.0417 0.0405 Inf 1 -3.272 0.0094
## treatment1 / treatment4 0.5054 0.3493 Inf 1 -0.987 0.8612
## treatment1 / treatment5 0.0476 0.0433 Inf 1 -3.345 0.0074
## treatment2 / treatment3 0.2475 0.2213 Inf 1 -1.562 0.5221
## treatment2 / treatment4 2.9973 2.5498 Inf 1 1.290 0.6972
## treatment2 / treatment5 0.2821 0.2340 Inf 1 -1.526 0.5457
## treatment3 / treatment4 12.1119 12.6742 Inf 1 2.384 0.1197
## treatment3 / treatment5 1.1400 1.0911 Inf 1 0.137 0.9999
## treatment4 / treatment5 0.0941 0.0938 Inf 1 -2.371 0.1233
##
## Results are averaged over the levels of: qro
## P value adjustment: tukey method for comparing a family of 5 estimates
## Tests are performed on the log odds ratio scaleemm1## $emmeans
## treatment prob SE df asymp.LCL asymp.UCL
## 1 0.569 0.1039 Inf 0.365 0.752
## 2 0.887 0.0591 Inf 0.712 0.961
## 3 0.969 0.0251 Inf 0.858 0.994
## 4 0.723 0.1275 Inf 0.428 0.901
## 5 0.965 0.0251 Inf 0.865 0.992
##
## Results are averaged over the levels of: qro
## Confidence level used: 0.95
## Intervals are back-transformed from the logit scale
##
## $contrasts
## contrast odds.ratio SE df null z.ratio p.value
## treatment1 / treatment2 0.1686 0.1255 Inf 1 -2.391 0.1176
## treatment1 / treatment3 0.0417 0.0405 Inf 1 -3.272 0.0094
## treatment1 / treatment4 0.5054 0.3493 Inf 1 -0.987 0.8612
## treatment1 / treatment5 0.0476 0.0433 Inf 1 -3.345 0.0074
## treatment2 / treatment3 0.2475 0.2213 Inf 1 -1.562 0.5221
## treatment2 / treatment4 2.9973 2.5498 Inf 1 1.290 0.6972
## treatment2 / treatment5 0.2821 0.2340 Inf 1 -1.526 0.5457
## treatment3 / treatment4 12.1119 12.6742 Inf 1 2.384 0.1197
## treatment3 / treatment5 1.1400 1.0911 Inf 1 0.137 0.9999
## treatment4 / treatment5 0.0941 0.0938 Inf 1 -2.371 0.1233
##
## Results are averaged over the levels of: qro
## P value adjustment: tukey method for comparing a family of 5 estimates
## Tests are performed on the log odds ratio scaleemmdf <- as.data.frame(emm1$contrasts)
emmdf## contrast odds.ratio SE df null z.ratio p.value
## treatment1 / treatment2 0.168615 0.125511 Inf 1 -2.391 0.1176
## treatment1 / treatment3 0.041727 0.040505 Inf 1 -3.272 0.0094
## treatment1 / treatment4 0.505393 0.349343 Inf 1 -0.987 0.8612
## treatment1 / treatment5 0.047569 0.043314 Inf 1 -3.345 0.0074
## treatment2 / treatment3 0.247469 0.221268 Inf 1 -1.562 0.5221
## treatment2 / treatment4 2.997324 2.549782 Inf 1 1.290 0.6972
## treatment2 / treatment5 0.282117 0.234013 Inf 1 -1.526 0.5457
## treatment3 / treatment4 12.111902 12.674160 Inf 1 2.384 0.1197
## treatment3 / treatment5 1.140009 1.091140 Inf 1 0.137 0.9999
## treatment4 / treatment5 0.094123 0.093819 Inf 1 -2.371 0.1233
##
## Results are averaged over the levels of: qro
## P value adjustment: tukey method for comparing a family of 5 estimates
## Tests are performed on the log odds ratio scaleworkcld <- cld(object = emm1,
adjust = "Tukey",
alpha = 0.05,
Letters = letters)
workcld ## treatment prob SE df asymp.LCL asymp.UCL .group
## 1 0.569 0.1039 Inf 0.308 0.797 a
## 4 0.723 0.1275 Inf 0.337 0.931 ab
## 2 0.887 0.0591 Inf 0.634 0.973 ab
## 5 0.965 0.0251 Inf 0.803 0.995 b
## 3 0.969 0.0251 Inf 0.783 0.996 b
##
## Results are averaged over the levels of: qro
## Confidence level used: 0.95
## Conf-level adjustment: sidak method for 5 estimates
## Intervals are back-transformed from the logit scale
## P value adjustment: tukey method for comparing a family of 5 estimates
## Tests are performed on the log odds ratio scale
## significance level used: alpha = 0.05
## NOTE: If two or more means share the same grouping symbol,
## then we cannot show them to be different.
## But we also did not show them to be the same.workcld <- as.data.frame(workcld)
workcld$plot <- workcld$prob + workcld$asymp.UCL
workcld## treatment prob SE df asymp.LCL asymp.UCL .group plot
## 1 0.5688864 0.10394405 Inf 0.3075951 0.7967339 a 1.365620
## 4 0.7230672 0.12747855 Inf 0.3372412 0.9305434 ab 1.653611
## 2 0.8866979 0.05905240 Inf 0.6335663 0.9725444 ab 1.859242
## 5 0.9652054 0.02508011 Inf 0.8029056 0.9947340 b 1.959939
## 3 0.9693477 0.02510820 Inf 0.7829991 0.9964050 b 1.965753
##
## Results are averaged over the levels of: qro
## Confidence level used: 0.95
## Conf-level adjustment: sidak method for 5 estimates
## Intervals are back-transformed from the logit scale
## P value adjustment: tukey method for comparing a family of 5 estimates
## Tests are performed on the log odds ratio scale
## significance level used: alpha = 0.05
## NOTE: If two or more means share the same grouping symbol,
## then we cannot show them to be different.
## But we also did not show them to be the same.ggplot(data = workcld, aes(x=treatment, y=prob, fill=treatment)) +
geom_col(position = "dodge", color = "black") +
geom_errorbar(aes(ymin = prob - SE, ymax = prob + SE), width = 0.2, position = position_dodge(0.9)) +
coord_cartesian(ylim = c(0,1.3)) +
labs(x = "Treatment", y = "Probability of Survival", title ="Probability of Worker Survival for Duration of Experiment") +
theme(text = element_text(size = 20)) +
annotate(geom = "text",
x = 1, y = 1.2,
label = "P < 0.001",
size = 8) +
annotate(geom = "text",
x = c(1, 2, 3, 4, 5),
y = c(0.75, 1.1, 1.1, 1, 1.1),
label = c("a", "ab", "b", "ab", "b"),
size = 8) +
theme(legend.position = "none")
Brood Production
brood1 <- glm.nb(brood_cells ~ treatment + whole.mean + alive + duration, data = brood)
emmeans(brood1, pairwise ~ treatment)## $emmeans
## treatment emmean SE df asymp.LCL asymp.UCL
## 1 3.43 0.1063 Inf 3.23 3.64
## 2 3.54 0.0991 Inf 3.34 3.73
## 3 3.53 0.0986 Inf 3.33 3.72
## 4 3.41 0.1018 Inf 3.21 3.61
## 5 3.36 0.1061 Inf 3.16 3.57
##
## Results are given on the log (not the response) scale.
## Confidence level used: 0.95
##
## $contrasts
## contrast estimate SE df z.ratio p.value
## treatment1 - treatment2 -0.1039 0.148 Inf -0.702 0.9561
## treatment1 - treatment3 -0.0918 0.146 Inf -0.629 0.9705
## treatment1 - treatment4 0.0237 0.145 Inf 0.163 0.9998
## treatment1 - treatment5 0.0709 0.154 Inf 0.461 0.9907
## treatment2 - treatment3 0.0121 0.138 Inf 0.088 1.0000
## treatment2 - treatment4 0.1275 0.142 Inf 0.896 0.8985
## treatment2 - treatment5 0.1748 0.144 Inf 1.218 0.7411
## treatment3 - treatment4 0.1154 0.140 Inf 0.825 0.9230
## treatment3 - treatment5 0.1626 0.143 Inf 1.134 0.7885
## treatment4 - treatment5 0.0472 0.149 Inf 0.318 0.9978
##
## Results are given on the log (not the response) scale.
## P value adjustment: tukey method for comparing a family of 5 estimatesbrood2 <- glm(brood_cells ~ treatment + whole.mean + alive + duration, data = brood, family = "poisson") #overdispersed
summary(brood2)##
## Call:
## glm(formula = brood_cells ~ treatment + whole.mean + alive +
## duration, family = "poisson", data = brood)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -4.5125 -1.2364 -0.0304 0.9353 3.2099
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.397836 0.169424 14.153 < 2e-16 ***
## treatment2 0.051493 0.082855 0.621 0.53428
## treatment3 0.097931 0.079413 1.233 0.21751
## treatment4 -0.060838 0.080982 -0.751 0.45250
## treatment5 -0.067623 0.088439 -0.765 0.44449
## whole.mean 2.486554 0.151649 16.397 < 2e-16 ***
## alive 0.066894 0.023434 2.855 0.00431 **
## duration -0.009293 0.003292 -2.823 0.00476 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 526.03 on 44 degrees of freedom
## Residual deviance: 133.51 on 37 degrees of freedom
## AIC: 381.35
##
## Number of Fisher Scoring iterations: 5drop1(brood1, test = "Chisq")## Single term deletions
##
## Model:
## brood_cells ~ treatment + whole.mean + alive + duration
## Df Deviance AIC LRT Pr(>Chi)
## <none> 60.842 356.16
## treatment 4 63.101 350.42 2.258 0.688397
## whole.mean 1 160.948 454.27 100.105 < 2.2e-16 ***
## alive 1 67.616 360.93 6.773 0.009253 **
## duration 1 63.907 357.22 3.064 0.080034 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1brood4 <- glm.nb(brood_cells ~ treatment*whole.mean + alive + duration, data = brood)
anova(brood1, brood4, test = "Chisq")## Likelihood ratio tests of Negative Binomial Models
##
## Response: brood_cells
## Model theta Resid. df 2 x log-lik.
## 1 treatment + whole.mean + alive + duration 17.62812 37 -340.1606
## 2 treatment * whole.mean + alive + duration 19.92861 33 -333.6440
## Test df LR stat. Pr(Chi)
## 1
## 2 1 vs 2 4 6.516653 0.1637441drop1(brood1, test = "Chisq")## Single term deletions
##
## Model:
## brood_cells ~ treatment + whole.mean + alive + duration
## Df Deviance AIC LRT Pr(>Chi)
## <none> 60.842 356.16
## treatment 4 63.101 350.42 2.258 0.688397
## whole.mean 1 160.948 454.27 100.105 < 2.2e-16 ***
## alive 1 67.616 360.93 6.773 0.009253 **
## duration 1 63.907 357.22 3.064 0.080034 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1brood3 <- update(brood1, .~. -duration)
anova(brood1, brood3, test = "Chisq")## Likelihood ratio tests of Negative Binomial Models
##
## Response: brood_cells
## Model theta Resid. df 2 x log-lik.
## 1 treatment + whole.mean + alive 16.00719 38 -343.1629
## 2 treatment + whole.mean + alive + duration 17.62812 37 -340.1606
## Test df LR stat. Pr(Chi)
## 1
## 2 1 vs 2 1 3.002336 0.08314454AIC(brood1, brood3)## df AIC
## brood1 9 358.1606
## brood3 8 359.1629plot(brood3)
brood3##
## Call: glm.nb(formula = brood_cells ~ treatment + whole.mean + alive,
## data = brood, init.theta = 16.00718545, link = log)
##
## Coefficients:
## (Intercept) treatment2 treatment3 treatment4 treatment5 whole.mean
## 1.75174 0.04015 0.06645 -0.04033 -0.12599 2.67494
## alive
## 0.10534
##
## Degrees of Freedom: 44 Total (i.e. Null); 38 Residual
## Null Deviance: 195.5
## Residual Deviance: 61.09 AIC: 359.2ab <- setDT(as.data.frame(Anova(brood3)))
ab## LR Chisq Df Pr(>Chisq)
## 1: 2.091982 4 7.188455e-01
## 2: 92.661567 1 6.204688e-22
## 3: 8.357010 1 3.842023e-03emb1 <- emmeans(brood3, "treatment", type = "response")
emb <- setDT(as.data.frame(emb1))
emb## treatment response SE df asymp.LCL asymp.UCL
## 1: 1 32.14020 3.432741 Inf 26.06968 39.62427
## 2: 2 33.45700 3.386669 Inf 27.43624 40.79900
## 3: 3 34.34845 3.502438 Inf 28.12626 41.94714
## 4: 4 30.86983 3.225520 Inf 25.15325 37.88562
## 5: 5 28.33545 3.070770 Inf 22.91309 35.04100pemb <- pairs(emb1)
pemb <- setDT(as.data.frame(pemb))
pemb## contrast ratio SE df null z.ratio p.value
## 1: treatment1 / treatment2 0.9606418 0.1418075 Inf 1 -0.2720116 0.9988017
## 2: treatment1 / treatment3 0.9357102 0.1393322 Inf 1 -0.4462529 0.9918070
## 3: treatment1 / treatment4 1.0411524 0.1549990 Inf 1 0.2708909 0.9988210
## 4: treatment1 / treatment5 1.1342752 0.1747998 Inf 1 0.8175732 0.9253307
## 5: treatment2 / treatment3 0.9740470 0.1383405 Inf 1 -0.1851468 0.9997380
## 6: treatment2 / treatment4 1.0838092 0.1567959 Inf 1 0.5563091 0.9811878
## 7: treatment2 / treatment5 1.1807472 0.1745650 Inf 1 1.1238118 0.7940119
## 8: treatment3 / treatment4 1.1126868 0.1605357 Inf 1 0.7400852 0.9470905
## 9: treatment3 / treatment5 1.2122077 0.1788611 Inf 1 1.3042588 0.6885789
## 10: treatment4 / treatment5 1.0894420 0.1648596 Inf 1 0.5661043 0.9799283brood_sum <- brood %>%
group_by(treatment) %>%
summarise(mb = mean(brood_cells),
nb = length(brood_cells),
sdb = sd(brood_cells)) %>%
mutate(seb = (sdb/sqrt(nb)))
brood_sum## # A tibble: 5 × 5
## treatment mb nb sdb seb
## <fct> <dbl> <int> <dbl> <dbl>
## 1 1 33.8 9 22.6 7.53
## 2 2 36.9 9 11.2 3.74
## 3 3 45.6 9 26.2 8.73
## 4 4 36.7 9 18.3 6.09
## 5 5 29.6 9 17.5 5.82plot(brood$treatment, brood$brood_cells)
ggplot(brood, aes(x = treatment, y = brood_cells, fill = treatment)) +
geom_boxplot(alpha = 0.8, width = 0.5, outlier.shape = NA) +
scale_fill_viridis_d() +
labs(x = "Treatment", y = "Mean Count of Brood Cells", title = "Count of Brood Cells by Treatment") +
theme_minimal() +
theme(legend.position = "right")
Eggs
e1 <- glm.nb(eggs ~ treatment + whole.mean + alive + duration, data = brood)
e2 <- glm.nb(eggs ~ treatment*whole.mean + alive + duration, data = brood)## Warning: glm.fit: algorithm did not converge
## Warning: glm.fit: algorithm did not converge## Warning in glm.nb(eggs ~ treatment * whole.mean + alive + duration, data =
## brood): alternation limit reachede3 <- glm(eggs~treatment + whole.mean + alive + duration, data = brood, family = "poisson") #overdispersed
summary(e3)##
## Call:
## glm(formula = eggs ~ treatment + whole.mean + alive + duration,
## family = "poisson", data = brood)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -6.095 -2.252 -1.018 1.133 8.262
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.764050 0.373664 4.721 2.35e-06 ***
## treatment2 -0.299283 0.149547 -2.001 0.045364 *
## treatment3 -1.048886 0.185284 -5.661 1.51e-08 ***
## treatment4 -0.796041 0.162890 -4.887 1.02e-06 ***
## treatment5 -0.752003 0.196271 -3.831 0.000127 ***
## whole.mean 4.388473 0.342779 12.803 < 2e-16 ***
## alive -0.225315 0.038493 -5.853 4.82e-09 ***
## duration -0.014649 0.008155 -1.796 0.072442 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 624.61 on 44 degrees of freedom
## Residual deviance: 368.51 on 37 degrees of freedom
## AIC: 504.9
##
## Number of Fisher Scoring iterations: 6anova(e1, e2, test = "Chisq") ## Likelihood ratio tests of Negative Binomial Models
##
## Response: eggs
## Model theta Resid. df 2 x log-lik.
## 1 treatment + whole.mean + alive + duration 0.7292315 37 -253.9705
## 2 treatment * whole.mean + alive + duration 0.7932064 33 -250.9366
## Test df LR stat. Pr(Chi)
## 1
## 2 1 vs 2 4 3.033941 0.5521617drop1(e1, test = "Chisq")## Single term deletions
##
## Model:
## eggs ~ treatment + whole.mean + alive + duration
## Df Deviance AIC LRT Pr(>Chi)
## <none> 51.448 269.97
## treatment 4 55.882 266.40 4.4338 0.3504687
## whole.mean 1 66.106 282.63 14.6580 0.0001289 ***
## alive 1 53.094 269.62 1.6456 0.1995527
## duration 1 51.808 268.33 0.3596 0.5487513
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1e4 <- update(e1, .~. -duration)
drop1(e4, test = "Chisq")## Single term deletions
##
## Model:
## eggs ~ treatment + whole.mean + alive
## Df Deviance AIC LRT Pr(>Chi)
## <none> 51.604 268.33
## treatment 4 56.165 264.89 4.5608 0.335403
## whole.mean 1 66.666 281.39 15.0620 0.000104 ***
## alive 1 53.201 267.93 1.5976 0.206251
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1e5 <- update(e4, .~. -alive)
anova(e4, e5, test = "Chisq") ## Likelihood ratio tests of Negative Binomial Models
##
## Response: eggs
## Model theta Resid. df 2 x log-lik. Test
## 1 treatment + whole.mean 0.6823306 39 -255.8782
## 2 treatment + whole.mean + alive 0.7248174 38 -254.3296 1 vs 2
## df LR stat. Pr(Chi)
## 1
## 2 1 1.548579 0.2133453ea <- setDT(as.data.frame(Anova(e5)))
ea## LR Chisq Df Pr(>Chisq)
## 1: 5.870448 4 0.2090344820
## 2: 12.855832 1 0.0003364292em <- emmeans(e5, pairwise ~ "treatment", type = "response")
emc <- setDT(as.data.frame(em$contrasts))
emc## contrast ratio SE df null z.ratio p.value
## 1: treatment1 / treatment2 1.0564628 0.6293440 Inf 1 0.09220335 0.9999837
## 2: treatment1 / treatment3 2.9193133 1.8022509 Inf 1 1.73538636 0.4120943
## 3: treatment1 / treatment4 2.3612037 1.4447818 Inf 1 1.40414209 0.6249783
## 4: treatment1 / treatment5 2.5687099 1.5813938 Inf 1 1.53240180 0.5412580
## 5: treatment2 / treatment3 2.7632902 1.6832962 Inf 1 1.66855321 0.4535609
## 6: treatment2 / treatment4 2.2350089 1.3529025 Inf 1 1.32862139 0.6733046
## 7: treatment2 / treatment5 2.4314249 1.4949586 Inf 1 1.44503415 0.5983903
## 8: treatment3 / treatment4 0.8088216 0.5033189 Inf 1 -0.34096329 0.9970990
## 9: treatment3 / treatment5 0.8799021 0.5601836 Inf 1 -0.20096757 0.9996373
## 10: treatment4 / treatment5 1.0878816 0.6863491 Inf 1 0.13351039 0.9999286emm <- setDT(as.data.frame(em$emmeans))
emm## treatment response SE df asymp.LCL asymp.UCL
## 1: 1 10.439527 4.415846 Inf 4.556471 23.918451
## 2: 2 9.881585 4.132733 Inf 4.353437 22.429573
## 3: 3 3.576021 1.596816 Inf 1.490423 8.580068
## 4: 4 4.421273 1.945498 Inf 1.866346 10.473758
## 5: 5 4.064113 1.824338 Inf 1.686049 9.796283e5##
## Call: glm.nb(formula = eggs ~ treatment + whole.mean, data = brood,
## init.theta = 0.6823306007, link = log)
##
## Coefficients:
## (Intercept) treatment2 treatment3 treatment4 treatment5 whole.mean
## 0.36435 -0.05493 -1.07135 -0.85917 -0.94340 4.12331
##
## Degrees of Freedom: 44 Total (i.e. Null); 39 Residual
## Null Deviance: 69.33
## Residual Deviance: 51.11 AIC: 269.9ggplot(brood, aes(x = treatment, y = eggs, fill = treatment)) +
geom_boxplot(alpha = 0.8, width = 0.5, outlier.shape = NA) +
scale_fill_viridis_d() +
labs(x = "Treatment", y = "Mean Count of Eggs", title = "Count of Eggs by Treatment") +
theme_minimal() +
theme(legend.position = "right")
range(brood$eggs)## [1] 0 87brood.sub <- brood[brood$eggs <= 50, ]
range(brood.sub$eggs)## [1] 0 36ggplot(brood.sub, aes(x = treatment, y = eggs, fill = treatment)) +
geom_boxplot(alpha = 0.8, width = 0.5, outlier.shape = NA) +
scale_fill_viridis_d() +
labs(x = "Treatment", y = "Mean Count of Eggs", title = "Count of Eggs by Treatment") +
theme_minimal() +
theme(legend.position = "right")
egg_sum1 <- brood %>%
group_by(treatment) %>%
summarise(me = mean(eggs),
sde = sd(eggs),
ne = length(eggs)) %>%
mutate(see = sde/sqrt(ne))
egg_sum1## # A tibble: 5 × 5
## treatment me sde ne see
## <fct> <dbl> <dbl> <int> <dbl>
## 1 1 14.8 27.7 9 9.22
## 2 2 9.11 11.7 9 3.91
## 3 3 5.56 6.56 9 2.19
## 4 4 6.56 5.90 9 1.97
## 5 5 4.33 4.39 9 1.46ggplot(egg_sum1, aes(x = treatment, y = me)) +
geom_bar(stat = "identity", fill = "steelblue", color = "black") +
geom_errorbar(aes(ymin = me - see, ymax = me + see), width = 0.2, position = position_dodge(0.9)) +
labs(x = "Treatment", y = "Eggs", title = "Average Egg Count by Treatment (with the outlier of 87 eggs in T1.5)") +
theme_minimal()
egg_sum <- brood.sub %>%
group_by(treatment) %>%
summarise(me = mean(eggs),
sde = sd(eggs),
ne = length(eggs)) %>%
mutate(see = sde/sqrt(ne))
egg_sum## # A tibble: 5 × 5
## treatment me sde ne see
## <fct> <dbl> <dbl> <int> <dbl>
## 1 1 5.75 6.04 8 2.14
## 2 2 9.11 11.7 9 3.91
## 3 3 5.56 6.56 9 2.19
## 4 4 6.56 5.90 9 1.97
## 5 5 4.33 4.39 9 1.46ggplot(egg_sum, aes(x = treatment, y = me)) +
geom_bar(stat = "identity", fill = "steelblue", color = "black") +
geom_errorbar(aes(ymin = me - see, ymax = me + see), width = 0.2, position = position_dodge(0.9)) +
labs(x = "Treatment", y = "Eggs", title = "Average Egg Count by Treatment (without the outlier of 87 eggs in T1.5)") +
theme_minimal()
Honey Pots
hp1 <- glm.nb(honey_pot ~ treatment + whole.mean + duration + alive, data = brood)
hp2 <- glm.nb(honey_pot ~ treatment *whole.mean + duration + alive, data=brood)
hp3 <- glm(honey_pot ~ treatment + whole.mean + alive +duration, data = brood, family = "poisson")
summary(hp3)##
## Call:
## glm(formula = honey_pot ~ treatment + whole.mean + alive + duration,
## family = "poisson", data = brood)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.52238 -1.12419 -0.02076 0.65822 2.83439
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.145325 0.471850 0.308 0.758090
## treatment2 0.478946 0.210398 2.276 0.022823 *
## treatment3 0.037830 0.223887 0.169 0.865823
## treatment4 0.364541 0.207988 1.753 0.079653 .
## treatment5 0.297022 0.219971 1.350 0.176927
## whole.mean 1.290798 0.377435 3.420 0.000626 ***
## alive 0.143422 0.057371 2.500 0.012422 *
## duration 0.003405 0.009452 0.360 0.718653
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 112.507 on 44 degrees of freedom
## Residual deviance: 70.703 on 37 degrees of freedom
## AIC: 238.91
##
## Number of Fisher Scoring iterations: 5anova(hp1, hp2, test ="Chisq")## Likelihood ratio tests of Negative Binomial Models
##
## Response: honey_pot
## Model theta Resid. df 2 x log-lik.
## 1 treatment + whole.mean + duration + alive 17.52117 37 -221.3263
## 2 treatment * whole.mean + duration + alive 21.06266 33 -219.3671
## Test df LR stat. Pr(Chi)
## 1
## 2 1 vs 2 4 1.959172 0.7432683plot(hp3)
plot(hp1)
AIC(hp1, hp3)## df AIC
## hp1 9 239.3263
## hp3 8 238.9125drop1(hp1, test = "Chisq")## Single term deletions
##
## Model:
## honey_pot ~ treatment + whole.mean + duration + alive
## Df Deviance AIC LRT Pr(>Chi)
## <none> 55.953 237.33
## treatment 4 62.583 235.96 6.6303 0.156763
## whole.mean 1 64.678 244.05 8.7248 0.003139 **
## duration 1 55.975 235.35 0.0214 0.883560
## alive 1 61.406 240.78 5.4529 0.019536 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1drop1(hp3, test = "Chisq")## Single term deletions
##
## Model:
## honey_pot ~ treatment + whole.mean + alive + duration
## Df Deviance AIC LRT Pr(>Chi)
## <none> 70.703 238.91
## treatment 4 79.851 240.06 9.1482 0.0575007 .
## whole.mean 1 82.311 248.52 11.6079 0.0006567 ***
## alive 1 77.636 243.85 6.9338 0.0084584 **
## duration 1 70.833 237.04 0.1305 0.7178812
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1hp4 <- update(hp3, .~. -duration)
drop1(hp4, test = "Chisq")## Single term deletions
##
## Model:
## honey_pot ~ treatment + whole.mean + alive
## Df Deviance AIC LRT Pr(>Chi)
## <none> 70.833 237.04
## treatment 4 80.497 238.71 9.6635 0.0464935 *
## whole.mean 1 84.118 248.33 13.2844 0.0002676 ***
## alive 1 77.688 241.90 6.8547 0.0088408 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Anova(hp4)## Analysis of Deviance Table (Type II tests)
##
## Response: honey_pot
## LR Chisq Df Pr(>Chisq)
## treatment 9.6635 4 0.0464935 *
## whole.mean 13.2844 1 0.0002676 ***
## alive 6.8547 1 0.0088408 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1ha <- setDT(as.data.frame(Anova(hp4)))
ha## LR Chisq Df Pr(>Chisq)
## 1: 9.663523 4 0.0464935193
## 2: 13.284449 1 0.0002676167
## 3: 6.854713 1 0.0088407739hp4##
## Call: glm(formula = honey_pot ~ treatment + whole.mean + alive, family = "poisson",
## data = brood)
##
## Coefficients:
## (Intercept) treatment2 treatment3 treatment4 treatment5 whole.mean
## 0.27744 0.49895 0.05398 0.37111 0.31416 1.33003
## alive
## 0.13938
##
## Degrees of Freedom: 44 Total (i.e. Null); 38 Residual
## Null Deviance: 112.5
## Residual Deviance: 70.83 AIC: 237ggplot(brood, aes(x = treatment, y = honey_pot, fill = treatment)) +
geom_boxplot(alpha = 0.8, width = 0.5, outlier.shape = NA) +
scale_fill_viridis_d() +
labs(x = "Treatment", y = "Mean Count of Honey Pots", title = "Count of Honey Pots by Treatment") +
theme_minimal() +
theme(legend.position = "right")
hp_sum <- brood %>%
group_by(treatment) %>%
summarise(mhp = mean(honey_pot),
sdhp = sd(honey_pot),
nhp = length(honey_pot)) %>%
mutate(sehp = sdhp/sqrt(nhp))
hp.means <- emmeans(object = hp4,
specs = "treatment",
adjust = "Tukey",
type = "response")
hpem <- setDT(as.data.frame(hp.means))
hpem## treatment rate SE df asymp.LCL asymp.UCL
## 1: 1 4.435043 0.7228102 Inf 2.917969 6.740855
## 2: 2 7.304510 0.8826030 Inf 5.355417 9.962971
## 3: 3 4.681045 0.6894722 Inf 3.206461 6.833761
## 4: 4 6.427907 0.8382044 Inf 4.598270 8.985551
## 5: 5 6.072032 0.8349689 Inf 4.265080 8.644519hpa <- setDT(as.data.frame(pairs(hp.means)))
hpa## contrast ratio SE df null z.ratio p.value
## 1: treatment1 / treatment2 0.6071651 0.1232310 Inf 1 -2.4583742 0.1002765
## 2: treatment1 / treatment3 0.9474472 0.2074110 Inf 1 -0.2465978 0.9991856
## 3: treatment1 / treatment4 0.6899669 0.1429589 Inf 1 -1.7911079 0.3786974
## 4: treatment1 / treatment5 0.7304051 0.1569572 Inf 1 -1.4619346 0.5873534
## 5: treatment2 / treatment3 1.5604442 0.2898881 Inf 1 2.3952402 0.1165246
## 6: treatment2 / treatment4 1.1363745 0.1982245 Inf 1 0.7328936 0.9488752
## 7: treatment2 / treatment5 1.2029762 0.2165561 Inf 1 1.0265628 0.8431815
## 8: treatment3 / treatment4 0.7282379 0.1384305 Inf 1 -1.6683054 0.4537171
## 9: treatment3 / treatment5 0.7709191 0.1526869 Inf 1 -1.3136129 0.6827362
## 10: treatment4 / treatment5 1.0586089 0.1996727 Inf 1 0.3019633 0.9981946hp.cld.model <- cld(object = hp.means,
adjust = "Tukey",
Letters = letters,
alpha = 0.05)
hp.cld.model## treatment rate SE df asymp.LCL asymp.UCL .group
## 1 4.44 0.723 Inf 2.92 6.74 a
## 3 4.68 0.689 Inf 3.21 6.83 a
## 5 6.07 0.835 Inf 4.27 8.64 a
## 4 6.43 0.838 Inf 4.60 8.99 a
## 2 7.30 0.883 Inf 5.36 9.96 a
##
## Confidence level used: 0.95
## Conf-level adjustment: sidak method for 5 estimates
## Intervals are back-transformed from the log scale
## P value adjustment: tukey method for comparing a family of 5 estimates
## Tests are performed on the log scale
## significance level used: alpha = 0.05
## NOTE: If two or more means share the same grouping symbol,
## then we cannot show them to be different.
## But we also did not show them to be the same.ggplot(hp_sum, aes(x = treatment, y = mhp)) +
geom_bar(stat = "identity", fill = "steelblue", color = "black") +
geom_errorbar(aes(ymin = mhp - sehp, ymax = mhp + sehp), width = 0.2, position = position_dodge(0.9)) +
labs(x = "Treatment", y = "Honey Pot Count", title = "Average Honey Pots by Treatment") +
theme_minimal()
Larvae and Pupae
brood$larvae <- brood$dead_larvae + brood$live_larvae
brood$pupae <- brood$dead_lp + brood$live_pupae
#total count of larvae
bl1 <- glm.nb(larvae ~ treatment + whole.mean + alive + duration, data = brood)
bl2 <- glm.nb(larvae ~ treatment*whole.mean + alive + duration, data = brood)
bl3 <- glm(larvae ~ treatment + whole.mean + alive + duration, data = brood, family = "poisson") #overdispersed
anova(bl1, bl2, test = "Chisq")## Likelihood ratio tests of Negative Binomial Models
##
## Response: larvae
## Model theta Resid. df 2 x log-lik.
## 1 treatment + whole.mean + alive + duration 2.588945 37 -345.5865
## 2 treatment * whole.mean + alive + duration 2.787855 33 -341.8088
## Test df LR stat. Pr(Chi)
## 1
## 2 1 vs 2 4 3.777742 0.4369199AIC(bl1, bl2)## df AIC
## bl1 9 363.5865
## bl2 13 367.8088summary(bl3)##
## Call:
## glm(formula = larvae ~ treatment + whole.mean + alive + duration,
## family = "poisson", data = brood)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -4.9218 -1.8310 -0.8381 1.5146 4.6269
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.090716 0.187590 11.145 < 2e-16 ***
## treatment2 -0.472721 0.106226 -4.450 8.58e-06 ***
## treatment3 0.068889 0.090806 0.759 0.44807
## treatment4 -0.274272 0.094912 -2.890 0.00386 **
## treatment5 -0.230769 0.107318 -2.150 0.03153 *
## whole.mean 3.533988 0.186434 18.956 < 2e-16 ***
## alive -0.060460 0.026657 -2.268 0.02332 *
## duration -0.008486 0.003807 -2.229 0.02580 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 837.19 on 44 degrees of freedom
## Residual deviance: 305.80 on 37 degrees of freedom
## AIC: 521.79
##
## Number of Fisher Scoring iterations: 5drop1(bl1, test = "Chisq")## Single term deletions
##
## Model:
## larvae ~ treatment + whole.mean + alive + duration
## Df Deviance AIC LRT Pr(>Chi)
## <none> 53.540 361.59
## treatment 4 58.458 358.50 4.917 0.2959
## whole.mean 1 96.178 402.22 42.637 6.589e-11 ***
## alive 1 53.682 359.73 0.142 0.7065
## duration 1 53.923 359.97 0.383 0.5361
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1bl4 <- update(bl1, .~. -alive)
drop1(bl4, test = "Chisq")## Single term deletions
##
## Model:
## larvae ~ treatment + whole.mean + duration
## Df Deviance AIC LRT Pr(>Chi)
## <none> 53.746 359.73
## treatment 4 58.863 356.85 5.117 0.2755
## whole.mean 1 99.623 403.61 45.877 1.259e-11 ***
## duration 1 54.170 358.15 0.424 0.5150
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1bl5 <- update(bl4, .~. -duration)
Anova(bl5)## Analysis of Deviance Table (Type II tests)
##
## Response: larvae
## LR Chisq Df Pr(>Chisq)
## treatment 5.626 4 0.2289
## whole.mean 46.193 1 1.072e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#total count of pupae
bp1 <- glm.nb(pupae ~ treatment + whole.mean + alive + duration, data = brood)
bp2 <- glm.nb(pupae ~ treatment*whole.mean + alive + duration, data = brood)
bp3 <- glm(pupae ~ treatment + whole.mean + alive + duration, data = brood, family = "poisson") #overdispersed
anova(bp1, bp2, test = "Chisq")## Likelihood ratio tests of Negative Binomial Models
##
## Response: pupae
## Model theta Resid. df 2 x log-lik.
## 1 treatment + whole.mean + alive + duration 4.064932 37 -279.6872
## 2 treatment * whole.mean + alive + duration 4.161739 33 -279.3694
## Test df LR stat. Pr(Chi)
## 1
## 2 1 vs 2 4 0.3178062 0.9886359AIC(bp1, bp2)## df AIC
## bp1 9 297.6872
## bp2 13 305.3694summary(bp3)##
## Call:
## glm(formula = pupae ~ treatment + whole.mean + alive + duration,
## family = "poisson", data = brood)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.5640 -1.8131 -0.1462 0.7426 5.9416
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.434566 0.290731 1.495 0.134984
## treatment2 0.657406 0.145874 4.507 6.59e-06 ***
## treatment3 0.504844 0.144959 3.483 0.000496 ***
## treatment4 0.185211 0.150917 1.227 0.219733
## treatment5 0.102260 0.169424 0.604 0.546127
## whole.mean 3.572494 0.265062 13.478 < 2e-16 ***
## alive 0.067052 0.043195 1.552 0.120585
## duration -0.009980 0.005221 -1.911 0.055953 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 468.91 on 44 degrees of freedom
## Residual deviance: 169.82 on 37 degrees of freedom
## AIC: 361.56
##
## Number of Fisher Scoring iterations: 5drop1(bp1, test = "Chisq")## Single term deletions
##
## Model:
## pupae ~ treatment + whole.mean + alive + duration
## Df Deviance AIC LRT Pr(>Chi)
## <none> 48.307 295.69
## treatment 4 56.270 295.65 7.963 0.09294 .
## whole.mean 1 92.344 337.72 44.037 3.222e-11 ***
## alive 1 49.815 295.20 1.508 0.21937
## duration 1 49.827 295.21 1.520 0.21755
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1bp4 <- update(bp1, .~. -alive)
drop1(bp4, test = "Chisq")## Single term deletions
##
## Model:
## pupae ~ treatment + whole.mean + duration
## Df Deviance AIC LRT Pr(>Chi)
## <none> 49.259 295.19
## treatment 4 58.069 296.00 8.809 0.06605 .
## whole.mean 1 102.744 346.68 53.485 2.606e-13 ***
## duration 1 51.363 295.30 2.103 0.14698
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1bp5 <- update(bp4, .~. -duration)
Anova(bp5)## Analysis of Deviance Table (Type II tests)
##
## Response: pupae
## LR Chisq Df Pr(>Chisq)
## treatment 7.672 4 0.1043
## whole.mean 50.517 1 1.181e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#total count of dead larvae
bdl1 <- glm.nb(dead_larvae ~ treatment + whole.mean + alive + duration, data = brood)## Warning in glm.nb(dead_larvae ~ treatment + whole.mean + alive + duration, :
## alternation limit reachedbdl2 <- glm.nb(dead_larvae ~ treatment*whole.mean + alive + duration, data = brood)
bdl3 <- glm(dead_larvae ~ treatment + whole.mean + alive + duration, data = brood, family = "poisson") #overdispersed
summary(bdl3)##
## Call:
## glm(formula = dead_larvae ~ treatment + whole.mean + alive +
## duration, family = "poisson", data = brood)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -4.0954 -1.5847 -0.5209 0.0452 5.0466
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.659014 0.577473 -2.873 0.004067 **
## treatment2 0.637143 0.322161 1.978 0.047961 *
## treatment3 0.821695 0.301933 2.721 0.006500 **
## treatment4 1.077060 0.289434 3.721 0.000198 ***
## treatment5 0.071101 0.380328 0.187 0.851702
## whole.mean 4.609979 0.524910 8.782 < 2e-16 ***
## alive 0.064763 0.092381 0.701 0.483274
## duration -0.012268 0.009859 -1.244 0.213348
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 359.50 on 44 degrees of freedom
## Residual deviance: 191.85 on 37 degrees of freedom
## AIC: 300.82
##
## Number of Fisher Scoring iterations: 6anova(bdl1, bdl2, test = "Chisq")## Likelihood ratio tests of Negative Binomial Models
##
## Response: dead_larvae
## Model theta Resid. df 2 x log-lik.
## 1 treatment + whole.mean + alive + duration 0.8197864 37 -194.3271
## 2 treatment * whole.mean + alive + duration 0.8889151 33 -192.1742
## Test df LR stat. Pr(Chi)
## 1
## 2 1 vs 2 4 2.152917 0.7076577AIC(bdl1, bdl2)## df AIC
## bdl1 9 212.3271
## bdl2 13 218.1742drop1(bdl1, test = "Chisq")## Warning: glm.fit: algorithm did not converge## Single term deletions
##
## Model:
## dead_larvae ~ treatment + whole.mean + alive + duration
## Df Deviance AIC LRT Pr(>Chi)
## <none> 47.274 210.33
## treatment 4 50.336 205.39 3.0620 0.547508
## whole.mean 1 56.138 217.19 8.8636 0.002909 **
## alive 1 48.077 209.13 0.8031 0.370161
## duration 1 47.975 209.03 0.7011 0.402429
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1bdl4 <- update(bdl1, .~. -duration)
drop1(bdl4, test = "Chisq")## Single term deletions
##
## Model:
## dead_larvae ~ treatment + whole.mean + alive
## Df Deviance AIC LRT Pr(>Chi)
## <none> 47.457 209.03
## treatment 4 50.386 203.95 2.9286 0.569840
## whole.mean 1 55.699 215.27 8.2418 0.004094 **
## alive 1 48.684 208.25 1.2264 0.268115
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1bdl5 <- update(bdl4, .~. -alive)
Anova(bdl5)## Analysis of Deviance Table (Type II tests)
##
## Response: dead_larvae
## LR Chisq Df Pr(>Chisq)
## treatment 3.0291 4 0.55297
## whole.mean 10.3713 1 0.00128 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#total count of dead pupae
bdp1 <- glm.nb(dead_pupae ~ treatment + whole.mean + alive + duration, data = brood)
bdp2 <- glm.nb(dead_pupae ~ treatment*whole.mean + alive + duration, data = brood)
bdp3 <- glm(dead_pupae ~ treatment + whole.mean + alive + duration, data = brood, family = "poisson") #overdispersed
summary(bdp3)##
## Call:
## glm(formula = dead_pupae ~ treatment + whole.mean + alive + duration,
## family = "poisson", data = brood)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.3389 -1.5376 -0.5912 0.9029 7.1036
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.021996 0.621416 -3.254 0.00114 **
## treatment2 1.264408 0.270440 4.675 2.93e-06 ***
## treatment3 1.119921 0.266134 4.208 2.58e-05 ***
## treatment4 0.063814 0.309950 0.206 0.83688
## treatment5 0.604931 0.297199 2.035 0.04181 *
## whole.mean 3.182366 0.424094 7.504 6.19e-14 ***
## alive 0.369887 0.102795 3.598 0.00032 ***
## duration -0.011451 0.007632 -1.500 0.13354
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 309.89 on 44 degrees of freedom
## Residual deviance: 150.49 on 37 degrees of freedom
## AIC: 285
##
## Number of Fisher Scoring iterations: 6anova(bdp1, bdp2, test = "Chisq")## Likelihood ratio tests of Negative Binomial Models
##
## Response: dead_pupae
## Model theta Resid. df 2 x log-lik.
## 1 treatment + whole.mean + alive + duration 2.066457 37 -213.2572
## 2 treatment * whole.mean + alive + duration 2.219008 33 -210.6380
## Test df LR stat. Pr(Chi)
## 1
## 2 1 vs 2 4 2.619186 0.6234283AIC(bdp1, bdp2)## df AIC
## bdp1 9 231.2572
## bdp2 13 236.6380drop1(bdp1, test = "Chisq")## Single term deletions
##
## Model:
## dead_pupae ~ treatment + whole.mean + alive + duration
## Df Deviance AIC LRT Pr(>Chi)
## <none> 50.576 229.26
## treatment 4 62.993 233.67 12.4172 0.014504 *
## whole.mean 1 64.543 241.22 13.9677 0.000186 ***
## alive 1 54.930 231.61 4.3540 0.036923 *
## duration 1 51.348 228.03 0.7728 0.379362
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1bdp4 <- update(bdp1, .~. -duration)
drop1(bdp4, test = "Chisq")## Single term deletions
##
## Model:
## dead_pupae ~ treatment + whole.mean + alive
## Df Deviance AIC LRT Pr(>Chi)
## <none> 50.546 228.02
## treatment 4 62.070 231.55 11.5240 0.021265 *
## whole.mean 1 63.610 239.09 13.0642 0.000301 ***
## alive 1 55.461 230.94 4.9155 0.026617 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Anova(bdp4)## Analysis of Deviance Table (Type II tests)
##
## Response: dead_pupae
## LR Chisq Df Pr(>Chisq)
## treatment 11.5240 4 0.021265 *
## whole.mean 13.0642 1 0.000301 ***
## alive 4.9155 1 0.026617 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1bdp4##
## Call: glm.nb(formula = dead_pupae ~ treatment + whole.mean + alive,
## data = brood, init.theta = 2.002606201, link = log)
##
## Coefficients:
## (Intercept) treatment2 treatment3 treatment4 treatment5 whole.mean
## -1.8440 1.0432 1.0534 0.0184 0.4272 2.9125
## alive
## 0.2805
##
## Degrees of Freedom: 44 Total (i.e. Null); 38 Residual
## Null Deviance: 95.48
## Residual Deviance: 50.55 AIC: 230bdpa <- setDT(as.data.frame(Anova(bdp4)))
bdpa## LR Chisq Df Pr(>Chisq)
## 1: 11.524044 4 0.0212648485
## 2: 13.064226 1 0.0003009895
## 3: 4.915506 1 0.0266166717dpe <- emmeans(bdp4, pairwise ~ treatment, type = "response")
pairs(dpe)## contrast ratio SE df null z.ratio p.value
## treatment1 / treatment2 0.352 0.158 Inf 1 -2.330 0.1354
## treatment1 / treatment3 0.349 0.156 Inf 1 -2.350 0.1294
## treatment1 / treatment4 0.982 0.476 Inf 1 -0.038 1.0000
## treatment1 / treatment5 0.652 0.311 Inf 1 -0.896 0.8985
## treatment2 / treatment3 0.990 0.380 Inf 1 -0.026 1.0000
## treatment2 / treatment4 2.787 1.200 Inf 1 2.380 0.1207
## treatment2 / treatment5 1.852 0.766 Inf 1 1.488 0.5702
## treatment3 / treatment4 2.815 1.200 Inf 1 2.428 0.1079
## treatment3 / treatment5 1.870 0.769 Inf 1 1.523 0.5474
## treatment4 / treatment5 0.664 0.306 Inf 1 -0.888 0.9013
##
## P value adjustment: tukey method for comparing a family of 5 estimates
## Tests are performed on the log scaledpem <- setDT(as.data.frame(dpe$emmeans))
dpcm <- setDT(as.data.frame(dpe$contrasts))
dpem## treatment response SE df asymp.LCL asymp.UCL
## 1: 1 2.030910 0.7166039 Inf 1.017058 4.055422
## 2: 2 5.764541 1.5964468 Inf 3.349892 9.919703
## 3: 3 5.823275 1.6273391 Inf 3.367405 10.070226
## 4: 4 2.068625 0.7010003 Inf 1.064714 4.019117
## 5: 5 3.113347 0.9872904 Inf 1.672239 5.796378dpcm## contrast ratio SE df null z.ratio p.value
## 1: treatment1 / treatment2 0.3523109 0.1577558 Inf 1 -2.32983700 0.1354231
## 2: treatment1 / treatment3 0.3487574 0.1563364 Inf 1 -2.34989208 0.1293974
## 3: treatment1 / treatment4 0.9817683 0.4761449 Inf 1 -0.03793897 0.9999995
## 4: treatment1 / treatment5 0.6523238 0.3110729 Inf 1 -0.89587354 0.8985394
## 5: treatment2 / treatment3 0.9899139 0.3797248 Inf 1 -0.02642723 0.9999999
## 6: treatment2 / treatment4 2.7866535 1.1999128 Inf 1 2.38007121 0.1207160
## 7: treatment2 / treatment5 1.8515574 0.7664285 Inf 1 1.48821394 0.5701633
## 8: treatment3 / treatment4 2.8150463 1.1999534 Inf 1 2.42802190 0.1078507
## 9: treatment3 / treatment5 1.8704227 0.7690272 Inf 1 1.52295297 0.5474333
## 10: treatment4 / treatment5 0.6644376 0.3057419 Inf 1 -0.88843419 0.9012937ggplot(brood, aes(x = treatment, y = dead_pupae, fill = treatment)) +
geom_boxplot(alpha = 0.8, width = 0.5) +
scale_fill_viridis_d() +
labs(x = "Treatment", y = "Mean Count", title = "Average Count of Dead Pupae by Treatment") +
theme_minimal() +
theme(legend.position = "right")
#One seemingly outlier in treatment 2
brood.sub1 <- brood[brood$dead_pupae <= 30, ]
bdp1 <- glm.nb(dead_pupae ~ treatment + whole.mean + alive + duration, data = brood.sub1)
bdp2 <- glm.nb(dead_pupae ~ treatment*whole.mean + alive + duration, data = brood.sub1)
bdp3 <- glm(dead_pupae ~ treatment + whole.mean + alive + duration, data = brood.sub1, family = "poisson") #not super overdispersed
summary(bdp3)##
## Call:
## glm(formula = dead_pupae ~ treatment + whole.mean + alive + duration,
## family = "poisson", data = brood.sub1)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.7891 -1.3438 -0.3136 0.8495 2.0770
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.462404 0.593075 -2.466 0.0137 *
## treatment2 0.655151 0.300808 2.178 0.0294 *
## treatment3 1.166392 0.267795 4.356 1.33e-05 ***
## treatment4 0.107611 0.310755 0.346 0.7291
## treatment5 0.682104 0.300063 2.273 0.0230 *
## whole.mean 3.326525 0.446502 7.450 9.32e-14 ***
## alive 0.242491 0.099210 2.444 0.0145 *
## duration -0.013630 0.007851 -1.736 0.0825 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 213.773 on 43 degrees of freedom
## Residual deviance: 81.387 on 36 degrees of freedom
## AIC: 210.39
##
## Number of Fisher Scoring iterations: 5anova(bdp1, bdp2, test = "Chisq")## Likelihood ratio tests of Negative Binomial Models
##
## Response: dead_pupae
## Model theta Resid. df 2 x log-lik.
## 1 treatment + whole.mean + alive + duration 5.926959 36 -189.7422
## 2 treatment * whole.mean + alive + duration 8.291785 32 -186.0895
## Test df LR stat. Pr(Chi)
## 1
## 2 1 vs 2 4 3.652643 0.4550512AIC(bdp1, bdp2)## df AIC
## bdp1 9 207.7422
## bdp2 13 212.0895drop1(bdp1, test = "Chisq")## Single term deletions
##
## Model:
## dead_pupae ~ treatment + whole.mean + alive + duration
## Df Deviance AIC LRT Pr(>Chi)
## <none> 56.004 205.74
## treatment 4 73.311 215.05 17.3061 0.001685 **
## whole.mean 1 84.284 232.02 28.2800 1.05e-07 ***
## alive 1 60.270 208.01 4.2657 0.038889 *
## duration 1 57.574 205.31 1.5697 0.210246
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1bdp4 <- update(bdp1, .~. -duration)
drop1(bdp4, test = "Chisq")## Single term deletions
##
## Model:
## dead_pupae ~ treatment + whole.mean + alive
## Df Deviance AIC LRT Pr(>Chi)
## <none> 55.005 205.25
## treatment 4 70.181 212.43 15.1760 0.00435 **
## whole.mean 1 80.025 228.27 25.0203 5.673e-07 ***
## alive 1 59.974 208.22 4.9699 0.02579 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Anova(bdp4)## Analysis of Deviance Table (Type II tests)
##
## Response: dead_pupae
## LR Chisq Df Pr(>Chisq)
## treatment 15.1760 4 0.00435 **
## whole.mean 25.0203 1 5.673e-07 ***
## alive 4.9699 1 0.02579 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1bdp4##
## Call: glm.nb(formula = dead_pupae ~ treatment + whole.mean + alive,
## data = brood.sub1, init.theta = 5.039931301, link = log)
##
## Coefficients:
## (Intercept) treatment2 treatment3 treatment4 treatment5 whole.mean
## -1.73702 0.47985 1.09069 0.04813 0.51340 3.00272
## alive
## 0.23523
##
## Degrees of Freedom: 43 Total (i.e. Null); 37 Residual
## Null Deviance: 121.2
## Residual Deviance: 55 AIC: 207.2bdpa <- setDT(as.data.frame(Anova(bdp4)))
bdpa## LR Chisq Df Pr(>Chisq)
## 1: 15.176001 4 4.349760e-03
## 2: 25.020333 1 5.672891e-07
## 3: 4.969943 1 2.579150e-02dpe <- emmeans(bdp4, pairwise ~ treatment, type = "response")
pairs(dpe)## contrast ratio SE df null z.ratio p.value
## treatment1 / treatment2 0.619 0.237 Inf 1 -1.255 0.7190
## treatment1 / treatment3 0.336 0.119 Inf 1 -3.084 0.0174
## treatment1 / treatment4 0.953 0.375 Inf 1 -0.122 0.9999
## treatment1 / treatment5 0.598 0.230 Inf 1 -1.338 0.6671
## treatment2 / treatment3 0.543 0.171 Inf 1 -1.938 0.2971
## treatment2 / treatment4 1.540 0.558 Inf 1 1.192 0.7563
## treatment2 / treatment5 0.967 0.334 Inf 1 -0.097 1.0000
## treatment3 / treatment4 2.836 0.927 Inf 1 3.191 0.0124
## treatment3 / treatment5 1.781 0.554 Inf 1 1.857 0.3408
## treatment4 / treatment5 0.628 0.227 Inf 1 -1.286 0.6999
##
## P value adjustment: tukey method for comparing a family of 5 estimates
## Tests are performed on the log scaledpem <- setDT(as.data.frame(dpe$emmeans))
dpcm <- setDT(as.data.frame(dpe$contrasts))
dpem## treatment response SE df asymp.LCL asymp.UCL
## 1: 1 1.943916 0.5674115 Inf 1.097032 3.444574
## 2: 2 3.141033 0.7895118 Inf 1.919196 5.140739
## 3: 3 5.785723 1.2108228 Inf 3.839018 8.719571
## 4: 4 2.039770 0.5598873 Inf 1.191074 3.493202
## 5: 5 3.248220 0.8091564 Inf 1.993447 5.292809dpcm## contrast ratio SE df null z.ratio p.value
## 1: treatment1 / treatment2 0.6188780 0.2366682 Inf 1 -1.25478132 0.71896819
## 2: treatment1 / treatment3 0.3359850 0.1188210 Inf 1 -3.08409213 0.01743806
## 3: treatment1 / treatment4 0.9530076 0.3751979 Inf 1 -0.12225695 0.99994974
## 4: treatment1 / treatment5 0.5984558 0.2295596 Inf 1 -1.33842716 0.66710691
## 5: treatment2 / treatment3 0.5428937 0.1711178 Inf 1 -1.93797602 0.29711655
## 6: treatment2 / treatment4 1.5398958 0.5579098 Inf 1 1.19158282 0.75628398
## 7: treatment2 / treatment5 0.9670012 0.3340299 Inf 1 -0.09714167 0.99997991
## 8: treatment3 / treatment4 2.8364591 0.9267432 Inf 1 3.19092582 0.01235752
## 9: treatment3 / treatment5 1.7811981 0.5536727 Inf 1 1.85716422 0.34075741
## 10: treatment4 / treatment5 0.6279654 0.2272017 Inf 1 -1.28596551 0.69992019ggplot(brood.sub1, aes(x = treatment, y = dead_pupae, fill = treatment)) +
geom_boxplot(alpha = 0.8, width = 0.5) +
scale_fill_viridis_d() +
labs(x = "Treatment", y = "Mean Count", title = "Average Count of Dead Pupae by Treatment") +
theme_minimal() +
theme(legend.position = "right")
deadpupmeans <- emmeans(object = bdp4,
specs = "treatment",
adjust = "Tukey",
type = "response")
deadpup.cld.model <- cld(object = deadpupmeans,
adjust = "Tukey",
Letters = letters,
alpha = 0.05)
deadpup.cld.model## treatment response SE df asymp.LCL asymp.UCL .group
## 1 1.94 0.567 Inf 0.918 4.11 a
## 4 2.04 0.560 Inf 1.008 4.13 a
## 2 3.14 0.790 Inf 1.647 5.99 ab
## 5 3.25 0.809 Inf 1.713 6.16 ab
## 3 5.79 1.211 Inf 3.380 9.90 b
##
## Confidence level used: 0.95
## Conf-level adjustment: sidak method for 5 estimates
## Intervals are back-transformed from the log scale
## P value adjustment: tukey method for comparing a family of 5 estimates
## Tests are performed on the log scale
## significance level used: alpha = 0.05
## NOTE: If two or more means share the same grouping symbol,
## then we cannot show them to be different.
## But we also did not show them to be the same.deadpup.means <- as.data.frame(deadpupmeans)
dp_max <- brood.sub1 %>%
group_by(treatment) %>%
summarize(maxdp = max((dead_pupae)))
dpsum <- brood.sub1 %>%
group_by(treatment) %>%
summarise(mean = mean(dead_pupae),
sd = sd(dead_pupae),
n = length(dead_pupae)) %>%
mutate(se = sd/sqrt(n))
dpsum## # A tibble: 5 × 5
## treatment mean sd n se
## <fct> <dbl> <dbl> <int> <dbl>
## 1 1 2 2.06 9 0.687
## 2 2 4 3.55 8 1.25
## 3 3 8.89 7.27 9 2.42
## 4 4 2.89 3.02 9 1.01
## 5 5 3.89 4.28 9 1.43cbind larvae and pupae
mod1 <- glm(cbind(alive_lp, dead_lp) ~ treatment + whole.mean + alive + duration, data = brood, family = binomial("logit"))
summary(mod1)##
## Call:
## glm(formula = cbind(alive_lp, dead_lp) ~ treatment + whole.mean +
## alive + duration, family = binomial("logit"), data = brood)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -7.248 -1.848 0.000 2.262 3.960
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.574739 0.466531 7.662 1.83e-14 ***
## treatment2 -1.479230 0.227106 -6.513 7.35e-11 ***
## treatment3 -1.004472 0.217035 -4.628 3.69e-06 ***
## treatment4 -1.028709 0.232030 -4.434 9.27e-06 ***
## treatment5 -0.613336 0.253748 -2.417 0.0156 *
## whole.mean -0.649436 0.388068 -1.674 0.0942 .
## alive -0.323581 0.073540 -4.400 1.08e-05 ***
## duration 0.004658 0.007203 0.647 0.5178
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 411.27 on 42 degrees of freedom
## Residual deviance: 313.30 on 35 degrees of freedom
## AIC: 450.4
##
## Number of Fisher Scoring iterations: 4qqnorm(resid(mod1));qqline(resid(mod1))
Anova(mod1)## Analysis of Deviance Table (Type II tests)
##
## Response: cbind(alive_lp, dead_lp)
## LR Chisq Df Pr(>Chisq)
## treatment 52.729 4 9.709e-11 ***
## whole.mean 2.822 1 0.09296 .
## alive 23.566 1 1.207e-06 ***
## duration 0.416 1 0.51892
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1plot(mod1)
drop1(mod1, test = "Chisq")## Single term deletions
##
## Model:
## cbind(alive_lp, dead_lp) ~ treatment + whole.mean + alive + duration
## Df Deviance AIC LRT Pr(>Chi)
## <none> 313.30 450.40
## treatment 4 366.03 495.13 52.729 9.709e-11 ***
## whole.mean 1 316.12 451.22 2.822 0.09296 .
## alive 1 336.87 471.96 23.566 1.207e-06 ***
## duration 1 313.72 448.81 0.416 0.51892
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1mod2 <- update(mod1, .~. -duration)
drop1(mod2, test = "Chisq")## Single term deletions
##
## Model:
## cbind(alive_lp, dead_lp) ~ treatment + whole.mean + alive
## Df Deviance AIC LRT Pr(>Chi)
## <none> 313.72 448.81
## treatment 4 366.15 493.25 52.435 1.119e-10 ***
## whole.mean 1 316.13 449.22 2.408 0.1207
## alive 1 338.06 471.15 24.340 8.076e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1mod3 <- update(mod2, .~. -whole.mean)
drop1(mod3, test = "Chisq")## Single term deletions
##
## Model:
## cbind(alive_lp, dead_lp) ~ treatment + alive
## Df Deviance AIC LRT Pr(>Chi)
## <none> 316.13 449.22
## treatment 4 370.89 495.99 54.765 3.639e-11 ***
## alive 1 341.77 472.87 25.648 4.097e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Anova(mod3)## Analysis of Deviance Table (Type II tests)
##
## Response: cbind(alive_lp, dead_lp)
## LR Chisq Df Pr(>Chisq)
## treatment 54.765 4 3.639e-11 ***
## alive 25.648 1 4.097e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1me <- emmeans(mod3, pairwise~treatment, type = "response")
mem <- setDT(as.data.frame(me$emmeans))
mcm <- setDT(as.data.frame(me$contrasts))
mem## treatment prob SE df asymp.LCL asymp.UCL
## 1: 1 0.8863883 0.01847489 Inf 0.8448542 0.9178840
## 2: 2 0.6470471 0.02964379 Inf 0.5870243 0.7027633
## 3: 3 0.7380210 0.02130778 Inf 0.6941747 0.7775952
## 4: 4 0.7296369 0.02782540 Inf 0.6717960 0.7806132
## 5: 5 0.8185783 0.02531742 Inf 0.7636169 0.8630523mcm## contrast odds.ratio SE df null z.ratio
## 1: treatment1 / treatment2 4.2558041 0.95336848 Inf 1 6.4650887
## 2: treatment1 / treatment3 2.7694813 0.58926863 Inf 1 4.7875618
## 3: treatment1 / treatment4 2.8909550 0.66426146 Inf 1 4.6201688
## 4: treatment1 / treatment5 1.7291390 0.43036135 Inf 1 2.2002842
## 5: treatment2 / treatment3 0.6507539 0.10767039 Inf 1 -2.5966219
## 6: treatment2 / treatment4 0.6792970 0.12604642 Inf 1 -2.0840099
## 7: treatment2 / treatment5 0.4063014 0.08478525 Inf 1 -4.3160742
## 8: treatment3 / treatment4 1.0438616 0.17539392 Inf 1 0.2554804
## 9: treatment3 / treatment5 0.6243548 0.12060584 Inf 1 -2.4384714
## 10: treatment4 / treatment5 0.5981203 0.12459077 Inf 1 -2.4673730
## p.value
## 1: 1.012001e-09
## 2: 1.667451e-05
## 3: 3.771541e-05
## 4: 1.794902e-01
## 5: 7.094213e-02
## 6: 2.269222e-01
## 7: 1.545598e-04
## 8: 9.990637e-01
## 9: 1.051942e-01
## 10: 9.811326e-02alp <- setDT(as.data.frame(Anova(mod3)))
alp## LR Chisq Df Pr(>Chisq)
## 1: 54.76506 4 3.638899e-11
## 2: 25.64805 1 4.097093e-07mem$plot <- mem$prob + mem$SE
mod3##
## Call: glm(formula = cbind(alive_lp, dead_lp) ~ treatment + alive, family = binomial("logit"),
## data = brood)
##
## Coefficients:
## (Intercept) treatment2 treatment3 treatment4 treatment5 alive
## 3.4082 -1.4483 -1.0187 -1.0616 -0.5476 -0.3293
##
## Degrees of Freedom: 42 Total (i.e. Null); 37 Residual
## Null Deviance: 411.3
## Residual Deviance: 316.1 AIC: 449.2sum <- brood %>%
group_by(treatment) %>%
summarise(mean.l = mean(alive_lp),
mean.d = mean(dead_lp))
sum$prob.alive <- (sum$mean.l)/(sum$mean.d + sum$mean.l)
sum## # A tibble: 5 × 4
## treatment mean.l mean.d prob.alive
## <fct> <dbl> <dbl> <dbl>
## 1 1 31.4 3.78 0.893
## 2 2 19.3 11.1 0.635
## 3 3 35.3 14.7 0.707
## 4 4 20.6 9.56 0.683
## 5 5 19.3 5.44 0.780cldb <- cld(object = me,
adjust = "Tukey",
Letters = letters,
alpha = 0.05)
cldb## treatment prob SE df asymp.LCL asymp.UCL .group
## 2 0.647 0.0296 Inf 0.568 0.719 a
## 4 0.730 0.0278 Inf 0.653 0.795 ab
## 3 0.738 0.0213 Inf 0.680 0.789 ab
## 5 0.819 0.0253 Inf 0.744 0.875 bc
## 1 0.886 0.0185 Inf 0.830 0.926 c
##
## Confidence level used: 0.95
## Conf-level adjustment: sidak method for 5 estimates
## Intervals are back-transformed from the logit scale
## P value adjustment: tukey method for comparing a family of 5 estimates
## Tests are performed on the log odds ratio scale
## significance level used: alpha = 0.05
## NOTE: If two or more means share the same grouping symbol,
## then we cannot show them to be different.
## But we also did not show them to be the same.ggplot(mem, aes(x = treatment, y = prob, fill = treatment)) +
geom_bar(stat = "identity", color = "black") +
scale_fill_viridis_d() +
geom_errorbar(aes(ymin = prob - SE, ymax = prob + SE), width = 0.2, position = position_dodge(0.9)) +
labs(x = "Treatment", y = "Probability", title = "Probability of Brood Being Alive Upon Dissection") +
theme_classic(base_size = 30) +
coord_cartesian(ylim=c(0.5,1)) +
annotate(geom = "text",
x = 3, y = 1 ,
label = "P < 0.001",
size = 8) +
annotate(geom = "text",
x = c(1, 2, 3, 4, 5),
y = c(mem$plot + 0.05),
label = c("c", "a", "ab", "ab", "bc"),
size = 8) +
theme(legend.position = "none")
mcm## contrast odds.ratio SE df null z.ratio
## 1: treatment1 / treatment2 4.2558041 0.95336848 Inf 1 6.4650887
## 2: treatment1 / treatment3 2.7694813 0.58926863 Inf 1 4.7875618
## 3: treatment1 / treatment4 2.8909550 0.66426146 Inf 1 4.6201688
## 4: treatment1 / treatment5 1.7291390 0.43036135 Inf 1 2.2002842
## 5: treatment2 / treatment3 0.6507539 0.10767039 Inf 1 -2.5966219
## 6: treatment2 / treatment4 0.6792970 0.12604642 Inf 1 -2.0840099
## 7: treatment2 / treatment5 0.4063014 0.08478525 Inf 1 -4.3160742
## 8: treatment3 / treatment4 1.0438616 0.17539392 Inf 1 0.2554804
## 9: treatment3 / treatment5 0.6243548 0.12060584 Inf 1 -2.4384714
## 10: treatment4 / treatment5 0.5981203 0.12459077 Inf 1 -2.4673730
## p.value
## 1: 1.012001e-09
## 2: 1.667451e-05
## 3: 3.771541e-05
## 4: 1.794902e-01
## 5: 7.094213e-02
## 6: 2.269222e-01
## 7: 1.545598e-04
## 8: 9.990637e-01
## 9: 1.051942e-01
## 10: 9.811326e-02Drone Count
dc1 <- glm.nb(count ~ treatment + whole.mean + alive + duration + replicate, data = drone.ce)## Warning in glm.nb(count ~ treatment + whole.mean + alive + duration +
## replicate, : alternation limit reacheddc2 <- glm.nb(count ~ treatment*whole.mean + alive + duration + replicate, data = drone.ce)## Warning in glm.nb(count ~ treatment * whole.mean + alive + duration +
## replicate, : alternation limit reacheddc3 <- glm(count ~ treatment + whole.mean + alive + duration + replicate, data = drone.ce, family = "poisson")
summary(dc3) #overdispersed ##
## Call:
## glm(formula = count ~ treatment + whole.mean + alive + duration +
## replicate, family = "poisson", data = drone.ce)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.9722 -1.0601 -0.3165 0.7621 2.2854
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.77558 0.71298 -1.088 0.276685
## treatment2 -0.03635 0.16107 -0.226 0.821479
## treatment3 -0.36343 0.16560 -2.195 0.028186 *
## treatment4 0.08370 0.17064 0.490 0.623790
## treatment5 0.20407 0.17129 1.191 0.233509
## whole.mean 2.80299 0.45461 6.166 7.02e-10 ***
## alive 0.13425 0.06796 1.975 0.048235 *
## duration 0.02925 0.01533 1.908 0.056342 .
## replicate2 0.32594 0.19870 1.640 0.100935
## replicate3 -0.04694 0.18762 -0.250 0.802451
## replicate4 -0.06918 0.19777 -0.350 0.726471
## replicate5 -0.32560 0.21152 -1.539 0.123725
## replicate7 -0.27885 0.18060 -1.544 0.122577
## replicate9 -0.27318 0.20180 -1.354 0.175837
## replicate11 -0.57746 0.24643 -2.343 0.019115 *
## replicate12 -1.40686 0.38401 -3.664 0.000249 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 275.44 on 44 degrees of freedom
## Residual deviance: 79.40 on 29 degrees of freedom
## AIC: 273.4
##
## Number of Fisher Scoring iterations: 6anova(dc1, dc2, test = "Chisq")## Likelihood ratio tests of Negative Binomial Models
##
## Response: count
## Model theta Resid. df
## 1 treatment + whole.mean + alive + duration + replicate 18.38429 29
## 2 treatment * whole.mean + alive + duration + replicate 31.97521 25
## 2 x log-lik. Test df LR stat. Pr(Chi)
## 1 -237.8697
## 2 -229.3870 1 vs 2 4 8.482753 0.07541174AIC(dc1, dc2)## df AIC
## dc1 17 271.8697
## dc2 21 271.3870drop1(dc1, test = "Chisq")## Single term deletions
##
## Model:
## count ~ treatment + whole.mean + alive + duration + replicate
## Df Deviance AIC LRT Pr(>Chi)
## <none> 57.249 269.87
## treatment 4 66.473 271.09 9.224 0.05573 .
## whole.mean 1 84.576 295.20 27.327 1.718e-07 ***
## alive 1 61.532 272.15 4.283 0.03850 *
## duration 1 59.403 270.02 2.155 0.14215
## replicate 8 90.275 286.90 33.026 6.093e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1dc4 <- update(dc1, .~. -duration)## Warning in glm.nb(formula = count ~ treatment + whole.mean + alive + replicate,
## : alternation limit reacheddrop1(dc4, test = "Chisq")## Single term deletions
##
## Model:
## count ~ treatment + whole.mean + alive + replicate
## Df Deviance AIC LRT Pr(>Chi)
## <none> 55.843 269.91
## treatment 4 63.096 269.17 7.253 0.12311
## whole.mean 1 79.374 291.44 23.531 1.229e-06 ***
## alive 1 65.681 277.75 9.838 0.00171 **
## replicate 8 90.932 289.00 35.089 2.576e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Anova(dc4)## Analysis of Deviance Table (Type II tests)
##
## Response: count
## LR Chisq Df Pr(>Chisq)
## treatment 7.253 4 0.12311
## whole.mean 23.531 1 1.229e-06 ***
## alive 9.838 1 0.00171 **
## replicate 35.089 8 2.576e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1plot(dc4)
sum <- drone.ce %>%
group_by(treatment) %>%
summarise(mean = mean(count),
sd = sd(count),
n = length(count)) %>%
mutate(se = sd/sqrt(n))
sum## # A tibble: 5 × 5
## treatment mean sd n se
## <fct> <dbl> <dbl> <int> <dbl>
## 1 1 9.67 7.47 9 2.49
## 2 2 9.78 6.67 9 2.22
## 3 3 8.67 6.76 9 2.25
## 4 4 12.2 9.13 9 3.04
## 5 5 10.9 6.92 9 2.31ggplot(sum, aes(x = treatment, y = mean)) +
geom_bar(stat = "identity", fill = "steelblue", color = "black") +
geom_errorbar(aes(ymin = mean - se, ymax = mean + se), width = 0.2, position = position_dodge(0.9)) +
labs(x = "Treatment", y = "Drone Count", title = "Average Drones Produced by Treatment") +
theme_minimal()
dc4##
## Call: glm.nb(formula = count ~ treatment + whole.mean + alive + replicate,
## data = drone.ce, init.theta = 14.68324431, link = log)
##
## Coefficients:
## (Intercept) treatment2 treatment3 treatment4 treatment5 whole.mean
## 0.09323 -0.15144 -0.46195 -0.07613 0.04504 2.83003
## alive replicate2 replicate3 replicate4 replicate5 replicate7
## 0.23588 0.54340 -0.15243 0.02448 -0.38163 -0.37317
## replicate9 replicate11 replicate12
## -0.23196 -0.62453 -1.15649
##
## Degrees of Freedom: 44 Total (i.e. Null); 30 Residual
## Null Deviance: 182.7
## Residual Deviance: 55.84 AIC: 271.9da <- setDT(as.data.frame(Anova(dc4)))
da## LR Chisq Df Pr(>Chisq)
## 1: 7.253040 4 1.231053e-01
## 2: 23.531381 1 1.228929e-06
## 3: 9.837506 1 1.709892e-03
## 4: 35.088974 8 2.575885e-05emdc <- emmeans(dc4, pairwise ~ "treatment", type = "response")
em <- setDT(as.data.frame(emdc$emmeans))
emc <- setDT(as.data.frame(emdc$contrasts))
em## treatment response SE df asymp.LCL asymp.UCL
## 1: 1 8.683474 1.3148787 Inf 6.453598 11.683826
## 2: 2 7.463146 1.1065322 Inf 5.581071 9.979904
## 3: 3 5.471051 0.8775945 Inf 3.995141 7.492200
## 4: 4 8.046908 1.2498668 Inf 5.934965 10.910381
## 5: 5 9.083516 1.3975267 Inf 6.718836 12.280440emc## contrast ratio SE df null z.ratio p.value
## 1: treatment1 / treatment2 1.1635138 0.2418436 Inf 1 0.7286025 0.9499214
## 2: treatment1 / treatment3 1.5871675 0.3418119 Inf 1 2.1450207 0.2010896
## 3: treatment1 / treatment4 1.0791069 0.2276218 Inf 1 0.3609340 0.9963807
## 4: treatment1 / treatment5 0.9559596 0.2026829 Inf 1 -0.2124308 0.9995482
## 5: treatment2 / treatment3 1.3641157 0.2858889 Inf 1 1.4815778 0.5745061
## 6: treatment2 / treatment4 0.9274551 0.1914747 Inf 1 -0.3647867 0.9962286
## 7: treatment2 / treatment5 0.8216143 0.1704865 Inf 1 -0.9469037 0.8784759
## 8: treatment3 / treatment4 0.6798948 0.1421628 Inf 1 -1.8451746 0.3474998
## 9: treatment3 / treatment5 0.6023054 0.1294987 Inf 1 -2.3580412 0.1270078
## 10: treatment4 / treatment5 0.8858803 0.1914680 Inf 1 -0.5606426 0.9806375Drone Emerge Time
drone.ce.na <- na.omit(drone.ce)
drone.ce.col <- lm(emerge~ treatment + whole.mean + alive + replicate + mean.dose + qro, data = drone.ce.na)
drop1(drone.ce.col, test = "Chisq")## Single term deletions
##
## Model:
## emerge ~ treatment + whole.mean + alive + replicate + mean.dose +
## qro
## Df Sum of Sq RSS AIC Pr(>Chi)
## <none> 328.85 116.27
## treatment 4 83.576 412.43 117.33 0.05966 .
## whole.mean 1 31.850 360.70 117.97 0.05449 .
## alive 1 18.469 347.32 116.45 0.13930
## replicate 5 134.668 463.52 120.00 0.01742 *
## mean.dose 1 24.749 353.60 117.17 0.08844 .
## qro 0 0.000 328.85 116.27
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1d1 <- update(drone.ce.col, .~. -qro)
vif(d1)## GVIF Df GVIF^(1/(2*Df))
## treatment 11.065311 4 1.350503
## whole.mean 2.741920 1 1.655874
## alive 1.945499 1 1.394812
## replicate 5.791834 8 1.116030
## mean.dose 8.660495 1 2.942872d2 <- update(d1, .~. -mean.dose)
vif(d2)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.522758 4 1.053971
## whole.mean 2.679428 1 1.636896
## alive 1.932432 1 1.390119
## replicate 5.091336 8 1.107075d3 <- update(d2, .~. -replicate)
vif(d3)## GVIF Df GVIF^(1/(2*Df))
## treatment 1.132923 4 1.015722
## whole.mean 1.024170 1 1.012013
## alive 1.106926 1 1.052106de1 <- glm.nb(emerge ~ treatment + whole.mean + alive, data = drone.ce.na)## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reachedsummary(de1)##
## Call:
## glm.nb(formula = emerge ~ treatment + whole.mean + alive, data = drone.ce.na,
## init.theta = 1993285.021, link = log)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.7967 -0.4165 -0.1477 0.2458 1.6970
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.8363199 0.1720975 22.292 < 2e-16 ***
## treatment2 -0.0258049 0.0881318 -0.293 0.76968
## treatment3 0.0212144 0.0844717 0.251 0.80170
## treatment4 -0.0796947 0.0873184 -0.913 0.36140
## treatment5 -0.0163648 0.0889253 -0.184 0.85399
## whole.mean -0.4581344 0.1613839 -2.839 0.00453 **
## alive 0.0006647 0.0332978 0.020 0.98407
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for Negative Binomial(1993285) family taken to be 1)
##
## Null deviance: 23.538 on 39 degrees of freedom
## Residual deviance: 13.313 on 33 degrees of freedom
## AIC: 246.3
##
## Number of Fisher Scoring iterations: 1
##
##
## Theta: 1993285
## Std. Err.: 50356630
## Warning while fitting theta: iteration limit reached
##
## 2 x log-likelihood: -230.297de2 <- glm.nb(emerge ~ treatment*whole.mean + alive, data = drone.ce.na)## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reachedsummary(de1)##
## Call:
## glm.nb(formula = emerge ~ treatment + whole.mean + alive, data = drone.ce.na,
## init.theta = 1993285.021, link = log)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.7967 -0.4165 -0.1477 0.2458 1.6970
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.8363199 0.1720975 22.292 < 2e-16 ***
## treatment2 -0.0258049 0.0881318 -0.293 0.76968
## treatment3 0.0212144 0.0844717 0.251 0.80170
## treatment4 -0.0796947 0.0873184 -0.913 0.36140
## treatment5 -0.0163648 0.0889253 -0.184 0.85399
## whole.mean -0.4581344 0.1613839 -2.839 0.00453 **
## alive 0.0006647 0.0332978 0.020 0.98407
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for Negative Binomial(1993285) family taken to be 1)
##
## Null deviance: 23.538 on 39 degrees of freedom
## Residual deviance: 13.313 on 33 degrees of freedom
## AIC: 246.3
##
## Number of Fisher Scoring iterations: 1
##
##
## Theta: 1993285
## Std. Err.: 50356630
## Warning while fitting theta: iteration limit reached
##
## 2 x log-likelihood: -230.297de2 <- glm(emerge ~ treatment + whole.mean + alive, data = drone.ce.na, family = "poisson")
summary(de2) #underdispersed ##
## Call:
## glm(formula = emerge ~ treatment + whole.mean + alive, family = "poisson",
## data = drone.ce.na)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.7967 -0.4165 -0.1477 0.2458 1.6970
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.8363202 0.1720959 22.292 < 2e-16 ***
## treatment2 -0.0258051 0.0881310 -0.293 0.76967
## treatment3 0.0212144 0.0844709 0.251 0.80170
## treatment4 -0.0796949 0.0873176 -0.913 0.36140
## treatment5 -0.0163648 0.0889245 -0.184 0.85399
## whole.mean -0.4581347 0.1613825 -2.839 0.00453 **
## alive 0.0006647 0.0332975 0.020 0.98407
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 23.538 on 39 degrees of freedom
## Residual deviance: 13.313 on 33 degrees of freedom
## AIC: 244.3
##
## Number of Fisher Scoring iterations: 4AIC(de1, de2)## df AIC
## de1 8 246.2971
## de2 7 244.2967drop1(de1, test ="Chisq")## Single term deletions
##
## Model:
## emerge ~ treatment + whole.mean + alive
## Df Deviance AIC LRT Pr(>Chi)
## <none> 13.313 244.30
## treatment 4 14.961 237.95 1.6486 0.800023
## whole.mean 1 21.468 250.45 8.1548 0.004295 **
## alive 1 13.313 242.30 0.0004 0.984070
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1de2 <- update(de1, .~. -alive)## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reached
## Warning in theta.ml(Y, mu, sum(w), w, limit = control$maxit, trace =
## control$trace > : iteration limit reacheddrop1(de2, test = "Chisq")## Single term deletions
##
## Model:
## emerge ~ treatment + whole.mean
## Df Deviance AIC LRT Pr(>Chi)
## <none> 13.313 242.30
## treatment 4 14.978 235.96 1.6649 0.797078
## whole.mean 1 21.468 248.45 8.1546 0.004295 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1ggplot(drone.ce.na, aes(x = treatment, y = emerge, fill = treatment)) +
geom_boxplot(alpha = 0.8, width = 0.5, outlier.shape = NA) +
scale_fill_viridis_d() +
labs(x = "Treatment", y = "Mean Count of Days", title = "Days Until First Drone Emergence by Treatment") +
theme_minimal() +
theme(legend.position = "right")
plot(de2)
Anova(de2)## Analysis of Deviance Table (Type II tests)
##
## Response: emerge
## LR Chisq Df Pr(>Chisq)
## treatment 1.6649 4 0.797078
## whole.mean 8.1546 1 0.004295 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1ea <- setDT(as.data.frame(Anova(de2)))
ea## LR Chisq Df Pr(>Chisq)
## 1: 1.664928 4 0.79707819
## 2: 8.154641 1 0.00429511de2##
## Call: glm.nb(formula = emerge ~ treatment + whole.mean, data = drone.ce.na,
## init.theta = 1992908.801, link = log)
##
## Coefficients:
## (Intercept) treatment2 treatment3 treatment4 treatment5 whole.mean
## 3.83907 -0.02541 0.02155 -0.07959 -0.01589 -0.45810
##
## Degrees of Freedom: 39 Total (i.e. Null); 34 Residual
## Null Deviance: 23.54
## Residual Deviance: 13.31 AIC: 244.3egm <- emmeans(de2, pairwise ~ treatment, type = "response")
eg <- setDT(as.data.frame(egm$emmeans))
eg## treatment response SE df asymp.LCL asymp.UCL
## 1: 1 36.80043 2.295576 Inf 32.56535 41.58628
## 2: 2 35.87713 2.117854 Inf 31.95734 40.27771
## 3: 3 37.60215 2.045644 Inf 33.79912 41.83310
## 4: 4 33.98503 2.068686 Inf 30.16300 38.29135
## 5: 5 36.22027 2.129303 Inf 32.27837 40.64357cg <- setDT(as.data.frame(egm$contrasts))
cg## contrast ratio SE df null z.ratio p.value
## 1: treatment1 / treatment2 1.0257351 0.08809162 Inf 1 0.2958676 0.9983332
## 2: treatment1 / treatment3 0.9786788 0.08100275 Inf 1 -0.2603894 0.9989908
## 3: treatment1 / treatment4 1.0828424 0.09437978 Inf 1 0.9131489 0.8919753
## 4: treatment1 / treatment5 1.0160175 0.08707097 Inf 1 0.1854241 0.9997364
## 5: treatment2 / treatment3 0.9541243 0.07658747 Inf 1 -0.5850425 0.9773308
## 6: treatment2 / treatment4 1.0556745 0.08952128 Inf 1 0.6389129 0.9687062
## 7: treatment2 / treatment5 0.9905262 0.08246520 Inf 1 -0.1143371 0.9999615
## 8: treatment3 / treatment4 1.1064328 0.09034356 Inf 1 1.2386707 0.7286542
## 9: treatment3 / treatment5 1.0381521 0.08303253 Inf 1 0.4681394 0.9901683
## 10: treatment4 / treatment5 0.9382875 0.07952751 Inf 1 -0.7515369 0.9441674em_sum <- drone.ce.na %>%
group_by(treatment) %>%
summarise(mean = mean(emerge),
sd = sd(emerge),
n = length(emerge)) %>%
mutate(se = sd/sqrt(n))
em_sum## # A tibble: 5 × 5
## treatment mean sd n se
## <fct> <dbl> <dbl> <int> <dbl>
## 1 1 36.7 6.82 7 2.58
## 2 2 35.9 1.89 8 0.666
## 3 3 37.6 5.08 9 1.69
## 4 4 33.8 2.55 8 0.901
## 5 5 37.1 6.29 8 2.22ggplot(em_sum, aes(x = treatment, y = mean)) +
geom_bar(stat = "identity", fill = "steelblue", color = "black") +
geom_errorbar(aes(ymin = mean - se, ymax = mean + se), width = 0.2, position = position_dodge(0.9)) +
labs(x = "Treatment", y = "Days", title = "Average Time Until First Drone Emergence by Treatment") +
theme_minimal() 
ggplot(drone.ce.na, aes(x = whole.mean, y = emerge, color = treatment)) +
geom_point(size = 3) +
labs(x = "Average Pollen Consumed(g)", y = "Days", title = "Days Until First Drone Emergence by Average Pollen Consumed") +
theme_minimal() +
scale_color_viridis_d() +
geom_smooth(method = "lm", color = "pink", size = 1) 
Drone Radial Cell
shapiro.test(drone.h$radial)##
## Shapiro-Wilk normality test
##
## data: drone.h$radial
## W = 0.98636, p-value = 0.0006497n <- is.na(drone.h$radial)
unique(n)## [1] TRUE FALSEdrone.rad <- na.omit(drone.h)
ggplot(drone.rad, aes(x=radial, fill = treatment)) +
geom_histogram(position = "identity", binwidth = 0.05 ,col=I("black")) +
scale_fill_manual(values = c("gray90", "gray70", "gray50" , "gray30","gray10"),
name = "Pristine Level",
labels = c("Treatment 1 (control)", "Treatment 2",
"Treatment 3", "Treatment 4", "Treatment 5")) +
ggtitle("Drone Radial Cell Length(mm)") +
labs(y = "Count", x = "Length")
shapiro.test(drone.rad$radial)##
## Shapiro-Wilk normality test
##
## data: drone.rad$radial
## W = 0.98323, p-value = 0.0002138dr1 <- lmer(radial ~ treatment + whole.mean + alive + duration + replicate + (1|colony), data = drone.rad)
summary(dr1)## Linear mixed model fit by REML ['lmerMod']
## Formula: radial ~ treatment + whole.mean + alive + duration + replicate +
## (1 | colony)
## Data: drone.rad
##
## REML criterion at convergence: -112
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.9170 -0.4960 0.0595 0.6197 3.6570
##
## Random effects:
## Groups Name Variance Std.Dev.
## colony (Intercept) 0.00373 0.06108
## Residual 0.03517 0.18753
## Number of obs: 380, groups: colony, 39
##
## Fixed effects:
## Estimate Std. Error t value
## (Intercept) 2.177888 0.175065 12.440
## treatment2 -0.018231 0.050443 -0.361
## treatment3 -0.109883 0.049445 -2.222
## treatment4 0.026604 0.048903 0.544
## treatment5 -0.004263 0.048568 -0.088
## whole.mean 0.020339 0.161441 0.126
## aliveTRUE 0.357346 0.147065 2.430
## duration -0.002068 0.002524 -0.819
## replicate2 0.085313 0.057761 1.477
## replicate3 0.037381 0.061071 0.612
## replicate4 0.058093 0.059040 0.984
## replicate5 0.035371 0.067440 0.524
## replicate7 0.022353 0.062131 0.360
## replicate9 -0.053065 0.061205 -0.867
## replicate11 -0.055463 0.069602 -0.797
## replicate12 0.131757 0.101195 1.302dr2 <- lmer(radial ~ treatment + whole.mean + alive + duration + (1|colony), data = drone.rad)
anova(dr1, dr2, test = "Chisq")## Data: drone.rad
## Models:
## dr2: radial ~ treatment + whole.mean + alive + duration + (1 | colony)
## dr1: radial ~ treatment + whole.mean + alive + duration + replicate + (1 | colony)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## dr2 10 -153.64 -114.234 86.818 -173.64
## dr1 18 -152.84 -81.915 94.419 -188.84 15.202 8 0.05533 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1dr3 <- lmer(radial ~ treatment*whole.mean + alive + duration + replicate + (1|colony), data = drone.rad)
anova(dr1, dr3)## Data: drone.rad
## Models:
## dr1: radial ~ treatment + whole.mean + alive + duration + replicate + (1 | colony)
## dr3: radial ~ treatment * whole.mean + alive + duration + replicate + (1 | colony)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## dr1 18 -152.84 -81.915 94.419 -188.84
## dr3 22 -150.28 -63.600 97.142 -194.28 5.4461 4 0.2445drop1(dr1, test = "Chisq")## Single term deletions
##
## Model:
## radial ~ treatment + whole.mean + alive + duration + replicate +
## (1 | colony)
## npar AIC LRT Pr(Chi)
## <none> -152.84
## treatment 4 -147.30 13.5403 0.008916 **
## whole.mean 1 -154.84 0.0000 0.995412
## alive 1 -147.20 7.6409 0.005706 **
## duration 1 -153.75 1.0830 0.298027
## replicate 8 -153.64 15.2024 0.055327 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1dr4 <- update(dr1, .~. -duration)
drop1(dr4, test = "Chisq")## Single term deletions
##
## Model:
## radial ~ treatment + whole.mean + alive + replicate + (1 | colony)
## npar AIC LRT Pr(Chi)
## <none> -153.75
## treatment 4 -147.46 14.2988 0.006400 **
## whole.mean 1 -155.47 0.2862 0.592646
## alive 1 -148.29 7.4613 0.006304 **
## replicate 8 -154.73 15.0224 0.058712 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1dr5 <- update(dr4, .~. -whole.mean)
drop1(dr5, test = "Chisq")## Single term deletions
##
## Model:
## radial ~ treatment + alive + replicate + (1 | colony)
## npar AIC LRT Pr(Chi)
## <none> -155.47
## treatment 4 -149.39 14.0781 0.007050 **
## alive 1 -150.24 7.2286 0.007175 **
## replicate 8 -156.72 14.7462 0.064272 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1dr6 <- update(dr5, .~. -replicate)
anova(dr5, dr6)## Data: drone.rad
## Models:
## dr6: radial ~ treatment + alive + (1 | colony)
## dr5: radial ~ treatment + alive + replicate + (1 | colony)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## dr6 8 -156.72 -125.201 86.361 -172.72
## dr5 16 -155.47 -92.426 93.734 -187.47 14.746 8 0.06427 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1plot(dr5)
qqnorm(resid(dr5));qqline(resid(dr5))
plot(dr6)
qqnorm(resid(dr6));qqline(resid(dr6)) #keep dr5
dr5## Linear mixed model fit by REML ['lmerMod']
## Formula: radial ~ treatment + alive + replicate + (1 | colony)
## Data: drone.rad
## REML criterion at convergence: -123.4498
## Random effects:
## Groups Name Std.Dev.
## colony (Intercept) 0.05732
## Residual 0.18756
## Number of obs: 380, groups: colony, 39
## Fixed Effects:
## (Intercept) treatment2 treatment3 treatment4 treatment5 aliveTRUE
## 2.11277 -0.03461 -0.12014 0.02044 -0.01526 0.35413
## replicate2 replicate3 replicate4 replicate5 replicate7 replicate9
## 0.08312 0.03075 0.05178 0.03612 0.03856 -0.05461
## replicate11 replicate12
## -0.05916 0.13373Anova(dr5)## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: radial
## Chisq Df Pr(>Chisq)
## treatment 10.4485 4 0.03351 *
## alive 5.9049 1 0.01510 *
## replicate 11.1907 8 0.19113
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1dra <- setDT(as.data.frame(Anova(dr5)))
dra## Chisq Df Pr(>Chisq)
## 1: 10.448516 4 0.03351361
## 2: 5.904928 1 0.01509858
## 3: 11.190698 8 0.19112636dre <- emmeans(dr5, pairwise ~ treatment, type = "response")
edr <- setDT(as.data.frame(dre$emmeans))
edr## treatment emmean SE df lower.CL upper.CL
## 1: 1 2.318758 0.07817467 189.4129 2.164553 2.472962
## 2: 2 2.284150 0.07662793 189.5895 2.132997 2.435303
## 3: 3 2.198615 0.07563122 241.7409 2.049635 2.347596
## 4: 4 2.339202 0.07803481 181.7889 2.185232 2.493172
## 5: 5 2.303494 0.07680387 191.8976 2.152006 2.454982cdr <- setDT(as.data.frame(dre$contrasts))
cdr## contrast estimate SE df t.ratio
## 1: treatment1 - treatment2 0.03460771 0.04601917 22.42930 0.7520281
## 2: treatment1 - treatment3 0.12014241 0.04708252 23.28482 2.5517414
## 3: treatment1 - treatment4 -0.02044434 0.04538655 19.89274 -0.4504493
## 4: treatment1 - treatment5 0.01526383 0.04507287 19.91937 0.3386478
## 5: treatment2 - treatment3 0.08553470 0.04763358 26.79672 1.7956806
## 6: treatment2 - treatment4 -0.05505205 0.04470167 21.52925 -1.2315435
## 7: treatment2 - treatment5 -0.01934388 0.04432579 20.88226 -0.4364024
## 8: treatment3 - treatment4 -0.14058675 0.04739849 23.89659 -2.9660594
## 9: treatment3 - treatment5 -0.10487858 0.04694393 22.80544 -2.2341245
## 10: treatment4 - treatment5 0.03570817 0.04400457 18.56213 0.8114650
## p.value
## 1: 0.94150571
## 2: 0.11319342
## 3: 0.99082332
## 4: 0.99692357
## 5: 0.39671754
## 6: 0.73362271
## 7: 0.99188918
## 8: 0.04799689
## 9: 0.20320305
## 10: 0.92379473sum <- drone.rad %>%
group_by(treatment) %>%
summarise(mean = mean(radial),
sd = sd(radial),
n = length(radial)) %>%
mutate(se = sd/sqrt(n))
edr$plot <- (edr$emmean + edr$SE) +0.02
edr## treatment emmean SE df lower.CL upper.CL plot
## 1: 1 2.318758 0.07817467 189.4129 2.164553 2.472962 2.416932
## 2: 2 2.284150 0.07662793 189.5895 2.132997 2.435303 2.380778
## 3: 3 2.198615 0.07563122 241.7409 2.049635 2.347596 2.294246
## 4: 4 2.339202 0.07803481 181.7889 2.185232 2.493172 2.437237
## 5: 5 2.303494 0.07680387 191.8976 2.152006 2.454982 2.400298rad.cld <- cld(object =dre,
adjust = "Tukey",
Letters = letters,
alpha = 0.05)
rad.cld## treatment emmean SE df lower.CL upper.CL .group
## 3 2.20 0.0756 242 2.00 2.39 a
## 2 2.28 0.0766 190 2.09 2.48 ab
## 5 2.30 0.0768 192 2.10 2.50 ab
## 1 2.32 0.0782 189 2.12 2.52 ab
## 4 2.34 0.0780 182 2.14 2.54 b
##
## Results are averaged over the levels of: alive, replicate
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: sidak method for 5 estimates
## P value adjustment: tukey method for comparing a family of 5 estimates
## significance level used: alpha = 0.05
## NOTE: If two or more means share the same grouping symbol,
## then we cannot show them to be different.
## But we also did not show them to be the same.ggplot(edr, aes(x = treatment, y = emmean, fill = treatment)) +
geom_bar(stat = "identity", color = "black") +
scale_fill_viridis_d() +
geom_errorbar(aes(ymin = emmean - SE, ymax = emmean + SE), width = 0.2, position = position_dodge(0.9)) +
labs(x = "Treatment", y = "Radial Cell Length(mm)", title = "Average Drone Radial Cell Length by Treatment") +
theme_classic(base_size = 30) +
coord_cartesian(ylim=c(2,2.45)) +
annotate(geom = "text",
x = 3, y = 2.45,
label = "P = 0.03",
size = 8) +
annotate(geom = "text",
x = c(1, 2, 3, 4, 5),
y = c(edr$plot),
label = c("ab", "ab", "a", "b", "ab"),
size = 8) +
theme(legend.position = "none")
Drone Dry Weight
shapiro.test(drone.rad$dry_weight)##
## Shapiro-Wilk normality test
##
## data: drone.rad$dry_weight
## W = 0.99386, p-value = 0.1279ggplot(drone.rad, aes(x=dry_weight, fill = treatment)) +
geom_histogram(position = "identity", binwidth = 0.001 ,col=I("black")) +
scale_fill_manual(values = c("gray90", "gray70", "gray50" , "gray30","gray10"),
name = "Pristine Level",
labels = c("Treatment 1 (control)", "Treatment 2",
"Treatment 3", "Treatment 4", "Treatment 5")) +
ggtitle("Drone Radial Cell Length(mm)") +
labs(y = "Count", x = "Length")
dd1 <- lmer(dry_weight ~ treatment + whole.mean + alive + duration + replicate + (1|colony), data = drone.rad)
dd2 <- lmer(dry_weight ~ treatment*whole.mean + alive + duration + replicate + (1|colony), data = drone.rad)
dd3 <- lmer(dry_weight ~ treatment + whole.mean + alive + duration + (1|colony), data = drone.rad)
dd6 <- lmer(dry_weight ~ treatment + whole.mean + alive + duration + qro + (1|colony), data = drone.rad)
anova(dd1, dd6)## Data: drone.rad
## Models:
## dd6: dry_weight ~ treatment + whole.mean + alive + duration + qro + (1 | colony)
## dd1: dry_weight ~ treatment + whole.mean + alive + duration + replicate + (1 | colony)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## dd6 13 -2586.1 -2534.9 1306.1 -2612.1
## dd1 18 -2590.2 -2519.3 1313.1 -2626.2 14.081 5 0.0151 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova(dd1, dd2)## Data: drone.rad
## Models:
## dd1: dry_weight ~ treatment + whole.mean + alive + duration + replicate + (1 | colony)
## dd2: dry_weight ~ treatment * whole.mean + alive + duration + replicate + (1 | colony)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## dd1 18 -2590.2 -2519.3 1313.1 -2626.2
## dd2 22 -2585.6 -2498.9 1314.8 -2629.6 3.3862 4 0.4954anova(dd1, dd3)## Data: drone.rad
## Models:
## dd3: dry_weight ~ treatment + whole.mean + alive + duration + (1 | colony)
## dd1: dry_weight ~ treatment + whole.mean + alive + duration + replicate + (1 | colony)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## dd3 10 -2582.7 -2543.3 1301.3 -2602.7
## dd1 18 -2590.2 -2519.3 1313.1 -2626.2 23.54 8 0.002735 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1drop1(dd3, test = "Chisq")## Single term deletions
##
## Model:
## dry_weight ~ treatment + whole.mean + alive + duration + (1 |
## colony)
## npar AIC LRT Pr(Chi)
## <none> -2582.7
## treatment 4 -2575.8 14.8725 0.004973 **
## whole.mean 1 -2582.8 1.8645 0.172111
## alive 1 -2579.7 5.0084 0.025224 *
## duration 1 -2583.4 1.2458 0.264350
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1dd4 <- update(dd3, .~. -duration)
drop1(dd4, test = "Chisq")## Single term deletions
##
## Model:
## dry_weight ~ treatment + whole.mean + alive + (1 | colony)
## npar AIC LRT Pr(Chi)
## <none> -2583.4
## treatment 4 -2575.6 15.8684 0.003201 **
## whole.mean 1 -2584.2 1.2003 0.273253
## alive 1 -2580.5 4.9128 0.026659 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1dd5 <- update(dd4, .~. -whole.mean)
anova(dd4, dd5)## Data: drone.rad
## Models:
## dd5: dry_weight ~ treatment + alive + (1 | colony)
## dd4: dry_weight ~ treatment + whole.mean + alive + (1 | colony)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## dd5 8 -2584.2 -2552.7 1300.1 -2600.2
## dd4 9 -2583.4 -2548.0 1300.7 -2601.4 1.2003 1 0.2733drop1(dd6, test = "Chisq")## Single term deletions
##
## Model:
## dry_weight ~ treatment + whole.mean + alive + duration + qro +
## (1 | colony)
## npar AIC LRT Pr(Chi)
## <none> -2586.1
## treatment 4 -2574.8 19.3478 0.0006714 ***
## whole.mean 1 -2588.1 0.0157 0.9002031
## alive 1 -2583.1 4.9910 0.0254790 *
## duration 1 -2585.9 2.2603 0.1327298
## qro 3 -2582.7 9.4593 0.0237686 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1dd7 <- update(dd6, .~. -duration)
drop1(dd7, test = "Chisq")## Single term deletions
##
## Model:
## dry_weight ~ treatment + whole.mean + alive + qro + (1 | colony)
## npar AIC LRT Pr(Chi)
## <none> -2585.9
## treatment 4 -2573.9 19.9478 0.0005114 ***
## whole.mean 1 -2587.8 0.0694 0.7922432
## alive 1 -2583.0 4.8350 0.0278881 *
## qro 3 -2583.4 8.4448 0.0376598 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1dd8 <- update(dd7, .~. -whole.mean)
anova(dd7, dd8)## Data: drone.rad
## Models:
## dd8: dry_weight ~ treatment + alive + qro + (1 | colony)
## dd7: dry_weight ~ treatment + whole.mean + alive + qro + (1 | colony)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## dd8 11 -2587.8 -2544.5 1304.9 -2609.8
## dd7 12 -2585.9 -2538.6 1304.9 -2609.9 0.0694 1 0.7922anova(dd5, dd8) #with only one difference in variables (qro) dd5 is significantly better so we will stick with leaving out qro ## Data: drone.rad
## Models:
## dd5: dry_weight ~ treatment + alive + (1 | colony)
## dd8: dry_weight ~ treatment + alive + qro + (1 | colony)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## dd5 8 -2584.2 -2552.7 1300.1 -2600.2
## dd8 11 -2587.8 -2544.5 1304.9 -2609.8 9.5758 3 0.02254 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1qqnorm(resid(dd5));qqline(resid(dd5))
qqnorm(resid(dd8));qqline(resid(dd8))
dd5## Linear mixed model fit by REML ['lmerMod']
## Formula: dry_weight ~ treatment + alive + (1 | colony)
## Data: drone.rad
## REML criterion at convergence: -2533.881
## Random effects:
## Groups Name Std.Dev.
## colony (Intercept) 0.002351
## Residual 0.007728
## Number of obs: 380, groups: colony, 39
## Fixed Effects:
## (Intercept) treatment2 treatment3 treatment4 treatment5 aliveTRUE
## 0.030342 -0.004220 -0.006928 -0.001690 -0.001656 0.013378Anova(dd5)## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: dry_weight
## Chisq Df Pr(>Chisq)
## treatment 16.1421 4 0.002834 **
## alive 5.4468 1 0.019604 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1dda <- setDT(as.data.frame(Anova(dd5)))
dda## Chisq Df Pr(>Chisq)
## 1: 16.142146 4 0.002834237
## 2: 5.446793 1 0.019604287dem <- emmeans(dd5, pairwise ~ treatment, type = "response")
de <- setDT(as.data.frame(dem$emmeans))
ce <- setDT(as.data.frame(dem$contrasts))
de## treatment emmean SE df lower.CL upper.CL
## 1: 1 0.03703052 0.003155463 232.4260 0.03081356 0.04324749
## 2: 2 0.03281009 0.003043623 255.5910 0.02681632 0.03880386
## 3: 3 0.03010298 0.003042070 289.1300 0.02411557 0.03609039
## 4: 4 0.03534020 0.003130613 232.5106 0.02917221 0.04150819
## 5: 5 0.03537462 0.003129857 236.6559 0.02920868 0.04154056ce## contrast estimate SE df t.ratio
## 1: treatment1 - treatment2 4.220431e-03 0.001811605 29.71440 2.32966467
## 2: treatment1 - treatment3 6.927545e-03 0.001925518 31.60841 3.59775671
## 3: treatment1 - treatment4 1.690321e-03 0.001802925 25.83646 0.93754381
## 4: treatment1 - treatment5 1.655903e-03 0.001801612 26.64604 0.91912271
## 5: treatment2 - treatment3 2.707114e-03 0.001883886 34.13507 1.43698394
## 6: treatment2 - treatment4 -2.530110e-03 0.001767964 27.68154 -1.43108633
## 7: treatment2 - treatment5 -2.564528e-03 0.001766626 28.61025 -1.45165355
## 8: treatment3 - treatment4 -5.237224e-03 0.001884518 29.71425 -2.77907922
## 9: treatment3 - treatment5 -5.271642e-03 0.001883262 30.61945 -2.79920871
## 10: treatment4 - treatment5 -3.441855e-05 0.001757724 24.76012 -0.01958132
## p.value
## 1: 0.16382512
## 2: 0.00888931
## 3: 0.87958072
## 4: 0.88699038
## 5: 0.60883100
## 6: 0.61363373
## 7: 0.60072396
## 8: 0.06568513
## 9: 0.06219965
## 10: 0.99999996de$plot <- de$emmean + de$SE
dd.cld <- cld(object =dem,
adjust = "Tukey",
Letters = letters,
alpha = 0.05)
dd.cld## treatment emmean SE df lower.CL upper.CL .group
## 3 0.0301 0.00304 289 0.0222 0.0380 a
## 2 0.0328 0.00304 256 0.0249 0.0407 ab
## 4 0.0353 0.00313 233 0.0272 0.0434 ab
## 5 0.0354 0.00313 237 0.0273 0.0435 ab
## 1 0.0370 0.00316 232 0.0289 0.0452 b
##
## Results are averaged over the levels of: alive
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: sidak method for 5 estimates
## P value adjustment: tukey method for comparing a family of 5 estimates
## significance level used: alpha = 0.05
## NOTE: If two or more means share the same grouping symbol,
## then we cannot show them to be different.
## But we also did not show them to be the same.de## treatment emmean SE df lower.CL upper.CL plot
## 1: 1 0.03703052 0.003155463 232.4260 0.03081356 0.04324749 0.04018599
## 2: 2 0.03281009 0.003043623 255.5910 0.02681632 0.03880386 0.03585371
## 3: 3 0.03010298 0.003042070 289.1300 0.02411557 0.03609039 0.03314505
## 4: 4 0.03534020 0.003130613 232.5106 0.02917221 0.04150819 0.03847081
## 5: 5 0.03537462 0.003129857 236.6559 0.02920868 0.04154056 0.03850448ggplot(de, aes(x = treatment, y = emmean, fill = treatment)) +
geom_bar(stat = "identity", color = "black") +
scale_fill_viridis_d() +
geom_errorbar(aes(ymin = emmean - SE, ymax = emmean + SE), width = 0.2, position = position_dodge(0.9)) +
labs(x = "Treatment", y = "Dry Weight(g)", title = "Average Drone Dry Weight by Treatment") +
theme_classic(base_size = 30) +
coord_cartesian(ylim=c(0.02, 0.042)) +
annotate(geom = "text",
x = 3, y = 0.0425 ,
label = "P < 0.01",
size = 8) +
annotate(geom = "text",
x = c(1, 2, 3, 4, 5),
y = c(de$plot+0.001),
label = c("b", "ab", "a", "ab", "ab"),
size = 8) +
theme(legend.position = "none")
Drone Relative Fat
shapiro.test(drone.rad$relative_fat)##
## Shapiro-Wilk normality test
##
## data: drone.rad$relative_fat
## W = 0.80183, p-value < 2.2e-16drone.rad$logrf <- log(drone.rad$relative_fat)
shapiro.test(drone.rad$logrf)##
## Shapiro-Wilk normality test
##
## data: drone.rad$logrf
## W = 0.93346, p-value = 5.464e-12ggplot(drone.rad, aes(x=relative_fat, fill = treatment)) +
geom_histogram(position = "identity", binwidth = 0.0001 ,col=I("black")) +
scale_fill_manual(values = c("gray90", "gray70", "gray50" , "gray30","gray10"),
name = "Pristine Level",
labels = c("Treatment 1 (control)", "Treatment 2",
"Treatment 3", "Treatment 4", "Treatment 5")) +
ggtitle("Drone Relative Fat") +
labs(y = "Count", x = "Relative Fat(g)")
ggplot(drone.rad, aes(x=logrf, fill = treatment)) +
geom_histogram(position = "identity", binwidth = 0.1 ,col=I("black")) +
scale_fill_manual(values = c("gray90", "gray70", "gray50" , "gray30","gray10"),
name = "Pristine Level",
labels = c("Treatment 1 (control)", "Treatment 2",
"Treatment 3", "Treatment 4", "Treatment 5")) +
ggtitle("(Log) Drone Relative Fat") +
labs(y = "Count", x = "log(Realtive Fat)(g)")
rf1 <- lmer(logrf ~ treatment + whole.mean + alive + duration + (1|colony), data = drone.rad)
rf4 <- lmer(relative_fat ~ treatment + whole.mean + alive + duration + (1|colony), data = drone.rad)
rf2 <- lmer(logrf ~ treatment*whole.mean + alive + duration + (1|colony), data = drone.rad)
rf3 <- lmer(logrf ~ treatment + whole.mean + alive + duration + qro + (1|colony), data = drone.rad)
anova(rf1,rf2)## Data: drone.rad
## Models:
## rf1: logrf ~ treatment + whole.mean + alive + duration + (1 | colony)
## rf2: logrf ~ treatment * whole.mean + alive + duration + (1 | colony)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## rf1 10 446.05 485.46 -213.03 426.05
## rf2 14 449.06 504.22 -210.53 421.06 4.994 4 0.2879anova(rf1, rf3)## Data: drone.rad
## Models:
## rf1: logrf ~ treatment + whole.mean + alive + duration + (1 | colony)
## rf3: logrf ~ treatment + whole.mean + alive + duration + qro + (1 | colony)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## rf1 10 446.05 485.46 -213.03 426.05
## rf3 13 446.18 497.41 -210.09 420.18 5.871 3 0.1181Anova(rf4)## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: relative_fat
## Chisq Df Pr(>Chisq)
## treatment 22.4139 4 0.0001658 ***
## whole.mean 8.1208 1 0.0043759 **
## alive 1.2309 1 0.2672380
## duration 3.8050 1 0.0511007 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1drop1(rf1, test = "Chisq")## Single term deletions
##
## Model:
## logrf ~ treatment + whole.mean + alive + duration + (1 | colony)
## npar AIC LRT Pr(Chi)
## <none> 446.05
## treatment 4 459.08 21.0295 0.0003124 ***
## whole.mean 1 448.68 4.6206 0.0315910 *
## alive 1 450.39 6.3330 0.0118512 *
## duration 1 451.90 7.8491 0.0050846 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1drop1(rf3, test = "Chisq")## Single term deletions
##
## Model:
## logrf ~ treatment + whole.mean + alive + duration + qro + (1 |
## colony)
## npar AIC LRT Pr(Chi)
## <none> 446.18
## treatment 4 459.80 21.6126 0.0002393 ***
## whole.mean 1 445.16 0.9761 0.3231591
## alive 1 450.14 5.9529 0.0146931 *
## duration 1 452.32 8.1388 0.0043328 **
## qro 3 446.05 5.8710 0.1180601
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Anova(rf1)## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: logrf
## Chisq Df Pr(>Chisq)
## treatment 23.5609 4 9.781e-05 ***
## whole.mean 3.9919 1 0.045718 *
## alive 6.1539 1 0.013112 *
## duration 7.0345 1 0.007995 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1rf1## Linear mixed model fit by REML ['lmerMod']
## Formula: logrf ~ treatment + whole.mean + alive + duration + (1 | colony)
## Data: drone.rad
## REML criterion at convergence: 457.0058
## Random effects:
## Groups Name Std.Dev.
## colony (Intercept) 0.09395
## Residual 0.42055
## Number of obs: 380, groups: colony, 39
## Fixed Effects:
## (Intercept) treatment2 treatment3 treatment4 treatment5 whole.mean
## -6.933197 -0.001548 -0.269583 -0.104119 0.161988 0.375643
## aliveTRUE duration
## 0.767712 -0.010271Anova(rf1)## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: logrf
## Chisq Df Pr(>Chisq)
## treatment 23.5609 4 9.781e-05 ***
## whole.mean 3.9919 1 0.045718 *
## alive 6.1539 1 0.013112 *
## duration 7.0345 1 0.007995 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1dda <- setDT(as.data.frame(Anova(rf1)))
dda## Chisq Df Pr(>Chisq)
## 1: 23.560891 4 9.780555e-05
## 2: 3.991937 1 4.571849e-02
## 3: 6.153895 1 1.311230e-02
## 4: 7.034539 1 7.995247e-03qqnorm(resid(rf1));qqline(resid(rf1))
qqnorm(resid(rf4));qqline(resid(rf4))
plot(rf1)
plot(rf4)
dem <- emmeans(rf1, pairwise ~ treatment, type = "response")
de <- setDT(as.data.frame(dem$emmeans))
ce <- setDT(as.data.frame(dem$contrasts))
de## treatment emmean SE df lower.CL upper.CL
## 1: 1 -6.771224 0.1684084 239.7207 -7.102974 -6.439475
## 2: 2 -6.772772 0.1635784 265.1622 -7.094850 -6.450695
## 3: 3 -7.040808 0.1616108 300.1779 -7.358841 -6.722774
## 4: 4 -6.875344 0.1652785 247.8522 -7.200873 -6.549814
## 5: 5 -6.609236 0.1677213 243.6694 -6.939605 -6.278868ce## contrast estimate SE df t.ratio
## 1: treatment1 - treatment2 0.001547925 0.09234309 28.44705 0.01676276
## 2: treatment1 - treatment3 0.269583350 0.09436342 27.56655 2.85686294
## 3: treatment1 - treatment4 0.104119413 0.08675668 22.60483 1.20013142
## 4: treatment1 - treatment5 -0.161988153 0.08802185 23.94374 -1.84031748
## 5: treatment2 - treatment3 0.268035426 0.09425774 34.42023 2.84364355
## 6: treatment2 - treatment4 0.102571488 0.08759237 25.39401 1.17100942
## 7: treatment2 - treatment5 -0.163536077 0.08555338 26.51106 -1.91150921
## 8: treatment3 - treatment4 -0.165463938 0.09027703 25.43622 -1.83284659
## 9: treatment3 - treatment5 -0.431571503 0.09283279 28.96870 -4.64891213
## 10: treatment4 - treatment5 -0.266107566 0.08517773 21.87561 -3.12414486
## p.value
## 1: 0.9999999809
## 2: 0.0570101503
## 3: 0.7512626553
## 4: 0.3750569100
## 5: 0.0540624793
## 6: 0.7673520154
## 7: 0.3360485424
## 8: 0.3776752543
## 9: 0.0006012801
## 10: 0.0359115686dd.cld <- cld(object =dem,
adjust = "Tukey",
Letters = letters,
alpha = 0.05)
predicted_log <-predict(rf1, newdata = drone.rad)
predicted_original <- exp(predicted_log)
result_df <- data.frame(predictors = drone.rad$treatment, predicted_original)
sum <- result_df %>%
group_by(predictors) %>%
summarise(mean = mean(predicted_original),
sd = sd(predicted_original),
n=(length(predicted_original))) %>%
mutate(se = sd/sqrt(n))
sum$plot <- (sum$mean + sum$se)
sum## # A tibble: 5 × 6
## predictors mean sd n se plot
## <fct> <dbl> <dbl> <int> <dbl> <dbl>
## 1 1 0.00179 0.000225 74 0.0000262 0.00181
## 2 2 0.00159 0.000133 75 0.0000154 0.00161
## 3 3 0.00130 0.000188 59 0.0000245 0.00133
## 4 4 0.00155 0.000105 89 0.0000111 0.00156
## 5 5 0.00195 0.000194 83 0.0000213 0.00197ggplot(sum, aes(x = predictors, y = mean, fill = predictors)) +
geom_bar(stat = "identity", color = "black") +
scale_fill_viridis_d() +
geom_errorbar(aes(ymin = mean - se, ymax = mean + se), width = 0.2, position = position_dodge(0.9)) +
labs(x = "Treatment", y = "Relative Fat (g)", title = "Average Drone Abdominal Relative Fat by Treatment") +
theme_classic(base_size = 30) +
coord_cartesian(ylim=c(0.001, 0.002)) +
annotate(geom = "text",
x = 3, y = 0.002 ,
label = "P < 0.01",
size = 8) +
annotate(geom = "text",
x = c(1, 2, 3, 4, 5),
y = c(sum$plot + 3e-05),
label = c("ab", "ab", "a", "a", "b"),
size = 8) +
theme(legend.position = "none")
ggplot(drone.rad, aes(x = whole.mean, y = radial, color = treatment)) +
geom_point(size = 3) +
labs(x = "Average Pollen Consumed(g)", y = "Relative Fat(g)", title = "Drone Abdominal Relative Fat by Average Pollen Consumed") +
theme_minimal() +
scale_color_viridis_d() +
geom_smooth(method = "lm", color = "pink", size = 1) 
Colony Duration
dur1 <- glm(duration ~ treatment + whole.mean + alive + replicate, data = drone.ce)
dur3 <- glm(duration ~ treatment*whole.mean + alive + replicate, data = drone.ce)
drop1(dur1, test = "Chisq")## Single term deletions
##
## Model:
## duration ~ treatment + whole.mean + alive + replicate
## Df Deviance AIC scaled dev. Pr(>Chi)
## <none> 630.85 278.52
## treatment 4 870.71 285.02 14.501 0.005857 **
## whole.mean 1 682.56 280.07 3.545 0.059724 .
## alive 1 987.40 296.68 20.160 7.121e-06 ***
## replicate 8 1105.97 287.79 25.264 0.001402 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1dur2 <- update(dur1, .~. -whole.mean)
anova(dur1, dur2, test = "Chisq")## Analysis of Deviance Table
##
## Model 1: duration ~ treatment + whole.mean + alive + replicate
## Model 2: duration ~ treatment + alive + replicate
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 30 630.85
## 2 31 682.56 -1 -51.707 0.1169AIC(dur1, dur2)## df AIC
## dur1 16 278.5227
## dur2 15 280.0677Anova(dur1) ## Analysis of Deviance Table (Type II tests)
##
## Response: duration
## LR Chisq Df Pr(>Chisq)
## treatment 11.4066 4 0.022355 *
## whole.mean 2.4589 1 0.116858
## alive 16.9558 1 3.826e-05 ***
## replicate 22.5944 8 0.003926 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova(dur1, dur3, test = "Chisq")## Analysis of Deviance Table
##
## Model 1: duration ~ treatment + whole.mean + alive + replicate
## Model 2: duration ~ treatment * whole.mean + alive + replicate
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 30 630.85
## 2 26 526.31 4 104.54 0.2708plot(dur1)
plot(dur2)
durm <- emmeans(dur2, pairwise ~ treatment, type = "response")
durm## $emmeans
## treatment emmean SE df lower.CL upper.CL
## 1 46.4 1.60 31 43.1 49.7
## 2 41.8 1.57 31 38.6 45.0
## 3 43.4 1.59 31 40.2 46.7
## 4 39.8 1.57 31 36.6 43.0
## 5 41.0 1.57 31 37.8 44.2
##
## Results are averaged over the levels of: replicate
## Confidence level used: 0.95
##
## $contrasts
## contrast estimate SE df t.ratio p.value
## treatment1 - treatment2 4.610 2.25 31 2.048 0.2680
## treatment1 - treatment3 2.975 2.31 31 1.289 0.6996
## treatment1 - treatment4 6.587 2.22 31 2.961 0.0430
## treatment1 - treatment5 5.396 2.26 31 2.384 0.1466
## treatment2 - treatment3 -1.635 2.22 31 -0.735 0.9466
## treatment2 - treatment4 1.977 2.22 31 0.891 0.8982
## treatment2 - treatment5 0.786 2.21 31 0.355 0.9964
## treatment3 - treatment4 3.612 2.25 31 1.605 0.5058
## treatment3 - treatment5 2.421 2.22 31 1.091 0.8098
## treatment4 - treatment5 -1.191 2.22 31 -0.535 0.9829
##
## Results are averaged over the levels of: replicate
## P value adjustment: tukey method for comparing a family of 5 estimatescldur <- cld(object = durm,
adjust = "Tukey",
Letters = letters,
alpha = 0.05)
cldur## treatment emmean SE df lower.CL upper.CL .group
## 4 39.8 1.57 31 35.5 44.1 a
## 5 41.0 1.57 31 36.7 45.3 ab
## 2 41.8 1.57 31 37.5 46.1 ab
## 3 43.4 1.59 31 39.0 47.8 ab
## 1 46.4 1.60 31 42.0 50.8 b
##
## Results are averaged over the levels of: replicate
## Confidence level used: 0.95
## Conf-level adjustment: sidak method for 5 estimates
## P value adjustment: tukey method for comparing a family of 5 estimates
## significance level used: alpha = 0.05
## NOTE: If two or more means share the same grouping symbol,
## then we cannot show them to be different.
## But we also did not show them to be the same.durmdf <- as.data.frame(durm$emmeans)
durmdf$plot <- durmdf$emmean + durmdf$SE
ggplot(durmdf, aes(x = treatment, y = emmean, fill = treatment)) +
geom_bar(stat = "identity", color = "black") +
geom_errorbar(aes(ymin = emmean - SE, ymax = emmean + SE), width = 0.2, position = position_dodge(0.9)) +
labs(x = "Treatment", y = "Days", title = "Average Colony Duration") +
scale_fill_viridis_d() +
coord_cartesian(ylim=c(35,50))+
theme(legend.position = "none") +
annotate(geom = "text",
x = 3, y = 50,
label = "P = 0.03",
size = 8) +
annotate(geom = "text",
x = c(1, 2, 3, 4, 5),
y = c(durmdf$plot+1),
label = c("b", "ab", "ab", "a", "ab"),
size = 6) +
theme(legend.position = "none")
LS0tDQp0aXRsZTogIldpZGVseS11c2VkIGZ1bmdpY2lkZSBQcmlzdGluZcKuIGNhdXNlcyBzdWItbGV0aGFsIGVmZmVjdHMgaW4gY29tbW9uIGVhc3Rlcm4gYnVtYmxlIGJlZSAoKkJvbWJ1cyBpbXBhdGllbnMqKSBtaWNyb2NvbG9uaWVzICINCmF1dGhvcjogIkVtaWx5IFJ1bm5pb24iDQpkYXRlOiAiRGF0YSBDb2xsZWN0ZWQgMjAyMiwgRGF0YSBBbmFseXplZCAyMDIzIg0Kb3V0cHV0Og0KICBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogdHJ1ZQ0KICAgIHRvY19kZXB0aDogNA0KICAgIG51bWJlcl9zZWN0aW9uczogZmFsc2UNCiAgICB0b2NfZmxvYXQ6IHRydWUNCiAgICB0aGVtZTogam91cm5hbA0KICAgIGNvZGVfZG93bmxvYWQ6IHRydWUNCi0tLQ0KDQpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0NCmtuaXRyOjpvcHRzX2NodW5rJHNldChtZXNzYWdlID0gRkFMU0UpDQpgYGANCg0KYGBge3IgbG9hZCBsaWJyYXJpZXMsIGluY2x1ZGU9RkFMU0V9DQpsaWJyYXJ5KHJlYWRyKQ0KbGlicmFyeSh2aXJpZGlzTGl0ZSkNCmxpYnJhcnkoc3RhdHMpDQpsaWJyYXJ5KGdncGxvdDIpDQpsaWJyYXJ5KGNhcikNCmxpYnJhcnkoZW1tZWFucykNCmxpYnJhcnkoTUFTUykNCmxpYnJhcnkobG1lNCkNCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShkcGx5cikNCg0KbGlicmFyeShrYWJsZUV4dHJhKQ0KbGlicmFyeShibG1lY28pDQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCmxpYnJhcnkoZHBseXIpDQpsaWJyYXJ5KGNvd3Bsb3QpDQpsaWJyYXJ5KHBsb3RseSkNCmxpYnJhcnkoYWdyaWNvbGFlKSANCmxpYnJhcnkoZ2dwdWJyKQ0KbGlicmFyeShnbHVlKQ0KbGlicmFyeShtdWx0Y29tcCkNCmxpYnJhcnkobXVsdGNvbXBWaWV3KQ0KbGlicmFyeShnbG1tVE1CKQ0KbGlicmFyeShyc3RhdGl4KQ0KbGlicmFyeShmaXRkaXN0cnBsdXMpDQpsaWJyYXJ5KGxvZ3NwbGluZSkNCmxpYnJhcnkob2xzcnIpDQpsaWJyYXJ5KEdHYWxseSkNCmxpYnJhcnkoZGF0YS50YWJsZSkNCmBgYA0KDQojIyMgSW5wdXQgRGF0YSANCg0KYGBge3IgaW5wdXQgcmVsZXZhbnQgZGF0YSBmaWxlc30NCg0KYnJvb2QgPC0gcmVhZF9jc3YoImJyb29kLmNzdiIpDQpicm9vZCRjb2xvbnkgPC0gYXMuZmFjdG9yKGJyb29kJGNvbG9ueSkNCmJyb29kJHRyZWF0bWVudCA8LSBhcy5mYWN0b3IoYnJvb2QkdHJlYXRtZW50KQ0KYnJvb2QkcmVwbGljYXRlPC0gYXMuZmFjdG9yKGJyb29kJHJlcGxpY2F0ZSkNCmJyb29kJHFybyA8LSBhcy5mYWN0b3IoYnJvb2QkcXJvKQ0KDQpkcm9uZS5jZSA8LSByZWFkX2NzdigiZHJvbmUuY291bnQuZW1lcmdlLmNzdiIpDQpkcm9uZS5jZSRjb2xvbnkgPC0gYXMuZmFjdG9yKGRyb25lLmNlJGNvbG9ueSkNCmRyb25lLmNlJHRyZWF0bWVudCA8LSBhcy5mYWN0b3IoZHJvbmUuY2UkdHJlYXRtZW50KQ0KZHJvbmUuY2UkcmVwbGljYXRlPC0gYXMuZmFjdG9yKGRyb25lLmNlJHJlcGxpY2F0ZSkNCmRyb25lLmNlJHFybyA8LSBhcy5mYWN0b3IoZHJvbmUuY2UkcXJvKQ0KDQpkcm9uZS5oIDwtIHJlYWRfY3N2KCJkcm9uZS5oZWFsdGguY3N2IikNCmRyb25lLmgkY29sb255IDwtIGFzLmZhY3Rvcihkcm9uZS5oJGNvbG9ueSkNCmRyb25lLmgkdHJlYXRtZW50IDwtIGFzLmZhY3Rvcihkcm9uZS5oJHRyZWF0bWVudCkNCmRyb25lLmgkcmVwbGljYXRlPC0gYXMuZmFjdG9yKGRyb25lLmgkcmVwbGljYXRlKQ0KZHJvbmUuaCRxcm8gPC0gYXMuZmFjdG9yKGRyb25lLmgkcXJvKQ0KDQpwb2xsZW4gPC0gcmVhZF9jc3YoInBvbGxlbi5jc3YiKQ0KcG9sbGVuJGNvbG9ueSA8LSBhcy5mYWN0b3IocG9sbGVuJGNvbG9ueSkNCnBvbGxlbiR0cmVhdG1lbnQgPC0gYXMuZmFjdG9yKHBvbGxlbiR0cmVhdG1lbnQpDQpwb2xsZW4kcmVwbGljYXRlPC0gYXMuZmFjdG9yKHBvbGxlbiRyZXBsaWNhdGUpDQoNCnFybyA8LSByZWFkX2NzdigicXJvLmNzdiIpDQpxcm8kY29sb255IDwtIGFzLmZhY3Rvcihxcm8kY29sb255KQ0KcXJvJHFybyA8LSBhcy5mYWN0b3IocXJvJHFybykNCnBvbGxlbiA8LSBtZXJnZShwb2xsZW4sIHFybywgYnkueCA9ICJjb2xvbnkiKQ0KcG9sbGVuIDwtIG5hLm9taXQocG9sbGVuKQ0KcG9sbGVuJHFybyA8LSBhcy5mYWN0b3IocG9sbGVuJHFybykNCiMgZ2V0IHJpZCBvZiBuZWdhdGl2ZSBudW1iZXJzDQpwb2xsZW4kZGlmZmVyZW5jZVtwb2xsZW4kZGlmZmVyZW5jZSA8IDBdIDwtIE5BDQpwb2xsZW4gPC0gbmEub21pdChwb2xsZW4pDQpyYW5nZShwb2xsZW4kZGlmZmVyZW5jZSkNCg0Kd2VpZ2h0cyA8LSByZWFkX2Nzdigid2VpZ2h0cy5jc3YiKQ0Kd2VpZ2h0cyRjb2xvbnkgPC0gYXMuZmFjdG9yKHdlaWdodHMkY29sb255KQ0Kd2VpZ2h0cyR0cmVhdG1lbnQgPC0gYXMuZmFjdG9yKHdlaWdodHMkdHJlYXRtZW50KQ0Kd2VpZ2h0cyRyZXBsaWNhdGU8LSBhcy5mYWN0b3Iod2VpZ2h0cyRyZXBsaWNhdGUpDQp3ZWlnaHRzJHFybyA8LSBhcy5mYWN0b3Iod2VpZ2h0cyRxcm8pDQoNCndvcmtlcnMgPC0gcmVhZF9jc3YoIndvcmtlcnMuY3N2IikNCndvcmtlcnMkY29sb255IDwtIGFzLmZhY3Rvcih3b3JrZXJzJGNvbG9ueSkNCndvcmtlcnMkdHJlYXRtZW50IDwtIGFzLmZhY3Rvcih3b3JrZXJzJHRyZWF0bWVudCkNCndvcmtlcnMkcmVwbGljYXRlPC0gYXMuZmFjdG9yKHdvcmtlcnMkcmVwbGljYXRlKQ0Kd29ya2VycyRxcm8gPC0gYXMuZmFjdG9yKHdvcmtlcnMkcXJvKQ0Kd29ya2VycyRhbGl2ZV9hdF9lbmQgPC0gYXMubG9naWNhbCh3b3JrZXJzJGFsaXZlX2F0X2VuZCkNCndvcmtlcnMkZGVhZF9hdF9lbmQgPC0gYXMubG9naWNhbCh3b3JrZXJzJGRlYWRfYXRfZW5kKQ0KDQpjYmluZHdvcmtlcnMgPC0gcmVhZC5jc3YoImNiaW5kd29ya2Vycy5jc3YiKQ0KY2JpbmR3b3JrZXJzJGNvbG9ueSA8LSBhcy5mYWN0b3IoY2JpbmR3b3JrZXJzJGNvbG9ueSkNCmNiaW5kd29ya2VycyR0cmVhdG1lbnQgPC0gYXMuZmFjdG9yKGNiaW5kd29ya2VycyR0cmVhdG1lbnQpDQpjYmluZHdvcmtlcnMkcmVwbGljYXRlIDwtIGFzLmZhY3RvcihjYmluZHdvcmtlcnMkcmVwbGljYXRlKQ0KDQpgYGANCg0KIyMjIENoZWNrIGZvciBjb2xsaW5lYXJpdHkgDQoNCmBgYHtyfQ0KYnJvb2QuY29sIDwtIGxtKGJyb29kX2NlbGxzfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiAgKyByZXBsaWNhdGUgKyBtZWFuLmRvc2UgKyBxcm8sIGRhdGEgPSBicm9vZCkNCmRyb3AxKGJyb29kLmNvbCwgdGVzdCA9ICJDaGlzcSIpDQpiMSA8LSB1cGRhdGUoYnJvb2QuY29sLCAufi4gLXFybykNCnZpZihiMSkNCmIyIDwtIHVwZGF0ZShiMSwgLn4uIC1tZWFuLmRvc2UpDQp2aWYoYjIpDQpiMyA8LSB1cGRhdGUoYjIsIC5+LiAtcmVwbGljYXRlKQ0KdmlmKGIzKQ0KYW5vdmEoYjIsIGIzKQ0KQUlDKGIyLCBiMykNCg0KYnJvb2QuY29sIDwtIGxtKGhvbmV5X3BvdH4gdHJlYXRtZW50ICsgd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24gICsgcmVwbGljYXRlICsgbWVhbi5kb3NlICsgcXJvLCBkYXRhID0gYnJvb2QpDQpkcm9wMShicm9vZC5jb2wsIHRlc3QgPSAiQ2hpc3EiKQ0KYjEgPC0gdXBkYXRlKGJyb29kLmNvbCwgLn4uIC1xcm8pDQp2aWYoYjEpDQpiMiA8LSB1cGRhdGUoYjEsIC5+LiAtbWVhbi5kb3NlKQ0KdmlmKGIyKQ0KYjMgPC0gdXBkYXRlKGIyLCAufi4gLXJlcGxpY2F0ZSkNCnZpZihiMykNCmFub3ZhKGIyLCBiMykNCkFJQyhiMiwgYjMpDQoNCmJyb29kLmNvbCA8LSBsbShlZ2dzfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiAgKyByZXBsaWNhdGUgKyBtZWFuLmRvc2UgKyBxcm8sIGRhdGEgPSBicm9vZCkNCmRyb3AxKGJyb29kLmNvbCwgdGVzdCA9ICJDaGlzcSIpDQpiMSA8LSB1cGRhdGUoYnJvb2QuY29sLCAufi4gLXFybykNCnZpZihiMSkNCmIyIDwtIHVwZGF0ZShiMSwgLn4uIC1tZWFuLmRvc2UpDQp2aWYoYjIpDQpiMyA8LSB1cGRhdGUoYjIsIC5+LiAtcmVwbGljYXRlKQ0KdmlmKGIzKQ0KYW5vdmEoYjIsIGIzKQ0KQUlDKGIyLCBiMykNCg0KYnJvb2QuY29sIDwtIGxtKGRlYWRfbGFydmFlfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiAgKyByZXBsaWNhdGUgKyBtZWFuLmRvc2UgKyBxcm8sIGRhdGEgPSBicm9vZCkNCmRyb3AxKGJyb29kLmNvbCwgdGVzdCA9ICJDaGlzcSIpDQpiMSA8LSB1cGRhdGUoYnJvb2QuY29sLCAufi4gLXFybykNCnZpZihiMSkNCmIyIDwtIHVwZGF0ZShiMSwgLn4uIC1tZWFuLmRvc2UpDQp2aWYoYjIpDQpiMyA8LSB1cGRhdGUoYjIsIC5+LiAtcmVwbGljYXRlKQ0KdmlmKGIzKQ0KYW5vdmEoYjIsIGIzKQ0KQUlDKGIyLCBiMykNCg0KYnJvb2QuY29sIDwtIGxtKGxpdmVfbGFydmFlfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiAgKyByZXBsaWNhdGUgKyBtZWFuLmRvc2UgKyBxcm8sIGRhdGEgPSBicm9vZCkNCmRyb3AxKGJyb29kLmNvbCwgdGVzdCA9ICJDaGlzcSIpDQpiMSA8LSB1cGRhdGUoYnJvb2QuY29sLCAufi4gLXFybykNCnZpZihiMSkNCmIyIDwtIHVwZGF0ZShiMSwgLn4uIC1tZWFuLmRvc2UpDQp2aWYoYjIpDQpiMyA8LSB1cGRhdGUoYjIsIC5+LiAtcmVwbGljYXRlKQ0KdmlmKGIzKQ0KYW5vdmEoYjIsIGIzKQ0KQUlDKGIyLCBiMykNCg0KYnJvb2QuY29sIDwtIGxtKGRlYWRfcHVwYWV+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uICArIHJlcGxpY2F0ZSArIG1lYW4uZG9zZSArIHFybywgZGF0YSA9IGJyb29kKQ0KZHJvcDEoYnJvb2QuY29sLCB0ZXN0ID0gIkNoaXNxIikNCmIxIDwtIHVwZGF0ZShicm9vZC5jb2wsIC5+LiAtcXJvKQ0KdmlmKGIxKQ0KYjIgPC0gdXBkYXRlKGIxLCAufi4gLW1lYW4uZG9zZSkNCnZpZihiMikNCmIzIDwtIHVwZGF0ZShiMiwgLn4uIC1yZXBsaWNhdGUpDQp2aWYoYjMpDQphbm92YShiMiwgYjMpDQpBSUMoYjIsIGIzKQ0KDQpicm9vZC5jb2wgPC0gbG0obGl2ZV9wdXBhZX4gdHJlYXRtZW50ICsgd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24gICsgcmVwbGljYXRlICsgbWVhbi5kb3NlICsgcXJvLCBkYXRhID0gYnJvb2QpDQpkcm9wMShicm9vZC5jb2wsIHRlc3QgPSAiQ2hpc3EiKQ0KYjEgPC0gdXBkYXRlKGJyb29kLmNvbCwgLn4uIC1xcm8pDQp2aWYoYjEpDQpiMiA8LSB1cGRhdGUoYjEsIC5+LiAtbWVhbi5kb3NlKQ0KdmlmKGIyKQ0KYjMgPC0gdXBkYXRlKGIyLCAufi4gLXJlcGxpY2F0ZSkNCnZpZihiMykNCmFub3ZhKGIyLCBiMykNCkFJQyhiMiwgYjMpDQojIFZhcmlhYmxlcyB0byBrZWVwIGZvciBicm9vZCBwcm9kdWN0aW9uIG1vZGVscyA9IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uDQoNCmRyb25lLmNlLmNvbCA8LSBsbShlbWVyZ2V+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSAgKyByZXBsaWNhdGUgKyBtZWFuLmRvc2UgKyBxcm8sIGRhdGEgPSBkcm9uZS5jZSkNCmQxIDwtIHVwZGF0ZShkcm9uZS5jZS5jb2wsIC5+LiAtcXJvKQ0KdmlmKGQxKQ0KZDIgPC0gdXBkYXRlKGQxLCAufi4gLW1lYW4uZG9zZSkNCnZpZihkMikNCmQzIDwtIHVwZGF0ZShkMiwgLn4uIC1yZXBsaWNhdGUpDQp2aWYoZDMpDQphbm92YShkMiwgZDMpDQoNCmRyb25lLmNlLmNvbCA8LSBsbShjb3VudH4gdHJlYXRtZW50ICsgd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24gICsgcmVwbGljYXRlICsgbWVhbi5kb3NlICsgcXJvLCBkYXRhID0gZHJvbmUuY2UpDQpkMSA8LSB1cGRhdGUoZHJvbmUuY2UuY29sLCAufi4gLXFybykNCnZpZihkMSkNCmQyIDwtIHVwZGF0ZShkMSwgLn4uIC1tZWFuLmRvc2UpDQp2aWYoZDIpDQpkMyA8LSB1cGRhdGUoZDIsIC5+LiAtcmVwbGljYXRlKQ0KdmlmKGQzKQ0KYW5vdmEoZDIsIGQzKQ0KQUlDKGQyLCBkMykgICNrZWVwIGQyDQojIFZhcmlhYmxlcyB0byBrZWVwIGZvciBlbWVyZ2VuY2UgbW9kZWwgPSB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUNCiNkcm9uZSBjb3VudCBtb2RlbCA9IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uICsgcmVwbGljYXRlDQoNCmRyb25lLmguY29sIDwtICBsbShyZWxhdGl2ZV9mYXR+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uICArIHJlcGxpY2F0ZSArIG1lYW4uZG9zZSArIHFybywgZGF0YSA9IGRyb25lLmgpDQpkcm9wMShkcm9uZS5oLmNvbCwgdGVzdCA9ICJDaGlzcSIpDQpkMSA8LSB1cGRhdGUoZHJvbmUuaC5jb2wsIC5+LiAtcXJvKQ0KdmlmKGQxKQ0KZDIgPC0gdXBkYXRlKGQxLCAufi4gLW1lYW4uZG9zZSkNCnZpZihkMikNCmQzIDwtIHVwZGF0ZShkMiwgLn4uIC1yZXBsaWNhdGUpDQp2aWYoZDMpDQphbm92YShkMiwgZDMsIHRlc3QgPSAiQ2hpc3EiKQ0KQUlDKGQyLCBkMykNCg0KZHJvbmUuaC5jb2wgPC0gIGxtKGRyeV93ZWlnaHR+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uICArIHJlcGxpY2F0ZSArIG1lYW4uZG9zZSArIHFybywgZGF0YSA9IGRyb25lLmgpDQpkcm9wMShkcm9uZS5oLmNvbCwgdGVzdCA9ICJDaGlzcSIpDQpkMSA8LSB1cGRhdGUoZHJvbmUuaC5jb2wsIC5+LiAtcXJvKQ0KdmlmKGQxKQ0KZDIgPC0gdXBkYXRlKGQxLCAufi4gLW1lYW4uZG9zZSkNCnZpZihkMikNCmQzIDwtIHVwZGF0ZShkMiwgLn4uIC1yZXBsaWNhdGUpDQp2aWYoZDMpDQphbm92YShkMiwgZDMsIHRlc3QgPSAiQ2hpc3EiKQ0KQUlDKGQyLCBkMykNCg0KZHJvbmUuaC5jb2wgPC0gIGxtKHJhZGlhbH4gdHJlYXRtZW50ICsgd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24gICsgcmVwbGljYXRlICsgbWVhbi5kb3NlICsgcXJvLCBkYXRhID0gZHJvbmUuaCkNCmRyb3AxKGRyb25lLmguY29sLCB0ZXN0ID0gIkNoaXNxIikNCmQxIDwtIHVwZGF0ZShkcm9uZS5oLmNvbCwgLn4uIC1xcm8pDQp2aWYoZDEpDQpkMiA8LSB1cGRhdGUoZDEsIC5+LiAtbWVhbi5kb3NlKQ0KdmlmKGQyKQ0KZDMgPC0gdXBkYXRlKGQyLCAufi4gLXJlcGxpY2F0ZSkNCnZpZihkMykNCmFub3ZhKGQyLCBkMywgdGVzdCA9ICJDaGlzcSIpDQpBSUMoZDIsIGQzKQ0KDQojIFZhcmlhYmxlcyB0byBpbmNsdWRlIGluIGRyb25lIGRyeSB3ZWlnaHQgYW5kIHJhZGlhbCBjZWxsIG1vZGVsID0gdHJlYXRtZW50ICsgd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24gKyByZXBsaWNhdGUsIGJ1dCBpbiByZWxhdGl2ZSBmYXQgaXQgaXMgPSB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbg0KDQp3ZWlnaHRzLmNvbCA8LSAgbG0oZGlmZmVyZW5jZX4gdHJlYXRtZW50ICsgd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24gICsgcmVwbGljYXRlICsgbWVhbi5kb3NlICsgcXJvLCBkYXRhID0gd2VpZ2h0cykNCmRyb3AxKHdlaWdodHMuY29sLCB0ZXN0ID0gIkNoaXNxIikNCnd0Y29sMSA8LSB1cGRhdGUod2VpZ2h0cy5jb2wsIC5+LiAtcXJvKQ0KdmlmKHd0Y29sMSkNCnd0Y29sMiA8LSB1cGRhdGUod3Rjb2wxLCAufi4gLW1lYW4uZG9zZSkNCnZpZih3dGNvbDIpDQp3dGNvbDMgPC0gdXBkYXRlKHd0Y29sMiwgLn4uIC1yZXBsaWNhdGUpDQp2aWYod3Rjb2wzKQ0KYW5vdmEod3Rjb2wyLCB3dGNvbDMsIHRlc3QgPSAiQ2hpc3EiKQ0KI3ZhcmlhYmxlcyB0byBpbmNsdWRlIGluIHdlaWdodCBjaGFuZ2UgbW9kZWwgPSB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbg0KDQoNCndvcmtlcnMuY29sIDwtIGxtKGRyeV93ZWlnaHQgfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmVfYXRfZW5kICsgY29sb255X2R1cmF0aW9uICsgcmVwbGljYXRlICsgcXJvICsgbWVhbi5kb3NlLCBkYXRhID0gd29ya2VycykNCmRyb3AxKHdvcmtlcnMuY29sLCB0ZXN0ID0gIkNoaXNxIikNCndjb2wxIDwtIHVwZGF0ZSh3b3JrZXJzLmNvbCwgLn4uIC1xcm8pDQp2aWYod2NvbDEpDQpkcm9wMSh3Y29sMSwgdGVzdCA9ICJDaGlzcSIpDQp3Y29sMiA8LSB1cGRhdGUod2NvbDEsIC5+LiAtbWVhbi5kb3NlKQ0KdmlmKHdjb2wyKQ0KZHJvcDEod2NvbDIsIHRlc3QgPSAiQ2hpc3EiKQ0Kd2NvbDMgPC0gdXBkYXRlKHdjb2wyLCAufi4gLXJlcGxpY2F0ZSkNCnZpZih3Y29sMykNCmFub3ZhKHdjb2wyLCB3Y29sMykNCg0KI3ZhcmlhYmxlcyB0byBiZWdpbiBmb3Igd29ya2VycyBkcnkgd2VpZ2h0IG1vZGVsIC0tPiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmVfYXRfZW5kICsgY29sb255X2R1cmF0aW9uICsgcmVwbGljYXRlDQoNCndvcmtlcnMuY29sIDwtICBsbShkYXlzX2FsaXZlfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgY29sb255X2R1cmF0aW9uICsgcmVwbGljYXRlICsgZHJ5X3dlaWdodCArIG1lYW4uZG9zZSArIHFybywgZGF0YSA9IHdvcmtlcnMpDQpkcm9wMSh3b3JrZXJzLmNvbCwgdGVzdCA9ICJDaGlzcSIpDQp3Y29sMSA8LSB1cGRhdGUod29ya2Vycy5jb2wsIC5+LiAtcXJvKQ0KdmlmKHdjb2wxKQ0Kd2NvbDIgPC0gdXBkYXRlKHdjb2wxLCAufi4gLW1lYW4uZG9zZSkNCnZpZih3Y29sMikNCmRyb3AxKHdjb2wyLCB0ZXN0ID0gIkNoaXNxIikNCiN2YXJpYWJsZXMgdG8ga2VlcCBmb3Igd29ya2VyIGRheXMgYWxpdmUgbW9kZWwgLS0+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBjb2xvbnlfZHVyYXRpb24gKyByZXBsaWNhdGUgKyBkcnlfd2VpZ2h0IA0KDQoNCmNiaW5kdy5jb2wgPC0gbG0oYWxpdmUgfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgbWVhbi5kb3NlICsgcmVwbGljYXRlICsgZHVyYXRpb24gKyBxcm8sIGRhdGEgPWNiaW5kd29ya2VycykNCmNiMSA8LSB1cGRhdGUoY2JpbmR3LmNvbCwgLn4uIC1xcm8pDQpjYjMgPC0gdXBkYXRlKGNiaW5kdy5jb2wsIC5+LiAtcmVwbGljYXRlKQ0KYW5vdmEoY2IxLCBjYjMpDQpBSUMoY2IxLCBjYjMpDQp2aWYoY2IxKQ0KY2IyIDwtIHVwZGF0ZShjYjEsIC5+LiAtbWVhbi5kb3NlKQ0KdmlmKGNiMikNCiN2YXJpYWJsZXMgZm9yIGNiaW5kIHdvcmtlcnMgPSB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgcmVwbGljYXRlICsgZHVyYXRpb24NCg0KcG9sbGVuLmNvbCA8LSBsbShkaWZmZXJlbmNlfiB0cmVhdG1lbnQgKyBiZWVzX2FsaXZlICsgcmVwbGljYXRlICsgcXJvICsgY291bnQsIGRhdGEgPSBwb2xsZW4pDQpwY29sMSA8LSB1cGRhdGUocG9sbGVuLmNvbCwgLn4uIC1xcm8pDQp2aWYocGNvbDEpDQpkcm9wMShwY29sMSwgdGVzdCA9ICJDaGlzcSIpDQojdmFyaWFibGVzIHRvIGtlZXAgZm9yIHBvbGxlbiBtb2RlbCA9IHRyZWF0bWVudCArIGJlZXNfYWxpdmUgKyByZXBsaWNhdGUgKyBjb3VudA0KDQpkdXIuY29sPC0gbG0oZHVyYXRpb24gfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyByZXBsaWNhdGUgKyBjb3VudCwgZGF0YSA9IGRyb25lLmNlKQ0KdmlmKGR1ci5jb2wpDQpkcm9wMShkdXIuY29sLCB0ZXN0ID0gIkNoaXNxIikNCmR1cjEgPC0gdXBkYXRlKGR1ci5jb2wsIC5+LiAtY291bnQpDQp2aWYoZHVyMSkNCiN2YXJpYWJsZXMgdG8ga2VlcCBmb3IgZHVyYXRpb24gPSB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyByZXBsaWNhdGUgDQoNCmBgYA0KDQoNCiMjIyBXZWlnaHQgQ2hhbmdlDQoNCmBgYHtyfQ0KdyA8LSB3ZWlnaHRzIA0KDQpyYW5nZSh3JGRpZmZlcmVuY2UpDQoNCnUgPC0gaXMubmEodykNCnVuaXF1ZSh1KQ0KDQpnZ3Bsb3QodywgYWVzKHggPSBkaWZmZXJlbmNlLCBmaWxsID0gdHJlYXRtZW50KSkgKw0KICBnZW9tX2hpc3RvZ3JhbShwb3NpdGlvbiA9ICJpZGVudGl0eSIsIGJpbndpZHRoID0gMC41LCBjb2wgPSBJKCJibGFjayIpKSArDQogIHNjYWxlX2ZpbGxfdmlyaWRpc19kKCkgKyAgIyBVc2UgdmlyaWRpc19kKCkgZm9yIHRoZSBjb2xvci1ibGluZCBmcmllbmRseSBwYWxldHRlDQogIGdndGl0bGUoIkNvbG9ueSBXZWlnaHQgQ2hhbmdlIikgKw0KICBsYWJzKHkgPSAiQ291bnQiLCB4ID0gIldlaWdodCAoZykiKQ0KDQpzaGFwaXJvLnRlc3QodyRkaWZmZXJlbmNlKQ0KDQpgYGANCg0KYGBge3J9DQpkZXNjZGlzdCh3JGRpZmZlcmVuY2UsIGRpc2NyZXRlID0gRkFMU0UpDQoNCndtb2QuaW50IDwtIGdsbShkaWZmZXJlbmNlIH4gdHJlYXRtZW50Kndob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uLCBkYXRhID0gdykNCndtb2QxIDwtIGdsbShkaWZmZXJlbmNlIH4gdHJlYXRtZW50ICsgd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24sIGRhdGEgPSB3KQ0KDQphbm92YSh3bW9kLmludCwgd21vZDEsIHRlc3QgPSAiQ2hpc3EiKQ0KDQpBSUMod21vZC5pbnQsIHdtb2QxKQ0KDQpkcm9wMSh3bW9kMSwgdGVzdCA9ICJDaGlzcSIpDQoNCndtb2QyIDwtIHVwZGF0ZSh3bW9kMSwgLn4uIC1hbGl2ZSkNCg0KYW5vdmEod21vZDEsIHdtb2QyLCB0ZXN0ID0gIkNoaXNxIikNCg0KQUlDKHdtb2QxLCB3bW9kMikNCg0KZHJvcDEod21vZDIsIHRlc3QgPSAiQ2hpc3EiKQ0KDQp3bW9kMyA8LSB1cGRhdGUod21vZDIsIC5+LiAtZHVyYXRpb24pDQoNCmFub3ZhKHdtb2QyLCB3bW9kMywgdGVzdCA9ICJDaGlzcSIpDQoNCmRyb3AxKHdtb2QzLCB0ZXN0ID0gIkNoaXNxIikNCg0KQW5vdmEod21vZDMpDQoNCndtb2QzDQpzdW1tYXJ5KHdtb2QzKQ0KDQoNCmBgYA0KDQpgYGB7cn0NCndzdW0gPC0gdyAlPiUNCiAgZ3JvdXBfYnkodHJlYXRtZW50KSAlPiUNCiAgc3VtbWFyaXNlKG0gPSBtZWFuKGRpZmZlcmVuY2UpLCANCiAgICAgICAgICAgIHNkID0gc2QoZGlmZmVyZW5jZSksIA0KICAgICAgICAgICAgbiA9IGxlbmd0aChkaWZmZXJlbmNlKSkgJT4lDQogIG11dGF0ZShzZSA9IHNkL3NxcnQobikpDQoNCndkdCA8LSBzZXREVChhcy5kYXRhLmZyYW1lKHdzdW0pKQ0Kd2R0DQoNCmF3IDwtIHNldERUKGFzLmRhdGEuZnJhbWUoQW5vdmEod21vZDMpKSkNCmF3DQoNCndlIDwtIGVtbWVhbnMod21vZDMsICJ0cmVhdG1lbnQiKQ0Kd3AgPC0gcGFpcnMod2UpDQp3cCA8LSBhcy5kYXRhLmZyYW1lKHdwKQ0Kd3AgPC0gc2V0RFQod3ApDQp3cA0KYGBgDQoNCg0KDQoNCmBgYHtyLCBmaWcud2lkdGg9IDE1LCBmaWcuaGVpZ2h0PSAxMn0NCnd0dWsubWVhbnMgPC0gZW1tZWFucyhvYmplY3QgPSB3bW9kMywNCiAgICAgICAgICAgICAgICAgICAgICAgIHNwZWNzID0gInRyZWF0bWVudCIsDQogICAgICAgICAgICAgICAgICAgICAgICBhZGp1c3QgPSAiVHVrZXkiLA0KICAgICAgICAgICAgICAgICAgICAgICAgdHlwZSA9ICJyZXNwb25zZSIpDQoNCg0Kd3R1ay5tZWFucw0KDQp3dGtkdCA8LSBzZXREVChhcy5kYXRhLmZyYW1lKHd0dWsubWVhbnMpKQ0Kd3RrZHQNCg0Kdy5jbGQubW9kZWwgPC0gY2xkKG9iamVjdCA9IHd0dWsubWVhbnMsDQogICAgICAgICAgICAgICAgICAgICBhZGp1c3QgPSAiVHVrZXkiLA0KICAgICAgICAgICAgICAgICAgICAgTGV0dGVycyA9IGxldHRlcnMsDQogICAgICAgICAgICAgICAgICAgICBhbHBoYSA9IDAuMDUpDQp3LmNsZC5tb2RlbA0KDQp3dHVrLnRyZWF0bWVudCA8LSBhcy5kYXRhLmZyYW1lKHcuY2xkLm1vZGVsKQ0Kd3R1ay50cmVhdG1lbnQNCg0Kd19tYXggPC0gdyAlPiUNCiAgZ3JvdXBfYnkodHJlYXRtZW50KSAlPiUNCiAgc3VtbWFyaXplKG1heHcgPSBtYXgobWVhbihkaWZmZXJlbmNlKSkpDQoNCg0Kd19mb3JfcGxvdHRpbmcgPC0gZnVsbF9qb2luKHd0dWsudHJlYXRtZW50LCB3X21heCwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGJ5PSJ0cmVhdG1lbnQiKQ0KDQp3c3VtDQoNCmdncGxvdChkYXRhID0gd3N1bSwgYWVzKHggPSB0cmVhdG1lbnQsIHkgPSBtLCBmaWxsID0gdHJlYXRtZW50KSkgKw0KICBnZW9tX2NvbChjb2wgPSAiYmxhY2siKSArDQogIGNvb3JkX2NhcnRlc2lhbih5bGltID0gYygwLCAyMCkpICsNCiAgc2NhbGVfZmlsbF92aXJpZGlzX2QoKSArICAjIFVzZSB2aXJpZGlzX2QoKSBmb3IgdGhlIGNvbG9yLWJsaW5kIGZyaWVuZGx5IHBhbGV0dGUNCiAgZ2VvbV9lcnJvcmJhcihhZXMoeW1pbiA9IG0gLSBzZSwgeW1heCA9IG0gKyBzZCksDQogICAgICAgICAgICAgICAgcG9zaXRpb24gPSBwb3NpdGlvbl9kb2RnZSgyKSwgd2lkdGggPSAwLjQsIHNpemUgPSAxLjUpICsNCiAgbGFicyh5ID0gIk1lYW4gV2VpZ2h0IERpZmZlcmVuY2UiKSArDQogIGdndGl0bGUoIkF2ZXJhZ2UgQ29sb255IFdlaWdodCBDaGFuZ2UoZykgYnkgVHJlYXRtZW50IikgKw0KICBzY2FsZV94X2Rpc2NyZXRlKA0KICAgIG5hbWUgPSAiVHJlYXRtZW50IiwNCiAgICBsYWJlbHMgPSBjKCIwIFBQQiIsICIxNTAgUFBCIiwgIjEsNTAwIFBQQiIsICIxNSwwMDAgUFBCIiwgIjE1MCwwMDAgUFBCIikNCiAgKSArDQogIHRoZW1lX2NsYXNzaWMoYmFzZV9zaXplID0gMzApICsgICMgQWRqdXN0IHRoZSBiYXNlX3NpemUgYXMgbmVlZGVkDQogIGFubm90YXRlKA0KICAgIGdlb20gPSAidGV4dCIsDQogICAgeCA9IDEsIHkgPSAxOSwNCiAgICBsYWJlbCA9ICIgcCA9IDAuMjQiLA0KICAgIHNpemUgPSAxNSAgIyBBZGp1c3QgdGhlIHNpemUgb2YgdGhlIGFubm90YXRpb24gdGV4dCBhcyBuZWVkZWQNCiAgKSArDQogIGFubm90YXRlKA0KICAgIGdlb20gPSAidGV4dCIsDQogICAgeCA9IGMoMSwgNSwgMiwgNCwgMyksDQogICAgeSA9IGMoMTQsIDE1LCAxNC41LCAxNiwgMTgpLA0KICAgIGxhYmVsID0gYygiYSIsICJhIiwgImEiLCAiYSIsICJhIiksDQogICAgc2l6ZSA9IDIwICAjIEFkanVzdCB0aGUgc2l6ZSBvZiB0aGUgYW5ub3RhdGlvbiB0ZXh0IGFzIG5lZWRlZA0KICApICsNCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gIm5vbmUiKQ0KDQoNCmBgYA0KDQojIyMgUG9sbGVuIENvbnN1bXB0aW9uDQoNCmBgYHtyfQ0Kc2hhcGlyby50ZXN0KHBvbGxlbiRkaWZmZXJlbmNlKQ0KDQpwb2xsZW4kc3EgPC0gKHBvbGxlbiRkaWZmZXJlbmNlKV4oMS8zKQ0KDQpwb2xsZW4kYm94IDwtIGJjUG93ZXIocG9sbGVuJGRpZmZlcmVuY2UsIC0zLCBnYW1tYT0xKQ0KDQpzaGFwaXJvLnRlc3QocG9sbGVuJHNxKQ0Kc2hhcGlyby50ZXN0KHBvbGxlbiRib3gpDQoNCmdncGxvdChwb2xsZW4sIGFlcyh4ID0gYm94LCBmaWxsID0gdHJlYXRtZW50KSkgKw0KICBnZW9tX2hpc3RvZ3JhbShwb3NpdGlvbiA9ICJpZGVudGl0eSIsIGJpbndpZHRoID0gMC4wMSwgY29sID0gSSgiYmxhY2siKSkgKw0KICBzY2FsZV9maWxsX3ZpcmlkaXNfZCgpICsgICMgVXNlIHZpcmlkaXNfZCgpIGZvciB0aGUgY29sb3ItYmxpbmQgZnJpZW5kbHkgcGFsZXR0ZQ0KICBnZ3RpdGxlKCJQb2xsZW4gQ29uc3VtcHRpb24oZykiKSArDQogIGxhYnMoeSA9ICJDb3VudCIsIHggPSAiUG9sbGVuIChnKSIpDQoNCnAxIDwtIGFvdihib3ggfiB0cmVhdG1lbnQgKyBjb3VudCArIGJlZXNfYWxpdmUgKyByZXBsaWNhdGUsIGRhdGEgPSBwb2xsZW4gKQ0KZHJvcDEocDEsIHRlc3QgPSAiQ2hpc3EiKQ0Kc3VtbWFyeShwMSkNCnBsb3QocDEpDQoNCnAyIDwtIGxtZXIoYm94IH4gdHJlYXRtZW50ICsgY291bnQgKyBiZWVzX2FsaXZlICsgcmVwbGljYXRlICsgKDF8Y29sb255KSwgZGF0YSA9IHBvbGxlbiApDQpwbG90KHAyKQ0KQW5vdmEocDIpDQpxcW5vcm0ocmVzaWQocDIpKTtxcWxpbmUocmVzaWQocDIpKSANCg0Kc3VtIDwtIHBvbGxlbiAlPiUNCiAgZ3JvdXBfYnkodHJlYXRtZW50KSAlPiUNCiAgc3VtbWFyaXNlKG1lYW4gPSBtZWFuKGRpZmZlcmVuY2UpLA0KICAgICAgICAgICAgc2QgPSBzZChkaWZmZXJlbmNlKSwNCiAgICAgICAgICAgIG4gPSBsZW5ndGgoZGlmZmVyZW5jZSkpICU+JQ0KICBtdXRhdGUoc2UgPSBzZC9zcXJ0KG4pKQ0KDQpzdW0NCg0Kc3VtDQoNCmVtbWVhbnMocDIsIHBhaXJ3aXNlIH4gInRyZWF0bWVudCIpDQoNCmdncGxvdChkYXRhID0gc3VtLCBhZXMoeD10cmVhdG1lbnQsIHkgPSBtZWFuLCBmaWxsID0gdHJlYXRtZW50KSkgKw0KICBnZW9tX2NvbChjb2wgPSAiYmxhY2siKSArDQogIGNvb3JkX2NhcnRlc2lhbih5bGltID0gYygwLjQwLCAwLjU1KSkgKw0KICBzY2FsZV9maWxsX3ZpcmlkaXNfZCgpICsNCiAgZ2VvbV9lcnJvcmJhcihhZXMoeW1pbiA9IG1lYW4gLSBzZSwgeW1heCA9IG1lYW4gKyBzZSksIHdpZHRoID0gMC4yLCBwb3NpdGlvbiA9IHBvc2l0aW9uX2RvZGdlKDAuOSkpDQoNCmBgYA0KDQoNCmBgYHtyLCBmaWcud2lkdGg9IDMwfQ0KDQpzdW0xIDwtIHBvbGxlbiAlPiUNCiAgZ3JvdXBfYnkoY29sb255KSAlPiUNCiAgc3VtbWFyaXNlKG1lYW4gPSBtZWFuKGRvc2VfY29uc3VtZWQpLA0KICAgICAgICAgICAgc2QgPSBzZChkb3NlX2NvbnN1bWVkKSwNCiAgICAgICAgICAgIG4gPSBsZW5ndGgoZG9zZV9jb25zdW1lZCkpICU+JQ0KICBtdXRhdGUoc2UgPSBzZC9zcXJ0KG4pKQ0Kc3VtMQ0KDQpnZ3Bsb3QoZGF0YSA9IHN1bTEsIGFlcyh4PWNvbG9ueSwgeSA9IG1lYW4sIGZpbGwgPSBjb2xvbnkpKSArDQogIGdlb21fY29sKGNvbCA9ICJibGFjayIpICsNCiAgY29vcmRfY2FydGVzaWFuKHlsaW0gPSBjKDAsIDk1MDAwKSkgKw0KICBzY2FsZV9maWxsX3ZpcmlkaXNfZCgpICsNCiAgZ2VvbV9lcnJvcmJhcihhZXMoeW1pbiA9IG1lYW4gLSBzZSwgeW1heCA9IG1lYW4gKyBzZSksIHdpZHRoID0gMC4yLCBwb3NpdGlvbiA9IHBvc2l0aW9uX2RvZGdlKDAuOSkpICsNCiAgbGFicyh0aXRsZSA9ICJEb3NlIG9mIFByaXN0aW5lIENvbnN1bWVkIHBlciBDb2xvbnkiLCB5ID0gIkRvc2UoUFBNKSIsIHggPSAiQ29sb255IikrDQogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbiA9IGMoMC4yLCAwLjcpKSArDQogIHRoZW1lKHRleHQgPSBlbGVtZW50X3RleHQoc2l6ZSA9IDIwKSkNCg0KYGBgDQoNCg0KIyMjIFdvcmtlcnMgDQoNCiMjIyMgRHJ5IFdlaWdodA0KDQpgYGB7cn0NCg0KZ2dwbG90KHdvcmtlcnMsIGFlcyh4ID0gZHJ5X3dlaWdodCwgZmlsbCA9IHRyZWF0bWVudCkpICsNCiAgZ2VvbV9oaXN0b2dyYW0ocG9zaXRpb24gPSAiaWRlbnRpdHkiLCBiaW53aWR0aCA9IDAuMDAyLCBjb2wgPSBJKCJibGFjayIpKSArDQogIHNjYWxlX2ZpbGxfdmlyaWRpc19kKCkgKyAgIyBVc2UgdmlyaWRpc19kKCkgZm9yIHRoZSBjb2xvci1ibGluZCBmcmllbmRseSBwYWxldHRlDQogIGdndGl0bGUoIldvcmtlciBEcnkgV2VpZ2h0KGcpIikgKw0KICBsYWJzKHkgPSAiQ291bnQiLCB4ID0gIldlaWdodCAoZykiKQ0KDQpzaGFwaXJvLnRlc3Qod29ya2VycyRkcnlfd2VpZ2h0KQ0KDQoNCndvcmtlcnMkbG9nZHJ5IDwtIGxvZyh3b3JrZXJzJGRyeV93ZWlnaHQpDQoNCnNoYXBpcm8udGVzdCh3b3JrZXJzJGxvZ2RyeSkNCg0KZ2dwbG90KHdvcmtlcnMsIGFlcyh4ID0gbG9nZHJ5LCBmaWxsID0gdHJlYXRtZW50KSkgKw0KICBnZW9tX2hpc3RvZ3JhbShwb3NpdGlvbiA9ICJpZGVudGl0eSIsIGJpbndpZHRoID0gMC4wNSwgY29sID0gSSgiYmxhY2siKSkgKw0KICBzY2FsZV9maWxsX3ZpcmlkaXNfZCgpICsgICMgVXNlIHZpcmlkaXNfZCgpIGZvciB0aGUgY29sb3ItYmxpbmQgZnJpZW5kbHkgcGFsZXR0ZQ0KICBnZ3RpdGxlKCJXb3JrZXIgRHJ5IFdlaWdodChnKSIpICsNCiAgbGFicyh5ID0gIkNvdW50IiwgeCA9ICJXZWlnaHQgKGcpIikNCg0KYGBgDQoNCg0KYGBge3J9DQoNCndya2RyeS5pbnQgPC0gbG1lcihsb2dkcnkgfiB0cmVhdG1lbnQqd2hvbGUubWVhbiArIGFsaXZlX2F0X2VuZCArIGNvbG9ueV9kdXJhdGlvbiArIGRheXNfYWxpdmUgKyAoMXxjb2xvbnkpLCBkYXRhID0gd29ya2VycykNCndya2RyeTEgPC0gbG1lcihsb2dkcnkgfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmVfYXRfZW5kICsgY29sb255X2R1cmF0aW9uICsgZGF5c19hbGl2ZSArICgxfGNvbG9ueSksIGRhdGEgPSB3b3JrZXJzKQ0KDQphbm92YSh3cmtkcnkuaW50LCB3cmtkcnkxKQ0KDQpkcm9wMSh3cmtkcnkxLCB0ZXN0ID0gIkNoaXNxIikNCg0Kd2QxIDwtIHVwZGF0ZSh3cmtkcnkxLCAufi4gLWFsaXZlX2F0X2VuZCkNCmRyb3AxKHdkMSwgdGVzdCA9ICJDaGlzcSIpDQoNCndkMiA8LSB1cGRhdGUod2QxLCAufi4gLWRheXNfYWxpdmUpDQpkcm9wMSh3ZDEsIHRlc3QgPSAiQ2hpc3EiKQ0KDQp3ZDMgPC0gdXBkYXRlKHdkMiwgLn4uIC1jb2xvbnlfZHVyYXRpb24pDQpkcm9wMSh3ZDMsIHRlc3QgPSAiQ2hpc3EiKQ0KDQp3ZDMNCkFub3ZhKHdkMykNCndhIDwtIHNldERUKGFzLmRhdGEuZnJhbWUoKChBbm92YSh3ZDMpKSkpKQ0Kd2ENCg0Kd29ya2RyeSA8LSB3b3JrZXJzICU+JQ0KICBncm91cF9ieSh0cmVhdG1lbnQpICU+JQ0KICBzdW1tYXJpc2UoYS5tPSBtZWFuKGRyeV93ZWlnaHQpLCANCiAgICAgICAgICAgIHNkLmEgPSBzZChkcnlfd2VpZ2h0KSwNCiAgICAgICAgICAgIG4uYSA9IGxlbmd0aChkcnlfd2VpZ2h0KSkgJT4lDQogIG11dGF0ZShzZWEgPSBzZC5hIC8gc3FydChuLmEpKQ0KDQp3b3JrZHJ5IDwtIHNldERUKHdvcmtkcnkpDQp3b3JrZHJ5DQpgYGANCg0KDQpgYGB7ciwgZmlnLmhlaWdodD0gMTIsIGZpZy53aWR0aD0gMTJ9DQp3b3JrZHJ5ZW0gPC0gZW1tZWFucyh3bW9kMywgfnRyZWF0bWVudCwgdHlwZSA9ICJyZXNwb25zZSIpDQp3b3JrZHJ5ZW0NCg0Kd3AgPC0gYXMuZGF0YS5mcmFtZShwYWlycyh3b3JrZHJ5ZW0pKQ0Kd3AgPC0gc2V0RFQod3ApDQp3cA0KDQp3ZGUgPC0gYXMuZGF0YS5mcmFtZSh3b3JrZHJ5ZW0pDQp3ZGUyIDwtIHNldERUKHdkZSkNCndkZTINCg0Kd29ya2NsZCA8LSBjbGQob2JqZWN0ID0gd29ya2RyeWVtLCANCiAgICAgICAgICAgICAgIGFkanVzdCA9ICJUVWtleSIsDQogICAgICAgICAgICAgICBhbHBoYSA9IDAuMDUsDQogICAgICAgICAgICAgICBMZXR0ZXJzID0gbGV0dGVycykNCndvcmtjbGQNCg0KZW1tZGYyIDwtIGFzLmRhdGEuZnJhbWUod29ya2NsZCkNCg0KZW1tZGYyDQoNCg0Kd29ya2RyeSRwbG90IDwtIHdvcmtkcnkkYS5tICsgd29ya2RyeSRzZWENCg0KZ2dwbG90KGRhdGEgPSB3b3JrZHJ5LCBhZXMoeCA9IHRyZWF0bWVudCwgeSA9IGEubSwgZmlsbCA9IHRyZWF0bWVudCkpICsNCiAgZ2VvbV9jb2woY29sID0gImJsYWNrIikgKw0KICBjb29yZF9jYXJ0ZXNpYW4oeWxpbSA9IGMoMCwgMC4wNikpICsNCiAgc2NhbGVfZmlsbF92aXJpZGlzX2QoKSArICAjIFVzZSB2aXJpZGlzX2QoKSBmb3IgdGhlIGNvbG9yLWJsaW5kIGZyaWVuZGx5IHBhbGV0dGUNCiAgZ2VvbV9lcnJvcmJhcihhZXMoeW1heCA9IGEubSArIHNlYSwgeW1pbiA9IGEubSAtIHNlYSksDQogICAgICAgICAgICAgICAgcG9zaXRpb24gPSBwb3NpdGlvbl9kb2RnZSgyKSwgd2lkdGggPSAwLjQsIHNpemUgPSAxLjUpICsNCiAgbGFicyh5ID0gIkF2ZXJhZ2UgV29ya2VyIERyeSBXZWlnaHQoZykiKSArDQogIGdndGl0bGUoIkF2ZXJhZ2UgV29ya2VyIERyeSBXZWlnaHQoZykgYnkgVHJlYXRtZW50IikgKw0KICBzY2FsZV94X2Rpc2NyZXRlKA0KICAgIG5hbWUgPSAiVHJlYXRtZW50IiwNCiAgICBsYWJlbHMgPSBjKCIwIFBQQiIsICIxNTAgUFBCIiwgIjEsNTAwIFBQQiIsICIxNSwwMDAgUFBCIiwgIjE1MCwwMDAgUFBCIikNCiAgKSArDQogIHRoZW1lX2NsYXNzaWMoYmFzZV9zaXplID0gMzApICsgICMgQWRqdXN0IHRoZSBiYXNlX3NpemUgYXMgbmVlZGVkDQogIGFubm90YXRlKA0KICAgIGdlb20gPSAidGV4dCIsDQogICAgeCA9IDEsIHkgPSAwLjA2LA0KICAgIGxhYmVsID0gIiBwID0gMC43NCIsDQogICAgc2l6ZSA9IDE1ICAjIEFkanVzdCB0aGUgc2l6ZSBvZiB0aGUgYW5ub3RhdGlvbiB0ZXh0IGFzIG5lZWRlZA0KICApICsNCiAgYW5ub3RhdGUoDQogICAgZ2VvbSA9ICJ0ZXh0IiwNCiAgICB4ID0gYygxLCA1LCAyLCA0LCAzKSwNCiAgICB5ID0gYygwLjA1NSwgMC4wNTUsIDAuMDU0LCAwLjA1NywgMC4wNTYpLA0KICAgIGxhYmVsID0gYygiYSIsICJhIiwgImEiLCAiYSIsICJhIiksDQogICAgc2l6ZSA9IDIwICAjIEFkanVzdCB0aGUgc2l6ZSBvZiB0aGUgYW5ub3RhdGlvbiB0ZXh0IGFzIG5lZWRlZA0KICApICsNCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gIm5vbmUiKQ0KDQpgYGANCg0KYGBge3IsIGZpZy53aWR0aD0gMTIsIGZpZy5oZWlnaHQ9IDEwfQ0KZ2dwbG90KHdvcmtlcnMsIGFlcyh4ID0gd2hvbGUubWVhbiwgeSA9IGRyeV93ZWlnaHQsIGNvbG9yID0gdHJlYXRtZW50KSkgKw0KICBnZW9tX3BvaW50KHNpemUgPSA1KSsNCiAgZ2d0aXRsZSgiQW1vdW50IG9mIFBvbGxlbiAgQ29uc3VtZWQgdnMuIEF2ZXJhZ2UgV29ya2VyIERyeSBXZWlnaHQiKSsNCiAgeGxhYigiTWVhbiBQb2xlbiBDb25zdW1wdGlvbihnKSIpICsNCiAgeWxhYigiTWVhbiBEcnkgV2VpZ2h0KGcpIikgKw0KICBzY2FsZV9maWxsX3ZpcmlkaXNfZCgpICsNCiAgdGhlbWUodGV4dCA9IGVsZW1lbnRfdGV4dChzaXplID0gMjApKSArDQogIGdlb21fc21vb3RoKG1ldGhvZCA9ICJsbSIsIGNvbG9yID0gImJsYWNrIikNCmBgYA0KDQoNCiMjIyMgV29ya2VyIFN1cnZpdmFsIA0KDQojIyMjIyBEYXlzIEFsaXZlDQoNCmBgYHtyfQ0Kd29ya2VycyRzdXJ2aXZlZCA8LSBhcy5sb2dpY2FsKHdvcmtlcnMkc3Vydml2ZWQpDQoNCndya2RheXMxIDwtIGdsbS5uYihkYXlzX2FsaXZlIH4gdHJlYXRtZW50ICsgd2hvbGUubWVhbiArIGNvbG9ueV9kdXJhdGlvbiArIHJlcGxpY2F0ZSArIGRyeV93ZWlnaHQsIGRhdGEgPSB3b3JrZXJzKQ0Kd3JrZGF5czIgPC0gZ2xtLm5iKGRheXNfYWxpdmUgfiB0cmVhdG1lbnQqd2hvbGUubWVhbiArIGNvbG9ueV9kdXJhdGlvbiArIHJlcGxpY2F0ZSArIGRyeV93ZWlnaHQsIGRhdGEgPSB3b3JrZXJzKQ0KQUlDKHdya2RheXMxLCB3cmtkYXlzMikNCmRyb3AxKHdya2RheXMxLCB0ZXN0ID0gIkNoaXNxIikNCndkMiA8LSB1cGRhdGUod3JrZGF5czEsIC5+LiAtZHJ5X3dlaWdodCkNCmRyb3AxKHdkMiwgdGVzdCA9ICJDaGlzcSIpDQpxcW5vcm0ocmVzaWQod2QyKSk7cXFsaW5lKHJlc2lkKHdkMikpDQoNCg0Kd2QzIDwtIHVwZGF0ZSh3ZDIsIC5+LiAtYWxpdmUpDQpkcm9wMSh3ZDMsIHRlc3QgPSAiQ2hpc3EiKQ0Kd2Q0IDwtIHVwZGF0ZSh3ZDMsIC5+LiAtd2hvbGUubWVhbikNCmRyb3AxKHdkNCwgdGVzdCA9ICJDaGlzcSIpDQoNCmBgYA0KIyMjIyMgY2JpbmQgd29ya2Vycw0KDQpgYGB7ciwgZmlnLndpZHRoPSAxMn0NCmNidzEgPC0gZ2xtKGNiaW5kKGFsaXZlLCBkZWFkKSB+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBxcm8gKyBkdXJhdGlvbiwgZGF0YSA9IGNiaW5kd29ya2VycywgZmFtaWx5ID0gYmlub21pYWwoImxvZ2l0IikpDQpjYncyIDwtIGdsbShjYmluZChhbGl2ZSwgZGVhZCkgfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgcmVwbGljYXRlICsgZHVyYXRpb24sIGRhdGEgPSBjYmluZHdvcmtlcnMsIGZhbWlseSA9IGJpbm9taWFsKCJsb2dpdCIpKQ0KYW5vdmEoY2J3MSwgY2J3MiwgdGVzdCA9ICJDaGlzcSIpDQpBSUMoY2J3MSwgY2J3MikNCg0KZHJvcDEoY2J3MSwgdGVzdCA9ICJDaGlzcSIpDQoNCnBsb3QoY2J3MSkNCnBsb3QoY2J3MikNCg0KY2J3MQ0KQW5vdmEoY2J3MSkNCg0KYWN3IDwtIHNldERUKGFzLmRhdGEuZnJhbWUoQW5vdmEoY2J3MSkpKQ0KYWN3DQoNCmVtbTEgPC0gZW1tZWFucyhjYncxLCBwYWlyd2lzZSB+IHRyZWF0bWVudCwgdHlwZSA9ICJyZXNwb25zZSIpDQpwYWlycyhlbW0xKQ0KZW1tMQ0KZW1tZGYgPC0gYXMuZGF0YS5mcmFtZShlbW0xJGNvbnRyYXN0cykNCmVtbWRmDQoNCndvcmtjbGQgPC0gY2xkKG9iamVjdCA9IGVtbTEsDQogICAgICAgICAgICAgICBhZGp1c3QgPSAiVHVrZXkiLA0KICAgICAgICAgICAgICAgYWxwaGEgPSAwLjA1LA0KICAgICAgICAgICAgICAgTGV0dGVycyA9IGxldHRlcnMpDQoNCndvcmtjbGQgDQoNCndvcmtjbGQgPC0gYXMuZGF0YS5mcmFtZSh3b3JrY2xkKQ0KDQp3b3JrY2xkJHBsb3QgPC0gd29ya2NsZCRwcm9iICsgd29ya2NsZCRhc3ltcC5VQ0wNCg0Kd29ya2NsZA0KDQpnZ3Bsb3QoZGF0YSA9IHdvcmtjbGQsIGFlcyh4PXRyZWF0bWVudCwgeT1wcm9iLCBmaWxsPXRyZWF0bWVudCkpICsgDQogIGdlb21fY29sKHBvc2l0aW9uID0gImRvZGdlIiwgY29sb3IgPSAiYmxhY2siKSArDQogIGdlb21fZXJyb3JiYXIoYWVzKHltaW4gPSBwcm9iIC0gU0UsIHltYXggPSBwcm9iICsgU0UpLCB3aWR0aCA9IDAuMiwgcG9zaXRpb24gPSBwb3NpdGlvbl9kb2RnZSgwLjkpKSArIA0KICBjb29yZF9jYXJ0ZXNpYW4oeWxpbSA9IGMoMCwxLjMpKSArDQogIGxhYnMoeCA9ICJUcmVhdG1lbnQiLCB5ID0gIlByb2JhYmlsaXR5IG9mIFN1cnZpdmFsIiwgdGl0bGUgPSJQcm9iYWJpbGl0eSBvZiBXb3JrZXIgU3Vydml2YWwgZm9yIER1cmF0aW9uIG9mIEV4cGVyaW1lbnQiKSArDQogIHRoZW1lKHRleHQgPSBlbGVtZW50X3RleHQoc2l6ZSA9IDIwKSkgKyAgICAgICAgICAgICAgICAgICAgDQogICBhbm5vdGF0ZShnZW9tID0gInRleHQiLCANCiAgICAgICAgICB4ID0gMSwgeSA9IDEuMiwNCiAgICAgICAgICBsYWJlbCA9ICJQIDwgMC4wMDEiLA0KICAgICAgICAgIHNpemUgPSA4KSArDQogIGFubm90YXRlKGdlb20gPSAidGV4dCIsDQogICAgICAgICAgIHggPSBjKDEsIDIsIDMsIDQsIDUpLA0KICAgICAgICAgICB5ID0gYygwLjc1LCAxLjEsIDEuMSwgMSwgMS4xKSwNCiAgICAgICAgICAgbGFiZWwgPSBjKCJhIiwgImFiIiwgImIiLCAiYWIiLCAiYiIpLA0KICAgICAgICAgICBzaXplID0gOCkgKw0KICB0aGVtZShsZWdlbmQucG9zaXRpb24gPSAgIm5vbmUiKQ0KYGBgDQoNCg0KIyMjIEJyb29kIFByb2R1Y3Rpb24NCg0KYGBge3J9DQoNCmJyb29kMSA8LSBnbG0ubmIoYnJvb2RfY2VsbHMgfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiwgZGF0YSA9IGJyb29kKQ0KZW1tZWFucyhicm9vZDEsIHBhaXJ3aXNlIH4gdHJlYXRtZW50KQ0KYnJvb2QyIDwtIGdsbShicm9vZF9jZWxscyB+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uLCBkYXRhID0gYnJvb2QsIGZhbWlseSA9ICJwb2lzc29uIikgI292ZXJkaXNwZXJzZWQNCnN1bW1hcnkoYnJvb2QyKQ0KZHJvcDEoYnJvb2QxLCB0ZXN0ID0gIkNoaXNxIikNCmJyb29kNCA8LSBnbG0ubmIoYnJvb2RfY2VsbHMgfiB0cmVhdG1lbnQqd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24sIGRhdGEgPSBicm9vZCkNCmFub3ZhKGJyb29kMSwgYnJvb2Q0LCB0ZXN0ID0gIkNoaXNxIikNCg0KZHJvcDEoYnJvb2QxLCB0ZXN0ID0gIkNoaXNxIikNCmJyb29kMyA8LSB1cGRhdGUoYnJvb2QxLCAufi4gLWR1cmF0aW9uKQ0KYW5vdmEoYnJvb2QxLCBicm9vZDMsIHRlc3QgPSAiQ2hpc3EiKQ0KQUlDKGJyb29kMSwgYnJvb2QzKQ0KDQpwbG90KGJyb29kMykNCg0KYnJvb2QzDQoNCmFiIDwtIHNldERUKGFzLmRhdGEuZnJhbWUoQW5vdmEoYnJvb2QzKSkpDQphYg0KDQplbWIxIDwtIGVtbWVhbnMoYnJvb2QzLCAidHJlYXRtZW50IiwgdHlwZSA9ICJyZXNwb25zZSIpDQplbWIgPC0gc2V0RFQoYXMuZGF0YS5mcmFtZShlbWIxKSkNCmVtYg0KDQpwZW1iIDwtIHBhaXJzKGVtYjEpDQpwZW1iIDwtIHNldERUKGFzLmRhdGEuZnJhbWUocGVtYikpDQpwZW1iDQoNCmJyb29kX3N1bSA8LSBicm9vZCAlPiUNCiAgZ3JvdXBfYnkodHJlYXRtZW50KSAlPiUNCiAgc3VtbWFyaXNlKG1iID0gbWVhbihicm9vZF9jZWxscyksDQogICAgICAgICAgICBuYiA9IGxlbmd0aChicm9vZF9jZWxscyksIA0KICAgICAgICAgICAgc2RiID0gc2QoYnJvb2RfY2VsbHMpKSAlPiUNCiAgbXV0YXRlKHNlYiA9IChzZGIvc3FydChuYikpKQ0KYnJvb2Rfc3VtDQoNCnBsb3QoYnJvb2QkdHJlYXRtZW50LCBicm9vZCRicm9vZF9jZWxscykNCg0KDQpnZ3Bsb3QoYnJvb2QsIGFlcyh4ID0gdHJlYXRtZW50LCB5ID0gYnJvb2RfY2VsbHMsIGZpbGwgPSB0cmVhdG1lbnQpKSArDQogIGdlb21fYm94cGxvdChhbHBoYSA9IDAuOCwgd2lkdGggPSAwLjUsIG91dGxpZXIuc2hhcGUgPSBOQSkgKw0KICBzY2FsZV9maWxsX3ZpcmlkaXNfZCgpICsNCiAgbGFicyh4ID0gIlRyZWF0bWVudCIsIHkgPSAiTWVhbiBDb3VudCBvZiBCcm9vZCBDZWxscyIsIHRpdGxlID0gIkNvdW50IG9mIEJyb29kIENlbGxzIGJ5IFRyZWF0bWVudCIpICsNCiAgdGhlbWVfbWluaW1hbCgpICsNCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gInJpZ2h0IikNCg0KDQpgYGANCg0KDQojIyMgRWdncw0KDQpgYGB7cn0NCg0KZTEgPC0gZ2xtLm5iKGVnZ3MgfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiwgZGF0YSA9IGJyb29kKQ0KZTIgPC0gZ2xtLm5iKGVnZ3MgfiB0cmVhdG1lbnQqd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24sIGRhdGEgPSBicm9vZCkNCmUzIDwtIGdsbShlZ2dzfnRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uLCBkYXRhID0gYnJvb2QsIGZhbWlseSA9ICJwb2lzc29uIikgICNvdmVyZGlzcGVyc2VkDQpzdW1tYXJ5KGUzKQ0KDQphbm92YShlMSwgZTIsIHRlc3QgPSAiQ2hpc3EiKSAgDQoNCmRyb3AxKGUxLCB0ZXN0ID0gIkNoaXNxIikNCmU0IDwtIHVwZGF0ZShlMSwgLn4uIC1kdXJhdGlvbikNCmRyb3AxKGU0LCB0ZXN0ID0gIkNoaXNxIikNCmU1IDwtIHVwZGF0ZShlNCwgLn4uIC1hbGl2ZSkNCg0KYW5vdmEoZTQsIGU1LCB0ZXN0ID0gIkNoaXNxIikgIA0KDQplYSA8LSBzZXREVChhcy5kYXRhLmZyYW1lKEFub3ZhKGU1KSkpDQplYQ0KDQplbSA8LSBlbW1lYW5zKGU1LCBwYWlyd2lzZSB+ICJ0cmVhdG1lbnQiLCB0eXBlID0gInJlc3BvbnNlIikNCg0KZW1jIDwtIHNldERUKGFzLmRhdGEuZnJhbWUoZW0kY29udHJhc3RzKSkNCmVtYw0KDQplbW0gPC0gc2V0RFQoYXMuZGF0YS5mcmFtZShlbSRlbW1lYW5zKSkNCmVtbQ0KDQplNQ0KDQpnZ3Bsb3QoYnJvb2QsIGFlcyh4ID0gdHJlYXRtZW50LCB5ID0gZWdncywgZmlsbCA9IHRyZWF0bWVudCkpICsNCiAgZ2VvbV9ib3hwbG90KGFscGhhID0gMC44LCB3aWR0aCA9IDAuNSwgb3V0bGllci5zaGFwZSA9IE5BKSArDQogIHNjYWxlX2ZpbGxfdmlyaWRpc19kKCkgKw0KICBsYWJzKHggPSAiVHJlYXRtZW50IiwgeSA9ICJNZWFuIENvdW50IG9mIEVnZ3MiLCB0aXRsZSA9ICJDb3VudCBvZiBFZ2dzIGJ5IFRyZWF0bWVudCIpICsNCiAgdGhlbWVfbWluaW1hbCgpICsNCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gInJpZ2h0IikNCg0KcmFuZ2UoYnJvb2QkZWdncykNCg0KYnJvb2Quc3ViIDwtIGJyb29kW2Jyb29kJGVnZ3MgPD0gNTAsIF0NCg0KcmFuZ2UoYnJvb2Quc3ViJGVnZ3MpDQoNCmdncGxvdChicm9vZC5zdWIsIGFlcyh4ID0gdHJlYXRtZW50LCB5ID0gZWdncywgZmlsbCA9IHRyZWF0bWVudCkpICsNCiAgZ2VvbV9ib3hwbG90KGFscGhhID0gMC44LCB3aWR0aCA9IDAuNSwgb3V0bGllci5zaGFwZSA9IE5BKSArDQogIHNjYWxlX2ZpbGxfdmlyaWRpc19kKCkgKw0KICBsYWJzKHggPSAiVHJlYXRtZW50IiwgeSA9ICJNZWFuIENvdW50IG9mIEVnZ3MiLCB0aXRsZSA9ICJDb3VudCBvZiBFZ2dzIGJ5IFRyZWF0bWVudCIpICsNCiAgdGhlbWVfbWluaW1hbCgpICsNCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gInJpZ2h0IikNCg0KZWdnX3N1bTEgPC0gYnJvb2QgJT4lDQogIGdyb3VwX2J5KHRyZWF0bWVudCkgJT4lDQogIHN1bW1hcmlzZShtZSA9IG1lYW4oZWdncyksDQogICAgICAgICAgICBzZGUgPSBzZChlZ2dzKSwNCiAgICAgICAgICAgIG5lID0gbGVuZ3RoKGVnZ3MpKSAlPiUNCiAgbXV0YXRlKHNlZSA9IHNkZS9zcXJ0KG5lKSkNCmVnZ19zdW0xDQoNCg0KZ2dwbG90KGVnZ19zdW0xLCBhZXMoeCA9IHRyZWF0bWVudCwgeSA9IG1lKSkgKw0KICBnZW9tX2JhcihzdGF0ID0gImlkZW50aXR5IiwgZmlsbCA9ICJzdGVlbGJsdWUiLCBjb2xvciA9ICJibGFjayIpICsNCiAgZ2VvbV9lcnJvcmJhcihhZXMoeW1pbiA9IG1lIC0gc2VlLCB5bWF4ID0gbWUgKyBzZWUpLCB3aWR0aCA9IDAuMiwgcG9zaXRpb24gPSBwb3NpdGlvbl9kb2RnZSgwLjkpKSArDQogIGxhYnMoeCA9ICJUcmVhdG1lbnQiLCB5ID0gIkVnZ3MiLCB0aXRsZSA9ICJBdmVyYWdlIEVnZyBDb3VudCBieSBUcmVhdG1lbnQgKHdpdGggdGhlIG91dGxpZXIgb2YgODcgZWdncyBpbiBUMS41KSIpICsNCiAgdGhlbWVfbWluaW1hbCgpDQoNCmVnZ19zdW0gPC0gYnJvb2Quc3ViICU+JQ0KICBncm91cF9ieSh0cmVhdG1lbnQpICU+JQ0KICBzdW1tYXJpc2UobWUgPSBtZWFuKGVnZ3MpLA0KICAgICAgICAgICAgc2RlID0gc2QoZWdncyksDQogICAgICAgICAgICBuZSA9IGxlbmd0aChlZ2dzKSkgJT4lDQogIG11dGF0ZShzZWUgPSBzZGUvc3FydChuZSkpDQplZ2dfc3VtDQoNCg0KZ2dwbG90KGVnZ19zdW0sIGFlcyh4ID0gdHJlYXRtZW50LCB5ID0gbWUpKSArDQogIGdlb21fYmFyKHN0YXQgPSAiaWRlbnRpdHkiLCBmaWxsID0gInN0ZWVsYmx1ZSIsIGNvbG9yID0gImJsYWNrIikgKw0KICBnZW9tX2Vycm9yYmFyKGFlcyh5bWluID0gbWUgLSBzZWUsIHltYXggPSBtZSArIHNlZSksIHdpZHRoID0gMC4yLCBwb3NpdGlvbiA9IHBvc2l0aW9uX2RvZGdlKDAuOSkpICsNCiAgbGFicyh4ID0gIlRyZWF0bWVudCIsIHkgPSAiRWdncyIsIHRpdGxlID0gIkF2ZXJhZ2UgRWdnIENvdW50IGJ5IFRyZWF0bWVudCAod2l0aG91dCB0aGUgb3V0bGllciBvZiA4NyBlZ2dzIGluIFQxLjUpIikgKw0KICB0aGVtZV9taW5pbWFsKCkNCg0KYGBgDQoNCiMjIyBIb25leSBQb3RzDQoNCmBgYHtyfQ0KDQpocDEgPC0gZ2xtLm5iKGhvbmV5X3BvdCB+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBkdXJhdGlvbiArIGFsaXZlLCBkYXRhID0gYnJvb2QpDQpocDIgPC0gZ2xtLm5iKGhvbmV5X3BvdCB+IHRyZWF0bWVudCAqd2hvbGUubWVhbiArIGR1cmF0aW9uICsgYWxpdmUsIGRhdGE9YnJvb2QpDQpocDMgPC0gZ2xtKGhvbmV5X3BvdCB+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArZHVyYXRpb24sIGRhdGEgPSBicm9vZCwgZmFtaWx5ID0gInBvaXNzb24iKQ0Kc3VtbWFyeShocDMpDQphbm92YShocDEsIGhwMiwgdGVzdCA9IkNoaXNxIikNCg0KcGxvdChocDMpDQpwbG90KGhwMSkNCg0KQUlDKGhwMSwgaHAzKQ0KDQpkcm9wMShocDEsIHRlc3QgPSAiQ2hpc3EiKQ0KZHJvcDEoaHAzLCB0ZXN0ID0gIkNoaXNxIikNCg0KaHA0IDwtIHVwZGF0ZShocDMsIC5+LiAtZHVyYXRpb24pDQpkcm9wMShocDQsIHRlc3QgPSAiQ2hpc3EiKQ0KDQpBbm92YShocDQpDQoNCg0KaGEgPC0gc2V0RFQoYXMuZGF0YS5mcmFtZShBbm92YShocDQpKSkNCmhhDQpocDQNCg0KZ2dwbG90KGJyb29kLCBhZXMoeCA9IHRyZWF0bWVudCwgeSA9IGhvbmV5X3BvdCwgZmlsbCA9IHRyZWF0bWVudCkpICsNCiAgZ2VvbV9ib3hwbG90KGFscGhhID0gMC44LCB3aWR0aCA9IDAuNSwgb3V0bGllci5zaGFwZSA9IE5BKSArDQogIHNjYWxlX2ZpbGxfdmlyaWRpc19kKCkgKw0KICBsYWJzKHggPSAiVHJlYXRtZW50IiwgeSA9ICJNZWFuIENvdW50IG9mIEhvbmV5IFBvdHMiLCB0aXRsZSA9ICJDb3VudCBvZiBIb25leSBQb3RzIGJ5IFRyZWF0bWVudCIpICsNCiAgdGhlbWVfbWluaW1hbCgpICsNCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gInJpZ2h0IikNCg0KaHBfc3VtIDwtIGJyb29kICU+JQ0KICBncm91cF9ieSh0cmVhdG1lbnQpICU+JQ0KICBzdW1tYXJpc2UobWhwID0gbWVhbihob25leV9wb3QpLCANCiAgICAgICAgICAgIHNkaHAgPSBzZChob25leV9wb3QpLA0KICAgICAgICAgICAgbmhwID0gbGVuZ3RoKGhvbmV5X3BvdCkpICU+JQ0KICBtdXRhdGUoc2VocCA9IHNkaHAvc3FydChuaHApKQ0KDQoNCmhwLm1lYW5zIDwtIGVtbWVhbnMob2JqZWN0ID0gaHA0LA0KICAgICAgICAgICAgICAgICAgICAgICAgc3BlY3MgPSAidHJlYXRtZW50IiwNCiAgICAgICAgICAgICAgICAgICAgICAgIGFkanVzdCA9ICJUdWtleSIsDQogICAgICAgICAgICAgICAgICAgICAgICB0eXBlID0gInJlc3BvbnNlIikNCg0KaHBlbSA8LSBzZXREVChhcy5kYXRhLmZyYW1lKGhwLm1lYW5zKSkNCmhwZW0NCg0KaHBhIDwtIHNldERUKGFzLmRhdGEuZnJhbWUocGFpcnMoaHAubWVhbnMpKSkNCmhwYQ0KDQpocC5jbGQubW9kZWwgPC0gY2xkKG9iamVjdCA9IGhwLm1lYW5zLA0KICAgICAgICAgICAgICAgICAgICAgYWRqdXN0ID0gIlR1a2V5IiwNCiAgICAgICAgICAgICAgICAgICAgIExldHRlcnMgPSBsZXR0ZXJzLA0KICAgICAgICAgICAgICAgICAgICAgYWxwaGEgPSAwLjA1KQ0KaHAuY2xkLm1vZGVsDQoNCmdncGxvdChocF9zdW0sIGFlcyh4ID0gdHJlYXRtZW50LCB5ID0gbWhwKSkgKw0KICBnZW9tX2JhcihzdGF0ID0gImlkZW50aXR5IiwgZmlsbCA9ICJzdGVlbGJsdWUiLCBjb2xvciA9ICJibGFjayIpICsNCiAgZ2VvbV9lcnJvcmJhcihhZXMoeW1pbiA9IG1ocCAtIHNlaHAsIHltYXggPSBtaHAgKyBzZWhwKSwgd2lkdGggPSAwLjIsIHBvc2l0aW9uID0gcG9zaXRpb25fZG9kZ2UoMC45KSkgKw0KICBsYWJzKHggPSAiVHJlYXRtZW50IiwgeSA9ICJIb25leSBQb3QgQ291bnQiLCB0aXRsZSA9ICJBdmVyYWdlIEhvbmV5IFBvdHMgYnkgVHJlYXRtZW50IikgKw0KICB0aGVtZV9taW5pbWFsKCkNCg0KYGBgDQoNCg0KIyMjIExhcnZhZSBhbmQgUHVwYWUNCg0KYGBge3J9DQoNCmJyb29kJGxhcnZhZSA8LSBicm9vZCRkZWFkX2xhcnZhZSArIGJyb29kJGxpdmVfbGFydmFlDQpicm9vZCRwdXBhZSA8LSBicm9vZCRkZWFkX2xwICsgYnJvb2QkbGl2ZV9wdXBhZQ0KDQojdG90YWwgY291bnQgb2YgbGFydmFlIA0KYmwxIDwtIGdsbS5uYihsYXJ2YWUgfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiwgZGF0YSA9IGJyb29kKQ0KYmwyIDwtIGdsbS5uYihsYXJ2YWUgfiB0cmVhdG1lbnQqd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24sIGRhdGEgPSBicm9vZCkNCmJsMyA8LSBnbG0obGFydmFlIH4gdHJlYXRtZW50ICsgd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24sIGRhdGEgPSBicm9vZCwgZmFtaWx5ID0gInBvaXNzb24iKSAjb3ZlcmRpc3BlcnNlZA0KYW5vdmEoYmwxLCBibDIsIHRlc3QgPSAiQ2hpc3EiKQ0KQUlDKGJsMSwgYmwyKQ0Kc3VtbWFyeShibDMpDQoNCmRyb3AxKGJsMSwgdGVzdCA9ICJDaGlzcSIpDQpibDQgPC0gdXBkYXRlKGJsMSwgLn4uIC1hbGl2ZSkNCmRyb3AxKGJsNCwgdGVzdCA9ICJDaGlzcSIpDQpibDUgPC0gdXBkYXRlKGJsNCwgLn4uIC1kdXJhdGlvbikNCg0KQW5vdmEoYmw1KQ0KDQoNCiN0b3RhbCBjb3VudCBvZiBwdXBhZSANCmJwMSA8LSBnbG0ubmIocHVwYWUgfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiwgZGF0YSA9IGJyb29kKQ0KYnAyIDwtIGdsbS5uYihwdXBhZSB+IHRyZWF0bWVudCp3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiwgZGF0YSA9IGJyb29kKQ0KYnAzIDwtIGdsbShwdXBhZSB+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uLCBkYXRhID0gYnJvb2QsIGZhbWlseSA9ICJwb2lzc29uIikgI292ZXJkaXNwZXJzZWQNCmFub3ZhKGJwMSwgYnAyLCB0ZXN0ID0gIkNoaXNxIikNCkFJQyhicDEsIGJwMikNCnN1bW1hcnkoYnAzKQ0KDQpkcm9wMShicDEsIHRlc3QgPSAiQ2hpc3EiKQ0KYnA0IDwtIHVwZGF0ZShicDEsIC5+LiAtYWxpdmUpDQpkcm9wMShicDQsIHRlc3QgPSAiQ2hpc3EiKQ0KYnA1IDwtIHVwZGF0ZShicDQsIC5+LiAtZHVyYXRpb24pDQoNCkFub3ZhKGJwNSkNCg0KYGBgDQoNCg0KDQpgYGB7cn0NCiN0b3RhbCBjb3VudCBvZiBkZWFkIGxhcnZhZSANCmJkbDEgPC0gZ2xtLm5iKGRlYWRfbGFydmFlIH4gdHJlYXRtZW50ICsgd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24sIGRhdGEgPSBicm9vZCkNCmJkbDIgPC0gZ2xtLm5iKGRlYWRfbGFydmFlIH4gdHJlYXRtZW50Kndob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uLCBkYXRhID0gYnJvb2QpDQpiZGwzIDwtIGdsbShkZWFkX2xhcnZhZSB+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uLCBkYXRhID0gYnJvb2QsIGZhbWlseSA9ICJwb2lzc29uIikgI292ZXJkaXNwZXJzZWQNCnN1bW1hcnkoYmRsMykNCmFub3ZhKGJkbDEsIGJkbDIsIHRlc3QgPSAiQ2hpc3EiKQ0KQUlDKGJkbDEsIGJkbDIpDQoNCmRyb3AxKGJkbDEsIHRlc3QgPSAiQ2hpc3EiKQ0KYmRsNCA8LSB1cGRhdGUoYmRsMSwgLn4uIC1kdXJhdGlvbikNCmRyb3AxKGJkbDQsIHRlc3QgPSAiQ2hpc3EiKQ0KYmRsNSA8LSB1cGRhdGUoYmRsNCwgLn4uIC1hbGl2ZSkNCg0KQW5vdmEoYmRsNSkNCg0KI3RvdGFsIGNvdW50IG9mIGRlYWQgcHVwYWUNCmJkcDEgPC0gZ2xtLm5iKGRlYWRfcHVwYWUgfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiwgZGF0YSA9IGJyb29kKQ0KYmRwMiA8LSBnbG0ubmIoZGVhZF9wdXBhZSB+IHRyZWF0bWVudCp3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiwgZGF0YSA9IGJyb29kKQ0KYmRwMyA8LSBnbG0oZGVhZF9wdXBhZSB+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uLCBkYXRhID0gYnJvb2QsIGZhbWlseSA9ICJwb2lzc29uIikgI292ZXJkaXNwZXJzZWQNCnN1bW1hcnkoYmRwMykNCmFub3ZhKGJkcDEsIGJkcDIsIHRlc3QgPSAiQ2hpc3EiKQ0KQUlDKGJkcDEsIGJkcDIpDQoNCmRyb3AxKGJkcDEsIHRlc3QgPSAiQ2hpc3EiKQ0KYmRwNCA8LSB1cGRhdGUoYmRwMSwgLn4uIC1kdXJhdGlvbikNCmRyb3AxKGJkcDQsIHRlc3QgPSAiQ2hpc3EiKQ0KDQpBbm92YShiZHA0KQ0KYmRwNA0KDQpiZHBhIDwtIHNldERUKGFzLmRhdGEuZnJhbWUoQW5vdmEoYmRwNCkpKQ0KYmRwYQ0KDQpkcGUgPC0gZW1tZWFucyhiZHA0LCBwYWlyd2lzZSB+IHRyZWF0bWVudCwgdHlwZSA9ICJyZXNwb25zZSIpDQpwYWlycyhkcGUpDQpkcGVtIDwtIHNldERUKGFzLmRhdGEuZnJhbWUoZHBlJGVtbWVhbnMpKQ0KZHBjbSA8LSBzZXREVChhcy5kYXRhLmZyYW1lKGRwZSRjb250cmFzdHMpKQ0KZHBlbQ0KZHBjbQ0KDQpnZ3Bsb3QoYnJvb2QsIGFlcyh4ID0gdHJlYXRtZW50LCB5ID0gZGVhZF9wdXBhZSwgZmlsbCA9IHRyZWF0bWVudCkpICsNCiAgZ2VvbV9ib3hwbG90KGFscGhhID0gMC44LCB3aWR0aCA9IDAuNSkgKw0KICBzY2FsZV9maWxsX3ZpcmlkaXNfZCgpICsNCiAgbGFicyh4ID0gIlRyZWF0bWVudCIsIHkgPSAiTWVhbiBDb3VudCIsIHRpdGxlID0gIkF2ZXJhZ2UgQ291bnQgb2YgRGVhZCBQdXBhZSBieSBUcmVhdG1lbnQiKSArDQogIHRoZW1lX21pbmltYWwoKSArDQogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbiA9ICJyaWdodCIpDQoNCiNPbmUgc2VlbWluZ2x5IG91dGxpZXIgaW4gdHJlYXRtZW50IDINCg0KDQpicm9vZC5zdWIxIDwtIGJyb29kW2Jyb29kJGRlYWRfcHVwYWUgPD0gMzAsIF0NCg0KYmRwMSA8LSBnbG0ubmIoZGVhZF9wdXBhZSB+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uLCBkYXRhID0gYnJvb2Quc3ViMSkNCmJkcDIgPC0gZ2xtLm5iKGRlYWRfcHVwYWUgfiB0cmVhdG1lbnQqd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24sIGRhdGEgPSBicm9vZC5zdWIxKQ0KYmRwMyA8LSBnbG0oZGVhZF9wdXBhZSB+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uLCBkYXRhID0gYnJvb2Quc3ViMSwgZmFtaWx5ID0gInBvaXNzb24iKSAjbm90IHN1cGVyIG92ZXJkaXNwZXJzZWQNCnN1bW1hcnkoYmRwMykNCmFub3ZhKGJkcDEsIGJkcDIsIHRlc3QgPSAiQ2hpc3EiKQ0KQUlDKGJkcDEsIGJkcDIpDQoNCmRyb3AxKGJkcDEsIHRlc3QgPSAiQ2hpc3EiKQ0KYmRwNCA8LSB1cGRhdGUoYmRwMSwgLn4uIC1kdXJhdGlvbikNCmRyb3AxKGJkcDQsIHRlc3QgPSAiQ2hpc3EiKQ0KDQpBbm92YShiZHA0KQ0KYmRwNA0KDQpiZHBhIDwtIHNldERUKGFzLmRhdGEuZnJhbWUoQW5vdmEoYmRwNCkpKQ0KYmRwYQ0KDQpkcGUgPC0gZW1tZWFucyhiZHA0LCBwYWlyd2lzZSB+IHRyZWF0bWVudCwgdHlwZSA9ICJyZXNwb25zZSIpDQpwYWlycyhkcGUpDQpkcGVtIDwtIHNldERUKGFzLmRhdGEuZnJhbWUoZHBlJGVtbWVhbnMpKQ0KZHBjbSA8LSBzZXREVChhcy5kYXRhLmZyYW1lKGRwZSRjb250cmFzdHMpKQ0KZHBlbQ0KZHBjbQ0KDQpnZ3Bsb3QoYnJvb2Quc3ViMSwgYWVzKHggPSB0cmVhdG1lbnQsIHkgPSBkZWFkX3B1cGFlLCBmaWxsID0gdHJlYXRtZW50KSkgKw0KICBnZW9tX2JveHBsb3QoYWxwaGEgPSAwLjgsIHdpZHRoID0gMC41KSArDQogIHNjYWxlX2ZpbGxfdmlyaWRpc19kKCkgKw0KICBsYWJzKHggPSAiVHJlYXRtZW50IiwgeSA9ICJNZWFuIENvdW50IiwgdGl0bGUgPSAiQXZlcmFnZSBDb3VudCBvZiBEZWFkIFB1cGFlIGJ5IFRyZWF0bWVudCIpICsNCiAgdGhlbWVfbWluaW1hbCgpICsNCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gInJpZ2h0IikNCg0KZGVhZHB1cG1lYW5zIDwtIGVtbWVhbnMob2JqZWN0ID0gYmRwNCwgDQogICAgICAgICAgICAgICAgICAgICAgICAgIHNwZWNzID0gInRyZWF0bWVudCIsDQogICAgICAgICAgICAgICAgICAgICAgICAgIGFkanVzdCA9ICJUdWtleSIsDQogICAgICAgICAgICAgICAgICAgICAgICAgIHR5cGUgPSAicmVzcG9uc2UiKQ0KDQpkZWFkcHVwLmNsZC5tb2RlbCA8LSBjbGQob2JqZWN0ID0gZGVhZHB1cG1lYW5zLA0KICAgICAgICAgICAgICAgICAgICAgYWRqdXN0ID0gIlR1a2V5IiwNCiAgICAgICAgICAgICAgICAgICAgIExldHRlcnMgPSBsZXR0ZXJzLA0KICAgICAgICAgICAgICAgICAgICAgYWxwaGEgPSAwLjA1KQ0KZGVhZHB1cC5jbGQubW9kZWwNCg0KZGVhZHB1cC5tZWFucyA8LSBhcy5kYXRhLmZyYW1lKGRlYWRwdXBtZWFucykNCg0KZHBfbWF4IDwtIGJyb29kLnN1YjEgJT4lDQogIGdyb3VwX2J5KHRyZWF0bWVudCkgJT4lDQogIHN1bW1hcml6ZShtYXhkcCA9IG1heCgoZGVhZF9wdXBhZSkpKQ0KDQoNCmRwc3VtIDwtIGJyb29kLnN1YjEgJT4lDQogIGdyb3VwX2J5KHRyZWF0bWVudCkgJT4lDQogIHN1bW1hcmlzZShtZWFuID0gbWVhbihkZWFkX3B1cGFlKSwgDQogICAgICAgICAgICBzZCA9IHNkKGRlYWRfcHVwYWUpLA0KICAgICAgICAgICAgbiA9IGxlbmd0aChkZWFkX3B1cGFlKSkgJT4lDQogIG11dGF0ZShzZSA9IHNkL3NxcnQobikpDQpkcHN1bQ0KDQpgYGANCg0KIyMjIyBjYmluZCBsYXJ2YWUgYW5kIHB1cGFlIA0KDQpgYGB7ciwgZmlnLndpZHRoPSAxNCwgZmlnLmhlaWdodD0gMTB9DQptb2QxIDwtIGdsbShjYmluZChhbGl2ZV9scCwgZGVhZF9scCkgfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiwgZGF0YSA9IGJyb29kLCBmYW1pbHkgPSBiaW5vbWlhbCgibG9naXQiKSkNCnN1bW1hcnkobW9kMSkNCnFxbm9ybShyZXNpZChtb2QxKSk7cXFsaW5lKHJlc2lkKG1vZDEpKQ0KQW5vdmEobW9kMSkNCnBsb3QobW9kMSkNCmRyb3AxKG1vZDEsIHRlc3QgPSAiQ2hpc3EiKQ0KDQptb2QyIDwtIHVwZGF0ZShtb2QxLCAufi4gLWR1cmF0aW9uKQ0KZHJvcDEobW9kMiwgdGVzdCA9ICJDaGlzcSIpDQptb2QzIDwtIHVwZGF0ZShtb2QyLCAufi4gLXdob2xlLm1lYW4pDQpkcm9wMShtb2QzLCB0ZXN0ID0gIkNoaXNxIikNCkFub3ZhKG1vZDMpDQoNCm1lIDwtIGVtbWVhbnMobW9kMywgcGFpcndpc2V+dHJlYXRtZW50LCB0eXBlID0gInJlc3BvbnNlIikNCg0KbWVtIDwtIHNldERUKGFzLmRhdGEuZnJhbWUobWUkZW1tZWFucykpDQptY20gPC0gc2V0RFQoYXMuZGF0YS5mcmFtZShtZSRjb250cmFzdHMpKQ0KbWVtDQptY20NCmFscCA8LSBzZXREVChhcy5kYXRhLmZyYW1lKEFub3ZhKG1vZDMpKSkNCmFscA0KDQptZW0kcGxvdCA8LSBtZW0kcHJvYiArIG1lbSRTRQ0KDQptb2QzDQoNCnN1bSA8LSBicm9vZCAlPiUNCiAgZ3JvdXBfYnkodHJlYXRtZW50KSAlPiUNCiAgc3VtbWFyaXNlKG1lYW4ubCA9IG1lYW4oYWxpdmVfbHApLA0KICAgICAgICAgICAgbWVhbi5kID0gbWVhbihkZWFkX2xwKSkNCnN1bSRwcm9iLmFsaXZlIDwtIChzdW0kbWVhbi5sKS8oc3VtJG1lYW4uZCArIHN1bSRtZWFuLmwpDQpzdW0NCg0KY2xkYiA8LSBjbGQob2JqZWN0ID0gbWUsDQogICAgICAgICAgICAgICAgICAgICBhZGp1c3QgPSAiVHVrZXkiLA0KICAgICAgICAgICAgICAgICAgICAgTGV0dGVycyA9IGxldHRlcnMsDQogICAgICAgICAgICAgICAgICAgICBhbHBoYSA9IDAuMDUpDQpjbGRiDQoNCg0KZ2dwbG90KG1lbSwgYWVzKHggPSB0cmVhdG1lbnQsIHkgPSBwcm9iLCBmaWxsID0gdHJlYXRtZW50KSkgKw0KICBnZW9tX2JhcihzdGF0ID0gImlkZW50aXR5IiwgY29sb3IgPSAiYmxhY2siKSArDQogIHNjYWxlX2ZpbGxfdmlyaWRpc19kKCkgKw0KICBnZW9tX2Vycm9yYmFyKGFlcyh5bWluID0gcHJvYiAtIFNFLCB5bWF4ID0gcHJvYiArIFNFKSwgd2lkdGggPSAwLjIsIHBvc2l0aW9uID0gcG9zaXRpb25fZG9kZ2UoMC45KSkgKw0KICBsYWJzKHggPSAiVHJlYXRtZW50IiwgeSA9ICJQcm9iYWJpbGl0eSIsIHRpdGxlID0gIlByb2JhYmlsaXR5IG9mIEJyb29kIEJlaW5nIEFsaXZlIFVwb24gRGlzc2VjdGlvbiIpICsNCiAgIHRoZW1lX2NsYXNzaWMoYmFzZV9zaXplID0gMzApICsNCiAgICBjb29yZF9jYXJ0ZXNpYW4oeWxpbT1jKDAuNSwxKSkgKw0KICBhbm5vdGF0ZShnZW9tID0gInRleHQiLCANCiAgICAgICAgICB4ID0gMywgeSA9IDEgLA0KICAgICAgICAgIGxhYmVsID0gIlAgPCAwLjAwMSIsDQogICAgICAgICAgc2l6ZSA9IDgpICsNCiAgYW5ub3RhdGUoZ2VvbSA9ICJ0ZXh0IiwNCiAgICAgICAgICAgeCA9IGMoMSwgMiwgMywgNCwgNSksDQogICAgICAgICAgIHkgPSBjKG1lbSRwbG90ICsgMC4wNSksDQogICAgICAgICAgIGxhYmVsID0gYygiYyIsICJhIiwgImFiIiwgImFiIiwgImJjIiksDQogICAgICAgICAgIHNpemUgPSA4KSArDQogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbiA9ICAibm9uZSIpDQoNCm1jbQ0KDQpgYGANCg0KDQojIyMgRHJvbmUgQ291bnQgDQoNCmBgYHtyfQ0KZGMxIDwtIGdsbS5uYihjb3VudCB+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uICsgcmVwbGljYXRlLCBkYXRhID0gZHJvbmUuY2UpDQpkYzIgPC0gZ2xtLm5iKGNvdW50IH4gdHJlYXRtZW50Kndob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uICsgcmVwbGljYXRlLCBkYXRhID0gZHJvbmUuY2UpDQpkYzMgPC0gZ2xtKGNvdW50IH4gdHJlYXRtZW50ICsgd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24gKyByZXBsaWNhdGUsIGRhdGEgPSBkcm9uZS5jZSwgZmFtaWx5ID0gInBvaXNzb24iKQ0Kc3VtbWFyeShkYzMpICNvdmVyZGlzcGVyc2VkIA0KDQphbm92YShkYzEsIGRjMiwgdGVzdCA9ICJDaGlzcSIpDQpBSUMoZGMxLCBkYzIpDQoNCmRyb3AxKGRjMSwgdGVzdCA9ICJDaGlzcSIpDQpkYzQgPC0gdXBkYXRlKGRjMSwgLn4uIC1kdXJhdGlvbikNCmRyb3AxKGRjNCwgdGVzdCA9ICJDaGlzcSIpDQpBbm92YShkYzQpDQpwbG90KGRjNCkNCg0KDQpzdW0gPC0gZHJvbmUuY2UgJT4lDQogIGdyb3VwX2J5KHRyZWF0bWVudCkgJT4lDQogIHN1bW1hcmlzZShtZWFuID0gbWVhbihjb3VudCksIA0KICAgICAgICAgICAgc2QgPSBzZChjb3VudCksDQogICAgICAgICAgICBuID0gbGVuZ3RoKGNvdW50KSkgJT4lDQogIG11dGF0ZShzZSA9IHNkL3NxcnQobikpDQpzdW0NCg0KZ2dwbG90KHN1bSwgYWVzKHggPSB0cmVhdG1lbnQsIHkgPSBtZWFuKSkgKw0KICBnZW9tX2JhcihzdGF0ID0gImlkZW50aXR5IiwgZmlsbCA9ICJzdGVlbGJsdWUiLCBjb2xvciA9ICJibGFjayIpICsNCiAgZ2VvbV9lcnJvcmJhcihhZXMoeW1pbiA9IG1lYW4gLSBzZSwgeW1heCA9IG1lYW4gKyBzZSksIHdpZHRoID0gMC4yLCBwb3NpdGlvbiA9IHBvc2l0aW9uX2RvZGdlKDAuOSkpICsNCiAgbGFicyh4ID0gIlRyZWF0bWVudCIsIHkgPSAiRHJvbmUgQ291bnQiLCB0aXRsZSA9ICJBdmVyYWdlIERyb25lcyBQcm9kdWNlZCBieSBUcmVhdG1lbnQiKSArDQogIHRoZW1lX21pbmltYWwoKQ0KDQoNCmRjNA0KZGEgPC0gc2V0RFQoYXMuZGF0YS5mcmFtZShBbm92YShkYzQpKSkNCmRhDQoNCmVtZGMgPC0gZW1tZWFucyhkYzQsIHBhaXJ3aXNlIH4gInRyZWF0bWVudCIsIHR5cGUgPSAicmVzcG9uc2UiKQ0KZW0gPC0gc2V0RFQoYXMuZGF0YS5mcmFtZShlbWRjJGVtbWVhbnMpKQ0KZW1jIDwtIHNldERUKGFzLmRhdGEuZnJhbWUoZW1kYyRjb250cmFzdHMpKQ0KZW0NCmVtYw0KYGBgDQoNCg0KIyMjIERyb25lIEVtZXJnZSBUaW1lDQoNCmBgYHtyfQ0KDQpkcm9uZS5jZS5uYSA8LSBuYS5vbWl0KGRyb25lLmNlKQ0KDQpkcm9uZS5jZS5jb2wgPC0gbG0oZW1lcmdlfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyByZXBsaWNhdGUgKyBtZWFuLmRvc2UgKyBxcm8sIGRhdGEgPSBkcm9uZS5jZS5uYSkNCmRyb3AxKGRyb25lLmNlLmNvbCwgdGVzdCA9ICJDaGlzcSIpDQoNCmQxIDwtIHVwZGF0ZShkcm9uZS5jZS5jb2wsIC5+LiAtcXJvKQ0KdmlmKGQxKQ0KZDIgPC0gdXBkYXRlKGQxLCAufi4gLW1lYW4uZG9zZSkNCnZpZihkMikNCmQzIDwtIHVwZGF0ZShkMiwgLn4uIC1yZXBsaWNhdGUpDQp2aWYoZDMpDQoNCmRlMSA8LSBnbG0ubmIoZW1lcmdlIH4gdHJlYXRtZW50ICsgd2hvbGUubWVhbiArIGFsaXZlLCBkYXRhID0gZHJvbmUuY2UubmEpDQpzdW1tYXJ5KGRlMSkNCmRlMiA8LSBnbG0ubmIoZW1lcmdlIH4gdHJlYXRtZW50Kndob2xlLm1lYW4gKyBhbGl2ZSwgZGF0YSA9IGRyb25lLmNlLm5hKQ0Kc3VtbWFyeShkZTEpDQpkZTIgPC0gZ2xtKGVtZXJnZSB+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSwgZGF0YSA9IGRyb25lLmNlLm5hLCBmYW1pbHkgPSAicG9pc3NvbiIpDQpzdW1tYXJ5KGRlMikgI3VuZGVyZGlzcGVyc2VkIA0KDQpBSUMoZGUxLCBkZTIpDQoNCmRyb3AxKGRlMSwgdGVzdCA9IkNoaXNxIikNCmRlMiA8LSB1cGRhdGUoZGUxLCAufi4gLWFsaXZlKQ0KZHJvcDEoZGUyLCB0ZXN0ID0gIkNoaXNxIikNCg0KZ2dwbG90KGRyb25lLmNlLm5hLCBhZXMoeCA9IHRyZWF0bWVudCwgeSA9IGVtZXJnZSwgZmlsbCA9IHRyZWF0bWVudCkpICsNCiAgZ2VvbV9ib3hwbG90KGFscGhhID0gMC44LCB3aWR0aCA9IDAuNSwgb3V0bGllci5zaGFwZSA9IE5BKSArDQogIHNjYWxlX2ZpbGxfdmlyaWRpc19kKCkgKw0KICBsYWJzKHggPSAiVHJlYXRtZW50IiwgeSA9ICJNZWFuIENvdW50IG9mIERheXMiLCB0aXRsZSA9ICJEYXlzIFVudGlsIEZpcnN0IERyb25lIEVtZXJnZW5jZSBieSBUcmVhdG1lbnQiKSArDQogIHRoZW1lX21pbmltYWwoKSArDQogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbiA9ICJyaWdodCIpDQoNCg0KcGxvdChkZTIpDQoNCkFub3ZhKGRlMikNCg0KZWEgPC0gc2V0RFQoYXMuZGF0YS5mcmFtZShBbm92YShkZTIpKSkNCmVhDQoNCmRlMg0KDQplZ20gPC0gZW1tZWFucyhkZTIsIHBhaXJ3aXNlIH4gdHJlYXRtZW50LCB0eXBlID0gInJlc3BvbnNlIikNCmVnIDwtIHNldERUKGFzLmRhdGEuZnJhbWUoZWdtJGVtbWVhbnMpKQ0KZWcNCmNnIDwtIHNldERUKGFzLmRhdGEuZnJhbWUoZWdtJGNvbnRyYXN0cykpDQpjZw0KDQplbV9zdW0gPC0gZHJvbmUuY2UubmEgJT4lDQogIGdyb3VwX2J5KHRyZWF0bWVudCkgJT4lDQogIHN1bW1hcmlzZShtZWFuID0gbWVhbihlbWVyZ2UpLA0KICAgICAgICAgICAgc2QgPSBzZChlbWVyZ2UpLA0KICAgICAgICAgICAgbiA9IGxlbmd0aChlbWVyZ2UpKSAlPiUNCiAgbXV0YXRlKHNlID0gc2Qvc3FydChuKSkNCmVtX3N1bQ0KDQpnZ3Bsb3QoZW1fc3VtLCBhZXMoeCA9IHRyZWF0bWVudCwgeSA9IG1lYW4pKSArDQogIGdlb21fYmFyKHN0YXQgPSAiaWRlbnRpdHkiLCBmaWxsID0gInN0ZWVsYmx1ZSIsIGNvbG9yID0gImJsYWNrIikgKw0KICBnZW9tX2Vycm9yYmFyKGFlcyh5bWluID0gbWVhbiAtIHNlLCB5bWF4ID0gbWVhbiArIHNlKSwgd2lkdGggPSAwLjIsIHBvc2l0aW9uID0gcG9zaXRpb25fZG9kZ2UoMC45KSkgKw0KICBsYWJzKHggPSAiVHJlYXRtZW50IiwgeSA9ICJEYXlzIiwgdGl0bGUgPSAiQXZlcmFnZSBUaW1lIFVudGlsIEZpcnN0IERyb25lIEVtZXJnZW5jZSBieSBUcmVhdG1lbnQiKSArDQogIHRoZW1lX21pbmltYWwoKSANCg0KZ2dwbG90KGRyb25lLmNlLm5hLCBhZXMoeCA9IHdob2xlLm1lYW4sIHkgPSBlbWVyZ2UsIGNvbG9yID0gdHJlYXRtZW50KSkgKw0KICBnZW9tX3BvaW50KHNpemUgPSAzKSArDQogIGxhYnMoeCA9ICJBdmVyYWdlIFBvbGxlbiBDb25zdW1lZChnKSIsIHkgPSAiRGF5cyIsIHRpdGxlID0gIkRheXMgVW50aWwgRmlyc3QgRHJvbmUgRW1lcmdlbmNlIGJ5IEF2ZXJhZ2UgUG9sbGVuIENvbnN1bWVkIikgKw0KICB0aGVtZV9taW5pbWFsKCkgKw0KICBzY2FsZV9jb2xvcl92aXJpZGlzX2QoKSArDQogIGdlb21fc21vb3RoKG1ldGhvZCA9ICJsbSIsIGNvbG9yID0gInBpbmsiLCBzaXplID0gMSkgDQoNCg0KYGBgDQoNCg0KIyMjIERyb25lIFJhZGlhbCBDZWxsIA0KDQoNCmBgYHtyLCBmaWcud2lkdGg9IDEzLCBmaWcuaGVpZ2h0PSAxMH0NCnNoYXBpcm8udGVzdChkcm9uZS5oJHJhZGlhbCkNCm4gPC0gaXMubmEoZHJvbmUuaCRyYWRpYWwpDQp1bmlxdWUobikNCmRyb25lLnJhZCA8LSBuYS5vbWl0KGRyb25lLmgpDQoNCmdncGxvdChkcm9uZS5yYWQsIGFlcyh4PXJhZGlhbCwgZmlsbCA9IHRyZWF0bWVudCkpICsNCiAgZ2VvbV9oaXN0b2dyYW0ocG9zaXRpb24gPSAiaWRlbnRpdHkiLCBiaW53aWR0aCA9IDAuMDUgLGNvbD1JKCJibGFjayIpKSArDQogIHNjYWxlX2ZpbGxfbWFudWFsKHZhbHVlcyA9IGMoImdyYXk5MCIsICJncmF5NzAiLCAiZ3JheTUwIiAsICJncmF5MzAiLCJncmF5MTAiKSwNCiAgICAgICAgICAgICAgICAgICAgbmFtZSA9ICJQcmlzdGluZSBMZXZlbCIsDQogICAgICAgICAgICAgICAgICAgIGxhYmVscyA9IGMoIlRyZWF0bWVudCAxIChjb250cm9sKSIsICJUcmVhdG1lbnQgMiIsIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJUcmVhdG1lbnQgMyIsICJUcmVhdG1lbnQgNCIsICJUcmVhdG1lbnQgNSIpKSArDQogIGdndGl0bGUoIkRyb25lIFJhZGlhbCBDZWxsIExlbmd0aChtbSkiKSArDQogIGxhYnMoeSA9ICJDb3VudCIsIHggPSAiTGVuZ3RoIikNCnNoYXBpcm8udGVzdChkcm9uZS5yYWQkcmFkaWFsKQ0KDQpkcjEgPC0gbG1lcihyYWRpYWwgfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiArIHJlcGxpY2F0ZSArICgxfGNvbG9ueSksIGRhdGEgPSBkcm9uZS5yYWQpDQpzdW1tYXJ5KGRyMSkNCmRyMiA8LSBsbWVyKHJhZGlhbCB+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uICsgKDF8Y29sb255KSwgZGF0YSA9IGRyb25lLnJhZCkNCmFub3ZhKGRyMSwgZHIyLCB0ZXN0ID0gIkNoaXNxIikNCmRyMyA8LSBsbWVyKHJhZGlhbCB+IHRyZWF0bWVudCp3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiArIHJlcGxpY2F0ZSArICgxfGNvbG9ueSksIGRhdGEgPSBkcm9uZS5yYWQpDQphbm92YShkcjEsIGRyMykNCg0KZHJvcDEoZHIxLCB0ZXN0ID0gIkNoaXNxIikNCmRyNCA8LSB1cGRhdGUoZHIxLCAufi4gLWR1cmF0aW9uKQ0KZHJvcDEoZHI0LCB0ZXN0ID0gIkNoaXNxIikNCmRyNSA8LSB1cGRhdGUoZHI0LCAufi4gLXdob2xlLm1lYW4pDQpkcm9wMShkcjUsIHRlc3QgPSAiQ2hpc3EiKQ0KZHI2IDwtIHVwZGF0ZShkcjUsIC5+LiAtcmVwbGljYXRlKQ0KYW5vdmEoZHI1LCBkcjYpDQoNCnBsb3QoZHI1KQ0KcXFub3JtKHJlc2lkKGRyNSkpO3FxbGluZShyZXNpZChkcjUpKQ0KcGxvdChkcjYpDQpxcW5vcm0ocmVzaWQoZHI2KSk7cXFsaW5lKHJlc2lkKGRyNikpICAgICNrZWVwIGRyNQ0KDQoNCmRyNQ0KQW5vdmEoZHI1KQ0KZHJhIDwtIHNldERUKGFzLmRhdGEuZnJhbWUoQW5vdmEoZHI1KSkpDQpkcmENCg0KZHJlIDwtIGVtbWVhbnMoZHI1LCBwYWlyd2lzZSB+IHRyZWF0bWVudCwgdHlwZSA9ICJyZXNwb25zZSIpDQplZHIgPC0gc2V0RFQoYXMuZGF0YS5mcmFtZShkcmUkZW1tZWFucykpDQplZHINCmNkciA8LSBzZXREVChhcy5kYXRhLmZyYW1lKGRyZSRjb250cmFzdHMpKQ0KY2RyDQoNCnN1bSA8LSBkcm9uZS5yYWQgJT4lDQogIGdyb3VwX2J5KHRyZWF0bWVudCkgJT4lDQogIHN1bW1hcmlzZShtZWFuID0gbWVhbihyYWRpYWwpLA0KICAgICAgICAgICAgc2QgPSBzZChyYWRpYWwpLA0KICAgICAgICAgICAgbiA9IGxlbmd0aChyYWRpYWwpKSAlPiUNCiAgbXV0YXRlKHNlID0gc2Qvc3FydChuKSkNCg0KZWRyJHBsb3QgPC0gKGVkciRlbW1lYW4gKyBlZHIkU0UpICswLjAyDQoNCmVkcg0KDQpyYWQuY2xkIDwtIGNsZChvYmplY3QgPWRyZSwNCiAgICAgICAgICAgICAgICAgICAgIGFkanVzdCA9ICJUdWtleSIsDQogICAgICAgICAgICAgICAgICAgICBMZXR0ZXJzID0gbGV0dGVycywNCiAgICAgICAgICAgICAgICAgICAgIGFscGhhID0gMC4wNSkNCg0KcmFkLmNsZA0KDQpnZ3Bsb3QoZWRyLCBhZXMoeCA9IHRyZWF0bWVudCwgeSA9IGVtbWVhbiwgZmlsbCA9IHRyZWF0bWVudCkpICsNCiAgZ2VvbV9iYXIoc3RhdCA9ICJpZGVudGl0eSIsIGNvbG9yID0gImJsYWNrIikgKw0KICBzY2FsZV9maWxsX3ZpcmlkaXNfZCgpICsNCiAgZ2VvbV9lcnJvcmJhcihhZXMoeW1pbiA9IGVtbWVhbiAtIFNFLCB5bWF4ID0gZW1tZWFuICsgU0UpLCB3aWR0aCA9IDAuMiwgcG9zaXRpb24gPSBwb3NpdGlvbl9kb2RnZSgwLjkpKSArDQogIGxhYnMoeCA9ICJUcmVhdG1lbnQiLCB5ID0gIlJhZGlhbCBDZWxsIExlbmd0aChtbSkiLCB0aXRsZSA9ICJBdmVyYWdlIERyb25lIFJhZGlhbCBDZWxsIExlbmd0aCBieSBUcmVhdG1lbnQiKSArDQogICB0aGVtZV9jbGFzc2ljKGJhc2Vfc2l6ZSA9IDMwKSArDQogICAgY29vcmRfY2FydGVzaWFuKHlsaW09YygyLDIuNDUpKSArDQogIGFubm90YXRlKGdlb20gPSAidGV4dCIsIA0KICAgICAgICAgIHggPSAzLCB5ID0gMi40NSwNCiAgICAgICAgICBsYWJlbCA9ICJQID0gMC4wMyIsDQogICAgICAgICAgc2l6ZSA9IDgpICsNCiAgYW5ub3RhdGUoZ2VvbSA9ICJ0ZXh0IiwNCiAgICAgICAgICAgeCA9IGMoMSwgMiwgMywgNCwgNSksDQogICAgICAgICAgIHkgPSBjKGVkciRwbG90KSwNCiAgICAgICAgICAgbGFiZWwgPSBjKCJhYiIsICJhYiIsICJhIiwgImIiLCAiYWIiKSwNCiAgICAgICAgICAgc2l6ZSA9IDgpICsNCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gICJub25lIikNCg0KYGBgDQoNCiMjIyBEcm9uZSBEcnkgV2VpZ2h0DQoNCmBgYHtyLCBmaWcud2lkdGg9IDEzLCBmaWcuaGVpZ2h0PSAxMH0NCnNoYXBpcm8udGVzdChkcm9uZS5yYWQkZHJ5X3dlaWdodCkNCg0KZ2dwbG90KGRyb25lLnJhZCwgYWVzKHg9ZHJ5X3dlaWdodCwgZmlsbCA9IHRyZWF0bWVudCkpICsNCiAgZ2VvbV9oaXN0b2dyYW0ocG9zaXRpb24gPSAiaWRlbnRpdHkiLCBiaW53aWR0aCA9IDAuMDAxICxjb2w9SSgiYmxhY2siKSkgKw0KICBzY2FsZV9maWxsX21hbnVhbCh2YWx1ZXMgPSBjKCJncmF5OTAiLCAiZ3JheTcwIiwgImdyYXk1MCIgLCAiZ3JheTMwIiwiZ3JheTEwIiksDQogICAgICAgICAgICAgICAgICAgIG5hbWUgPSAiUHJpc3RpbmUgTGV2ZWwiLA0KICAgICAgICAgICAgICAgICAgICBsYWJlbHMgPSBjKCJUcmVhdG1lbnQgMSAoY29udHJvbCkiLCAiVHJlYXRtZW50IDIiLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiVHJlYXRtZW50IDMiLCAiVHJlYXRtZW50IDQiLCAiVHJlYXRtZW50IDUiKSkgKw0KICBnZ3RpdGxlKCJEcm9uZSBSYWRpYWwgQ2VsbCBMZW5ndGgobW0pIikgKw0KICBsYWJzKHkgPSAiQ291bnQiLCB4ID0gIkxlbmd0aCIpDQoNCmRkMSA8LSBsbWVyKGRyeV93ZWlnaHQgfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiArIHJlcGxpY2F0ZSArICgxfGNvbG9ueSksIGRhdGEgPSBkcm9uZS5yYWQpDQpkZDIgPC0gbG1lcihkcnlfd2VpZ2h0IH4gdHJlYXRtZW50Kndob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uICsgcmVwbGljYXRlICsgKDF8Y29sb255KSwgZGF0YSA9IGRyb25lLnJhZCkNCmRkMyA8LSBsbWVyKGRyeV93ZWlnaHQgfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyBkdXJhdGlvbiArICgxfGNvbG9ueSksIGRhdGEgPSBkcm9uZS5yYWQpDQpkZDYgPC0gbG1lcihkcnlfd2VpZ2h0IH4gdHJlYXRtZW50ICsgd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24gKyBxcm8gKyAoMXxjb2xvbnkpLCBkYXRhID0gZHJvbmUucmFkKQ0KYW5vdmEoZGQxLCBkZDYpDQoNCmFub3ZhKGRkMSwgZGQyKQ0KYW5vdmEoZGQxLCBkZDMpDQoNCmRyb3AxKGRkMywgdGVzdCA9ICJDaGlzcSIpDQpkZDQgPC0gdXBkYXRlKGRkMywgLn4uIC1kdXJhdGlvbikNCmRyb3AxKGRkNCwgdGVzdCA9ICJDaGlzcSIpDQpkZDUgPC0gdXBkYXRlKGRkNCwgLn4uIC13aG9sZS5tZWFuKQ0KYW5vdmEoZGQ0LCBkZDUpDQoNCmRyb3AxKGRkNiwgdGVzdCA9ICJDaGlzcSIpDQpkZDcgPC0gdXBkYXRlKGRkNiwgLn4uIC1kdXJhdGlvbikNCmRyb3AxKGRkNywgdGVzdCA9ICJDaGlzcSIpDQpkZDggPC0gdXBkYXRlKGRkNywgLn4uIC13aG9sZS5tZWFuKQ0KYW5vdmEoZGQ3LCBkZDgpDQoNCg0KYW5vdmEoZGQ1LCBkZDgpICAjd2l0aCBvbmx5IG9uZSBkaWZmZXJlbmNlIGluIHZhcmlhYmxlcyAocXJvKSBkZDUgaXMgc2lnbmlmaWNhbnRseSBiZXR0ZXIgc28gd2Ugd2lsbCBzdGljayB3aXRoIGxlYXZpbmcgb3V0IHFybyANCg0KcXFub3JtKHJlc2lkKGRkNSkpO3FxbGluZShyZXNpZChkZDUpKQ0KcXFub3JtKHJlc2lkKGRkOCkpO3FxbGluZShyZXNpZChkZDgpKQ0KDQpkZDUNCkFub3ZhKGRkNSkNCmRkYSA8LSBzZXREVChhcy5kYXRhLmZyYW1lKEFub3ZhKGRkNSkpKQ0KZGRhDQoNCmRlbSA8LSBlbW1lYW5zKGRkNSwgcGFpcndpc2UgfiB0cmVhdG1lbnQsIHR5cGUgPSAicmVzcG9uc2UiKQ0KZGUgPC0gc2V0RFQoYXMuZGF0YS5mcmFtZShkZW0kZW1tZWFucykpDQpjZSA8LSBzZXREVChhcy5kYXRhLmZyYW1lKGRlbSRjb250cmFzdHMpKQ0KZGUNCmNlDQoNCmRlJHBsb3QgPC0gZGUkZW1tZWFuICsgZGUkU0UNCg0KDQpkZC5jbGQgPC0gY2xkKG9iamVjdCA9ZGVtLA0KICAgICAgICAgICAgICAgICAgICAgYWRqdXN0ID0gIlR1a2V5IiwNCiAgICAgICAgICAgICAgICAgICAgIExldHRlcnMgPSBsZXR0ZXJzLA0KICAgICAgICAgICAgICAgICAgICAgYWxwaGEgPSAwLjA1KQ0KDQpkZC5jbGQNCg0KZGUNCg0KZ2dwbG90KGRlLCBhZXMoeCA9IHRyZWF0bWVudCwgeSA9IGVtbWVhbiwgZmlsbCA9IHRyZWF0bWVudCkpICsNCiAgZ2VvbV9iYXIoc3RhdCA9ICJpZGVudGl0eSIsIGNvbG9yID0gImJsYWNrIikgKw0KICBzY2FsZV9maWxsX3ZpcmlkaXNfZCgpICsNCiAgZ2VvbV9lcnJvcmJhcihhZXMoeW1pbiA9IGVtbWVhbiAtIFNFLCB5bWF4ID0gZW1tZWFuICsgU0UpLCB3aWR0aCA9IDAuMiwgcG9zaXRpb24gPSBwb3NpdGlvbl9kb2RnZSgwLjkpKSArDQogIGxhYnMoeCA9ICJUcmVhdG1lbnQiLCB5ID0gIkRyeSBXZWlnaHQoZykiLCB0aXRsZSA9ICJBdmVyYWdlIERyb25lIERyeSBXZWlnaHQgYnkgVHJlYXRtZW50IikgKw0KICAgdGhlbWVfY2xhc3NpYyhiYXNlX3NpemUgPSAzMCkgKw0KICAgIGNvb3JkX2NhcnRlc2lhbih5bGltPWMoMC4wMiwgMC4wNDIpKSArDQogIGFubm90YXRlKGdlb20gPSAidGV4dCIsIA0KICAgICAgICAgIHggPSAzLCB5ID0gMC4wNDI1ICwNCiAgICAgICAgICBsYWJlbCA9ICJQIDwgMC4wMSIsDQogICAgICAgICAgc2l6ZSA9IDgpICsNCiAgYW5ub3RhdGUoZ2VvbSA9ICJ0ZXh0IiwNCiAgICAgICAgICAgeCA9IGMoMSwgMiwgMywgNCwgNSksDQogICAgICAgICAgIHkgPSBjKGRlJHBsb3QrMC4wMDEpLA0KICAgICAgICAgICBsYWJlbCA9IGMoImIiLCAiYWIiLCAiYSIsICJhYiIsICJhYiIpLA0KICAgICAgICAgICBzaXplID0gOCkgKw0KICB0aGVtZShsZWdlbmQucG9zaXRpb24gPSAgIm5vbmUiKQ0KDQpgYGANCg0KDQojIyMgRHJvbmUgUmVsYXRpdmUgRmF0DQoNCmBgYHtyLCBmaWcud2lkdGg9IDE0LCBmaWcuaGVpZ2h0PSA4fQ0KDQoNCnNoYXBpcm8udGVzdChkcm9uZS5yYWQkcmVsYXRpdmVfZmF0KQ0KDQpkcm9uZS5yYWQkbG9ncmYgPC0gbG9nKGRyb25lLnJhZCRyZWxhdGl2ZV9mYXQpDQoNCnNoYXBpcm8udGVzdChkcm9uZS5yYWQkbG9ncmYpDQoNCmdncGxvdChkcm9uZS5yYWQsIGFlcyh4PXJlbGF0aXZlX2ZhdCwgZmlsbCA9IHRyZWF0bWVudCkpICsNCiAgZ2VvbV9oaXN0b2dyYW0ocG9zaXRpb24gPSAiaWRlbnRpdHkiLCBiaW53aWR0aCA9IDAuMDAwMSAsY29sPUkoImJsYWNrIikpICsNCiAgc2NhbGVfZmlsbF9tYW51YWwodmFsdWVzID0gYygiZ3JheTkwIiwgImdyYXk3MCIsICJncmF5NTAiICwgImdyYXkzMCIsImdyYXkxMCIpLA0KICAgICAgICAgICAgICAgICAgICBuYW1lID0gIlByaXN0aW5lIExldmVsIiwNCiAgICAgICAgICAgICAgICAgICAgbGFiZWxzID0gYygiVHJlYXRtZW50IDEgKGNvbnRyb2wpIiwgIlRyZWF0bWVudCAyIiwgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIlRyZWF0bWVudCAzIiwgIlRyZWF0bWVudCA0IiwgIlRyZWF0bWVudCA1IikpICsNCiAgZ2d0aXRsZSgiRHJvbmUgUmVsYXRpdmUgRmF0IikgKw0KICBsYWJzKHkgPSAiQ291bnQiLCB4ID0gIlJlbGF0aXZlIEZhdChnKSIpDQoNCmdncGxvdChkcm9uZS5yYWQsIGFlcyh4PWxvZ3JmLCBmaWxsID0gdHJlYXRtZW50KSkgKw0KICBnZW9tX2hpc3RvZ3JhbShwb3NpdGlvbiA9ICJpZGVudGl0eSIsIGJpbndpZHRoID0gMC4xICxjb2w9SSgiYmxhY2siKSkgKw0KICBzY2FsZV9maWxsX21hbnVhbCh2YWx1ZXMgPSBjKCJncmF5OTAiLCAiZ3JheTcwIiwgImdyYXk1MCIgLCAiZ3JheTMwIiwiZ3JheTEwIiksDQogICAgICAgICAgICAgICAgICAgIG5hbWUgPSAiUHJpc3RpbmUgTGV2ZWwiLA0KICAgICAgICAgICAgICAgICAgICBsYWJlbHMgPSBjKCJUcmVhdG1lbnQgMSAoY29udHJvbCkiLCAiVHJlYXRtZW50IDIiLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiVHJlYXRtZW50IDMiLCAiVHJlYXRtZW50IDQiLCAiVHJlYXRtZW50IDUiKSkgKw0KICBnZ3RpdGxlKCIoTG9nKSBEcm9uZSBSZWxhdGl2ZSBGYXQiKSArDQogIGxhYnMoeSA9ICJDb3VudCIsIHggPSAibG9nKFJlYWx0aXZlIEZhdCkoZykiKQ0KDQoNCg0KDQpyZjEgPC0gbG1lcihsb2dyZiB+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uICsgKDF8Y29sb255KSwgZGF0YSA9IGRyb25lLnJhZCkNCnJmNCA8LSBsbWVyKHJlbGF0aXZlX2ZhdCB+IHRyZWF0bWVudCArIHdob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uICsgKDF8Y29sb255KSwgZGF0YSA9IGRyb25lLnJhZCkNCnJmMiA8LSBsbWVyKGxvZ3JmIH4gdHJlYXRtZW50Kndob2xlLm1lYW4gKyBhbGl2ZSArIGR1cmF0aW9uICsgKDF8Y29sb255KSwgZGF0YSA9IGRyb25lLnJhZCkNCnJmMyA8LSBsbWVyKGxvZ3JmIH4gdHJlYXRtZW50ICsgd2hvbGUubWVhbiArIGFsaXZlICsgZHVyYXRpb24gKyBxcm8gKyAoMXxjb2xvbnkpLCBkYXRhID0gZHJvbmUucmFkKQ0KDQphbm92YShyZjEscmYyKQ0KYW5vdmEocmYxLCByZjMpDQoNCkFub3ZhKHJmNCkNCg0KZHJvcDEocmYxLCB0ZXN0ID0gIkNoaXNxIikNCmRyb3AxKHJmMywgdGVzdCA9ICJDaGlzcSIpDQoNCkFub3ZhKHJmMSkNCg0KcmYxDQpBbm92YShyZjEpDQpkZGEgPC0gc2V0RFQoYXMuZGF0YS5mcmFtZShBbm92YShyZjEpKSkNCmRkYQ0KDQpxcW5vcm0ocmVzaWQocmYxKSk7cXFsaW5lKHJlc2lkKHJmMSkpDQpxcW5vcm0ocmVzaWQocmY0KSk7cXFsaW5lKHJlc2lkKHJmNCkpDQpwbG90KHJmMSkNCnBsb3QocmY0KQ0KDQpkZW0gPC0gZW1tZWFucyhyZjEsIHBhaXJ3aXNlIH4gdHJlYXRtZW50LCB0eXBlID0gInJlc3BvbnNlIikNCmRlIDwtIHNldERUKGFzLmRhdGEuZnJhbWUoZGVtJGVtbWVhbnMpKQ0KY2UgPC0gc2V0RFQoYXMuZGF0YS5mcmFtZShkZW0kY29udHJhc3RzKSkNCmRlDQpjZQ0KDQpkZC5jbGQgPC0gY2xkKG9iamVjdCA9ZGVtLA0KICAgICAgICAgICAgICAgICAgICAgYWRqdXN0ID0gIlR1a2V5IiwNCiAgICAgICAgICAgICAgICAgICAgIExldHRlcnMgPSBsZXR0ZXJzLA0KICAgICAgICAgICAgICAgICAgICAgYWxwaGEgPSAwLjA1KQ0KDQpwcmVkaWN0ZWRfbG9nIDwtcHJlZGljdChyZjEsIG5ld2RhdGEgPSBkcm9uZS5yYWQpDQpwcmVkaWN0ZWRfb3JpZ2luYWwgPC0gZXhwKHByZWRpY3RlZF9sb2cpDQpyZXN1bHRfZGYgPC0gZGF0YS5mcmFtZShwcmVkaWN0b3JzID0gZHJvbmUucmFkJHRyZWF0bWVudCwgcHJlZGljdGVkX29yaWdpbmFsKQ0KDQpzdW0gPC0gcmVzdWx0X2RmICU+JQ0KICBncm91cF9ieShwcmVkaWN0b3JzKSAlPiUNCiAgc3VtbWFyaXNlKG1lYW4gPSBtZWFuKHByZWRpY3RlZF9vcmlnaW5hbCksDQogICAgICAgICAgICBzZCA9IHNkKHByZWRpY3RlZF9vcmlnaW5hbCksDQogICAgICAgICAgICBuPShsZW5ndGgocHJlZGljdGVkX29yaWdpbmFsKSkpICU+JQ0KICBtdXRhdGUoc2UgPSBzZC9zcXJ0KG4pKQ0KDQpzdW0kcGxvdCA8LSAoc3VtJG1lYW4gKyBzdW0kc2UpDQoNCnN1bQ0KDQpnZ3Bsb3Qoc3VtLCBhZXMoeCA9IHByZWRpY3RvcnMsIHkgPSBtZWFuLCBmaWxsID0gcHJlZGljdG9ycykpICsNCiAgZ2VvbV9iYXIoc3RhdCA9ICJpZGVudGl0eSIsIGNvbG9yID0gImJsYWNrIikgKw0KICBzY2FsZV9maWxsX3ZpcmlkaXNfZCgpICsNCiAgZ2VvbV9lcnJvcmJhcihhZXMoeW1pbiA9IG1lYW4gLSBzZSwgeW1heCA9IG1lYW4gKyBzZSksIHdpZHRoID0gMC4yLCBwb3NpdGlvbiA9IHBvc2l0aW9uX2RvZGdlKDAuOSkpICsNCiAgbGFicyh4ID0gIlRyZWF0bWVudCIsIHkgPSAiUmVsYXRpdmUgRmF0IChnKSIsIHRpdGxlID0gIkF2ZXJhZ2UgRHJvbmUgQWJkb21pbmFsIFJlbGF0aXZlIEZhdCBieSBUcmVhdG1lbnQiKSArDQogICB0aGVtZV9jbGFzc2ljKGJhc2Vfc2l6ZSA9IDMwKSArDQogICAgY29vcmRfY2FydGVzaWFuKHlsaW09YygwLjAwMSwgMC4wMDIpKSArDQogIGFubm90YXRlKGdlb20gPSAidGV4dCIsIA0KICAgICAgICAgIHggPSAzLCB5ID0gMC4wMDIgLA0KICAgICAgICAgIGxhYmVsID0gIlAgPCAwLjAxIiwNCiAgICAgICAgICBzaXplID0gOCkgKw0KICBhbm5vdGF0ZShnZW9tID0gInRleHQiLA0KICAgICAgICAgICB4ID0gYygxLCAyLCAzLCA0LCA1KSwNCiAgICAgICAgICAgeSA9IGMoc3VtJHBsb3QgKyAzZS0wNSksDQogICAgICAgICAgIGxhYmVsID0gYygiYWIiLCAiYWIiLCAiYSIsICJhIiwgImIiKSwNCiAgICAgICAgICAgc2l6ZSA9IDgpICsNCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gICJub25lIikNCg0KDQpnZ3Bsb3QoZHJvbmUucmFkLCBhZXMoeCA9IHdob2xlLm1lYW4sIHkgPSByYWRpYWwsIGNvbG9yID0gdHJlYXRtZW50KSkgKw0KICBnZW9tX3BvaW50KHNpemUgPSAzKSArDQogIGxhYnMoeCA9ICJBdmVyYWdlIFBvbGxlbiBDb25zdW1lZChnKSIsIHkgPSAiUmVsYXRpdmUgRmF0KGcpIiwgdGl0bGUgPSAiRHJvbmUgQWJkb21pbmFsIFJlbGF0aXZlIEZhdCBieSBBdmVyYWdlIFBvbGxlbiBDb25zdW1lZCIpICsNCiAgdGhlbWVfbWluaW1hbCgpICsNCiAgc2NhbGVfY29sb3JfdmlyaWRpc19kKCkgKw0KICBnZW9tX3Ntb290aChtZXRob2QgPSAibG0iLCBjb2xvciA9ICJwaW5rIiwgc2l6ZSA9IDEpIA0KDQoNCmBgYA0KDQojIyMgQ29sb255IER1cmF0aW9uIA0KDQpgYGB7cn0NCg0KZHVyMSA8LSBnbG0oZHVyYXRpb24gfiB0cmVhdG1lbnQgKyB3aG9sZS5tZWFuICsgYWxpdmUgKyByZXBsaWNhdGUsIGRhdGEgPSBkcm9uZS5jZSkNCmR1cjMgPC0gZ2xtKGR1cmF0aW9uIH4gdHJlYXRtZW50Kndob2xlLm1lYW4gKyBhbGl2ZSArIHJlcGxpY2F0ZSwgZGF0YSA9IGRyb25lLmNlKQ0KZHJvcDEoZHVyMSwgdGVzdCA9ICJDaGlzcSIpDQpkdXIyIDwtIHVwZGF0ZShkdXIxLCAufi4gLXdob2xlLm1lYW4pDQphbm92YShkdXIxLCBkdXIyLCB0ZXN0ID0gIkNoaXNxIikNCkFJQyhkdXIxLCBkdXIyKQ0KQW5vdmEoZHVyMSkgDQphbm92YShkdXIxLCBkdXIzLCB0ZXN0ID0gIkNoaXNxIikNCg0KcGxvdChkdXIxKQ0KcGxvdChkdXIyKQ0KDQpkdXJtIDwtIGVtbWVhbnMoZHVyMiwgcGFpcndpc2UgfiB0cmVhdG1lbnQsIHR5cGUgPSAicmVzcG9uc2UiKQ0KZHVybQ0KDQpjbGR1ciA8LSBjbGQob2JqZWN0ID0gZHVybSwNCiAgICAgICAgICAgICAgICAgICAgIGFkanVzdCA9ICJUdWtleSIsDQogICAgICAgICAgICAgICAgICAgICBMZXR0ZXJzID0gbGV0dGVycywNCiAgICAgICAgICAgICAgICAgICAgIGFscGhhID0gMC4wNSkNCg0KY2xkdXINCmR1cm1kZiA8LSBhcy5kYXRhLmZyYW1lKGR1cm0kZW1tZWFucykNCmR1cm1kZiRwbG90IDwtIGR1cm1kZiRlbW1lYW4gKyBkdXJtZGYkU0UNCg0KZ2dwbG90KGR1cm1kZiwgYWVzKHggPSB0cmVhdG1lbnQsIHkgPSBlbW1lYW4sIGZpbGwgPSB0cmVhdG1lbnQpKSArDQogIGdlb21fYmFyKHN0YXQgPSAiaWRlbnRpdHkiLCBjb2xvciA9ICJibGFjayIpICsNCiAgZ2VvbV9lcnJvcmJhcihhZXMoeW1pbiA9IGVtbWVhbiAtIFNFLCB5bWF4ID0gZW1tZWFuICsgU0UpLCB3aWR0aCA9IDAuMiwgcG9zaXRpb24gPSBwb3NpdGlvbl9kb2RnZSgwLjkpKSArDQogIGxhYnMoeCA9ICJUcmVhdG1lbnQiLCB5ID0gIkRheXMiLCB0aXRsZSA9ICJBdmVyYWdlIENvbG9ueSBEdXJhdGlvbiIpICsNCiAgc2NhbGVfZmlsbF92aXJpZGlzX2QoKSArDQogIGNvb3JkX2NhcnRlc2lhbih5bGltPWMoMzUsNTApKSsNCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gIm5vbmUiKSArDQogICBhbm5vdGF0ZShnZW9tID0gInRleHQiLCANCiAgICAgICAgICB4ID0gMywgeSA9IDUwLA0KICAgICAgICAgIGxhYmVsID0gIlAgPSAwLjAzIiwNCiAgICAgICAgICBzaXplID0gOCkgKw0KICBhbm5vdGF0ZShnZW9tID0gInRleHQiLA0KICAgICAgICAgICB4ID0gYygxLCAyLCAzLCA0LCA1KSwNCiAgICAgICAgICAgeSA9IGMoZHVybWRmJHBsb3QrMSksDQogICAgICAgICAgIGxhYmVsID0gYygiYiIsICJhYiIsICJhYiIsICJhIiwgImFiIiksDQogICAgICAgICAgIHNpemUgPSA2KSArDQogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbiA9ICAibm9uZSIpDQoNCmBgYA0KDQoNCg==