# Libraries
#install.packages("tidyverse")
#install.packages("ggthemes")
#install.packages("ggplot2")
#install.packages("insight")
#install.packages("janitor")
#install.packages("rmarkdown")
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ readr 2.1.5
## ✔ ggplot2 3.5.1 ✔ stringr 1.5.1
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(rmarkdown)
library(janitor)
##
## Attaching package: 'janitor'
##
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.test
library(flextable)
##
## Attaching package: 'flextable'
##
## The following object is masked from 'package:purrr':
##
## compose
library(insight)
##
## Attaching package: 'insight'
##
## The following object is masked from 'package:janitor':
##
## clean_names
library(tinytex)
# Read Data
cbd_suscept <- read.csv("C://Users/brebouss/OneDrive - Wake Forest Baptist Health/Projects/CBD/SurveyData.csv", na.strings = '')
cbd_suscept <- data.frame(cbd_suscept)
# remove incompletes
cbd_suscept <- cbd_suscept[cbd_suscept$form_1_complete !=0,]
# create CBD user groups
# current users (usestatus=1), former users (usestatus=2), never users (usestatus=3)
cbd_suscept$usestatus[cbd_suscept$cbd_use==1 | cbd_suscept$cbd_use==2 | cbd_suscept$cbd_use==3] <- 1
cbd_suscept$usestatus[cbd_suscept$cbd_use==4 | cbd_suscept$cbd_use==5 ] <- 2
cbd_suscept$usestatus[cbd_suscept$cbd_use==6] <- 3
cbd_suscept$usestatus <- factor(cbd_suscept$usestatus,
levels=c(1,2,3),
labels=c("current", "former", "never"))
table1 <- cbd_suscept %>% tabyl(usestatus) %>%
adorn_pct_formatting(digits=2) %>%
knitr::kable(caption="Table 1. CBD User Status",
align="lccccc")
# create traditional susceptibility measure
cbd_suscept$traditional[(cbd_suscept$susc_1==3 | cbd_suscept$susc_1==4 |
cbd_suscept$susc_2==3 | cbd_suscept$susc_2==4 |
cbd_suscept$susc_3==3 | cbd_suscept$susc_3==4)] <- 1
cbd_suscept$traditional[(cbd_suscept$susc_1==1 | cbd_suscept$susc_1==2) &
(cbd_suscept$susc_2==1 | cbd_suscept$susc_2==2) &
(cbd_suscept$susc_3==1 | cbd_suscept$susc_3==2)] <- 0
cbd_suscept$traditional[cbd_suscept$usestatus=="current"] <- 'NA'
cbd_suscept$traditional <- factor(cbd_suscept$traditional,
levels=c(0,1),
labels=c("non-susceptible", "susceptible"))
# create five item susceptibility measure
cbd_suscept$susc5item[cbd_suscept$susc_1==3 | cbd_suscept$susc_1==4 |
cbd_suscept$susc_2==3 | cbd_suscept$susc_2==4 |
cbd_suscept$susc_3==3 | cbd_suscept$susc_3==4 |
cbd_suscept$susp_posexperience==3 |
cbd_suscept$susp_posexperience==4 |
cbd_suscept$susp_negexperience==3 |
cbd_suscept$susp_negexperience==4 ] <- 1
cbd_suscept$susc5item[(cbd_suscept$susc_1==1 | cbd_suscept$susc_1==2) &
(cbd_suscept$susc_2==1 | cbd_suscept$susc_2==2) &
(cbd_suscept$susc_3==1 | cbd_suscept$susc_3==2) &
(cbd_suscept$susp_posexperience==1 |
cbd_suscept$susp_posexperience==2) &
(cbd_suscept$susp_negexperience==1 |
cbd_suscept$susp_negexperience==2)] <- 0
cbd_suscept$susc5item[cbd_suscept$usestatus=="current"] <- 'NA'
cbd_suscept$susc5item <- factor(cbd_suscept$susc5item,
levels=c(0,1),
labels=c("non-susceptible", "susceptible"))
table(cbd_suscept$susc5item)
##
## non-susceptible susceptible
## 26 381
table(cbd_suscept$susc5item,cbd_suscept$usestatus)
##
## current former never
## non-susceptible 0 13 13
## susceptible 0 233 148
# create 2 item susceptibility measure
cbd_suscept$susc2item[
cbd_suscept$susp_posexperience==3 |
cbd_suscept$susp_posexperience==4 |
cbd_suscept$susp_negexperience==3 |
cbd_suscept$susp_negexperience==4 ] <- 1
cbd_suscept$susc2item[
(cbd_suscept$susp_posexperience==1 |
cbd_suscept$susp_posexperience==2) &
(cbd_suscept$susp_negexperience==1 |
cbd_suscept$susp_negexperience==2)] <- 0
cbd_suscept$susc2item[cbd_suscept$usestatus=="current"] <- 'NA'
cbd_suscept$susc2item <- factor(cbd_suscept$susc2item,
levels=c(0,1),
labels=c("non-susceptible", "susceptible"))
table(cbd_suscept$susc2item)
##
## non-susceptible susceptible
## 61 346
table(cbd_suscept$susc2item,cbd_suscept$usestatus)
##
## current former never
## non-susceptible 0 38 23
## susceptible 0 208 138
#labels for outcomes
cbd_suscept$likelihood_buy1 <- factor(cbd_suscept$liklihood_buy1,
levels=c(1,2,3,4,5),
labels=c("Extremely Unlikely",
"Somewhat unlikely",
"Neither likely or unlikely",
"Somewhat likely",
"Extremely likely"))
cbd_suscept$likelihood_buy2 <- factor(cbd_suscept$liklihood_buy2,
levels=c(1,2,3,4,5),
labels=c("Extremely Unlikely",
"Somewhat unlikely",
"Neither likely or unlikely",
"Somewhat likely",
"Extremely likely"))
cbd_suscept$try_1 <- factor(cbd_suscept$try_1,
levels=c(1,2,3,4,5),
labels=c("Extremely Unlikely",
"Somewhat unlikely",
"Neither likely or unlikely",
"Somewhat likely",
"Extremely likely"))
# cross tabs of susceptibility by likelihood buy/try
table2 <- cbd_suscept %>% tabyl(traditional, likelihood_buy1, show_na=FALSE) %>%
adorn_percentages("row") %>%
adorn_pct_formatting(digits=2) %>%
adorn_ns() %>%
adorn_title("combined") %>%
knitr::kable(caption="Table 2. Traditional Susceptibility by Likelihood Buy Next Month",
align="lccccc")
table3 <- cbd_suscept %>% tabyl(susc5item, likelihood_buy1, show_na=FALSE) %>%
adorn_percentages("row") %>%
adorn_pct_formatting(digits=2) %>%
adorn_ns() %>%
adorn_title("combined") %>%
knitr::kable(caption="Table 3. Five-Item Susceptibility by Likelihood Buy Next Month",
align="lccccc")
table4 <- cbd_suscept %>% tabyl(susc2item, likelihood_buy1, show_na=FALSE) %>%
adorn_percentages("row") %>%
adorn_pct_formatting(digits=2) %>%
adorn_ns() %>%
adorn_title("combined") %>%
knitr::kable(caption="Table 4. Two-Item Susceptibility by Likelihood Buy Next Month",
align="lccccc")
table5 <- cbd_suscept %>% tabyl(traditional, likelihood_buy2, show_na=FALSE) %>%
adorn_percentages("row") %>%
adorn_pct_formatting(digits=2) %>%
adorn_ns() %>%
adorn_title("combined") %>%
knitr::kable(caption="Table 5. Traditional Susceptibility by Likelihood Buy Next Year",
align="lccccc")
table6 <- cbd_suscept %>% tabyl(susc5item, likelihood_buy2, show_na=FALSE) %>%
adorn_percentages("row") %>%
adorn_pct_formatting(digits=2) %>%
adorn_ns() %>%
adorn_title("combined") %>%
knitr::kable(caption="Table 6. Five-Item Susceptibility by Likelihood Buy Next Year",
align="lccccc")
table7 <- cbd_suscept %>% tabyl(susc2item, likelihood_buy2, show_na=FALSE) %>%
adorn_percentages("row") %>%
adorn_pct_formatting(digits=2) %>%
adorn_ns() %>%
adorn_title("combined") %>%
knitr::kable(caption="Table 7. Two-Item Susceptibility by Likelihood Buy Next Year",
align="lccccc")
table8 <- cbd_suscept %>% tabyl(traditional, try_1, show_na=FALSE) %>%
adorn_percentages("row") %>%
adorn_pct_formatting(digits=2) %>%
adorn_ns() %>%
adorn_title("combined") %>%
knitr::kable(caption="Table 8. Traditional Susceptibility by Likelihood to Try",
align="lccccc")
table9 <- cbd_suscept %>% tabyl(susc5item, try_1, show_na=FALSE) %>%
adorn_percentages("row") %>%
adorn_pct_formatting(digits=2) %>%
adorn_ns() %>%
adorn_title("combined") %>%
knitr::kable(caption="Table 9. Five-Item Susceptibility by Likelihood to Try",
align="lccccc")
table10 <- cbd_suscept %>% tabyl(susc2item, try_1, show_na=FALSE) %>%
adorn_percentages("row") %>%
adorn_pct_formatting(digits=2) %>%
adorn_ns() %>%
adorn_title("combined") %>%
knitr::kable(caption="Table 10. Two-Item Susceptibility by Likelihood to Try",
align="lccccc")
table1
Table 1. CBD User Status
| current |
195 |
32.39% |
| former |
246 |
40.86% |
| never |
161 |
26.74% |
table2
Table 2. Traditional Susceptibility by Likelihood Buy Next
Month
| non-susceptible |
85.05% (91) |
13.08% (14) |
0.00% (0) |
0.93% (1) |
0.93% (1) |
| susceptible |
26.67% (80) |
30.67% (92) |
26.33% (79) |
14.67% (44) |
1.67% (5) |
table3
Table 3. Five-Item Susceptibility by Likelihood Buy Next
Month
| non-susceptible |
96.15% (25) |
3.85% (1) |
0.00% (0) |
0.00% (0) |
0.00% (0) |
| susceptible |
38.32% (146) |
27.56% (105) |
20.73% (79) |
11.81% (45) |
1.57% (6) |
table4
Table 4. Two-Item Susceptibility by Likelihood Buy Next
Month
| non-susceptible |
67.21% (41) |
16.39% (10) |
13.11% (8) |
3.28% (2) |
0.00% (0) |
| susceptible |
37.57% (130) |
27.75% (96) |
20.52% (71) |
12.43% (43) |
1.73% (6) |
table5
Table 5. Traditional Susceptibility by Likelihood Buy Next
Year
| non-susceptible |
69.16% (74) |
27.10% (29) |
1.87% (2) |
1.87% (2) |
0.00% (0) |
| susceptible |
12.00% (36) |
23.33% (70) |
22.33% (67) |
29.67% (89) |
12.67% (38) |
table6
Table 6. Five-Item Susceptibility by Likelihood Buy Next
Year
| non-susceptible |
84.62% (22) |
15.38% (4) |
0.00% (0) |
0.00% (0) |
0.00% (0) |
| susceptible |
23.10% (88) |
24.93% (95) |
18.11% (69) |
23.88% (91) |
9.97% (38) |
table7
Table 7. Two-Item Susceptibility by Likelihood Buy Next
Year
| non-susceptible |
47.54% (29) |
27.87% (17) |
13.11% (8) |
8.20% (5) |
3.28% (2) |
| susceptible |
23.41% (81) |
23.70% (82) |
17.63% (61) |
24.86% (86) |
10.40% (36) |
table8
Table 8. Traditional Susceptibility by Likelihood to
Try
| non-susceptible |
49.53% (53) |
26.17% (28) |
11.21% (12) |
13.08% (14) |
0.00% (0) |
| susceptible |
5.67% (17) |
5.67% (17) |
11.33% (34) |
33.00% (99) |
44.33% (133) |
table9
Table 9. Five-Item Susceptibility by Likelihood to
Try
| non-susceptible |
42.31% (11) |
26.92% (7) |
19.23% (5) |
11.54% (3) |
0.00% (0) |
| susceptible |
15.49% (59) |
9.97% (38) |
10.76% (41) |
28.87% (110) |
34.91% (133) |
table10
Table 10. Two-Item Susceptibility by Likelihood to
Try
| non-susceptible |
24.59% (15) |
16.39% (10) |
21.31% (13) |
21.31% (13) |
16.39% (10) |
| susceptible |
15.90% (55) |
10.12% (35) |
9.54% (33) |
28.90% (100) |
35.55% (123) |