1"gsl_sf_gamma" <- function(x,give=FALSE,strict=TRUE){ 2 attr <- attributes(x) 3 x.vec <- as.vector(x) 4 jj <- .C("gamma_e", 5 as.double(x.vec), 6 as.integer(length(x.vec)), 7 val=as.double(x.vec), 8 err=as.double(x.vec), 9 status=as.integer(0*x.vec), 10 PACKAGE="gsl" 11 ) 12 val <- jj$val 13 err <- jj$err 14 status <- jj$status 15 attributes(val) <- attr 16 attributes(err) <- attr 17 attributes(status) <- attr 18 19 if(strict){ 20 val <- strictify(val,status) 21 } 22 23 if(give){ 24 return(list(val=val,err=err,status=status)) 25 } else { 26 return(val) 27 } 28} 29 30"lngamma" <- function(x,give=FALSE,strict=TRUE){ 31 attr <- attributes(x) 32 x.vec <- as.vector(x) 33 jj <- .C("lngamma_e", 34 as.double(x.vec), 35 as.integer(length(x.vec)), 36 val=as.double(x.vec), 37 err=as.double(x.vec), 38 status=as.integer(0*x.vec), 39 PACKAGE="gsl" 40 ) 41 val <- jj$val 42 err <- jj$err 43 status <- jj$status 44 attributes(val) <- attr 45 attributes(err) <- attr 46 attributes(status) <- attr 47 48 if(strict){ 49 val <- strictify(val,status) 50 } 51 52 if(give){ 53 return(list(val=val,err=err,status=status)) 54 } else { 55 return(val) 56 } 57} 58 59"lngamma_sgn" <- function(x, give=FALSE,strict=TRUE){ 60 jj <- process.args(x) 61 x.vec <- jj$arg1 62 attr <- jj$attr 63 64 jj <- .C("lngamma_sgn_e", 65 as.double(x.vec), 66 as.integer(length(x.vec)), 67 val=as.double(x.vec), 68 err=as.double(x.vec), 69 status=as.integer(0*x.vec), 70 sgn=as.double(x.vec), 71 PACKAGE="gsl" 72 ) 73 val <- jj$val 74 err <- jj$err 75 sgn <- jj$sgn 76 status <- jj$status 77 attributes(val) <- attr 78 attributes(err) <- attr 79 attributes(status) <- attr 80 attributes(sgn) <- attr 81 82 if(strict){ 83 val <- strictify(val,status) 84 } 85 86 if(give){ 87 return(list(val=val,err=err,status=status,sgn=sgn)) 88 } else { 89 return(list(val=val,sgn=sgn)) 90 } 91} 92 93"gammastar" <- function(x,give=FALSE,strict=TRUE){ 94 x.vec <- as.vector(x) 95 attr <- attributes(x) 96 jj <- .C("gammastar_e", 97 as.double(x.vec), 98 as.integer(length(x.vec)), 99 val=as.double(x.vec), 100 err=as.double(x.vec), 101 status=as.integer(0*x.vec), 102 PACKAGE="gsl" 103 ) 104 val <- jj$val 105 err <- jj$err 106 status <- jj$status 107 attributes(val) <- attr 108 attributes(err) <- attr 109 attributes(status) <- attr 110 111 if(strict){ 112 val <- strictify(val,status) 113 } 114 115 if(give){ 116 return(list(val=val,err=err,status=status)) 117 } else { 118 return(val) 119 } 120} 121 122"gammainv" <- function(x,give=FALSE,strict=TRUE){ 123 x.vec <- as.vector(x) 124 attr <- attributes(x) 125 jj <- .C("gammainv_e", 126 as.double(x.vec), 127 as.integer(length(x.vec)), 128 val=as.double(x.vec), 129 err=as.double(x.vec), 130 status=as.integer(0*x.vec), 131 PACKAGE="gsl" 132 ) 133 val <- jj$val 134 err <- jj$err 135 status <- jj$status 136 attributes(val) <- attr 137 attributes(err) <- attr 138 attributes(status) <- attr 139 140 if(strict){ 141 val <- strictify(val,status) 142 } 143 144 if(give){ 145 return(list(val=val,err=err,status=status)) 146 } else { 147 return(val) 148 } 149} 150 151"lngamma_complex" <- function(zr, zi=NULL, r.and.i=TRUE, give=FALSE, strict=TRUE){ 152 attr <- attributes(zr) 153 if(is.null(zi)){ 154 zi <- as.vector(Im(zr)) 155 zr <- as.vector(Re(zr)) 156 } else { 157 zi <- as.vector(zi) 158 zr <- as.vector(zr) 159 } 160 if(length(zr) !=length(zi)){stop("zr and zi must be of the same dimensions")} 161 162 jj <- .C("lngamma_complex_e", 163 as.double(zr), 164 as.double(zi), 165 as.integer(length(zr)), 166 val_lnr=as.double(zr), 167 val_arg=as.double(zr), 168 err_lnr=as.double(zr), 169 err_arg=as.double(zr), 170 status=as.integer(0*zr), 171 PACKAGE="gsl" 172 ) 173 val_lnr <- jj$val_lnr 174 val_arg <- jj$val_arg 175 176 err_lnr <- jj$err_lnr 177 err_arg <- jj$err_arg 178 179 status <- jj$status 180 attributes(status) <- attr 181 182 if(r.and.i){ 183# val <- exp(val_lnr)*cos(val_arg) + 1i*exp(val_lnr)*sin(val_arg) 184# err <- exp(xerr_lnr)*cos(err_arg) + 1i*exp(err_lnr)*sin(err_arg) 185 val <- val_lnr + 1i*val_arg 186 err <- err_lnr + 1i*err_arg 187 attributes(val) <- attr 188 attributes(err) <- attr 189 190 if(strict){ 191 val <- strictify(val,status) 192 } 193 194 if(give){ 195 return(list(val=val, err=err, status=status)) 196 } else { 197 return(val) 198 } 199 } else { 200 attributes(val_lnr) <- attr 201 attributes(val_arg) <- attr 202 attributes(err_lnr) <- attr 203 attributes(err_arg) <- attr 204 205 if(strict){ 206 val_lnr <- strictify(val_lnr,status) 207 val_arg <- strictify(val_arg,status) 208 } 209 210 if(give){ 211 return(list(val_lnr=val_lnr, val_arg=val_arg, err_lnr=err_lnr,err_arg=err_arg, status=status)) 212 } else { 213 return(list(val_lnr=val_lnr, val_arg=val_arg)) 214 } 215 } 216} 217 218"taylorcoeff" <- function(n, x ,give=FALSE,strict=TRUE){ 219 jj <- process.args(n,x) 220 n.vec <- jj$arg1 221 x.vec <- jj$arg2 222 attr <- jj$attr 223 jj <- .C("taylorcoeff_e", 224 as.integer(n.vec), 225 as.double(x.vec), 226 as.integer(length(x.vec)), 227 val=as.double(x.vec), 228 err=as.double(x.vec), 229 status=as.integer(0*x.vec), 230 PACKAGE="gsl" 231 ) 232 val <- jj$val 233 err <- jj$err 234 status <- jj$status 235 attributes(val) <- attr 236 attributes(err) <- attr 237 attributes(status) <- attr 238 239 if(strict){ 240 val <- strictify(val,status) 241 } 242 243 if(give){ 244 return(list(val=val,err=err,status=status)) 245 } else { 246 return(val) 247 } 248} 249"fact" <- function(n, give=FALSE,strict=TRUE){ 250 n.vec <- as.vector(n) 251 attr <- attributes(n) 252 jj <- .C("fact_e", 253 as.integer(n), 254 as.integer(length(n.vec)), 255 val=as.double(n.vec), 256 err=as.double(n.vec), 257 status=as.integer(0*n.vec), 258 PACKAGE="gsl" 259 ) 260 val <- jj$val 261 err <- jj$err 262 status <- jj$status 263 attributes(val) <- attributes(n) 264 attributes(err) <- attributes(n) 265 attributes(status) <- attributes(n) 266 267 if(strict){ 268 val <- strictify(val,status) 269 } 270 271 if(give){ 272 return(list(val=val,err=err,status=status)) 273 } else { 274 return(val) 275 } 276} 277 278"doublefact" <- function(n, give=FALSE,strict=TRUE){ 279 n.vec <- as.vector(n) 280 attr <- attributes(n) 281 jj <- .C("doublefact_e", 282 as.integer(n), 283 as.integer(length(n.vec)), 284 val=as.double(n.vec), 285 err=as.double(n.vec), 286 status=as.integer(0*n.vec), 287 PACKAGE="gsl" 288 ) 289 val <- jj$val 290 err <- jj$err 291 status <- jj$status 292 attributes(val) <- attributes(n) 293 attributes(err) <- attributes(n) 294 attributes(status) <- attributes(n) 295 296 if(strict){ 297 val <- strictify(val,status) 298 } 299 300 if(give){ 301 return(list(val=val,err=err,status=status)) 302 } else { 303 return(val) 304 } 305} 306 307"lnfact" <- function(n, give=FALSE,strict=TRUE){ 308 n.vec <- as.vector(n) 309 attr <- attributes(n) 310 jj <- .C("lnfact_e", 311 as.integer(n), 312 as.integer(length(n.vec)), 313 val=as.double(n.vec), 314 err=as.double(n.vec), 315 status=as.integer(0*n.vec), 316 PACKAGE="gsl" 317 ) 318 val <- jj$val 319 err <- jj$err 320 status <- jj$status 321 attributes(val) <- attributes(n) 322 attributes(err) <- attributes(n) 323 attributes(status) <- attributes(n) 324 325 if(strict){ 326 val <- strictify(val,status) 327 } 328 329 if(give){ 330 return(list(val=val,err=err,status=status)) 331 } else { 332 return(val) 333 } 334} 335 336"lndoublefact" <- function(n, give=FALSE,strict=TRUE){ 337 n.vec <- as.vector(n) 338 attr <- attributes(n) 339 jj <- .C("lndoublefact_e", 340 as.integer(n), 341 as.integer(length(n.vec)), 342 val=as.double(n.vec), 343 err=as.double(n.vec), 344 status=as.integer(0*n.vec), 345 PACKAGE="gsl" 346 ) 347 val <- jj$val 348 err <- jj$err 349 status <- jj$status 350 attributes(val) <- attributes(n) 351 attributes(err) <- attributes(n) 352 attributes(status) <- attributes(n) 353 354 if(strict){ 355 val <- strictify(val,status) 356 } 357 358 if(give){ 359 return(list(val=val,err=err,status=status)) 360 } else { 361 return(val) 362 } 363} 364 365"gsl_sf_choose" <- function(n, m, give=FALSE,strict=TRUE){ 366 jj <- process.args(n,m) 367 n.vec <- jj$arg1 368 m.vec <- jj$arg2 369 attr <- jj$attr 370 371 jj <- .C("choose_e", 372 as.integer(n.vec), 373 as.integer(m.vec), 374 as.integer(length(n.vec)), 375 val=as.double(n.vec), 376 err=as.double(n.vec), 377 status=as.integer(0*n.vec), 378 PACKAGE="gsl" 379 ) 380 val <- jj$val 381 err <- jj$err 382 status <- jj$status 383 attributes(val) <- attributes(n) 384 attributes(err) <- attributes(n) 385 attributes(status) <- attributes(n) 386 387 if(strict){ 388 val <- strictify(val,status) 389 } 390 391 if(give){ 392 return(list(val=val,err=err,status=status)) 393 } else { 394 return(val) 395 } 396} 397"lnchoose" <- function(n, m, give=FALSE,strict=TRUE){ 398 jj <- process.args(n,m) 399 n.vec <- jj$arg1 400 m.vec <- jj$arg2 401 attr <- jj$attr 402 403 jj <- .C("lnchoose_e", 404 as.integer(n.vec), 405 as.integer(m.vec), 406 as.integer(length(n.vec)), 407 val=as.double(n.vec), 408 err=as.double(n.vec), 409 status=as.integer(0*n.vec), 410 PACKAGE="gsl" 411 ) 412 val <- jj$val 413 err <- jj$err 414 status <- jj$status 415 attributes(val) <- attributes(n) 416 attributes(err) <- attributes(n) 417 attributes(status) <- attributes(n) 418 419 if(strict){ 420 val <- strictify(val,status) 421 } 422 423 if(give){ 424 return(list(val=val,err=err,status=status)) 425 } else { 426 return(val) 427 } 428} 429 430"poch" <- function(a, x, give=FALSE,strict=TRUE){ 431 jj <- process.args(a,x) 432 a.vec <- jj$arg1 433 x.vec <- jj$arg2 434 attr <- jj$attr 435 436 jj <- .C("poch_e", 437 as.double(a.vec), 438 as.double(x.vec), 439 as.integer(length(x.vec)), 440 val=as.double(x.vec), 441 err=as.double(x.vec), 442 status=as.integer(0*x.vec), 443 PACKAGE="gsl" 444 ) 445 val <- jj$val 446 err <- jj$err 447 status <- jj$status 448 attributes(val) <- attr 449 attributes(err) <- attr 450 attributes(status) <- attr 451 452 if(strict){ 453 val <- strictify(val,status) 454 } 455 456 if(give){ 457 return(list(val=val,err=err,status=status)) 458 } else { 459 return(val) 460 } 461} 462 463"lnpoch" <- function(a, x, give=FALSE,strict=TRUE){ 464 jj <- process.args(a,x) 465 a.vec <- jj$arg1 466 x.vec <- jj$arg2 467 attr <- jj$attr 468 469 jj <- .C("lnpoch_e", 470 as.double(a.vec), 471 as.double(x.vec), 472 as.integer(length(x.vec)), 473 val=as.double(x.vec), 474 err=as.double(x.vec), 475 status=as.integer(0*x.vec), 476 PACKAGE="gsl" 477 ) 478 val <- jj$val 479 err <- jj$err 480 status <- jj$status 481 attributes(val) <- attr 482 attributes(err) <- attr 483 attributes(status) <- attr 484 485 if(strict){ 486 val <- strictify(val,status) 487 } 488 489 if(give){ 490 return(list(val=val,err=err,status=status)) 491 } else { 492 return(val) 493 } 494} 495 496"lnpoch_sgn" <- function(a, x, give=FALSE,strict=TRUE){ 497 jj <- process.args(a,x) 498 a.vec <- jj$arg1 499 x.vec <- jj$arg2 500 attr <- jj$attr 501 502 jj <- .C("lnpoch_sgn_e", 503 as.double(a.vec), 504 as.double(x.vec), 505 as.integer(length(x.vec)), 506 val=as.double(x.vec), 507 err=as.double(x.vec), 508 status=as.integer(0*x.vec), 509 sgn=as.double(x.vec), 510 PACKAGE="gsl" 511 ) 512 val <- jj$val 513 err <- jj$err 514 sgn <- jj$sgn 515 status <- jj$status 516 attributes(val) <- attr 517 attributes(err) <- attr 518 attributes(status) <- attr 519 attributes(sgn) <- attr 520 521 if(strict){ 522 val <- strictify(val,status) 523 } 524 525 if(give){ 526 return(list(val=val,err=err,status=status,sgn=sgn)) 527 } else { 528 return(list(val=val,sgn=sgn)) 529 } 530} 531 532"pochrel" <- function(a, x, give=FALSE,strict=TRUE){ 533 jj <- process.args(a,x) 534 a.vec <- jj$arg1 535 x.vec <- jj$arg2 536 attr <- jj$attr 537 538 jj <- .C("pochrel_e", 539 as.double(a.vec), 540 as.double(x.vec), 541 as.integer(length(x.vec)), 542 val=as.double(x.vec), 543 err=as.double(x.vec), 544 status=as.integer(0*x.vec), 545 PACKAGE="gsl" 546 ) 547 val <- jj$val 548 err <- jj$err 549 status <- jj$status 550 attributes(val) <- attr 551 attributes(err) <- attr 552 attributes(status) <- attr 553 554 if(strict){ 555 val <- strictify(val,status) 556 } 557 558 if(give){ 559 return(list(val=val,err=err,status=status)) 560 } else { 561 return(val) 562 } 563} 564 565"gamma_inc_Q" <- function(a, x, give=FALSE,strict=TRUE){ 566 jj <- process.args(a,x) 567 a.vec <- jj$arg1 568 x.vec <- jj$arg2 569 attr <- jj$attr 570 571 jj <- .C("gamma_inc_Q_e", 572 as.double(a.vec), 573 as.double(x.vec), 574 as.integer(length(x.vec)), 575 val=as.double(x.vec), 576 err=as.double(x.vec), 577 status=as.integer(0*x.vec), 578 PACKAGE="gsl" 579 ) 580 val <- jj$val 581 err <- jj$err 582 status <- jj$status 583 attributes(val) <- attr 584 attributes(err) <- attr 585 attributes(status) <- attr 586 587 if(strict){ 588 val <- strictify(val,status) 589 } 590 591 if(give){ 592 return(list(val=val,err=err,status=status)) 593 } else { 594 return(val) 595 } 596} 597 598"gamma_inc_P" <- function(a, x, give=FALSE,strict=TRUE){ 599 jj <- process.args(a,x) 600 a.vec <- jj$arg1 601 x.vec <- jj$arg2 602 attr <- jj$attr 603 604 jj <- .C("gamma_inc_P_e", 605 as.double(a.vec), 606 as.double(x.vec), 607 as.integer(length(x.vec)), 608 val=as.double(x.vec), 609 err=as.double(x.vec), 610 status=as.integer(0*x.vec), 611 PACKAGE="gsl" 612 ) 613 val <- jj$val 614 err <- jj$err 615 status <- jj$status 616 attributes(val) <- attr 617 attributes(err) <- attr 618 attributes(status) <- attr 619 620 if(strict){ 621 val <- strictify(val,status) 622 } 623 624 if(give){ 625 return(list(val=val,err=err,status=status)) 626 } else { 627 return(val) 628 } 629} 630 631"gamma_inc" <- function(a, x, give=FALSE,strict=TRUE){ 632 jj <- process.args(a,x) 633 a.vec <- jj$arg1 634 x.vec <- jj$arg2 635 attr <- jj$attr 636 637 jj <- .C("gamma_inc_e", 638 as.double(a.vec), 639 as.double(x.vec), 640 as.integer(length(x.vec)), 641 val=as.double(x.vec), 642 err=as.double(x.vec), 643 status=as.integer(0*x.vec), 644 PACKAGE="gsl" 645 ) 646 val <- jj$val 647 err <- jj$err 648 status <- jj$status 649 attributes(val) <- attr 650 attributes(err) <- attr 651 attributes(status) <- attr 652 653 if(strict){ 654 val <- strictify(val,status) 655 } 656 657 if(give){ 658 return(list(val=val,err=err,status=status)) 659 } else { 660 return(val) 661 } 662} 663 664"gsl_sf_beta" <- function(a, b, give=FALSE,strict=TRUE){ 665 jj <- process.args(a,b) 666 a.vec <- jj$arg1 667 b.vec <- jj$arg2 668 attr <- jj$attr 669 670 jj <- .C("beta_e", 671 as.double(a.vec), 672 as.double(b.vec), 673 as.integer(length(b.vec)), 674 val=as.double(b.vec), 675 err=as.double(b.vec), 676 status=as.integer(0*b.vec), 677 PACKAGE="gsl" 678 ) 679 val <- jj$val 680 err <- jj$err 681 status <- jj$status 682 attributes(val) <- attr 683 attributes(err) <- attr 684 attributes(status) <- attr 685 686 if(strict){ 687 val <- strictify(val,status) 688 } 689 690 if(give){ 691 return(list(val=val,err=err,status=status)) 692 } else { 693 return(val) 694 } 695} 696 697"lnbeta" <- function(a, b, give=FALSE,strict=TRUE){ 698 jj <- process.args(a,b) 699 a.vec <- jj$arg1 700 b.vec <- jj$arg2 701 attr <- jj$attr 702 703 jj <- .C("lnbeta_e", 704 as.double(a.vec), 705 as.double(b.vec), 706 as.integer(length(b.vec)), 707 val=as.double(b.vec), 708 err=as.double(b.vec), 709 status=as.integer(0*b.vec), 710 PACKAGE="gsl" 711 ) 712 val <- jj$val 713 err <- jj$err 714 status <- jj$status 715 attributes(val) <- attr 716 attributes(err) <- attr 717 attributes(status) <- attr 718 719 if(strict){ 720 val <- strictify(val,status) 721 } 722 723 if(give){ 724 return(list(val=val,err=err,status=status)) 725 } else { 726 return(val) 727 } 728} 729 730"beta_inc" <- function(a, b, x, give=FALSE,strict=TRUE){ 731 jj <- process.args(a,b,x) 732 a.vec <- jj$arg1 733 b.vec <- jj$arg2 734 x.vec <- jj$arg3 735 attr <- jj$attr 736 737 jj <- .C("beta_inc_e", 738 as.double(a.vec), 739 as.double(b.vec), 740 as.double(x.vec), 741 as.integer(length(x.vec)), 742 val=as.double(x.vec), 743 err=as.double(x.vec), 744 status=as.integer(0*x.vec), 745 PACKAGE="gsl" 746 ) 747 val <- jj$val 748 err <- jj$err 749 status <- jj$status 750 attributes(val) <- attr 751 attributes(err) <- attr 752 attributes(status) <- attr 753 754 if(strict){ 755 val <- strictify(val,status) 756 } 757 758 if(give){ 759 return(list(val=val,err=err,status=status)) 760 } else { 761 return(val) 762 } 763} 764