\title{results of 350,757 coin flips to examine same-side bias}
\description{results from 350,757 coin flips by 48 people to examine the presence of same-side bias.}
\bold{person} \tab \code{character} \tab person identifier \cr
\bold{hsame}  \tab \code{numeric}   \tab number of flips where the coin landed on heads and on the same side as where it started \cr
\bold{hdiff}  \tab \code{numeric}   \tab number of flips where the coin landed on heads and on the different side as where it started \cr
\bold{tsame}  \tab \code{numeric}   \tab number of flips where the coin landed on tails and on the same side as where it started \cr
\bold{tdiff}  \tab \code{numeric}   \tab number of flips where the coin landed on tails and on the different side as where it started \cr
\bold{same}   \tab \code{numeric}   \tab number of flips where the coin landed on the same side as where it started \cr
\bold{flips}  \tab \code{numeric}   \tab total number of flips
in a landmark study by \enc{bartoš}{bartos} et al. (2023), 48 people flipped a coin (of various currencies and/or denominations) a total of 350,757 times, recording on each flip whether it landed on heads or tails and whether the coin landed on the same side as where it started or on the different side. the goal of this experiment was to examine the model by diaconis, holmes, and montgomery (2007), according to which flipped coins have a slightly higher than 50\% chance (of around 51\% according to the d-h-m model) of landing on the same side as where they started.
\enc{bartoš}{bartos}, f., sarafoglou, a., godmann, h. r., sahrani, a., leunk, d. k., gui, p. y., voss, d., ullah, k., zoubek, m. j., nippold, f., aust, f., vieira, f. f., islam, c.-g., zoubek, a. j., shabani, s., petter, j., roos, i. b., finnemann, a., lob, a. b., hoffstadt, m. f., nak, j., de ron, j., derks, k., huth, k., terpstra, s., bastelica, t., matetovici, m., ott, v. l., zetea, a. s., karnbach, k., donzallaz, m. c., john, a., moore, r. m., assion, f., van bork, r., leidinger, t. e., zhao, x., motaghi, a. k., pan, t., armstrong, h., peng, t., bialas, m., pang, j. y.-c., fu, b., yang, s., lin, x., sleiffer, d., bognar, m., aczel, b., & wagenmakers, e.-j. (2023). fair coins tend to land on the same side they started: evidence from 350,757 flips. \emph{arxiv}, 2310.04153, v2. \verb{https://arxiv.org/abs/2310.04153}
diaconis, p., holmes, s., & montgomery, r. (2007). dynamical bias in the coin toss. \emph{siam review}, \bold{49}(2), 211--235. \verb{https://doi.org/10.1137/s0036144504446436}
### compute proportions and the corresponding sampling variances
dat <- escalc(measure="pr", xi=same, ni=flips, data=dat, slab=person)
### compute confidence intervals for the individual proportions (as in table 1)
### compute a confidence interval based on the column totals
### this is the same as meta-analyzing the proportions directly using an equal-effects
### model and also computing the sampling variances under the assumption that the true
rma(measure="pr", xi=same, ni=flips, vtype="av", method="ee", data=dat, digits=3)
### profile likelihood confidence interval for tau^2
### fit a random-effects model excluding those with same-side proportions larger than 0.53
res <- rma(yi, vi, data=dat, subset=yi<=0.53)
res <- rma.glmm(measure="plo", xi=same, ni=flips, data=dat)
### conduct a meta-analysis for the proportions of heads (to examine heads-tails bias)
dat <- escalc(measure="pr", xi=hdiff+hsame, ni=flips, data=dat)
### restructure the dataset for a bivariate meta-analysis of same-side and heads proportions
dat <- escalc(measure="pr", xi=hsame+hdiff, ni=flips, data=dat, include=outcome=="heads")
dat <- escalc(measure="pr", xi=hsame+tsame, ni=flips, data=dat, include=outcome=="same")
### construct the 2x2 variance-covariance matrix of the proportions within persons
dat$cov <- with(dat, (hsame/flips * (1-hsame/flips) - hsame/flips * tsame/flips -
hsame/flips * hdiff/flips - hdiff/flips * tsame/flips) / flips)
v <- lapply(split(dat, dat$person), \(x) matrix(c(x$vi[1], x$cov, x$vi[2]), nrow=2))
res <- rma.mv(yi, v, mods = ~ 0 + outcome, random = ~ outcome | person, struct="un", data=dat)
### create plot with confidence ellipses ('ellipse' package must be installed)
xy <- ellipse(matrix(c(x$vi[1],x$cov,x$vi[2]), nrow=2), centre=x$yi, level=0.95)
invisible(tapply(dat, dat$person, \(x) points(x$yi[1], x$yi[2], pch=21, bg="gray80", cex=1.5)))
# add the 95\% pi ellipsis based on the model
xy <- ellipse(res$g, centre=coef(res), level=0.95)
# add the 95\% ci ellipsis based on the model
xy <- ellipse(vcov(res), centre=coef(res), level=0.95)
points(coef(res)[1], coef(res)[2], pch=21, bg="gray40", cex=2)
physics, human factors, proportions, multivariate models