FundRaise_InClass

Fund Raising Simulation

A fundraiser is planning to call 20 potential donors. The probability that a potential donor answers the phone is 40%, and if they answer the phone the probability that they make a contribution is 50%. The amount of each contribution is normally distributed with a mean of $200 and a standard deviation of $50. The fundraiser’s goal is to raise $1,000 from these calls. Use 1,000 simulation trials in your analysis.

a. What is the expected (sample mean) total contributions from these calls?

b. What is the sample standard deviation?

c. Compute a 95% confidence interval for the mean of the total contributions.***

d. What is the probability that the fundraiser reaches the goal of $1,000?

runSimulation <- function(trials, numCalls, probAnswer, probDonation, meanDonation, sdDonation){
  sample = c()
  for(i in 1:trials){
    totalDonations = 0
    numberAnswers = rbinom(1, numCalls, probAnswer)
    numberDonations = rbinom(1, numberAnswers, probDonation)
    #writeLines(paste("People that answer:", numberAnswers, "People that donate:", numberDonations))
    for(j in 1:numberDonations){
      amount = rnorm(1, meanDonation, sdDonation)
      totalDonations = totalDonations + amount
    }
    #writeLines(paste("Total Donations:", totalDonations))
    sample <- append(sample, totalDonations)
  }
  return(sample)
}

calcProb <- function(sample, value){
  count = 0
  for(donation in sample){
    if(donation > value){
      count = count + 1
    }
  }
  probability = count/length(sample)
  return(probability)
}

A, B, & D

numTrials = 100000
result <- runSimulation(numTrials,20,.4,.5,200,50)
prob = calcProb(result, 1000)

writeLines(paste("Expeced donation is:", dollar(mean(result))))
writeLines(paste("Stdev of donations is:", dollar(sd(result))))
writeLines(paste("Probablitity of getting at least 1000 is:", prob))

Result <- as.data.frame(result)

bw <- 2*IQR(Result$result)/length(Result$result)^(1/3)

ggplot(Result,
       aes(x = result))+
  geom_histogram(binwidth = bw,
                 fill = 'green',
                 color = 'black',
                 alpha = .5)+
  labs(title = "Distribution of Donation amount",
       x = "Donation Amount",
       y = "Frequency")+
  hrbrthemes::theme_ft_rc()

## Expeced donation is: $804.71
## Stdev of donations is: $364.33
## Probablitity of getting at least 1000 is: 0.2823

C.)

# 95% Confidence interval using z a/2 value of 1.96 for expected value
Confidence_Interval_low <- mean(result) - 1.96*(sd(result)/sqrt(numTrials))
Confidence_Interval_high <- mean(result) + 1.96*(sd(result)/sqrt(numTrials))

# 95% Confidence interval using z a/2 value of 1.96 for the probability estimate
P.Confidence_Interval_low <- prob - 1.96*(sqrt(prob*(1-prob)) / numTrials)
P.Confidence_Interval_high <- prob + 1.96*(sqrt(prob*(1-prob)) / numTrials)

writeLines(paste("With 95% confidence the EV donations falls in:", 
                 "[",round(Confidence_Interval_low, digits = 2), ",", round(Confidence_Interval_high, digits = 2),"]"))
writeLines(paste("With 95% confidence the the probability of getting at least 1000 falls in:", 
                 "[",round(P.Confidence_Interval_low, digits = 5), ",", round(P.Confidence_Interval_high, digits = 5),"]"))

## With 95% confidence the EV donations falls in: [ 802.46 , 806.97 ]
## With 95% confidence the the probability of getting at least 1000 falls in: [ 0.28229 , 0.28231 ]