inst/doc/irdc-demo.R

In FORD: Feature Ordering by Integrated R Square Dependence

## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(FORD)     # Our package
library(FOCI)     # For comparison
library(ggplot2)  # For visualization

## ----continuous---------------------------------------------------------------
n <- 1000
x <- matrix(runif(n * 3), nrow = n)
y <- (x[, 1] + x[, 2]) %% 1

irdc(y, x[, 1])
irdc(y, x[, 2])
irdc(y, x[, 3])

## ----discrete-1---------------------------------------------------------------
n <- 10000
s <- 0.1
x1 <- c(rep(0, n * s), runif(n * (1 - s)))
x2 <- runif(n)
y <- x1

irdc(y, x1, dist.type.X = "discrete")
irdc(y, x2)

## ----discrete-2---------------------------------------------------------------
n <- 10000
x1 <- runif(n)
y1 <- rbinom(n, 1, 0.5)
y2 <- as.numeric(x1 >= 0.5)

irdc(y1, x1, dist.type.X = "discrete")
irdc(y2, x1, dist.type.X = "discrete")

FOCI::codec(y1, x1)
FOCI::codec(y2, x1)

## ----hurdle-vs-gamma----------------------------------------------------------
r_hurdle_poisson <- function(n, p_zero = 0.3, lambda = 2) {
  is_zero <- rbinom(n, 1, p_zero)
  rztpois <- function(m, lambda) {
    samples <- numeric(m)
    for (i in 1:m) {
      repeat {
        x <- rpois(1, lambda)
        if (x > 0) {
          samples[i] <- x
          break
        }
      }
    }
    samples
  }
  result <- numeric(n)
  result[is_zero == 0] <- rztpois(sum(is_zero == 0), lambda)
  result
}

set.seed(123)
n <- 1000
p_zero <- 0.4
lambda <- 10

hurdle <- r_hurdle_poisson(n, p_zero, lambda)
gamma_mix <- c(rep(0, round(p_zero * n)), rgamma(round((1 - p_zero) * n), shape = lambda, rate = 1))

df <- data.frame(
  value = c(hurdle, gamma_mix),
  source = rep(c("Hurdle Poisson", "Gamma Mixture"), each = n)
)

ggplot(df, aes(x = value, fill = source)) +
  geom_histogram(alpha = 0.5, position = "identity", bins = 40) +
  labs(title = "Comparison: Hurdle Poisson vs Gamma Mixture",
       x = "Value", y = "Count", fill = "Distribution") +
  theme_bw()

## ----discrete-3---------------------------------------------------------------
x1 <- sort(gamma_mix)
y1 <- rbinom(n, 1, 0.5)
y2 <- sort(hurdle)

irdc(y1, x1, dist.type.X = "discrete")
irdc(y2, x1, dist.type.X = "discrete")

FOCI::codec(y1, x1)
FOCI::codec(y2, x1)

## ----discrete-4---------------------------------------------------------------
x1 <- sort(hurdle)
y1 <- rbinom(n, 1, 0.5)
y2 <- sort(gamma_mix)

irdc(y1, x1, dist.type.X = "discrete")
irdc(y2, x1, dist.type.X = "discrete")

FOCI::codec(y1, x1)
FOCI::codec(y2, x1)