├── .gitignore ├── src ├── test │ └── java │ │ └── org │ │ └── renjin │ │ └── gcc │ │ └── example │ │ └── NormalDistTest.java └── main │ └── c │ ├── nmath.h │ ├── dpq.h │ └── pnorm.c ├── README.md └── pom.xml /.gitignore: -------------------------------------------------------------------------------- 1 | target 2 | .idea 3 | *.iml 4 | -------------------------------------------------------------------------------- /src/test/java/org/renjin/gcc/example/NormalDistTest.java: -------------------------------------------------------------------------------- 1 | package org.renjin.gcc.example; 2 | 3 | import org.junit.Test; 4 | 5 | import static org.hamcrest.Matchers.closeTo; 6 | import static org.junit.Assert.assertThat; 7 | 8 | /** 9 | * Example of using a compiled C function from Java 10 | */ 11 | public class NormalDistTest { 12 | 13 | @Test 14 | public void pgammaTest() { 15 | 16 | // Defined in pnorm.c 17 | // double pnorm5(double x, double mu, double sigma, int lower_tail, int log_p) 18 | 19 | double p = org.renjin.gcc.example.Example.pnorm5(0.5, 0, 1, 1, 0); 20 | assertThat(p, closeTo(0.6914, 0.0001)); 21 | } 22 | 23 | } 24 | -------------------------------------------------------------------------------- /src/main/c/nmath.h: -------------------------------------------------------------------------------- 1 | 2 | #ifndef NMATH_H 3 | #define NMATH_H 4 | 5 | #include 6 | #include 7 | 8 | 9 | // Some defines from R 10 | #define ML_NEGINF ((-1.0) / 0.0) 11 | #define ML_POSINF (( 1.0) / 0.0) 12 | #define FALSE 0 13 | #define LDOUBLE double 14 | #define NULL 0 15 | #define M_LN_SQRT_2PI 0.918938533204672741780329736406 /* log(sqrt(2*pi)) */ 16 | #define M_LN_SQRT_PId2 0.225791352644727432363097614947 /* log(sqrt(pi/2)) */ 17 | #define M_SQRT_32 5.656854249492380195206754896838 /* sqrt(32) */ 18 | #define M_1_SQRT_2PI 0.398942280401432677939946059934 /* 1/sqrt(2pi) */ 19 | #define ML_NAN NAN 20 | #define M_2PI 6.283185307179586476925286766559 21 | #define pnorm pnorm5 22 | #define dnorm dnorm4 23 | 24 | #define R_FINITE isfinite 25 | 26 | #define expm1(x) (exp(1)-1) 27 | #define log1p(x) (log(x+1)) 28 | #define fmax2(x, y) fmax(x, y) 29 | 30 | #define MATHLIB_WARNING(...) {} 31 | #endif 32 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # GCC-Bridge Example Project 3 | 4 | This is an example of how the gcc-bridge plugin can be used independently of Renjin to compile 5 | C and Fortran sources to JVM class files that can be used as any other JAR. 6 | 7 | ## Project Layout 8 | 9 | The project follows the standard Maven layout: 10 | 11 | ``` 12 | src/main/c -- C Sources 13 | src/test/java -- Java test sources demonstrating how the C files can be used 14 | pom.xml -- Maven setup 15 | ``` 16 | 17 | The C sources are taken as an example from the GNU R nmath library. 18 | 19 | ## Requirements 20 | 21 | The GCC-Bridge maven plugin requires GCC 4.7 to be installed to compile C and Fortran Sources. 22 | 23 | You will also need Java 1.8 and Apache Maven 3.x. 24 | 25 | On Ubuntu, you can install all required tools via `apt-get`: 26 | 27 | ``` 28 | sudo apt-get install maven gcc-4.7 gcc-4.7-plugin-dev gfortran-4.7 gcc-4.7.multilib g++-4.7 29 | ``` 30 | 31 | ## Compiling 32 | 33 | You can build the java library by running 34 | 35 | ``` 36 | mvn install 37 | ``` 38 | 39 | 40 | 41 | 42 | 43 | 44 | -------------------------------------------------------------------------------- /pom.xml: -------------------------------------------------------------------------------- 1 | 2 | 5 | 4.0.0 6 | 7 | org.renjin.gcc.example 8 | gcc-bridge-example 9 | 1.0-SNAPSHOT 10 | 11 | 12 | 0.9.2594 13 | 14 | 15 | 16 | 17 | 18 | 19 | bedatadriven 20 | bedatadriven public repo 21 | https://nexus.bedatadriven.com/content/groups/public/ 22 | 23 | 24 | 25 | 26 | 27 | bedatadriven 28 | bedatadriven public repo 29 | https://nexus.bedatadriven.com/content/groups/public/ 30 | 31 | 32 | 33 | 34 | 35 | org.renjin 36 | gcc-runtime 37 | ${gcc.bridge.version} 38 | 39 | 40 | 41 | junit 42 | junit 43 | 4.11 44 | 45 | 46 | org.hamcrest 47 | hamcrest-library 48 | 1.3 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | org.renjin 57 | gcc-bridge-maven-plugin 58 | ${gcc.bridge.version} 59 | 60 | 61 | org.renjin.gcc.example 62 | 63 | 64 | Example 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | compile 74 | 75 | compile 76 | 77 | 78 | 79 | 80 | 81 | 82 | -------------------------------------------------------------------------------- /src/main/c/dpq.h: -------------------------------------------------------------------------------- 1 | /* 2 | * R : A Computer Language for Statistical Data Analysis 3 | * Copyright (C) 2000--2014 The R Core Team 4 | * 5 | * This program is free software; you can redistribute it and/or modify 6 | * it under the terms of the GNU General Public License as published by 7 | * the Free Software Foundation; either version 2 of the License, or 8 | * (at your option) any later version. 9 | * 10 | * This program is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | * GNU General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU General Public License 16 | * along with this program; if not, a copy is available at 17 | * http://www.r-project.org/Licenses/ 18 | */ 19 | /* Utilities for `dpq' handling (density/probability/quantile) */ 20 | 21 | /* give_log in "d"; log_p in "p" & "q" : */ 22 | #define give_log log_p 23 | /* "DEFAULT" */ 24 | /* --------- */ 25 | #define R_D__0 (log_p ? ML_NEGINF : 0.) /* 0 */ 26 | #define R_D__1 (log_p ? 0. : 1.) /* 1 */ 27 | #define R_DT_0 (lower_tail ? R_D__0 : R_D__1) /* 0 */ 28 | #define R_DT_1 (lower_tail ? R_D__1 : R_D__0) /* 1 */ 29 | #define R_D_half (log_p ? -M_LN2 : 0.5) // 1/2 (lower- or upper tail) 30 | 31 | 32 | /* Use 0.5 - p + 0.5 to perhaps gain 1 bit of accuracy */ 33 | #define R_D_Lval(p) (lower_tail ? (p) : (0.5 - (p) + 0.5)) /* p */ 34 | #define R_D_Cval(p) (lower_tail ? (0.5 - (p) + 0.5) : (p)) /* 1 - p */ 35 | 36 | #define R_D_val(x) (log_p ? log(x) : (x)) /* x in pF(x,..) */ 37 | #define R_D_qIv(p) (log_p ? exp(p) : (p)) /* p in qF(p,..) */ 38 | #define R_D_exp(x) (log_p ? (x) : exp(x)) /* exp(x) */ 39 | #define R_D_log(p) (log_p ? (p) : log(p)) /* log(p) */ 40 | #define R_D_Clog(p) (log_p ? log1p(-(p)) : (0.5 - (p) + 0.5)) /* [log](1-p) */ 41 | 42 | // log(1 - exp(x)) in more stable form than log1p(- R_D_qIv(x)) : 43 | #define R_Log1_Exp(x) ((x) > -M_LN2 ? log(-expm1(x)) : log1p(-exp(x))) 44 | 45 | /* log(1-exp(x)): R_D_LExp(x) == (log1p(- R_D_qIv(x))) but even more stable:*/ 46 | #define R_D_LExp(x) (log_p ? R_Log1_Exp(x) : log1p(-x)) 47 | 48 | #define R_DT_val(x) (lower_tail ? R_D_val(x) : R_D_Clog(x)) 49 | #define R_DT_Cval(x) (lower_tail ? R_D_Clog(x) : R_D_val(x)) 50 | 51 | /*#define R_DT_qIv(p) R_D_Lval(R_D_qIv(p)) * p in qF ! */ 52 | #define R_DT_qIv(p) (log_p ? (lower_tail ? exp(p) : - expm1(p)) \ 53 | : R_D_Lval(p)) 54 | 55 | /*#define R_DT_CIv(p) R_D_Cval(R_D_qIv(p)) * 1 - p in qF */ 56 | #define R_DT_CIv(p) (log_p ? (lower_tail ? -expm1(p) : exp(p)) \ 57 | : R_D_Cval(p)) 58 | 59 | #define R_DT_exp(x) R_D_exp(R_D_Lval(x)) /* exp(x) */ 60 | #define R_DT_Cexp(x) R_D_exp(R_D_Cval(x)) /* exp(1 - x) */ 61 | 62 | #define R_DT_log(p) (lower_tail? R_D_log(p) : R_D_LExp(p))/* log(p) in qF */ 63 | #define R_DT_Clog(p) (lower_tail? R_D_LExp(p): R_D_log(p))/* log(1-p) in qF*/ 64 | #define R_DT_Log(p) (lower_tail? (p) : R_Log1_Exp(p)) 65 | // == R_DT_log when we already "know" log_p == TRUE 66 | 67 | 68 | #define R_Q_P01_check(p) \ 69 | if ((log_p && p > 0) || \ 70 | (!log_p && (p < 0 || p > 1)) ) \ 71 | ML_ERR_return_NAN 72 | 73 | /* Do the boundaries exactly for q*() functions : 74 | * Often _LEFT_ = ML_NEGINF , and very often _RIGHT_ = ML_POSINF; 75 | * 76 | * R_Q_P01_boundaries(p, _LEFT_, _RIGHT_) :<==> 77 | * 78 | * R_Q_P01_check(p); 79 | * if (p == R_DT_0) return _LEFT_ ; 80 | * if (p == R_DT_1) return _RIGHT_; 81 | * 82 | * the following implementation should be more efficient (less tests): 83 | */ 84 | #define R_Q_P01_boundaries(p, _LEFT_, _RIGHT_) \ 85 | if (log_p) { \ 86 | if(p > 0) \ 87 | ML_ERR_return_NAN; \ 88 | if(p == 0) /* upper bound*/ \ 89 | return lower_tail ? _RIGHT_ : _LEFT_; \ 90 | if(p == ML_NEGINF) \ 91 | return lower_tail ? _LEFT_ : _RIGHT_; \ 92 | } \ 93 | else { /* !log_p */ \ 94 | if(p < 0 || p > 1) \ 95 | ML_ERR_return_NAN; \ 96 | if(p == 0) \ 97 | return lower_tail ? _LEFT_ : _RIGHT_; \ 98 | if(p == 1) \ 99 | return lower_tail ? _RIGHT_ : _LEFT_; \ 100 | } 101 | 102 | #define R_P_bounds_01(x, x_min, x_max) \ 103 | if(x <= x_min) return R_DT_0; \ 104 | if(x >= x_max) return R_DT_1 105 | /* is typically not quite optimal for (-Inf,Inf) where 106 | * you'd rather have */ 107 | #define R_P_bounds_Inf_01(x) \ 108 | if(!R_FINITE(x)) { \ 109 | if (x > 0) return R_DT_1; \ 110 | /* x < 0 */return R_DT_0; \ 111 | } 112 | 113 | 114 | 115 | /* additions for density functions (C.Loader) */ 116 | #define R_D_fexp(f,x) (give_log ? -0.5*log(f)+(x) : exp(x)/sqrt(f)) 117 | 118 | /* [neg]ative or [non int]eger : */ 119 | #define R_D_negInonint(x) (x < 0. || R_nonint(x)) 120 | 121 | // for discrete d(x, ...) : 122 | #define R_D_nonint_check(x) \ 123 | if(R_nonint(x)) { \ 124 | MATHLIB_WARNING("non-integer x = %f", x); \ 125 | return R_D__0; \ 126 | } 127 | 128 | -------------------------------------------------------------------------------- /src/main/c/pnorm.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Mathlib : A C Library of Special Functions 3 | * Copyright (C) 1998 Ross Ihaka 4 | * Copyright (C) 2000-2013 The R Core Team 5 | * Copyright (C) 2003 The R Foundation 6 | * 7 | * This program is free software; you can redistribute it and/or modify 8 | * it under the terms of the GNU General Public License as published by 9 | * the Free Software Foundation; either version 2 of the License, or 10 | * (at your option) any later version. 11 | * 12 | * This program is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | * GNU General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU General Public License 18 | * along with this program; if not, a copy is available at 19 | * http://www.r-project.org/Licenses/ 20 | * 21 | * SYNOPSIS 22 | * 23 | * #include 24 | * 25 | * double pnorm5(double x, double mu, double sigma, int lower_tail,int log_p); 26 | * {pnorm (..) is synonymous and preferred inside R} 27 | * 28 | * void pnorm_both(double x, double *cum, double *ccum, 29 | * int i_tail, int log_p); 30 | * 31 | * DESCRIPTION 32 | * 33 | * The main computation evaluates near-minimax approximations derived 34 | * from those in "Rational Chebyshev approximations for the error 35 | * function" by W. J. Cody, Math. Comp., 1969, 631-637. This 36 | * transportable program uses rational functions that theoretically 37 | * approximate the normal distribution function to at least 18 38 | * significant decimal digits. The accuracy achieved depends on the 39 | * arithmetic system, the compiler, the intrinsic functions, and 40 | * proper selection of the machine-dependent constants. 41 | * 42 | * REFERENCE 43 | * 44 | * Cody, W. D. (1993). 45 | * ALGORITHM 715: SPECFUN - A Portable FORTRAN Package of 46 | * Special Function Routines and Test Drivers". 47 | * ACM Transactions on Mathematical Software. 19, 22-32. 48 | * 49 | * EXTENSIONS 50 | * 51 | * The "_both" , lower, upper, and log_p variants were added by 52 | * Martin Maechler, Jan.2000; 53 | * as well as log1p() and similar improvements later on. 54 | * 55 | * James M. Rath contributed bug report PR#699 and patches correcting SIXTEN 56 | * and if() clauses {with a bug: "|| instead of &&" -> PR #2883) more in line 57 | * with the original Cody code. 58 | */ 59 | 60 | #include "nmath.h" 61 | #include "dpq.h" 62 | double pnorm5(double x, double mu, double sigma, int lower_tail, int log_p) 63 | { 64 | double p, cp; 65 | 66 | /* Note: The structure of these checks has been carefully thought through. 67 | * For example, if x == mu and sigma == 0, we get the correct answer 1. 68 | */ 69 | #ifdef IEEE_754 70 | if(ISNAN(x) || ISNAN(mu) || ISNAN(sigma)) 71 | return x + mu + sigma; 72 | #endif 73 | if(!R_FINITE(x) && mu == x) return NAN;/* x-mu is NaN */ 74 | if (sigma <= 0) { 75 | if(sigma < 0) return NAN; 76 | /* sigma = 0 : */ 77 | return (x < mu) ? R_DT_0 : R_DT_1; 78 | } 79 | p = (x - mu) / sigma; 80 | if(!R_FINITE(p)) 81 | return (x < mu) ? R_DT_0 : R_DT_1; 82 | x = p; 83 | 84 | pnorm_both(x, &p, &cp, (lower_tail ? 0 : 1), log_p); 85 | 86 | return(lower_tail ? p : cp); 87 | } 88 | 89 | #define SIXTEN 16 /* Cutoff allowing exact "*" and "/" */ 90 | 91 | void pnorm_both(double x, double *cum, double *ccum, int i_tail, int log_p) 92 | { 93 | /* i_tail in {0,1,2} means: "lower", "upper", or "both" : 94 | if(lower) return *cum := P[X <= x] 95 | if(upper) return *ccum := P[X > x] = 1 - P[X <= x] 96 | */ 97 | const static double a[5] = { 98 | 2.2352520354606839287, 99 | 161.02823106855587881, 100 | 1067.6894854603709582, 101 | 18154.981253343561249, 102 | 0.065682337918207449113 103 | }; 104 | const static double b[4] = { 105 | 47.20258190468824187, 106 | 976.09855173777669322, 107 | 10260.932208618978205, 108 | 45507.789335026729956 109 | }; 110 | const static double c[9] = { 111 | 0.39894151208813466764, 112 | 8.8831497943883759412, 113 | 93.506656132177855979, 114 | 597.27027639480026226, 115 | 2494.5375852903726711, 116 | 6848.1904505362823326, 117 | 11602.651437647350124, 118 | 9842.7148383839780218, 119 | 1.0765576773720192317e-8 120 | }; 121 | const static double d[8] = { 122 | 22.266688044328115691, 123 | 235.38790178262499861, 124 | 1519.377599407554805, 125 | 6485.558298266760755, 126 | 18615.571640885098091, 127 | 34900.952721145977266, 128 | 38912.003286093271411, 129 | 19685.429676859990727 130 | }; 131 | const static double p[6] = { 132 | 0.21589853405795699, 133 | 0.1274011611602473639, 134 | 0.022235277870649807, 135 | 0.001421619193227893466, 136 | 2.9112874951168792e-5, 137 | 0.02307344176494017303 138 | }; 139 | const static double q[5] = { 140 | 1.28426009614491121, 141 | 0.468238212480865118, 142 | 0.0659881378689285515, 143 | 0.00378239633202758244, 144 | 7.29751555083966205e-5 145 | }; 146 | 147 | double xden, xnum, temp, del, eps, xsq, y; 148 | #ifdef NO_DENORMS 149 | double min = DBL_MIN; 150 | #endif 151 | int i, lower, upper; 152 | 153 | #ifdef IEEE_754 154 | if(ISNAN(x)) { *cum = *ccum = x; return; } 155 | #endif 156 | 157 | /* Consider changing these : */ 158 | eps = DBL_EPSILON * 0.5; 159 | 160 | /* i_tail in {0,1,2} =^= {lower, upper, both} */ 161 | lower = i_tail != 1; 162 | upper = i_tail != 0; 163 | 164 | y = fabs(x); 165 | if (y <= 0.67448975) { /* qnorm(3/4) = .6744.... -- earlier had 0.66291 */ 166 | if (y > eps) { 167 | xsq = x * x; 168 | xnum = a[4] * xsq; 169 | xden = xsq; 170 | for (i = 0; i < 3; ++i) { 171 | xnum = (xnum + a[i]) * xsq; 172 | xden = (xden + b[i]) * xsq; 173 | } 174 | } else xnum = xden = 0.0; 175 | 176 | temp = x * (xnum + a[3]) / (xden + b[3]); 177 | if(lower) *cum = 0.5 + temp; 178 | if(upper) *ccum = 0.5 - temp; 179 | if(log_p) { 180 | if(lower) *cum = log(*cum); 181 | if(upper) *ccum = log(*ccum); 182 | } 183 | } 184 | else if (y <= M_SQRT_32) { 185 | 186 | /* Evaluate pnorm for 0.674.. = qnorm(3/4) < |x| <= sqrt(32) ~= 5.657 */ 187 | 188 | xnum = c[8] * y; 189 | xden = y; 190 | for (i = 0; i < 7; ++i) { 191 | xnum = (xnum + c[i]) * y; 192 | xden = (xden + d[i]) * y; 193 | } 194 | temp = (xnum + c[7]) / (xden + d[7]); 195 | 196 | #define do_del(X) \ 197 | xsq = trunc(X * SIXTEN) / SIXTEN; \ 198 | del = (X - xsq) * (X + xsq); \ 199 | if(log_p) { \ 200 | *cum = (-xsq * xsq * 0.5) + (-del * 0.5) + log(temp); \ 201 | if((lower && x > 0.) || (upper && x <= 0.)) \ 202 | *ccum = log1p(-exp(-xsq * xsq * 0.5) * \ 203 | exp(-del * 0.5) * temp); \ 204 | } \ 205 | else { \ 206 | *cum = exp(-xsq * xsq * 0.5) * exp(-del * 0.5) * temp; \ 207 | *ccum = 1.0 - *cum; \ 208 | } 209 | 210 | #define swap_tail \ 211 | if (x > 0.) {/* swap ccum <--> cum */ \ 212 | temp = *cum; if(lower) *cum = *ccum; *ccum = temp; \ 213 | } 214 | 215 | do_del(y); 216 | swap_tail; 217 | } 218 | 219 | /* else |x| > sqrt(32) = 5.657 : 220 | * the next two case differentiations were really for lower=T, log=F 221 | * Particularly *not* for log_p ! 222 | 223 | * Cody had (-37.5193 < x && x < 8.2924) ; R originally had y < 50 224 | * 225 | * Note that we do want symmetry(0), lower/upper -> hence use y 226 | */ 227 | else if((log_p && y < 1e170) /* avoid underflow below */ 228 | /* ^^^^^ MM FIXME: can speedup for log_p and much larger |x| ! 229 | * Then, make use of Abramowitz & Stegun, 26.2.13, something like 230 | 231 | xsq = x*x; 232 | 233 | if(xsq * DBL_EPSILON < 1.) 234 | del = (1. - (1. - 5./(xsq+6.)) / (xsq+4.)) / (xsq+2.); 235 | else 236 | del = 0.; 237 | *cum = -.5*xsq - M_LN_SQRT_2PI - log(x) + log1p(-del); 238 | *ccum = log1p(-exp(*cum)); /.* ~ log(1) = 0 *./ 239 | 240 | swap_tail; 241 | 242 | [Yes, but xsq might be infinite.] 243 | 244 | */ 245 | || (lower && -37.5193 < x && x < 8.2924) 246 | || (upper && -8.2924 < x && x < 37.5193) 247 | ) { 248 | 249 | /* Evaluate pnorm for x in (-37.5, -5.657) union (5.657, 37.5) */ 250 | xsq = 1.0 / (x * x); /* (1./x)*(1./x) might be better */ 251 | xnum = p[5] * xsq; 252 | xden = xsq; 253 | for (i = 0; i < 4; ++i) { 254 | xnum = (xnum + p[i]) * xsq; 255 | xden = (xden + q[i]) * xsq; 256 | } 257 | temp = xsq * (xnum + p[4]) / (xden + q[4]); 258 | temp = (M_1_SQRT_2PI - temp) / y; 259 | 260 | do_del(x); 261 | swap_tail; 262 | } else { /* large x such that probs are 0 or 1 */ 263 | if(x > 0) { *cum = R_D__1; *ccum = R_D__0; } 264 | else { *cum = R_D__0; *ccum = R_D__1; } 265 | } 266 | 267 | 268 | #ifdef NO_DENORMS 269 | /* do not return "denormalized" -- we do in R */ 270 | if(log_p) { 271 | if(*cum > -min) *cum = -0.; 272 | if(*ccum > -min)*ccum = -0.; 273 | } 274 | else { 275 | if(*cum < min) *cum = 0.; 276 | if(*ccum < min) *ccum = 0.; 277 | } 278 | #endif 279 | return; 280 | } 281 | --------------------------------------------------------------------------------