cffiglue.lsp

   1 ;;;; cffiglue -- Interface to C library
   2 ;;;;
   3 ;;;; Copyright (c) 1991, by Luke Tierney.
   4 ;;;; Copyright (c) 2007, by Carlos Ungil.
   5 ;;;; Permission is granted for unrestricted use.
   6
   7 ;;;; Tested (but the results have not been checked):
   8 ;;;;    Probability Distributions
   9 ;;;;    Internal Error Message Emulation
  10 ;;;;    Matrix Manipulation
  11
  12 ;;;; Untested
  13 ;;;;    numgrad numhess minfo-maximize
  14
  15 ;;;; Known problems
  16 ;;;;   BINOMIAL-QUANT doesn't return !!!
  17 ;;;;   maybe a bug in BINOMIALQUANT (lib/cdists.c)?
  18 ;;;;   I suspect of the line "del = max(1, (int) (0.2 * s));"
  19 ;;;;   (or a problem with signed/unsigned integers?)
  20
  21 (in-package :lisp-stat-basics)
  22
  23 (cffi:load-foreign-library (concatenate 'string
  24                                         (namestring cl-user::*lispstat-home-dir*)
  25                                         "lib/liblispstat"
  26                                         #+darwin ".dylib"
  27                                         #-darwin ".so"))
  28
  29
  30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31 ;;;;
  32 ;;;;                     Callback Support Functions
  33 ;;;;
  34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35
  36 (cffi:defcfun ("ccl_store_integer" ccl-store-integer)
  37     :void (x :int))
  38 (cffi:defcfun ("ccl_store_double" ccl-store-double)
  39     :void (x :double))
  40 (cffi:defcfun ("ccl_store_ptr" ccl-store-ptr)
  41     :void (x :pointer))
  42
  43 ;;;;
  44 ;;;;                  Lisp-Managed Calloc/Free
  45 ;;;;
  46
  47 ;;;; this section is commented out in mclglue.lsp
  48 ;;;; and the relevant fragment in cffi-glue.c is not compiled (ifdef DODO)
  49
  50 ;;;;
  51 ;;;;                Storage Allocation Functions
  52 ;;;;
  53
  54
  55 (defun null-ptr-p (p) (cffi:null-pointer-p p))
  56 (defun ptr-eq (p q) (cffi:pointer-eq p q))
  57
  58
  59 (cffi:defcfun ("la_base_allocate" ccl-la-base-allocate)
  60     :pointer (n :int) (m :int))
  61 (defun la-base-allocate (n m)
  62   (ccl-la-base-allocate n m))
  63
  64 (cffi:defcfun ("la_base_free_alloc" ccl-la-base-free-alloc)
  65     :void (p :pointer))
  66 (defun la-base-free (p)
  67   (ccl-la-base-free-alloc p))
  68
  69 (cffi:defcfun ("la_mode_size" ccl-la-mode-size)
  70     :int (x :int))
  71 (defun la-mode-size (mode)
  72   (ccl-la-mode-size mode))
  73
  74 ;;;;
  75 ;;;;             Callbacks for Internal Storage
  76 ;;;;
  77
  78 (cffi:defcallback lisp-la-allocate :void ((n :long) (m :long))
  79                   (ccl-store-ptr (la-allocate n m)))
  80 (cffi:defcfun ("register_la_allocate" register-la-allocate)
  81     :void (p :pointer))
  82 (register-la-allocate (cffi:callback lisp-la-allocate))
  83 (cffi:defcfun ("la_allocate" la)
  84     :pointer (x :int) (y :int))
  85
  86 (cffi:defcallback lisp-la-free-alloc :void ((p :pointer))
  87                   (la-free p))
  88 (cffi:defcfun ("register_la_free_alloc" register-la-free-alloc)
  89     :void (p :pointer))
  90 (register-la-free-alloc (cffi:callback lisp-la-free-alloc))
  91 (cffi:defcfun ("la_free_alloc" lf)
  92     :void (p :pointer))
  93
  94 ;;;;
  95 ;;;;                Storage Access Functions
  96 ;;;;
  97
  98 (cffi:defcfun ("la_get_integer" ccl-la-get-integer)
  99     :int (p :pointer) (i :int))
 100 (defun la-get-integer (p i)
 101   (ccl-la-get-integer p i))
 102
 103 (cffi:defcfun ("la_get_double" ccl-la-get-double)
 104     :double (p :pointer) (i :int))
 105 (defun la-get-double (p i)
 106   (ccl-la-get-double p i))
 107
 108 (cffi:defcfun ("la_get_complex_real" ccl-la-get-complex-real)
 109     :double (p :pointer) (i :int))
 110 (defun la-get-complex-real (p i)
 111   (ccl-la-get-complex-real p i))
 112
 113 (cffi:defcfun ("la_get_complex_imag" ccl-la-get-complex-imag)
 114     :double (p :pointer) (i :int))
 115 (defun la-get-complex-imag (p i)
 116   (ccl-la-get-complex-imag p i))
 117
 118 (defun la-get-complex (p i)
 119   (complex (la-get-complex-real p i) (la-get-complex-imag p i)))
 120
 121 (cffi:defcfun ("la_get_pointer" ccl-la-get-pointer)
 122     :pointer (p :pointer) (i :int))
 123 (defun la-get-pointer (p i)
 124   (ccl-la-get-pointer p i))
 125
 126 ;;;;
 127 ;;;;                Storage Mutation Functions
 128 ;;;;
 129
 130 (cffi:defcfun ("la_put_integer" ccl-la-put-integer)
 131     :void (p :pointer) (i :int) (x :int))
 132 (defun la-put-integer (p i x)
 133   (ccl-la-put-integer p i x))
 134
 135 (cffi:defcfun ("la_put_double" ccl-la-put-double)
 136     :void (p :pointer) (i :int) (x :double))
 137 (defun la-put-double (p i x)
 138   (ccl-la-put-double p i (float x 1d0)))
 139
 140 (cffi:defcfun ("la_put_complex" ccl-la-put-complex)
 141     :void (p :pointer) (i :int) (x :double) (y :double))
 142 (defun la-put-complex (p i x y)
 143   (ccl-la-put-complex p i (float x 1d0) (float y 1d0)))
 144
 145 (cffi:defcfun ("la_put_pointer" ccl-la-put-pointer)
 146     :void (p :pointer) (i :int) (q :pointer))
 147 (defun la-put-pointer (p i q)
 148   (ccl-la-put-pointer p i q))
 149
 150 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 151 ;;;;
 152 ;;;;                 XLISP Internal Error Message Emulation
 153 ;;;;
 154 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 155
 156 (defvar *buf* (make-string 1000))
 157
 158 (defun set-buf-char (i c) (setf (elt *buf* i) (code-char c)))
 159
 160 (defun get-buf (&optional (n (position (code-char 0) *buf*)))
 161   (subseq *buf* 0 n))
 162
 163 (cffi:defcfun ("register_set_buf_char" register-set-buf-char)
 164     :void (p :pointer))
 165 (cffi:defcallback ccl-set-buf-char :void ((n :int) (c :int))
 166   (set-buf-char n c))
 167 (register-set-buf-char (cffi:callback ccl-set-buf-char))
 168
 169 (cffi:defcfun ("register_print_buffer" register-print-buffer)
 170     :void (p :pointer))
 171 (cffi:defcallback ccl-print-buffer :void ((n :int) (type :int))
 172   (case type
 173     (0 (princ (get-buf n)))
 174     (1 (error (get-buf n))))
 175   n)
 176 (register-print-buffer (cffi:callback ccl-print-buffer))
 177
 178 (cffi:defcfun ("stdputstr" stdputstr)
 179     :void (string :string))
 180 (cffi:defcfun ("xlfail" xlfail)
 181     :void (string :string))
 182
 183
 184 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 185 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 186 ;;;;
 187 ;;;;             Lisp Interfaces to Linear Algebra Routines
 188 ;;;;
 189 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 190 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 191
 192 ;;;;
 193 ;;;; Cholesky Decomposition
 194 ;;;;
 195
 196 (cffi:defcfun ("ccl_chol_decomp_front" ccl-chol-decomp-front)
 197     :int (x :pointer) (y :int) (z :pointer))
 198 (defun chol-decomp-front (x y z)
 199   (ccl-chol-decomp-front x y z))
 200
 201 ;;;;
 202 ;;;; LU Decomposition
 203 ;;;;
 204
 205 (cffi:defcfun ("ccl_lu_decomp_front" ccl-lu-decomp-front)
 206   :int (x :pointer) (y :int) (z :pointer) (u :int) (v :pointer))
 207 (defun lu-decomp-front (x y z u v)
 208 (ccl-lu-decomp-front x y z u v))
 209
 210 (cffi:defcfun ("ccl_lu_solve_front" ccl-lu-solve-front)
 211     :int (x :pointer) (y :int) (z :pointer) (u :pointer) (v :int))
 212 (defun lu-solve-front (x y z u v)
 213   (ccl-lu-solve-front x y z u v))
 214
 215 (cffi:defcfun ("ccl_lu_inverse_front" ccl-lu-inverse-front)
 216     :int (x :pointer) (y :int) (z :pointer) (u :pointer) (v :int) (w :pointer))
 217 (defun lu-inverse-front (x y z u v w)
 218   (ccl-lu-inverse-front x y z u v w))
 219
 220 ;;;;
 221 ;;;; SV Decomposition
 222 ;;;;
 223
 224 (cffi:defcfun ("ccl_sv_decomp_front" ccl-sv-decomp-front)
 225     :int (x :pointer) (y :int) (z :int) (u :pointer) (v :pointer))
 226 (defun sv-decomp-front (x y z u v)
 227   (ccl-sv-decomp-front x y z u v))
 228
 229 ;;;;
 230 ;;;; QR Decomposition
 231 ;;;;
 232
 233 (cffi:defcfun ("ccl_qr_decomp_front" ccl-qr-decomp-front)
 234     :int (x :pointer) (y :int) (z :int) (u :pointer) (v :pointer) (w :int))
 235 (defun qr-decomp-front (x y z u v w)
 236   (ccl-qr-decomp-front x y z u v w))
 237
 238 ;;;;
 239 ;;;; Estimate of Condition Number for Lower Triangular Matrix
 240 ;;;;
 241
 242 (cffi:defcfun ("ccl_rcondest_front" ccl-rcondest-front)
 243     :double (x :pointer) (y :int))
 244 (defun rcondest-front (x y)
 245   (ccl-rcondest-front x y))
 246
 247 ;;;;
 248 ;;;; Make Rotation Matrix
 249 ;;;;
 250
 251 (cffi:defcfun ("ccl_make_rotation_front" ccl-make-rotation-front)
 252     :int (x :int) (y :pointer) (z :pointer) (u :pointer) (v :int) (w :double))
 253 (defun make-rotation-front (x y z u v w)
 254   (ccl-make-rotation-front x y z u v (float w 1d0)))
 255
 256 ;;;;
 257 ;;;; Eigenvalues and Eigenvectors
 258 ;;;;
 259
 260 (cffi:defcfun ("ccl_eigen_front" ccl-eigen-front)
 261     :int (x :pointer) (y :int) (z :pointer) (u :pointer) (v :pointer))
 262 (defun eigen-front (x y z u v)
 263   (ccl-eigen-front x y z u v))
 264
 265 ;;;;
 266 ;;;; Spline Interpolation
 267 ;;;;
 268
 269 (cffi:defcfun ("ccl_range_to_rseq" ccl-range-to-rseq)
 270     :int (x :int) (y :pointer) (z :int) (u :pointer))
 271 (defun la-range-to-rseq (x y z u)
 272   (ccl-range-to-rseq x y z u))
 273
 274 (cffi:defcfun ("ccl_spline_front" ccl-spline-front)
 275     :int (x :int) (y :pointer) (z :pointer) (u :int) (v :pointer) (w :pointer) (a :pointer))
 276 (defun spline-front (x y z u v w a)
 277   (ccl-spline-front x y z u v w a))
 278
 279 ;;;;
 280 ;;;; Kernel Density Estimators and Smoothers
 281 ;;;;
 282
 283 (cffi:defcfun ("ccl_kernel_dens_front" ccl-kernel-dens-front)
 284     :int (x :pointer) (y :int) (z :double) (u :pointer) (v :pointer) (w :int) (a :int))
 285 (defun kernel-dens-front (x y z u v w a)
 286   (ccl-kernel-dens-front x y (float z 1d0) u v w a))
 287
 288 (cffi:defcfun ("ccl_kernel_smooth_front" ccl-kernel-smooth-front)
 289     :int (x :pointer) (y :pointer) (z :int) (u :double) (v :pointer) (w :pointer) (a :int) (b :int))
 290 (defun kernel-smooth-front (x y z u v w a b)
 291   (ccl-kernel-smooth-front x y z (float u 1d0) v w a b))
 292
 293 ;;;;
 294 ;;;; Lowess Smoother Interface
 295 ;;;;
 296
 297 (cffi:defcfun ("ccl_base_lowess_front" ccl-base-lowess-front)
 298   :int (x :pointer) (y :pointer) (z :int) (u :double) (v :int) (w :double) (a :pointer) (b :pointer) (c :pointer))
 299 (defun base-lowess-front (x y z u v w a b c)
 300   (ccl-base-lowess-front x y z (float u 1d0) v (float w 1d0) a b c))
 301
 302 ;;;;
 303 ;;;; FFT
 304 ;;;;
 305
 306 (cffi:defcfun ("ccl_fft_front" ccl-fft-front)
 307     :int (x :int) (y :pointer) (z :pointer) (u :int))
 308 (defun fft-front (x y z u)
 309   (ccl-fft-front x y z u))
 310
 311 ;;;;
 312 ;;;; Maximization and Numerical Derivatives
 313 ;;;;
 314
 315 (cffi:defcallback ccl-maximize-callback :void ((n :int)
 316                                                (px :pointer)
 317                                                (pfval :pointer)
 318                                                (pgrad :pointer)
 319                                                (phess :pointer)
 320                                                (pderivs :pointer))
 321   (lisp-stat-optimize::maximize-callback n px pfval pgrad phess pderivs))
 322
 323 (cffi:defcfun ("register_maximize_callback" register-maximize-callback)
 324     :void (x :pointer))
 325 (register-maximize-callback (cffi:callback ccl-maximize-callback))
 326
 327 (cffi:defcfun ("ccl_numgrad_front" ccl-numgrad-front)
 328     :int (x :int) (y :pointer) (z :pointer) (u :double) (v :pointer))
 329 (defun numgrad-front (x y z u v)
 330   (ccl-numgrad-front x y z (float u 1d0) v))
 331
 332 (cffi:defcfun ("ccl_numhess_front" ccl-numhess-front)
 333     :int (x :int) (y :pointer) (z :pointer) (u :pointer) (v :pointer) (w :double) (a :pointer))
 334 (defun numhess-front (x y z u v w a)
 335   (ccl-numhess-front x y z u v (float w 1d0) a))
 336
 337 (cffi:defcfun ("ccl_minfo_maximize" ccl-minfo-maximize)
 338     :int (x :pointer) (y :pointer) (z :pointer) (u :pointer) (v :pointer) (w :int))
 339 (defun base-minfo-maximize (x y z u v w)
 340   (ccl-minfo-maximize x y z u v w))
 341
 342 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 343 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 344 ;;;;
 345 ;;;;                     Probability Distributions
 346 ;;;;
 347 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 348 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 349
 350 ;;;;
 351 ;;;; C-callable uniform generator
 352 ;;;;
 353
 354 (cffi:defcfun ("register_uni" register-uni)
 355     :void (f :pointer))
 356 (cffi:defcallback ccl-uni :int () (ccl-store-double (random 1.0)) 0)
 357 (register-uni (cffi:callback ccl-uni))
 358
 359 (defun one-uniform-rand () (random 1.0))
 360
 361 ;;;;
 362 ;;;; Log-gamma function
 363 ;;;;
 364
 365 (cffi:defcfun ("ccl_gamma" ccl-base-log-gamma)
 366     :double (x :double))
 367 (defun base-log-gamma (x)
 368   (ccl-base-log-gamma (float x 1d0)))
 369
 370 ;;;;
 371 ;;;; Normal distribution
 372 ;;;;
 373
 374 (cffi:defcfun ("ccl_normalcdf" ccl-base-normal-cdf)
 375     :double (x :double))
 376 (defun base-normal-cdf (x)
 377   (ccl-base-normal-cdf (float x 1d0)))
 378
 379 (cffi:defcfun ("ccl_normalquant" ccl-base-normal-quant)
 380     :double (x :double))
 381 (defun base-normal-quant (x)
 382   (ccl-base-normal-quant (float x 1d0)))
 383
 384 (cffi:defcfun ("ccl_normaldens" ccl-base-normal-dens)
 385         :double (x :double))
 386 (defun base-normal-dens (x)
 387   (ccl-base-normal-dens (float x 1d0)))
 388
 389 (cffi:defcfun ("ccl_normalrand" one-normal-rand)
 390     :float)
 391
 392 (cffi:defcfun ("ccl_bnormcdf" ccl-base-bivnorm-cdf)
 393     :double (x :double) (y :double) (z :double))
 394 (defun base-bivnorm-cdf (x y z)
 395   (ccl-base-bivnorm-cdf (float x 1d0) (float y 1d0) (float z 1d0)))
 396
 397 ;;;;
 398 ;;;; Cauchy distribution
 399 ;;;;
 400
 401 (cffi:defcfun ("ccl_cauchycdf" ccl-base-cauchy-cdf)
 402             :double (x :double))
 403 (defun base-cauchy-cdf (x)
 404   (ccl-base-cauchy-cdf (float x 1d0)))
 405
 406 (cffi:defcfun ("ccl_cauchyquant" ccl-base-cauchy-quant)
 407             :double (x :double))
 408 (defun base-cauchy-quant (x)
 409   (ccl-base-cauchy-quant (float x 1d0)))
 410
 411 (cffi:defcfun ("ccl_cauchydens" ccl-base-cauchy-dens)
 412             :double (x :double))
 413 (defun base-cauchy-dens (x)
 414   (ccl-base-cauchy-dens (float x 1d0)))
 415
 416 (cffi:defcfun ("ccl_cauchyrand" one-cauchy-rand)
 417     :double)
 418
 419 ;;;;
 420 ;;;; Gamma distribution
 421 ;;;;
 422
 423 (cffi:defcfun ("ccl_gammacdf" ccl-base-gamma-cdf)
 424             :double (x :double) (y :double))
 425 (defun base-gamma-cdf (x y)
 426   (ccl-base-gamma-cdf (float x 1d0) (float y 1d0)))
 427
 428 (cffi:defcfun ("ccl_gammaquant" ccl-base-gamma-quant)
 429             :double (x :double) (y :double))
 430 (defun base-gamma-quant (x y)
 431   (ccl-base-gamma-quant (float x 1d0) (float y 1d0)))
 432
 433 (cffi:defcfun ("ccl_gammadens" ccl-base-gamma-dens)
 434             :double (x :double) (y :double))
 435 (defun base-gamma-dens (x y)
 436   (ccl-base-gamma-dens (float x 1d0) (float y 1d0)))
 437
 438 (cffi:defcfun ("ccl_gammarand" ccl-gamma-rand)
 439             :double (x :double))
 440 (defun one-gamma-rand (x)
 441   (ccl-gamma-rand (float x 1d0)))
 442
 443 ;;;;
 444 ;;;; Chi-square distribution
 445 ;;;;
 446
 447 (cffi:defcfun ("ccl_chisqcdf" ccl-base-chisq-cdf)
 448             :double (x :double) (y :double))
 449 (defun base-chisq-cdf (x y)
 450   (ccl-base-chisq-cdf (float x 1d0) (float y 1d0)))
 451
 452 (cffi:defcfun ("ccl_chisqquant" ccl-base-chisq-quant)
 453             :double (x :double) (y :double))
 454 (defun base-chisq-quant (x y)
 455   (ccl-base-chisq-quant (float x 1d0) (float y 1d0)))
 456
 457 (cffi:defcfun ("ccl_chisqdens" ccl-base-chisq-dens)
 458             :double (x :double) (y :double))
 459 (defun base-chisq-dens (x y)
 460   (ccl-base-chisq-dens (float x 1d0) (float y 1d0)))
 461
 462 (cffi:defcfun ("ccl_chisqrand" ccl-chisq-rand)
 463             :double (x :double))
 464 (defun one-chisq-rand (x)
 465   (ccl-chisq-rand (float x 1d0)))
 466
 467 ;;;;
 468 ;;;; Beta distribution
 469 ;;;;
 470
 471 (cffi:defcfun ("ccl_betacdf" ccl-base-beta-cdf)
 472     :double (x :double) (y :double) (z :double))
 473 (defun base-beta-cdf (x y z)
 474   (ccl-base-beta-cdf (float x 1d0) (float y 1d0) (float z 1d0)))
 475
 476 (cffi:defcfun ("ccl_betaquant" ccl-base-beta-quant)
 477     :double (x :double) (y :double) (z :double))
 478 (defun base-beta-quant (x y z)
 479   (ccl-base-beta-quant (float x 1d0) (float y 1d0) (float z 1d0)))
 480
 481 (cffi:defcfun ("ccl_betadens" ccl-base-beta-dens)
 482     :double (x :double) (y :double) (z :double))
 483 (defun base-beta-dens (x y z)
 484   (ccl-base-beta-dens (float x 1d0) (float y 1d0) (float z 1d0)))
 485
 486 (cffi:defcfun ("ccl_betarand" ccl-beta-rand)
 487     :double (x :double) (y :double))
 488 (defun one-beta-rand (x y)
 489   (ccl-beta-rand (float x 1d0) (float y 1d0)))
 490
 491 ;;;;
 492 ;;;; t distribution
 493 ;;;;
 494
 495 (cffi:defcfun ("ccl_tcdf" ccl-base-t-cdf)
 496     :double (x :double) (y :double))
 497 (defun base-t-cdf (x y)
 498   (ccl-base-t-cdf (float x 1d0) (float y 1d0)))
 499
 500 (cffi:defcfun ("ccl_tquant" ccl-base-t-quant)
 501     :double (x :double) (y :double))
 502 (defun base-t-quant (x y)
 503   (ccl-base-t-quant (float x 1d0) (float y 1d0)))
 504
 505 (cffi:defcfun ("ccl_tdens" ccl-base-t-dens)
 506     :double (x :double) (y :double))
 507 (defun base-t-dens (x y)
 508   (ccl-base-t-dens (float x 1d0) (float y 1d0)))
 509
 510 (cffi:defcfun ("ccl_trand" ccl-t-rand)
 511     :double (x :double))
 512 (defun one-t-rand (x)
 513   (ccl-t-rand (float x 1d0)))
 514
 515 ;;;;
 516 ;;;; F distribution
 517 ;;;;
 518
 519 (cffi:defcfun ("ccl_fcdf" ccl-base-f-cdf)
 520     :double (x :double) (y :double) (z :double))
 521 (defun base-f-cdf (x y z)
 522   (ccl-base-f-cdf (float x 1d0) (float y 1d0) (float z 1d0)))
 523
 524 (cffi:defcfun ("ccl_fquant" ccl-base-f-quant)
 525     :double (x :double) (y :double) (z :double))
 526 (defun base-f-quant (x y z)
 527   (ccl-base-f-quant (float x 1d0) (float y 1d0) (float z 1d0)))
 528
 529 (cffi:defcfun ("ccl_fdens" ccl-base-f-dens)
 530     :double (x :double) (y :double) (z :double))
 531 (defun base-f-dens (x y z)
 532   (ccl-base-f-dens (float x 1d0) (float y 1d0) (float z 1d0)))
 533
 534 (cffi:defcfun ("ccl_frand" ccl-f-rand)
 535     :double (x :double) (y :double))
 536 (defun one-f-rand (x y) (ccl-f-rand (float x 1d0) (float y 1d0)))
 537
 538 ;;;;
 539 ;;;; Poisson distribution
 540 ;;;;
 541
 542 (cffi:defcfun ("ccl_poissoncdf" ccl-base-poisson-cdf)
 543     :double (x :double) (y :double))
 544 (defun base-poisson-cdf (x y)
 545   (ccl-base-poisson-cdf (float x 1d0) (float y 1d0)))
 546
 547 (cffi:defcfun ("ccl_poissonquant" ccl-base-poisson-quant)
 548     :int (x :double) (y :double))
 549 (defun base-poisson-quant (x y)
 550   (ccl-base-poisson-quant (float x 1d0) (float y 1d0)))
 551
 552 (cffi:defcfun ("ccl_poissonpmf" ccl-base-poisson-pmf)
 553     :double (x :int) (y :double))
 554 (defun base-poisson-pmf (x y)
 555   (ccl-base-poisson-pmf x (float y 1d0)))
 556
 557 (cffi:defcfun ("ccl_poissonrand" ccl-poisson-rand)
 558     :int (x :double))
 559 (defun one-poisson-rand (x)
 560   (ccl-poisson-rand (float x 1d0)))
 561
 562 ;;;;
 563 ;;;; Binomial distribution
 564 ;;;;
 565
 566 (cffi:defcfun ("ccl_binomialcdf" ccl-base-binomial-cdf)
 567     :double (x :double) (y :int) (z :double))
 568 (defun base-binomial-cdf (x y z)
 569   (ccl-base-binomial-cdf (float x 1d0) y (float z 1d0)))
 570
 571 (cffi:defcfun ("ccl_binomialquant" ccl-base-binomial-quant)
 572     :int (x :double) (y :int) (z :double))
 573 (defun base-binomial-quant (x y z)
 574   (ccl-base-binomial-quant (float x 1d0) y (float z 1d0)))
 575
 576 (cffi:defcfun ("ccl_binomialpmf" ccl-base-binomial-pmf)
 577     :double (x :int) (y :int) (z :double))
 578 (defun base-binomial-pmf (x y z)
 579   (ccl-base-binomial-pmf x y (float z 1d0)))
 580
 581 (cffi:defcfun ("ccl_binomialrand" ccl-binomial-rand)
 582     :int (x :int) (y :double))
 583 (defun one-binomial-rand (x y)
 584   (ccl-binomial-rand x (float y 1d0)))