STATE OF THE PANDEMIC

FIGURE 1: CASES, DEATHS, AND KEY POLICY DECISIONS BY DATE.

#NOW = as.Date( Sys.time(), format = 'Y%-%m-%d')
NOW = as.Date('2020-06-18')
START = as.Date( '2020-01-19' )

TWN = WorldCOVIDdata('Taiwan',
                    StartDate = START, EndDate = NOW) %>%  
  select(cases, deaths, date, country) %>% 
  melt(id = c('date','country'))

# Allocated Data to dataframes for Key dates, Waves, and Taiwan Cases & Deaths.
Dates = data.frame( date = as.Date( c("2020-01-21", "2020-02-23", 
                                      "2020-01-26", "2020-01-28",
                                      '2020-01-30', "2020-02-03",
                                      '2020-02-07', '2020-02-11',
                                      '2020-03-18', '2020-04-09',
                                      '2020-04-11', '2020-04-19',
                                      '2020-05-10', '2020-05-20'
                                      ),
                                    '%Y-%m-%d'), 
                    text = c('1st case in Taiwan.', 'Wuhan flight ban.', 
                             'Chinese students & tourists denied entry.',
                             'Monitoring devices enforce quarantine.',
                             'Mask factories expropriated.',
                             'School & University opening postponed.',
                             'Chinese travel ban.',
                             'Mask output increases to 1.7M per day.',
                             'Foreigners travel ban. Arrivals must quarantine.',
                             'Public gatherings & clubs banned.',
                             'Google/Apple API announced.',
                             '22 infected navy officers.\nSMS notify public to isolate.',
                             'Risk of infection deemed low by CECC.',
                             'Google/Apple API launched.'
                             ))

Waves = data.frame( start = as.Date( c("2020-05-14", "2020-05-25", "2020-06-04", "2020-06-16")),
                   text  = c('Wave 1','Wave 2','Wave 3', 'Wave 4'))

ft = 3.8
p  = 0
c  = 'sienna1'

# Plot Cases & Deaths in TWN
TWNPlot = ggplot(TWN) + 
  geom_col(aes(date, value, group = variable, fill = variable), width = .8) + PltTheme + 
  scale_fill_manual(values = alpha(c('dodgerblue','red'), c(.35,1)),
       labels = c('Cases','Deaths')) + 
  scale_y_continuous( expand = c(0, .1), limits = c(0,max(TWN$value)) ) +
    scale_x_date(expand = c(0.0, 0), labels = date_format("%d-%b"), date_breaks = "14 days", 
                 limits = c(START,  NOW+1)) + 
    theme( legend.direction = 'vertical', 
          legend.position = c(.1,.9),
          axis.text.x = element_text(angle=45, hjust = 1)) + 
  labs(title = 'Daily COVID-19 cases, deaths and key dates in Taiwan', y = 'Frequency', x = 'Date') 

# Add Data collectiond dates.
for (d in 1:nrow(Waves)){
  TWNPlot = TWNPlot +
  annotate("rect", xmin = Waves$start[d], xmax = Waves$start[d]+.7, ymin = 0, ymax = Inf, fill = 'green',  alpha = .25) +
  annotate("text", x = Waves$start[d], y = Inf, label = Waves$text[d], angle=90, color = 'darkgreen', size=4.5, vjust=-.4, hjust='right', fontface = "bold")
}

# Add key dates
for (d in 1:nrow(Dates)){
  TWNPlot = TWNPlot +
    annotate("text", x = Dates$date[d], y = p+2, label = Dates$text[d], angle=90, color = 'black', size=ft, vjust=0+.25, hjust='left', fontface = "bold") +
    geom_segment(x = Dates$date[d], y = 1+TWN$value[(TWN$date == Dates$date[d] & TWN$variable == 'deaths')], yend = p, xend = Dates$date[d], color = 'gray10', size = 1, alpha = 0.5 )
}

TWNPlot = TWNPlot + annotate("text", x = as.Date('2020-05-28'), y = 10, label = 'Cases remain < 10\nas of October, 2020',, color = 'black', size=ft+1, vjust=0+.25, hjust='left', fontface = "bold")

ggsave(plot = TWNPlot, filename = 'Figures//Cases.pdf', dpi = 5000, width = 13, height = 6)
TWNPlot
Figure 1. Key dates, cases, and deaths related to COVID-19 in Taiwan.

Figure 1. Key dates, cases, and deaths related to COVID-19 in Taiwan.

Description of the data sample

complyM = mean(W$COVID_comply_percent)
complySD = sd(W$COVID_comply_percent)
Phoneuse = Per(W$PhoneUse,1,2)
COVIDpos = Per(W$COVID_pos, 1, 2)
COVIDposOth = Per(W$COVID_pos_others, 1, 2)
LockdownM = mean(W$COVID_ndays_4)
LockdownSD = sd(W$COVID_ndays_4)
JobLost = Per(W$COVID_lost_job, 1, 2)
SocialDist = 'moderately' # Looked at the mean & median distribution of the likert responses. 
GovSat_Policy = 'moderately' # Looked at the mean & median distribution of the likert responses. 
GovSat_Govern = 'moderately' # Looked at the mean & median distribution of the likert responses. 
GovSat_PubService = 'moderately' # Looked at the mean & median distribution of the likert responses. 
TotalP = nrow(Data$Raw)
CleanP = nrow(W)
Wave1P = nrow(W %>% filter(WaveN == 'Wave 1'))
Wave2P = nrow(W %>% filter(WaveN == 'Wave 2'))
Wave3P = nrow(W %>% filter(WaveN == 'Wave 3'))
Wave4P = nrow(W %>% filter(WaveN == 'Wave 4'))
Removed = TotalP - CleanP
InitialWaveP = TotalP / 4

6000 nationally representative Taiwanese participants were sampled in four waves of 1500 space roughly one week apart between the dates of May 14th 2020 and June 16th 2020. Participants were exlcuded from analysis if they did not pass a scenario comprehension check. In total, 3825 participants passed the comprehension check (participants who passed comprehension checks in each wave were Wave 1 = 971, Wave 2 = 1018, Wave 3 = 939, Wave 4 = 897). In total, 2175 participants were removed from the analysis.

The following statistics and subsiquent analyses relate only to those participants who passed the attention checks:

  • 99.69% of participants reported they used a mobile phone
  • 2.61% of participants knew someone who had tested positive with COVID-19
  • 0.44% of participants had tested positive with COVID-19
  • Participants had spent a mean of 0.6224837 (SD = 3.05249) of the previous days in lockdown.
  • 7.35% of participants had lost their job as a direct effect of COVID-19
  • On average, particianpnts thought 59.2901961% (SD = 25.3928438) of the population were complying with COVID-19 policies
  • Participants reported that they thought people were moderately complying with Social Distancing guidelines
  • Participants were moderately satisfied with i) Government COVID-19 policies, ii) Governance during the pandemic, and iii) public services’ during the pandemic.

Demographics: Figures and Tables

Summary Figures

ggplot(W) +
  geom_bar(aes(y = ..prop.., state, fill = WaveN, group = WaveN), position = 'dodge', color = 'white', size = .5, width = .82) + PltTheme +
  scale_fill_manual(values = WaveCols ) +
  scale_y_continuous( expand = c(0, 0), limits = c(0,.3), breaks = c(0, .1, .2, .3), labels = c('0','10','20','30') ) +
  theme( legend.position = 'none',
          axis.text.x = element_text(angle=45, hjust = 1)) +
  labs(title = 'City of Residence', y = 'Percent (%)', x = '')

ggplot(W) +
  geom_bar(aes(y = ..prop.., Agebins, fill = WaveN, group = WaveN), position = 'dodge', color = 'white', size = .5, width = .82) + PltTheme +
  scale_fill_manual(values = WaveCols ) +
  scale_y_continuous( expand = c(0, 0), limits = c(0,.3), breaks = c(0, .1, .2, .3), labels = c('0','10','20','30') ) +
  theme( legend.position = 'none',
          axis.text.x = element_text(angle=45, hjust = 1)) +
  labs(title = 'Age Distribution', y = 'Percent (%)', x = '')

ggplot(W) +
  geom_bar(aes(y = ..prop.., education, fill = WaveN, group = WaveN), position = 'dodge', color = 'white', size = .5, width = .82) + PltTheme +
  scale_fill_manual(values = WaveCols ) +
  scale_y_continuous( expand = c(0, 0), limits = c(0,1), breaks = c(0, .2, .4, .6, .8, 1), labels = c('0','20','40','60','80','100') ) +
  theme( legend.position = 'none',
          axis.text.x = element_text(angle=45, hjust = 1)) +
  labs(title = 'Education Distribution', y = 'Percent (%)', x = '')

ggplot(W) +
  geom_bar(aes(y = ..prop.., gender, fill = WaveN, group = WaveN), position = 'dodge', color = 'white', size = .5, width = .82) + PltTheme +
  scale_fill_manual(values = WaveCols ) +
  scale_y_continuous( expand = c(0, 0), limits = c(0,.6), breaks = c(0, .2, .4, .6), labels = c('0','20','40','60') ) +
  theme( legend.position = 'none',
          axis.text.x = element_text(angle=45, hjust = 1)) +
  labs(title = 'Gender Distribution', y = 'Percent (%)', x = '') + 
  xlim(c('Man','Woman'))

Descriptive Summary Tables

Education

cro_tpct(W$education, row_vars=W$WaveN) %>% set_caption("Level of education by wave: Percentages")  %>% rename(Percent = `#Total`)
Level of education by wave: Percentages
 Percent 
 W$WaveN 
   Wave 1   W$education   < H.Sch  1
    > H.Sch  12.3
    Uni  86.7
    #Total cases  971
   Wave 2   W$education   < H.Sch  0.7
    > H.Sch  13.8
    Uni  85.6
    #Total cases  1018
   Wave 3   W$education   < H.Sch  0.7
    > H.Sch  12.9
    Uni  86.4
    #Total cases  939
   Wave 4   W$education   < H.Sch  0.9
    > H.Sch  12.9
    Uni  86.2
    #Total cases  897 
cro_tpct(W$education) %>% set_caption("Level of education: Percentages")  %>% rename(Percent = `#Total`)
Level of education: Percentages
 Percent 
 W$education 
   < H.Sch  0.8
   > H.Sch  13
   Uni  86.2
   #Total cases  3825

Gender

cro_tpct(W$gender, row_vars=W$WaveN) %>% set_caption("Gender by wave: Percentages")  %>% rename(Percent = `#Total`)
Gender by wave: Percentages
 Percent 
 W$WaveN 
   Wave 1   W$gender   Man  47.9
    Woman  52.1
    Other 
    Prefer not to say 
    #Total cases  971
   Wave 2   W$gender   Man  47.2
    Woman  52.6
    Other  0.2
    Prefer not to say 
    #Total cases  1018
   Wave 3   W$gender   Man  48
    Woman  51.8
    Other  0.1
    Prefer not to say  0.1
    #Total cases  939
   Wave 4   W$gender   Man  50.1
    Woman  49.7
    Other 
    Prefer not to say  0.2
    #Total cases  897 
cro_tpct(W$gender) %>% set_caption("Gender: Percentages")  %>% rename(Percent = `#Total`)
Gender: Percentages
 Percent 
 W$gender 
   Man  48.3
   Woman  51.6
   Other  0.1
   Prefer not to say  0.1
   #Total cases  3825

City of residence

cro_tpct(W$state, row_vars=W$WaveN) %>% set_caption("City by wave: Percentages")  %>% rename(Percent = `#Total`)
City by wave: Percentages
 Percent 
 W$WaveN 
   Wave 1   W$state   Changhua  4.4
    Chiayi  1.2
    Chiayi city  1.6
    Hsinchu city  1.9
    Hsinchu county  0.7
    Hualien  1.6
    Kaohsiung  18.4
    Keelung  0.7
    Miaoli  2.6
    Nantou  1.6
    New Taipei  13.4
    Pingtung  1.4
    Taichung  22.6
    Tainan  10.7
    Taipei  11
    Taitung  0.3
    Taoyuan  4.1
    Yilan  0.3
    Yunlin  1.2
    #Total cases  971
   Wave 2   W$state   Changhua  4
    Chiayi  1.4
    Chiayi city  1.4
    Hsinchu city  2.1
    Hsinchu county  0.8
    Hualien  1.9
    Kaohsiung  19.1
    Keelung  0.5
    Miaoli  2.8
    Nantou  1.4
    New Taipei  13
    Pingtung  2.4
    Taichung  19.6
    Tainan  11.3
    Taipei  12
    Taitung  0.6
    Taoyuan  4.3
    Yilan  0.3
    Yunlin  1.4
    #Total cases  1018
   Wave 3   W$state   Changhua  3.2
    Chiayi  1.2
    Chiayi city  0.5
    Hsinchu city  2.2
    Hsinchu county  1.3
    Hualien  2.1
    Kaohsiung  19.4
    Keelung  1.1
    Miaoli  1.8
    Nantou  0.9
    New Taipei  11.4
    Pingtung  1.9
    Taichung  23.5
    Tainan  10.6
    Taipei  13.1
    Taitung  0.7
    Taoyuan  4.2
    Yilan  0.2
    Yunlin  0.6
    #Total cases  939
   Wave 4   W$state   Changhua  6.1
    Chiayi  1.1
    Chiayi city  1.2
    Hsinchu city  2.1
    Hsinchu county  1.3
    Hualien  1.6
    Kaohsiung  15.4
    Keelung  0.6
    Miaoli  3.5
    Nantou  1.4
    New Taipei  14.4
    Pingtung  2.6
    Taichung  18.7
    Tainan  11.5
    Taipei  10.7
    Taitung  0.4
    Taoyuan  5.4
    Yilan  0.2
    Yunlin  1.8
    #Total cases  897 
cro_tpct(W$state) %>% set_caption("City: Percentages")  %>% rename(Percent = `#Total`)
City: Percentages
 Percent 
 W$state 
   Changhua  4.4
   Chiayi  1.2
   Chiayi city  1.2
   Hsinchu city  2.1
   Hsinchu county  1
   Hualien  1.8
   Kaohsiung  18.1
   Keelung  0.7
   Miaoli  2.6
   Nantou  1.3
   New Taipei  13
   Pingtung  2.1
   Taichung  21.1
   Tainan  11
   Taipei  11.7
   Taitung  0.5
   Taoyuan  4.5
   Yilan  0.3
   Yunlin  1.3
   #Total cases  3825

Age Bins

cro_tpct(W$Agebins, row_vars=W$WaveN) %>% set_caption("Age bins by wave: Percentages")  %>% rename(Percent = `#Total`)
Age bins by wave: Percentages
 Percent 
 W$WaveN 
   Wave 1   W$Agebins   20-29  25.6
    30-39  24.1
    40-49  25.2
    50-59  18.8
    60-69  5.8
    70-79  0.3
    80+  0.1
    #Total cases  971
   Wave 2   W$Agebins   20-29  26.9
    30-39  24.1
    40-49  25
    50-59  16.8
    60-69  6.5
    70-79  0.8
    80+ 
    #Total cases  1018
   Wave 3   W$Agebins   20-29  23.5
    30-39  24.9
    40-49  26.3
    50-59  20.4
    60-69  4.7
    70-79 
    80+  0.1
    #Total cases  939
   Wave 4   W$Agebins   20-29  24.2
    30-39  24.7
    40-49  25.6
    50-59  17.7
    60-69  6.2
    70-79  1.3
    80+  0.1
    #Total cases  897 
cro_tpct(W$Agebins) %>% set_caption("Age bins: Percentages")  %>% rename(Percent = `#Total`)
Age bins: Percentages
 Percent 
 W$Agebins 
   20-29  25.1
   30-39  24.4
   40-49  25.5
   50-59  18.4
   60-69  5.8
   70-79  0.6
   80+  0.1
   #Total cases  3825

Information Sources about COVID-19

cro_tpct(W$COVID_info_source, row_vars=W$WaveN) %>% set_caption("COVID Info Source by wave: Percentages")  %>% rename(Percent = `#Total`)
COVID Info Source by wave: Percentages
 Percent 
 W$WaveN 
   Wave 1   W$COVID_info_source   Friend/ Family  1
    News  60.7
    Other  0.4
    Radio  0.1
    S.Media  12.8
    TV  25
    #Total cases  971
   Wave 2   W$COVID_info_source   Friend/ Family  1.8
    News  65.3
    Other  0.3
    Radio  0.2
    S.Media  10.7
    TV  21.7
    #Total cases  1018
   Wave 3   W$COVID_info_source   Friend/ Family  0.7
    News  65.6
    Other  0.1
    Radio 
    S.Media  12.9
    TV  20.7
    #Total cases  939
   Wave 4   W$COVID_info_source   Friend/ Family  0.9
    News  64.4
    Other  0.4
    Radio  0.1
    S.Media  16.4
    TV  17.7
    #Total cases  897 
cro_tpct(W$COVID_info_source) %>% set_caption("COVID Info Source: Percentages")  %>% rename(Percent = `#Total`)
COVID Info Source: Percentages
 Percent 
 W$COVID_info_source 
   Friend/ Family  1.1
   News  64
   Other  0.3
   Radio  0.1
   S.Media  13.1
   TV  21.4
   #Total cases  3825

Figures for the national paper

FIGURE: RISKS FROM COVID-19

Var = c('COVID_gen_harm','COVID_pers_harm','COVID_pers_concern','COVID_concern_oth')
CoVars = gather(W %>% select(WaveN, Var), key = 'key', value = 'value', Var, -WaveN )
CoVars$key = factor(CoVars$key,labels=c("General\nharm","Personal\nharm","Concern\nself","Concern\nothers"))

MCMCd_risk = MCMCpack::MCMCoprobit(as.formula('value ~ 1 + WaveN * key'), data = CoVars, tune = 0.3, mcmc = 20000)
MCMCs = HDIsummary(MCMCd_risk, levels(CoVars$WaveN), levels(CoVars$key))
Lines = Siglines(MCMCs)

tsize = 3.8
Plt = ggplot(MCMCs$Means, aes(x = Factor2, y = .value, group = Factor1, fill = Factor1, color = Factor1)) + 
  geom_errorbar(aes(ymin = .lower, ymax = .upper, x = Factor2, group = Factor1),
                 position = position_dodge(.75), width = .5, size = 1.25, color = rep(WaveCols,each=4, alpha=1)) +
  geom_point(size = 2, shape = 21, stroke = 0, position = position_dodge(.75), alpha = 1) + 
  PltTheme + 
  scale_fill_manual(values = rep('black',4) ) + PltTheme + 
  scale_color_manual(values = WaveCols, labels = c("Wave 1", "Wave 2", "Wave 3", "Wave 4") ) +
  ylab('Posterior means') + xlab('') +
  scale_y_continuous(expand = c(.0, .1), breaks = 0:5, limits = c(-.7, 3.7),
                     labels = c('0','1','2','3','4','5')) +
  theme( legend.direction = 'horizontal',
         legend.position = c(.47,-.19),
         plot.margin=unit(c(0,.5,0.4,.5),"cm"),
         legend.text=element_text(size=14, face = 'bold'),
         legend.key.size = unit(2,"line"),
         legend.key = element_rect(fill = "white")) + 
  annotate('segment', x = 0.5, xend = 4.5, y = MCMCs$Cutpoints[1], yend = MCMCs$Cutpoints[1], alpha = .2, linetype = 'dashed') + 
  annotate('segment', x = 0.5, xend = 4.5, y = MCMCs$Cutpoints[2], yend = MCMCs$Cutpoints[2], alpha = .2, linetype = 'dashed') + 
  annotate('segment', x = 0.5, xend = 4.5, y = MCMCs$Cutpoints[3], yend = MCMCs$Cutpoints[3], alpha = .2, linetype = 'dashed') + 
  annotate('segment', x = 0.5, xend = 4.5, y = MCMCs$Cutpoints[4], yend = MCMCs$Cutpoints[4], alpha = .2, linetype = 'dashed') + 
  annotate('text', x = 4.5, y = MCMCs$Cutpoints[1] - MCMCs$Cutpoints[2]*.5, label = 'None', angle = 90, alpha = .5, size = tsize) + 
  annotate('text', x = 4.5, y = MCMCs$Cutpoints[1] + MCMCs$Cutpoints[2]*.5, label = 'Slight', angle = 90, alpha = .5, size = tsize) + 
  annotate('text', x = 4.5, y = MCMCs$Cutpoints[2] + (MCMCs$Cutpoints[3] - MCMCs$Cutpoints[2])*.5, label = 'Some', angle = 90, alpha = .5, size = tsize) + 
  annotate('text', x = 4.5, y = MCMCs$Cutpoints[3] + (MCMCs$Cutpoints[4] - MCMCs$Cutpoints[3])*.5, label = 'Very', angle = 90, alpha = .5, size = tsize) + 
  annotate('text', x = 4.5, y = MCMCs$Cutpoints[4] + (MCMCs$Cutpoints[4] - MCMCs$Cutpoints[3])*.4, label = 'Ext', angle = 90, alpha = .5, size = tsize) + 
  labs(title = 'Perceived risk from COVID-19') + 
  guides(colour = guide_legend(override.aes = list(shape = 15, size = 5)))

#for (ii in 1:length(Lines$y)){
#  Plt = Plt + annotate('segment', x = Lines$xi[ii], xend = Lines$xe[ii], y = Lines$y[ii], yend = Lines$y[ii] )
#}

ggsave(filename = 'Figures\\CovidRisks.pdf', plot = Plt, dpi = 5000, units = 'cm', height = 12.5, width = 18)
Plt

FIGURE: BENEFITS FROM TRACKING

Var = c('Reduce_Likelihood','Reduce_Spread','Return_Activity')
D = gather(W %>% select(Scenario, Var), key = 'key', value = 'value', Var, -Scenario )
D$key = factor(D$key,labels=c("Reduce contraction","Reduce spread", "Resume activities"))

MCMCd_benefits = MCMCpack::MCMCoprobit(as.formula('value ~ 1 + Scenario * key'), data = D, tune = 0.3, mcmc = 20000)
MCMCs = HDIsummary(MCMCd_benefits, levels(D$Scenario), levels(D$key))
Lines = Siglines(MCMCs, pos = c(-2, 0, 2), yoffset = .075 )

tsize = 3.8
Plt = ggplot(MCMCs$Means, aes(x = Factor2, y = .value, group = Factor1, fill = Factor1, color = Factor1)) + 
  geom_errorbar(aes(ymin = .lower, ymax = .upper, x = Factor2, group = Factor1),
                 position = position_dodge(.75), width = .4, size = 1.25, color = rep(PrimeCols[c(1,2,3)],each=3, alpha=1)) +
  geom_point(size = 2, shape = 21, stroke = 0, position = position_dodge(.75), alpha = 1) + 
  PltTheme + 
  scale_fill_manual(values = rep('black',4), guide = FALSE ) + PltTheme + 
  scale_color_manual(values = PrimeCols, labels = c("Telecommunication", "Bluetooth", "Gov App", "COVIDSafe") ) +
  ylab('Posterior means') + xlab('') +
  scale_y_continuous(expand = c(.0, .1), breaks = 0:5, limits = c(-.8, 4.7),
                     labels = c('0','1','2','3','4','5')) +
  theme( legend.direction = 'horizontal',
         legend.position = c(.44,-.13),
         plot.margin=unit(c(0,.5,0.5,.5),"cm"),
         legend.text=element_text(size=14, face = 'bold'),
         legend.key.size = unit(2,"line"),
         legend.key = element_rect(fill = "white")) +
  annotate('segment', x = 0.5, xend = 3.5, y = MCMCs$Cutpoints[1], yend = MCMCs$Cutpoints[1], alpha = .2, linetype = 'dashed') + 
  annotate('segment', x = 0.5, xend = 3.5, y = MCMCs$Cutpoints[2], yend = MCMCs$Cutpoints[2], alpha = .2, linetype = 'dashed') + 
  annotate('segment', x = 0.5, xend = 3.5, y = MCMCs$Cutpoints[3], yend = MCMCs$Cutpoints[3], alpha = .2, linetype = 'dashed') + 
  annotate('segment', x = 0.5, xend = 3.5, y = MCMCs$Cutpoints[4], yend = MCMCs$Cutpoints[4], alpha = .2, linetype = 'dashed') + 
  annotate('segment', x = 0.5, xend = 3.5, y = MCMCs$Cutpoints[5], yend = MCMCs$Cutpoints[5], alpha = .2, linetype = 'dashed') + 
  annotate('text', x = 3.5, y = MCMCs$Cutpoints[1] - MCMCs$Cutpoints[2]*.5, label = 'None', angle = 90, alpha = .5, size = tsize) + 
  annotate('text', x = 3.5, y = MCMCs$Cutpoints[1] + MCMCs$Cutpoints[2]*.5, label = 'Slight', angle = 90, alpha = .5, size = tsize) + 
  annotate('text', x = 3.5, y = MCMCs$Cutpoints[2] + (MCMCs$Cutpoints[3] - MCMCs$Cutpoints[2])*.5, label = 'A bit', angle = 90, alpha = .5, size = tsize) + 
    annotate('text', x = 3.5, y = MCMCs$Cutpoints[3] + (MCMCs$Cutpoints[4] - MCMCs$Cutpoints[3])*.5, label = 'Mod', angle = 90, alpha = .5, size = tsize) + 
  annotate('text', x = 3.5, y = MCMCs$Cutpoints[4] + (MCMCs$Cutpoints[5] - MCMCs$Cutpoints[4])*.5, label = 'A lot', angle = 90, alpha = .5, size = tsize) + 
  annotate('text', x = 3.5, y = MCMCs$Cutpoints[5] + (MCMCs$Cutpoints[5] - MCMCs$Cutpoints[4])*.3, label = 'Extr', angle = 90, alpha = .5, size = tsize) + 
  labs(title = 'Perceived benefits from tracking technologies') + 
  guides(colour = guide_legend(override.aes = list(shape = 15, size = 5)))

for (ii in 1:length(Lines$y)){
  Plt = Plt + annotate('segment', x = Lines$xi[ii], xend = Lines$xe[ii], y = Lines$y[ii], yend = Lines$y[ii] )
}

ggsave(filename = 'Figures\\TrackingBenefits.pdf', plot = Plt, dpi = 5000, units = 'cm', height = 12.5, width = 18)
Plt

FIGURE: RISKS FROM TRACKING

Var = c('Decline', 'Necessary', 'Sensitive', 'Risk', 'TrustIntentions', 'TrustPrivacy', 'Security', 'ongoing_control')
D = gather(W %>% select(Scenario, Var), key = 'key', value = 'value', Var, -Scenario )
D$key = factor(D$key,labels=c('Difficult\nDecline','Necessary\nData','Sensitive\nData','Risk','Trust\nIntentions','Trust\nPrivacy','Data\nsecurity','Ongoing\ncontrol'))
D$key = factor(D$key, c('Difficult\nDecline','Necessary\nData','Sensitive\nData','Risk','Trust\nIntentions','Trust\nPrivacy','Data\nsecurity','Ongoing\ncontrol'))
#D$value[D$key == 'Difficult\nDecline'] = revscore(D$value[D$key == 'Difficult\nDecline'], 6)

MCMCd_percepts = MCMCpack::MCMCoprobit(as.formula('value ~ 1 + Scenario * key'), data = D, tune = 0.3, mcmc = 20000)
MCMCs = HDIsummary(MCMCd_percepts, levels(D$Scenario), levels(D$key))
Lines = Siglines(MCMCs, pos = c(-2, 0, 2), yoffset = .075)

tsize = 3.8
Plt = ggplot(MCMCs$Means, aes(x = Factor2, y = .value, group = Factor1, fill = Factor1, color = Factor1)) + 
  geom_errorbar(aes(ymin = .lower, ymax = .upper, x = Factor2, group = Factor1),
                 position = position_dodge(.75), width = .5, size = 1.25, color = rep(PrimeCols[c(1,2,3)],each=8, alpha=1)) +
  geom_point(size = 2, shape = 21, stroke = 0, position = position_dodge(.75), alpha = 1) + 
  PltTheme + 
  scale_fill_manual(values = rep('black',4), guide = FALSE ) + PltTheme + 
  scale_color_manual(values = PrimeCols, labels = c("Telecommunication", "Bluetooth", "Gov App", "COVIDSafe") ) +
  ylab('Posterior means') + xlab('') +
  scale_y_continuous(expand = c(.0, .1), breaks = 0:7, limits = c(3, 7),
                     labels = c('0','1','2','3','4','5','6','7')) +
  theme( legend.direction = 'horizontal',
         legend.position = c(.47,-.2),
         plot.margin=unit(c(0,.5,0.8,.5),"cm"),
         legend.text=element_text(size=14, face = 'bold'),
         legend.key.size = unit(2,"line"),
         legend.key = element_rect(fill = "white")) +
  annotate('segment', x = 0.5, xend = 8.5, y = MCMCs$Cutpoints[1], yend = MCMCs$Cutpoints[1], alpha = .2, linetype = 'dashed') + 
  annotate('segment', x = 0.5, xend = 8.5, y = MCMCs$Cutpoints[2], yend = MCMCs$Cutpoints[2], alpha = .2, linetype = 'dashed') + 
  annotate('segment', x = 0.5, xend = 8.5, y = MCMCs$Cutpoints[3], yend = MCMCs$Cutpoints[3], alpha = .2, linetype = 'dashed') + 
  annotate('segment', x = 0.5, xend = 8.5, y = MCMCs$Cutpoints[4], yend = MCMCs$Cutpoints[4], alpha = .2, linetype = 'dashed') + 
  annotate('segment', x = 0.5, xend = 8.5, y = MCMCs$Cutpoints[5], yend = MCMCs$Cutpoints[5], alpha = .2, linetype = 'dashed') + 
  annotate('text', x = 8.5, y = MCMCs$Cutpoints[1] - MCMCs$Cutpoints[2]*.5, label = 'None', angle = 90, alpha = .5, size = tsize) + 
  annotate('text', x = 8.5, y = MCMCs$Cutpoints[1] + MCMCs$Cutpoints[2]*.5, label = 'Slight', angle = 90, alpha = .5, size = tsize) + 
  annotate('text', x = 8.5, y = MCMCs$Cutpoints[2] + (MCMCs$Cutpoints[3] - MCMCs$Cutpoints[2])*.5, label = 'A bit', angle = 90, alpha = .5, size = tsize) + 
    annotate('text', x = 8.5, y = MCMCs$Cutpoints[3] + (MCMCs$Cutpoints[4] - MCMCs$Cutpoints[3])*.5, label = 'Mod', angle = 90, alpha = .5, size = tsize) + 
  annotate('text', x = 8.5, y = MCMCs$Cutpoints[4] + (MCMCs$Cutpoints[5] - MCMCs$Cutpoints[4])*.5, label = 'A lot', angle = 90, alpha = .5, size = tsize) + 
  annotate('text', x = 8.5, y = MCMCs$Cutpoints[5] + (MCMCs$Cutpoints[5] - MCMCs$Cutpoints[4])*.5, label = 'Extr', angle = 90, alpha = .5, size = tsize) + 
  labs(title = 'Perceived risks from tracking technologies') + 
  guides(colour = guide_legend(override.aes = list(shape = 15, size = 5)))

for (ii in 1:length(Lines$y)){
  Plt = Plt + annotate('segment', x = Lines$xi[ii], xend = Lines$xe[ii], y = Lines$y[ii], yend = Lines$y[ii] )
}

ggsave(filename = 'Figures\\TrackingRisks.pdf', plot = Plt, dpi = 5000, units = 'cm', height = 13, width = 22)
Plt

FIGURE: ACCEPTABILITY OF TRACKING TECHNOLOGIES

D = W %>% select(Scenario, Accept2, Sunset, ChangeOther) %>% split(W$Scenario)
D$Telecommunication$ChangeOther = rowSums(cbind(D$Telecommunication$ChangeOther, D$Telecommunication$Accept2), na.rm=T)
D$`Government App`$ChangeOther = rowSums(cbind(D$`Government App`$ChangeOther, D$`Government App`$Accept2), na.rm=T)

CI = matrix(0, 9, 3)
count = 0
for (ii in 1:3){
  for (kk in 2:4){
    count = count + 1
    x = bayes.prop.test( as.integer(round(mean(D[[ii]][[kk]],na.rm=T) * 100)), nrow(D[[ii]]), n.iter = 20000 )
    CI[count,1] = x$stats[1,5] * 100
    CI[count,2] = x$stats[1,6] * 100
    CI[count,3] = mean(D[[ii]][[kk]],na.rm=T) * 100
  }
}

d = data.frame(Scenario = rep(levels(W$Scenario),each=3), key = c('Accept','Sunset','Opt Out', 'Accept', 'Sunset', 'NA','Accept', 'Sunset', 'Local Storage'), M = CI[,3], Low = CI[,1], High = CI[,2], color = c(1,.6,.4,1,.6,.4,1,.6,.4))
d = d[d$key != 'NA',]
d$Scenario = factor(d$Scenario, levels = c('Telecommunication', 'Bluetooth', 'Government App'))
d$key = factor(d$key, levels = c('Accept', 'Sunset', 'Opt Out', 'Local Storage'))
d$X   = c(.1, .19, .28, .43, .57, .73, .82, .91)


Plt = ggplot(d) + 
  geom_col(aes(y = M, x = Scenario, group = key, fill = Scenario),  alpha = d$color,
           position = 'dodge') + 
  geom_errorbar( aes(y = M, x = Scenario, group = key, fill = Scenario, ymin=M-Low, ymax=M+High), width=.2, position=position_dodge(.9)) +
  scale_fill_manual(values = PrimeCols ) + 
  PltTheme + 
  scale_y_continuous( expand = c(0, 0), limits = c(0,100) ) + 
  labs(title = 'Tracking Acceptability', y = 'Percent (%)', x = '') +
  theme( legend.direction = 'vertical', 
         plot.title = element_text(size = 16),
         axis.title = element_text(size=14),
         legend.key = element_rect(fill = "white"),
         legend.position = c(.5,-.23), 
         legend.text = element_text(size = 14),
         #plot.margin=unit(c(0,0,1.7,0),"cm"),
         plot.margin=unit(c(0,0,2.5,0),"cm"),
         axis.text.x = element_text(angle=45, hjust = 1, color = 'white',size=0)) + 
  guides(fill=guide_legend(ncol=4))

for (p in 1:8){
  Plt = Plt + annotation_custom(grob = textGrob(d$key[p], x = d$X[p], y = -.04, rot = 45, just = 1, gp = gpar(fontsize = 14) ))
}

gt <- ggplot_gtable(ggplot_build(Plt))
gt$layout$clip[gt$layout$name == "panel"] = "off"
#grid.arrange(gt)

ggsave(filename = 'Figures\\TrackingAcceptability.pdf', plot = gt, dpi = 5000, units = 'cm', height = 15, width = 24)

grid.arrange(gt)

Modelling

Examination of which items correlate with one-another

CorData = W %>% select(Education, Resilience, libertarianism, Accept2, ongoing_control, Security, TrustIntentions, TrustPrivacy, Risk, Sensitive, Necessary, Decline, Reduce_Spread, Return_Activity, Reduce_Likelihood)

CorData %>% 
  mutate(across(as.numeric())) %>% 
  cor(use = "pairwise.complete.obs") %>% 
  corrplot::corrplot(type = "upper", method = "number",
                     tl.col = "black", tl.srt = 45,
                     sig.level = 0.01, insig = "blank", number.cex = .70)

Frequentist Modelling for Tracking Acceptance

ModelData = W %>% select(Scenario, Age, education, gender, Resilience, libertarianism, Accept2, Sunset, ongoing_control, Security, TrustIntentions, TrustPrivacy, Risk, Sensitive, Necessary, Decline, Reduce_Spread, Return_Activity, Reduce_Likelihood)

### Check missing data
#nrow(ModelData)
#ModelData %>% drop_na() %>% nrow()

Equ = 'Accept2 ~ Age + education + gender + Resilience + libertarianism + ongoing_control + Security + TrustIntentions + TrustPrivacy + Risk + Sensitive + Necessary + Decline + Reduce_Spread + Return_Activity + Reduce_Likelihood + (1|Scenario)'

Model <- glmer(Equ, data = ModelData, family = binomial(link = "logit"), 
                       control = glmerControl(optCtrl = list(maxfun=2e8)))
summary(Model)
## Generalized linear mixed model fit by maximum likelihood (Laplace
##   Approximation) [glmerMod]
##  Family: binomial  ( logit )
## Formula: Accept2 ~ Age + education + gender + Resilience + libertarianism +  
##     ongoing_control + Security + TrustIntentions + TrustPrivacy +  
##     Risk + Sensitive + Necessary + Decline + Reduce_Spread +  
##     Return_Activity + Reduce_Likelihood + (1 | Scenario)
##    Data: ModelData
## Control: glmerControl(optCtrl = list(maxfun = 2e+08))
## 
##      AIC      BIC   logLik deviance df.resid 
##   3250.2   3381.4  -1604.1   3208.2     3804 
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -25.5831  -0.3359   0.2611   0.4903   7.7013 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  Scenario (Intercept) 0.01193  0.1092  
## Number of obs: 3825, groups:  Scenario, 3
## 
## Fixed effects:
##                           Estimate Std. Error z value Pr(>|z|)    
## (Intercept)             -6.5082887  0.7020246  -9.271  < 2e-16 ***
## Age                      0.0004474  0.0040579   0.110  0.91220    
## education> H.Sch         1.4375455  0.4494683   3.198  0.00138 ** 
## educationUni             1.3459466  0.4348571   3.095  0.00197 ** 
## genderWoman             -0.0453171  0.0920121  -0.493  0.62236    
## genderOther             -1.3653107  2.1610705  -0.632  0.52753    
## genderPrefer not to say  0.4589739  1.5442879   0.297  0.76631    
## Resilience               0.0066280  0.0032025   2.070  0.03849 *  
## libertarianism          -0.0836711  0.0587116  -1.425  0.15412    
## ongoing_control          0.2004871  0.0443216   4.523 6.08e-06 ***
## Security                 0.3662773  0.0672739   5.445 5.19e-08 ***
## TrustIntentions          0.1766553  0.0641416   2.754  0.00588 ** 
## TrustPrivacy             0.0651845  0.0702797   0.928  0.35367    
## Risk                     0.1059795  0.0584247   1.814  0.06969 .  
## Sensitive               -0.1942931  0.0602529  -3.225  0.00126 ** 
## Necessary                0.1131544  0.0525466   2.153  0.03129 *  
## Decline                 -0.0177261  0.0445057  -0.398  0.69042    
## Reduce_Spread            0.2245020  0.0826170   2.717  0.00658 ** 
## Return_Activity          0.2035556  0.0855548   2.379  0.01735 *  
## Reduce_Likelihood        0.4796450  0.0791146   6.063 1.34e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1