DATA609 Course Project Summary

• Monte Carlo Simulation

• Decision Theory

• SIR Model (Differential Equations)

probabilities <- c(1/8,1/6,1/10,1/13,1/5,1/36,1/16,1/5)
(sum(probabilities))

[1] 0.9588675

(factor <- (1/sum(probabilities)))

[1] 1.042897

(sum((probabilities.modified <- probabilities * factor)))

[1] 1

Write a function to sample from the probability distribution. And make 1000 samples:

Problem Definition

The NBC TV network earns an average of $400,000 from a hit show and loses an average of 100,000 on a flop (a show that cannot hold its rating and must be canceled). If the network airs a show without a market review, 25% turn out to be hits, and 75% are flops. For $40,000, a market research firm can be hired to help determine whether the show will be a hit or a flop. If the show is actually going to be a hit, there is a 90% chance that the market research firm will predict a hit. If the show is going to be a flop, there is an 80% chance that the market research will predict the show to be a flop. Determine how the network can maximize its profits over the long haul.

There are four outcomes. 2 with research and 2 without research (Decision Trees)

1.Air show a hit with research

2.Air show a flop with research

3.Air show a hit without research

4.Air show a flop without research

NBC TV network will pay $40,000 to the market research firm.

Expected Value if the show is hit is 0.25 * 0.9 * 400,000 + 0.75 * 0.2 * 400,000 = $150,000

Expected Value if the show is Flop 0.25 * 0.1 * 100000 + 0.75 * 0.8 * 100000 = $62,500

So the total profit is 150000 - 62500 - 40,000 = $47,500

Expected Value if the show is hit is 0.25 * 400,000 = $100,000

Expected Value if the show is Flop 0.75 * 100000 = $75,000

So the total profit is 100000- 75000 = $25,000

Based on the above results :

“We would recommend NBC TV network to hire a market research firm before airing a show.”

Fixed population given as 1000. And the initial values as: S(0) = 1000, evreyone is susceptable at the beginning. I(0) = 2 R(0) = 0 We assume the transmission coefficient as, b = 0.002. And the recovery coefficient as , a = 0.7.

#load required libraries 
library(deSolve)
# Create an SIR function 
sir <- function(time, state, parameters) {
  with(as.list(c(state, parameters)), {
    dS <- -b * S * I 
    dI <- b * S * I - a * I 
    dR <- a * I
    return(list(c(dS, dI, dR)))
  })
}

flu_epidemic <- function(S0, I0, R0, times, trans_param, recovery_param) 
{
  ### Set parameters
  init       <- c(S =S0, I = I0, R = R0)
  ## b: infection parameter; a: recovery parameter
  parameters <- c(b = trans_param, a = recovery_param)
  ## Solve using ode (Ordinary Differential Equations)
  out <- ode(y = init, times = times, func = sir, parms = parameters)
  ## change to data frame
  out <- as.data.frame(out)
  return (out)
}

population (n) = susceptible (S) + infected (I)

We assume that S(1) = n - I(1) , S(2) = n - I(2) etc. here

sir_custom <- function(s0, i0, r0, a, b, n)
{
  time <- numeric(25)
  S <- numeric(25)
  I <- numeric(25)
  R <- numeric(25)
  time[1] <- 0
  S[1] <- s0
  I[1] <- i0
  R[1] <- r0
  for(i in seq(2,25)) {
    s_prime <- -b * S[i-1] * I[i-1]
    i_prime <- (b * S[i-1] * I[i-1]) - (a * I[i-1])
    r_prime <- (a * I[i-1])
    I[i] <- (I[i-1] + i_prime * 1)
    S[i] <- n - I[i] #Instead of s[i-1] + s_prime * 1, we assign S[i] as n - I[i] and check the results.
    R[i] <- R[i-1] + r_prime
    time[i] <- i
  }
  return (data.frame(time, S, I, R))
}