single-r-math.c

     
   1  //! @file single-r-math.c
   2  //! @author J. Marcel van der Veer
   3  
   4  //! @section Copyright
   5  //!
   6  //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
   7  //! Copyright 2001-2023 J. Marcel van der Veer [algol68g@xs4all.nl].
   8  
   9  //! @section License
  10  //!
  11  //! This program is free software; you can redistribute it and/or modify it 
  12  //! under the terms of the GNU General Public License as published by the 
  13  //! Free Software Foundation; either version 3 of the License, or 
  14  //! (at your option) any later version.
  15  //!
  16  //! This program is distributed in the hope that it will be useful, but 
  17  //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
  18  //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 
  19  //! more details. You should have received a copy of the GNU General Public 
  20  //! License along with this program. If not, see [http://www.gnu.org/licenses/].
  21  
  22  //! @section Synopsis
  23  //!
  24  //! REAL GNU R math routines. 
  25  
  26  #include "a68g.h"
  27  
  28  // This file contains bindings to the GNU R standalone mathematical library.
  29  
  30  #if defined (HAVE_MATHLIB)
  31  
  32  #include "a68g-genie.h"
  33  #include "a68g-prelude.h"
  34  #include <Rmath.h>
  35  
  36  //! @brief PROC (REAL) REAL r digamma
  37  
  38  void genie_R_digamma_real (NODE_T * p)
  39  {
  40    C_FUNCTION (p, digamma);
  41  }
  42  
  43  //! @brief PROC (REAL) REAL r trigamma
  44  
  45  void genie_R_trigamma_real (NODE_T * p)
  46  {
  47    C_FUNCTION (p, trigamma);
  48  }
  49  
  50  //! @brief PROC (REAL) REAL r tetragamma
  51  
  52  void genie_R_tetragamma_real (NODE_T * p)
  53  {
  54    C_FUNCTION (p, tetragamma);
  55  }
  56  
  57  //! @brief PROC (REAL) REAL r pentagamma
  58  
  59  void genie_R_pentagamma_real (NODE_T * p)
  60  {
  61    C_FUNCTION (p, pentagamma);
  62  }
  63  
  64  //! @brief PROC (REAL, REAL) REAL r psigamma
  65  
  66  void genie_R_psigamma_real (NODE_T * p)
  67  {
  68    A68_REAL *x, *s;
  69    POP_OPERAND_ADDRESSES (p, x, s, A68_REAL);
  70    errno = 0;
  71    VALUE (x) = psigamma (VALUE (x), (int) VALUE (s));
  72    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);
  73  }
  74  
  75  #define D_3(a68_fun, R_fun)\
  76  void a68_fun (NODE_T * p)\
  77  {\
  78    A68_BOOL give_log;\
  79    A68_REAL a, b;\
  80    POP_OBJECT (p, &give_log, A68_BOOL);\
  81    POP_OBJECT (p, &b, A68_REAL);\
  82    POP_OBJECT (p, &a, A68_REAL);\
  83    errno = 0;\
  84    PUSH_VALUE (p, R_fun (VALUE (&a), VALUE (&b),\
  85                         (VALUE (&give_log) == A68_TRUE ? 1 : 0)), A68_REAL);\
  86    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);\
  87  }
  88  
  89  #define D_4(a68_fun, R_fun)\
  90  void a68_fun (NODE_T * p)\
  91  {\
  92    A68_BOOL give_log;\
  93    A68_REAL a, b, c;\
  94    POP_OBJECT (p, &give_log, A68_BOOL);\
  95    POP_OBJECT (p, &c, A68_REAL);\
  96    POP_OBJECT (p, &b, A68_REAL);\
  97    POP_OBJECT (p, &a, A68_REAL);\
  98    errno = 0;\
  99    PUSH_VALUE (p, R_fun (VALUE (&a), VALUE (&b), VALUE (&c),\
 100                         (VALUE (&give_log) == A68_TRUE ? 1 : 0)), A68_REAL);\
 101    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);\
 102  }
 103  
 104  #define D_5(a68_fun, R_fun)\
 105  void a68_fun (NODE_T * p)\
 106  {\
 107    A68_BOOL give_log;\
 108    A68_REAL a, b, c, d;\
 109    POP_OBJECT (p, &give_log, A68_BOOL);\
 110    POP_OBJECT (p, &d, A68_REAL);\
 111    POP_OBJECT (p, &c, A68_REAL);\
 112    POP_OBJECT (p, &b, A68_REAL);\
 113    POP_OBJECT (p, &a, A68_REAL);\
 114    errno = 0;\
 115    PUSH_VALUE (p, R_fun (VALUE (&a), VALUE (&b), VALUE (&c), VALUE (&d),\
 116                         (VALUE (&give_log) == A68_TRUE ? 1 : 0)), A68_REAL);\
 117    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);\
 118  }
 119  
 120  #define PQ_4(a68_fun, R_fun)\
 121  void a68_fun (NODE_T * p)\
 122  {\
 123    A68_BOOL lower_tail, log_p;\
 124    A68_REAL x, a;\
 125    POP_OBJECT (p, &log_p, A68_BOOL);\
 126    POP_OBJECT (p, &lower_tail, A68_BOOL);\
 127    POP_OBJECT (p, &a, A68_REAL);\
 128    POP_OBJECT (p, &x, A68_REAL);\
 129    errno = 0;\
 130    PUSH_VALUE (p, R_fun (VALUE (&x), VALUE (&a),\
 131                (VALUE (&lower_tail) == A68_TRUE ? 1 : 0),\
 132                (VALUE (&log_p) == A68_TRUE ? 1 : 0)), A68_REAL);\
 133    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);\
 134  }
 135  
 136  #define PQ_5(a68_fun, R_fun)\
 137  void a68_fun (NODE_T * p)\
 138  {\
 139    A68_BOOL lower_tail, log_p;\
 140    A68_REAL x, a, b;\
 141    POP_OBJECT (p, &log_p, A68_BOOL);\
 142    POP_OBJECT (p, &lower_tail, A68_BOOL);\
 143    POP_OBJECT (p, &b, A68_REAL);\
 144    POP_OBJECT (p, &a, A68_REAL);\
 145    POP_OBJECT (p, &x, A68_REAL);\
 146    errno = 0;\
 147    PUSH_VALUE (p, R_fun (VALUE (&x), VALUE (&a), VALUE (&b),\
 148                (VALUE (&lower_tail) == A68_TRUE ? 1 : 0),\
 149                (VALUE (&log_p) == A68_TRUE ? 1 : 0)), A68_REAL);\
 150    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);\
 151  }
 152  
 153  #define PQ_6(a68_fun, R_fun)\
 154  void a68_fun (NODE_T * p)\
 155  {\
 156    A68_BOOL lower_tail, log_p;\
 157    A68_REAL x, a, b, c;\
 158    POP_OBJECT (p, &log_p, A68_BOOL);\
 159    POP_OBJECT (p, &lower_tail, A68_BOOL);\
 160    POP_OBJECT (p, &c, A68_REAL);\
 161    POP_OBJECT (p, &b, A68_REAL);\
 162    POP_OBJECT (p, &a, A68_REAL);\
 163    POP_OBJECT (p, &x, A68_REAL);\
 164    errno = 0;\
 165    PUSH_VALUE (p, R_fun (VALUE (&x), VALUE (&a), VALUE (&b), VALUE (&c),\
 166                (VALUE (&lower_tail) == A68_TRUE ? 1 : 0),\
 167                (VALUE (&log_p) == A68_TRUE ? 1 : 0)), A68_REAL);\
 168    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);\
 169  }
 170  
 171  #define R_1(a68_fun, R_fun)\
 172  void a68_fun (NODE_T * p)\
 173  {\
 174    A68_REAL a;\
 175    POP_OBJECT (p, &a, A68_REAL);\
 176    errno = 0;\
 177    PUSH_VALUE (p, R_fun (VALUE (&a)), A68_REAL);\
 178    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);\
 179  }
 180  
 181  #define R_2(a68_fun, R_fun)\
 182  void a68_fun (NODE_T * p)\
 183  {\
 184    A68_REAL a, b;\
 185    POP_OBJECT (p, &b, A68_REAL);\
 186    POP_OBJECT (p, &a, A68_REAL);\
 187    errno = 0;\
 188    PUSH_VALUE (p, R_fun (VALUE (&a), VALUE (&b)), A68_REAL);\
 189    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);\
 190  }
 191  
 192  #define R_3(a68_fun, R_fun)\
 193  void a68_fun (NODE_T * p)\
 194  {\
 195    A68_REAL a, b, c;\
 196    POP_OBJECT (p, &c, A68_REAL);\
 197    POP_OBJECT (p, &b, A68_REAL);\
 198    POP_OBJECT (p, &a, A68_REAL);\
 199    errno = 0;\
 200    PUSH_VALUE (p, R_fun (VALUE (&a), VALUE (&b), VALUE (&c)), A68_REAL);\
 201    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);\
 202  }
 203  
 204  // Distribution functions
 205  
 206  // Chi squared
 207  
 208  //! @brief PROC dchisq = (REAL x, df, BOOL give log) REAL
 209  //! @brief PROC pchisq = (REAL x, df, BOOL lower tail, give log) REAL
 210  //! @brief PROC qchisq = (REAL p, df, BOOL lower tail, log p) REAL
 211  //! @brief PROC rchisq = (REAL df) REAL
 212  
 213  D_3 (genie_R_dchisq_real, dchisq);
 214  PQ_4 (genie_R_pchisq_real, pchisq);
 215  PQ_4 (genie_R_qchisq_real, qchisq);
 216  R_1 (genie_R_rchisq_real, rchisq);
 217  
 218  // Exponential
 219  
 220  //! @brief PROC dexp = (REAL x, scale, BOOL give log) REAL
 221  //! @brief PROC pexp = (REAL x, scale, BOOL lower tail, give log) REAL
 222  //! @brief PROC qexp = (REAL p, scale, BOOL lower tail, log p) REAL
 223  //! @brief PROC rexp = (REAL scale) REAL
 224  
 225  D_3 (genie_R_dexp_real, dexp);
 226  PQ_4 (genie_R_pexp_real, pexp);
 227  PQ_4 (genie_R_qexp_real, qexp);
 228  R_1 (genie_R_rexp_real, rexp);
 229  
 230  // Geometric
 231  
 232  //! @brief PROC dgeom = (REAL x, p, BOOL give log) REAL
 233  //! @brief PROC pgeom = (REAL x, p, BOOL lower tail, give log) REAL
 234  //! @brief PROC qgeom = (REAL p, p, BOOL lower tail, log p) REAL
 235  //! @brief PROC rgeom = (REAL p) REAL
 236  
 237  D_3 (genie_R_dgeom_real, dgeom);
 238  PQ_4 (genie_R_pgeom_real, pgeom);
 239  PQ_4 (genie_R_qgeom_real, qgeom);
 240  R_1 (genie_R_rgeom_real, rgeom);
 241  
 242  // Poisson 
 243  
 244  //! @brief PROC dpois = (REAL x, lambda, BOOL give log) REAL
 245  //! @brief PROC ppois = (REAL x, lambda, BOOL lower tail, give log) REAL
 246  //! @brief PROC qpois = (REAL p, lambda, BOOL lower tail, log p) REAL
 247  //! @brief PROC rpois = (REAL lambda) REAL
 248  
 249  D_3 (genie_R_dpois_real, dpois);
 250  PQ_4 (genie_R_ppois_real, ppois);
 251  PQ_4 (genie_R_qpois_real, qpois);
 252  R_1 (genie_R_rpois_real, rpois);
 253  
 254  // Student
 255  
 256  //! @brief PROC dt = (REAL x, n, BOOL give log) REAL
 257  //! @brief PROC pt = (REAL x, n, BOOL lower tail, give log) REAL
 258  //! @brief PROC qt = (REAL p, n, BOOL lower tail, log p) REAL
 259  //! @brief PROC rt = (REAL n) REAL
 260  
 261  D_3 (genie_R_dt_real, dt);
 262  PQ_4 (genie_R_pt_real, pt);
 263  PQ_4 (genie_R_qt_real, qt);
 264  R_1 (genie_R_rt_real, rt);
 265  
 266  // Beta
 267  
 268  //! @brief PROC dbeta = (REAL x, a, b, BOOL give log) REAL
 269  //! @brief PROC pbeta = (REAL x, a, b, BOOL lower tail, give log) REAL
 270  //! @brief PROC qbeta = (REAL p, a, b, BOOL lower tail, log p) REAL
 271  //! @brief PROC rbeta = (REAL a, b) REAL
 272  
 273  D_4 (genie_R_dbeta_real, dbeta);
 274  PQ_5 (genie_R_pbeta_real, pbeta);
 275  PQ_5 (genie_R_qbeta_real, qbeta);
 276  R_2 (genie_R_rbeta_real, rbeta);
 277  
 278  // Binomial
 279  
 280  //! @brief PROC dbinom = (REAL x, n, p, BOOL give log) REAL
 281  //! @brief PROC pbinom = (REAL x, n, p, BOOL lower tail, give log) REAL
 282  //! @brief PROC qbinom = (REAL p, n, p, BOOL lower tail, log p) REAL
 283  //! @brief PROC rbinom = (REAL n, p) REAL
 284  
 285  D_4 (genie_R_dbinom_real, dbinom);
 286  PQ_5 (genie_R_pbinom_real, pbinom);
 287  PQ_5 (genie_R_qbinom_real, qbinom);
 288  R_2 (genie_R_rbinom_real, rbinom);
 289  
 290  // Chi squared, non central
 291  
 292  //! @brief PROC dnchisq = (REAL x, df, ncp, BOOL give log) REAL
 293  //! @brief PROC pnchisq = (REAL x, df, ncp, BOOL lower tail, give log) REAL
 294  //! @brief PROC qnchisq = (REAL p, df, ncp, BOOL lower tail, log p) REAL
 295  //! @brief PROC rnchisq = (REAL df, ncp) REAL
 296  
 297  D_4 (genie_R_dnchisq_real, dnchisq);
 298  PQ_5 (genie_R_pnchisq_real, pnchisq);
 299  PQ_5 (genie_R_qnchisq_real, qnchisq);
 300  R_2 (genie_R_rnchisq_real, rnchisq);
 301  
 302  // Cauchy
 303  
 304  //! @brief PROC dcauchy = (REAL x, location, scale, BOOL give log) REAL
 305  //! @brief PROC pcauchy = (REAL x, location, scale, BOOL lower tail, give log) REAL
 306  //! @brief PROC qcauchy = (REAL p, location, scale, BOOL lower tail, log p) REAL
 307  //! @brief PROC rcauchy = (REAL location, scale) REAL
 308  
 309  D_4 (genie_R_dcauchy_real, dcauchy);
 310  PQ_5 (genie_R_pcauchy_real, pcauchy);
 311  PQ_5 (genie_R_qcauchy_real, qcauchy);
 312  R_2 (genie_R_rcauchy_real, rcauchy);
 313  
 314  // F
 315  
 316  //! @brief PROC df = (REAL x, n1, n2, BOOL give log) REAL
 317  //! @brief PROC pf = (REAL x, n1, n2, BOOL lower tail, give log) REAL
 318  //! @brief PROC qf = (REAL p, n1, n2, BOOL lower tail, log p) REAL
 319  //! @brief PROC rf = (REAL n1, n2) REAL
 320  
 321  D_4 (genie_R_df_real, df);
 322  PQ_5 (genie_R_pf_real, pf);
 323  PQ_5 (genie_R_qf_real, qf);
 324  R_2 (genie_R_rf_real, rf);
 325  
 326  // Logistic
 327  
 328  //! @brief PROC dlogis = (REAL x, location, scale, BOOL give log) REAL
 329  //! @brief PROC plogis = (REAL x, location, scale, BOOL lower tail, give log) REAL
 330  //! @brief PROC qlogis = (REAL p, location, scale, BOOL lower tail, log p) REAL
 331  //! @brief PROC rlogis = (REAL location, scale) REAL
 332  
 333  D_4 (genie_R_dlogis_real, dlogis);
 334  PQ_5 (genie_R_plogis_real, plogis);
 335  PQ_5 (genie_R_qlogis_real, qlogis);
 336  R_2 (genie_R_rlogis_real, rlogis);
 337  
 338  // Log-normal
 339  
 340  //! @brief PROC dlnorm = (REAL x, logmu, logsd, BOOL give log) REAL
 341  //! @brief PROC plnorm = (REAL x, logmu, logsd, BOOL lower tail, give log) REAL
 342  //! @brief PROC qlnorm = (REAL p, logmu, logsd, BOOL lower tail, log p) REAL
 343  //! @brief PROC rlnorm = (REAL logmu, logsd) REAL
 344  
 345  D_4 (genie_R_dlnorm_real, dlnorm);
 346  PQ_5 (genie_R_plnorm_real, plnorm);
 347  PQ_5 (genie_R_qlnorm_real, qlnorm);
 348  R_2 (genie_R_rlnorm_real, rlnorm);
 349  
 350  // Negative binomial
 351  
 352  //! @brief PROC dnbinom = (REAL x, size, prob, BOOL give log) REAL
 353  //! @brief PROC pnbinom = (REAL x, size, prob, BOOL lower tail, give log) REAL
 354  //! @brief PROC qnbinom = (REAL p, size, prob, BOOL lower tail, log p) REAL
 355  //! @brief PROC rnbinom = (REAL size, prob) REAL
 356  
 357  D_4 (genie_R_dnbinom_real, dnbinom);
 358  PQ_5 (genie_R_pnbinom_real, pnbinom);
 359  PQ_5 (genie_R_qnbinom_real, qnbinom);
 360  R_2 (genie_R_rnbinom_real, rnbinom);
 361  
 362  // t, non-central
 363  
 364  //! @brief PROC dnt = (REAL x, df, delta, BOOL give log) REAL
 365  //! @brief PROC pnt = (REAL x, df, delta, BOOL lower tail, give log) REAL
 366  //! @brief PROC qnt = (REAL p, df, delta, BOOL lower tail, log p) REAL
 367  
 368  D_4 (genie_R_dnt_real, dnt);
 369  PQ_5 (genie_R_pnt_real, pnt);
 370  PQ_5 (genie_R_qnt_real, qnt);
 371  
 372  // Normal
 373  
 374  //! @brief PROC dnorm = (REAL x, mu, sigma, BOOL give log) REAL
 375  //! @brief PROC pnorm = (REAL x, mu, sigma, BOOL lower tail, give log) REAL
 376  //! @brief PROC qnorm = (REAL p, mu, sigma, BOOL lower tail, log p) REAL
 377  //! @brief PROC rnorm = (REAL mu, sigma) REAL
 378  
 379  D_4 (genie_R_dnorm_real, dnorm);
 380  PQ_5 (genie_R_pnorm_real, pnorm);
 381  PQ_5 (genie_R_qnorm_real, qnorm);
 382  R_2 (genie_R_rnorm_real, rnorm);
 383  
 384  // Uniform
 385  
 386  //! @brief PROC dunif = (REAL x, a, b, BOOL give log) REAL
 387  //! @brief PROC punif = (REAL x, a, b, BOOL lower tail, give log) REAL
 388  //! @brief PROC qunif = (REAL p, a, b, BOOL lower tail, log p) REAL
 389  //! @brief PROC runif = (REAL a, b) REAL
 390  
 391  D_4 (genie_R_dunif_real, dunif);
 392  PQ_5 (genie_R_punif_real, punif);
 393  PQ_5 (genie_R_qunif_real, qunif);
 394  R_2 (genie_R_runif_real, runif);
 395  
 396  // Weibull
 397  
 398  //! @brief PROC dweibull = (REAL x, shape, scale, BOOL give log) REAL
 399  //! @brief PROC pweibull = (REAL x, shape, scale, BOOL lower tail, give log) REAL
 400  //! @brief PROC qweibull = (REAL p, shape, scale, BOOL lower tail, log p) REAL
 401  //! @brief PROC rweibull = (REAL shape, scale) REAL
 402  
 403  D_4 (genie_R_dweibull_real, dweibull);
 404  PQ_5 (genie_R_pweibull_real, pweibull);
 405  PQ_5 (genie_R_qweibull_real, qweibull);
 406  R_2 (genie_R_rweibull_real, rweibull);
 407  
 408  // F, non central
 409  
 410  //! @brief PROC dnf = (REAL x, n1, n2, ncp, BOOL give log) REAL
 411  //! @brief PROC pnf = (REAL x, n1, n2, ncp, BOOL lower tail, give log) REAL
 412  //! @brief PROC qnf = (REAL p, n1, n2, ncp, BOOL lower tail, log p) REAL
 413  
 414  D_5 (genie_R_dnf_real, dnf);
 415  PQ_6 (genie_R_pnf_real, pnf);
 416  PQ_6 (genie_R_qnf_real, qnf);
 417  
 418  // Hyper geometric
 419  
 420  //! @brief PROC dhyper = (REAL x, nr, nb, n, BOOL give log) REAL
 421  //! @brief PROC phyper = (REAL x, nr, nb, n, BOOL lower tail, give log) REAL
 422  //! @brief PROC qhyper = (REAL p, nr, nb, n, BOOL lower tail, log p) REAL
 423  //! @brief PROC rhyper = (REAL nr, nb, n) REAL
 424  
 425  D_5 (genie_R_dhyper_real, dhyper);
 426  PQ_6 (genie_R_phyper_real, phyper);
 427  PQ_6 (genie_R_qhyper_real, qhyper);
 428  R_3 (genie_R_rhyper_real, rhyper);
 429  
 430  // Tukey
 431  
 432  //! @brief PROC ptukey = (REAL x, groups, df, treatments, BOOL lower tail, give log) REAL
 433  //! @brief PROC qtukey = (REAL p, groups, df, treatments, BOOL lower tail, log p) REAL
 434  
 435  PQ_6 (genie_R_ptukey_real, ptukey);
 436  PQ_6 (genie_R_qtukey_real, qtukey);
 437  
 438  // Wilcoxon
 439  
 440  //! @brief PROC dwilcox = (REAL x, m, n, BOOL give log) REAL
 441  //! @brief PROC pwilcox = (REAL x, m, n, BOOL lower tail, give log) REAL
 442  //! @brief PROC qwilcox = (REAL p, m, n, BOOL lower tail, log p) REAL
 443  //! @brief PROC rwilcox = (REAL m, n) REAL
 444  
 445  void genie_R_dwilcox_real (NODE_T * p)
 446  {
 447    A68_BOOL give_log;
 448    A68_REAL a, b, c;
 449    extern void wilcox_free (void);
 450    POP_OBJECT (p, &give_log, A68_BOOL);
 451    POP_OBJECT (p, &c, A68_REAL);
 452    POP_OBJECT (p, &b, A68_REAL);
 453    POP_OBJECT (p, &a, A68_REAL);
 454    errno = 0;
 455    PUSH_VALUE (p, dwilcox (VALUE (&a), VALUE (&b), VALUE (&c), (VALUE (&give_log) == A68_TRUE ? 1 : 0)), A68_REAL);
 456    wilcox_free ();
 457    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);
 458  }
 459  
 460  void genie_R_pwilcox_real (NODE_T * p)
 461  {
 462    A68_BOOL lower_tail, log_p;
 463    A68_REAL x, a, b;
 464    extern void wilcox_free (void);
 465    POP_OBJECT (p, &log_p, A68_BOOL);
 466    POP_OBJECT (p, &lower_tail, A68_BOOL);
 467    POP_OBJECT (p, &b, A68_REAL);
 468    POP_OBJECT (p, &a, A68_REAL);
 469    POP_OBJECT (p, &x, A68_REAL);
 470    errno = 0;
 471    PUSH_VALUE (p, pwilcox (VALUE (&x), VALUE (&a), VALUE (&b), (VALUE (&lower_tail) == A68_TRUE ? 1 : 0), (VALUE (&log_p) == A68_TRUE ? 1 : 0)), A68_REAL);
 472    wilcox_free ();
 473    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);
 474  }
 475  
 476  void genie_R_qwilcox_real (NODE_T * p)
 477  {
 478    A68_BOOL lower_tail, log_p;
 479    A68_REAL x, a, b;
 480    extern void wilcox_free (void);
 481    POP_OBJECT (p, &log_p, A68_BOOL);
 482    POP_OBJECT (p, &lower_tail, A68_BOOL);
 483    POP_OBJECT (p, &b, A68_REAL);
 484    POP_OBJECT (p, &a, A68_REAL);
 485    POP_OBJECT (p, &x, A68_REAL);
 486    errno = 0;
 487    PUSH_VALUE (p, qwilcox (VALUE (&x), VALUE (&a), VALUE (&b), (VALUE (&lower_tail) == A68_TRUE ? 1 : 0), (VALUE (&log_p) == A68_TRUE ? 1 : 0)), A68_REAL);
 488    wilcox_free ();
 489    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);
 490  }
 491  
 492  R_2 (genie_R_rwilcox_real, rwilcox);
 493  
 494  // Wilcoxon sign rank
 495  
 496  //! @brief PROC dsignrank = (REAL x, n, BOOL give log) REAL
 497  //! @brief PROC psignrank = (REAL x, n, BOOL lower tail, give log) REAL
 498  //! @brief PROC qsignrank = (REAL p, n, BOOL lower tail, log p) REAL
 499  //! @brief PROC rsignrank = (REAL n) REAL
 500  
 501  void genie_R_dsignrank_real (NODE_T * p)
 502  {
 503    A68_BOOL give_log;
 504    A68_REAL a, b;
 505    extern void signrank_free (void);
 506    POP_OBJECT (p, &give_log, A68_BOOL);
 507    POP_OBJECT (p, &b, A68_REAL);
 508    POP_OBJECT (p, &a, A68_REAL);
 509    errno = 0;
 510    PUSH_VALUE (p, dsignrank (VALUE (&a), VALUE (&b), (VALUE (&give_log) == A68_TRUE ? 1 : 0)), A68_REAL);
 511    signrank_free ();
 512    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);
 513  }
 514  
 515  void genie_R_psignrank_real (NODE_T * p)
 516  {
 517    A68_BOOL lower_tail, log_p;
 518    A68_REAL x, a;
 519    extern void signrank_free (void);
 520    POP_OBJECT (p, &log_p, A68_BOOL);
 521    POP_OBJECT (p, &lower_tail, A68_BOOL);
 522    POP_OBJECT (p, &a, A68_REAL);
 523    POP_OBJECT (p, &x, A68_REAL);
 524    errno = 0;
 525    PUSH_VALUE (p, psignrank (VALUE (&x), VALUE (&a), (VALUE (&lower_tail) == A68_TRUE ? 1 : 0), (VALUE (&log_p) == A68_TRUE ? 1 : 0)), A68_REAL);
 526    signrank_free ();
 527    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);
 528  }
 529  
 530  void genie_R_qsignrank_real (NODE_T * p)
 531  {
 532    A68_BOOL lower_tail, log_p;
 533    A68_REAL x, a;
 534    extern void signrank_free (void);
 535    POP_OBJECT (p, &log_p, A68_BOOL);
 536    POP_OBJECT (p, &lower_tail, A68_BOOL);
 537    POP_OBJECT (p, &a, A68_REAL);
 538    POP_OBJECT (p, &x, A68_REAL);
 539    errno = 0;
 540    PUSH_VALUE (p, qsignrank (VALUE (&x), VALUE (&a), (VALUE (&lower_tail) == A68_TRUE ? 1 : 0), (VALUE (&log_p) == A68_TRUE ? 1 : 0)), A68_REAL);
 541    signrank_free ();
 542    PRELUDE_ERROR (errno != 0, p, ERROR_MATH_EXCEPTION, NO_TEXT);
 543  }
 544  
 545  R_1 (genie_R_rsignrank_real, rsignrank);
 546  
 547  #endif