You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@commons.apache.org by tn...@apache.org on 2013/10/21 23:12:46 UTC
svn commit: r1534375 -
/commons/proper/math/trunk/src/test/R/geometricTestCases
Author: tn
Date: Mon Oct 21 21:12:46 2013
New Revision: 1534375
URL: http://svn.apache.org/r1534375
Log:
Add R test script for geometric distribution
Added:
commons/proper/math/trunk/src/test/R/geometricTestCases
Added: commons/proper/math/trunk/src/test/R/geometricTestCases
URL: http://svn.apache.org/viewvc/commons/proper/math/trunk/src/test/R/geometricTestCases?rev=1534375&view=auto
==============================================================================
--- commons/proper/math/trunk/src/test/R/geometricTestCases (added)
+++ commons/proper/math/trunk/src/test/R/geometricTestCases Mon Oct 21 21:12:46 2013
@@ -0,0 +1,121 @@
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+#------------------------------------------------------------------------------
+# R source file to validate Geometric distribution tests in
+# org.apache.commons.math.distribution.GeometricDistributionTest
+#
+# To run the test, install R, put this file and testFunctions
+# into the same directory, launch R from this directory and then enter
+# source("<name-of-this-file>")
+#
+# R functions used
+# dgeom(x, prob, log = FALSE) <- density
+# pgeom(q, prob, lower.tail = TRUE, log.p = FALSE) <- distribution
+# qgeom(p, prob, lower.tail = TRUE, log.p = FALSE) <- quantiles
+#------------------------------------------------------------------------------
+tol <- 1E-6 # error tolerance for tests
+#------------------------------------------------------------------------------
+# Function definitions
+
+source("testFunctions") # utility test functions
+
+# function to verify density computations
+
+verifyDensity <- function(points, expected, prob, tol, log = FALSE) {
+ rDensityValues <- rep(0, length(points))
+ i <- 0
+ for (point in points) {
+ i <- i + 1
+ rDensityValues[i] <- dgeom(point, prob, log)
+ }
+ output <- c("Density test prob = ", prob)
+ if (assertEquals(expected,rDensityValues,tol,"Density Values")) {
+ displayPadded(output, SUCCEEDED, WIDTH)
+ } else {
+ displayPadded(output, FAILED, WIDTH)
+ }
+}
+
+# function to verify distribution computations
+
+verifyDistribution <- function(points, expected, prob, tol) {
+ rDistValues <- rep(0, length(points))
+ i <- 0
+ for (point in points) {
+ i <- i + 1
+ rDistValues[i] <- pgeom(point, prob)
+ }
+ output <- c("Distribution test prob = ", prob)
+ if (assertEquals(expected,rDistValues,tol,"Distribution Values")) {
+ displayPadded(output, SUCCEEDED, WIDTH)
+ } else {
+ displayPadded(output, FAILED, WIDTH)
+ }
+}
+
+#--------------------------------------------------------------------------
+cat("Geometric test cases\n")
+
+prob <- 0.4
+
+densityPoints <- c(-1, 0, 1, 2, 3, 4, 5, 6, 7, 8,
+ 9, 10, 11, 12, 13, 14, 15, 16, 17, 18,
+ 19, 20, 21, 22, 23, 24, 25, 26, 27, 28)
+densityValues <- c(0, 0.4, 0.24, 0.144, 0.0864, 0.05184, 0.031104, 0.0186624, 0.01119744, 0.006718464,
+ 0.0040310784, 0.00241864704, 0.001451188224, 0.0008707129344, 0.00052242776064,
+ 0.000313456656384, 0.0001880739938304, 0.00011284439629824, 6.7706637778944e-05,
+ 4.06239826673664e-05, 2.43743896004198e-05, 1.46246337602519e-05, 8.77478025615113e-06,
+ 5.26486815369068e-06, 3.15892089221441e-06, 1.89535253532865e-06, 1.13721152119719e-06,
+ 6.82326912718312e-07, 4.09396147630988e-07, 2.45637688578593e-07)
+logDensityValues <- c(-Inf, -0.916290731874155, -1.42711635564015, -1.93794197940614, -2.44876760317213,
+ -2.95959322693812, -3.47041885070411, -3.9812444744701, -4.49207009823609,
+ -5.00289572200208, -5.51372134576807, -6.02454696953406, -6.53537259330005,
+ -7.04619821706604, -7.55702384083203, -8.06784946459802, -8.57867508836402,
+ -9.08950071213001, -9.600326335896, -10.111151959662, -10.621977583428,
+ -11.132803207194, -11.64362883096, -12.154454454726, -12.6652800784919, -13.1761057022579,
+ -13.6869313260239, -14.1977569497899, -14.7085825735559, -15.2194081973219)
+distributionValues <- c(0, 0.4, 0.64, 0.784, 0.8704, 0.92224, 0.953344, 0.9720064, 0.98320384, 0.989922304,
+ 0.9939533824, 0.99637202944, 0.997823217664, 0.9986939305984, 0.99921635835904,
+ 0.999529815015424, 0.999717889009254, 0.999830733405553, 0.999898440043332,
+ 0.999939064025999, 0.999963438415599, 0.99997806304936, 0.999986837829616,
+ 0.99999210269777, 0.999995261618662, 0.999997156971197, 0.999998294182718,
+ 0.999998976509631, 0.999999385905779, 0.999999631543467)
+#Eliminate p=1 case because it will mess up adjustement below
+inverseCumPoints <- c(0, 0.001, 0.010, 0.025, 0.050, 0.100, 0.999,
+ 0.990, 0.975, 0.950, 0.900)
+inverseCumValues <- c(-1, -1, -1, -1, -1, -1, 12, 8, 6, 4, 3)
+
+verifyDensity(densityPoints, densityValues, prob, tol)
+verifyDensity(densityPoints, logDensityValues, prob, tol, TRUE)
+verifyDistribution(densityPoints, distributionValues, prob, tol)
+
+i <- 0
+rInverseCumValues <- rep(0,length(inverseCumPoints))
+for (point in inverseCumPoints) {
+ i <- i + 1
+ rInverseCumValues[i] <- qgeom(point, prob)
+}
+
+output <- c("Inverse Distribution test prob = ", prob)
+# R defines quantiles from the right, need to subtract one
+if (assertEquals(inverseCumValues, rInverseCumValues-1, tol,
+ "Inverse Dist Values")) {
+ displayPadded(output, SUCCEEDED, 80)
+} else {
+ displayPadded(output, FAILED, 80)
+}
+
+displayDashes(WIDTH)