Tukey Functions

Author

Beniamino Sartini

Setup

library(ggplot2)
library(dplyr)
library(latex2exp)
library(backports)
grid <- seq(-6, 6, 0.01)
d <- c(4.57, 3.57, 2.57, 1.57)

Tukey’s Bisquare

\rho(x; d) = \begin{cases} \begin{align*} {} & \frac{d^2}{6} \{1- [1- (\frac{x}{d})^2]^3\} \quad {} & |x| \le d \\ & \frac{d^2}{6} & |x| > d \end{align*} \end{cases}

# Tukey's Bisquare Function
tukey_bisquare <- function(d){
  function(x){
    x[abs(x) > d] <- NA
    f_x <- (d^2)/6*(1 - (1 - (x/d)^2)^3)
    f_x[is.na(f_x)] <- (d^2)/6
    return(f_x)
  }
}

Plot code

ggplot()+
  geom_line(aes(grid, tukey_bisquare(d[1])(grid), color = "p1"))+
  geom_line(aes(grid, tukey_bisquare(d[2])(grid), color = "p2"))+
  geom_line(aes(grid, tukey_bisquare(d[3])(grid), color = "p3"))+
  geom_line(aes(grid, tukey_bisquare(d[4])(grid), color = "p4"))+
  scale_color_manual(values = c(p1 = "red", p2 = "black", p3 = "green", p4 = "purple"),
                     labels = c(p1 = paste0("d = ", d[1]), 
                                p2 = paste0("d = ", d[2]), 
                                p3 = paste0("d = ", d[3]), 
                                p4 = paste0("d = ", d[4])))+
  theme_bw()+
  scale_x_continuous(breaks = c(min(grid),-d, 0, d, max(grid)))+
  theme(legend.position = "top")+
  labs(x = "x", y = TeX("$\\rho(x; d)$"), color = NULL)

First derivative

\rho^{\prime}(x; d) = \begin{cases} \begin{align*} {} & x \bigl[1- (\frac{x}{d})^2\bigl]^2 \quad {} & |x| \le d \\ & 0 & |x| > d \end{align*} \end{cases}

# Tukey's Bisquare First Derivative
tukey_bisquare_prime <- function(d){
  function(x){
    x[abs(x) > d] <- NA
    f_x <- x*(1 - (x/d)^2)^2
    f_x[is.na(f_x)] <- 0
    return(f_x)
  }
}

Plot code

ggplot()+
  geom_line(aes(grid, tukey_bisquare_prime(d[1])(grid), color = "p1"))+
  geom_line(aes(grid, tukey_bisquare_prime(d[2])(grid), color = "p2"))+
  geom_line(aes(grid, tukey_bisquare_prime(d[3])(grid), color = "p3"))+
  geom_line(aes(grid, tukey_bisquare_prime(d[4])(grid), color = "p4"))+
  scale_color_manual(values = c(p1 = "red", p2 = "black", p3 = "green", p4 = "purple"),
                     labels = c(p1 = paste0("d = ", d[1]), 
                                p2 = paste0("d = ", d[2]), 
                                p3 = paste0("d = ", d[3]), 
                                p4 = paste0("d = ", d[4])))+
  theme_bw()+
  scale_x_continuous(breaks = c(min(grid),-d, 0, d, max(grid)))+
  theme(legend.position = "top")+
  labs(x = "x", y = TeX("$\\rho^{\\prime}(x; d)$"), color = NULL)

Second derivative

\rho^{\prime\prime}(x; d) = \begin{cases} \begin{align*} {} & \bigl[1- (\frac{x}{d})^2\bigl]\bigl[1- (\frac{x}{d})^2 - \frac{4x^2}{d^2}\bigl] \quad {} & |x| \le d \\ & 0 & |x| > d \end{align*} \end{cases}

# Tukey's Bisquare Second Derivative
tukey_bisquare_second <- function(d){
  function(x){
    x[abs(x) > d] <- NA
    f_x <- (1 - (x/d)^2)*((1 - (x/d)^2) - 4*(x^2)/(d^2))
    f_x[is.na(f_x)] <- 0
    return(f_x)
  }
}

Plot code

ggplot()+
  geom_line(aes(grid, tukey_bisquare_second(d[1])(grid), color = "p1"))+
  geom_line(aes(grid, tukey_bisquare_second(d[2])(grid), color = "p2"))+
  geom_line(aes(grid, tukey_bisquare_second(d[3])(grid), color = "p3"))+
  geom_line(aes(grid, tukey_bisquare_second(d[4])(grid), color = "p4"))+
  scale_color_manual(values = c(p1 = "red", p2 = "black", p3 = "green", p4 = "purple"),
                     labels = c(p1 = paste0("d = ", d[1]), 
                                p2 = paste0("d = ", d[2]), 
                                p3 = paste0("d = ", d[3]), 
                                p4 = paste0("d = ", d[4])))+
  theme_bw()+
  scale_x_continuous(breaks = c(min(grid),-d, 0, d, max(grid)))+
  theme(legend.position = "top")+
  labs(x = "x", y = TeX("$\\rho^{\\prime\\prime}(x; d)$"), color = NULL)

Tukey Biweight

\rho^{\prime}(x; d) = \begin{cases} \begin{align*} {} & \bigl[1- (\frac{x}{d})^2\bigl]^2 \quad {} & |x| \le d \\ & 0 & |x| > d \end{align*} \end{cases}

# Tukey's Biweight Function
tukey_biweight <- function(d){
  function(x){
    x[abs(x) > d] <- NA
    f_x <- (1 - (x/d)^2)^2
    f_x[is.na(f_x)] <- 0
    return(f_x)
  }
}

Plot code

ggplot()+
  geom_line(aes(grid, tukey_biweight(d[1])(grid), color = "p1"))+
  geom_line(aes(grid, tukey_biweight(d[2])(grid), color = "p2"))+
  geom_line(aes(grid, tukey_biweight(d[3])(grid), color = "p3"))+
  geom_line(aes(grid, tukey_biweight(d[4])(grid), color = "p4"))+
  scale_color_manual(values = c(p1 = "red", p2 = "black", p3 = "green", p4 = "purple"),
                     labels = c(p1 = paste0("d = ", d[1]), 
                                p2 = paste0("d = ", d[2]), 
                                p3 = paste0("d = ", d[3]), 
                                p4 = paste0("d = ", d[4])))+
  theme_bw()+
  scale_x_continuous(breaks = c(min(grid),-d, 0, d, max(grid)))+
  theme(legend.position = "top")+
  labs(x = "x", y = TeX("$\\rho(x; d)$"), color = NULL)

Tukey-Beaton Bisquare

\rho(x; d) = \begin{cases} \begin{align*} {} & 3(\frac{x}{d})^2 - 3(\frac{x}{d})^4 + (\frac{x}{d})^6 \quad {} & |x| \le d \\ & 1 & |x| > d \end{align*} \end{cases}

# Tukey-Beaton Bisquare Function
tukey_beaton_bisquare <- function(d){
  function(x){
    x[abs(x) > d] <- NA
    f_x <- 3*(x/d)^2 - 3*(x/d)^4 + (x/d)^6
    f_x[is.na(f_x)] <- 1
    return(f_x)
  }
}

Plot code

ggplot()+
  geom_line(aes(grid, tukey_beaton_bisquare(d[1])(grid), color = "p1"))+
  geom_line(aes(grid, tukey_beaton_bisquare(d[2])(grid), color = "p2"))+
  geom_line(aes(grid, tukey_beaton_bisquare(d[3])(grid), color = "p3"))+
  geom_line(aes(grid, tukey_beaton_bisquare(d[4])(grid), color = "p4"))+
  scale_color_manual(values = c(p1 = "red", p2 = "black", p3 = "green", p4 = "purple"),
                     labels = c(p1 = paste0("d = ", d[1]), 
                                p2 = paste0("d = ", d[2]), 
                                p3 = paste0("d = ", d[3]), 
                                p4 = paste0("d = ", d[4])))+
  theme_bw()+
  scale_x_continuous(breaks = c(min(grid),-d, 0, d, max(grid)))+
  theme(legend.position = "top")+
  labs(x = "x", y = TeX("$\\rho(x; d)$"), color = NULL)

First derivative

\rho^{\prime}(x; d) = \begin{cases} \begin{align*} {} & \frac{6}{d^2}x - \frac{12}{d^4}x^{3} + \frac{6}{d^4}x^{5} \quad {} & |x| \le d \\ & 0 & |x| > d \end{align*} \end{cases}

# Tukey-Beaton Bisquare First Derivative
tukey_beaton_prime <- function(d){
  function(x){
    x[abs(x) > d] <- NA
    f_x <- 6*(1/d^2)*x - 12*(1/d^4)*(x)^3 + 6*(x)^5*(1/d^6)
    f_x[is.na(f_x)] <- 0
    return(f_x)
  }
}

Plot code

ggplot()+
  geom_line(aes(grid, tukey_beaton_prime(d[1])(grid), color = "p1"))+
  geom_line(aes(grid, tukey_beaton_prime(d[2])(grid), color = "p2"))+
  geom_line(aes(grid, tukey_beaton_prime(d[3])(grid), color = "p3"))+
  geom_line(aes(grid, tukey_beaton_prime(d[4])(grid), color = "p4"))+
  scale_color_manual(values = c(p1 = "red", p2 = "black", p3 = "green", p4 = "purple"),
                     labels = c(p1 = paste0("d = ", d[1]), 
                                p2 = paste0("d = ", d[2]), 
                                p3 = paste0("d = ", d[3]), 
                                p4 = paste0("d = ", d[4])))+
  theme_bw()+
  scale_x_continuous(breaks = c(min(grid),-d, 0, d, max(grid)))+
  theme(legend.position = "top")+
  labs(x = "x", y = TeX("$\\rho^{\\prime}(x; d)$"), color = NULL)

Second derivative

\rho^{\prime\prime}(x; d) = \begin{cases} \begin{align*} {} & \frac{6}{d^2} - \frac{36}{d^4}x^{2} + \frac{30}{d^4}x^{4} \quad {} & |x| \le d \\ & 0 & |x| > d \end{align*} \end{cases}

# Tukey-Beaton Bisquare Second Derivative
tukey_beaton_second <- function(d){
  function(x){
    x[abs(x) > d] <- NA
    f_x <- 6*(1/d^2) - 36*(1/d^4)*(x)^2 + 30*(x)^4*(1/d^6)
    f_x[is.na(f_x)] <- 0
    return(f_x)
  }
}

Plot code

ggplot()+
  geom_line(aes(grid, tukey_beaton_second(d[1])(grid), color = "p1"))+
  geom_line(aes(grid, tukey_beaton_second(d[2])(grid), color = "p2"))+
  geom_line(aes(grid, tukey_beaton_second(d[3])(grid), color = "p3"))+
  geom_line(aes(grid, tukey_beaton_second(d[4])(grid), color = "p4"))+
  scale_color_manual(values = c(p1 = "red", p2 = "black", p3 = "green", p4 = "purple"),
                     labels = c(p1 = paste0("d = ", d[1]), 
                                p2 = paste0("d = ", d[2]), 
                                p3 = paste0("d = ", d[3]), 
                                p4 = paste0("d = ", d[4])))+
  theme_bw()+
  scale_x_continuous(breaks = c(min(grid),-d, 0, d, max(grid)))+
  theme(legend.position = "top")+
  labs(x = "x", y = TeX("$\\rho^{\\prime\\prime}(x; d)$"), color = NULL)