1 A researcher wishes to conduct a study of the color preferences of new car buyers. Suppose that 50% of this population prefers the color red. If 20 buyers are randomly selected, what is the probability that between 9 and 12 (both inclusive) buyers would prefer red? Round your answer to four decimal places. Use the round() function in R.

Setting up the plot

plot(x  = 0:20,
     y  = dbinom(x  = 0:20,
                   size = 20,
                   prob = .5
     ),
     type = 'h',
     main = 'Binomial Distribution',
     ylab = 'Probability prefers red',
     xlab = 'Number of Buyers',
     lwd  = 3
)

Finding the probability

dbinom(x = 9:12, size = 20, prob = 0.50)
## [1] 0.1601791 0.1761971 0.1601791 0.1201344
Probability <- sum(dbinom(x = 9:12, size = 20, prob = 0.50))
round(Probability, digits = 4)
## [1] 0.6167

After plugging in our numbers into the dbinom function, we can see the probability that between 9 and 12 buyers would prefer red is 61.67%. A good way to double check is looking at the graph where we can see the density is much higher between 9 and 12.

2 . A quality control inspector has drawn a sample of 13 light bulbs from a recent production lot. Suppose 20% of the bulbs in the lot are defective. What is the probability that less than 6 but more than 3 bulbs from the sample are defective? Round your answer to four decimal places.

plot(x  = 0:13, 
     y  = dbinom(x    = 0:13, 
                 size = 13, 
                 prob = .2
                  ), 
     type = 'h',
     main = 'Binomial Distribution',
     ylab = 'Probability',
     xlab = '# Successes',
     lwd  = 3
     )

dbinom(x = 4:5, size = 13, prob = 0.20)
## [1] 0.15354508 0.06909529
P2 <- sum(dbinom(x = 4:5, size = 13, prob = 0.20))
round(P2, digits = 4)
## [1] 0.2226

We can see that the probability is 22.26%.

3 The auto parts department of an automotive dealership sends out a mean of 4.2 special orders daily. What is the probability that, for any day, the number of special orders sent out will be no more than 3?

plot(x  = 0:10,
     y  = dpois(x = 0:10,
                lambda = 4.2
                ),
     type = 'h',
     main = 'Poisson Distribution',
     ylab = 'Probability',
     xlab = '# Special Orders',
     lwd  = 3
)

P3 <- ppois(3, lambda = 4.2)
round(P3, digits = 4)
## [1] 0.3954

The probability is 39.54% that the number of special orders sent out will be no more than 3.

4 A pharmacist receives a shipment of 17 bottles of a drug and has 3 of the bottles tested. If 6 of the 17 bottles are contaminated, what is the probability that less than 2 of the tested bottles are contaminated?

plot(x    = 0:5,
     y    = dhyper(x = 0:5,
                   m = 6,
                   n = 17-6,
                   k = 3
     ),
     type = 'h',
     main = 'Hypergeometric Distribution',
     ylab = 'Probability',
     xlab = '# Bottles',
     lwd  = 3
)

P4 <- sum(dhyper(x = 0:1, 
                 m = 6, 
                 n = 17-6, 
                 k = 3))
round(P4,digits = 4)
## [1] 0.7279

The probability less than 2 of the bottles is contaminated is 72.79%.

5 A town recently dismissed 6 employees in order to meet their new budget reductions. The town had 6 employees over 50 years of age and 19 under 50. If the dismissed employees were selected at random, what is the probability that more than 1 employee was over 50?

plot(x    = 0:6,
     y    = dhyper(x = 0:6,
                   m = 6,
                   n = 19,
                   k = 6
                ),
     type = 'h',
     main = 'Hypergeometric Distribution',
     ylab = 'Probability ',
     xlab = '#Dismissed Employees',
     lwd  = 3
)

P5 <- sum(dhyper(x = 2:6, 
                 m = 6, 
                 n = 19, 
                 k = 6))

round(P5, digits = 4)
## [1] 0.4529

The probability is 45.29% that more than 1 dismissed employee is over 50.

6 The weights of steers in a herd are distributed normally. The variance is 90,000 and the mean steer weight is 800 lbs. Find the probability that the weight of a randomly selected steer is between 1040 and 1460 lbs.

# Set the mean and standard deviation
mu    <- 800
variance <- 90000
standard.dev <- sqrt(90000)

# Generate a range of values around the mean
x <- seq(from       =  mu - 3*standard.dev,
         to         =  mu + 3*standard.dev, 
         length.out = 1000
         )

# Calculate the probability density function
pdf <- dnorm(x    = x, 
             mean = mu, 
             sd   = standard.dev
             )

# Plot the normal distribution

plot(x    = x, 
     y    = pdf,
     type = 'l', 
     col  = 'blue', 
     lwd  = 2, 
     xlab = 'Pounds', 
     ylab = 'Density',
     main = 'Normal Distribution'
     )

# Vertical Line on Mean
abline(v = mu)

mu <- 800
var <- 90000
std.dev <- sqrt(90000)
lower_num <- 1040
upper_num <- 1460


lower <- (lower_num - mu) / std.dev
upper <- (upper_num - mu) / std.dev


P6 <- diff(pnorm(c(lower, upper)))
round(P6, digits = 4)
## [1] 0.198

The probability is 19.8% that a randomly selected steer will be between 1040 and 1460 pounds.

7 The diameters of ball bearings are distributed normally. The mean diameter is 106 millimeters and the standard deviation is 4 millimeters. Find the probability that the diameter of a selected bearing is between 103 and 111 millimeters.

# Set the mean and standard deviation
mean.mm    <- 106
st.dev <- 4

# Generate a range of values around the mean
x <- seq(from    =  mean.mm - 3*st.dev,
         to         =  mean.mm + 3*st.dev, 
         length.out = 1000
         )

# Calculate the probability density function
pdf <- dnorm(x    = x, 
             mean = mean.mm, 
             sd   = st.dev
             )

# Plot the normal distribution

plot(x    = x, 
     y    = pdf,
     type = 'l', 
     col  = 'blue', 
     lwd  = 2, 
     xlab = 'MM', 
     ylab = 'Density',
     main = 'Normal Distribution'
     )

# Vertical Line on Mean
abline(v = mean.mm)

mean_mm <- 106
sdv <- 4
lower_num <- 103
upper_num <- 111

P7 <- diff(pnorm(c((lower_num - mean_mm) / sdv, (upper_num - mean_mm) / sdv)), lower.tail = FALSE)

round(P7, digits = 4)
## [1] 0.6677

The probability that the diameter of a selected bearing is between 103 and 111mm is 66.77%.

8 The lengths of nails produced in a factory are normally distributed with a mean of 3.34 centimeters and a standard deviation of 0.07 centimeters. Find the two lengths that separate the top 3% and the bottom 3%. These lengths could serve as limits used to identify which nails should be rejected.

# Set the mean and standard deviation
mean.length   <- 3.34
st.dev.length <- 0.07

# Generate a range of values around the mean
x <- seq(from    =  mean.length - 3*st.dev.length,
         to      =  mean.length + 3*st.dev.length, 
         length.out = 1000
        )

# Calculate the probability density function
pdf <- dnorm(x    = x, 
             mean = mean.length, 
             sd   = st.dev.length
             )

# Plot the normal distribution

plot(x    = x, 
     y    = pdf,
     type = 'l', 
     col  = 'blue', 
     lwd  = 2, 
     xlab = 'CM', 
     ylab = 'Density',
     main = 'Normal Distribution'
     )

# Vertical Line on Mean
abline(v = mean.length)

mean_length <- 3.34
sdv_length <- 0.07
upper <- qnorm(0.97) 
lower <- qnorm(0.03)  

length_upper <- mean_length + upper* sdv_length
length_lower <- mean_length + lower * sdv_length
# Length Top 3%
round(length_upper, digits = 2)
## [1] 3.47
# Length Bottom 3% 
round(length_lower, digits = 2)
## [1] 3.21
# Plotting Region in between
require(tigerstats)
## Loading required package: tigerstats
## Loading required package: abd
## Loading required package: nlme
## Loading required package: lattice
## Loading required package: grid
## Loading required package: mosaic
## Registered S3 method overwritten by 'mosaic':
##   method                           from   
##   fortify.SpatialPolygonsDataFrame ggplot2
## 
## The 'mosaic' package masks several functions from core packages in order to add 
## additional features.  The original behavior of these functions should not be affected by this.
## 
## Attaching package: 'mosaic'
## The following objects are masked from 'package:dplyr':
## 
##     count, do, tally
## The following object is masked from 'package:Matrix':
## 
##     mean
## The following object is masked from 'package:ggplot2':
## 
##     stat
## The following objects are masked from 'package:stats':
## 
##     binom.test, cor, cor.test, cov, fivenum, IQR, median, prop.test,
##     quantile, sd, t.test, var
## The following objects are masked from 'package:base':
## 
##     max, mean, min, prod, range, sample, sum
## Welcome to tigerstats!
## To learn more about this package, consult its website:
##  http://homerhanumat.github.io/tigerstats
pnormGC(c(3.21,3.47),
        region="between",
        mean=3.34,
        sd=0.07,
        graph=TRUE)

## [1] 0.9367092

From our above calculations, our upper bound at the top 3% is 3.47. Our bottom 3% is 3.21. I then plotted this to highlight the space where nails will NOT be rejected. The white region outside of our upper and lower bounds will show the areas which should be rejected.

9 A psychology professor assigns letter grades on a test according to the following scheme. A: Top 9% of scores B: Scores below the top 9% and above the bottom 63% C: Scores below the top 37% and above the bottom 17% D: Scores below the top 83% and above the bottom 8% F: Bottom 8% of scores Scores on the test are normally distributed with a mean of 75.8 and a standard deviation of 8.1. Find the minimum score required for an A grade.

# Set the mean and standard deviation
mean.grade   <- 75.8
st.dev.grade <- 8.1

# Generate a range of values around the mean
x <- seq(from    =  mean.grade - 3*st.dev.grade,
         to      =  mean.grade + 3*st.dev.grade, 
         length.out = 1000
        )

# Calculate the probability density function
pdf <- dnorm(x    = x, 
             mean = mean.grade, 
             sd   = st.dev.grade
             )

# Plot the normal distribution

plot(x    = x, 
     y    = pdf,
     type = 'l', 
     col  = 'blue', 
     lwd  = 2, 
     xlab = 'Grades', 
     ylab = 'Density',
     main = 'Normal Distribution'
     )

# Vertical Line on Mean
abline(v = mean.grade)

mean_grade <- 75.8
sdv_grade <- 8.1
top_percentile <- 0.09 
min_grade <- qnorm(1 - top_percentile, mean_grade, sdv_grade)

round(min_grade)
## [1] 87

We can see that the minimum score required for an A is an 87 since that is minimum to be in the top 9% grades.

10 Consider the probability that exactly 96 out of 155 computers will not crash in a day. Assume the probability that a given computer will not crash in a day is 61%. Approximate the (binomial) probability using the normal distribution.

n<- 155
x<- 96
pi<- .61
P10 <- dbinom(x, n, pi)

round(P10, digits = 4)
## [1] 0.064

The probability is 6.4%.