fix density computation for discrete variables (#23)

tnagler · May 6, 2018 · 6de6901 · 6de6901
1 parent 5ed40a3
commit 6de6901
Show file tree

Hide file tree

Showing 2 changed files with 8 additions and 2 deletions.
diff --git a/R/kde1d_methods.R b/R/kde1d_methods.R
@@ -48,11 +48,11 @@ dkde1d <- function(x, obj) {
     if (length(obj$jitter_info$i_disc) == 1 & !is.ordered(x))
         x <- ordered(x, obj$jitter_info$levels$x)
 
-    fhat <- dkde1d_cpp(x, obj)
+    fhat <- dkde1d_cpp(expand_as_numeric(x), obj)
 
     if (length(obj$jitter_info$i_disc) == 1) {
         # for discrete variables we can normalize
-        f_all <- dkde1d_cpp(as.ordered(obj$jitter_info$levels$x), obj)
+        f_all <- dkde1d_cpp(seq_along(obj$jitter_info$levels$x) - 1, obj)
         fhat <- fhat / sum(f_all)
     }
 

diff --git a/tests/testthat/test_kde1d.R b/tests/testthat/test_kde1d.R
@@ -129,4 +129,10 @@ test_that("behavior for discrete data is consistent", {
     expect_true(all(is.na(dkde1d(c(0, 6), fit))))
     expect_true(all(is.na(pkde1d(c(0, 6), fit))))
     expect_true(all(rkde1d(n, fit) %in% x))
+})
+
+test_that("estimates for discrete data are reasonable", {
+    x <- ordered(sample(5, 1e5, TRUE), 1:5)
+    fit <- kde1d(x)
+    expect_true(all(abs(dkde1d(1:5, fit) - 0.2) < 0.1))
 })