to do:

  1. model time as a fixed effect (try polynomial)
  2. fix all the NAs

demographics

draw <- read.csv("C:/Users/Marri/Dropbox/graduate school records/research projects/longitudinal gratitude/data prep/long_grat_raw.csv", header = T)

delete_cases <- c(3, 6, 70, 77, 102, 140, 152, 192, 205, 214, 232, 261, 306, 417)
draw$remove <- ifelse(draw$subID %in% delete_cases, 1, 0)
draw <- draw %>% filter(remove == 0)

describe(draw$age, na.rm = T)
table(draw$sex)
## 
## female   male 
##     69     32
table(draw$class)
## 
##  freshman    junior    senior sophomore 
##        65         9         5        22

descriptive stats

- close

How close is your friendship with this person? (0 = not at all close, 6 = extremely close)

psych::alpha(d[c("w1close", "w2closeAvg", "w3closeAvg", "w4closeAvg", "w5closeAvg")]) #.91
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("w1close", "w2closeAvg", "w3closeAvg", "w4closeAvg", 
##     "w5closeAvg")])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N    ase mean  sd median_r
##       0.91      0.91    0.92      0.67  10 0.0066  4.3 1.3     0.68
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt      0.9  0.91  0.92
## Duhachek   0.9  0.91  0.92
## 
##  Reliability if an item is dropped:
##            raw_alpha std.alpha G6(smc) average_r  S/N alpha se  var.r med.r
## w1close         0.91      0.91    0.90      0.72 10.1   0.0068 0.0053  0.70
## w2closeAvg      0.88      0.88    0.86      0.64  7.1   0.0092 0.0156  0.63
## w3closeAvg      0.89      0.89    0.89      0.66  7.7   0.0089 0.0167  0.66
## w4closeAvg      0.88      0.88    0.87      0.65  7.5   0.0088 0.0108  0.65
## w5closeAvg      0.89      0.89    0.88      0.67  8.3   0.0081 0.0087  0.70
## 
##  Item statistics 
##              n raw.r std.r r.cor r.drop mean  sd
## w1close    400  0.85  0.79  0.72   0.67  4.5 1.4
## w2closeAvg 406  0.92  0.90  0.87   0.83  4.4 1.4
## w3closeAvg 394  0.90  0.87  0.83   0.79  4.3 1.4
## w4closeAvg 336  0.90  0.88  0.86   0.81  4.3 1.4
## w5closeAvg 151  0.87  0.85  0.82   0.76  4.5 1.4
## 
## Non missing response frequency for each item
##               0    1    2 2.5    3    4    5    6 miss
## w1close    0.00 0.03 0.05   0 0.14 0.23 0.23 0.31 0.18
## w2closeAvg 0.01 0.02 0.05   0 0.15 0.26 0.25 0.26 0.17
## w3closeAvg 0.02 0.03 0.04   0 0.15 0.27 0.27 0.21 0.19
## w4closeAvg 0.02 0.02 0.04   0 0.17 0.26 0.27 0.22 0.31
## w5closeAvg 0.03 0.03 0.03   0 0.10 0.26 0.25 0.30 0.69
describe(d[c("w1close", "w2closeAvg", "w3closeAvg", "w4closeAvg", "w5closeAvg")])

- commit

How committed are you to your friendship with this person? (0 = not at all committed, 6 = extremely committed)

psych::alpha(d[c("w1commit", "w2commitAvg", "w3commitAvg", "w4commitAvg", "w5commitAvg")]) #.91
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("w1commit", "w2commitAvg", "w3commitAvg", 
##     "w4commitAvg", "w5commitAvg")])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N    ase mean  sd median_r
##       0.91      0.91    0.91      0.67  10 0.0065  4.4 1.3     0.68
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt      0.9  0.91  0.92
## Duhachek   0.9  0.91  0.92
## 
##  Reliability if an item is dropped:
##             raw_alpha std.alpha G6(smc) average_r  S/N alpha se  var.r med.r
## w1commit         0.91      0.91    0.89      0.72 10.1   0.0067 0.0027  0.70
## w2commitAvg      0.88      0.88    0.86      0.65  7.3   0.0090 0.0127  0.65
## w3commitAvg      0.89      0.89    0.89      0.66  7.9   0.0086 0.0138  0.68
## w4commitAvg      0.89      0.89    0.87      0.66  7.8   0.0086 0.0084  0.68
## w5commitAvg      0.89      0.89    0.87      0.67  8.3   0.0081 0.0060  0.70
## 
##  Item statistics 
##               n raw.r std.r r.cor r.drop mean  sd
## w1commit    399  0.86  0.80  0.73   0.68  4.6 1.4
## w2commitAvg 406  0.91  0.90  0.87   0.83  4.5 1.4
## w3commitAvg 398  0.90  0.87  0.82   0.79  4.3 1.5
## w4commitAvg 339  0.91  0.87  0.85   0.80  4.5 1.4
## w5commitAvg 152  0.88  0.86  0.82   0.77  4.6 1.5
## 
## Non missing response frequency for each item
##                0    1    2    3    4    5    6 miss
## w1commit    0.01 0.03 0.05 0.15 0.14 0.26 0.36 0.18
## w2commitAvg 0.01 0.02 0.04 0.15 0.22 0.27 0.28 0.17
## w3commitAvg 0.03 0.03 0.04 0.13 0.26 0.25 0.26 0.19
## w4commitAvg 0.02 0.02 0.03 0.15 0.24 0.22 0.31 0.31
## w5commitAvg 0.03 0.02 0.03 0.11 0.16 0.32 0.33 0.69
describe(d[c("w1commit", "w2commitAvg", "w3commitAvg", "w4commitAvg", "w5commitAvg")])

- ios

Using the diagram below, please indicate which picture best described your relationship with this person by selecting a number: 1 = no overlap, 4 = half overlap, 7 = almost complete overlap)

psych::alpha(d[c("w1ios", "w2iosAvg", "w3iosAvg", "w4iosAvg", "w5iosAvg")]) #.92
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("w1ios", "w2iosAvg", "w3iosAvg", "w4iosAvg", 
##     "w5iosAvg")])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N    ase mean  sd median_r
##       0.92      0.92    0.91       0.7  12 0.0057  4.2 1.4     0.71
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.91  0.92  0.93
## Duhachek  0.91  0.92  0.93
## 
##  Reliability if an item is dropped:
##          raw_alpha std.alpha G6(smc) average_r  S/N alpha se  var.r med.r
## w1ios         0.91      0.91    0.89      0.72 10.4   0.0065 0.0013  0.73
## w2iosAvg      0.89      0.89    0.86      0.67  8.1   0.0082 0.0016  0.66
## w3iosAvg      0.90      0.90    0.88      0.70  9.4   0.0071 0.0025  0.71
## w4iosAvg      0.90      0.90    0.88      0.70  9.3   0.0072 0.0036  0.70
## w5iosAvg      0.91      0.91    0.89      0.71 10.0   0.0068 0.0039  0.74
## 
##  Item statistics 
##            n raw.r std.r r.cor r.drop mean  sd
## w1ios    400  0.87  0.84  0.79   0.75  4.3 1.6
## w2iosAvg 412  0.92  0.92  0.90   0.87  4.2 1.6
## w3iosAvg 400  0.90  0.87  0.83   0.79  4.2 1.6
## w4iosAvg 340  0.88  0.87  0.83   0.80  4.4 1.4
## w5iosAvg 153  0.87  0.86  0.80   0.77  4.5 1.6
## 
## Non missing response frequency for each item
##             1    2  2.5    3    4    5 5.5    6    7 miss
## w1ios    0.03 0.13 0.00 0.16 0.24 0.18   0 0.16 0.10 0.18
## w2iosAvg 0.04 0.14 0.00 0.14 0.21 0.23   0 0.18 0.07 0.16
## w3iosAvg 0.04 0.12 0.00 0.15 0.25 0.20   0 0.17 0.06 0.18
## w4iosAvg 0.04 0.09 0.00 0.12 0.27 0.25   0 0.18 0.05 0.30
## w5iosAvg 0.05 0.07 0.01 0.10 0.25 0.23   0 0.20 0.10 0.69
describe(d[c("w1ios", "w2iosAvg", "w3iosAvg", "w4iosAvg", "w5iosAvg")])

The following questions are about this friend: For the questions on this page, please consider the interactions you have had with this person since the last time you filled out this questionnaire.

- gratitude

Over the past two weeks how grateful have you been toward this person?

psych::alpha(d[c("grat2", "grat3", "grat4", "grat5")]) #.85
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("grat2", "grat3", "grat4", "grat5")])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean  sd median_r
##       0.85      0.85    0.83      0.58 5.6 0.011  3.4 1.6      0.6
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.82  0.85  0.87
## Duhachek  0.83  0.85  0.87
## 
##  Reliability if an item is dropped:
##       raw_alpha std.alpha G6(smc) average_r S/N alpha se  var.r med.r
## grat2      0.84      0.84    0.79      0.63 5.2    0.013 0.0062  0.68
## grat3      0.79      0.79    0.74      0.55 3.7    0.017 0.0216  0.58
## grat4      0.76      0.76    0.70      0.52 3.2    0.019 0.0141  0.54
## grat5      0.83      0.83    0.77      0.63 5.0    0.013 0.0026  0.63
## 
##  Item statistics 
##         n raw.r std.r r.cor r.drop mean  sd
## grat2 383  0.86  0.78  0.67   0.61  3.5 1.8
## grat3 365  0.89  0.86  0.80   0.73  3.4 1.8
## grat4 320  0.88  0.89  0.85   0.78  3.5 1.9
## grat5 143  0.87  0.79  0.69   0.62  3.6 1.9
## 
## Non missing response frequency for each item
##          0    1    2    3    4    5    6 miss
## grat2 0.09 0.07 0.10 0.22 0.21 0.16 0.14 0.22
## grat3 0.10 0.05 0.13 0.21 0.23 0.13 0.15 0.25
## grat4 0.11 0.05 0.10 0.14 0.25 0.18 0.16 0.35
## grat5 0.11 0.05 0.12 0.13 0.25 0.17 0.17 0.71
describe(d[c("grat2", "grat3", "grat4", "grat5")])

- anger

Over the past two weeks how angry have you been with this person?

psych::alpha(d[c("anger2", "anger3", "anger4", "anger5")]) #.81
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("anger2", "anger3", "anger4", "anger5")])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean  sd median_r
##       0.81      0.81    0.79      0.51 4.2 0.014  1.1 1.4     0.55
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.78  0.81  0.83
## Duhachek  0.78  0.81  0.83
## 
##  Reliability if an item is dropped:
##        raw_alpha std.alpha G6(smc) average_r S/N alpha se   var.r med.r
## anger2      0.79      0.79    0.72      0.56 3.8    0.017 0.00032  0.56
## anger3      0.72      0.72    0.66      0.46 2.6    0.022 0.02177  0.52
## anger4      0.74      0.74    0.69      0.48 2.8    0.020 0.02629  0.56
## anger5      0.78      0.78    0.71      0.55 3.6    0.017 0.00137  0.54
## 
##  Item statistics 
##          n raw.r std.r r.cor r.drop mean  sd
## anger2 380  0.85  0.75  0.64   0.57 1.09 1.6
## anger3 368  0.89  0.84  0.78   0.70 1.19 1.7
## anger4 317  0.84  0.83  0.74   0.67 0.92 1.5
## anger5 147  0.79  0.76  0.66   0.57 0.88 1.4
## 
## Non missing response frequency for each item
##           0    1    2    3    4    5    6 miss
## anger2 0.57 0.15 0.08 0.07 0.06 0.05 0.01 0.22
## anger3 0.56 0.13 0.10 0.07 0.05 0.04 0.04 0.25
## anger4 0.61 0.16 0.06 0.09 0.04 0.02 0.02 0.35
## anger5 0.59 0.18 0.10 0.07 0.02 0.01 0.02 0.70
describe(d[c("anger2", "anger3", "anger4", "anger5")])

- irritated

Over the past two weeks how irritated have you been with this person?

psych::alpha(d[c("irritated2", "irritated3", "irritated4", "irritated5")]) #.81
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("irritated2", "irritated3", "irritated4", 
##     "irritated5")])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean  sd median_r
##       0.81      0.81    0.78      0.51 4.2 0.014  1.4 1.5     0.54
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.78  0.81  0.84
## Duhachek  0.78  0.81  0.84
## 
##  Reliability if an item is dropped:
##            raw_alpha std.alpha G6(smc) average_r S/N alpha se   var.r med.r
## irritated2      0.77      0.77    0.69      0.53 3.4    0.018 0.00069  0.53
## irritated3      0.74      0.74    0.66      0.48 2.8    0.021 0.00821  0.53
## irritated4      0.75      0.75    0.69      0.50 3.1    0.019 0.01175  0.56
## irritated5      0.78      0.78    0.70      0.54 3.5    0.017 0.00140  0.54
## 
##  Item statistics 
##              n raw.r std.r r.cor r.drop mean  sd
## irritated2 383  0.85  0.78  0.68   0.60  1.4 1.7
## irritated3 370  0.87  0.83  0.75   0.67  1.4 1.8
## irritated4 320  0.83  0.81  0.71   0.64  1.3 1.7
## irritated5 146  0.81  0.77  0.66   0.59  1.2 1.7
## 
## Non missing response frequency for each item
##               0    1    2    3    4    5    6 miss
## irritated2 0.48 0.15 0.13 0.08 0.09 0.05 0.03 0.22
## irritated3 0.48 0.17 0.11 0.08 0.07 0.05 0.05 0.24
## irritated4 0.48 0.22 0.10 0.08 0.05 0.03 0.04 0.35
## irritated5 0.53 0.16 0.10 0.08 0.04 0.05 0.03 0.70
describe(d[c("irritated2", "irritated3", "irritated4", "irritated5")])

- happy

Over the past two weeks how happy have you been with this person?

psych::alpha(d[c("happy2", "happy3", "happy4", "happy5")]) #.85
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("happy2", "happy3", "happy4", "happy5")])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean  sd median_r
##       0.85      0.85    0.81      0.58 5.6 0.011  3.9 1.5     0.58
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.83  0.85  0.87
## Duhachek  0.83  0.85  0.87
## 
##  Reliability if an item is dropped:
##        raw_alpha std.alpha G6(smc) average_r S/N alpha se   var.r med.r
## happy2      0.82      0.82    0.76      0.61 4.7    0.014 0.00282  0.64
## happy3      0.81      0.81    0.74      0.58 4.2    0.015 0.00371  0.59
## happy4      0.78      0.78    0.71      0.55 3.6    0.017 0.00063  0.55
## happy5      0.82      0.82    0.75      0.60 4.5    0.014 0.00121  0.59
## 
##  Item statistics 
##          n raw.r std.r r.cor r.drop mean  sd
## happy2 383  0.86  0.81  0.70   0.65  4.0 1.5
## happy3 368  0.88  0.83  0.75   0.69  3.8 1.6
## happy4 319  0.88  0.86  0.81   0.75  4.0 1.6
## happy5 147  0.88  0.82  0.72   0.67  4.1 1.7
## 
## Non missing response frequency for each item
##           0    1    2    3    4    5    6 miss
## happy2 0.05 0.02 0.08 0.16 0.27 0.26 0.15 0.22
## happy3 0.06 0.04 0.07 0.18 0.30 0.18 0.17 0.25
## happy4 0.07 0.03 0.07 0.14 0.26 0.25 0.18 0.35
## happy5 0.06 0.03 0.05 0.16 0.19 0.27 0.24 0.70
describe(d[c("happy2", "happy3", "happy4", "happy5")])

- thankful

Over the past two weeks how thankful have you been toward this person?

psych::alpha(d[c("thankful2", "thankful3", "thankful4", "thankful5")]) #.87
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("thankful2", "thankful3", "thankful4", "thankful5")])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N    ase mean  sd median_r
##       0.87      0.87    0.85      0.63 6.8 0.0094  3.4 1.6     0.62
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.85  0.87  0.89
## Duhachek  0.85  0.87  0.89
## 
##  Reliability if an item is dropped:
##           raw_alpha std.alpha G6(smc) average_r S/N alpha se  var.r med.r
## thankful2      0.87      0.87    0.82      0.68 6.5    0.010 0.0035  0.69
## thankful3      0.83      0.83    0.79      0.62 4.9    0.013 0.0141  0.62
## thankful4      0.80      0.80    0.74      0.57 4.0    0.015 0.0041  0.60
## thankful5      0.84      0.84    0.78      0.64 5.3    0.012 0.0024  0.62
## 
##  Item statistics 
##             n raw.r std.r r.cor r.drop mean  sd
## thankful2 380  0.85  0.80  0.69   0.65  3.5 1.8
## thankful3 370  0.89  0.86  0.79   0.74  3.4 1.8
## thankful4 319  0.89  0.90  0.87   0.81  3.5 1.9
## thankful5 147  0.89  0.84  0.78   0.72  3.7 1.8
## 
## Non missing response frequency for each item
##              0    1    2    3    4    5    6 miss
## thankful2 0.09 0.05 0.10 0.22 0.21 0.20 0.13 0.22
## thankful3 0.10 0.08 0.12 0.17 0.23 0.14 0.16 0.24
## thankful4 0.11 0.08 0.08 0.18 0.18 0.22 0.15 0.35
## thankful5 0.10 0.03 0.12 0.18 0.18 0.20 0.20 0.70
describe(d[c("thankful2", "thankful3", "thankful4", "thankful5")])

- appreciative

Over the past two weeks how appreciative have you been toward this person?

psych::alpha(d[c("appreciative2", "appreciative3", "appreciative4", "appreciative5")]) #.87
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("appreciative2", "appreciative3", "appreciative4", 
##     "appreciative5")])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N  ase mean  sd median_r
##       0.86      0.86    0.84      0.61 6.3 0.01  3.5 1.6     0.61
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.84  0.86  0.88
## Duhachek  0.84  0.86  0.88
## 
##  Reliability if an item is dropped:
##               raw_alpha std.alpha G6(smc) average_r S/N alpha se  var.r med.r
## appreciative2      0.86      0.86    0.81      0.66 5.9    0.011 0.0088  0.68
## appreciative3      0.82      0.82    0.78      0.60 4.5    0.014 0.0219  0.60
## appreciative4      0.78      0.78    0.72      0.54 3.6    0.017 0.0071  0.56
## appreciative5      0.84      0.84    0.78      0.63 5.2    0.013 0.0019  0.62
## 
##  Item statistics 
##                 n raw.r std.r r.cor r.drop mean  sd
## appreciative2 385  0.85  0.79  0.68   0.63  3.7 1.7
## appreciative3 368  0.89  0.85  0.78   0.72  3.5 1.8
## appreciative4 319  0.88  0.90  0.88   0.81  3.5 1.9
## appreciative5 148  0.88  0.82  0.75   0.68  3.8 1.8
## 
## Non missing response frequency for each item
##                  0    1    2    3    4    5    6 miss
## appreciative2 0.08 0.06 0.07 0.21 0.24 0.20 0.15 0.21
## appreciative3 0.10 0.05 0.10 0.18 0.25 0.15 0.15 0.25
## appreciative4 0.11 0.08 0.08 0.18 0.18 0.22 0.15 0.35
## appreciative5 0.10 0.03 0.09 0.16 0.22 0.20 0.20 0.70
describe(d[c("appreciative2", "appreciative3", "appreciative4", "appreciative5")])

- gratitude scale

psych::alpha(d[c("appreciative2", "appreciative3", "appreciative4", "appreciative5",
                 "thankful2", "thankful3", "thankful4", "thankful5",
                 "grat2", "grat3", "grat4", "grat5")]) #alpha = .96
## Warning in cor.smooth(r): Matrix was not positive definite, smoothing was done
## In smc, smcs < 0 were set to .0
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("appreciative2", "appreciative3", "appreciative4", 
##     "appreciative5", "thankful2", "thankful3", "thankful4", "thankful5", 
##     "grat2", "grat3", "grat4", "grat5")])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N    ase mean  sd median_r
##       0.96      0.96    0.98      0.66  23 0.0029  3.4 1.6     0.62
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.95  0.96  0.96
## Duhachek  0.95  0.96  0.96
## 
##  Reliability if an item is dropped:
##               raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## appreciative2      0.96      0.96    0.97      0.67  22   0.0030 0.020  0.67
## appreciative3      0.95      0.95    0.97      0.66  21   0.0032 0.022  0.62
## appreciative4      0.95      0.95    0.98      0.65  20   0.0034 0.022  0.62
## appreciative5      0.96      0.96    0.97      0.66  22   0.0031 0.020  0.62
## thankful2          0.96      0.96    0.97      0.67  22   0.0030 0.021  0.67
## thankful3          0.95      0.95    0.97      0.66  21   0.0032 0.022  0.62
## thankful4          0.95      0.95    0.98      0.65  20   0.0034 0.022  0.62
## thankful5          0.95      0.95    0.97      0.66  21   0.0032 0.021  0.62
## grat2              0.96      0.96    0.97      0.67  22   0.0030 0.021  0.67
## grat3              0.96      0.95    0.97      0.66  21   0.0032 0.023  0.62
## grat4              0.95      0.95    0.96      0.65  21   0.0033 0.023  0.62
## grat5              0.96      0.96    0.97      0.67  22   0.0030 0.018  0.62
## 
##  Item statistics 
##                 n raw.r std.r r.cor r.drop mean  sd
## appreciative2 385  0.82  0.77  0.77   0.72  3.7 1.7
## appreciative3 368  0.88  0.85  0.86   0.82  3.5 1.8
## appreciative4 319  0.88  0.90  0.85   0.88  3.5 1.9
## appreciative5 148  0.87  0.81  0.81   0.77  3.8 1.8
## thankful2     380  0.84  0.78  0.78   0.74  3.5 1.8
## thankful3     370  0.87  0.85  0.85   0.81  3.4 1.8
## thankful4     319  0.88  0.90  0.85   0.88  3.5 1.9
## thankful5     147  0.90  0.84  0.85   0.81  3.7 1.8
## grat2         383  0.82  0.77  0.76   0.72  3.5 1.8
## grat3         365  0.87  0.84  0.83   0.80  3.4 1.8
## grat4         320  0.86  0.88  0.87   0.85  3.5 1.9
## grat5         143  0.84  0.77  0.77   0.73  3.6 1.9
## 
## Non missing response frequency for each item
##                  0    1    2    3    4    5    6 miss
## appreciative2 0.08 0.06 0.07 0.21 0.24 0.20 0.15 0.21
## appreciative3 0.10 0.05 0.10 0.18 0.25 0.15 0.15 0.25
## appreciative4 0.11 0.08 0.08 0.18 0.18 0.22 0.15 0.35
## appreciative5 0.10 0.03 0.09 0.16 0.22 0.20 0.20 0.70
## thankful2     0.09 0.05 0.10 0.22 0.21 0.20 0.13 0.22
## thankful3     0.10 0.08 0.12 0.17 0.23 0.14 0.16 0.24
## thankful4     0.11 0.08 0.08 0.18 0.18 0.22 0.15 0.35
## thankful5     0.10 0.03 0.12 0.18 0.18 0.20 0.20 0.70
## grat2         0.09 0.07 0.10 0.22 0.21 0.16 0.14 0.22
## grat3         0.10 0.05 0.13 0.21 0.23 0.13 0.15 0.25
## grat4         0.11 0.05 0.10 0.14 0.25 0.18 0.16 0.35
## grat5         0.11 0.05 0.12 0.13 0.25 0.17 0.17 0.71

describe(d[c("appreciative2", "appreciative3", "appreciative4", "appreciative5",
                 "thankful2", "thankful3", "thankful4", "thankful5",
                 "grat2", "grat3", "grat4", "grat5")])

- need

1. when I consider my life right now, I would say I am in a terrible place.

2. when I consider my life right now, i would say I am in a really good place.

Please indicate how much you agree that each of the following are currently a cause of stress:

1. Financial problems (ex: a lack of money, owe someone money, etc.)

2. Health related issues (ex: poor sleep, sickness, injury, death of someone close, etc.)

3. Friend problems (ex: arguments, conflicts with roommate, not enough friends, etc.)

4. General life problems (ex: victim of a crime, car troubles, traffic ticket, etc.)

5. Academic issues (ex: did poorly on a test, a lot of deadlines, etc.)

6. Relationship issues (ex: breaking up with a boy/girlfriend, fights,long-distance relationship, etc.)

7. Family problems (ex: divorce, arguments, not enough support, etc.)

d$w1need2.R <- 8 - d$w1need2
d$w2need2.R <- 8 - d$w2need2
d$w3need2.R <- 8 - d$w3need2
d$w4need2.R <- 8 - d$w4need2
d$w5need2.R <- 8 - d$w5need2

### need 1-9 for week 1-5

# lok at just need 1 and need 2.r cause they are close!

psych::alpha(d[c("w1need1", 
                 "w1need2.R", 
                 "w1need3", 
                 "w1need4", 
                 "w1need5", 
                 "w1need6", 
                 "w1need7", 
                 "w1need8", 
                 "w1need9")], check.keys = TRUE) #.56
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("w1need1", "w1need2.R", "w1need3", "w1need4", 
##     "w1need5", "w1need6", "w1need7", "w1need8", "w1need9")], 
##     check.keys = TRUE)
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean   sd median_r
##       0.69      0.71    0.74      0.21 2.4 0.021  3.1 0.96     0.24
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.65  0.69  0.73
## Duhachek  0.65  0.69  0.73
## 
##  Reliability if an item is dropped:
##           raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## w1need1        0.66      0.67    0.68      0.20 2.0    0.023 0.015  0.23
## w1need2.R      0.66      0.66    0.68      0.20 2.0    0.023 0.014  0.23
## w1need3        0.68      0.70    0.72      0.23 2.3    0.022 0.021  0.25
## w1need4        0.65      0.67    0.70      0.20 2.0    0.024 0.025  0.23
## w1need5        0.65      0.66    0.70      0.20 2.0    0.024 0.025  0.24
## w1need6        0.66      0.68    0.72      0.21 2.1    0.023 0.027  0.23
## w1need7        0.65      0.67    0.71      0.20 2.0    0.024 0.027  0.19
## w1need8        0.71      0.72    0.75      0.24 2.6    0.020 0.023  0.27
## w1need9        0.67      0.69    0.72      0.22 2.2    0.023 0.024  0.25
## 
##  Item statistics 
##             n raw.r std.r r.cor r.drop mean  sd
## w1need1   484  0.53  0.60  0.58   0.40  2.0 1.3
## w1need2.R 484  0.54  0.62  0.61   0.42  2.3 1.3
## w1need3   484  0.52  0.46  0.36   0.32  3.7 2.0
## w1need4   484  0.61  0.60  0.53   0.44  3.5 2.0
## w1need5   484  0.61  0.62  0.56   0.45  3.5 1.8
## w1need6   484  0.53  0.56  0.46   0.38  2.3 1.6
## w1need7   484  0.61  0.60  0.52   0.45  4.4 1.9
## w1need8   484  0.38  0.36  0.20   0.17  3.3 2.0
## w1need9   484  0.55  0.50  0.40   0.35  2.8 2.0
## 
## Non missing response frequency for each item
##              1    2    3    4    5    6    7 miss
## w1need1   0.51 0.27 0.06 0.08 0.05 0.01 0.01 0.01
## w1need2.R 0.27 0.41 0.17 0.05 0.07 0.02 0.01 0.01
## w1need3   0.19 0.21 0.08 0.06 0.24 0.12 0.09 0.01
## w1need4   0.25 0.18 0.07 0.06 0.29 0.11 0.04 0.01
## w1need5   0.17 0.23 0.08 0.16 0.19 0.12 0.04 0.01
## w1need6   0.43 0.30 0.04 0.09 0.09 0.04 0.02 0.01
## w1need7   0.12 0.11 0.08 0.07 0.31 0.20 0.12 0.01
## w1need8   0.27 0.19 0.07 0.12 0.17 0.13 0.04 0.01
## w1need9   0.42 0.18 0.09 0.10 0.06 0.08 0.08 0.01
psych::alpha(d[c("w2need1", 
                 "w2need2.R", 
                 "w2need3", 
                 "w2need4", 
                 "w2need5", 
                 "w2need6", 
                 "w2need7", 
                 "w2need8", 
                 "w2need9")], check.keys = TRUE) #.62
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("w2need1", "w2need2.R", "w2need3", "w2need4", 
##     "w2need5", "w2need6", "w2need7", "w2need8", "w2need9")], 
##     check.keys = TRUE)
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean sd median_r
##       0.71      0.73    0.76      0.23 2.6 0.019  3.2  1     0.19
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.67  0.71  0.75
## Duhachek  0.68  0.71  0.75
## 
##  Reliability if an item is dropped:
##           raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## w2need1        0.69      0.69    0.70      0.22 2.2    0.021 0.014  0.20
## w2need2.R      0.70      0.70    0.72      0.23 2.4    0.021 0.014  0.20
## w2need3        0.68      0.70    0.74      0.23 2.3    0.022 0.022  0.19
## w2need4        0.68      0.69    0.73      0.22 2.2    0.022 0.025  0.18
## w2need5        0.67      0.68    0.73      0.21 2.2    0.022 0.024  0.17
## w2need6        0.68      0.70    0.72      0.22 2.3    0.022 0.019  0.19
## w2need7        0.69      0.70    0.74      0.23 2.3    0.021 0.024  0.19
## w2need8        0.73      0.74    0.77      0.26 2.9    0.018 0.019  0.24
## w2need9        0.69      0.70    0.73      0.23 2.3    0.021 0.023  0.19
## 
##  Item statistics 
##             n raw.r std.r r.cor r.drop mean  sd
## w2need1   466  0.55  0.62  0.61   0.43  2.0 1.4
## w2need2.R 466  0.47  0.55  0.52   0.35  2.4 1.3
## w2need3   466  0.62  0.57  0.49   0.43  3.7 2.2
## w2need4   466  0.62  0.60  0.52   0.45  3.9 2.0
## w2need5   466  0.62  0.63  0.56   0.46  3.7 1.9
## w2need6   466  0.58  0.58  0.53   0.44  2.2 1.6
## w2need7   466  0.57  0.56  0.46   0.40  4.9 1.9
## w2need8   466  0.40  0.36  0.21   0.18  3.6 2.1
## w2need9   466  0.58  0.56  0.48   0.40  2.8 2.0
## 
## Non missing response frequency for each item
##              1    2    3    4    5    6    7 miss
## w2need1   0.52 0.27 0.08 0.03 0.07 0.03 0.00 0.05
## w2need2.R 0.26 0.37 0.22 0.07 0.03 0.05 0.00 0.05
## w2need3   0.26 0.16 0.05 0.06 0.21 0.14 0.11 0.05
## w2need4   0.17 0.19 0.05 0.09 0.23 0.20 0.07 0.05
## w2need5   0.17 0.21 0.09 0.08 0.27 0.14 0.04 0.05
## w2need6   0.47 0.25 0.09 0.05 0.06 0.05 0.02 0.05
## w2need7   0.07 0.11 0.05 0.05 0.27 0.25 0.19 0.05
## w2need8   0.24 0.17 0.05 0.14 0.18 0.12 0.10 0.05
## w2need9   0.44 0.12 0.07 0.10 0.15 0.10 0.03 0.05
psych::alpha(d[c("w3need1", 
                 "w3need2.R", 
                 "w3need3", 
                 "w3need4", 
                 "w3need5", 
                 "w3need6", 
                 "w3need7", 
                 "w3need8", 
                 "w3need9")], check.keys = TRUE) #.60
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("w3need1", "w3need2.R", "w3need3", "w3need4", 
##     "w3need5", "w3need6", "w3need7", "w3need8", "w3need9")], 
##     check.keys = TRUE)
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean  sd median_r
##       0.76      0.77     0.8      0.27 3.3 0.017  3.1 1.1     0.28
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.72  0.76  0.79
## Duhachek  0.72  0.76  0.79
## 
##  Reliability if an item is dropped:
##           raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## w3need1        0.73      0.73    0.74      0.26 2.7    0.018 0.018  0.27
## w3need2.R      0.72      0.73    0.73      0.25 2.7    0.019 0.017  0.26
## w3need3        0.74      0.76    0.78      0.28 3.1    0.018 0.025  0.29
## w3need4        0.71      0.73    0.76      0.25 2.7    0.020 0.026  0.26
## w3need5        0.70      0.72    0.75      0.24 2.6    0.020 0.025  0.26
## w3need6        0.73      0.75    0.78      0.27 2.9    0.018 0.027  0.27
## w3need7        0.74      0.75    0.78      0.28 3.0    0.018 0.026  0.30
## w3need8        0.78      0.79    0.80      0.32 3.7    0.015 0.016  0.31
## w3need9        0.74      0.75    0.77      0.27 3.0    0.018 0.022  0.28
## 
##  Item statistics 
##             n raw.r std.r r.cor r.drop mean  sd
## w3need1   448  0.60  0.66  0.65   0.51  1.9 1.3
## w3need2.R 448  0.64  0.69  0.69   0.54  2.6 1.5
## w3need3   448  0.57  0.53  0.44   0.39  3.5 2.0
## w3need4   448  0.69  0.67  0.62   0.56  3.4 2.0
## w3need5   448  0.72  0.72  0.68   0.60  3.7 1.8
## w3need6   448  0.59  0.60  0.51   0.46  2.5 1.7
## w3need7   448  0.56  0.56  0.46   0.40  4.5 1.9
## w3need8   443  0.35  0.34  0.20   0.16  3.3 2.0
## w3need9   444  0.57  0.56  0.48   0.40  2.8 2.0
## 
## Non missing response frequency for each item
##              1    2    3    4    5    6    7 miss
## w3need1   0.51 0.27 0.09 0.05 0.07 0.01 0.00 0.08
## w3need2.R 0.24 0.36 0.21 0.04 0.08 0.08 0.00 0.08
## w3need3   0.22 0.21 0.09 0.07 0.22 0.10 0.09 0.08
## w3need4   0.24 0.23 0.05 0.06 0.28 0.06 0.08 0.08
## w3need5   0.18 0.19 0.05 0.15 0.26 0.13 0.04 0.08
## w3need6   0.40 0.25 0.10 0.09 0.08 0.06 0.01 0.08
## w3need7   0.09 0.12 0.10 0.08 0.21 0.29 0.12 0.08
## w3need8   0.26 0.23 0.04 0.17 0.13 0.14 0.05 0.09
## w3need9   0.40 0.23 0.03 0.07 0.11 0.12 0.04 0.09
psych::alpha(d[c("w4need1", 
                 "w4need2.R", 
                 "w4need3", 
                 "w4need4", 
                 "w4need5", 
                 "w4need6", 
                 "w4need7", 
                 "w4need8", 
                 "w4need9")], check.keys = TRUE) #.66
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("w4need1", "w4need2.R", "w4need3", "w4need4", 
##     "w4need5", "w4need6", "w4need7", "w4need8", "w4need9")], 
##     check.keys = TRUE)
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean  sd median_r
##       0.77      0.78    0.81      0.28 3.5 0.016    3 1.1     0.28
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.74  0.77   0.8
## Duhachek  0.74  0.77   0.8
## 
##  Reliability if an item is dropped:
##           raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## w4need1        0.75      0.76    0.77      0.28 3.1    0.017 0.014  0.28
## w4need2.R      0.75      0.76    0.76      0.28 3.1    0.017 0.015  0.29
## w4need3        0.73      0.75    0.77      0.27 3.0    0.018 0.018  0.28
## w4need4        0.75      0.76    0.79      0.28 3.1    0.017 0.022  0.27
## w4need5        0.73      0.74    0.78      0.27 2.9    0.018 0.022  0.25
## w4need6        0.73      0.74    0.77      0.26 2.8    0.019 0.018  0.26
## w4need7        0.75      0.76    0.80      0.29 3.3    0.017 0.022  0.30
## w4need8        0.78      0.78    0.81      0.31 3.6    0.015 0.017  0.31
## w4need9        0.75      0.76    0.79      0.28 3.2    0.017 0.018  0.28
## 
##  Item statistics 
##             n raw.r std.r r.cor r.drop mean  sd
## w4need1   400  0.54  0.61  0.58   0.44  1.9 1.3
## w4need2.R 400  0.54  0.60  0.57   0.42  2.5 1.5
## w4need3   400  0.68  0.64  0.60   0.53  3.5 2.1
## w4need4   400  0.61  0.60  0.51   0.45  3.5 2.0
## w4need5   400  0.67  0.68  0.62   0.56  3.0 1.7
## w4need6   400  0.70  0.70  0.68   0.60  2.2 1.6
## w4need7   400  0.57  0.56  0.46   0.42  4.5 1.9
## w4need8   400  0.47  0.44  0.32   0.28  3.3 2.1
## w4need9   400  0.60  0.59  0.52   0.45  2.6 1.9
## 
## Non missing response frequency for each item
##              1    2    3    4    5    6    7 miss
## w4need1   0.50 0.31 0.08 0.03 0.08 0.01 0.00 0.18
## w4need2.R 0.28 0.31 0.22 0.03 0.09 0.07 0.00 0.18
## w4need3   0.27 0.16 0.09 0.07 0.17 0.16 0.09 0.18
## w4need4   0.24 0.17 0.07 0.11 0.24 0.11 0.06 0.18
## w4need5   0.22 0.30 0.07 0.10 0.24 0.05 0.01 0.18
## w4need6   0.54 0.18 0.08 0.09 0.06 0.05 0.01 0.18
## w4need7   0.11 0.12 0.08 0.06 0.23 0.30 0.11 0.18
## w4need8   0.28 0.20 0.04 0.14 0.16 0.09 0.09 0.18
## w4need9   0.43 0.24 0.07 0.04 0.08 0.11 0.04 0.18
psych::alpha(d[c("w5need1", 
                 "w5need2.R", 
                 "w5need3", 
                 "w5need4", 
                 "w5need5", 
                 "w5need6", 
                 "w5need7", 
                 "w5need8", 
                 "w5need9")], check.keys = TRUE) #.44
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("w5need1", "w5need2.R", "w5need3", "w5need4", 
##     "w5need5", "w5need6", "w5need7", "w5need8", "w5need9")], 
##     check.keys = TRUE)
## 
##   raw_alpha std.alpha G6(smc) average_r S/N  ase mean sd median_r
##       0.71      0.73    0.83      0.23 2.7 0.02  3.1  1     0.26
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.67  0.71  0.74
## Duhachek  0.67  0.71  0.75
## 
##  Reliability if an item is dropped:
##           raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## w5need1        0.66      0.67    0.77      0.20 2.0    0.024 0.040  0.21
## w5need2.R      0.65      0.67    0.76      0.20 2.0    0.024 0.042  0.22
## w5need3        0.71      0.74    0.80      0.26 2.8    0.020 0.056  0.27
## w5need4        0.69      0.72    0.79      0.24 2.6    0.021 0.056  0.26
## w5need5        0.67      0.70    0.81      0.23 2.4    0.023 0.065  0.27
## w5need6        0.62      0.65    0.77      0.19 1.9    0.027 0.050  0.21
## w5need7        0.67      0.69    0.80      0.22 2.3    0.023 0.062  0.21
## w5need8        0.74      0.76    0.83      0.28 3.2    0.018 0.052  0.31
## w5need9        0.71      0.73    0.82      0.25 2.7    0.020 0.056  0.27
## 
##  Item statistics 
##             n raw.r std.r r.cor r.drop mean  sd
## w5need1   194  0.67  0.73  0.75  0.583  1.8 1.3
## w5need2.R 194  0.68  0.73  0.76  0.575  2.5 1.5
## w5need3   194  0.46  0.40  0.33  0.247  3.5 2.1
## w5need4   190  0.51  0.49  0.44  0.316  3.5 1.9
## w5need5   194  0.57  0.58  0.49  0.427  3.0 1.7
## w5need6   194  0.78  0.79  0.79  0.674  2.7 2.0
## w5need7   194  0.61  0.62  0.55  0.459  4.5 1.8
## w5need8   194  0.31  0.27  0.14  0.092  3.4 2.0
## w5need9   194  0.45  0.45  0.35  0.249  2.8 2.0
## 
## Non missing response frequency for each item
##              1    2    3    4    5    6    7 miss
## w5need1   0.60 0.24 0.05 0.04 0.05 0.03 0.00 0.60
## w5need2.R 0.26 0.37 0.21 0.02 0.07 0.04 0.03 0.60
## w5need3   0.25 0.21 0.06 0.05 0.23 0.11 0.10 0.60
## w5need4   0.17 0.26 0.11 0.00 0.29 0.11 0.05 0.61
## w5need5   0.16 0.41 0.08 0.09 0.18 0.06 0.03 0.60
## w5need6   0.43 0.21 0.07 0.02 0.12 0.10 0.06 0.60
## w5need7   0.07 0.09 0.21 0.03 0.30 0.15 0.16 0.60
## w5need8   0.24 0.17 0.16 0.11 0.10 0.14 0.07 0.60
## w5need9   0.42 0.13 0.09 0.09 0.15 0.06 0.05 0.60
x <- d[c("w1need2.R", "w2need2.R", "w3need2.R", "w4need2.R", "w5need2.R")]
d$w2needAvg <- rowMeans(x)

psych::alpha(d[c("w1needAvg", #alpha = .94
                 "w2needAvg", 
                 "w3needAvg", 
                 "w4needAvg", 
                 "w5needAvg")], check.keys = TRUE) #.89
## Number of categories should be increased  in order to count frequencies.
## Warning in psych::alpha(d[c("w1needAvg", "w2needAvg", "w3needAvg", "w4needAvg", : Some items were negatively correlated with total scale and were automatically reversed.
##  This is indicated by a negative sign for the variable name.
## 
## Reliability analysis   
## Call: psych::alpha(x = d[c("w1needAvg", "w2needAvg", "w3needAvg", "w4needAvg", 
##     "w5needAvg")], check.keys = TRUE)
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean   sd median_r
##       0.57      0.68    0.68       0.3 2.1 0.026  3.8 0.43     0.23
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.51  0.57  0.63
## Duhachek  0.52  0.57  0.62
## 
##  Reliability if an item is dropped:
##            raw_alpha std.alpha G6(smc) average_r S/N alpha se  var.r med.r
## w1needAvg       0.55      0.71    0.69      0.38 2.4    0.029 0.0282  0.40
## w2needAvg-      0.63      0.65    0.63      0.31 1.8    0.028 0.0392  0.27
## w3needAvg       0.41      0.51    0.45      0.21 1.0    0.035 0.0076  0.20
## w4needAvg       0.53      0.65    0.64      0.32 1.9    0.027 0.0319  0.23
## w5needAvg       0.51      0.59    0.57      0.26 1.4    0.030 0.0251  0.21
## 
##  Item statistics 
##              n raw.r std.r r.cor r.drop mean   sd
## w1needAvg  484  0.61  0.51  0.28   0.26  3.8 0.54
## w2needAvg- 167  0.83  0.63  0.49   0.39  5.0 1.32
## w3needAvg  448  0.69  0.82  0.83   0.64  3.7 0.50
## w4needAvg  400  0.67  0.62  0.47   0.31  3.7 0.55
## w5needAvg  194  0.55  0.72  0.65   0.44  3.6 0.42

- weight (NA)

Please enter your current weight (pounds/kilograms)

- height (NA)

Please enter your height

head(d1, 10)

graphs: friendship/time

i = 1
for(i in unique(d1$subID)){
  print(ggplot(data = d1[d1$subID == i,], aes(x = week, y = rank, color = friend)) + 
          theme_minimal() +
          ylab("rank") +
          geom_point() + 
          geom_line() +
          ggtitle(paste0("participant ", i)) + 
          scale_x_continuous(breaks = c(1, 2, 3, 4, 5),
                     limits = c(1, 5)))
  }

H1. Do friend ranks predict WTRs?

h1 <- lmer(wtr ~ rank + (rank + week | subID) + (1 | fid), data = d1)

tab_model(h1, 
          show.df = T, 
          show.ci = .95,
          show.se = T,
          show.stat = T,
          string.stat = "t",
          string.se="SE",
          string.est = "Est",
          digits = 3)
  wtr
Predictors Est SE CI t p df
(Intercept) 0.760 0.026 0.710 – 0.810 29.746 <0.001 1480.000
rank -0.059 0.007 -0.073 – -0.046 -8.772 <0.001 1480.000
Random Effects
σ2 0.02
τ00 fid 0.01
τ00 subID 0.06
τ11 subID.rank 0.00
τ11 subID.week 0.00
ρ01 subID.rank -0.24
ρ01 subID.week -0.46
ICC 0.83
N subID 99
N fid 472
Observations 1490
Marginal R2 / Conditional R2 0.046 / 0.836 
p <-plot_model(h1, type = "pred", terms = "rank", 
           show.data = T, 
           jitter = .08,
           line.size = 1.5,
           dot.size = .8,
           title = "") +
  ylab("welfare trade-off ratio") +
  xlab("friend ranking") +
  theme_minimal() +
  theme(panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        panel.background = element_blank(), 
        axis.line = element_line(colour = "black"),
        text = element_text(size = 17),
        axis.text = element_text(colour = "black"))+
  scale_y_continuous(breaks = c(0,.1, .2,.3 ,.4, .5, .6, .7, .8, .9, 1, 1.1), 
                     limits = c(0, 1.1))
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.

H2. Do WTRs predict gratitude?

summary(h2<- lmer(gratScale ~ wtr + (wtr + week | subID) + (1 | fid), data = d1))
## Linear mixed model fit by REML ['lmerMod']
## Formula: gratScale ~ wtr + (wtr + week | subID) + (1 | fid)
##    Data: d1
## 
## REML criterion at convergence: 3729
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.2737 -0.4769  0.0350  0.5066  3.3558 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr       
##  fid      (Intercept) 0.57113  0.7557              
##  subID    (Intercept) 2.80135  1.6737              
##           wtr         2.66759  1.6333   -0.74      
##           week        0.08015  0.2831   -0.64  0.54
##  Residual             0.85026  0.9221              
## Number of obs: 1128, groups:  fid, 450; subID, 99
## 
## Fixed effects:
##             Estimate Std. Error t value
## (Intercept)   1.9706     0.1934   10.19
## wtr           2.6611     0.2660   10.00
## 
## Correlation of Fixed Effects:
##     (Intr)
## wtr -0.782
tab_model(h2, 
          show.df = T, 
          show.ci = .95,
          show.se = T,
          show.stat = T,
          string.stat = "t",
          string.se="SE",
          string.est = "Est",
          digits = 2)
  gratScale
Predictors Est SE CI t p df
(Intercept) 1.97 0.19 1.59 – 2.35 10.19 <0.001 1118.00
wtr 2.66 0.27 2.14 – 3.18 10.00 <0.001 1118.00
Random Effects
σ2 0.85
τ00 fid 0.57
τ00 subID 2.80
τ11 subID.wtr 2.67
τ11 subID.week 0.08
ρ01 subID.wtr -0.74
ρ01 subID.week -0.64
ICC 0.72
N subID 99
N fid 450
Observations 1128
Marginal R2 / Conditional R2 0.189 / 0.772 
plot_model(h2, type = "pred", terms = "wtr", 
           show.data = T, 
           jitter = .05,
           line.size = 1.5,
           dot.size = .8,
           title = "") +
  ylab("gratitude scale") +
  xlab("welfare trade-off ratio") +
  theme_minimal() +
  theme(panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        panel.background = element_blank(), 
        axis.line = element_line(colour = "black"),
        text = element_text(size = 17),
        axis.text = element_text(colour = "black")) +
  scale_y_continuous(breaks = c(0,1,2,3,4,5,6), 
                     limits = c(0,6)) +
  scale_x_continuous(breaks = c(0,.1, .2,.3 ,.4, .5, .6, .7, .8, .9, 1, 1.1), 
                     limits = c(0, 1.1))
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.
## Warning: Removed 216 rows containing missing values (`geom_point()`).
## Warning: Removed 1 row containing missing values (`geom_line()`).

H3. Do changes in WTRs predict gratitude each week?

summary(h3 <- lmer(gratScale ~ wtrDiff + (wtrDiff + week | subID) + (1 | fid), data = d1))
## Linear mixed model fit by REML ['lmerMod']
## Formula: gratScale ~ wtrDiff + (wtrDiff + week | subID) + (1 | fid)
##    Data: d1
## 
## REML criterion at convergence: 3580.5
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.3076 -0.4516  0.0565  0.4836  3.2143 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr       
##  fid      (Intercept) 0.9410   0.9700              
##  subID    (Intercept) 0.8042   0.8968              
##           wtrDiff     0.7922   0.8901   -0.39      
##           week        0.0661   0.2571   -0.29  0.52
##  Residual             0.9331   0.9660              
## Number of obs: 1042, groups:  fid, 423; subID, 98
## 
## Fixed effects:
##             Estimate Std. Error t value
## (Intercept)   3.5301     0.1141  30.951
## wtrDiff       1.0727     0.2257   4.752
## 
## Correlation of Fixed Effects:
##         (Intr)
## wtrDiff -0.011
tab_model(h3, 
          show.df = T, 
          show.ci = .95,
          show.se = T,
          show.stat = T,
          string.stat = "t",
          string.se="SE",
          string.est = "Est",
          digits = 2)
  gratScale
Predictors Est SE CI t p df
(Intercept) 3.53 0.11 3.31 – 3.75 30.95 <0.001 1032.00
wtrDiff 1.07 0.23 0.63 – 1.52 4.75 <0.001 1032.00
Random Effects
σ2 0.93
τ00 fid 0.94
τ00 subID 0.80
τ11 subID.wtrDiff 0.79
τ11 subID.week 0.07
ρ01 subID.wtrDiff -0.39
ρ01 subID.week -0.29
ICC 0.66
N subID 98
N fid 423
Observations 1042
Marginal R2 / Conditional R2 0.016 / 0.662 
p <- plot_model(h3, type = "pred", terms = "wtrDiff", 
           show.data = T,
           jitter = .05,
           line.size = 1.5,
           dot.size = .8,
           title = "") +
  ylab("gratitude scale") +
  xlab("change in welfare trade-off ratio") +
  theme_minimal() +
  theme(panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        panel.background = element_blank(), 
        axis.line = element_line(colour = "black"),
        text = element_text(size = 17),
        axis.text = element_text(colour = "black"))+
  scale_y_continuous(breaks = c(0,1,2,3,4,5,6), 
                     limits = c(0,6)) +
  scale_x_continuous(breaks = c( -1.1, -.8, -.6,  -.4,  -.2,  0,.2 ,.4, .6, .8, 1), 
                     limits = c(-1.3, 1))
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.

Q1. Do people feel less gratitude as friendship ages?

summary(Q1 <- lmer(gratScale ~ wtr + I(wtr^2) + (wtrDiff + week | subID) + (1 | fid), data = d1))
## Linear mixed model fit by REML ['lmerMod']
## Formula: gratScale ~ wtr + I(wtr^2) + (wtrDiff + week | subID) + (1 |      fid)
##    Data: d1
## 
## REML criterion at convergence: 3445.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.2108 -0.4792  0.0597  0.5259  3.2661 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr       
##  fid      (Intercept) 0.56794  0.7536              
##  subID    (Intercept) 0.99861  0.9993              
##           wtrDiff     0.11248  0.3354   -0.78      
##           week        0.08004  0.2829   -0.32  0.84
##  Residual             0.89785  0.9475              
## Number of obs: 1042, groups:  fid, 423; subID, 98
## 
## Fixed effects:
##             Estimate Std. Error t value
## (Intercept)   1.3150     0.2070   6.354
## wtr           5.6199     0.6381   8.807
## I(wtr^2)     -2.6520     0.5415  -4.898
## 
## Correlation of Fixed Effects:
##          (Intr) wtr   
## wtr      -0.725       
## I(wtr^2)  0.565 -0.950
summary(Q1 <- lmer(gratScale ~ wtrDiff + I(wtrDiff^2) + (wtrDiff + week | subID) + (1 | fid), data = d1))
## Linear mixed model fit by REML ['lmerMod']
## Formula: gratScale ~ wtrDiff + I(wtrDiff^2) + (wtrDiff + week | subID) +  
##     (1 | fid)
##    Data: d1
## 
## REML criterion at convergence: 3569.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.3493 -0.4740  0.0545  0.4814  3.2195 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr       
##  fid      (Intercept) 0.9531   0.9763              
##  subID    (Intercept) 0.8414   0.9173              
##           wtrDiff     0.4696   0.6852   -0.66      
##           week        0.0707   0.2659   -0.30  0.79
##  Residual             0.9208   0.9596              
## Number of obs: 1042, groups:  fid, 423; subID, 98
## 
## Fixed effects:
##              Estimate Std. Error t value
## (Intercept)    3.5918     0.1165  30.824
## wtrDiff        1.0366     0.2074   4.997
## I(wtrDiff^2)  -1.3199     0.3809  -3.465
## 
## Correlation of Fixed Effects:
##             (Intr) wtrDff
## wtrDiff     -0.053       
## I(wtrDff^2) -0.152  0.115
tab_model(Q1, 
          show.df = T, 
          show.ci = .95,
          show.se = T,
          show.stat = T,
          string.stat = "t",
          string.se="SE",
          string.est = "Est",
          digits = 2)
  gratScale
Predictors Est SE CI t p df
(Intercept) 3.59 0.12 3.36 – 3.82 30.82 <0.001 1031.00
wtrDiff 1.04 0.21 0.63 – 1.44 5.00 <0.001 1031.00
wtrDiff^2 -1.32 0.38 -2.07 – -0.57 -3.47 0.001 1031.00
Random Effects
σ2 0.92
τ00 fid 0.95
τ00 subID 0.84
τ11 subID.wtrDiff 0.47
τ11 subID.week 0.07
ρ01 subID.wtrDiff -0.66
ρ01 subID.week -0.30
ICC 0.66
N subID 98
N fid 423
Observations 1042
Marginal R2 / Conditional R2 0.025 / 0.673 
p <- plot_model(Q1, type = "pred", terms = "wtrDiff", 
           show.data = T,
           jitter = .05,
           line.size = 1.5,
           dot.size = .8,
           title = "") +
  ylab("gratitude scale") +
  xlab("change in welfare trade-off ratio") +
  theme_minimal() +
  theme(panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        panel.background = element_blank(), 
        axis.line = element_line(colour = "black"),
        text = element_text(size = 17),
        axis.text = element_text(colour = "black"))+
  scale_y_continuous(breaks = c(0,1,2,3,4,5,6), 
                     limits = c(0, 6)) +
  scale_x_continuous(breaks = c(-1, -.8, -.6,  -.4,  -.2,  0, .2 ,.4, .6, .8, 1), 
                     limits = c(-1.1, 1))
## Model contains polynomial or cubic / quadratic terms. Consider using
##   `terms="wtrDiff [all]"` to get smooth plots. See also package-vignette
##   'Marginal Effects at Specific Values'.
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.

Q2. Do changes in WTRs predict changes in friendship rank each week?

#m <- lmer(rankDiff ~ gratitude + (gratitude + week | subID) + (1 | fid), data = d1)

#tab_model(m1, 
#          show.df = F, 
#          show.ci = F,
#          show.se = F,
#          show.stat = T,
#          string.stat = "t",
#          string.se="SE",
#          string.est = "Est",
#          digits = 2)

Q3: Do WTR proxies (i.e., closeness, commitment, and IOS) also show same patterns with gratitude?

### closeness
h1 <- lmer(close ~ rank + (rank + week | subID)  + (1 | fid), data = d1)
h2<- lmer(close ~ wtr + (wtr + week | subID)  + (1 | fid), data = d1)
h3 <- lmer(close ~ wtrDiff + (wtrDiff + week | subID) + (1 | fid), data = d1)
## boundary (singular) fit: see help('isSingular')
### commitment
h1 <- lmer(commit ~ rank + (rank + week | subID), data = d1)
h2<- lmer(commit ~ wtr + (wtr + week | subID) , data = d1)
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00466312 (tol = 0.002, component 1)
h3 <- lmer(commit ~ wtrDiff + (wtrDiff + week | subID), data = d1)
## boundary (singular) fit: see help('isSingular')
### IOS
h1 <- lmer(ios ~ rank + (rank + week | subID), data = d1)
h2<- lmer(ios ~ wtr + (wtr + week | subID) , data = d1)
h3 <- lmer(ios ~ wtrDiff + (wtrDiff + week | subID), data = d1)
## boundary (singular) fit: see help('isSingular')
tab_model(h1, h2, h3, 
          show.df = F, 
          show.ci = F,
          show.se = F,
          show.stat = T,
          string.stat = "t",
          string.se="SE",
          string.est = "Est",
          digits = 2)
  ios ios ios
Predictors Est t p Est t p Est t p
(Intercept) 5.82 46.03 <0.001 2.38 15.67 <0.001 4.23 43.41 <0.001
rank -0.61 -13.02 <0.001
wtr 3.22 14.19 <0.001
wtrDiff 0.71 2.88 0.004
Random Effects
σ2 0.98 1.22 1.60
τ00 1.25 subID 1.58 subID 0.67 subID
τ11 0.17 subID.rank 2.66 subID.wtr 0.52 subID.wtrDiff
0.02 subID.week 0.03 subID.week 0.00 subID.week
ρ01 -0.72 -0.75 -0.30
-0.18 -0.53 0.95
ICC 0.47 0.44 0.30
N 101 subID 99 subID 98 subID
Observations 1615 1575 1047
Marginal R2 / Conditional R2 0.201 / 0.577 0.318 / 0.615 0.008 / 0.309

Q4: does need correlate with gratitude?

h2<- lmer(gratScale ~ need + (need + week | subID) + (1 | fid) , data = d1)
## boundary (singular) fit: see help('isSingular')
tab_model(h2, 
          show.df = F, 
          show.ci = F,
          show.se = F,
          show.stat = T,
          string.stat = "t",
          string.se="SE",
          string.est = "Est",
          digits = 2)
  gratScale
Predictors Est t p
(Intercept) 3.43 8.81 <0.001
need 0.02 0.21 0.834
Random Effects
σ2 1.02
τ00 fid 0.99
τ00 subID 1.32
τ11 subID.need 0.00
τ11 subID.week 0.06
ρ01 subID.need -1.00
ρ01 subID.week -0.37
N subID 101
N fid 467
Observations 1218
Marginal R2 / Conditional R2 0.000 / NA

Q5: Is it change in WTR that predicts or does WTR predict gratitude?

#use bobqa
summary(Q5 <- lmer(gratScale ~ wtr + wtr.past + (wtr + wtr.past + week | subID), 
               control = lmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 100000)),
               data = d1))
## boundary (singular) fit: see help('isSingular')
## Linear mixed model fit by REML ['lmerMod']
## Formula: gratScale ~ wtr + wtr.past + (wtr + wtr.past + week | subID)
##    Data: d1
## Control: lmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 1e+05))
## 
## REML criterion at convergence: 3528
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.1974 -0.5205  0.0470  0.5825  3.3028 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr             
##  subID    (Intercept) 3.49908  1.8706                    
##           wtr         1.38207  1.1756   -0.87            
##           wtr.past    1.49566  1.2230   -0.74  0.94      
##           week        0.05461  0.2337   -0.53  0.62  0.37
##  Residual             1.26268  1.1237                    
## Number of obs: 1042, groups:  subID, 98
## 
## Fixed effects:
##             Estimate Std. Error t value
## (Intercept)   1.8064     0.2310   7.819
## wtr           2.7733     0.2651  10.461
## wtr.past      0.1344     0.2687   0.500
## 
## Correlation of Fixed Effects:
##          (Intr) wtr   
## wtr      -0.542       
## wtr.past -0.535 -0.174
## optimizer (bobyqa) convergence code: 0 (OK)
## boundary (singular) fit: see help('isSingular')
tab_model(Q5, 
          show.df = T, 
          show.ci = .95,
          show.se = T,
          show.stat = T,
          string.stat = "t",
          string.se="SE",
          string.est = "Est",
          digits = 2)
  gratScale
Predictors Est SE CI t p df
(Intercept) 1.81 0.23 1.35 – 2.26 7.82 <0.001 1028.00
wtr 2.77 0.27 2.25 – 3.29 10.46 <0.001 1028.00
wtr past 0.13 0.27 -0.39 – 0.66 0.50 0.617 1028.00
Random Effects
σ2 1.26
τ00 subID 3.50
τ11 subID.wtr 1.38
τ11 subID.wtr.past 1.50
τ11 subID.week 0.05
ρ01 -0.87
-0.74
-0.53
N subID 98
Observations 1042
Marginal R2 / Conditional R2 0.392 / NA 
plot_model(Q5, type = "pred", terms = "wtr", 
           show.data = T,
           jitter = .05,
           line.size = 1.5,
           dot.size = .8,
           title = "") +
  ylab("gratitude scale") +
  xlab("current week welfare trade-off ratio") +
  theme_minimal() +
  theme(panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        panel.background = element_blank(), 
        axis.line = element_line(colour = "black"),
        text = element_text(size = 17),
        axis.text = element_text(colour = "black"))+
  scale_y_continuous(breaks = c(0,1,2,3,4,5,6), 
                     limits = c(0, 6)) +
  scale_x_continuous(breaks = c(0, .2 ,.4, .6, .8, 1, 1.2), 
                     limits = c(0, 1.2))
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.
## Warning: Removed 118 rows containing missing values (`geom_point()`).

  • present as a table
  • all are highly corr with WTR
  • rank 1 = highest (closest friend)
summary(h3<- lmer(gratScale ~ wtrDiff + close + commit + ios + rank + (wtrDiff + close + commit + ios + rank + week | subID) + (wtrDiff||fid), control = lmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 100000)), data = d1))
## boundary (singular) fit: see help('isSingular')
## Linear mixed model fit by REML ['lmerMod']
## Formula: gratScale ~ wtrDiff + close + commit + ios + rank + (wtrDiff +  
##     close + commit + ios + rank + week | subID) + ((1 | fid) +  
##     (0 + wtrDiff | fid))
##    Data: d1
## Control: lmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 1e+05))
## 
## REML criterion at convergence: 2822
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.0387 -0.4550  0.0483  0.4816  3.6921 
## 
## Random effects:
##  Groups   Name        Variance  Std.Dev.  Corr                               
##  fid      wtrDiff     3.269e-10 1.808e-05                                    
##  fid.1    (Intercept) 2.660e-01 5.157e-01                                    
##  subID    (Intercept) 8.534e-01 9.238e-01                                    
##           wtrDiff     8.926e-02 2.988e-01 -0.23                              
##           close       4.021e-02 2.005e-01  0.18  0.52                        
##           commit      8.294e-02 2.880e-01  0.23 -0.81 -0.59                  
##           ios         7.727e-02 2.780e-01 -0.69 -0.04 -0.59 -0.18            
##           rank        2.711e-02 1.647e-01 -0.18  0.51  0.57 -0.13 -0.56      
##           week        4.100e-02 2.025e-01 -0.61  0.32  0.45 -0.27  0.06  0.52
##  Residual             6.422e-01 8.013e-01                                    
## Number of obs: 943, groups:  fid, 390; subID, 98
## 
## Fixed effects:
##             Estimate Std. Error t value
## (Intercept)  1.26716    0.27564   4.597
## wtrDiff      0.63046    0.17441   3.615
## close        0.16642    0.06444   2.583
## commit       0.28259    0.06344   4.455
## ios          0.14058    0.05598   2.511
## rank        -0.11302    0.04402  -2.567
## 
## Correlation of Fixed Effects:
##         (Intr) wtrDff close  commit ios   
## wtrDiff  0.114                            
## close   -0.176  0.007                     
## commit  -0.181 -0.082 -0.572              
## ios     -0.335 -0.059 -0.410 -0.197       
## rank    -0.687 -0.044  0.261  0.042  0.006
## optimizer (bobyqa) convergence code: 0 (OK)
## boundary (singular) fit: see help('isSingular')
tab_model(h3, 
          show.df = T, 
          show.ci = .95,
          show.se = T,
          show.stat = T,
          string.stat = "t",
          string.se="SE",
          string.est = "Est",
          digits = 2)
  gratScale
Predictors Est SE CI t p df
(Intercept) 1.27 0.28 0.73 – 1.81 4.60 <0.001 906.00
wtrDiff 0.63 0.17 0.29 – 0.97 3.61 <0.001 906.00
close 0.17 0.06 0.04 – 0.29 2.58 0.010 906.00
commit 0.28 0.06 0.16 – 0.41 4.45 <0.001 906.00
ios 0.14 0.06 0.03 – 0.25 2.51 0.012 906.00
rank -0.11 0.04 -0.20 – -0.03 -2.57 0.010 906.00
Random Effects
σ2 0.64
τ00 fid.1 0.27
τ00 subID 0.85
τ11 subID.wtrDiff 0.09
τ11 subID.close 0.04
τ11 subID.commit 0.08
τ11 subID.ios 0.08
τ11 subID.rank 0.03
τ11 subID.week 0.04
τ11 fid.wtrDiff 0.00
ρ01 subID.wtrDiff -0.23
ρ01 subID.close 0.18
ρ01 subID.commit 0.23
ρ01 subID.ios -0.69
ρ01 subID.rank -0.18
ρ01 subID.week -0.61
ICC 0.58
N subID 98
N fid 390
Observations 943
Marginal R2 / Conditional R2 0.323 / 0.715 
p <-plot_model(h3, type = "pred", terms = "wtrDiff", 
           show.data = T,
           jitter = .05,
           line.size = 1.5,
           dot.size = .8,
           title = "") +
  ylab("gratitude scale") +
  xlab("change in welfare trade-off ratio") +
  theme_minimal() +
  theme(panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        panel.background = element_blank(), 
        axis.line = element_line(colour = "black"),
        text = element_text(size = 17),
        axis.text = element_text(colour = "black"))+
  scale_y_continuous(breaks = c(0,1,2,3,4,5,6), 
                     limits = c(0, 6)) +
  scale_x_continuous(breaks = c( -1, -.8, -.6,  -.4,  -.2,  0, .2 ,.4, .6, .8, 1), 
                     limits = c(-1.1, 1))
## Scale for y is already present.
## Adding another scale for y, which will replace the existing scale.