[gnumeric] R.QTUKEY: New function.

[Morten Welinder <mortenw src gnome org>]

commit 4a9e747f390fe34f085faede4607595b3894c2be
Author: Morten Welinder <terra gnome org>
Date:   Fri May 24 10:56:08 2013 -0400

    R.QTUKEY: New function.

 ChangeLog                  |    1 +
 NEWS                       |    1 +
 plugins/fn-r/functions.c   |   37 +++++++++++++++++++++++++++++++++++++
 plugins/fn-r/generate      |    4 ++--
 plugins/fn-r/plugin.xml.in |    1 +
 src/mathfunc.c             |   26 +++++++++++++++++++++++++-
 src/mathfunc.h             |    1 +
 7 files changed, 68 insertions(+), 3 deletions(-)
---
diff --git a/ChangeLog b/ChangeLog
index 64f1379..5739e06 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,7 @@
 
        * src/mathfunc.c (R_ptukey): Accelerate handling of right tail of
        the outer integral.
+       (pfuncinverter): Handle lack of dfunc (poorly).
 
 2013-05-23  Morten Welinder  <terra gnome org>
 
diff --git a/NEWS b/NEWS
index 94ee0d4..60df6a9 100644
--- a/NEWS
+++ b/NEWS
@@ -23,6 +23,7 @@ Morten:
        * Improve statfuns tests.  [#700294]
        * Improve mathfuns tests.  [#700295]
        * Add new R.PTUKEY function.  [#700132]
+       * Add new Q.PTUKEY function.  [#700132]
        * Fix missing translation of certain function examples.
        * Add new R.PNORM2 function.
        * Fix critical when last row deleted.
diff --git a/plugins/fn-r/functions.c b/plugins/fn-r/functions.c
index 3eaf171..d5f20c8 100644
--- a/plugins/fn-r/functions.c
+++ b/plugins/fn-r/functions.c
@@ -1183,6 +1183,7 @@ static GnmFuncHelp const help_r_ptukey[] = {
        { GNM_FUNC_HELP_ARG, F_("lower_tail:if true (the default), the lower tail of the distribution is 
considered") },
        { GNM_FUNC_HELP_ARG, F_("log_p:if true, log of the probability is used") },
        { GNM_FUNC_HELP_DESCRIPTION, F_("This function returns the cumulative distribution function of the 
Studentized range distribution.") },
+       { GNM_FUNC_HELP_SEEALSO, "R.QTUKEY" },
        { GNM_FUNC_HELP_END }
 };
 
@@ -1202,6 +1203,35 @@ gnumeric_r_ptukey (GnmFuncEvalInfo *ei, GnmValue const * const *args)
 /* ------------------------------------------------------------------------- */
 
 
+static GnmFuncHelp const help_r_qtukey[] = {
+       { GNM_FUNC_HELP_NAME, F_("R.QTUKEY:probability quantile function of the Studentized range 
distribution") },
+       { GNM_FUNC_HELP_ARG, F_("p:probability") },
+       { GNM_FUNC_HELP_ARG, F_("nmeans:the number of means") },
+       { GNM_FUNC_HELP_ARG, F_("df:the number of degrees of freedom of the distribution") },
+       { GNM_FUNC_HELP_ARG, F_("nranges:the number of ranges; default is 1") },
+       { GNM_FUNC_HELP_ARG, F_("lower_tail:if true (the default), the lower tail of the distribution is 
considered") },
+       { GNM_FUNC_HELP_ARG, F_("log_p:if true, log of the probability is used") },
+       { GNM_FUNC_HELP_DESCRIPTION, F_("This function returns the probability quantile function, i.e., the 
inverse of the cumulative distribution function, of the Studentized range distribution.") },
+       { GNM_FUNC_HELP_SEEALSO, "R.PTUKEY" },
+       { GNM_FUNC_HELP_END }
+};
+
+static GnmValue *
+gnumeric_r_qtukey (GnmFuncEvalInfo *ei, GnmValue const * const *args)
+{
+       gnm_float p = value_get_as_float (args[0]);
+       gnm_float nmeans = value_get_as_float (args[1]);
+       gnm_float df = value_get_as_float (args[2]);
+       gnm_float nranges = args[3] ? value_get_as_float (args[3]) : 1;
+       gboolean lower_tail = args[4] ? value_get_as_checked_bool (args[4]) : TRUE;
+       gboolean log_p = args[5] ? value_get_as_checked_bool (args[5]) : FALSE;
+
+       return value_new_float (qtukey (p, nmeans, df, nranges, lower_tail, log_p));
+}
+
+/* ------------------------------------------------------------------------- */
+
+
 static GnmFuncHelp const help_r_qcauchy[] = {
        { GNM_FUNC_HELP_NAME, F_("R.QCAUCHY:probability quantile function of the Cauchy distribution") },
        { GNM_FUNC_HELP_ARG, F_("p:probability") },
@@ -1728,6 +1758,13 @@ GnmFuncDescriptor const stat_functions[] = {
                GNM_FUNC_SIMPLE, GNM_FUNC_IMPL_STATUS_UNIQUE_TO_GNUMERIC, GNM_FUNC_TEST_STATUS_NO_TESTSUITE,
        },
        {
+               "r.qtukey",
+               "fff|fbb",
+               help_r_qtukey,
+               gnumeric_r_qtukey, NULL, NULL, NULL,
+               GNM_FUNC_SIMPLE, GNM_FUNC_IMPL_STATUS_UNIQUE_TO_GNUMERIC, GNM_FUNC_TEST_STATUS_NO_TESTSUITE,
+       },
+       {
                "r.qcauchy",
                "fff|bb",
                help_r_qcauchy,
diff --git a/plugins/fn-r/generate b/plugins/fn-r/generate
index 2ac0e63..00c62e2 100644
--- a/plugins/fn-r/generate
+++ b/plugins/fn-r/generate
@@ -136,14 +136,14 @@ my %defaults;
         ({ 'n' => "the number of degrees of freedom $of",
            @common })];
 
-    $funcs{'ptukey'} =
+    $funcs{'ptukey'} = $funcs{'qtukey'} =
        [\&distribution,
         'Studentized range',
         ({ 'nranges' => "the number of ranges; default is 1",
            'nmeans' => "the number of means",
            'df' => "the number of degrees of freedom $of",
            @common })];
-    $defaults{'ptukey:nranges'} = 1;
+    $defaults{'ptukey:nranges'} = $defaults{'qtukey:nranges'} = 1;
 }
 
 
diff --git a/plugins/fn-r/plugin.xml.in b/plugins/fn-r/plugin.xml.in
index acd1b03..e360c2f 100644
--- a/plugins/fn-r/plugin.xml.in
+++ b/plugins/fn-r/plugin.xml.in
@@ -63,6 +63,7 @@
                                <function name="r.qsnorm"/>
                                <function name="r.qst"/>
                                <function name="r.qt"/>
+                               <function name="r.qtukey"/>
                                <function name="r.qweibull"/>
                        </functions>
                </service>
diff --git a/src/mathfunc.c b/src/mathfunc.c
index ebcbdfc..4024e30 100644
--- a/src/mathfunc.c
+++ b/src/mathfunc.c
@@ -5544,6 +5544,28 @@ ptukey(gnm_float x, gnm_float nmeans, gnm_float df, gnm_float nranges, gboolean
 }
 
 static gnm_float
+ptukey1 (gnm_float x, const gnm_float shape[],
+        gboolean lower_tail, gboolean log_p)
+{
+       return ptukey (x, shape[0], shape[1], shape[2], lower_tail, log_p);
+}
+
+gnm_float
+qtukey (gnm_float p, gnm_float nmeans, gnm_float df, gnm_float nranges, gboolean lower_tail, gboolean log_p)
+{
+       gnm_float x0, shape[3];
+
+       /* This is accurate for nmeans==2 and nranges==1.   */
+       x0 = M_SQRT2gnum * qt ((1 + p) / 2, df, lower_tail, log_p);
+
+       shape[0] = nmeans;
+       shape[1] = df;
+       shape[2] = nranges;
+
+       return pfuncinverter (p, shape, lower_tail, log_p, 0, gnm_pinf, x0, ptukey1, NULL);
+}
+
+static gnm_float
 logspace_signed_add (gnm_float logx, gnm_float logabsy, gboolean ypos)
 {
        return ypos
@@ -6360,6 +6382,8 @@ pfuncinverter (gnm_float p, const gnm_float shape[],
        gnm_float x = 0, e = 0, px;
        int i;
 
+       g_return_val_if_fail (pfunc != NULL, gnm_nan);
+
        R_Q_P01_check (p);
        if (p == R_DT_0) return xlow;
        if (p == R_DT_1) return xhigh;
@@ -6468,7 +6492,7 @@ pfuncinverter (gnm_float p, const gnm_float shape[],
                                goto done;
                        }
 
-                       if (i % 3 < 2 && (i == 0 || prec < 0.05)) {
+                       if (dpfunc_dx && i % 3 < 2 && (i == 0 || prec < 0.05)) {
                                gnm_float d = dpfunc_dx (x, shape, log_p);
                                if (log_p) d = gnm_exp (d - px);
 #ifdef DEBUG_pfuncinverter
diff --git a/src/mathfunc.h b/src/mathfunc.h
index 8de5b47..d920009 100644
--- a/src/mathfunc.h
+++ b/src/mathfunc.h
@@ -136,6 +136,7 @@ gnm_float random_laplace_pdf    (gnm_float x, gnm_float a);
 /* Studentized range distribution */
 /* Note: argument order differs from R.  */
 gnm_float ptukey(gnm_float x, gnm_float nmeans, gnm_float df, gnm_float nranges, gboolean lower_tail, 
gboolean log_p);
+gnm_float qtukey(gnm_float p, gnm_float nmeans, gnm_float df, gnm_float nranges, gboolean lower_tail, 
gboolean log_p);
 
 /* ------------------------------------------------------------------------- */