knitr::opts_chunk$set(echo = TRUE)
[even though it has a higher number than others, it is the simpliest, so it is here first - other functions build off this concept]
func6 <- function(x){ tryCatch(stopifnot(is.numeric(x)), error=function(e){print("not numeric")}) tryCatch(stopifnot(is.finite(x)), error=function(e){print("not finite")}) tryCatch(stopifnot(length(x)!=0), error=function(e){print("has 0 length")}) tryCatch(stopifnot(!is.nan(x)), error=function(e){print("NA or NAN")}) tryCatch(stopifnot(!is.na(x)), error=function(e){print("NA or NAN")}) } func6(2) func6('a') func6(Inf) func6(c(1,2,3)) func6(NaN) func6(NA)
Purpose: to compute mean, (population) varience, and (population) SD Details: takes in a vector x, returns a list with all those components. Equations used ... mean: $$\mu = 1/n \sum_{i=1}^n x_i$$ pop var: $$\sigma^2 = (1/n) \sum_{i=1}^n (x_i-\mu)^2$$ SD is square root of the var
x<-rnorm(10) func1 <- function(x){ a = sum(x)/length(x) b = sum((x-a)^2)/length(x) c = sqrt(b) return(list(mean=a,var=b,sd=c)) } func1(x)
Same as above but with user checks for non-numeric, infinte, NA, NaN values
x<-rnorm(10) func2 <- function(x){ stopifnot(is.numeric(x)) stopifnot(length(x)!=0) stopifnot(is.finite(x)) stopifnot(!is.na(x)) stopifnot(!is.nan(x)) a = sum(x)/length(x) b = sum((x-a)^2)/length(x) c = sqrt(b) return(list(mean=a,var=b,sd=c)) } func2(x)
Purpose: to compute WEIGHTED mean, WEIGHTED (population) varience, and WEIGHTED (population) SD Details: takes in a vector x, returns a list with all those components. Equations used ... mean: $$\mu = \sum_{i=1}^n x_i * w_i $$ var: $$\sigma^2 = \sum_{i=1}^n (x_i - \mu)^2*w_i $$ sd: $$\sigma = \sqrt(\sigma^2) $$
x <- c(1,2,3) p <- c(.25,.25,.5) d <- data.frame(x,p) func4 <- function(d) { a = sum(d$x * d$p) b = sum(((d$x - a)^2) * d$p) c = sqrt(b) return(list(mean=a,var=b,sd=c)) } func4orig <- function(d){ return( list( weighted.mean(d$x,d$p), sum(p * (x - weighted.mean(d$x,d$p))^2), sqrt(sum(p * (x - weighted.mean(d$x,d$p))^2)))) } func4(d) func4orig(d)
Same as above but with user checks for non-numeric, infinte, NA, NaN values
x <- c(1,2,3) p <- c(.25,.25,.5) d <- data.frame(x,p) badx <- c(NA,2,3) badd <- data.frame(badx,p) func5 <- function(d) { stopifnot(is.numeric(d$x)) stopifnot(is.numeric(d$p)) stopifnot(length(d$x)!=0) stopifnot(length(d$p)!=0) stopifnot(is.finite(d$x)) stopifnot(is.finite(d$p)) stopifnot(!is.na(d$x)) stopifnot(!is.na(d$p)) stopifnot(!is.nan(d$x)) stopifnot(!is.nan(d$p)) stopifnot(all.equal(sum(d$p),1)) a = sum(d$x * d$p) b = sum(((d$x - a)^2) * d$p) c = sqrt(b) return(list(mean=a,var=b,sd=c)) } func5orig <- function(d){ return( list( weighted.mean(d$x,d$p), sum(p * (x - weighted.mean(d$x,d$p))^2), sqrt(sum(p * (x - weighted.mean(d$x,d$p))^2)))) } func5(badd) func5(d) func5orig(d)
Maximum likelihood estimation for the gamma distribution with unknown shape parameter and known scale parameter
options(warn=-1) x<-rnorm(10) func3 <- function(x){ alpha <- pi log <- function(alpha) sum(dgamma(x, shape = alpha, log = TRUE)) interval <- mean(x) + c(-1,1) * 3 * sd(x) interval <- pmax(mean(x) / 1e3, interval) oout<- optimize(log, maximum = TRUE, interval) return (oout$maximum) } func3(x)
Maximum likelihood estimation for the any distribution with unknown shape parameter and known scale parameter Tested here with the gamma distribution.
func1 = function(theta, x) dgamma(x, shape = theta, log = TRUE) func7 <- function(x, func, interval){ f7 <- function(theta, x) {sum(func(theta, x))} oout<- optimize(f7, maximum = TRUE, interval, x=x) return(oout$maximum) } x1 <- scan(url("http://www.stat.umn.edu/geyer/3701/data/q1p3.txt")) result7_gamma <- func7(x1,func1,c(0,3)) result7_gamma
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.