##If a woman takes an early pregnancy test, she will either test positive, meaning that the test says she is pregnant or test negative, meaning that the test says she is not pregnant. Suppose that if a woman really is pregnant, there is a 98% chance that she will test positive. Also, suppose that if a woman really is not pregnant, there is a 99% chance that she will test negative. #(a) Suppose that 1,000 women take early pregnancy tests and that 100 of them really are pregnant. What is the probability that a randomly chosen woman from this group will test positive? # (b) Suppose that 1,000 women take early pregnancy tests and that 50 of them really are pregnant. What is the probability that a randomly chosen woman from this group will test positive?


here are the knowns facts: sensitivity = 0.98, specificity = .99 for preg test

in question a) incidence = 100/1000 = 0.01, in ? b) incidence = 50/1000 = 0.05

will use script from https://daranzolin.github.io/2018-01-07-probability-trees/

install.packages("DiagrammeR")
bayes_probability_tree <- function(prior, true_positive, true_negative) {
  
  if (!all(c(prior, true_positive, true_negative) > 0) && !all(c(prior, true_positive, true_negative) < 1)) {
    stop("probabilities must be greater than 0 and less than 1.",
         call. = FALSE)
  }
  c_prior <- 1 - prior
  c_tp <- 1 - true_positive
  c_tn <- 1 - true_negative
  
  round4 <- purrr::partial(round, digits = 4)
  
  b1 <- round4(prior * true_positive)
  b2 <- round4(prior * c_tp)
  b3 <- round4(c_prior * c_tn)
  b4 <- round4(c_prior * true_negative)
  
  bp <-  round4(b1/(b1 + b3))
  
  labs <- c("X", prior, c_prior, true_positive, c_tp, true_negative, c_tn, b1, b2, b4, b3)
  
  tree <-
    create_graph() %>%
    add_n_nodes(
      n = 11,
      type = "path",
      label = labs,
      node_aes = node_aes(
        shape = "circle",
        height = 1,
        width = 1,
        x = c(0, 3, 3, 6, 6, 6, 6, 8, 8, 8, 8),
        y = c(0, 2, -2, 3, 1, -3, -1, 3, 1, -3, -1))) %>% 
    add_edge(
      from = 1,
      to = 2,
      edge_aes = edge_aes(
        label = "Prior"
      )
    ) %>% 
    add_edge(
      from = 1, 
      to = 3,
      edge_aes = edge_aes(
        label = "Complimentary Prior"
      )
    ) %>% 
    add_edge(
      from = 2,
      to = 4,
      edge_aes = edge_aes(
        label = "True Positive"
      )
    ) %>% 
    add_edge(
      from = 2,
      to = 5,
      edge_aes = edge_aes(
        label = "False Negative"
      )
    ) %>% 
    add_edge(
      from = 3,
      to = 7,
      edge_aes = edge_aes(
        label = "False Positive"
      )
    ) %>% 
    add_edge(
      from = 3,
      to = 6,
      edge_aes = edge_aes(
        label = "True Negative"
      )
    ) %>% 
    add_edge(
      from = 4,
      to = 8,
      edge_aes = edge_aes(
        label = "="
      )
    ) %>% 
    add_edge(
      from = 5,
      to = 9,
      edge_aes = edge_aes(
        label = "="
      )
    ) %>% 
    add_edge(
      from = 7,
      to = 11,
      edge_aes = edge_aes(
        label = "="
      )
    ) %>% 
    add_edge(
      from = 6,
      to = 10,
      edge_aes = edge_aes(
        label = "="
      )
    ) 
  message(glue::glue("The probability of having (prior) after testing positive is {bp}"))
  print(render_graph(tree))
  invisible(tree)
}
bayes_probability_tree(prior = 0.1, true_positive = 0.98, true_negative = 0.99) # this returns the probability tree where incidence preg 0.01, sensitivity = 0.98, specificity = 0.99
The probability of having (prior) after testing positive is 0.9159
bayes_probability_tree(prior = 0.05, true_positive = 0.98, true_negative = 0.99)  # this returns the probability tree where incidence preg = 0.05, sensitivity = 0.98, specificity = 0.99
The probability of having (prior) after testing positive is 0.8376

now calculate the P for a) that a randomly chosen woman from this group will test positive?

##this is the sum of the T+ and F+ = 0.0098 + 0.009

randompositive <- 0.098 + 0.009 # returns chance for a) that a woman chosen randomly from this grp will test positive
print(randompositive)
[1] 0.107

now calculate the P for b) that a randomly chosen woman from this group will test positive?

##this is the sum of the T+ and F+= 0.049 + 0.0095

randompositiveb <- 0.049 + 0.0095 # returns chance for a) that a woman chosen randomly from this grp will test positive
print(randompositiveb)
[1] 0.0585
LS0tCnRpdGxlOiAic2NvdHRfcmVocmlnX2V4ZXJjaXNlXzMuMi42IgpvdXRwdXQ6CiAgaHRtbF9ub3RlYm9vazogZGVmYXVsdAogIGh0bWxfZG9jdW1lbnQ6CiAgICBkZl9wcmludDogcGFnZWQKICBwZGZfZG9jdW1lbnQ6IGRlZmF1bHQKICB3b3JkX2RvY3VtZW50OiBkZWZhdWx0Ci0tLQojI0lmIGEgd29tYW4gdGFrZXMgYW4gZWFybHkgcHJlZ25hbmN5IHRlc3QsIHNoZSB3aWxsIGVpdGhlciB0ZXN0IHBvc2l0aXZlLCBtZWFuaW5nIHRoYXQgdGhlIHRlc3Qgc2F5cyBzaGUgaXMgcHJlZ25hbnQgb3IgdGVzdCBuZWdhdGl2ZSwgbWVhbmluZyB0aGF0IHRoZSB0ZXN0IHNheXMgc2hlIGlzIG5vdCBwcmVnbmFudC4gU3VwcG9zZSB0aGF0IGlmIGEgd29tYW4gcmVhbGx5IGlzIHByZWduYW50LCB0aGVyZSBpcyBhIDk4JSBjaGFuY2UgdGhhdCBzaGUgd2lsbCB0ZXN0IHBvc2l0aXZlLiBBbHNvLCBzdXBwb3NlIHRoYXQgaWYgYSB3b21hbiByZWFsbHkgaXMgbm90IHByZWduYW50LCB0aGVyZSBpcyBhIDk5JSBjaGFuY2UgdGhhdCBzaGUgd2lsbCB0ZXN0IG5lZ2F0aXZlLgojKGEpIFN1cHBvc2UgdGhhdCAxLDAwMCB3b21lbiB0YWtlIGVhcmx5IHByZWduYW5jeSB0ZXN0cyBhbmQgdGhhdCAxMDAgb2YgdGhlbSByZWFsbHkgYXJlIHByZWduYW50LiBXaGF0IGlzIHRoZSBwcm9iYWJpbGl0eSB0aGF0IGEgcmFuZG9tbHkgY2hvc2VuIHdvbWFuIGZyb20gdGhpcyBncm91cCB3aWxsIHRlc3QgcG9zaXRpdmU/CiMgKGIpIFN1cHBvc2UgdGhhdCAxLDAwMCB3b21lbiB0YWtlIGVhcmx5IHByZWduYW5jeSB0ZXN0cyBhbmQgdGhhdCA1MCBvZiB0aGVtIHJlYWxseSBhcmUgcHJlZ25hbnQuIFdoYXQgaXMgdGhlIHByb2JhYmlsaXR5IHRoYXQgYSByYW5kb21seSBjaG9zZW4gd29tYW4gZnJvbSB0aGlzIGdyb3VwIHdpbGwgdGVzdCBwb3NpdGl2ZT8KCl9fX19fX19fX19fX19fX19fX19fX19fX19fX19fX19fX19fX19fCiMgaGVyZSBhcmUgdGhlIGtub3ducyBmYWN0czogc2Vuc2l0aXZpdHkgPSAwLjk4LCBzcGVjaWZpY2l0eSA9IC45OSBmb3IgcHJlZyB0ZXN0CiMjIGluIHF1ZXN0aW9uIGEpIGluY2lkZW5jZSA9IDEwMC8xMDAwID0gMC4wMSwgaW4gPyBiKSBpbmNpZGVuY2UgPSA1MC8xMDAwID0gMC4wNQojIyB3aWxsIHVzZSBzY3JpcHQgZnJvbSBodHRwczovL2RhcmFuem9saW4uZ2l0aHViLmlvLzIwMTgtMDEtMDctcHJvYmFiaWxpdHktdHJlZXMvCgpgYGB7cn0KaW5zdGFsbC5wYWNrYWdlcygiRGlhZ3JhbW1lUiIpCmBgYAoKCmBgYHtyfQpiYXllc19wcm9iYWJpbGl0eV90cmVlIDwtIGZ1bmN0aW9uKHByaW9yLCB0cnVlX3Bvc2l0aXZlLCB0cnVlX25lZ2F0aXZlKSB7CiAgCiAgaWYgKCFhbGwoYyhwcmlvciwgdHJ1ZV9wb3NpdGl2ZSwgdHJ1ZV9uZWdhdGl2ZSkgPiAwKSAmJiAhYWxsKGMocHJpb3IsIHRydWVfcG9zaXRpdmUsIHRydWVfbmVnYXRpdmUpIDwgMSkpIHsKICAgIHN0b3AoInByb2JhYmlsaXRpZXMgbXVzdCBiZSBncmVhdGVyIHRoYW4gMCBhbmQgbGVzcyB0aGFuIDEuIiwKICAgICAgICAgY2FsbC4gPSBGQUxTRSkKICB9CiAgY19wcmlvciA8LSAxIC0gcHJpb3IKICBjX3RwIDwtIDEgLSB0cnVlX3Bvc2l0aXZlCiAgY190biA8LSAxIC0gdHJ1ZV9uZWdhdGl2ZQogIAogIHJvdW5kNCA8LSBwdXJycjo6cGFydGlhbChyb3VuZCwgZGlnaXRzID0gNCkKICAKICBiMSA8LSByb3VuZDQocHJpb3IgKiB0cnVlX3Bvc2l0aXZlKQogIGIyIDwtIHJvdW5kNChwcmlvciAqIGNfdHApCiAgYjMgPC0gcm91bmQ0KGNfcHJpb3IgKiBjX3RuKQogIGI0IDwtIHJvdW5kNChjX3ByaW9yICogdHJ1ZV9uZWdhdGl2ZSkKICAKICBicCA8LSAgcm91bmQ0KGIxLyhiMSArIGIzKSkKICAKICBsYWJzIDwtIGMoIlgiLCBwcmlvciwgY19wcmlvciwgdHJ1ZV9wb3NpdGl2ZSwgY190cCwgdHJ1ZV9uZWdhdGl2ZSwgY190biwgYjEsIGIyLCBiNCwgYjMpCiAgCiAgdHJlZSA8LQogICAgY3JlYXRlX2dyYXBoKCkgJT4lCiAgICBhZGRfbl9ub2RlcygKICAgICAgbiA9IDExLAogICAgICB0eXBlID0gInBhdGgiLAogICAgICBsYWJlbCA9IGxhYnMsCiAgICAgIG5vZGVfYWVzID0gbm9kZV9hZXMoCiAgICAgICAgc2hhcGUgPSAiY2lyY2xlIiwKICAgICAgICBoZWlnaHQgPSAxLAogICAgICAgIHdpZHRoID0gMSwKICAgICAgICB4ID0gYygwLCAzLCAzLCA2LCA2LCA2LCA2LCA4LCA4LCA4LCA4KSwKICAgICAgICB5ID0gYygwLCAyLCAtMiwgMywgMSwgLTMsIC0xLCAzLCAxLCAtMywgLTEpKSkgJT4lIAogICAgYWRkX2VkZ2UoCiAgICAgIGZyb20gPSAxLAogICAgICB0byA9IDIsCiAgICAgIGVkZ2VfYWVzID0gZWRnZV9hZXMoCiAgICAgICAgbGFiZWwgPSAiUHJpb3IiCiAgICAgICkKICAgICkgJT4lIAogICAgYWRkX2VkZ2UoCiAgICAgIGZyb20gPSAxLCAKICAgICAgdG8gPSAzLAogICAgICBlZGdlX2FlcyA9IGVkZ2VfYWVzKAogICAgICAgIGxhYmVsID0gIkNvbXBsaW1lbnRhcnkgUHJpb3IiCiAgICAgICkKICAgICkgJT4lIAogICAgYWRkX2VkZ2UoCiAgICAgIGZyb20gPSAyLAogICAgICB0byA9IDQsCiAgICAgIGVkZ2VfYWVzID0gZWRnZV9hZXMoCiAgICAgICAgbGFiZWwgPSAiVHJ1ZSBQb3NpdGl2ZSIKICAgICAgKQogICAgKSAlPiUgCiAgICBhZGRfZWRnZSgKICAgICAgZnJvbSA9IDIsCiAgICAgIHRvID0gNSwKICAgICAgZWRnZV9hZXMgPSBlZGdlX2FlcygKICAgICAgICBsYWJlbCA9ICJGYWxzZSBOZWdhdGl2ZSIKICAgICAgKQogICAgKSAlPiUgCiAgICBhZGRfZWRnZSgKICAgICAgZnJvbSA9IDMsCiAgICAgIHRvID0gNywKICAgICAgZWRnZV9hZXMgPSBlZGdlX2FlcygKICAgICAgICBsYWJlbCA9ICJGYWxzZSBQb3NpdGl2ZSIKICAgICAgKQogICAgKSAlPiUgCiAgICBhZGRfZWRnZSgKICAgICAgZnJvbSA9IDMsCiAgICAgIHRvID0gNiwKICAgICAgZWRnZV9hZXMgPSBlZGdlX2FlcygKICAgICAgICBsYWJlbCA9ICJUcnVlIE5lZ2F0aXZlIgogICAgICApCiAgICApICU+JSAKICAgIGFkZF9lZGdlKAogICAgICBmcm9tID0gNCwKICAgICAgdG8gPSA4LAogICAgICBlZGdlX2FlcyA9IGVkZ2VfYWVzKAogICAgICAgIGxhYmVsID0gIj0iCiAgICAgICkKICAgICkgJT4lIAogICAgYWRkX2VkZ2UoCiAgICAgIGZyb20gPSA1LAogICAgICB0byA9IDksCiAgICAgIGVkZ2VfYWVzID0gZWRnZV9hZXMoCiAgICAgICAgbGFiZWwgPSAiPSIKICAgICAgKQogICAgKSAlPiUgCiAgICBhZGRfZWRnZSgKICAgICAgZnJvbSA9IDcsCiAgICAgIHRvID0gMTEsCiAgICAgIGVkZ2VfYWVzID0gZWRnZV9hZXMoCiAgICAgICAgbGFiZWwgPSAiPSIKICAgICAgKQogICAgKSAlPiUgCiAgICBhZGRfZWRnZSgKICAgICAgZnJvbSA9IDYsCiAgICAgIHRvID0gMTAsCiAgICAgIGVkZ2VfYWVzID0gZWRnZV9hZXMoCiAgICAgICAgbGFiZWwgPSAiPSIKICAgICAgKQogICAgKSAKICBtZXNzYWdlKGdsdWU6OmdsdWUoIlRoZSBwcm9iYWJpbGl0eSBvZiBoYXZpbmcgKHByaW9yKSBhZnRlciB0ZXN0aW5nIHBvc2l0aXZlIGlzIHticH0iKSkKICBwcmludChyZW5kZXJfZ3JhcGgodHJlZSkpCiAgaW52aXNpYmxlKHRyZWUpCn0KYGBgCgpgYGB7cn0KYmF5ZXNfcHJvYmFiaWxpdHlfdHJlZShwcmlvciA9IDAuMSwgdHJ1ZV9wb3NpdGl2ZSA9IDAuOTgsIHRydWVfbmVnYXRpdmUgPSAwLjk5KSAjIHRoaXMgcmV0dXJucyB0aGUgcHJvYmFiaWxpdHkgdHJlZSB3aGVyZSBpbmNpZGVuY2UgcHJlZyAwLjEsIHNlbnNpdGl2aXR5ID0gMC45OCwgc3BlY2lmaWNpdHkgPSAwLjk5CmBgYAoKYGBge3J9CmJheWVzX3Byb2JhYmlsaXR5X3RyZWUocHJpb3IgPSAwLjA1LCB0cnVlX3Bvc2l0aXZlID0gMC45OCwgdHJ1ZV9uZWdhdGl2ZSA9IDAuOTkpICAjIHRoaXMgcmV0dXJucyB0aGUgcHJvYmFiaWxpdHkgdHJlZSB3aGVyZSBpbmNpZGVuY2UgcHJlZyA9IDAuMDUsIHNlbnNpdGl2aXR5ID0gMC45OCwgc3BlY2lmaWNpdHkgPSAwLjk5CmBgYAoKIyBub3cgY2FsY3VsYXRlIHRoZSBQIGZvciBhKSB0aGF0IGEgcmFuZG9tbHkgY2hvc2VuIHdvbWFuIGZyb20gdGhpcyBncm91cCB3aWxsIHRlc3QgcG9zaXRpdmU/IAojI3RoaXMgaXMgdGhlIHN1bSBvZiB0aGUgVCsgYW5kIEYrID0gMC4wMDk4ICsgMC4wMDkKYGBge3J9CnJhbmRvbXBvc2l0aXZlIDwtIDAuMDk4ICsgMC4wMDkgIyByZXR1cm5zIGNoYW5jZSBmb3IgYSkgdGhhdCBhIHdvbWFuIGNob3NlbiByYW5kb21seSBmcm9tIHRoaXMgZ3JwIHdpbGwgdGVzdCBwb3NpdGl2ZQpwcmludChyYW5kb21wb3NpdGl2ZSkKYGBgCgojIG5vdyBjYWxjdWxhdGUgdGhlIFAgZm9yIGIpIHRoYXQgYSByYW5kb21seSBjaG9zZW4gd29tYW4gZnJvbSB0aGlzIGdyb3VwIHdpbGwgdGVzdCBwb3NpdGl2ZT8gCiMjdGhpcyBpcyB0aGUgc3VtIG9mIHRoZSBUKyBhbmQgRis9IDAuMDQ5ICsgMC4wMDk1CmBgYHtyfQpyYW5kb21wb3NpdGl2ZWIgPC0gMC4wNDkgKyAwLjAwOTUgIyByZXR1cm5zIGNoYW5jZSBmb3IgYSkgdGhhdCBhIHdvbWFuIGNob3NlbiByYW5kb21seSBmcm9tIHRoaXMgZ3JwIHdpbGwgdGVzdCBwb3NpdGl2ZQpwcmludChyYW5kb21wb3NpdGl2ZWIpCmBgYAoK