Tukey functions

Author

Affiliation

Beniamino Sartini

University of Bologna

library(dplyr)
# required for figures  
library(ggplot2)
# required for render latex 
library(backports)
library(latex2exp)
# Random seed 
set.seed(1)
# Grid of points
grid <- seq(-6, 6, 0.01)
# Grid of "d" parameter
d <- c(4.57, 3.57, 2.57, 1.57)

1 Tukey’s Bisquare

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

R

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)
  }
}

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)

1.1 First derivative

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

R

# 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)
  }
}

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)

1.2 Second derivative

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

R

# 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)
  }
}

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)

2 Tukey Biweight

\[ \rho_d(x) = \begin{cases} \begin{align*} {} & \left(1 - \frac{x^2}{d^2}\right)^2 \quad {} & |x| \le d \\ & 0 & |x| > d \end{align*} \end{cases} \]

R

# 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)
  }
}

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)

3 Tukey-Beaton Bisquare

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

R

# 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)
  }
}

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)

3.1 First derivative

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

R

# 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)
  }
}

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)

3.2 Second derivative

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

R

# 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)
  }
}

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)