I need to write an R code function with these guide lines: usage: ci(x, n, alter
ID: 3824055 • Letter: I
Question
I need to write an R code function with these guide lines:
usage:
ci(x, n, alternative = c("two.sided", "upper", "lower"), level = 0.95)
arguments:
x : number of successes in the sample
n : size of sample ,
alternative : character string specifying a two-sided confidence interval, a one-sided upper confidence interval, or a one-sided lower confidence interval
level : level of confidence
value:
list containing the following components:
lower_limit : lower limit of the confidence interval , upper_limit : upper limit of the confidence interval
So the function: ci() constructs a confidence interval for the population proportion. The lower limit and the upper limit must be numbers.
I need to write a code function called ci (), that will get me a two-sided population proportion using R. Any help would be appreciatted.
I thinking of trying to write the function ci() by using the function prop.test that is already found in the R console.
Instead of using strictly prop.test() function, example: prop.test( x=20, n =100, conf.level=.95, correct = F) , i need to write a function exactly like prop.test() but the name has to be ci() and following the guidelines. How would the code look like in R for this specific function and guidelines given?
Explanation / Answer
R program:
SIGN.test <- function(x, y = NULL, md = 0, alternative = c("two.sided", "lower", "upper"), confidence_level = 0.95)
{
alternative <- match.arg(alternative)
if(!missing(md) && (length(md) != 1 || is.na(md)))
stop("median must be a single number")
if(!missing(confidence_level) && (length(confidence_level) != 1 || is.na(confidence_level) || confidence_level < 0 || confidence_level > 1))
stop("confidence level must be a number between 0 and 1")
if( is.null(y) )
{
dname <- paste(deparse(substitute(x)))
x <- x[is.finite(x)]
x <- sort(x)
diff <- (x - md)
n <- length(x)
nt <- length(x) - sum(diff == 0)
s <- sum(diff > 0)
Estimate_median <- median(x)
Est_method <- c("One-sample Sign-Test")
names(Estimate_median) <- c("median of x")
names(md) <- "median"
names(s) <- "s"
CIS <- "Confidence Intervals"
if(alternative == "lower")
{
Pro_val <- sum(dbinom(0:s, nt, 0.5))
location <- c(0:n)
povis <- (dbinom(location, n, 0.5))
k <- location[cumsum(povis) > (1 - confidence_level)][1]
if(k < 1)
{
confidence_level <- (1 - (sum(dbinom(k, n, 0.5))))
x_length <- -Inf
x_mean <- x[n]
lcl <- c(x_length, x_mean)
}
else
{
di1 <- c(-Inf, x[n - k + 1])
ACCl1 <- (1 - (sum(dbinom(0:k - 1, n, 0.5))))
di2 <- c(-Inf, x[n - k])
ACL2 <- (1 - (sum(dbinom(0:k, n, 0.5))))
x_length <- -Inf
x_mean <- (((x[n - k + 1] - x[n - k]) * (confidence_level - ACL2))/(ACCl1 - ACL2)) + x[n - k]
lcl <- c(x_length, x_mean)
}
}
else if(alternative == "upper")
{
Pro_val <- (1 - sum(dbinom(0:s - 1, nt, 0.5)))
location <- c(0:n)
povis <- (dbinom(location, n, 0.5))
k <- location[cumsum(povis) > (1 - confidence_level)][1]
if(k < 1)
{
confidence_level <- (1 - (sum(dbinom(k, n, 0.5))))
x_length <- x[1]
x_mean <- Inf
lcl <- c(x_length, x_mean)
}
else
{
di1 <- c(x[k], Inf)
ACCl1 <- (1 - (sum(dbinom(0:k - 1, n, 0.5))))
di2 <- c(x[k + 1], Inf)
ACL2 <- (1 - (sum(dbinom(0:k, n, 0.5))))
x_length <- (((x[k] - x[k + 1]) * (confidence_level - ACL2))/(ACCl1 - ACL2)) + x[k + 1]
x_mean <- Inf
lcl <- c(x_length, x_mean)
}
}
else
{
p1 <- sum(dbinom(0:s, nt, 0.5))
p2 <- (1 - sum(dbinom(0:s - 1, nt, 0.5)))
Pro_val <- min(2 * p1, 2 * p2, 1)
location <- c(0:n)
povis <- (dbinom(location, n, 0.5))
k <- location[cumsum(povis) > (1 - confidence_level)/2][1]
if(k < 1)
{
confidence_level <- (1 - 2 * (sum(dbinom(k, n, 0.5))))
x_length <- x[1]
x_mean <- x[n]
lcl <- c(x_length, x_mean)
}
else
{
di1 <- c(x[k], x[n - k + 1])
ACCl1 <- (1 - 2 * (sum(dbinom(0:k - 1, n, 0.5))))
di2 <- c(x[k + 1], x[n - k])
ACL2 <- (1 - 2 * (sum(dbinom(0:k, n, 0.5))))
x_length <- (((x[k] - x[k + 1]) * (confidence_level - ACL2))/(ACCl1 - ACL2)) + x[k + 1]
x_mean <- (((x[n - k + 1] - x[n - k]) * (confidence_level - ACL2))/(ACCl1 - ACL2)) + x[n - k]
lcl <- c(x_length, x_mean)
}
}
}
else
{
# Paired-Samples Sign Test
if(length(x) != length(y))
stop("Length of x must equal length of y")
xy <- sort(x - y)
# remove NAs and Infs - 6/12/13
xy <- xy[is.finite(xy)]
diff <- (xy - md)
n <- length(xy)
nt <- length(xy) - sum(diff == 0)
s <- sum(diff > 0)
dname <- paste(deparse(substitute(x)), " and ", deparse(substitute(y)), sep = "")
Estimate_median <- median(xy)
Est_method <- c("Dependent-samples Sign-Test")
names(Estimate_median) <- c("median of x-y")
names(md) <- "median difference"
names(s) <- "S"
CIS <- "Conf Intervals"
if(alternative == "lower")
{
Pro_val <- sum(dbinom(0:s, nt, 0.5))
location <- c(0:n)
povis <- (dbinom(location, n, 0.5))
k <- location[cumsum(povis) > (1 - confidence_level)][1]
if(k < 1)
{
confidence_level <- (1 - (sum(dbinom(k, n, 0.5))))
x_length <- -Inf
x_mean <- xy[n]
lcl <- c(x_length, x_mean)
}
else
{
di1 <- c(-Inf, xy[n - k + 1])
ACCl1 <- (1 - (sum(dbinom(0:k - 1, n, 0.5))))
di2 <- c(-Inf, xy[n - k])
ACL2 <- (1 - (sum(dbinom(0:k, n, 0.5))))
x_length <- -Inf
x_mean <- (((xy[n - k + 1] - xy[n - k]) * (confidence_level - ACL2))/(ACCl1 - ACL2)) + xy[n - k]
lcl <- c(x_length, x_mean)
}
}
else if(alternative == "upper")
{
Pro_val <- (1 - sum(dbinom(0:s - 1, nt, 0.5)))
location <- c(0:n)
povis <- (dbinom(location, n, 0.5))
k <- location[cumsum(povis) > (1 - confidence_level)][1]
if(k < 1)
{
confidence_level <- (1 - (sum(dbinom(k, n, 0.5))))
x_length <- xy[1]
x_mean <- Inf
lcl <- c(x_length, x_mean)
}
else
{
di1 <- c(xy[k], Inf)
ACCl1 <- (1 - (sum(dbinom(0:k - 1, n, 0.5))))
di2 <- c(xy[k + 1], Inf)
ACL2 <- (1 - (sum(dbinom(0:k, n, 0.5))))
x_length <- (((xy[k] - xy[k + 1]) * (confidence_level - ACL2))/(ACCl1 - ACL2)) + xy[k + 1]
x_mean <- Inf
lcl <- c(x_length, x_mean)
}
}
else
{
p1 <- sum(dbinom(0:s, nt, 0.5))
p2 <- (1 - sum(dbinom(0:s - 1, nt, 0.5)))
Pro_val <- min(2 * p1, 2 * p2, 1)
location <- c(0:n)
povis <- (dbinom(location, n, 0.5))
k <- location[cumsum(povis) > (1 - confidence_level)/2][1]
if(k < 1)
{
confidence_level <- (1 - 2 * (sum(dbinom(k, n, 0.5))))
x_length <- xy[1]
x_mean <- xy[n]
lcl <- c(x_length, x_mean)
}
else
{
di1 <- c(xy[k], xy[n - k + 1])
ACCl1 <- (1 - 2 * (sum(dbinom(0:k - 1, n, 0.5))))
di2 <- c(xy[k + 1], xy[n - k])
ACL2 <- (1 - 2 * (sum(dbinom(0:k, n, 0.5))))
x_length <- (((xy[k] - xy[k + 1]) * (confidence_level - ACL2))/(ACCl1 - ACL2)) + xy[k + 1]
x_mean <- (((xy[n - k + 1] - xy[n - k]) * (confidence_level - ACL2))/(ACCl1 - ACL2)) + xy[n - k]
lcl <- c(x_length, x_mean)
}
}
}
if(k < 1)
{
cint <- lcl
attr(cint, "confidence_level") <- confidence_level
rval <- structure(list(statistic = s, p.value = Pro_val, Estimate_median = Estimate_median, null.value = md,
alternative = alternative, Est_method = Est_method, data.name = dname, conf.int = cint ))
oldClass(rval) <- "htest"
return(rval)
}
else
{
ans1 <- c(ACL2, di2)
ans2 <- c(confidence_level, lcl)
ans3 <- c(ACCl1, di1)
Confidence.Intervals <- round(as.matrix(rbind(ans1, ans2, ans3)),4)
cnames <- c("Conf.Level", "L.E.pt", "U.E.pt")
rnames <- c("Lower Achieved CI", "Interpolated CI", "Upper Achieved CI")
dimnames(Confidence.Intervals) <- list(rnames, cnames)
cint <- lcl
attr(cint, "confidence_level") <- confidence_level
rval <- structure(list(statistic = s, parameter = NULL, p.value = Pro_val,
conf.int = cint, Estimate_median = Estimate_median, null.value = md,
alternative = alternative, Est_method = Est_method, data.name = dname ))
oldClass(rval) <- "htest"
print(rval)
return(Confidence.Intervals)
}
}