[Yuima-commits] r442 - pkg/yuima/src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu May 26 08:08:19 CEST 2016


Author: yumauehara
Date: 2016-05-26 08:08:19 +0200 (Thu, 26 May 2016)
New Revision: 442

Added:
   pkg/yuima/src/rpts.c
Log:
added rpts

Added: pkg/yuima/src/rpts.c
===================================================================
--- pkg/yuima/src/rpts.c	                        (rev 0)
+++ pkg/yuima/src/rpts.c	2016-05-26 06:08:19 UTC (rev 442)
@@ -0,0 +1,47 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+#include <math.h>
+#include "R.h"
+#include "Mt.h"
+
+
+void rpts(int *x, double *alpha, double *a, double *b, double *rn);
+double rps(double *alpha, double *a, double *b);
+double rexp();
+
+void rpts(int *x, double *alpha, double *a, double *b, double *rn)
+{
+    int i=0;
+    double y;
+    init_genrand((unsigned)time(NULL));
+    while(i<*x){
+        y=rps(alpha,a,b); /* here input variables are pointa type*/
+        if(genrand_real3()<=exp(-(*b)*y))
+        {
+            rn[i]=y;
+            i++;
+        }
+        
+            }
+}
+
+
+
+double rps(double *alpha, double *a, double *b)
+{
+    double x1,y1,z1,uni;
+    uni=-M_PI/2.0+M_PI*genrand_real3();
+    x1=pow((*a)*tgamma(1.0-*alpha)*cos(M_PI*(*alpha)/(2.0))/(*alpha),1.0/(*alpha));
+    y1=sin((*alpha)*uni+M_PI*(*alpha)/2.0)/pow(cos(uni)*cos(M_PI*(*alpha)/2.0),1.0/(*alpha));
+    z1=pow(cos((1.0-*alpha)*uni-M_PI*(*alpha)/2.0)/rexp(),(1.0-*alpha)/(*alpha));
+    
+    return x1*y1*z1;
+}
+
+double rexp()
+{
+    return -log(genrand_real3());
+}
+
+


Property changes on: pkg/yuima/src/rpts.c
___________________________________________________________________
Added: svn:executable
   + *



More information about the Yuima-commits mailing list