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