Skip to main content
deleted 1 character in body
Source Link
whuber
  • 333.6k
  • 63
  • 792
  • 1.3k
ecdf.ks <- function(x, f=pnorm, col2="#00000010", accent="#d02020", cex=0.6,
                    limits=FALSE, ...) {
  obj <- ecdf(x)
  x <- sort(x)
  n <- length(x)
  y <- f(x) - (0:(n - 1))/n
  p <- pmax(y, 1/n - y)
  dp <- max(p)
  i <- which(p >= dp)[1]
  q <- ifelse(f(x[i]) > (i-1)/n, (i-1)/n, i/n)

  # if (dp != ks.test(x, f)$statistic) stop("Incorrect.")

  plot(obj, col=col2, cex=cex, ...)
  points(x[i], q, col=accent, pch=19, cex=cex)
  if (limits) {
    curve(pmin(1, f(x)+dp), add=TRUE, col=accent)
    curve(pmax(0, f(x)-dp), add=TRUE, col=accent)
  }
  c(i, dp)
}
ecdf.ks <- function(x, f=pnorm, col2="#00000010", accent="#d02020", cex=0.6,
                    limits=FALSE, ...) {
  obj <- ecdf(x)
  x <- sort(x)
  n <- length(x)
  y <- f(x) - (0:(n - 1))/n
  p <- pmax(y, 1/n - y)
  dp <- max(p)
  i <- which(p >= dp)[1]
  q <- ifelse(f(x[i]) > (i-1)/n, (i-1)/n, i/n)

  # if (dp != ks.test(x, f)$statistic) stop("Incorrect.")

  plot(obj, col=col2, cex=cex, ...)
  points(x[i], q, col=accent, pch=19, cex=cex)
  if (limits) {
    curve(pmin(1, f(x)+dp), add=TRUE, col=accent)
    curve(pmax(0, f(x)-dp), add=TRUE, col=accent)
  }
  c(i, dp)
}
ecdf.ks <- function(x, f=pnorm, col2="#00000010", accent="#d02020", cex=0.6,
                    limits=FALSE, ...) {
  obj <- ecdf(x)
  x <- sort(x)
  n <- length(x)
  y <- f(x) - (0:(n - 1))/n
  p <- pmax(y, 1/n - y)
  dp <- max(p)
  i <- which(p >= dp)[1]
  q <- ifelse(f(x[i]) > (i-1)/n, (i-1)/n, i/n)

  # if (dp != ks.test(x, f)$statistic) stop("Incorrect.")

  plot(obj, col=col2, cex=cex, ...)
  points(x[i], q, col=accent, pch=19, cex=cex)
  if (limits) {
    curve(pmin(1, f(x)+dp), add=TRUE, col=accent)
    curve(pmax(0, f(x)-dp), add=TRUE, col=accent)
  }
  c(i, dp)
}
ecdf.ks <- function(x, f=pnorm, col2="#00000010", accent="#d02020", cex=0.6,
                    limits=FALSE, ...) {
  obj <- ecdf(x)
  x <- sort(x)
  n <- length(x)
  y <- f(x) - (0:(n - 1))/n
  p <- pmax(y, 1/n - y)
  dp <- max(p)
  i <- which(p >= dp)[1]
  q <- ifelse(f(x[i]) > (i-1)/n, (i-1)/n, i/n)

  # if (dp != ks.test(x, f)$statistic) stop("Incorrect.")

  plot(obj, col=col2, cex=cex, ...)
  points(x[i], q, col=accent, pch=19, cex=cex)
  if (limits) {
    curve(pmin(1, f(x)+dp), add=TRUE, col=accent)
    curve(pmax(0, f(x)-dp), add=TRUE, col=accent)
  }
  c(i, dp)
}
deleted 4 characters in body
Source Link
whuber
  • 333.6k
  • 63
  • 792
  • 1.3k
ecdf.ks <- function(x, f=pnorm, col2="#00000010", accent="#d02020", cex=0.6,
                    limits=FALSE, ...) {
  obj <- ecdf(x)
  x <- sort(x)
  n <- length(x)
  y <- f(x) - (0:(n - 1))/n
  p <- pmax(y, 1/n - y)
  dp <- max(p)
  i <- which(p >= dp)[1]
  q <- ifelse(f(x[i]) > (i-1)/n, (i-1)/n, i/n)

  # if (dp != ks.test(x, pnormf)$statistic) stop("Incorrect.")

  plot(obj, col=col2, cex=cex, ...)
  points(x[i], q, col=accent, pch=19, cex=cex)
  if (limits) {
    curve(pmin(1, f(x)+dp), add=TRUE, col=accent)
    curve(pmax(0, f(x)-dp), add=TRUE, col=accent)
  }
  c(i, dp)
}
ecdf.ks <- function(x, f=pnorm, col2="#00000010", accent="#d02020", cex=0.6,
                    limits=FALSE, ...) {
  obj <- ecdf(x)
  x <- sort(x)
  n <- length(x)
  y <- f(x) - (0:(n - 1))/n
  p <- pmax(y, 1/n - y)
  dp <- max(p)
  i <- which(p >= dp)[1]
  q <- ifelse(f(x[i]) > (i-1)/n, (i-1)/n, i/n)

  # if (dp != ks.test(x, pnorm)$statistic) stop("Incorrect.")

  plot(obj, col=col2, cex=cex, ...)
  points(x[i], q, col=accent, pch=19, cex=cex)
  if (limits) {
    curve(pmin(1, f(x)+dp), add=TRUE, col=accent)
    curve(pmax(0, f(x)-dp), add=TRUE, col=accent)
  }
  c(i, dp)
}
ecdf.ks <- function(x, f=pnorm, col2="#00000010", accent="#d02020", cex=0.6,
                    limits=FALSE, ...) {
  obj <- ecdf(x)
  x <- sort(x)
  n <- length(x)
  y <- f(x) - (0:(n - 1))/n
  p <- pmax(y, 1/n - y)
  dp <- max(p)
  i <- which(p >= dp)[1]
  q <- ifelse(f(x[i]) > (i-1)/n, (i-1)/n, i/n)

  # if (dp != ks.test(x, f)$statistic) stop("Incorrect.")

  plot(obj, col=col2, cex=cex, ...)
  points(x[i], q, col=accent, pch=19, cex=cex)
  if (limits) {
    curve(pmin(1, f(x)+dp), add=TRUE, col=accent)
    curve(pmax(0, f(x)-dp), add=TRUE, col=accent)
  }
  c(i, dp)
}
added 1018 characters in body
Source Link
whuber
  • 333.6k
  • 63
  • 792
  • 1.3k

In response to requests, here is the essential R code I used for the calculations and plots. It uses the standard Normal distribution (pnorm) for the reference. The commented-out line established that my calculations agree with those of the built-in ks.test function. I had to modify its code in order to extract the specific data point contributing to the KS statistic.

ecdf.ks <- function(x, f=pnorm, col2="#00000010", accent="#d02020", cex=0.6,
                    limits=FALSE, ...) {
  obj <- ecdf(x)
  x <- sort(x)
  n <- length(x)
  y <- f(x) - (0:(n - 1))/n
  p <- pmax(y, 1/n - y)
  dp <- max(p)
  i <- which(p >= dp)[1]
  q <- ifelse(f(x[i]) > (i-1)/n, (i-1)/n, i/n)

  # if (dp != ks.test(x, pnorm)$statistic) stop("Incorrect.")

  plot(obj, col=col2, cex=cex, ...)
  points(x[i], q, col=accent, pch=19, cex=cex)
  if (limits) {
    curve(pmin(1, f(x)+dp), add=TRUE, col=accent)
    curve(pmax(0, f(x)-dp), add=TRUE, col=accent)
  }
  c(i, dp)
}

In response to requests, here is the essential R code I used for the calculations and plots. It uses the standard Normal distribution (pnorm) for the reference. The commented-out line established that my calculations agree with those of the built-in ks.test function. I had to modify its code in order to extract the specific data point contributing to the KS statistic.

ecdf.ks <- function(x, f=pnorm, col2="#00000010", accent="#d02020", cex=0.6,
                    limits=FALSE, ...) {
  obj <- ecdf(x)
  x <- sort(x)
  n <- length(x)
  y <- f(x) - (0:(n - 1))/n
  p <- pmax(y, 1/n - y)
  dp <- max(p)
  i <- which(p >= dp)[1]
  q <- ifelse(f(x[i]) > (i-1)/n, (i-1)/n, i/n)

  # if (dp != ks.test(x, pnorm)$statistic) stop("Incorrect.")

  plot(obj, col=col2, cex=cex, ...)
  points(x[i], q, col=accent, pch=19, cex=cex)
  if (limits) {
    curve(pmin(1, f(x)+dp), add=TRUE, col=accent)
    curve(pmax(0, f(x)-dp), add=TRUE, col=accent)
  }
  c(i, dp)
}
Source Link
whuber
  • 333.6k
  • 63
  • 792
  • 1.3k
Loading