<p><div><div><div><div data-show-faces="false" data-height="21" data-width="100" data-layout="button_count" data-send="true" data-href="https://www.r-bloggers.com/who-is-the-caretaker-evidence-based-probability-estimation-with-the-bnlearn-package/"></div></div><div></div></div><div></div></div>
<div>
(This article was first published on <strong><a href="http://blog.revolutionanalytics.com/2017/05/who-is-the-caretaker.html"> Revolutions</a></strong>, and kindly contributed to <a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers)</a> </div>
<div>
<p><em>by Juan M. Lavista Ferres , Senior Director of Data Science at Microsoft </em></p>
<p>In what was one of the most viral episodes of 2017, political science Professor <a rel="nofollow" href="https://twitter.com/robert_e_kelly?lang=en" target="_blank">Robert E Kelly</a> was live on BBC World News talking about the South Korean president being forced out of office when both his kids decided to take an easy path to fame <a rel="nofollow" href="https://apnews.com/ad4dd9951fb544cc9879cddd7eb05c5d" target="_blank">by showing up in their dad’s interview</a>. </p>
<p><iframe width="450" allowfullscreen="" src="https://www.youtube.com/embed/Mh4f9AYRCZY" height="281"></iframe></p>
<p>The video immediately went viral, and the <a rel="nofollow" href="http://www.bbc.co.uk/newsbeat/article/39235478/how-professordad-robert-kelly-realised-hed-gone-viral-very-very-viral" target="_blank">BBC reported</a> that within five days more than 100 million people from all over the world had watched it. Many people around the globe via Facebook, Twitter and reporters from reliable sources like <a rel="nofollow" href="http://time.com/money/4697929/kids-interrupt-live-skype-interview-bbc-funny/" target="_blank">Time.com</a> thought the woman that went after the children was her nanny, when in fact, the <a rel="nofollow" href="http://www.latimes.com/nation/la-na-bbc-professor-video-asian-wife-nanny-stereotypes-20170310-story.html" target="_blank">woman in the video was Robert’s wife, Jung-a Kim, who is Korean</a>. </p>
<p>The confusion over this episode caused a second viral wave calling out that <a rel="nofollow" href="https://www.theguardian.com/commentisfree/2017/mar/13/nanny-bbc-interview-robert-kelly-small-children" target="_blank">people that thought she was the nanny should feel bad for being stereotypical</a>.</p>
<p>We decided to embrace the uncertainty and take a data science based approach to estimating the chances that the person was the nanny or the mother of the child, based on the evidence people had from watching the news.</p>
<blockquote class="twitter-tweet" data-lang="en">
<p dir="ltr" lang="en"><a rel="nofollow" href="https://twitter.com/David_Waddell" target="_blank">@David_Waddell</a> What would that mean, please? Re-broadcasting it on BBC TV, or just here on Twitter? Is this kinda thing that goes 'viral' and gets weird?</p>
<p>— Robert E Kelly (@Robert_E_Kelly) <a rel="nofollow" href="https://twitter.com/Robert_E_Kelly/status/840165879291633664" target="_blank">March 10, 2017</a></p></blockquote>
<p></p>
<h2>What evidence did viewers of the video have?</h2>
<ul>
<li>the person is American Caucasian</li>
<li>the person is professional</li>
<li>there are two kids</li>
<li>the caretaker is Asian</li>
</ul>
<p>We then look for probability values for these statistics. (Given that Professor Kelly is American, all statistics are based on US data.)</p>
<ul>
<li>Probability (Asian Wife | Caucasian Husband) = 1% [<a rel="nofollow" href="https://en.wikipedia.org/wiki/Interracial_marriage_in_the_United_States" target="_blank">Married couples in the United States in 2010</a>]</li>
<li>Probability of (Household has Nanny | husband is professional) = 3.5% [<a rel="nofollow" href="https://cdn.americanprogress.org/wp-content/uploads/issues/2010/01/pdf/threefaces_exec_sum.pdf" target="_blank">The Three Faces of Work-Family Conflict</a>, page 9, Figure 3]</li>
<li>Probability of (Asian | Nanny) = 6% [<a rel="nofollow" href="https://www.caregiver.org/caregiver-statistics-demographics" target="_blank">Caregiver Statistics: Demographics</a>]</li>
<li>Probability of (Stay at home mom) = 14% and Probability of (Stay at home mom | Asian Wife) = 30%  [<a rel="nofollow" href="http://www.pewsocialtrends.org/2014/04/08/chapter-2-stay-at-home-mothers-by-demographic-group/" target="_blank">Stay-at-Home Mothers by Demographic Group</a> ]</li>
</ul>
<p>We define the following Bayesian network using the <a rel="nofollow" href="http://www.bnlearn.com/" target="_blank">bnlearn package</a> for R. We create the network using the <a rel="nofollow" href="https://www.rdocumentation.org/packages/bnlearn/versions/4.1/topics/model%20string%20utilities?tap_a=5644-dce66f&tap_s=10907-287229" target="_blank">model2network</a> function and then we input the conditional probability tables (CPTs) that we know at each node.</p>
<div>
<pre>library(bnlearn)
set.seed(<span>3</span>)
net <span>&lt;-</span> model2network(<span>&quot;[HusbandDemographics][HusbandIsProfessional][NannyDemographics][WifeDemographics|HusbandDemographics][StayAtHomeMom|HusbandIsProfessional:WifeDemographics][HouseholdHasNanny|StayAtHomeMom:HusbandIsProfessional][Caretaker|StayAtHomeMom:HouseholdHasNanny][CaretakerEthnicity|WifeDemographics:Caretaker:NannyDemographics]&quot;</span>)

plot(net)
</pre>
</div>
<p><a rel="nofollow" href="http://a1.typepad.com/6a0105360ba1c6970c01b8d28587d9970c-pi" target="_blank"><img border="0" alt="Prior-net" title="Prior-net" src="http://a1.typepad.com/6a0105360ba1c6970c01b8d28587d9970c-800wi"></a></p>
<p>The last step is to fit the parameters of the Bayesian network conditional on its structure, the <code>bn.fit</code> function runs the EM algorithm to learn CPT for all different nodes in the above graph.</p>
<div>
<pre>yn <span>&lt;-</span> c(<span>&quot;yes&quot;</span>, <span>&quot;no&quot;</span>)
ca <span>&lt;-</span> c(<span>&quot;caucacian&quot;</span>,<span>&quot;other&quot;</span>)
ao <span>&lt;-</span> c(<span>&quot;asian&quot;</span>,<span>&quot;other&quot;</span>)
nw <span>&lt;-</span> c(<span>&quot;nanny&quot;</span>,<span>&quot;wife&quot;</span>)

cptHusbandDemographics <span>&lt;-</span> matrix(c(<span>0.85</span>, <span>0.15</span>), ncol<span>=</span><span>2</span>, dimnames<span>=</span>list(<span>NULL</span>, ca)) <span>#[1]</span>
cptHusbandIsProfessional <span>&lt;-</span> matrix(c(<span>0.81</span>, <span>0.19</span>), ncol<span>=</span><span>2</span>, dimnames<span>=</span>list(<span>NULL</span>, yn)) <span>#[<a rel="nofollow" href="https://www.bls.gov/emp/ep_table_303.htm" target="_blank">2</a>]</span>
cptNannyDemographics <span>&lt;-</span> matrix(c(<span>0.06</span>, <span>0.94</span>), ncol<span>=</span><span>2</span>, dimnames<span>=</span>list(<span>NULL</span>, ao)) <span># [3]</span>
cptWifeDemographics <span>&lt;-</span> matrix(c(<span>0.01</span>, <span>0.99</span>, <span>0.33</span>, <span>0.67</span>), ncol<span>=</span><span>2</span>, dimnames<span>=</span>list(<span>&quot;WifeDemographics&quot;</span><span>=</span>ao, <span>&quot;HusbandDemographics&quot;</span><span>=</span>ca)) <span>#[1]</span>
cptStayAtHomeMom <span>&lt;-</span> c(<span>0.3</span>, <span>0.7</span>, <span>0.14</span>, <span>0.86</span>, <span>0.125</span>, <span>0.875</span>, <span>0.125</span>, <span>0.875</span>) <span>#[4]</span>

dim(cptStayAtHomeMom) <span>&lt;-</span> c(<span>2</span>, <span>2</span>, <span>2</span>)
dimnames(cptStayAtHomeMom) <span>&lt;-</span> list(<span>&quot;StayAtHomeMom&quot;</span><span>=</span>yn, <span>&quot;WifeDemographics&quot;</span><span>=</span>ao, <span>&quot;HusbandIsProfessional&quot;</span><span>=</span>yn)

cptHouseholdHasNanny <span>&lt;-</span> c(<span>0.01</span>, <span>0.99</span>, <span>0.035</span>, <span>0.965</span>, <span>0.00134</span>, <span>0.99866</span>, <span>0.00134</span>, <span>0.99866</span>) <span>#[5]</span>
dim(cptHouseholdHasNanny) <span>&lt;-</span> c(<span>2</span>, <span>2</span>, <span>2</span>)
dimnames(cptHouseholdHasNanny) <span>&lt;-</span> list(<span>&quot;HouseholdHasNanny&quot;</span><span>=</span>yn, <span>&quot;StayAtHomeMom&quot;</span><span>=</span>yn, <span>&quot;HusbandIsProfessional&quot;</span><span>=</span>yn)

cptCaretaker <span>&lt;-</span> c(<span>0.5</span>, <span>0.5</span>, <span>0.999</span>, <span>0.001</span>, <span>0.01</span>, <span>0.99</span>, <span>0.001</span>, <span>0.999</span>)
dim(cptCaretaker) <span>&lt;-</span> c(<span>2</span>, <span>2</span>, <span>2</span>)
dimnames(cptCaretaker) <span>&lt;-</span> list(<span>&quot;Caretaker&quot;</span><span>=</span>nw, <span>&quot;StayAtHomeMom&quot;</span><span>=</span>yn, <span>&quot;HouseholdHasNanny&quot;</span><span>=</span>yn)

cptCaretakerEthnicity <span>&lt;-</span> c(<span>0.99</span>, <span>0.01</span>, <span>0.99</span>, <span>0.01</span>, <span>0.99</span>, <span>0.01</span>, <span>0.01</span>, <span>0.99</span>, <span>0.01</span>,<span>0.99</span>,<span>0.99</span>,<span>0.01</span>,<span>0.01</span>,<span>0.99</span>,<span>0.01</span>,<span>0.99</span>)
dim(cptCaretakerEthnicity) <span>&lt;-</span> c(<span>2</span>, <span>2</span>, <span>2</span>,<span>2</span>)
dimnames(cptCaretakerEthnicity) <span>&lt;-</span> list(<span>&quot;CaretakerEthnicity&quot;</span><span>=</span>ao,<span>&quot;Caretaker&quot;</span><span>=</span>nw, <span>&quot;WifeDemographics&quot;</span><span>=</span>ao ,<span>&quot;NannyDemographics&quot;</span><span>=</span>ao)

net.disc <span>&lt;-</span> custom.fit(net, dist<span>=</span>list(HusbandDemographics<span>=</span>cptHusbandDemographics, HusbandIsProfessional<span>=</span>cptHusbandIsProfessional, WifeDemographics<span>=</span>cptWifeDemographics, StayAtHomeMom<span>=</span>cptStayAtHomeMom, HouseholdHasNanny<span>=</span>cptHouseholdHasNanny, Caretaker<span>=</span>cptCaretaker, NannyDemographics<span>=</span>cptNannyDemographics,CaretakerEthnicity<span>=</span>cptCaretakerEthnicity))
</pre>
</div>
<p>Once we have the model, we can query the network using <code>cpquery</code> to estimate the probability of the events and calculate the probability that the person is the nanny or the wife based on the evidence we have (husband is Caucasian and professional, caretaker is Asian). Based on this evidence the output is that the probability that she is the wife is <strong>90%</strong> vs. 10% that she is the nanny.</p>
<div>
<pre>probWife <span>&lt;-</span> cpquery(net.disc, (Caretaker<span>==</span><span>&quot;wife&quot;</span>),HusbandDemographics<span>==</span><span>&quot;caucacian&quot;</span> <span>&amp;</span> HusbandIsProfessional<span>==</span><span>&quot;yes&quot;</span> <span>&amp;</span> CaretakerEthnicity<span>==</span><span>&quot;asian&quot;</span>,n<span>=</span><span>1000000</span>)
probNanny <span>&lt;-</span> cpquery(net.disc, (Caretaker<span>==</span><span>&quot;nanny&quot;</span>),HusbandDemographics<span>==</span><span>&quot;caucacian&quot;</span> <span>&amp;</span> HusbandIsProfessional<span>==</span><span>&quot;yes&quot;</span> <span>&amp;</span> CaretakerEthnicity<span>==</span><span>&quot;asian&quot;</span>,n<span>=</span><span>1000000</span>) 

[<span>1</span>] <span>&quot;The probability that the caretaker is his wife = 0.898718647764449&quot;</span>
[<span>1</span>] <span>&quot;The probability that the caretaker is the nanny = 0.110892031547457&quot;</span>
</pre>
</div>
<p>In conclusion, if you thought the woman in the video was the nanny, you may need to review your priors!</p>
<p>The <a rel="nofollow" href="https://mran.microsoft.com/package/bnlearn/" target="_blank">bnlearn package</a> is available on CRAN. You can find the R code behind this post <a rel="nofollow" href="https://github.com/jlavista/WhoIsTheCaretaker/blob/master/bayesianNetwork.r" target="_blank">here on GitHub</a> or <a rel="nofollow" href="https://notebooks.azure.com/n/A3R4bArBBTc/notebooks/Nanny%20Prior.ipynb" target="_blank">here as a Jupyter Notebook</a>.</p>
</div>
<p>
<div>
<div>To <strong>leave a comment</strong> for the author, please follow the link and comment on their blog: <strong><a href="http://blog.revolutionanalytics.com/2017/05/who-is-the-caretaker.html"> Revolutions</a></strong>.</div>
<hr>
<a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers.com</a> offers <strong><a rel="nofollow" href="https://feedburner.google.com/fb/a/mailverify?uri=RBloggers">daily e-mail updates</a></strong> about <a rel="nofollow" href="https://www.r-project.org/" title="The R Project for Statistical Computing">R</a> news and <a rel="nofollow" href="https://www.r-bloggers.com/search/tutorial" title="R tutorials">tutorials</a> on topics such as: <a rel="nofollow" href="https://www.r-bloggers.com/search/data%20science" title="Data science">Data science</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/Big%20Data" title="Big Data">Big Data, <a rel="nofollow" href="https://www.r-users.com/" title="R jobs">R jobs</a>, visualization (<a rel="nofollow" href="https://www.r-bloggers.com/search/ggplot2" title="ggplot and ggplot2 tutorials">ggplot2</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/boxplot" title="Boxplots using lattice and ggplot2 tutorials">Boxplots</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/map" title="Maps and gis">maps</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/animation" title="Animation in R">animation</a>), programming (<a rel="nofollow" href="https://www.r-bloggers.com/search/RStudio" title="RStudio IDE for R">RStudio</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/sweave" title="Sweave and literate programming">Sweave</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/LaTeX" title="LaTeX in R">LaTeX</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/SQL" title="SQL and databases">SQL</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/eclipse" title="Eclipse IDE for R">Eclipse</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/git" title="git and github, Version Control System">git</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/hadoop" title="Large data in R using Hadoop">hadoop</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/Web+Scraping" title="Web Scraping of google, facebook, yahoo, twitter and more using R">Web Scraping</a>) statistics (<a rel="nofollow" href="https://www.r-bloggers.com/search/regression" title="Regressions and ANOVA analysis tutorials">regression</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/PCA" title="principal component analysis tutorial">PCA</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/time+series" title="Time series">time series</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/trading" title="finance trading">trading</a>) and more...
<img width="1" alt="" src="http://feeds.feedburner.com/~r/RBloggers/~4/IAcHNq5GP7I" height="1"></a></div>