Group Homework

• You will work with your group to complete this assignment.

• Upload your html file on RPubs and include the link when you submit your submission files on Collab.

• Submit your group’s shared .Rmd AND “knitted”.html files on Collab.

• Note that this html file is now uploaded on RPubs.

Group Homework

• Your “knitted .html” submission must be created from your “group .Rmd” but be created on your own computer.

• Confirm this with the following comment included in your submission text box: “Honor Pledge: I have recreated my group submission using using the tools I have installed on my own computer”

• Name the files with a group name and YOUR name for your submission.

• Each group member must be able to submit this assignment as created from their own computer. If only some members of the group submit the required files, those group members must additionally provide a supplemental explanation along with their submission as to why other students in their group have not completed this assignment.

Part 1: Instruction

• Use the EuStockMarkets data that contains the daily closing prices of major European stock indices: Germany DAX (Ibis), Switzerland SMI, France CAC, and UK FTSE. Then, create multiple lines that show changes of each index’s daily closing prices over time.

• Please use function gather from package tidyr to transform the data from a wide to a long format. For more info, refer to our lecture materials on dataformats (i.e., DS3003_dataformat_facets_note.pdf, DS3003_dataformat_facets_code.rmd, or DS3003_dataformat_facets_code.html

• Use function plot_ly from package plotly to create a line plot.

Part 1: Example

• see the html file.

Part 1: Results

library(tidyr) # load tidyr package
library(plotly) # load plotly package

data(EuStockMarkets) # load EuStockMarkets
dat <- as.data.frame(EuStockMarkets) # coerce it to a data frame
dat$time <- time(EuStockMarkets) # add `time` variable
#View(dat)

# add your codes
market_dat <- dat %>% gather("market", "price", 1:4)

dat_plot <- plot_ly(market_dat, x = ~time, y = ~price, color= ~market, type = 'scatter', mode = 'lines')
dat_plot <- dat_plot %>% layout(title = 'Stock Closing Prices Over Time',
         xaxis = list(title = 'Time'),
         yaxis = list (title = 'Price'))
dat_plot

Part 2: Instruction

• Use the SCS Data set you downloaded from the previous group assignments, and then investigate the relationship between the mathematics achievement score (“mathpre”) and the math anxiety score (“mars”).

• Plot the data, linear line, and bootstrap confidence envelopes. Use 2,000 bootstrap replicates (i.e., R=2000) in function boot, and add appropriate x- and y- labels, and a title to the graph.

• Please refer to section: Linear regression with bootstrap confidence intervals in DS3003_visualizingerrors_reg_note.html and DS3003_visualizingerrors_reg_code.html.

# add your codes
library(foreign)
library(boot)

data <- read.spss("/Users/michaelvaden/Downloads/SCS_QE.sav", to.data.frame=TRUE)

## re-encoding from CP1252

b.stat <- function(data, i)
{
   b.dat <- data[i ,]
   out.lm <- lm(mathpre ~ mars, b.dat)
   predict(out.lm, data.frame(mars=data$mars))   
}

b.out <- boot(data, b.stat, R=2000)
boot.ci(b.out, index = 1, type = 'perc')

## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 2000 bootstrap replicates
## 
## CALL : 
## boot.ci(boot.out = b.out, type = "perc", index = 1)
## 
## Intervals : 
## Level     Percentile     
## 95%   ( 6.147,  6.929 )  
## Calculations and Intervals on Original Scale

b.ci <- t(sapply(1:nrow(data), function(x) boot.ci(b.out, index = x, type = 'perc')$percent))[, 4:5]
dimnames(b.ci) <- list(rownames(data), c('lower', 'upper'))

scs2 <- cbind(data, b.ci)

ggplot(scs2, aes(x=mars, y=mathpre)) + geom_jitter(alpha=0.2) + 
  labs(x = 'Math Achievement Score', y = 'Math Anxiety Score') + 
        geom_smooth(method='lm', formula= y~x, se = FALSE) + theme_bw() +
        geom_ribbon(aes(ymin = lower, ymax = upper), alpha = 0.3, fill="#69b3a2")

Part 3: Instruction

• Create WHO Reporting Barplots with error bars separated by WHO region using either facet_grid or facet_wrap.

• First, get the latest data from from https://covid19.who.int/table.

  • The file should likely be named “WHO COVID-19 global table data March XXth 2022 at XXXXX.csv”

  • Don’t use the data that I uploaded on Collab. It’s not the most recent data.

Part 3: Instruction (Cont’d)

• Second, create a subset including 3 countries per WHO region (Africa, Americas, Eastern Mediterranean, Europe, South-East Asia, Western Pacific). You can choose any three countries within each WHO region to compare the mortality rate (mutate(rate = "Deaths - cumulative total"/"Cases - cumulative total")).

• Third, draw bar plots with error bars using your subset, but adjust the graph in the facets using either facet_grid or facet_wrap (e.g., facet_grid(~ "WHO region", scale="free"). Please include scale="free" in your facet function.

# add your codes
#file.choose()
who <- read.csv("/Users/michaelvaden/Downloads/WHO-COVID-19-global-data.csv")
#View(who)

who <- who[who$Date_reported == max(who$Date_reported),]

who$Country[who$Country =="United States of America"] = "US"
who$Country[who$Country =="Iran (Islamic Republic of)"] = "Iran"
who$Country[who$Country =="The United Kingdom"] = "UK"

regions <- who[ who$Country == "Ethiopia" | # Africa
                           who$Country == "Congo" |  
                           who$Country == "Nigeria" | 
                           who$Country == "US" |     # Americas
                           who$Country == "Mexico" | 
                           who$Country == "Brazil" |
                           who$Country == "Pakistan" | # Eastern Mediterranean
                           who$Country == "Iran" | 
                           who$Country ==  "Egypt" |
                           who$Country ==  "Germany" | # Europe
                           who$Country == "UK" | 
                           who$Country == "France" |
                           who$Country == "India" |   # South-East Asia
                           who$Country == "Thailand" |  
                           who$Country == "Indonesia" |  
                           who$Country == "China" |   # Western Pacific
                           who$Country == "Japan" | 
                           who$Country == "Australia",]

regions <- regions %>% mutate(rate = Cumulative_deaths/Cumulative_cases, 
                                    SE = sqrt(rate*(1-rate)/Cumulative_cases))

regions[is.na(regions)] = 0 # remove missing values

ggplot(regions, aes(x=rate, y=Country, fill=WHO_region)) + geom_col() + theme_bw() + 
  xlab("Reported Deaths / Reported Cases") + 
  facet_grid(vars(WHO_region), scale="free") +
  geom_errorbar(aes(xmin=rate-1.96*SE, xmax=rate+1.96*SE), width=.2)

Part 3: Example

• One of the group members will present R codes and plots for Part 3 in class on Mar. 21 (Mon). Also, if you’re a presenter, please bring your laptop so that you can share your screen on zoom for the presentation.