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
library(RColorBrewer)

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

colors <- c("firebrick2", "dodgerblue3", "mediumseagreen", "magenta4")
dat2 <- gather(dat, key = "Group", value="price", -time)
plot_ly(dat2, x = ~time, y = ~price, type = 'scatter', mode = 'lines', color = ~Group, colors=colors)

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.

library(foreign)
scs_data <- read.spss("/Users/GrantFaircloth/Desktop/DS 3003/SCS_QE.sav", to.data.frame = TRUE)

## re-encoding from CP1252

## Warning in read.spss("/Users/GrantFaircloth/Desktop/DS 3003/SCS_QE.sav", :
## Undeclared level(s) 0 added in variable: married

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

#scs_data2 <- scs_data[1:100,] # subset of the first 100 cases
scs_data2 <- scs_data[1:100,] # subset of the first 100 cases
b.out <- boot(scs_data2, b.stat, R = 2000) # R = num of replications

boot.ci(b.out, index = 1, type = 'perc') # 95% CI for the first observation

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

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

scs_data4 <- cbind(scs_data2, b.ci) # combine two datasets
ggplot(scs_data4, aes(x=mathpre, y=mars)) + geom_point(alpha=0.2) + labs(x = 'Math Score', y = 'Math Anxiety', title = "Relationship Between Math Scores and Math Anxiety") + theme_bw() + 
        geom_smooth(method='lm', formula= y ~ x, se = FALSE) +
        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.

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(stringr)

WHO <- read.csv("/Users/GrantFaircloth/Desktop/DS 3003/WHO-COVID-19-global-table-data.csv")

# Africa
nigeria <- WHO[WHO$Name == 'Nigeria',]
algeria <- WHO[WHO$Name == 'Algeria',]
mayotte <- WHO[WHO$Name == 'Mayotte',]

# Americas
usa <- WHO[WHO$Name == 'United States of America',]
mexico <- WHO[WHO$Name == 'Mexico',]
canada <- WHO[WHO$Name == 'Canada',]

# Eastern Mediterranean
afghan <- WHO[WHO$Name == 'Afghanistan',]
kuwait <- WHO[WHO$Name == 'Kuwait',]
iraq <- WHO[WHO$Name == 'Iraq',]

# Europe
poland <- WHO[WHO$Name == 'Poland',]
france <- WHO[WHO$Name == 'France',]
spain <- WHO[WHO$Name == 'Spain',]

# South East Asia
india <- WHO[WHO$Name == 'India',]
bhutan <- WHO[WHO$Name == 'Bhutan',]
indonesia <- WHO[WHO$Name == 'Indonesia',]

# Western Pacific
china <- WHO[WHO$Name == 'China',]
philippines <- WHO[WHO$Name == 'Philippines',]
japan <- WHO[WHO$Name == 'Japan',]

who <- rbind(nigeria, algeria, mayotte, usa, canada, mexico, afghan, kuwait, iraq, poland, france, spain, india, bhutan, indonesia, china, philippines, japan)

who <- who %>% mutate(rate = Deaths...cumulative.total / Cases...cumulative.total)

# Helper function for string wrapping. 
# Default 20 character target width.
swr = function(string, nwrap=20) {
  paste(strwrap(string, width=nwrap), collapse="\n")
}
swr = Vectorize(swr)

# Create line breaks in Year
who$WHO.Region = swr(who$WHO.Region)

library(plotly)
library(ggfittext)
g <- ggplot(who) + facet_grid(~WHO.Region, scale="free") + geom_bar(aes(x = Name, y = rate), stat = "identity") + theme(axis.text.x = element_text(angle = 20, vjust = 0.5, hjust=1)) + labs(title =  "Mortality Rate per Country", xlab = "Country Name", ylab = "Mortality Rate (%)")
ggplotly(g)

• 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.