Stat3701Quiz1Make-Up

Problem 1

This is my solution to problem 1 on the make-up quiz.This function takes a vector and returns the sum of the lowest half of the squares of the components. The function squares the components, then sorts them and checks if the length is divisible by two. If it is, it takes the sum of exactly half of the components. If it is odd, then it takes the sum of half + 1 components of the vector.

prob1_func <- function(x){
  lenx = length(x)
  x <- x^2
  if (lenx == 0){
    return(0)
  }
  x <- sort(x)
  if (lenx %% 2 == 0){
    half_val = lenx / 2
    sum(x[1:half_val])
  }
  else{
    half_val = (lenx + 1) / 2
    sum(x[1:half_val])
  }
}
# Even, nonzero length vector for testing
e <- c(-1, -5, 3, 2, 1, 6)
# Odd length vector for testing
o <- c(0, -1, -2, 3, -4, 5)

#Length zero numeric vector for testing
z <- numeric(0)

prob1_func(e)

## [1] 6

prob1_func(o)

## [1] 5

prob1_func(z)

## [1] 0

As seen above, all the test vectors work as they’re supposed to.

Problem 2

This is my solution to problem 2, which is adding GIEMO checks for my function defined in problem 1. I check if the vector is all numeric, if it has finite values, and if there are any NA or NaN values that would otherwise give me unintended results.

prob1_func <- function(x){
  stopifnot(is.numeric(x))
  stopifnot(is.finite(x))
  stopifnot(!is.na(x))
  stopifnot(!anyNA(x))
  lenx = length(x)
  x <- x^2
  if (lenx == 0){
    return(0)
  }
  x <- sort(x)
  if (lenx %% 2 == 0){
    half_val = lenx / 2
    sum(x[1:half_val])
  }
  else{
    half_val = (lenx + 1) / 2
    sum(x[1:half_val])
  }
}
# Previous three test vectors work as supposed to
e <- c(-1, -5, 3, 2, 1, 6)
o <- c(0, -1, -2, 3, -4, 5)
z <- numeric(0)

# Error test 1 contains a NA value, and fails
er1 <- c(0, NA, 1)

# Error test 2 contains a NaN value, and fails
er2 <- c(NaN, 1, 2, 3)

# Error test 3 contains non-numeric values, and fails
er3 <- c("a", "b")

# Error test 4 contains non-finite values, and fails
er4 <- c(Inf, 3, 2, 1)

# These tests work as supposed to
prob1_func(e)

## [1] 6

prob1_func(o)

## [1] 5

prob1_func(z)

## [1] 0

# These tests fail as supposed to
prob1_func(er1)

## Error in prob1_func(er1): is.finite(x) are not all TRUE

prob1_func(er2)

## Error in prob1_func(er2): is.finite(x) are not all TRUE

prob1_func(er3)

## Error in prob1_func(er3): is.numeric(x) is not TRUE

prob1_func(er4)

## Error in prob1_func(er4): is.finite(x) are not all TRUE

Problem 3

This is my solution to problem 3 on the make-up.This code modifies the calculations of Section 7.5.4 of the “Basics” course notes to use the dlogis function rather than dgamma. It also uses the mean to create the interval that we believe the MLE to be within. Most of this code is directly copied from 7.5.4, with modifications in the make.logl function to include the dlogis function and appropriate parameter names.

x <- scan(url("https://www.stat.umn.edu/geyer/3701/data/2022/mq1p3.txt"))

prob3_func <- function(x){
  make.logl <- function(x) function(alpha)
    sum(dlogis(x, location = alpha, log = TRUE)) # This is where modifications to the original source have been made

  interval <- mean(x) + c(-1, 1)
  interval <- pmax(mean(x)/1e3, interval)
  logl <- make.logl(x)
  oout <- optimize(logl, maximum = TRUE, interval)
  
  # This returns the maximum of the optimize function
  return_val <- oout$maximum
  
  # I put a name on the return vector just for personal organization
  names(return_val) <- c("Maximum of Optimize function")
  return(return_val)}


prob3_func(x)

## Maximum of Optimize function 
##                      5.93828