Scribd Logo
Upload

Welcome to Scribd!

  • 81 views

    MYLab 3

    Uploaded by

    Mangala Prasetia
    This document summarizes an experiment conducted by Mythbusters to test whether yawning is contagious. Participants were randomly assigned to a control group or treatment group. The treatment group was exposed to someone yawning near them, while the control group was not. The results showed that 25% of the control group yawned compared to 29.41% of the treatment group, a difference of 4.41 percentage points. A permutation test was conducted to determine if this difference could be due to chance, which showed that the difference was equaled or exceeded in the permuted data 25.49% of the time, resulting in a p-value of 0.2549 and failure to reject the null hypothesis that there is no

    Copyright:

    © All Rights Reserved
    Download as DOCX, PDF, TXT or read online from Scribd

    MYLab 3

    Uploaded by

    Mangala Prasetia
    81 views4 pages
    This document summarizes an experiment conducted by Mythbusters to test whether yawning is contagious. Participants were randomly assigned to a control group or treatment group. The treatment group was exposed to someone yawning near them, while the control group was not. The results showed that 25% of the control group yawned compared to 29.41% of the treatment group, a difference of 4.41 percentage points. A permutation test was conducted to determine if this difference could be due to chance, which showed that the difference was equaled or exceeded in the permuted data 25.49% of the time, resulting in a p-value of 0.2549 and failure to reject the null hypothesis that there is no

    Original Description:

    statistics

    Original Title

    MYLab3

    Copyright

    © © All Rights Reserved

    Available Formats

    DOCX, PDF, TXT or read online from Scribd

    Did you find this document useful?

    Is this content inappropriate?

    This document summarizes an experiment conducted by Mythbusters to test whether yawning is contagious. Participants were randomly assigned to a control group or treatment group. The treatment group was exposed to someone yawning near them, while the control group was not. The results showed that 25% of the control group yawned compared to 29.41% of the treatment group, a difference of 4.41 percentage points. A permutation test was conducted to determine if this difference could be due to chance, which showed that the difference was equaled or exceeded in the permuted data 25.49% of the time, resulting in a p-value of 0.2549 and failure to reject the null hypothesis that there is no

    Copyright:

    © All Rights Reserved
    Download as DOCX, PDF, TXT or read online from Scribd
    Download as docx, pdf, or txt
    81 views4 pages

    MYLab 3

    Uploaded by

    Mangala Prasetia
    This document summarizes an experiment conducted by Mythbusters to test whether yawning is contagious. Participants were randomly assigned to a control group or treatment group. The treatment group was exposed to someone yawning near them, while the control group was not. The results showed that 25% of the control group yawned compared to 29.41% of the treatment group, a difference of 4.41 percentage points. A permutation test was conducted to determine if this difference could be due to chance, which showed that the difference was equaled or exceeded in the permuted data 25.49% of the time, resulting in a p-value of 0.2549 and failure to reject the null hypothesis that there is no

    Copyright:

    © All Rights Reserved
    Download as DOCX, PDF, TXT or read online from Scribd
    Download as docx, pdf, or txt
    of 4

    MYLab3

    Jason Qin, Joshua Dharma Prameswara, Nursaule Sagyndykova, Carien Leushuis

    12 August 2016

    Authcates: jqin17, jdpra2, nsag3, cleu0001

    Question 1
    yawn_expt <- data.frame(group=c(rep("treatment", 34), rep("control", 16)),
    yawn=c(rep("yes", 10), rep("no", 24), rep("yes", 4), rep("no", 12)))

    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(tidyr)
    library(knitr)
    yawn_expt %>%
    group_by(group, yawn) %>%
    tally() %>%
    ungroup() %>%
    spread(yawn, n, fill=0) %>%
    mutate(total = rowSums(.[-1])) %>%
    mutate(proportion=yes/total) %>%
    kable()

    group no yes total proportion


    control 12 4 16 0.2500000
    treatment 24 10 34 0.2941176
    a. 50

    b. The participants were randomly assigned to two groups. 16 people were assigned to
    the control group where there wasn't a person yawning near them and 34 people were
    assigned to the treatment group where a person near them yawned.

    c. The two variables are: i) which group they belong to (control or treatment) and ii) the
    outcome depending on whether they yawned or not (yes or no).
    d. 25% of the control group yawned and roughly 29.41% of the treatment group yawned.

    e. There is roughly a 4.41 percentage point difference in the proportion of people


    yawning between the two groups.

    Question 2
    a. The null hypothesis is the hypothesis that the proportion of people yawning in the
    control group and the treatment group is the same.

    b. The alternative hypothesis would be the hypothesis that the proportion of people
    yawning in the treatment group is greater than the proportion of people yawning in
    the control group i.e. : < .

    c. This is because Mythbusters is testing whether "a person can be subconsciously


    influenced into yawning if another person near them yawns". Hence they expect that a
    person is more likely to yawn if someone near them also yawns.

    Question 3
    yawn_expt <- data.frame(group=c(rep("treatment", 34), rep("control", 16)),
    yawn=c(rep("yes", 10), rep("no", 24), rep("yes", 4), rep("no", 12)))

    yawn_expt %>%
    group_by(group, yawn) %>%
    tally() %>%
    ungroup() %>%
    spread(yawn, n, fill=0) %>%
    mutate(total = rowSums(.[-1])) %>%
    mutate(p=yes/total)->yawn.table
    expt.diff<-yawn.table$p[2]-yawn.table$p[1]

    set.seed(2)
    permutation <-function(data){
    data%>%
    mutate(yawn=sample(yawn)) %>%
    group_by(group, yawn) %>%
    tally() %>%
    ungroup() %>%
    spread(yawn, n, fill=0) %>%
    mutate(total = rowSums(.[-1])) %>%
    mutate(p=yes/total)->yawn.table
    expt.diff<-yawn.table$p[2]-yawn.table$p[1]
    return(expt.diff)
    }
    permutation(yawn_expt) #difference between proportions of treatment and contr
    ol groups

    ## [1] 0.1360294
    Question 4
    prop.difference<-vector(length=10000)
    set.seed(2)
    for (i in 1:10000) {
    prop.difference[i] <- permutation(yawn_expt)
    }

    library(ggplot2)
    prop.diff<-data.frame(prop.difference)
    ggplot(data=prop.diff)+geom_histogram(aes(x=prop.difference), binwidth=0.025)
    +geom_vline(xintercept=expt.diff,colour="red")+labs(x="Permutation test diffe
    rences")

    sum(prop.difference>expt.diff)

    ## [1] 2549

    sum(prop.difference>expt.diff)/length(prop.difference)

    ## [1] 0.2549

    above=filter(prop.diff,prop.difference>expt.diff)
    ggplot()+geom_histogram(data=prop.diff, aes(x=prop.difference),binwidth=0.025
    )+geom_histogram(data=above,aes(x=prop.difference), fill="red",binwidth=0.025
    )+geom_vline(xintercept=expt.diff,colour="red")
    The results indicate that 25.49% of the time, the permuted data yields a difference larger
    than the difference of the actual data.

    Question 5
    a. p-value = 0.2549

    b. Fail to reject the null hypothesis.

    c. We conclude that there is insufficient evidence to reject the null hypothesis that the
    proportion of people yawning in the control group is the same as the proportion of
    people yawning in the treatment group.

    d. Therefore based on our experimental results, there is evidence to suggest that


    yawning isn't contagious.

    You might also like