Last updated: 2021-02-15

Checks: 7 0

Knit directory: UKsocialLicence/

This reproducible R Markdown analysis was created with workflowr (version 1.6.1). The Checks tab describes the reproducibility checks that were applied when the results were created. The Past versions tab lists the development history.

R Markdown file: up-to-date

Great! Since the R Markdown file has been committed to the Git repository, you know the exact version of the code that produced these results.

Environment: empty

Great job! The global environment was empty. Objects defined in the global environment can affect the analysis in your R Markdown file in unknown ways. For reproduciblity it’s best to always run the code in an empty environment.

Seed: set.seed(20200329)

The command set.seed(20200329) was run prior to running the code in the R Markdown file. Setting a seed ensures that any results that rely on randomness, e.g. subsampling or permutations, are reproducible.

Session information: recorded

Great job! Recording the operating system, R version, and package versions is critical for reproducibility.

Cache: none

Nice! There were no cached chunks for this analysis, so you can be confident that you successfully produced the results during this run.

File paths: relative

Great job! Using relative paths to the files within your workflowr project makes it easier to run your code on other machines.

Repository version: 6da5a32

Great! You are using Git for version control. Tracking code development and connecting the code version to the results is critical for reproducibility.

The results in this page were generated with repository version 6da5a32. See the Past versions tab to see a history of the changes made to the R Markdown and HTML files.

Note that you need to be careful to ensure that all relevant files for the analysis have been committed to Git prior to generating the results (you can use wflow_publish or wflow_git_commit). workflowr only checks the R Markdown file, but you know if there are other scripts or data files that it depends on. Below is the status of the Git repository when the results were generated: 


Ignored files:
    Ignored:    .Rhistory
    Ignored:    .Rproj.user/
    Ignored:    data/4 OSF Spain+social+licencing+COVID+Wave+1.csv
    Ignored:    data/4 OSF U.S.+social+licencing+COVID+Wave+1.csv
    Ignored:    data/4 OSF UK+social+licencing+Wave+2.csv
    Ignored:    data/4 OSF US varCovid.xlsx
    Ignored:    data/4 OSF varSpainCovid.xlsx
    Ignored:    data/4 OSF varUKCovidW2.xlsx
    Ignored:    data/Lucid SES info Spain 1.xlsx
    Ignored:    data/Spain+social+licencing+COVID+Wave+1.csv
    Ignored:    data/U.S.+social+licencing+COVID+Wave+1.csv
    Ignored:    data/UK early data covid 1st 500/
    Ignored:    data/UK+social+licencing+COVID+Wave+2.csv
    Ignored:    data/dupsUK.dat
    Ignored:    data/dupsUK2.dat
    Ignored:    data/dupsUS.dat
    Ignored:    data/varSpainCovid.xlsx
    Ignored:    data/varUKCovid.xlsx
    Ignored:    data/varUKCovidW2.xlsx
    Ignored:    data/varUSCovid.xlsx
    Ignored:    data/varnamediffs.csv

Untracked files:
    Untracked:  analysis/Paul's code/
    Untracked:  covhisto.pdf

Note that any generated files, e.g. HTML, png, CSS, etc., are not included in this status report because it is ok for generated content to have uncommitted changes.

These are the previous versions of the repository in which changes were made to the R Markdown (analysis/SpainCov1.Rmd) and HTML (docs/SpainCov1.html) files. If you’ve configured a remote Git repository (see ?wflow_git_remote), click on the hyperlinks in the table below to view the files as they were in that past version.

File Version Author Date Message
html 5bd9045 StephanLewandowsky 2021-02-05 Build site.
Rmd b560f49 StephanLewandowsky 2021-02-05 wflow_publish(c(“analysis/index.Rmd”, “analysis/UKcov1.Rmd”,
html b560f49 StephanLewandowsky 2021-02-05 wflow_publish(c(“analysis/index.Rmd”, “analysis/UKcov1.Rmd”,
html bb03a95 StephanLewandowsky 2020-11-16 Build site.
html 7a92223 StephanLewandowsky 2020-11-15 Build site.
html fd1e250 StephanLewandowsky 2020-09-30 Build site.
html d6c4ad2 StephanLewandowsky 2020-07-28 Build site.
html 680986f StephanLewandowsky 2020-07-06 Build site.
Rmd 4f64552 StephanLewandowsky 2020-07-06 wflow_publish(c(“analysis/index.Rmd”, “analysis/UKcov1.Rmd”,
html 4f64552 StephanLewandowsky 2020-07-06 wflow_publish(c(“analysis/index.Rmd”, “analysis/UKcov1.Rmd”,
html 75ee0b1 StephanLewandowsky 2020-06-12 Build site.
html 4841846 StephanLewandowsky 2020-05-20 Build site.
html 0937f8f StephanLewandowsky 2020-05-11 Build site.
Rmd 4033430 StephanLewandowsky 2020-05-11 wflow_publish(c(“analysis/index.Rmd”, “analysis/UKcov1.Rmd”,
html 4033430 StephanLewandowsky 2020-05-11 wflow_publish(c(“analysis/index.Rmd”, “analysis/UKcov1.Rmd”,
html 2994975 StephanLewandowsky 2020-05-09 Build site.
html 7b7609a StephanLewandowsky 2020-05-07 Build site.
html a6c93f1 StephanLewandowsky 2020-05-06 Build site.
html 7b6f263 StephanLewandowsky 2020-05-05 Build site.
Rmd bce7b96 StephanLewandowsky 2020-05-05 wflow_publish(c(“analysis/index.Rmd”, “analysis/UKcov1.Rmd”,
html bce7b96 StephanLewandowsky 2020-05-05 wflow_publish(c(“analysis/index.Rmd”, “analysis/UKcov1.Rmd”,
html bfd84e0 StephanLewandowsky 2020-05-05 Build site.
html c656f8d StephanLewandowsky 2020-05-05 Build site.
Rmd ac85ee7 StephanLewandowsky 2020-05-05 wflow_publish(c(“analysis/index.Rmd”, “analysis/UKcov1.Rmd”,
html ac85ee7 StephanLewandowsky 2020-05-05 wflow_publish(c(“analysis/index.Rmd”, “analysis/UKcov1.Rmd”,
html 641e4c5 StephanLewandowsky 2020-05-05 Build site.
Rmd e7cfb3d StephanLewandowsky 2020-05-05 wflow_publish(c(“analysis/index.Rmd”, “analysis/UKcov1.Rmd”,

1 Status of this report

These results represent a snapshot of an ongoing analysis and have not been peer-reviewed. They are for information but not for citation or to inform policy (as yet). Please report comments or bugs to or leave a comment on the relevant post on our subreddit.

Last update: Mon Feb 15 13:49:52 2021

These results are for Spain only, and are from a first wave in Spain. For other countries, return Home (click menu option on top) and choose another country.

In addition to the two scenarios (mild and severe) included in the first wave, this wave also included a Bluetooth scenario. The Bluetooth scenario was as follows:

Tracking COVID-19 Transmission

The COVID-19 pandemic has rapidly become a worldwide threat. Containing the virus’ spread is essential to minimise the impact on the healthcare system, the economy, and save many lives. Apple and Google have proposed adding a contact tracing capability to existing smartphones to help inform people if they have been exposed to others with COVID-19. This would help reduce community spread of COVID-19 by allowing people to voluntarily self-isolate. When two people are near each other, their phones would connect via bluetooth. If a person is later identified as being infected, the people they have been in close proximity to are then notified without the government knowing who they are. The use of this contact tracing capability would be completely voluntary. People who are notified would not be informed who had tested positive.

Participants: A representative samples of 1,500 Spanish participants were recruited between 27 April and 2 May 2020. through the online platform Lucid using a quota system to ensure representativeness.

Preregistration: The preregistration for the first wave of the British survey is here. It contains multiple files (under the Files menu), including the text of the preregistration and a copy of the Qualtrics source code for the first wave in the U.K. The survey used here (for the Spanish sample) is a translation of the second U.K. wave and is available here (not preregistered).

Data: The data are available here. Note that demographics and other variables (such as location information and Lucid ID) that could lead to deanonymization have been omitted from the published data set. The results reported here include summaries of some of those variables.

2 Basic exploration

Note that the R code for this analysis can be hidden or made visible by clicking the black toggles next to each segment.

2.1 Setup and read data

Records 1 and 2 of the original file were transposed into columns in a new Excel file, called varUKCovidW2.xlsx, which therefore summarizes the short variable names (column 1, manually labelled varname) and the accompanying full text of the item (column 2, labelled fullname). Lines 2 and 3, which contain extended variable information, were then manually deleted from the .csv file provided by Qualtrics to facilitate reading of the file. The first two data records were also manually removed as they represented previews and tests from the preceding day.

In a non-public analysis of the raw data file, duplicate Prolific ID numbers (N=1) were identified and written to a text file for removal.

# Reading data and variable names 
covfn        <- paste(inputdir,"Spain+social+licencing+COVID+Wave+1.csv",sep="/") #this is the complete data file with demographics (but no location and IP). Version on OSF does not have demographics to reduce likelihood of reidentification of respondents.
covdata      <- read.csv(covfn)
#fix annoying misspelling of variables
covdata %<>% rename(wv_freemarket_lim = wv_.freemarket_lim, age_1 = age_4)
#there are no duplicate records for Spain
duplicaterecs <- NULL
#which response options for the two attention checks are correct?
corattcheck<-c(2,1)

2.2 Clean up data

  • There are no duplicate records to be removed for Spain Wave 1.
  • Remove observations that are returned as not having finished.
  • Remove observations with a Status other than 0 (e.g., previews or suspected spam responses).
  • Remove observations from participants who answered the fact check about the scenario incorrectly.
  • Remove lots of unnecessary variables to create a lean dataset.
  • Reverse score item wv_freemarket_lim so it points towards increasing libertarianism, just like the other two worldview items.
# from here on the code is identical between waves and countries, and hence there is not much in the .Rmd files.
# all the action takes place here

# remove duplicates first because the data set has not been touched yet, so the row pointers are correct
if (!is.null(duplicaterecs)) {
  covdata <- covdata [-unlist(duplicaterecs),]
}
covdata$attok <- covdata %>% select(starts_with("att_check")) %>% apply(.,1,FUN=function(x) sum(x==corattcheck,na.rm=TRUE)) #works for 1 or more attention checks
covfin  <- covdata %>% filter(Finished>0) %>% filter(attok == 1) %>%
                                              select(-c(starts_with("Recipient"),starts_with("Q_"),
                                                        Status,Finished,Progress,DistributionChannel,UserLanguage,
                                                        ResponseId,ExternalReference))
covfin$id <- 1:nrow(covfin)
covfin$scenario_type <- factor(covfin$scenario_type)  #get rid of empty levels (in case of Spain, those may have arisen through merge)


#create good labels for variables (from expss package)
#some of these are moved to each .Rmd file because different countries/waves have different labels for some items
covfin <- apply_labels(covfin,
                       gender = "Gender",
                       gender = c("Male" = 1, "Female" = 2, "Other" = 3, "Prefer not to say" =4),
                       COVID_pos = "I tested positive to COVID",
                       COVID_pos = c("Yes" = 1, "No" = 0),
                       scenario_type = "Type of policy scenario",
                       COVID_lost_job = "I lost my job",
                       COVID_lost_job = c("Yes" = 1, "No" = 0))


###############################################################################################################
#labels for country-specific variables
covfin <- apply_labels(covfin,
                       education = "Education",
                       education = c("Estudios básicos" = 1, "Bachiller/COU" = 2, "FP" = 3, "Titulación universitaria" = 11),
                       COVID_pos_others = "Tested pos someone I know",
                       COVID_pos_others = c("Yes" = 1, "No" = 0),
                       COVID_info_source= "Information source",
                       COVID_info_source = c("Newspaper (printed or online)" = 1, "Social media" = 2, "Friends/family" = 3, "Radio" = 4, 
                                             "Television" = 5, "Other" = 6, "Do not follow" = 7),
                       COVID_comply_pers = "Personal compliance",
                       COVID_comply_pers =  c("I don't follow these policies at all" = 1, 
                                              "I mostly don't follow these policies"= 2, 
                                              "I follow these policies somewhat" = 3, 
                                              "I mostly follow these policies, but not all the way" = 4, 
                                              "I completely follow these policies" = 5, 
                                              "I go slightly beyond what the government policy mandates" = 6,
                                              "I go somewhat beyond what the government policy mandates" = 7, 
                                              "I go significantly beyond what the government policy mandates" = 8,
                                              "I am in complete quarantine and never leave my home" = 9),
                       mobileuse_sev = "Use mobile",
                       mobileuse_sev = c("Yes" = 1, "No" = 0),
                       smartphoneuse_mildbt = "Use smartphone",
                       smartphoneuse_mildbt = c("Yes" = 1, "No" = 0),
                       SES = "Income",
                       SES = c("Menos de €15.000"=1,
                               "€15.000 a €19.999"=2,
                               "€20.000 a €24.999"=3,
                               "€25.000 a €29.999"=4,
                               "€30.000 a €34.999"=5,
                               "€35.000 a €39.999"=6,
                               "€40.000 a €44.999"=7,
                               "€45.000 a €49.999"=8,
                               "€50.000 a €59.999"=9,
                               "€60.000 a €74.999"=10,
                               "€75.000 a €84.999"=11,
                               "€85.000 a €99.999"=12,
                               "€100.000 a €124.999"=13,
                               "€125.000 a €149.999"=14,
                               "€150.000 a €174.999"=15,
                               "€175.000 a €199.999"=16,
                               "€200.000 o más"     =17,
                               "Prefiero no contestar"=18)
                       )
#reverse score
covfin <- covfin %>% mutate(wv_freemarket_lim=revscore(wv_freemarket_lim,7))
#compute composite score for worldview
covfin$Worldview <- covfin %>% select(starts_with("wv_")) %>% apply(.,1, mean, na.rm=TRUE)

2.3 Demographics

Number of retained participants: 1076.

Gender, education, and age:

cro_tpct(covfin$gender) %>% set_caption("Gender identification: Percentages")
Gender identification: Percentages
 #Total 
 Gender 
   Male  49.1
   Female  50.7
   Other  0.1
   Prefer not to say  0.2
   #Total cases  1076 
cro_tpct(covfin$education) %>% set_caption("Level of education: Percentages")
Level of education: Percentages
 #Total 
 Education 
   Estudios básicos  9.0
   Bachiller/COU  22.8
   FP  18.2
   Titulación universitaria  50.0
   #Total cases  1076 
descr(covfin$age_1)
Descriptive Statistics  
covfin$age_1  
N: 1076  

                      age_1
----------------- ---------
             Mean     48.47
          Std.Dev     15.86
              Min     18.00
               Q1     36.00
           Median     49.00
               Q3     61.00
              Max    100.00
              MAD     17.79
              IQR     25.00
               CV      0.33
         Skewness     -0.02
      SE.Skewness      0.07
         Kurtosis     -0.76
          N.Valid   1076.00
        Pct.Valid    100.00
hist(covfin$age_1, xlab="Age",main="",las=1)

###############################################################################################################

Income:

cro_tpct(covfin$SES) %>% set_caption("Income range: Percentages")
Income range: Percentages
 #Total 
 Income 
   Menos de €15.000  17.8
   €15.000 a €19.999  11.6
   €20.000 a €24.999  13.2
   €25.000 a €29.999  13.0
   €30.000 a €34.999  9.5
   €35.000 a €39.999  7.3
   €40.000 a €44.999  3.7
   €45.000 a €49.999  5.5
   €50.000 a €59.999  4.6
   €60.000 a €74.999  3.6
   €75.000 a €84.999  0.6
   €85.000 a €99.999  1.0
   €100.000 a €124.999  1.0
   €125.000 a €149.999  0.1
   €150.000 a €174.999  0.3
   €175.000 a €199.999  0.3
   €200.000 o más  0.6
   Prefiero no contestar  6.4
   #Total cases  783

Phone ownership:

cro_tpct(covfin$smartphoneuse_mildbt) %>% set_caption("I use a smartphone: Percentages")
I use a smartphone: Percentages
 #Total 
 Use smartphone 
   No  2.2
   Yes  97.8
   #Total cases  716 
cro_tpct(covfin$mobileuse_sev) %>% set_caption("I use a mobile phone: Percentages")
I use a mobile phone: Percentages
 #Total 
 Use mobile 
   No  1.9
   Yes  98.1
   #Total cases  360

2.4 COVID impact on participant

How long have you been in “lockdown”?

hist(covfin$COVID_ndays_4, xlab="Days in `lockdown`",main="",las=1)

Have you, temporarily or permanently, lost your job as a consequence of the novel coronavirus (COVID-19) pandemic?

cro_tpct(covfin$COVID_lost_job) %>% set_caption("I have lost my job: Percentages")
I have lost my job: Percentages
 #Total 
 I lost my job 
   No  71.7
   Yes  28.3
   #Total cases  1075

What is your main source of information about the novel coronavirus (COVID-19) pandemic?

cro_tpct(covfin$COVID_info_source) %>% set_caption("Information source: Percentages")
Information source: Percentages
 #Total 
 Information source 
   Newspaper (printed or online)  17.4
   Social media  10.0
   Friends/family  2.9
   Radio  6.9
   Television  59.2
   Other  2.9
   Do not follow  0.8
   #Total cases  1075

Have you tested positive for COVID?

cro_tpct(covfin$COVID_pos) %>% set_caption("I tested positive for COVID-19: Percentages")
I tested positive for COVID-19: Percentages
 #Total 
 I tested positive to COVID 
   No  96.6
   Yes  3.4
   #Total cases  1074

Has someone you know tested positive for COVID?

cro_tpct(covfin$COVID_pos_others) %>% set_caption("Somebody I know tested positive for COVID-19: Percentages")
Somebody I know tested positive for COVID-19: Percentages
 #Total 
 Tested pos someone I know 
   No  52.1
   Yes  47.9
   #Total cases  1076

What percentage of the population do you think is complying with government policies regarding social distancing?

hist(covfin$COVID_comply_percent,las=1,xlab="Estimated compliance of population (%)",main="")

How much are you following government policies regarding social distancing?

cro_tpct(covfin$COVID_comply_pers) %>% set_caption("Compliance with policy: Percentages")
Compliance with policy: Percentages
 #Total 
 Personal compliance 
   I don’t follow these policies at all  0.7
   I mostly don’t follow these policies  0.8
   I follow these policies somewhat  3.4
   I mostly follow these policies, but not all the way  10.5
   I completely follow these policies  54.7
   I go slightly beyond what the government policy mandates  7.2
   I go somewhat beyond what the government policy mandates  4.4
   I go significantly beyond what the government policy mandates  4.0
   I am in complete quarantine and never leave my home  14.2
   #Total cases  1075

2.5 COVID risk perception

Estimated fatalities in various countries:

vioplot (covfin %>% select(contains("fatal")), horizontal = TRUE, 
         xlab="Estimated fatalities",yaxt="n")
axis(side=2,at=1:9,labels=c("AUS", "China", "GER", "Italy", "S'pore", "S Korea", "Spain", "U.S.A.", "U.K."),las=1)
axis(side=1,at=seq(0,75000,10000))

There are 4 items probing people’s COVID risk perception:

  • How severe do you think novel coronavirus (COVID-19) will be in the population as a whole?
  • How harmful would it be for your health if you were to become infected with COVID-19?
  • How concerned are you that you might become infected with COVID-19?
  • How concerned are you that somebody you know might become infected with novel?

Provide snapshot of responses and correlations between items.

covvars<-gather(covfin %>% select(c(COVID_gen_harm,COVID_pers_harm,COVID_pers_concern,COVID_concern_oth)),factor_key = TRUE)
covvars$key <- factor(covvars$key,labels=c("General harm","Personal harm","Concern self","Concern others"))
covhisto <- ggplot(covvars, aes(value)) +
  theme_classic() +
  theme(panel.grid.minor.y = element_line(colour="lightgray", size=0.5),
        panel.grid.major.y = element_line(colour="darkgray", size=0.5),
        panel.grid.major.x = element_blank(),
        panel.border = element_rect(colour = "black", size=1, fill=NA)) +
  geom_histogram(bins = 5, color="darkblue", fill="lightblue") +
  xlab("Response") + ylab("Frequency") +
  facet_wrap(~key, scales = 'free_x',labeller=label_value)
ggsave("covhisto.pdf")
Saving 7 x 5 in image
Warning: Removed 73 rows containing non-finite values (stat_bin).
print(covhisto)
Warning: Removed 73 rows containing non-finite values (stat_bin).

covfin %>% select(c(COVID_gen_harm,COVID_pers_harm,COVID_pers_concern,COVID_concern_oth)) %>% cor (.,use="pairwise.complete.obs") %>% round(.,3)
                   COVID_gen_harm COVID_pers_harm COVID_pers_concern
COVID_gen_harm              1.000           0.440              0.483
COVID_pers_harm             0.440           1.000              0.656
COVID_pers_concern          0.483           0.656              1.000
COVID_concern_oth           0.457           0.468              0.713
                   COVID_concern_oth
COVID_gen_harm                 0.457
COVID_pers_harm                0.468
COVID_pers_concern             0.713
COVID_concern_oth              1.000
#compute composite score for COVID risk
covfin$COVIDrisk <- covfin %>% select(c(COVID_gen_harm,COVID_pers_harm,COVID_pers_concern,COVID_concern_oth)) %>% apply(.,1, mean, na.rm=TRUE)
#compute composite score for government trust
covfin$govtrust <- covfin %>% select(starts_with("trus")) %>% apply(.,1, mean, na.rm=TRUE)


###############################################################################################################

3 Comparison between scenarios

3.1 Efficacy of policy

Not all items are entirely commensurate between scenarios. We begin with a graphical summary.

The figure below shows people’s confidence that each of the scenarios would reduce their likelihood of contracting COVID-19:

plotvio (covfin, c("reduce_lik_bt", "reduce_lik_mild","reduce_lik_sev" ), "blue", "Reduce contracting")

The figure below shows people’s confidence that each of the scenarios would allow them to resume their normal lives more rapidly

plotvio (covfin, c("return_activ_bt", "return_activ_mild", "return_activ_sev"), "green", "Resume normal")

The figure below shows people’s confidence that each of the scenarios would reduce spread of COVID-19 in the community.

plotvio (covfin, c("reduce_spread_bt", "reduce_spread_mild", "reduce_spread_sev"), "orange", "Reduce spread")

3.2 Acceptability of policy

Basic acceptability of each scenario, probed by a single item immediately after reading the scenario. The table shows percentages. For the mild and Bluetooth scenarios, the question refers to whether participant would download the app. For the severe scenario, the question refers to acceptability of the tracking mandated by government.

#use gather and drop
accept1 <- covfin %>% select(c(app_uptake1_mild, is_acceptable1_sev, bluetooth_uptake1_bt)) %>% 
                    pivot_longer(c(app_uptake1_mild,is_acceptable1_sev,bluetooth_uptake1_bt), 
                                names_to = "key", values_to = "value")
covfin$accept1 <- (accept1 %>% drop_na())$value
#we do not drop NAs for the pivoted data frame to allow correct merging with the conditional responses below for quasi interval score
accept1 <- apply_labels(accept1,
                        value = "Acceptability of policy",
                        value = c("Yes" = 1, "No" = 0),
                        key = "Type of scenario",
                        key = c("Mild" ="app_uptake1_mild", "Severe" = "is_acceptable1_sev", "Bluetooth" = "bluetooth_uptake1_bt"))
cro_tpct(accept1$value,row_vars=accept1$key) #presence of NAs makes no difference here
 #Total 
 Type of scenario 
   Bluetooth   Acceptability of policy   No  31.6
    Yes  68.4
    #Total cases  351
   Mild   Acceptability of policy   No  34.8
    Yes  65.2
    #Total cases  365
   Severe   Acceptability of policy   No  39.4
    Yes  60.6
    #Total cases  360 
chisq.test(unlabel(accept1$value),unlabel(accept1$key),correct=TRUE)

    Pearson's Chi-squared test

data:  unlabel(accept1$value) and unlabel(accept1$key)
X-squared = 4.8239, df = 2, p-value = 0.08964

The difference between acceptability of scenarios fails to reach significance by a \(\chi^2\) test on the contingency table.

Repeated probing of basic acceptability of each scenario after multiple questions about the scenario have been answered. The table shows percentages. For the mild and Bluetooth scenarios, the question refers to whether participant would download the app. For the severe scenario, the question refers to acceptability of the tracking mandated by government.

covfin$accept2 <- apply(cbind(covfin$app_uptake2_mild,covfin$is_acceptable2_sev,covfin$bluetooth_uptake2_bt),1,sum,na.rm=TRUE)
covfin <- apply_labels(covfin,
                        accept2 = "Acceptability of policy",
                        accept2 = c("Yes" = 1, "No" = 0),
                        scenario_type = "Type of scenario")
cro_tpct(covfin$accept2,row_vars=covfin$scenario_type)
 #Total 
 Type of scenario 
   bluetooth   Acceptability of policy   No  33.3
    Yes  66.7
    #Total cases  351
   mild   Acceptability of policy   No  37.0
    Yes  63.0
    #Total cases  365
   severe   Acceptability of policy   No  41.4
    Yes  58.6
    #Total cases  360 
chisq.test(covfin$accept2,covfin$scenario_type,correct=TRUE)

    Pearson's Chi-squared test

data:  covfin$accept2 and covfin$scenario_type
X-squared = 4.9517, df = 2, p-value = 0.08409

The difference between acceptability of scenarios again fails to reach significance by a \(\chi^2\) test.

Those people who found the scenario unacceptable at the second opportunity were asked two follow-up questions. Those questions were as follows:

First, for both scenarios, people were asked if their decision would change if the government was required to delete the data and cease tracking after 6 months. Overall acceptance of the policies when a sunset clause was included was as follows:

covfin$accept3 <- apply(cbind(covfin$accept2,covfin %>% select(contains("sunset"))),1,sum,na.rm=TRUE)
covfin <- apply_labels(covfin,
                       accept3 = "Acceptability of policy",
                       accept3 = c("Yes" = 1, "No" = 0),
                       scenario_type = "Type of scenario")
cro_tpct(covfin$accept3,row_vars=covfin$scenario_type)
 #Total 
 Type of scenario 
   bluetooth   Acceptability of policy   No  26.8
    Yes  73.2
    #Total cases  351
   mild   Acceptability of policy   No  24.4
    Yes  75.6
    #Total cases  365
   severe   Acceptability of policy   No  26.4
    Yes  73.6
    #Total cases  360 
chisq.test(covfin$accept3,covfin$scenario_type,correct=TRUE)

    Pearson's Chi-squared test

data:  covfin$accept3 and covfin$scenario_type
X-squared = 0.62274, df = 2, p-value = 0.7324
###############################################################################################################

3.3 The sunset clause uniformly increased acceptance of the scenarios, with no significant differences between them.

The second follow-up question differed between scenarios. People in the mild scenario were asked if they would change their decision if data was stored only on the user’s smartphone (not government servers), and people were given the option to provide the data if they tested positive. People in the severe scenario were asked if they would change their decision if there was an option to opt out of data collection. People in the Bluetooth scenario were not asked a second follow-up question (which is why there responses are unchanged below compared to the sunset responses).

covfin$accept5 <- apply(cbind(covfin$accept2,covfin %>% select(contains("sunset")),
                                      covfin$change_dlocal_mild,covfin$change_optout_sev),1,max,na.rm=TRUE)
covfin <- apply_labels(covfin,
                       accept5 = "Acceptability of policy",
                       accept5 = c("Yes" = 1, "No" = 0),
                       scenario_type = "Type of scenario")
cro_tpct(covfin$accept5,row_vars=covfin$scenario_type)
 #Total 
 Type of scenario 
   bluetooth   Acceptability of policy   No  26.8
    Yes  73.2
    #Total cases  351
   mild   Acceptability of policy   No  16.4
    Yes  83.6
    #Total cases  365
   severe   Acceptability of policy   No  12.8
    Yes  87.2
    #Total cases  360 
chisq.test(covfin$accept5,covfin$scenario_type,correct=TRUE)

    Pearson's Chi-squared test

data:  covfin$accept5 and covfin$scenario_type
X-squared = 24.714, df = 2, p-value = 4.299e-06
###############################################################################################################

The opt-out/local storage options further enhanced acceptance.

3.4 Assessment of risk of scenarios, trust in government / Apple and Google and data security

How difficult is it for people to decline participation in the proposed project? (1 = Extremely easy – 6 = Extremely difficult)

  covfin$decline_participate[covfin$scenario_type=="bluetooth"] <- covfin$decline_part_bt[covfin$scenario_type=="bluetooth"]
  vioplot(decline_participate ~ scenario_type, data=covfin, col = "lightgray", ylab="Decline", xlab="Condition", las=1, )

To what extent is the Government only collecting the data necessary? (1 = Not at all – 6 = Completely)

  covfin$proportionality[covfin$scenario_type=="bluetooth"] <- covfin$proportionality_bt[covfin$scenario_type=="bluetooth"]
  vioplot(proportionality ~ scenario_type, data=covfin, col = "lightgray", ylab="Only data necessary", xlab="Condition", las=1, )

How sensitive is the data being collected in the proposed project? (1 = Not at all – 6 = Extremely)

  covfin$sensitivity[covfin$scenario_type=="bluetooth"] <- covfin$sensitivity_bt[covfin$scenario_type=="bluetooth"]
  vioplot(sensitivity ~ scenario_type, data=covfin, col = "lightgray", ylab="Sensitivity of data", xlab="Condition", las=1, )

How serious is the risk of harm that could arise from the proposed project? (1 = Not at all – 6 = Extremely)

  covfin$risk_of_harm[covfin$scenario_type=="bluetooth"] <- covfin$risk_of_harm_bt[covfin$scenario_type=="bluetooth"]
  vioplot(risk_of_harm ~ scenario_type, data=covfin, col = "lightgray", ylab="Risk of harm", xlab="Condition", las=1, )

How much do you trust the Government (or Apple and Google in the Bluetooth scenario) to use the tracking data only to deal with the COVID-19 pandemic? (1 = Not at all – 6 = Completely)

  covfin$trust_intentions[covfin$scenario_type=="bluetooth"] <- covfin$trust_intentions_bt[covfin$scenario_type=="bluetooth"]
  vioplot(trust_intentions ~ scenario_type, data=covfin, col = "lightgray", ylab="Trust intentions of government/corporations", xlab="Condition", las=1, )

How much do you trust the Government (or Apple and Google in the Bluetooth scenario) to be able to ensure the privacy of each individual? (1 = Not at all – 6 = Completely)

  covfin$trust_respect_priv[covfin$scenario_type=="bluetooth"] <- covfin$trust_respectpriv_bt[covfin$scenario_type=="bluetooth"]
  vioplot(trust_respect_priv ~ scenario_type, data=covfin, col = "lightgray", ylab="Trust government/corporations preserve privacy", xlab="Condition", las=1, )

How secure is the data that would be collected for the proposed project? (1 = Not at all – 6 = Completely)

  covfin$data_security[covfin$scenario_type=="bluetooth"] <- covfin$data_security_bt[covfin$scenario_type=="bluetooth"]
  vioplot(data_security ~ scenario_type, data=covfin, col = "lightgray", ylab="How secure is data", xlab="Condition", las=1, )

To what extent do people have ongoing control of their data? (1 = No control at all – 6 = Complete control)

  vioplot(ongoing_control ~ scenario_type, data=covfin, col = "lightgray", ylab="Ongoing control over data", xlab="Condition", las=1, )

4 Role of worldviews

4.1 Worldview and risk perception

We relate a composite of the 3 worldview items to the composite of the 4 items probing perceived risk from COVID. Worldview is scored such that greater values reflect greater libertarianism.

p <- ggplot(covfin, aes(Worldview, COVIDrisk)) +
  geom_point(size=1.5,shape = 21,fill="red",
             position=position_jitter(width=0.15, height=0.15)) +
  geom_smooth() +
  theme(plot.title = element_text(size = 18),
        panel.background = element_rect(fill = "white", colour = "grey50"),
        text = element_text(size=14)) +
  xlim(0.8,7.2) + ylim(0.8,5.2) +
  labs(x="Worldview (libertarianism)", y="Perceived COVID risk")
print(p)
`geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'

pcor <- cor.test (covfin$Worldview,covfin$COVIDrisk, use="pairwise.complete.obs") %>% print()

    Pearson's product-moment correlation

data:  covfin$Worldview and covfin$COVIDrisk
t = 0.36094, df = 1074, p-value = 0.7182
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.04878176  0.07072925
sample estimates:
       cor 
0.01101307 
###############################################################################################################

There is no evidence for an association between libertarianism and risk perception.

4.2 Worldviews and trust

We relate the composite of the 3 worldview items to the composite of the two trust-in-government items (which correlate 0.835 for severe and mild, and 0.759 for the Bluetooth scenario).

p <- ggplot(covfin, aes(Worldview, govtrust)) +
  geom_point(size=1.5,shape = 21,fill="red",
             position=position_jitter(width=0.15, height=0.15)) +
  geom_smooth() +
  theme(plot.title = element_text(size = 18),
        panel.background = element_rect(fill = "white", colour = "grey50"),
        text = element_text(size=14)) +
  xlim(0.8,7.2) + ylim(0.8,5.2) +
  labs(x="Worldview (libertarianism)", y="Trust in government")
print(p)
`geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
Warning: Removed 64 rows containing non-finite values (stat_smooth).
Warning: Removed 64 rows containing missing values (geom_point).

pcor <- cor.test (covfin$Worldview,covfin$govtrust, use="pairwise.complete.obs") %>% print()

    Pearson's product-moment correlation

data:  covfin$Worldview and covfin$govtrust
t = -9.0012, df = 1074, p-value < 2.2e-16
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.3195592 -0.2083903
sample estimates:
       cor 
-0.2648546 
###############################################################################################################

Trust is clearly reduced among libertarians.

5 Immunity Passports

Participants were asked their views on “immunity passports”, explained as follows:

An ‘immunity passport’ indicates that you have had a disease and that you have the antibodies for the virus causing that disease. Having the antibodies implies that you are now immune and therefore unable to spread the virus to other people. Thus, if an antibody test indicates that you have had the disease, you could be allocated an ‘immunity passport’ which would subsequently allow you to move around freely. Immunity passports have been proposed as a potential step towards lifting movement restrictions during the COVID-19 pandemic.

5.1 Basic summary of immunity passport items

There were 7 items that queries attitudes towards immunity passports:

  • Would you support a government proposal to introduce ‘immunity passports’ for novel coronavirus (COVID-19)? (1 = Not at all – 6 = Fully)

  • How concerned are you about the idea of introducing an ‘immunity passport’ for novel coronavirus (COVID-19)? (1 = Not at all – 5 = Extremely)

  • How much would you like to be allocated an ‘immunity passport’ for novel coronavirus (COVID-19)? (1 = Not at all – 6 = Extremely)

  • To what extent do you believe an ‘immunity passport’ for novel coronavirus (COVID-19) could harm the social fabric of your country? (1 = Not at all – 6 = Extremely)

  • To what extent do you believe that it is fair for people with ‘immunity passports’ for novel coronavirus (COVID-19) to go back to work, while individuals without such an ‘immunity passport’ cannot? (Extremely unfair = 1 – Extemely fair = 6)

  • To what extent would you consider purposefully infecting yourself with novel coronavirus (COVID-19) to get an ‘immunity passport’ for novel coronavirus (COVID-19)? (1 = Not at all – 6 = Extremely)

  • Would you support a government proposal to introduce ‘immunity passports’ for novel coronavirus (COVID-19)? (1 = Not at all – 6 = Fully)

Summary statistics for the 7 items are:

ipcov <- covfin %>% select(starts_with("ip_"))

hist(ipcov)

ipcov <- apply_labels(ipcov,ip_support2 = "Final support for Immunity Passports",
                            ip_support2 = c("Not at all" = 1, "Slightly" = 2, "A bit" = 3, 
                                            "Moderately" = 4, "A lot" = 5, "Fully" = 6),
                            ip_support1 = "Initial support for Immunity Passports",
                            ip_support1 = c("Not at all" = 1, "Slightly" = 2, "A bit" = 3, 
                                            "Moderately" = 4, "A lot" = 5, "Fully" = 6),
                            ip_concerned = "How concerned are you about immunity passport",
                            ip_concerned = c("Not at all" = 1, "Slightly" = 2, 
                                            "Moderately" = 3, "A lot" = 4, "Extremely" = 5),
                       
                            ip_like =  "How much would you like an immunity passport",
                            ip_like = c("Not at all" = 1, "Slightly" = 2, "A bit" = 3,
                                            "Moderately" = 4, "A lot" = 5, "Extremely" = 6),
                            
                            ip_harm_soc = "How much harm to society would arise from immunity passports",
                            ip_harm_soc = c("Not at all" = 1, "Slightly" = 2, "A bit" = 3,
                                            "Moderately" = 4, "A lot" = 5, "Extremely" = 6),
                            ip_fair = "How fair is it to issue immunity passports",
                            ip_fair = c("Not at all" = 1, "Slightly" = 2, "A bit" = 3,
                                            "Moderately" = 4, "A lot" = 5, "Extremely" = 6),
                            ip_infect_self = "How likely are you to infect yourself to get a passport",
                            ip_infect_self = c("Not at all" = 1, "Slightly" = 2, "A bit" = 3,
                                            "Moderately" = 4, "A lot" = 5, "Extremely" = 6))

cro_tpct(ipcov$ip_support1)
 #Total 
 Initial support for Immunity Passports 
   Not at all  10.5
   Slightly  11.2
   A bit  20.1
   Moderately  23.0
   A lot  17.4
   Fully  17.9
   #Total cases  1075 
cro_tpct(ipcov$ip_concerned)
 #Total 
 How concerned are you about immunity passport 
   Not at all  19.6
   Slightly  24.4
   Moderately  33.9
   A lot  13.7
   Extremely  8.5
   #Total cases  1075 
cro_tpct(ipcov$ip_like)
 #Total 
 How much would you like an immunity passport 
   Not at all  12.5
   Slightly  10.1
   A bit  22.7
   Moderately  21.1
   A lot  19.6
   Extremely  14.1
   #Total cases  1073 
cro_tpct(ipcov$ip_harm_soc)
 #Total 
 How much harm to society would arise from immunity passports 
   Not at all  9.7
   Slightly  18.2
   A bit  30.1
   Moderately  20.2
   A lot  13.1
   Extremely  8.7
   #Total cases  1075 
cro_tpct(ipcov$ip_fair)
 #Total 
 How fair is it to issue immunity passports 
   Not at all  12.4
   Slightly  14.7
   A bit  24.7
   Moderately  25.0
   A lot  15.7
   Extremely  7.4
   #Total cases  1074 
cro_tpct(ipcov$ip_infect_self)
 #Total 
 How likely are you to infect yourself to get a passport 
   Not at all  65.6
   Slightly  11.3
   A bit  8.6
   Moderately  7.4
   A lot  4.2
   Extremely  2.9
   #Total cases  1075 
cro_tpct(ipcov$ip_support2)
 #Total 
 Final support for Immunity Passports 
   Not at all  17.3
   Slightly  15.0
   A bit  23.4
   Moderately  22.3
   A lot  12.2
   Fully  9.9
   #Total cases  1074

Less than 20% of participants reject the idea of immunity passports whereas more than 20% strongly or fully endorse it.

Two of the items (concern and fairness), are now reverse scored so everything is pointing in the same direction. Correlations among items are shown first, followed by graphs relating a composite immunity-passport-endorsement score to other variables. (Note: this is a crude composite score because scales with a different number of points are combined. This needs to be fixed.)

ipcov %<>% mutate(ip_concerned = revscore(ip_concerned,5), ip_harm_soc  = revscore(ip_harm_soc,6)) %>% select(-ip_infect_self)

cor(ipcov,use="pairwise.complete.obs")
             ip_support1 ip_concerned   ip_like ip_harm_soc   ip_fair
ip_support1    1.0000000    0.5103830 0.6892038   0.4684540 0.5345221
ip_concerned   0.5103830    1.0000000 0.3448394   0.6398532 0.3264788
ip_like        0.6892038    0.3448394 1.0000000   0.3838309 0.4618047
ip_harm_soc    0.4684540    0.6398532 0.3838309   1.0000000 0.4110154
ip_fair        0.5345221    0.3264788 0.4618047   0.4110154 1.0000000
ip_support2    0.7773189    0.4475502 0.6332841   0.4522009 0.6418861
             ip_support2
ip_support1    0.7773189
ip_concerned   0.4475502
ip_like        0.6332841
ip_harm_soc    0.4522009
ip_fair        0.6418861
ip_support2    1.0000000
covfin$ipendorse <- apply(ipcov,1,mean,na.rm=TRUE)

p <- ggplot(covfin, aes(Worldview, ipendorse)) +
  geom_point(size=1.5,shape = 21,fill="red",
             position=position_jitter(width=0.15, height=0.15)) +
  geom_smooth() +
  theme(plot.title = element_text(size = 18),
        panel.background = element_rect(fill = "white", colour = "grey50"),
        text = element_text(size=14)) +
  xlim(0.8,7.2) + ylim(0.8,5.2) +
  labs(x="Worldview (libertarianism)", y="Endorsement of immunity passports")
print(p)

pcor <- cor.test (covfin$Worldview,covfin$ipendorse, use="pairwise.complete.obs") %>% print()

    Pearson's product-moment correlation

data:  covfin$Worldview and covfin$ipendorse
t = -2.1935, df = 1073, p-value = 0.02849
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.126100111 -0.007050971
sample estimates:
        cor 
-0.06681333 
p <- ggplot(covfin, aes(govtrust, ipendorse)) +
  geom_point(size=1.5,shape = 21,fill="red",
             position=position_jitter(width=0.15, height=0.15)) +
  geom_smooth() +
  theme(plot.title = element_text(size = 18),
        panel.background = element_rect(fill = "white", colour = "grey50"),
        text = element_text(size=14)) +
  xlim(0.8,7.2) + ylim(0.8,5.2) +
  labs(x="Trust in government", y="Endorsement of immunity passports")
print(p)

pcor <- cor.test (covfin$govtrust,covfin$ipendorse, use="pairwise.complete.obs") %>% print()

    Pearson's product-moment correlation

data:  covfin$govtrust and covfin$ipendorse
t = 10.116, df = 1073, p-value < 2.2e-16
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.2395165 0.3487193
sample estimates:
      cor 
0.2950812 
p <- ggplot(covfin, aes(COVIDrisk,ipendorse)) +
  geom_point(size=1.5,shape = 21,fill="red",
             position=position_jitter(width=0.15, height=0.15)) +
  geom_smooth() +
  theme(plot.title = element_text(size = 18),
        panel.background = element_rect(fill = "white", colour = "grey50"),
        text = element_text(size=14)) +
  xlim(0.8,7.2) + ylim(0.8,5.2) +
  labs(y="Endorsement of immunity passports", x="Perceived COVID risk")
print(p)

pcor <- cor.test (covfin$ipendorse,covfin$COVIDrisk, use="pairwise.complete.obs") %>% print()

    Pearson's product-moment correlation

data:  covfin$ipendorse and covfin$COVIDrisk
t = 2.7766, df = 1073, p-value = 0.005589
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.02479537 0.14352641
sample estimates:
       cor 
0.08446068 

R version 3.6.3 (2020-02-29)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19042)

Matrix products: default

locale:
[1] LC_COLLATE=English_United Kingdom.1252 
[2] LC_CTYPE=English_United Kingdom.1252   
[3] LC_MONETARY=English_United Kingdom.1252
[4] LC_NUMERIC=C                           
[5] LC_TIME=English_United Kingdom.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] broom.mixed_0.2.4  kableExtra_1.2.1   jtools_2.0.3       expss_0.10.2      
 [5] vioplot_0.3.4      zoo_1.8-7          sm_2.2-5.6         readxl_1.3.1      
 [9] summarytools_0.9.6 scales_1.1.0       psych_1.9.12.31    reshape2_1.4.4    
[13] Hmisc_4.4-0        Formula_1.2-3      survival_3.2-3     gridExtra_2.3     
[17] lme4_1.1-21        Matrix_1.2-18      forcats_0.5.0      stringr_1.4.0     
[21] dplyr_0.8.5        purrr_0.3.4        readr_1.3.1        tidyr_1.0.2       
[25] tibble_3.0.1       ggplot2_3.3.0      tidyverse_1.3.0    stargazer_5.2.2   
[29] hexbin_1.28.1      lattice_0.20-41    knitr_1.30         workflowr_1.6.1   

loaded via a namespace (and not attached):
 [1] minqa_1.2.4         colorspace_1.4-1    pryr_0.1.4         
 [4] ellipsis_0.3.0      rprojroot_1.3-2     htmlTable_1.13.3   
 [7] base64enc_0.1-3     fs_1.4.1            rstudioapi_0.11    
[10] farver_2.0.3        fansi_0.4.1         lubridate_1.7.8    
[13] xml2_1.3.2          codetools_0.2-16    splines_3.6.3      
[16] mnormt_1.5-6        jsonlite_1.6.1      nloptr_1.2.2.1     
[19] broom_0.5.5         cluster_2.1.0       dbplyr_1.4.2       
[22] png_0.1-7           compiler_3.6.3      httr_1.4.1         
[25] backports_1.1.6     assertthat_0.2.1    cli_2.0.2          
[28] later_1.0.0         acepack_1.4.1       htmltools_0.4.0    
[31] tools_3.6.3         coda_0.19-3         gtable_0.3.0       
[34] glue_1.4.1          Rcpp_1.0.4.6        cellranger_1.1.0   
[37] vctrs_0.2.4         nlme_3.1-145        xfun_0.20          
[40] rvest_0.3.5         lifecycle_0.2.0     MASS_7.3-51.5      
[43] hms_0.5.3           promises_1.1.0      parallel_3.6.3     
[46] TMB_1.7.16          RColorBrewer_1.1-2  yaml_2.2.1         
[49] pander_0.6.3        rpart_4.1-15        latticeExtra_0.6-29
[52] stringi_1.4.6       checkmate_2.0.0     boot_1.3-24        
[55] rlang_0.4.6         pkgconfig_2.0.3     matrixStats_0.56.0 
[58] evaluate_0.14       labeling_0.3        rapportools_1.0    
[61] htmlwidgets_1.5.1   tidyselect_1.0.0    plyr_1.8.6         
[64] magrittr_1.5        R6_2.4.1            magick_2.3         
[67] generics_0.0.2      DBI_1.1.0           mgcv_1.8-31        
[70] pillar_1.4.3        haven_2.2.0         whisker_0.4        
[73] foreign_0.8-76      withr_2.2.0         nnet_7.3-13        
[76] modelr_0.1.6        crayon_1.3.4        rmarkdown_2.6      
[79] jpeg_0.1-8.1        grid_3.6.3          data.table_1.12.8  
[82] git2r_0.26.1        webshot_0.5.2       reprex_0.3.0       
[85] digest_0.6.25       httpuv_1.5.2        munsell_0.5.0      
[88] viridisLite_0.3.0   tcltk_3.6.3