Coverage probability for an unspecified CDF

Question

I used the following r code to determine the coverage probability.

theta <- seq(0,1, length = 100)
CD_theta <- function(y, p, n){
  1 - pbinom (y, size = n, prob = p) + 1/2*dbinom(y, size = n, prob = p)
}

y <- 5
n <- 100
phat <- y/n
mytheta <- CD_theta(5, theta, 100)

set.seed(650)
ci <- list()
n <- 100
B <- 1000
result = rep(NA, B)
all_confInt <- function(B) {
for (i in 1:B){
  boot.sample <- sample(mytheta, replace = TRUE)
  lower <- theta[which.min(abs(boot.sample - .025))]
  upper <- theta[which.min(abs(boot.sample - .975))]
  ci[[i]] <- data.frame(lowerCI = lower, upperCI = upper)
  intervals <- unlist(ci)
}
  return(intervals)
}

df <- data.frame(matrix(all_confInt(B), nrow=B, byrow=T))
colnames(df)[1] <- "Lower"
colnames(df)[2] <- "Upper"
names(df)
dim(df)
mean(df$Lower < phat & df$Upper > phat)*100 

However, I obtained 6.4% which is too low. Why am I getting really lower percentage?. Is there any problem in the r function?