\documentclass{beamer} \usepackage{verbatim} \usecolortheme{seagull} \usepackage{pstricks,pst-node,pst-tree,amscd,amsfonts,verbatim,geometry,bbm} \usepackage{fancyvrb,fancybox} \usepackage{color} \usepackage{xcolor} \usepackage{colortbl} \usepackage{graphicx} %\RequirePackage{etex} %\usepackage{etex} %\usepackage{xypic} \usepackage[all,color]{xy} \usepackage{natbib} \usepackage{enumitem} \usepackage{tkz-graph} \usepackage{tikz} \usetikzlibrary{arrows,automata} \usetikzlibrary{graphs,arrows.meta} \usetikzlibrary{positioning} \usepackage{caption} \captionsetup[figure]{labelfont={it},textfont={color=black,it},labelformat={default},labelsep=period,name={}} \usepackage[latin1]{inputenc} \usepackage{undertilde} \usepackage{bm} \usepackage{amssymb} \usepackage{amsmath} %\usepackage{lastpage} \usepackage{rotating} \usepackage{multirow} \usepackage{graphicx} \usepackage{bbm} \usepackage{bbold} \usepackage{upgreek} \usepackage{fancybox} \usepackage{fancyhdr} \usepackage{amsfonts} \usepackage{dsfont} %\usepackage{arydshln} \usepackage{listings} \usepackage{courier} \lstloadlanguages{R} \usepackage[scaled=.85]{DejaVuSerifCondensed} \usepackage[T1]{fontenc} \usefonttheme{serif} \DeclareFontFamily{OT1}{pzc}{} \DeclareFontShape{OT1}{pzc}{m}{it}{<-> s * [1.30] pzcmi7t}{} \DeclareMathAlphabet{\mathpzc}{OT1}{pzc}{m}{it} %\theoremstyle{myNote} %\newtheorem{myNote}{Note} \usepackage{mathtools} \usepackage{bookmark} \usepackage{amsthm} \usepackage{ulem} \usepackage{soul} \usepackage{hanging} \setbeamertemplate{footnote}{\hangpara{2em}{1}\makebox[2em][l]{\insertfootnotemark}\footnotesize\insertfootnotetext\par} \addtobeamertemplate{footnote}{}{\vspace{5ex}} \hypersetup{% unicode =false, % non-Latin characters in Acrobat’s bookmarks pdftoolbar=true, % show Acrobat’s toolbar? pdfmenubar=true, % show Acrobat’s menu? %bookmarks=false, bookmarksopen=false } \usepackage{calc} \newsavebox\CBox \newcommand\hcancel[2][0.25pt]{% \ifmmode\sbox\CBox{$#2$}\else\sbox\CBox{#2}\fi% \makebox[0pt][l]{\usebox\CBox}% \rule[0.5\ht\CBox-#1/2]{\wd\CBox}{#1}} \newcommand{\msout}[1]{\text{\sout{\ensuremath{#1}}}} \makeatletter \newcommand*{\shifttext}[2]{% \settowidth{\@tempdima}{#2}% \makebox[\@tempdima]{\hspace*{#1}#2}% } \makeatother \newcommand\oldmyzeta[1]{{\textcolor{red}{\protect\mathpzc{z}_{#1}} \shifttext{-10pt}{\raisebox{0.1ex}{\tiny{\sim}}}}} \newcommand\firstmyzeta[1]{\textcolor{black}{{\protect\mathpzc{z}_{#1}}}} \newcommand\myzeta[1]{{\textcolor{mcgillred}{{\protect\textsf{z}_{#1}}}}} \newcommand\tildemyzeta[1]{\textcolor{mcgillred}{{\protect\widetilde{\textsf{z}}_{#1}}}} \theoremstyle{plain} \newtheorem{thm}{Theorem} % reset theorem numbering for each chapter \theoremstyle{definition} \newtheorem{defn}[thm]{Definition} % definition numbers are dependent on theorem numbers \newtheorem{Note}{Note} % same for example numbers \setbeamertemplate{theorems}[numbered] \def\U{\mathcal{U}} \def\u{\upsilon} \def\Ind{\mathds{1}} \def\transpose{\top} \def\Xvec{{\skew0\bm{X}}} \def\Xveca{{\skew0\bm{X}}_1} \def\Xvecb{{\skew0\bm{X}}_2} \def\Yvec{{\skew0\bm{Y}}} \def\xvec{{\skew0\bm{x}}} \def\xveca{{\skew0\bm{x}}_1} \def\xvecb{{\skew0\bm{x}}_2} \def\mvec{{\skew0\bm{m}}} \def\muvec{{\skew0\bm{\mu}}} \def\cvec{{\skew0\mathbf{c}}} \def\Xbar{\overline{X}} \def\xbar{\overline{x}} \def\ybar{\overline{y}} \def\yhat{\widehat{y}} \def\betahat{\widehat{\beta}} \def\betavec{\utilde{\beta}} \def\betahatvec{\skew3\widehat{\utilde{\beta}}} \def\sigmahat{\widehat{\sigma}} \def\ehat{\widehat{e}} \def\zhat{\widehat{z}} \def\nhat{\widehat{n}} \def\xbarA{\overline{x}_A} \def\xbarB{\overline{x}_B} \def\calR{\mathcal{R}} \def\calS{\mathcal{S}} \def\calE{{\mathcal{S}_{e}}} \def\calB{\mathcal{B}} \def\calU{\mathcal{U}} \def\calI{\mathcal{I}} \def\B{\mathcal{B}} \def\Qbb{\mathbb{Q}} \def\Pbb{\mathbb{P}} \def\E{\mathbb{E}} \def\Ehat{\widehat{\mathbbm{E}}} \def\Var{\mathbb{V}ar} \def\Cov{\mathbb{C}ov} \def\Corr{\mathbb{C}orr} \def\bhatint{\widehat{\beta}_0} \def\bhatsl{\widehat{\beta}_1} \def\d{\:\textrm{d}} \def\ps{{\textsf{e}}} \def\bs{{\textsf{b}}} \def\bX{\bm{X}} \def\Ident{\mathbf{I}} \def\One{\mathbf{1}} \def\Zero{\mathbf{0}} \def\bY{\mathbf{Y}} \def\by{\mathbf{y}} \newcommand\xbarBi[1]{\overline{x^{\text{\tiny{(B)}}}_{#1}}} \newcommand\xbarib[1]{\overline{x^{\text{\tiny{(B)}}}_{#1}}} \def\Fstat{\frac{(SSE_R - SSE_C)/(k-g)}{SSE_C/(n-k-1)}} \def\approxsim{\sim \! \! \! : \;} \def\hsp{\vspace{0.1 in}} \def\fsp{\vspace{0.2 in}} %\def\dfrac#1#2{{\displaystyle {#1 #2}}}% \def\dint{\mathop{\displaystyle \int}}% \def\dsum{\mathop{\displaystyle \sum}}% \newcommand\betaZ{$\beta_{1}$} \newcommand\betaA[1]{$\beta_{#1}^{(A)}$} \newcommand\betaB[1]{$\beta_{#1}^{(B)}$} \newcommand\gammaAB[1]{$\gamma_{#1}^{(AB)}$} \def\SST{\mathit{SST}} \def\MST{\mathit{MST}} \def\SSE{\mathit{SSE}} \def\MSE{\mathit{MSE}} \def\SSB{\mathit{SSB}} \def\MSB{\mathit{MSB}} \def\SSI{\mathit{SSI}} \def\MSI{\mathit{MSI}} \def\SS{\mathit{SS}} \def\Ztilde{{\widetilde Z}} \def\ztilde{{\widetilde z}} \def\bmu{\boldsymbol\mu} \newcounter{Lecture} \def\calA{\mathcal{A}} \renewcommand{\thelecture}{\arabic{lecture}} \newcommand\xbari[1]{\overline{x}_{#1}} \newcommand\subsectnum[1]{\textbf{\arabic{section}.\arabic{subsection}} \textbf{\uppercase{#1}}} \newcommand\textsclarge[1]{\fontshape{sc}\fontsize{14}{15} \selectfont{#1}} \renewcommand\emph[1]{\textcolor{mcgillred}{\textit{#1}}} \def\Exp{\mathcal{E}} \def\Ex{\mathcal{E}} \def\Exzero{\mathcal{E}_0} \def\Obs{\mathcal{O}} \def\Ob{\mathcal{O}} \usepackage{tikz} \newcommand*\circled[1]{\tikz[baseline=(char.base)]{ \node[shape=circle,draw,inner sep=1pt] (char) {#1};}} \def\WideSpacing{\itemsep=2.0ex\topsep=0.5ex\partopsep=0.0ex\parskip=0.0ex\parsep=0.0ex} \makeatletter \let\orig@Enumerate =\enumerate \newenvironment{enumerateWide}{\orig@Enumerate\WideSpacing}{\endlist} \makeatother \definecolor{midgray}{rgb}{0.75,0.75,0.75} \definecolor{lightgray}{rgb}{0.85,0.85,0.85} \definecolor{darkgray}{rgb}{0.654,0.724,0.795} \definecolor{lightdarkgray}{rgb}{0.727,0.805,0.883} \definecolor{purpleblue}{rgb}{0.50,0.50,1.00} \definecolor{lightblue}{rgb}{0.90,0.90,1.00} \definecolor{kugreen}{RGB}{50,93,61} \definecolor{kugreenlys}{RGB}{132,158,139} \definecolor{kugreenlyslys}{RGB}{173,190,177} \definecolor{kugreenlyslyslys}{RGB}{214,223,216} \definecolor{mcgillred}{rgb}{.926,0.105,0.184} \definecolor{mcgillreddark}{rgb}{0.617,0.035,0.094} \definecolor{mcgillredlight}{rgb}{0.926,0.153,0.241} \definecolor{verylightred}{rgb}{1,0.95,0.95} \definecolor{darkgreen}{rgb}{0.008, 0.294, 0.188} \definecolor{lightgreen}{rgb}{0.75,1.0,0.75} \definecolor{verylightgreen}{rgb}{0.90,1.0,0.90} \definecolor{darkblue}{rgb}{0.00, 0.00, 0.444} \definecolor{lightblue}{rgb}{0.933,0.933,1.00} \definecolor{psyc}{rgb}{0.87, 0.0, 1.0} \definecolor{mayablue}{rgb}{0.45, 0.76, 0.98} \definecolor{paleblue}{rgb}{0.69, 0.93, 0.93} \definecolor{spirodiscoball}{rgb}{0.06, 0.75, 0.99} \definecolor{lightcyan}{rgb}{0.88, 1.0, 1.0} \definecolor{frenchblue}{rgb}{0.0, 0.45, 0.73} \definecolor{bubbles}{rgb}{0.91, 1.0, 1.0} \definecolor{azurewm}{rgb}{0.94, 1.0, 1.0} \definecolor{airforceblue}{rgb}{0.36, 0.54, 0.66} \definecolor{darkmidnightblue}{rgb}{0.0, 0.2, 0.4} \definecolor{darkpastelblue}{rgb}{0.47, 0.62, 0.8} \definecolor{bleudefrance}{rgb}{0.19, 0.55, 0.91} \definecolor{babyblue}{rgb}{0.54, 0.81, 0.94} \setbeamercolor{background}{bg=red!15!white} \setbeamercovered{transparent} \setbeamercolor{title in sidebar}{fg=lightgray} \setbeamercolor{sidebar}{bg=lightgray,fg=purpleblue} \setbeamercolor{author in sidebar}{fg=lightgray} \setbeamercolor{section in sidebar}{fg=white,bg=mcgillred} \setbeamercolor{title}{fg=white,bg=mcgillred} \setbeamercolor{author}{use=structure,fg=black,bg=darkgray} \setbeamercolor{part name}{fg=black,bg=blue!30!white} \setbeamercolor{institute}{use=structure,fg=black,bg=lightdarkgray} \setbeamercolor{frametitle}{fg=white,bg=mcgillred} \setbeamercolor{subsection in sidebar}{fg=purpleblue} \setbeamercolor{block title}{use=structure,fg=black,bg=blue!30!white} \setbeamercolor{block body}{use=structure,fg=black,bg=blue!20!white} \setbeamertemplate{navigation symbols}{} \usepackage{relsize} \def\mybull{{\scriptsize{$\blacktriangleright$}}} \setlist[itemize]{label=\mybull} \setbeamercovered{transparent} \mode \setbeamertemplate{part page} { \begin{centering} %\begin{beamercolorbox}[sep=16pt,center]{author} % \usebeamerfont{part title}\partname~\insertpartnumber \par %\end{beamercolorbox} \vskip1em\par \begin{beamercolorbox}[sep=16pt,center]{institute} \usebeamerfont{part title} \insertpart\par \end{beamercolorbox} \end{centering} } \makeatletter \AtBeginPart{% \beamer@tocsectionnumber=0\relax \setcounter{section}{0} \numberwithin{section}{part} {% start a group to keep the template change local \setbeamertemplate{background canvas}{% \color{white}\rule{\paperwidth}{\paperheight}% }% \setbeamercolor{frametitle}{fg=white,bg=white} \setbeamertemplate{footline}{ \leavevmode% \hbox{\begin{beamercolorbox}[wd=.5\paperwidth,ht=2.5ex,dp=1.125ex,leftskip=.3cm plus1fill,rightskip=.3cm]{author in head/foot}% \usebeamerfont{author in head/foot} \end{beamercolorbox}% \begin{beamercolorbox}[wd=.5\paperwidth,ht=2.5ex,dp=1.125ex,leftskip=.3cm,rightskip=.3cm plus1fil]{title in head/foot}% \usebeamerfont{title in head/foot}\hfill\insertpagenumber \end{beamercolorbox}}% \vskip0pt% } %\addtocounter{framenumber}{-1} \begin{frame}[noframenumbering,c]{\partpage}\end{frame}% }% end group } \makeatother \setbeamercolor{author in head/foot}{bg=white, fg=mcgillred} \setbeamercolor{title in head/foot}{bg=white, fg=mcgillred} \setbeamertemplate{footline} {% %\rule{\paperwidth}{0.025cm} \leavevmode% \hbox{\begin{beamercolorbox}[left, wd=.5\paperwidth,ht=2.5ex,dp=1.125ex,leftskip=.3cm]{title in head/foot}% \usebeamerfont{author in head/foot}\insertpartnumber.\insertsectionnumber: \insertsection \end{beamercolorbox}% \begin{beamercolorbox}[wd=.5\paperwidth,ht=2.5ex,dp=1.125ex,leftskip=.3cm,rightskip=.3cm plus1fil]{title in head/foot}% \usebeamerfont{title in head/foot}\hfill\insertpagenumber \end{beamercolorbox}}% \vskip0pt% } %\usecolortheme[named=kugreen]{structure} %\useinnertheme{circles} %\setbeamercovered{transparent} %\setbeamertemplate{blocks}[rounded][shadow=true] \setbeamertemplate{blocks}[default] \setbeamerfont{itemize/enumerate subbody}{size=\footnotesize} \setbeamertemplate{itemize items}[circle] \newenvironment<>{Ex}[1]{% \begin{actionenv}#2% \def\insertblocktitle{Example: #1}% \par% \mode{% \setbeamercolor{block title}{use=structure,fg=darkmidnightblue,bg=babyblue} \setbeamercolor{block body}{use=structure,fg=black,bg=bubbles} \setbeamertemplate{itemize item}{\scriptsize\raise1.25pt\hbox{\donotcoloroutermaths$\bullet$}} }% \usebeamertemplate{block begin}\justifying} {\par\usebeamertemplate{block end}\end{actionenv}} \newenvironment<>{Thm}[1]{% \begin{actionenv}#2% \def\insertblocktitle{Theorem: #1}% \par% \mode{% \setbeamercolor{block title}{use=structure,fg=white,bg=darkgreen} \setbeamercolor{block body}{use=structure,fg=black,bg=lightgreen} \setbeamercolor{itemize item}{fg=orange!20!black} \setbeamertemplate{itemize item}[circle] }% \usebeamertemplate{block begin}\justifying} {\par\usebeamertemplate{block end}\end{actionenv}} \newenvironment<>{Nt}[1]{% \begin{actionenv}#2% \def\insertblocktitle{Note}% \par% \mode{% \setbeamercolor{block title}{use=structure,fg=white,bg=darkblue} \setbeamercolor{block body}{use=structure,fg=black,bg=azurewm} \setbeamercolor{itemize item}{fg=orange!20!black} \setbeamertemplate{itemize item}[circle] }% \usebeamertemplate{block begin}\justifying} {\par\usebeamertemplate{block end}\end{actionenv}} \newcounter{myNote} \newcommand{\myNote}{\arabic{myNote}} \setcounter{myNote}{1} \renewcommand*{\thefootnote}{[\arabic{footnote}]} \renewenvironment<>{Note}{% \begin{actionenv}% \def\insertblocktitle{Note \myNote.}% \par% \mode{% \setbeamercolor{block title}{use=structure,fg=white,bg=darkblue} \setbeamercolor{block body}{use=structure,fg=black,bg=lightblue} \setbeamercolor{itemize item}{fg=orange!20!black} \setbeamertemplate{itemize item}[circle] }% \usebeamertemplate{block begin}\addtocounter{myNote}{1}\justifying} {\par\usebeamertemplate{block end}\end{actionenv}} \date{ } % % The following info should normally be given in you main file: % \usepackage{tikz} \newcommand{\topline}{% \tikz[remember picture,overlay] {% \draw[midgray] ([yshift=-1cm]current page.north west) -- ([yshift=-1cm,xshift=\paperwidth]current page.north west);}} \setbeamertemplate{frametitle}{% \nointerlineskip \begin{beamercolorbox}[sep=0.3cm,ht=1.8em,wd=\paperwidth,rightskip=0cm]{frametitle}% \usebeamerfont{frametitle}\usebeamercolor[fg]{frametitle} \vbox{}\vskip-2ex% \strut\insertframetitle\strut \vskip-1.2ex% \end{beamercolorbox}% } \newcommand\mypart[1]{#1} %\setbeamertemplate{frametitle continuation}[from %second][(\lowercase{\insertcontinuationcountroman})] \setbeamertemplate{frametitle continuation}[from second][] \setbeamertemplate{section in toc}{\insertpartnumber.\inserttocsectionnumber\hspace*{1em}\inserttocsection} \title{The Two Sample Bernoulli Model} \author{Dr David A. Stephens} \institute{ Department of Mathematics \& Statistics\\ McGill University\\ Montreal, QC, Canada. \vspace{0.1 in} \texttt{david.stephens@mcgill.ca}\\ \texttt{\texttt{www.math.mcgill.ca/dstephens/SISCER2020/}} } \titlegraphic{\includegraphics[width=1.93cm,height=2cm]{McGillLogo}} \setbeamertemplate{itemize item}{\scriptsize\raise1.25pt\hbox{\donotcoloroutermaths$\bullet$}} \setbeamertemplate{itemize subitem}{\tiny\raise1.25pt\hbox{\donotcoloroutermaths$\blacktriangleright$}} \usepackage{etoolbox} %\usepackage{setspace} %\addtocontents{toc}{\protect\setstretch{0.9}} \usepackage{ragged2e} \apptocmd{\frame}{}{\justifying}{} % Allow optional arguments after frame. %\usepackage[bookmarks=true]{hyperref} \lstset{basicstyle=\ttfamily\tiny, numbers=left, numberstyle=\tiny, stepnumber=1, numbersep=5pt} \begin{document} \setbeamercolor{author in head/foot}{bg=white, fg=mcgillred} \setbeamercolor{title in head/foot}{bg=white, fg=mcgillred} { \setbeamertemplate{footline} {% \leavevmode% \hbox{\begin{beamercolorbox}[wd=.5\paperwidth,ht=2.5ex,dp=1.125ex,leftskip=.3cm plus1fill,rightskip=.3cm]{author in head/foot}% \usebeamerfont{author in head/foot} \end{beamercolorbox}% \begin{beamercolorbox}[wd=.5\paperwidth,ht=2.5ex,dp=1.125ex,leftskip=.3cm,rightskip=.3cm plus1fil]{title in head/foot}% \usebeamerfont{title in head/foot}\hfill\insertpagenumber \end{beamercolorbox}}% \vskip0pt% } <>= library(knitr) # global chunk options opts_chunk$set(cache=TRUE, autodep=TRUE, size = "tiny") options(scipen=5) options(repos=c(CRAN="https://cloud.r-project.org/")) @ %\frame{\titlepage} \begin{frame}[fragile,allowframebreaks]\frametitle{A Two Sample Problem} Suppose we have two infinite sequences \begin{align*} \{\bY_{1}\} & = Y_{11},Y_{12},\ldots,Y_{1n},\ldots\\ \{\bY_{2}\} & = Y_{21},Y_{22},\ldots,Y_{2n},\ldots \end{align*} For two finite collections of sizes $n_1$ and $n_2$, we have the de Finetti representation \[ f_{\bY_1,\bY_2}(\by_1,\by_2) = \iint \prod_{i=1}^{n_1} f_{1}(y_{1i};\theta_1) \prod_{i=1}^{n_2} f_{2}(y_{2i};\theta_2) \pi_0(d \theta_1, d \theta_2) \] \framebreak We can make different assumptions about a potential joint structure. \begin{enumerate}[label=(\alph*)] \item exchangeability \emph{within} each sequence and \emph{independence} across sequences \[ \pi_0(d \theta_1, d \theta_2) = \pi_0(d \theta_1) \pi_0(d \theta_2) \] that is, $\theta_1$ and $\theta_2$ are presumed independent \textit{a priori}. \framebreak \item exchangeability \emph{within} each sequence \[ \pi_0(d \theta_1, d \theta_2) \] has a general joint form; this is an example of \emph{partial exchangeability}, based on the sequence labels 1 and 2. \framebreak \item \emph{complete} exchangeability amongst all observables \[ \pi_0(d \theta_1, d \theta_2) \] is singular, and concentrates on the line $\theta_1 = \theta_2$. That is, there is in fact only one parameter \[ \theta = \theta_1 = \theta_2 \] and a prior $\pi_0$ on this parameter. \end{enumerate} \framebreak We focus on the case (a). In the binary observable case. \[ p_{Y_{ji}}(y;\theta_j) = \theta_j^{y} (1-\theta_j)^{1-y} \qquad j = 1,2 \] for each $0 \leq \theta \leq 1$. Suppose that, independently, \[ \pi_0(\theta_j) \equiv Beta(\alpha_0,\beta_0). \] for $\alpha_0, \beta_0 > 0$. \framebreak We have for the posterior densities for $j=1,2$. \[ \pi_n(\theta_j) \equiv Beta(s_{jn}+\alpha_0,n_j-s_{jn}+\beta_0) \equiv Beta(\alpha_{jn},\beta_{jn}) \] where \[ s_{1n} = \sum_{i=1}^{n_1} y_{1i} \qquad s_{2n} = \sum_{i=1}^{n_2} y_{2i} \] \framebreak Simulation: $n_1=8, n_2=12$, $\alpha_0 = 2,\beta_0 = 1.5$. Suppose that, in reality the true values of the parameters are \[ \theta_{10} = 0.5 \qquad \theta_{20} = 0.7 \] which are in the support of the prior. <>= set.seed(213) al0<-2.0 be0<-1.5 n1<-8 n2<-12 nreps<-4 th10<-0.5 th20<-0.7 ymat1<-t(replicate(nreps,rbinom(n1,1,th10))) ymat2<-t(replicate(nreps,rbinom(n2,1,th20))) @ \framebreak <>= #Data s1<-apply(ymat1,1,sum) s2<-apply(ymat2,1,sum) al.n1<-al0+s1 be.n1<-be0+n1-s1 al.n2<-al0+s2 be.n2<-be0+n2-s2 xv<-seq(0,1,length=1001) par(mar=c(4,4,2,1),mfrow=c(2,2)) for(irep in 1:4){ plot(xv,dbeta(xv,al.n1[irep],be.n1[irep]),type='l',col='red', ylim=range(0,6),xlab='',ylab=expression(pi[n])) lines(xv,dbeta(xv,al.n2[irep],be.n2[irep]),type='l',col='blue') legend(0,6,c('j=1','j=2'),col=c('red','blue'),lty=1) } mtext("Four data sets", side = 3, line = -1, cex=1.15, outer = TRUE) @ \framebreak We can report \begin{enumerate}[label=\arabic*.] \item Parameter Estimates: \begin{itemize} \item Posterior Mean: $\alpha_n/(\alpha_n+\beta_n)$ \item Posterior Median: 50\% quantile of $\pi_n(\theta)$ \item Posterior Mode: $(\alpha_n-1)/(\alpha_n+\beta_n-2)$ \end{itemize} \begin{table} \centering \begin{tabular}{|l|c|c|c|c|} \hline $\theta_{1}$ & 1 & 2 & 3 & 4 \\ \hline Mean & \Sexpr{round(al.n1[1]/(al.n1[1]+be.n1[1]),4)} & \Sexpr{round(al.n1[2]/(al.n1[2]+be.n1[2]),4)} & \Sexpr{round(al.n1[3]/(al.n1[3]+be.n1[3]),4)} & \Sexpr{round(al.n1[4]/(al.n1[4]+be.n1[4]),4)} \\ Median & \Sexpr{round(qbeta(0.5,al.n1[1],be.n1[1]),4)} & \Sexpr{round(qbeta(0.5,al.n1[2],be.n1[2]),4)} & \Sexpr{round(qbeta(0.5,al.n1[3],be.n1[3]),4)} & \Sexpr{round(qbeta(0.5,al.n1[4],be.n1[4]),4)} \\ Mode & \Sexpr{round((al.n1[1]-1)/(al.n1[1]+be.n1[1]-2),4)} & \Sexpr{round((al.n1[2]-1)/(al.n1[2]+be.n1[2]-2),4)} & \Sexpr{round((al.n1[3]-1)/(al.n1[3]+be.n1[3]-2),4)} & \Sexpr{round((al.n1[4]-1)/(al.n1[4]+be.n1[4]-2),4)} \\ \hline \end{tabular} \end{table} \begin{table} \centering \begin{tabular}{|l|c|c|c|c|} \hline $\theta_{2}$ & 1 & 2 & 3 & 4 \\ \hline Mean & \Sexpr{round(al.n2[1]/(al.n2[1]+be.n2[1]),4)} & \Sexpr{round(al.n2[2]/(al.n2[2]+be.n2[2]),4)} & \Sexpr{round(al.n2[3]/(al.n2[3]+be.n2[3]),4)} & \Sexpr{round(al.n2[4]/(al.n2[4]+be.n2[4]),4)} \\ Median & \Sexpr{round(qbeta(0.5,al.n2[1],be.n2[1]),4)} & \Sexpr{round(qbeta(0.5,al.n2[2],be.n2[2]),4)} & \Sexpr{round(qbeta(0.5,al.n2[3],be.n2[3]),4)} & \Sexpr{round(qbeta(0.5,al.n2[4],be.n2[4]),4)} \\ Mode & \Sexpr{round((al.n2[1]-1)/(al.n2[1]+be.n2[1]-2),4)} & \Sexpr{round((al.n2[2]-1)/(al.n2[2]+be.n2[2]-2),4)} & \Sexpr{round((al.n2[3]-1)/(al.n2[3]+be.n2[3]-2),4)} & \Sexpr{round((al.n2[4]-1)/(al.n2[4]+be.n2[4]-2),4)} \\ \hline \end{tabular} \end{table} \framebreak \item Posterior Credible Intervals: For $0 < \gamma < 1$, find $\mathcal{C}_{\gamma}$ such that \[ \int_{\mathcal{C}_{\gamma}} \pi_n(\theta) \ d \theta = \gamma \] which records a region where $\theta$ is inferred to lie with posterior probability $\gamma$. \medskip Typically we choose $\gamma=0.95$. There are several ways to construct such an interval \framebreak \emph{Equal tail probability interval:} find the $1-\gamma/2$ and $1-(1-\gamma/2)$ quantiles of the posterior. <>= gam<-0.95 par(mar=c(4,2,2,1)) plot(xv,dbeta(xv,al.n1[1],be.n1[1]),type='l', ylim=range(0,4),xlab='',ylab=expression(pi[n])) eti.l<-qbeta((1-gam)/2,al.n1[1],be.n1[1]) #Lower tail quantile eti.u<-qbeta(1-(1-gam)/2,al.n1[1],be.n1[1]) #Upper tail quantile eti.x<-seq(eti.l,eti.u,length=1001) eti.y<-dbeta(eti.x,al.n1[1],be.n1[1]) polygon(c(eti.x,eti.u,rev(eti.x),eti.l), c(rep(0,length(eti.x)),eti.y[length(eti.y)],rev(eti.y),0), col='cyan') @ \framebreak \emph{Highest posterior density (HPD) interval:} find $t_L$ and $t_U$ such that $\pi_n(t_L) = \pi_n(t_U)$ with \[ \int_{t_L}^{t_U} \pi_n(\theta) \ d \theta = \gamma \] <>= library(HDInterval) par(mar=c(4,2,2,1)) xv<-seq(0,1,length=1001) yv<-dbeta(xv,al.n1[1],be.n1[1]) hpd.int<-hdi(qbeta, 0.95, shape1=al.n1[1], shape2=be.n1[1]) hpd.int plot(xv,yv,type='l',ylim=range(0,4),xlab='',ylab=expression(pi[n])) hpd.l<-hpd.int[1] #Lower tail value hpd.u<-hpd.int[2] #Upper tail value hpd.x<-seq(hpd.l,hpd.u,length=1001) hpd.y<-dbeta(hpd.x,al.n1[1],be.n1[1]) polygon(c(hpd.x,hpd.u,rev(hpd.x),hpd.l), c(rep(0,length(hpd.x)),hpd.y[length(hpd.y)],rev(hpd.y),0), col='cyan') @ \framebreak \emph{Shortest interval:} <>= lowp<-seq(0.001,1-gam-0.001,by=0.001) lowq<-qbeta(lowp,al.n1[1],be.n1[1]) upq<-qbeta(lowp+gam,al.n1[1],be.n1[1]) minval<-which.min(upq-lowq) plot(xv,yv,type='l',ylim=range(0,4),xlab='',ylab=expression(pi[n])) spd.l<-lowq[minval] #Lower tail value spd.u<-upq[minval] #Upper tail value spd.x<-seq(spd.l,spd.u,length=1001) spd.y<-dbeta(spd.x,al.n1[1],be.n1[1]) polygon(c(spd.x,spd.u,rev(hpd.x),hpd.l), c(rep(0,length(spd.x)),spd.y[length(hpd.y)],rev(spd.y),0), col='cyan') @ \framebreak <>= #Equal-tailed c(eti.l,eti.u) #Ends of interval pbeta(eti.l,al.n1[1],be.n1[1]) #Left-tail probability #Highest posterior density c(hpd.l,hpd.u) #Ends of interval pbeta(hpd.l,al.n1[1],be.n1[1]) #Left-tail probability #Shortest c(spd.l,spd.u) #Ends of interval pbeta(spd.l,al.n1[1],be.n1[1]) #Left-tail probability @ \end{enumerate} \framebreak We may also examine parameters that \emph{compare} the two samples: \begin{itemize} \item Difference \[ \delta = \theta_2 - \theta_1 \] \item Ratio \[ \lambda = \frac{\theta_2}{\theta_1} \] \item Odds Ratio \[ \phi = \frac{\theta_2/(1-\theta_2)}{\theta_1/(1-\theta_1)} \] \end{itemize} In principle the posteriors for each of these derived parameters can be computed directly from \[ \pi_n(\theta_1) \qquad \pi_n(\theta_2) \] using standard transformation methods. \framebreak For example, for $t > 0$, \[ \Pr[\lambda \leq t] = \displaystyle \iint_{\mathcal{A}_t} \pi_n(\theta_1) \pi_n(\theta_2) \ d \theta_2 \ d \theta_1 \] where \[ \mathcal{A}_t = \{ (x_1,x_2) : 0 < x_1,x_2 < 1, x_2 \leq t x_1\}. \] that is \[ \Pr[\lambda \leq t] = \int_0^1 \int_0^{t \theta_1} \pi_n(\theta_1) \pi_n(\theta_2) \ d \theta_2 \ d \theta_1 \] This can be computed numerically. \framebreak However, it is very straightforward to use a \emph{sampling} approach: \begin{itemize} \item sample 10000 values from $\pi_n(\theta_1)$ \item sample 10000 values from $\pi_n(\theta_2)$ \item transform samples to obtain samples of $\lambda$ \end{itemize} <>= nsamp<-10000 th1.samp<-rbeta(nsamp,al.n1[1],be.n1[1]) th2.samp<-rbeta(nsamp,al.n2[1],be.n2[1]) lam.samp<-th2.samp/th1.samp hist(lam.samp,freq=FALSE,nclass=50,xlab=expression(lambda), main=expression(pi[n](lambda))) box() @ \framebreak We can compute a HPD credible interval from the sample using the \texttt{hdi} function: <>= hdi(lam.samp, 0.95) @ \end{frame} \end{document}