grnn_SmallSample.R

source("yager.R")
df <- read.table("lgd", header = T)[, 1:8]
Y <- 1 - df$rr
X <- scale(df[, 2:8])
pre.N <- 1000
trn.N <- 100
try.N <- 100
seeds <- floor(with(set.seed(2020), runif(try.N) * 1e8))

test_glm <- function(seed) {
  i1 <- with(set.seed(seed), sample(seq(length(Y)), pre.N))
  Y1 <- Y[i1]
  X1 <- X[i1, ]
  Y2 <- Y[-i1]
  X2 <- X[-i1, ] 	
  i2 <- with(set.seed(seed), sample(seq(length(Y2)), trn.N))
  gm <- glm(Y2 ~ ., data = data.frame(Y2, X2)[i2, ], family = quasibinomial)
  round(MLmetrics::R2_Score(predict(gm, newdata = data.frame(X1), type = "response"), Y1), 4)
}

perf.glm <- Reduce(c, lapply(seeds, test_glm))
summary(perf.glm)
#     Min.  1st Qu.   Median     Mean  3rd Qu.     Max.
# -0.39300 -0.10483 -0.02280 -0.05135  0.01230  0.08920
sum(perf.glm > 0) / length(perf.glm)
# [1] 0.32

test_grnn <- function(seed) {
  i1 <- with(set.seed(seed), sample(seq(length(Y)), pre.N))
  Y1 <- Y[i1]
  X1 <- X[i1, ]
  Y2 <- Y[-i1]
  X2 <- X[-i1, ]  
  i2 <- with(set.seed(seed), sample(seq(length(Y2)), trn.N))
  gn <- grnn.fit(X2[i2, ], Y2[i2])
  round(MLmetrics::R2_Score(grnn.predict(gn, X1), Y1), 4)
}

perf.grnn <- Reduce(c, lapply(seeds, test_grnn))
summary(perf.grnn)
#     Min.  1st Qu.   Median     Mean  3rd Qu.     Max.
# -0.06130  0.00075  0.03075  0.02739  0.05437  0.10000
sum(perf.grnn > 0) / length(perf.grnn)
# [1] 0.76