R/influence_functions.R

In abnormally-distributed/cvreg: Cross Validation and Robust Estimation Utilities

plotInfFunc <- function(which = c("optimal","huber","bisquare","hampel","powexp"), what = c("psi","dpsi","rho"), ...){

  what <- match.arg(what)
  which <- match.arg(which)

  if (which=="optimal"){
    .optimalPlot(what = what, ...)
  }
  else if (which=="huber"){
    .huberPlot(what = what, ...)
  }
  else if (which=="hampel"){
    .hampelPlot(what = what, ...)
  }
  else if (which=="bisquare"){
    .bisquarePlot(what = what, ...)
  }
  else if (which=="powexp"){
    .powexpPlot(what = what, ...)
  }
}



.hampelPlot = function(k = 0.9016085, what = c("psi","dpsi","rho")  ){
  what <- match.arg(what)
  u <- seq(-8, 8, len = 1000)
  h <-switch(what,
             "psi" = cvreg::psi.Hampel(u, k),
             "dpsi" = cvreg::dpsi.Hampel(u, k),
             "rho" = cvreg::rho.Hampel(u, k)
  )
  h = data.frame(h = h, u = u)
  ggplot(h, aes(x = u, y = h)) +
    geom_line(color = "#cf5c1f", size = 1.5, alpha = .85) +
    switch(what,
           "psi" = ylab(paste0("psi(", "k=", k , ")")),
           "dpsi" = ylab(paste0("psi`(", "k=", k , ")")),
           "rho" = ylab(paste0("rho(", "k=", k , ")"))
    )
}

.huberPlot = function(k = 1.345, what = c("psi","dpsi","rho")  ){
  what <- match.arg(what)
  u <- seq(-8, 8, len = 1000)
  h <-switch(what,
             "psi" = cvreg::psi.Huber(u, k),
             "dpsi" = cvreg::dpsi.Huber(u, k),
             "rho" = cvreg::rho.Huber(u, k)
  )
  h = data.frame(h = h, u = u)
  ggplot(h, aes(x = u, y = h)) +
    geom_line(color = "#b57c36", size = 1.5, alpha = .85) +
    switch(what,
           "psi" = ylab(paste0("psi(", "k=", k , ")")),
           "dpsi" = ylab(paste0("psi`(", "k=", k , ")")),
           "rho" = ylab(paste0("rho(", "k=", k , ")"))
    )
}

.bisquarePlot = function(c = 4.685, what = c("psi","dpsi","rho") ){
  what <- match.arg(what)
  u <- seq(-8, 8, len = 1000)
  h <-switch(what,
             "psi" = cvreg::psi.Bisquare(u, c),
             "dpsi" = cvreg::dpsi.Bisquare(u, c),
             "rho" = cvreg::rho.Bisquare(u, c)
  )
  h = data.frame(h = h, u = u)
  ggplot(h, aes(x = u, y = h)) +
    geom_line(color = "#1f47bf", size = 1.5, alpha = .85) +
    switch(what,
           "psi" = ylab(paste0("psi(", "c=", c , ")")),
           "dpsi" = ylab(paste0("psi`(", "c=", c , ")")),
           "rho" = ylab(paste0("rho(", "c=", c , ")"))
    )
}

.powexpPlot = function(c = 1.48, e = 1.25, what = c("psi","dpsi","rho")  ){
  what <- match.arg(what)
  u <- seq(-8, 8, len = 1000)
  h <-switch(what,
             "psi" = cvreg::psi.powexp(u, c, e),
             "dpsi" = cvreg::dpsi.powexp(u, c, e),
             "rho" = cvreg::rho.powexp(u, c, e)
  )
  h = data.frame(h = h, u = u)
  ggplot(h, aes(x = u, y = h)) +
    geom_line(color = "#753b94", size = 1.5, alpha = .85) +
    switch(what,
           "psi" = ylab(paste0("psi(", "c=", c , "e=" , e, ")")),
           "dpsi" = ylab(paste0("psi`(", "c=", c , "e=" , e, ")")),
           "rho" = ylab(paste0("rho(", "c=", c , "e=" , e, ")"))
    )
}

.optimalPlot = function(c = 1, what = c("psi","dpsi","rho")  ){
  what <- match.arg(what)
  u <- seq(-8, 8, len = 1000)
  h <-switch(what,
    "psi" = cvreg::psi.opt(u, c),
    "dpsi" = cvreg::dpsi.opt(u, c),
    "rho" = cvreg::rho.opt(u, c)
  )
  h = data.frame(h = h, u = u)
  ggplot(h, aes(x = u, y = h)) +
    geom_line(color = "#a81b2b", size = 1.5, alpha = .85) +
    switch(what,
           "psi" = ylab(paste0("psi(", "c=", c , ")")),
           "dpsi" = ylab(paste0("psi`(", "c=", c , ")")),
           "rho" = ylab(paste0("rho(", "c=", c , ")"))
    )
}