diff options
| author | ziejd2 | 2021-03-02 11:17:26 -0600 |
|---|---|---|
| committer | GitHub | 2021-03-02 11:17:26 -0600 |
| commit | a4388f1e8b73ce2f627360ce004da28255aaef7e (patch) | |
| tree | ddc292ba0d09defe159b56fe1c3f108b62f8de03 | |
| parent | 33c4b9f23a53daed3b0a97114d7658015da6a07f (diff) | |
| download | BNW-a4388f1e8b73ce2f627360ce004da28255aaef7e.tar.gz | |
Delete sourcecodes/localscore directory
44 files changed, 0 insertions, 11484 deletions
diff --git a/sourcecodes/localscore/Applic.h b/sourcecodes/localscore/Applic.h deleted file mode 100644 index 0ae5e981..00000000 --- a/sourcecodes/localscore/Applic.h +++ /dev/null @@ -1,291 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1998-2012 Robert Gentleman, Ross Ihaka - * and the R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - * - * - * Application Routines, typically implemented in ../appl/ - * ---------------------------------------------- ======== - */ - -/* This header file contains routines which are in the R API and ones which - are not. - - Those which are not can be used only at the user's risk and may change - or disappear in a future release of R. -*/ - - -#ifndef R_APPLIC_H_ -#define R_APPLIC_H_ - -#include <R_ext/Boolean.h> -#include <R_ext/RS.h> /* F77_... */ -#include <R_ext/BLAS.h> - -#ifdef __cplusplus -extern "C" { -#endif - -/* Entry points in the R API */ - -/* appl/integrate.c */ -typedef void integr_fn(double *x, int n, void *ex); -/* vectorizing function f(x[1:n], ...) -> x[] {overwriting x[]}. */ - -void Rdqags(integr_fn f, void *ex, double *a, double *b, - double *epsabs, double *epsrel, - double *result, double *abserr, int *neval, int *ier, - int *limit, int *lenw, int *last, int *iwork, double *work); - -void Rdqagi(integr_fn f, void *ex, double *bound, int *inf, - double *epsabs, double *epsrel, - double *result, double *abserr, int *neval, int *ier, - int *limit, int *lenw, int *last, - int *iwork, double *work); - -/* main/optim.c */ -typedef double optimfn(int, double *, void *); -typedef void optimgr(int, double *, double *, void *); - -void vmmin(int n, double *b, double *Fmin, - optimfn fn, optimgr gr, int maxit, int trace, - int *mask, double abstol, double reltol, int nREPORT, - void *ex, int *fncount, int *grcount, int *fail); -void nmmin(int n, double *Bvec, double *X, double *Fmin, optimfn fn, - int *fail, double abstol, double intol, void *ex, - double alpha, double bet, double gamm, int trace, - int *fncount, int maxit); -void cgmin(int n, double *Bvec, double *X, double *Fmin, - optimfn fn, optimgr gr, - int *fail, double abstol, double intol, void *ex, - int type, int trace, int *fncount, int *grcount, int maxit); -void lbfgsb(int n, int m, double *x, double *l, double *u, int *nbd, - double *Fmin, optimfn fn, optimgr gr, int *fail, void *ex, - double factr, double pgtol, int *fncount, int *grcount, - int maxit, char *msg, int trace, int nREPORT); -void samin(int n, double *pb, double *yb, optimfn fn, int maxit, - int tmax, double ti, int trace, void *ex); - - - -/* Entry points NOT in the R API */ - -/* appl/bakslv.c : hidden */ -void bakslv(double *, int *, int *, - double *, int *, int *, - double *, int *, int *); - -/* appl/binning.c : hidden */ -void bincode (double *x, int *n, double *breaks, int *nb, - int *code, int *right, int *include_border, int *naok); -void bincount(double *x, int *n, double *breaks, int *nb, int *count, - int *right, int *include_border, int *naok); - -/* appl/ch2inv.f */ -void F77_NAME(ch2inv)(double *x, int *ldx, int *n, double *v, int *info); - -/* appl/chol.f Used in nlme */ -void F77_NAME(chol)(double *a, int *lda, int *n, double *v, int *info); - -/* appl/cpoly.c : hidden */ -void R_cpolyroot(double *opr, double *opi, int *degree, - double *zeror, double *zeroi, Rboolean *fail); -/* More `Complex Polynomial Utilities' could be exported: - - polyev(...) - errev(...) - cpoly_cauchy(...) - cpoly_scale(...) - cdivid(...) -*/ - - -/* appl/cumsum.c : non-API, used in package DCluster */ -void R_cumsum(double *, int *, double *, double *); - -/* appl/eigen.f */ -int F77_NAME(cg)(int *nm, int *n, double *ar, double *ai, - double *wr, double *wi, int *matz, double *zr, double *zi, - double *fv1, double *fv2, double *fv3, int *ierr); -int F77_NAME(ch)(int *nm, int *n, double *ar, double *ai, - double *w, int *matz, double *zr, double *zi, - double *fv1, double *fv2, double *fm1, int *ierr); -int F77_NAME(rg)(int *nm, int *n, double *a, double *wr, double *wi, - int *matz, double *z, int *iv1, double *fv1, int *ierr); -/* used in nlme */ -int F77_NAME(rs)(int *nm, int *n, double *a, double *w, - int *matz, double *z, double *fv1, double *fv2, int *ierr); - -/* appl/fft.c */ -/* NOTE: The following functions use GLOBAL (static) variables !! - * ---- some of R-core think that this should be changed, - * which will INEVITABLY extend the argument lists ...! - */ -/* non-API, but used by package RandomFields */ -void fft_factor(int n, int *pmaxf, int *pmaxp); -Rboolean fft_work(double *a, double *b, int nseg, int n, int nspn, -/* TRUE: success */ int isn, double *work, int *iwork); - -/* appl/fmin.c : */ -double Brent_fmin(double ax, double bx, double (*f)(double, void *), - void *info, double tol); - -/* appl/interv.c: also in Utils.h */ -/* used in packages gam and mda */ -int F77_SUB(interv)(double *xt, int *n, double *x, - Rboolean *rightmost_closed, Rboolean *all_inside, - int *ilo, int *mflag); -/* Non-API No longer used */ -void find_interv_vec(double *xt, int *n, double *x, int *nx, - int *rightmost_closed, int *all_inside, int *indx); -/* API, used in package eco */ -int findInterval(double *xt, int n, double x, - Rboolean rightmost_closed, Rboolean all_inside, int ilo, - int *mflag); - -/* appl/lbfgsb.c */ -void setulb(int n, int m, double *x, double *l, double *u, int *nbd, - double *f, double *g, double factr, double *pgtol, - double *wa, int * iwa, char *task, int iprint, - int *lsave, int *isave, double *dsave); - -/* appl/machar.c */ -void machar(int *ibeta, int *it, int *irnd, int *ngrd, int *machep, - int *negep, int *iexp, int *minexp, int *maxexp, - double *eps, double *epsneg, double *xmin, double *xmax); - -/* appl/maxcol.c: also in Utils.h Used in package MNP */ -void R_max_col(double *matrix, int *nr, int *nc, int *maxes, int *ties_meth); - - -/* appl/pretty.c */ -double R_pretty0(double *lo, double *up, int *ndiv, int min_n, - double shrink_sml, double high_u_fact[], - int eps_correction, int return_bounds); -void R_pretty(double *lo, double *up, int *ndiv, int *min_n, - double *shrink_sml, double *high_u_fact, - int *eps_correction); - -/* appl/rcont.c: API prior to R 2.15.2 */ -void rcont2(int *nrow, int *ncol, int *nrowt, int *ncolt, int *ntotal, - double *fact, int *jwork, int *matrix); - -/* appl/rowsum.c */ -void R_rowsum(int *dim, double *na_x, double *x, double *group); - -/* appl/stem.c */ -Rboolean stemleaf(double *x, int *n, double *scale, int *width, double *atom); - -/* appl/strsignif.c */ -void str_signif(char *x, int *n, const char **type, int *width, int *digits, - const char **format, const char **flag, char **result); - -/* appl/tabulate.c : non-API, used in package ape, phangorn, pcaPA */ -void R_tabulate(int *x, int *n, int *nbin, int *ans); - -/* appl/uncmin.c : */ - -/* type of pointer to the target and gradient functions */ -typedef void (*fcn_p)(int, double *, double *, void *); - -/* type of pointer to the hessian functions */ -typedef void (*d2fcn_p)(int, int, double *, double *, void *); - -void fdhess(int n, double *x, double fval, fcn_p fun, void *state, - double *h, int nfd, double *step, double *f, int ndigit, - double *typx); - -/* used in nlme */ -void optif9(int nr, int n, double *x, - fcn_p fcn, fcn_p d1fcn, d2fcn_p d2fcn, - void *state, double *typsiz, double fscale, int method, - int iexp, int *msg, int ndigit, int itnlim, int iagflg, - int iahflg, double dlt, double gradtl, double stepmx, - double steptl, double *xpls, double *fpls, double *gpls, - int *itrmcd, double *a, double *wrk, int *itncnt); - -void optif0(int nr, int n, double *x, fcn_p fcn, void *state, - double *xpls, double *fpls, double *gpls, int *itrmcd, - double *a, double *wrk); - -/* appl/zeroin.c : non API, but used in package qtl */ -double R_zeroin(double ax, double bx, double (*f)(double, void *), void *info, - double *Tol, int *Maxit); -/* R_zeroin2() is faster for "expensive" f(), in those typical cases where - * f(ax) and f(bx) are available anyway : */ -double R_zeroin2(double ax, double bx, double fa, double fb, - double (*f)(double, void *), void *info, double *Tol, int *Maxit); - - -/* ALL appl/<foobar>.f [semi-automatically by - * f2c -A -P *.f; cat *.P > all.h and editing] - */ - -/* This is not in the applications but in the BLAS, and defined in Lapack.h -extern int F77_NAME(lsame)(const char *, const char *); -*/ - -/* LINPACK routines also declared in Linpack.h -void F77_NAME(dpoco)(double *a, int *lda, int *n, double *rcond, - double *z__, int *info); -void F77_NAME(dpodi)(double *a, int *lda, int *n, double *det, int *job); -void F77_NAME(dpofa)(double *a, int *lda, int *n, int *info); -void F77_NAME(dposl)(double *a, int *lda, int *n, double *b); -void F77_NAME(dqrdc)(double *x, int *ldx, int *n, int *p, - double *qraux, int *jpvt, double *work, int *job); -void F77_NAME(dqrsl)(double *x, int *ldx, int *n, int *k, - double *qraux, double *y, - double *qy, double *qty, double *b, - double *rsd, double *xb, int *job, int *info); -void F77_NAME(dsvdc)(double *x, int *ldx, int *n, int *p, - double *s, double *e, - double *u, int *ldu, double *v, int *ldv, - double *work, int *job, int *info); -void F77_NAME(dtrco)(double *t, int *ldt, int *n, double *rcond, - double *z__, int *job); -void F77_NAME(dtrsl)(double *t, int *ldt, int *n, double *b, int *job, - int *info); -*/ - -/* find qr decomposition, dqrdc2() is basis of R's qr(), also used by nlme */ -void F77_NAME(dqrdc2)(double *x, int *ldx, int *n, int *p, - double *tol, int *rank, - double *qraux, int *pivot, double *work); -void F77_NAME(dqrls)(double *x, int *n, int *p, double *y, int *ny, - double *tol, double *b, double *rsd, - double *qty, int *k, - int *jpvt, double *qraux, double *work); - -/* appl/dqrutl.f: interfaces to dqrsl */ -void F77_NAME(dqrqty)(double *x, int *n, int *k, double *qraux, - double *y, int *ny, double *qty); -void F77_NAME(dqrqy)(double *x, int *n, int *k, double *qraux, - double *y, int *ny, double *qy); -void F77_NAME(dqrcf)(double *x, int *n, int *k, double *qraux, - double *y, int *ny, double *b, int *info); -void F77_NAME(dqrrsd)(double *x, int *n, int *k, double *qraux, - double *y, int *ny, double *rsd); -void F77_NAME(dqrxb)(double *x, int *n, int *k, double *qraux, - double *y, int *ny, double *xb); - - -#ifdef __cplusplus -} -#endif - -#endif /* R_APPLIC_H_ */ diff --git a/sourcecodes/localscore/Arith.h b/sourcecodes/localscore/Arith.h deleted file mode 100644 index 4a0030f1..00000000 --- a/sourcecodes/localscore/Arith.h +++ /dev/null @@ -1,87 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka - * Copyright (C) 1998--2007 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* Included by R.h: API */ - -#ifndef R_ARITH_H_ -#define R_ARITH_H_ - -/* Only for use where config.h has not already been included */ -#if defined(HAVE_GLIBC2) && !defined(_BSD_SOURCE) -/* ensure that finite and isnan are declared */ -# define _BSD_SOURCE 1 -#endif - -#include "libextern.h" -#ifdef __cplusplus -extern "C" { -#elif !defined(NO_C_HEADERS) -/* needed for isnan and isfinite, neither of which are used under C++ */ -# include <math.h> -#endif - -/* implementation of these : ../../main/arithmetic.c */ -LibExtern double R_NaN; /* IEEE NaN */ -LibExtern double R_PosInf; /* IEEE Inf */ -LibExtern double R_NegInf; /* IEEE -Inf */ -LibExtern double R_NaReal; /* NA_REAL: IEEE */ -LibExtern int R_NaInt; /* NA_INTEGER:= INT_MIN currently */ -#ifdef __MAIN__ -#undef extern -#undef LibExtern -#endif - -#define NA_LOGICAL R_NaInt -#define NA_INTEGER R_NaInt -/* #define NA_FACTOR R_NaInt unused */ -#define NA_REAL R_NaReal -/* NA_STRING is a SEXP, so defined in Rinternals.h */ - -int R_IsNA(double); /* True for R's NA only */ -int R_IsNaN(double); /* True for special NaN, *not* for NA */ -int R_finite(double); /* True if none of NA, NaN, +/-Inf */ -#define ISNA(x) R_IsNA(x) - -/* ISNAN(): True for *both* NA and NaN. - NOTE: some systems do not return 1 for TRUE. - Also note that C++ math headers specifically undefine - isnan if it is a macro (it is on OS X and in C99), - hence the workaround. This code also appears in Rmath.h -*/ -#ifdef __cplusplus - int R_isnancpp(double); /* in arithmetic.c */ -# define ISNAN(x) R_isnancpp(x) -#else -# define ISNAN(x) (isnan(x)!=0) -#endif - -/* The following is only defined inside R */ -#ifdef HAVE_WORKING_ISFINITE -/* isfinite is defined in <math.h> according to C99 */ -# define R_FINITE(x) isfinite(x) -#else -# define R_FINITE(x) R_finite(x) -#endif - -#ifdef __cplusplus -} -#endif - -#endif /* R_ARITH_H_ */ diff --git a/sourcecodes/localscore/BLAS.h b/sourcecodes/localscore/BLAS.h deleted file mode 100644 index 98c192e9..00000000 --- a/sourcecodes/localscore/BLAS.h +++ /dev/null @@ -1,382 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2003-12 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* - C declarations of BLAS Fortran subroutines always available in R. - - Part of the API. - - R packages that use these should have PKG_LIBS in src/Makevars include - $(BLAS_LIBS) $(FLIBS) - */ - -/* Part of the API */ - -#ifndef R_BLAS_H -#define R_BLAS_H - -#include <R_ext/RS.h> /* for F77_... */ -#include <R_ext/Complex.h> /* for Rcomplex */ - -#ifdef __cplusplus -extern "C" { -#endif - -// never defined in R itself. -#ifndef BLAS_extern -#define BLAS_extern extern -#endif - -/* Double Precision Level 1 BLAS */ - -BLAS_extern double /* DASUM - sum of absolute values of a one-dimensional array */ -F77_NAME(dasum)(const int *n, const double *dx, const int *incx); -BLAS_extern void /* DAXPY - replace y by alpha*x + y */ -F77_NAME(daxpy)(const int *n, const double *alpha, - const double *dx, const int *incx, - double *dy, const int *incy); -BLAS_extern void /* DCOPY - copy x to y */ -F77_NAME(dcopy)(const int *n, const double *dx, const int *incx, - double *dy, const int *incy); -BLAS_extern double /* DDOT - inner product of x and y */ -F77_NAME(ddot)(const int *n, const double *dx, const int *incx, - const double *dy, const int *incy); -BLAS_extern double /* DNRM2 - 2-norm of a vector */ -F77_NAME(dnrm2)(const int *n, const double *dx, const int *incx); -BLAS_extern void /* DROT - apply a Given's rotation */ -F77_NAME(drot)(const int *n, double *dx, const int *incx, - double *dy, const int *incy, const double *c, const double *s); -BLAS_extern void /* DROTG - generate a Given's rotation */ -F77_NAME(drotg)(const double *a, const double *b, double *c, double *s); -BLAS_extern void /* DROTM - apply a modified Given's rotation */ -F77_NAME(drotm)(const int *n, double *dx, const int *incx, - double *dy, const int *incy, const double *dparam); -BLAS_extern void /* DROTMG - generate a modified Given's rotation */ -F77_NAME(drotmg)(const double *dd1, const double *dd2, const double *dx1, - const double *dy1, double *param); -BLAS_extern void /* DSCAL - scale a one-dimensional array */ -F77_NAME(dscal)(const int *n, const double *alpha, double *dx, const int *incx); -BLAS_extern void /* DSWAP - interchange one-dimensional arrays */ -F77_NAME(dswap)(const int *n, double *dx, const int *incx, - double *dy, const int *incy); -BLAS_extern int /* IDAMAX - return the index of the element with max abs value */ -F77_NAME(idamax)(const int *n, const double *dx, const int *incx); - -/* Double Precision Level 2 BLAS */ - -/* DGBMV - perform one of the matrix-vector operations */ -/* y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, */ -BLAS_extern void -F77_NAME(dgbmv)(const char *trans, const int *m, const int *n, - const int *kl,const int *ku, - const double *alpha, const double *a, const int *lda, - const double *x, const int *incx, - const double *beta, double *y, const int *incy); -/* DGEMV - perform one of the matrix-vector operations */ -/* y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, */ -BLAS_extern void -F77_NAME(dgemv)(const char *trans, const int *m, const int *n, - const double *alpha, const double *a, const int *lda, - const double *x, const int *incx, const double *beta, - double *y, const int *incy); -/* DSBMV - perform the matrix-vector operation */ -/* y := alpha*A*x + beta*y, */ -BLAS_extern void -F77_NAME(dsbmv)(const char *uplo, const int *n, const int *k, - const double *alpha, const double *a, const int *lda, - const double *x, const int *incx, - const double *beta, double *y, const int *incy); -/* DSPMV - perform the matrix-vector operation */ -/* y := alpha*A*x + beta*y, */ -BLAS_extern void -F77_NAME(dspmv)(const char *uplo, const int *n, - const double *alpha, const double *ap, - const double *x, const int *incx, - const double *beta, double *y, const int *incy); - -/* DSYMV - perform the matrix-vector operation */ -/* y := alpha*A*x + beta*y, */ -BLAS_extern void -F77_NAME(dsymv)(const char *uplo, const int *n, const double *alpha, - const double *a, const int *lda, - const double *x, const int *incx, - const double *beta, double *y, const int *incy); -/* DTBMV - perform one of the matrix-vector operations */ -/* x := A*x, or x := A'*x, */ -BLAS_extern void -F77_NAME(dtbmv)(const char *uplo, const char *trans, - const char *diag, const int *n, const int *k, - const double *a, const int *lda, - double *x, const int *incx); -/* DTPMV - perform one of the matrix-vector operations */ -/* x := A*x, or x := A'*x, */ -BLAS_extern void -F77_NAME(dtpmv)(const char *uplo, const char *trans, const char *diag, - const int *n, const double *ap, - double *x, const int *incx); -/* DTRMV - perform one of the matrix-vector operations */ -/* x := A*x, or x := A'*x, */ -BLAS_extern void -F77_NAME(dtrmv)(const char *uplo, const char *trans, const char *diag, - const int *n, const double *a, const int *lda, - double *x, const int *incx); -/* DTBSV - solve one of the systems of equations */ -/* A*x = b, or A'*x = b, */ -BLAS_extern void -F77_NAME(dtbsv)(const char *uplo, const char *trans, - const char *diag, const int *n, const int *k, - const double *a, const int *lda, - double *x, const int *incx); -/* DTPSV - solve one of the systems of equations */ -/* A*x = b, or A'*x = b, */ -BLAS_extern void -F77_NAME(dtpsv)(const char *uplo, const char *trans, - const char *diag, const int *n, - const double *ap, double *x, const int *incx); -/* DTRSV - solve one of the systems of equations */ -/* A*x = b, or A'*x = b, */ -BLAS_extern void -F77_NAME(dtrsv)(const char *uplo, const char *trans, - const char *diag, const int *n, - const double *a, const int *lda, - double *x, const int *incx); -/* DGER - perform the rank 1 operation A := alpha*x*y' + A */ -BLAS_extern void -F77_NAME(dger)(const int *m, const int *n, const double *alpha, - const double *x, const int *incx, - const double *y, const int *incy, - double *a, const int *lda); -/* DSYR - perform the symmetric rank 1 operation A := alpha*x*x' + A */ -BLAS_extern void -F77_NAME(dsyr)(const char *uplo, const int *n, const double *alpha, - const double *x, const int *incx, - double *a, const int *lda); -/* DSPR - perform the symmetric rank 1 operation A := alpha*x*x' + A */ -BLAS_extern void -F77_NAME(dspr)(const char *uplo, const int *n, const double *alpha, - const double *x, const int *incx, double *ap); -/* DSYR2 - perform the symmetric rank 2 operation */ -/* A := alpha*x*y' + alpha*y*x' + A, */ -BLAS_extern void -F77_NAME(dsyr2)(const char *uplo, const int *n, const double *alpha, - const double *x, const int *incx, - const double *y, const int *incy, - double *a, const int *lda); -/* DSPR2 - perform the symmetric rank 2 operation */ -/* A := alpha*x*y' + alpha*y*x' + A, */ -BLAS_extern void -F77_NAME(dspr2)(const char *uplo, const int *n, const double *alpha, - const double *x, const int *incx, - const double *y, const int *incy, double *ap); - -/* Double Precision Level 3 BLAS */ - -/* DGEMM - perform one of the matrix-matrix operations */ -/* C := alpha*op( A )*op( B ) + beta*C */ -BLAS_extern void -F77_NAME(dgemm)(const char *transa, const char *transb, const int *m, - const int *n, const int *k, const double *alpha, - const double *a, const int *lda, - const double *b, const int *ldb, - const double *beta, double *c, const int *ldc); -/* DTRSM - solve one of the matrix equations */ -/* op(A)*X = alpha*B, or X*op(A) = alpha*B */ -BLAS_extern void -F77_NAME(dtrsm)(const char *side, const char *uplo, - const char *transa, const char *diag, - const int *m, const int *n, const double *alpha, - const double *a, const int *lda, - double *b, const int *ldb); -/* DTRMM - perform one of the matrix-matrix operations */ -/* B := alpha*op( A )*B, or B := alpha*B*op( A ) */ -BLAS_extern void -F77_NAME(dtrmm)(const char *side, const char *uplo, const char *transa, - const char *diag, const int *m, const int *n, - const double *alpha, const double *a, const int *lda, - double *b, const int *ldb); -/* DSYMM - perform one of the matrix-matrix operations */ -/* C := alpha*A*B + beta*C, */ -BLAS_extern void -F77_NAME(dsymm)(const char *side, const char *uplo, const int *m, - const int *n, const double *alpha, - const double *a, const int *lda, - const double *b, const int *ldb, - const double *beta, double *c, const int *ldc); -/* DSYRK - perform one of the symmetric rank k operations */ -/* C := alpha*A*A' + beta*C or C := alpha*A'*A + beta*C */ -BLAS_extern void -F77_NAME(dsyrk)(const char *uplo, const char *trans, - const int *n, const int *k, - const double *alpha, const double *a, const int *lda, - const double *beta, double *c, const int *ldc); -/* DSYR2K - perform one of the symmetric rank 2k operations */ -/* C := alpha*A*B' + alpha*B*A' + beta*C or */ -/* C := alpha*A'*B + alpha*B'*A + beta*C */ -BLAS_extern void -F77_NAME(dsyr2k)(const char *uplo, const char *trans, - const int *n, const int *k, - const double *alpha, const double *a, const int *lda, - const double *b, const int *ldb, - const double *beta, double *c, const int *ldc); -/* - LSAME is a LAPACK support routine, not part of BLAS -*/ - -/* Double complex BLAS routines added for 2.3.0 */ -/* #ifdef HAVE_FORTRAN_DOUBLE_COMPLEX */ - BLAS_extern double - F77_NAME(dcabs1)(double *z); - BLAS_extern double - F77_NAME(dzasum)(int *n, Rcomplex *zx, int *incx); - BLAS_extern double - F77_NAME(dznrm2)(int *n, Rcomplex *x, int *incx); - BLAS_extern int - F77_NAME(izamax)(int *n, Rcomplex *zx, int *incx); - BLAS_extern void - F77_NAME(zaxpy)(int *n, Rcomplex *za, Rcomplex *zx, - int *incx, Rcomplex *zy, int *incy); - BLAS_extern void - F77_NAME(zcopy)(int *n, Rcomplex *zx, int *incx, - Rcomplex *zy, int *incy); - - /* WARNING! The next two return a value that may not be - compatible between C and Fortran, and even if it is, this might - not be the right translation to C. Only use after - configure-testing with your compilers. - */ - BLAS_extern Rcomplex - F77_NAME(zdotc)(int *n, - Rcomplex *zx, int *incx, Rcomplex *zy, int *incy); - BLAS_extern Rcomplex - F77_NAME(zdotu)(int *n, - Rcomplex *zx, int *incx, Rcomplex *zy, int *incy); - - BLAS_extern void - F77_NAME(zdrot)(int *n, Rcomplex *zx, int *incx, Rcomplex *zy, - int *incy, double *c, double *s); - BLAS_extern void - F77_NAME(zdscal)(int *n, double *da, Rcomplex *zx, int *incx); - BLAS_extern void - F77_NAME(zgbmv)(char *trans, int *m, int *n, int *kl, - int *ku, Rcomplex *alpha, Rcomplex *a, int *lda, - Rcomplex *x, int *incx, Rcomplex *beta, Rcomplex *y, - int *incy); - BLAS_extern void - F77_NAME(zgemm)(const char *transa, const char *transb, const int *m, - const int *n, const int *k, const Rcomplex *alpha, - const Rcomplex *a, const int *lda, - const Rcomplex *b, const int *ldb, - const Rcomplex *beta, Rcomplex *c, const int *ldc); - BLAS_extern void - F77_NAME(zgemv)(char *trans, int *m, int *n, Rcomplex *alpha, - Rcomplex *a, int *lda, Rcomplex *x, int *incx, - Rcomplex *beta, Rcomplex *y, int * incy); - BLAS_extern void - F77_NAME(zgerc)(int *m, int *n, Rcomplex *alpha, Rcomplex *x, - int *incx, Rcomplex *y, int *incy, Rcomplex *a, int *lda); - BLAS_extern void - F77_NAME(zgeru)(int *m, int *n, Rcomplex *alpha, Rcomplex *x, - int *incx, Rcomplex *y, int *incy, Rcomplex *a, int *lda); - BLAS_extern void - F77_NAME(zhbmv)(char *uplo, int *n, int *k, Rcomplex *alpha, - Rcomplex *a, int *lda, Rcomplex *x, int *incx, - Rcomplex *beta, Rcomplex *y, int *incy); - BLAS_extern void - F77_NAME(zhemm)(char *side, char *uplo, int *m, int *n, - Rcomplex *alpha, Rcomplex *a, int *lda, Rcomplex *b, - int *ldb, Rcomplex *beta, Rcomplex *c, int *ldc); - BLAS_extern void - F77_NAME(zhemv)(char *uplo, int *n, Rcomplex *alpha, Rcomplex *a, - int *lda, Rcomplex *x, int *incx, Rcomplex *beta, - Rcomplex *y, int *incy); - BLAS_extern void - F77_NAME(zher)(char *uplo, int *n, double *alpha, Rcomplex *x, - int *incx, Rcomplex *a, int *lda); - BLAS_extern void - F77_NAME(zher2)(char *uplo, int *n, Rcomplex *alpha, Rcomplex *x, - int *incx, Rcomplex *y, int *incy, Rcomplex *a, int *lda); - BLAS_extern void - F77_NAME(zher2k)(char *uplo, char *trans, int *n, int *k, - Rcomplex *alpha, Rcomplex *a, int *lda, Rcomplex *b, - int *ldb, double *beta, Rcomplex *c, int *ldc); - BLAS_extern void - F77_NAME(zherk)(char *uplo, char *trans, int *n, int *k, - double *alpha, Rcomplex *a, int *lda, double *beta, - Rcomplex *c, int *ldc); - BLAS_extern void - F77_NAME(zhpmv)(char *uplo, int *n, Rcomplex *alpha, Rcomplex *ap, - Rcomplex *x, int *incx, Rcomplex * beta, Rcomplex *y, - int *incy); - BLAS_extern void - F77_NAME(zhpr)(char *uplo, int *n, double *alpha, - Rcomplex *x, int *incx, Rcomplex *ap); - BLAS_extern void - F77_NAME(zhpr2)(char *uplo, int *n, Rcomplex *alpha, Rcomplex *x, - int *incx, Rcomplex *y, int *incy, Rcomplex *ap); - BLAS_extern void - F77_NAME(zrotg)(Rcomplex *ca, Rcomplex *cb, double *c, Rcomplex *s); - BLAS_extern void - F77_NAME(zscal)(int *n, Rcomplex *za, Rcomplex *zx, int *incx); - BLAS_extern void - F77_NAME(zswap)(int *n, Rcomplex *zx, int *incx, Rcomplex *zy, int *incy); - BLAS_extern void - F77_NAME(zsymm)(char *side, char *uplo, int *m, int *n, - Rcomplex *alpha, Rcomplex *a, int *lda, Rcomplex *b, - int *ldb, Rcomplex *beta, Rcomplex *c, int *ldc); - BLAS_extern void - F77_NAME(zsyr2k)(char *uplo, char *trans, int *n, int *k, - Rcomplex *alpha, Rcomplex *a, int *lda, Rcomplex *b, - int *ldb, Rcomplex *beta, Rcomplex *c, int *ldc); - BLAS_extern void - F77_NAME(zsyrk)(char *uplo, char *trans, int *n, int *k, - Rcomplex *alpha, Rcomplex *a, int *lda, - Rcomplex *beta, Rcomplex *c, int *ldc); - BLAS_extern void - F77_NAME(ztbmv)(char *uplo, char *trans, char *diag, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *x, int *incx); - BLAS_extern void - F77_NAME(ztbsv)(char *uplo, char *trans, char *diag, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *x, int *incx); - BLAS_extern void - F77_NAME(ztpmv)(char *uplo, char *trans, char *diag, int *n, - Rcomplex *ap, Rcomplex *x, int *incx); - BLAS_extern void - F77_NAME(ztpsv)(char *uplo, char *trans, char *diag, int *n, - Rcomplex *ap, Rcomplex *x, int *incx); - BLAS_extern void - F77_NAME(ztrmm)(char *side, char *uplo, char *transa, char *diag, - int *m, int *n, Rcomplex *alpha, Rcomplex *a, - int *lda, Rcomplex *b, int *ldb); - BLAS_extern void - F77_NAME(ztrmv)(char *uplo, char *trans, char *diag, int *n, - Rcomplex *a, int *lda, Rcomplex *x, int *incx); - BLAS_extern void - F77_NAME(ztrsm)(char *side, char *uplo, char *transa, char *diag, - int *m, int *n, Rcomplex *alpha, Rcomplex *a, - int *lda, Rcomplex *b, int *ldb); - BLAS_extern void - F77_NAME(ztrsv)(char *uplo, char *trans, char *diag, int *n, - Rcomplex *a, int *lda, Rcomplex *x, int *incx); -/* #endif */ - -#ifdef __cplusplus -} -#endif - -#endif /* R_BLAS_H */ diff --git a/sourcecodes/localscore/Boolean.h b/sourcecodes/localscore/Boolean.h deleted file mode 100644 index ea855a29..00000000 --- a/sourcecodes/localscore/Boolean.h +++ /dev/null @@ -1,37 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2000, 2001 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* Included by R.h: API */ - -#ifndef R_EXT_BOOLEAN_H_ -#define R_EXT_BOOLEAN_H_ - -#undef FALSE -#undef TRUE - -#ifdef __cplusplus -extern "C" { -#endif -typedef enum { FALSE = 0, TRUE /*, MAYBE */ } Rboolean; - -#ifdef __cplusplus -} -#endif - -#endif /* R_EXT_BOOLEAN_H_ */ diff --git a/sourcecodes/localscore/Callbacks.h b/sourcecodes/localscore/Callbacks.h deleted file mode 100644 index cb1d64ca..00000000 --- a/sourcecodes/localscore/Callbacks.h +++ /dev/null @@ -1,116 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2001-2 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* - Not part of the API, subject to change at any time. -*/ - -#ifndef R_CALLBACKS_H -#define R_CALLBACKS_H - -/** - These structures are for C (and R function) top-level task handlers. - Such routines are called at the end of every (successful) top-level task - in the regular REPL. - */ - -#include <Rinternals.h> -/** - The signature of the C routine that a callback must implement. - expr - the expression for the top-level task that was evaluated. - value - the result of the top-level task, i.e. evaluating expr. - succeeded - a logical value indicating whether the task completed propertly. - visible - a logical value indicating whether the result was printed to the R ``console''/stdout. - data - user-level data passed to the registration routine. - */ -typedef Rboolean (*R_ToplevelCallback)(SEXP expr, SEXP value, Rboolean succeeded, Rboolean visible, void *); - -typedef struct _ToplevelCallback R_ToplevelCallbackEl; -/** - Linked list element for storing the top-level task callbacks. - */ -struct _ToplevelCallback { - R_ToplevelCallback cb; /* the C routine to call. */ - void *data; /* the user-level data to pass to the call to cb() */ - void (*finalizer)(void *data); /* Called when the callback is removed. */ - - char *name; /* a name by which to identify this element. */ - - R_ToplevelCallbackEl *next; /* the next element in the linked list. */ -}; - -#ifdef __cplusplus -extern "C" { -#endif - -Rboolean Rf_removeTaskCallbackByIndex(int id); -Rboolean Rf_removeTaskCallbackByName(const char *name); -SEXP R_removeTaskCallback(SEXP which); -R_ToplevelCallbackEl* Rf_addTaskCallback(R_ToplevelCallback cb, void *data, void (*finalizer)(void *), const char *name, int *pos); - - - -/* - The following definitions are for callbacks to R functions and - methods related to user-level tables. This was implemented in a - separate package on Omegahat and these declarations allow the package - to interface to the internal R code. - - See http://developer.r-project.org/RObjectTables.pdf, - http://www.omegahat.org/RObjectTables/ -*/ - -typedef struct _R_ObjectTable R_ObjectTable; - -/* Do we actually need the exists() since it is never called but R - uses get to see if the symbol is bound to anything? */ -typedef Rboolean (*Rdb_exists)(const char * const name, Rboolean *canCache, R_ObjectTable *); -typedef SEXP (*Rdb_get)(const char * const name, Rboolean *canCache, R_ObjectTable *); -typedef int (*Rdb_remove)(const char * const name, R_ObjectTable *); -typedef SEXP (*Rdb_assign)(const char * const name, SEXP value, R_ObjectTable *); -typedef SEXP (*Rdb_objects)(R_ObjectTable *); -typedef Rboolean (*Rdb_canCache)(const char * const name, R_ObjectTable *); - -typedef void (*Rdb_onDetach)(R_ObjectTable *); -typedef void (*Rdb_onAttach)(R_ObjectTable *); - -struct _R_ObjectTable{ - int type; - char **cachedNames; - Rboolean active; - - Rdb_exists exists; - Rdb_get get; - Rdb_remove remove; - Rdb_assign assign; - Rdb_objects objects; - Rdb_canCache canCache; - - Rdb_onDetach onDetach; - Rdb_onAttach onAttach; - - void *privateData; -}; - - -#ifdef __cplusplus -} -#endif - -#endif /* R_CALLBACKS_H */ diff --git a/sourcecodes/localscore/Complex.h b/sourcecodes/localscore/Complex.h deleted file mode 100644 index 06417a71..00000000 --- a/sourcecodes/localscore/Complex.h +++ /dev/null @@ -1,38 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1998-2001 The R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* Included by R.h: API */ - -#ifndef R_COMPLEX_H -#define R_COMPLEX_H - -#ifdef __cplusplus -extern "C" { -#endif - -typedef struct { - double r; - double i; -} Rcomplex; - -#ifdef __cplusplus -} -#endif - -#endif /* R_COMPLEX_H */ diff --git a/sourcecodes/localscore/Constants.h b/sourcecodes/localscore/Constants.h deleted file mode 100644 index 08e3d158..00000000 --- a/sourcecodes/localscore/Constants.h +++ /dev/null @@ -1,44 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka - * Copyright (C) 1998-2012 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* Included by R.h: API */ - -#ifndef R_EXT_CONSTANTS_H_ -#define R_EXT_CONSTANTS_H_ - -/* usually in math.h, but not with strict C99 compliance */ -#ifndef M_PI -#define M_PI 3.141592653589793238462643383279502884197169399375 -#endif - -#ifndef STRICT_R_HEADERS -#define PI M_PI -#include <float.h> /* Defines the rest, at least in C99 */ -#define SINGLE_EPS FLT_EPSILON -#define SINGLE_BASE FLT_RADIX -#define SINGLE_XMIN FLT_MIN -#define SINGLE_XMAX FLT_MAX -#define DOUBLE_DIGITS DBL_MANT_DIG -#define DOUBLE_EPS DBL_EPSILON -#define DOUBLE_XMAX DBL_MAX -#define DOUBLE_XMIN DBL_MIN -#endif - -#endif /* R_EXT_CONSTANTS_H_ */ diff --git a/sourcecodes/localscore/Error.h b/sourcecodes/localscore/Error.h deleted file mode 100644 index 1a8905c6..00000000 --- a/sourcecodes/localscore/Error.h +++ /dev/null @@ -1,46 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1998-2005 The R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* Included by R.h: API */ - -#ifndef R_ERROR_H_ -#define R_ERROR_H_ - -#ifdef __cplusplus -extern "C" { -#endif - -void Rf_error(const char *, ...); -void Rf_warning(const char *, ...); -void WrongArgCount(const char *); -void UNIMPLEMENTED(const char *); -void R_ShowMessage(const char *s); - - -#ifdef __cplusplus -} -#endif - -#ifndef R_NO_REMAP -#define error Rf_error -#define warning Rf_warning -#endif - - -#endif /* R_ERROR_H_ */ diff --git a/sourcecodes/localscore/GetX11Image.h b/sourcecodes/localscore/GetX11Image.h deleted file mode 100644 index a7181fa3..00000000 --- a/sourcecodes/localscore/GetX11Image.h +++ /dev/null @@ -1,36 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2003 R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -#ifndef GETX11IMAGE_H_ -#define GETX11IMAGE_H_ - -#ifdef __cplusplus -extern "C" { -#endif - -/* used by package tkrplot */ - -Rboolean R_GetX11Image(int d, void *pximage, int *pwidth, int *pheight); -/* pximage is really (XImage **) */ - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/sourcecodes/localscore/GraphicsDevice.h b/sourcecodes/localscore/GraphicsDevice.h deleted file mode 100644 index 10851b26..00000000 --- a/sourcecodes/localscore/GraphicsDevice.h +++ /dev/null @@ -1,863 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2001-11 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* Used by third-party graphics devices. - * - * This defines DevDesc, whereas GraphicsEngine.h defines GEDevDesc. - * Also contains entry points from gevents.c - */ - -#ifndef R_GRAPHICSDEVICE_H_ -#define R_GRAPHICSDEVICE_H_ - - -/* ideally we would use prototypes in DevDesc. - Some devices have taken to passing pointers to their own structure - instead of DevDesc* , defining R_USE_PROTOTYPES 0 allows them to - opt out. -*/ - -#ifndef R_USE_PROTOTYPES -# define R_USE_PROTOTYPES 1 -# ifndef R_GRAPHICSENGINE_H_ -# error R_ext/GraphicsEngine.h must be included first, and includes this header -# endif -#endif - -#include <R_ext/Boolean.h> - -#ifdef __cplusplus -extern "C" { -#endif - -/* --------- New (in 1.4.0) device driver structure --------- - * NOTES: - * 1. All locations and dimensions are in device coordinates. - * 2. I found this comment in the doc for dev_Open -- looks nasty - * Any known instances of such a thing happening? Should be - * replaced by a function to query the device for preferred gpars - * settings? (to be called when the device is initialised) - * - * NOTE that it is perfectly acceptable for this - * function to set generic graphics parameters too - * (i.e., override the generic parameter settings - * which GInit sets up) all at the author's own risk - * of course :) - * - * 3. Do we really need dev_StrWidth as well as dev_MetricInfo? - * I can see the difference between the two -- its just a - * question of whether dev_MetricInfo should just return - * what dev_StrWidth would give if font metric information is - * not available. I guess having both allows the developer - * to decide when to ask for which sort of value, and to decide - * what to do when font metric information is not available. - * And why not a dev_StrHeight? - * 4. Should "ipr", "asp", and "cra" be in the device description? - * If not, then where? - * I guess they don't need to be if no device makes use of them. - * On the other hand, they would need to be replaced by a device - * call that R base graphics could use to get enough information - * to figure them out. (e.g., some sort of dpi() function to - * complement the size() function.) - */ - -typedef struct _DevDesc DevDesc; -typedef DevDesc* pDevDesc; - -struct _DevDesc { - /******************************************************** - * Device physical characteristics - ********************************************************/ - double left; /* left raster coordinate */ - double right; /* right raster coordinate */ - double bottom; /* bottom raster coordinate */ - double top; /* top raster coordinate */ - /* R only has the notion of a rectangular clipping region - */ - double clipLeft; - double clipRight; - double clipBottom; - double clipTop; - /* I hate these next three -- they seem like a real fudge - * BUT I'm not sure what to replace them with so they stay for now. - */ - double xCharOffset; /* x character addressing offset - unused */ - double yCharOffset; /* y character addressing offset */ - double yLineBias; /* 1/2 interline space as frac of line height */ - double ipr[2]; /* Inches per raster; [0]=x, [1]=y */ - /* I hate this guy too -- seems to assume that a device can only - * have one font size during its lifetime - * BUT removing/replacing it would take quite a lot of work - * to design and insert a good replacement so it stays for now. - */ - double cra[2]; /* Character size in rasters; [0]=x, [1]=y */ - double gamma; /* (initial) Device Gamma Correction */ - /******************************************************** - * Device capabilities - ********************************************************/ - Rboolean canClip; /* Device-level clipping */ - Rboolean canChangeGamma; /* can the gamma factor be modified? */ - int canHAdj; /* Can do at least some horiz adjust of text - 0 = none, 1 = {0,0.5,1}, 2 = [0,1] */ - /******************************************************** - * Device initial settings - ********************************************************/ - /* These are things that the device must set up when it is created. - * The graphics system can modify them and track current values, - */ - double startps; - int startcol; /* sets par("fg"), par("col") and gpar("col") */ - int startfill; /* sets par("bg") and gpar("fill") */ - int startlty; - int startfont; - double startgamma; - /******************************************************** - * Device specific information - ********************************************************/ - void *deviceSpecific; /* pointer to device specific parameters */ - /******************************************************** - * Device display list - ********************************************************/ - Rboolean displayListOn; /* toggle for initial display list status */ - - - /******************************************************** - * Event handling entries - ********************************************************/ - - /* Used in do_setGraphicsEventEnv */ - - Rboolean canGenMouseDown; /* can the device generate mousedown events */ - Rboolean canGenMouseMove; /* can the device generate mousemove events */ - Rboolean canGenMouseUp; /* can the device generate mouseup events */ - Rboolean canGenKeybd; /* can the device generate keyboard events */ - - Rboolean gettingEvent; /* This is set while getGraphicsEvent - is actively looking for events */ - - /******************************************************** - * Device procedures. - ********************************************************/ - - /* - * --------------------------------------- - * GENERAL COMMENT ON GRAPHICS PARAMETERS: - * --------------------------------------- - * Graphical parameters are now passed in a pointer to a - * graphics context structure (pGEcontext) rather than individually. - * Each device action should extract the parameters it needs - * and ignore the others. Thought should be given to which - * parameters are relevant in each case -- the graphics engine - * does not REQUIRE that each parameter is honoured, but if - * a parameter is NOT honoured, it might be a good idea to - * issue a warning when a parameter is not honoured (or at - * the very least document which parameters are not honoured - * in the user-level documentation for the device). [An example - * of a parameter that may not be honoured by many devices is - * transparency.] - */ - - /* - * device_Activate is called when a device becomes the - * active device. For example, it can be used to change the - * title of a window to indicate the active status of - * the device to the user. Not all device types will - * do anything. - * The only parameter is a device driver structure. - * An example is ... - * - * static void X11_Activate(pDevDesc dd); - * - * As from R 2.14.0 this can be omitted or set to NULL. - */ -#if R_USE_PROTOTYPES - void (*activate)(const pDevDesc ); -#else - void (*activate)(); -#endif - /* - * device_Circle should have the side-effect that a - * circle is drawn, centred at the given location, with - * the given radius. - * (If the device has non-square pixels, 'radius' should - * be interpreted in the units of the x direction.) - * The border of the circle should be - * drawn in the given "col", and the circle should be - * filled with the given "fill" colour. - * If "col" is NA_INTEGER then no border should be drawn - * If "fill" is NA_INTEGER then the circle should not - * be filled. - * An example is ... - * - * static void X11_Circle(double x, double y, double r, - * pGEcontext gc, - * pDevDesc dd); - * - * R_GE_gcontext parameters that should be honoured (if possible): - * col, fill, gamma, lty, lwd - */ -#if R_USE_PROTOTYPES - void (*circle)(double x, double y, double r, const pGEcontext gc, pDevDesc dd); -#else - void (*circle)(); -#endif - /* - * device_Clip is given the left, right, bottom, and - * top of a rectangle (in DEVICE coordinates). - * It should have the side-effect that subsequent output - * is clipped to the given rectangle. - * NOTE that R's graphics engine already clips to the - * extent of the device. - * NOTE also that this will probably only be called if - * the flag canClip is true. - * An example is ... - * - * static void X11_Clip(double x0, double x1, double y0, double y1, - * pDevDesc dd) - */ -#if R_USE_PROTOTYPES - void (*clip)(double x0, double x1, double y0, double y1, pDevDesc dd); -#else - void (*clip)(); -#endif - /* - * device_Close is called when the device is killed. - * This function is responsible for destroying any - * device-specific resources that were created in - * device_Open and for FREEing the device-specific - * parameters structure. - * An example is ... - * - * static void X11_Close(pDevDesc dd) - * - */ -#if R_USE_PROTOTYPES - void (*close)(pDevDesc dd); -#else - void (*close)(); -#endif - /* - * device_Deactivate is called when a device becomes - * inactive. - * This allows the device to undo anything it did in - * dev_Activate. - * Not all device types will do anything. - * An example is ... - * - * static void X11_Deactivate(pDevDesc dd) - * - * As from R 2.14.0 this can be omitted or set to NULL. - */ -#if R_USE_PROTOTYPES - void (*deactivate)(pDevDesc ); -#else - void (*deactivate)(); -#endif - - - /* - * device_Locator should return the location of the next - * mouse click (in DEVICE coordinates) - * Not all devices will do anything (e.g., postscript) - * An example is ... - * - * static Rboolean X11_Locator(double *x, double *y, pDevDesc dd) - * - * As from R 2.14.0 this can be omitted or set to NULL. - */ -#if R_USE_PROTOTYPES - Rboolean (*locator)(double *x, double *y, pDevDesc dd); -#else - Rboolean (*locator)(); -#endif - /* - * device_Line should have the side-effect that a single - * line is drawn (from x1,y1 to x2,y2) - * An example is ... - * - * static void X11_Line(double x1, double y1, double x2, double y2, - * const pGEcontext gc, - * pDevDesc dd); - * - * R_GE_gcontext parameters that should be honoured (if possible): - * col, gamma, lty, lwd - */ -#if R_USE_PROTOTYPES - void (*line)(double x1, double y1, double x2, double y2, - const pGEcontext gc, pDevDesc dd); -#else - void (*line)(); -#endif - /* - * device_MetricInfo should return height, depth, and - * width information for the given character in DEVICE - * units. - * Note: in an 8-bit locale, c is 'char'. - * In an mbcslocale, it is wchar_t, and at least some - * of code assumes that is UCS-2 (Windows, true) or UCS-4. - * This is used for formatting mathematical expressions - * and for exact centering of text (see GText) - * If the device cannot provide metric information then - * it MUST return 0.0 for ascent, descent, and width. - * An example is ... - * - * static void X11_MetricInfo(int c, - * const pGEcontext gc, - * double* ascent, double* descent, - * double* width, pDevDesc dd); - * - * R_GE_gcontext parameters that should be honoured (if possible): - * font, cex, ps - */ -#if R_USE_PROTOTYPES - void (*metricInfo)(int c, const pGEcontext gc, - double* ascent, double* descent, double* width, - pDevDesc dd); -#else - void (*metricInfo)(); -#endif - /* - * device_Mode is called whenever the graphics engine - * starts drawing (mode=1) or stops drawing (mode=0) - * GMode (in graphics.c) also says that - * mode = 2 (graphical input on) exists. - * The device is not required to do anything - * An example is ... - * - * static void X11_Mode(int mode, pDevDesc dd); - * - * As from R 2.14.0 this can be omitted or set to NULL. - */ -#if R_USE_PROTOTYPES - void (*mode)(int mode, pDevDesc dd); -#else - void (*mode)(); -#endif - /* - * device_NewPage is called whenever a new plot requires - * a new page. - * A new page might mean just clearing the - * device (e.g., X11) or moving to a new page - * (e.g., postscript) - * An example is ... - * - * - * static void X11_NewPage(const pGEcontext gc, - * pDevDesc dd); - * - */ -#if R_USE_PROTOTYPES - void (*newPage)(const pGEcontext gc, pDevDesc dd); -#else - void (*newPage)(); -#endif - /* - * device_Polygon should have the side-effect that a - * polygon is drawn using the given x and y values - * the polygon border should be drawn in the "col" - * colour and filled with the "fill" colour. - * If "col" is NA_INTEGER don't draw the border - * If "fill" is NA_INTEGER don't fill the polygon - * An example is ... - * - * static void X11_Polygon(int n, double *x, double *y, - * const pGEcontext gc, - * pDevDesc dd); - * - * R_GE_gcontext parameters that should be honoured (if possible): - * col, fill, gamma, lty, lwd - */ -#if R_USE_PROTOTYPES - void (*polygon)(int n, double *x, double *y, const pGEcontext gc, pDevDesc dd); -#else - void (*polygon)(); -#endif - /* - * device_Polyline should have the side-effect that a - * series of line segments are drawn using the given x - * and y values. - * An example is ... - * - * static void X11_Polyline(int n, double *x, double *y, - * const pGEcontext gc, - * pDevDesc dd); - * - * R_GE_gcontext parameters that should be honoured (if possible): - * col, gamma, lty, lwd - */ -#if R_USE_PROTOTYPES - void (*polyline)(int n, double *x, double *y, const pGEcontext gc, pDevDesc dd); -#else - void (*polyline)(); -#endif - /* - * device_Rect should have the side-effect that a - * rectangle is drawn with the given locations for its - * opposite corners. The border of the rectangle - * should be in the given "col" colour and the rectangle - * should be filled with the given "fill" colour. - * If "col" is NA_INTEGER then no border should be drawn - * If "fill" is NA_INTEGER then the rectangle should not - * be filled. - * An example is ... - * - * static void X11_Rect(double x0, double y0, double x1, double y1, - * const pGEcontext gc, - * pDevDesc dd); - * - */ -#if R_USE_PROTOTYPES - void (*rect)(double x0, double y0, double x1, double y1, - const pGEcontext gc, pDevDesc dd); -#else - void (*rect)(); -#endif - /* - * device_Path should draw one or more sets of points - * as a single path - * - * 'x' and 'y' give the points - * - * 'npoly' gives the number of polygons in the path - * MUST be at least 1 - * - * 'nper' gives the number of points in each polygon - * each value MUST be at least 2 - * - * 'winding' says whether to fill using the nonzero - * winding rule or the even-odd rule - * - * Added 2010-06-27 - * - * As from R 2.13.2 this can be left unimplemented as NULL. - */ -#if R_USE_PROTOTYPES - void (*path)(double *x, double *y, - int npoly, int *nper, - Rboolean winding, - const pGEcontext gc, pDevDesc dd); -#else - void (*path)(); -#endif - /* - * device_Raster should draw a raster image justified - * at the given location, - * size, and rotation (not all devices may be able to rotate?) - * - * 'raster' gives the image data BY ROW, with every four bytes - * giving one R colour (ABGR). - * - * 'x and 'y' give the bottom-left corner. - * - * 'rot' is in degrees (as per device_Text), with positive - * rotation anticlockwise from the positive x-axis. - * - * As from R 2.13.2 this can be left unimplemented as NULL. - */ -#if R_USE_PROTOTYPES - void (*raster)(unsigned int *raster, int w, int h, - double x, double y, - double width, double height, - double rot, - Rboolean interpolate, - const pGEcontext gc, pDevDesc dd); -#else - void (*raster)(); -#endif - /* - * device_Cap should return an integer matrix (R colors) - * representing the current contents of the device display. - * - * The result is expected to be ROW FIRST. - * - * This will only make sense for raster devices and can - * probably only be implemented for screen devices. - * - * added 2010-06-27 - * - * As from R 2.13.2 this can be left unimplemented as NULL. - * For earlier versions of R it should return R_NilValue. - */ -#if R_USE_PROTOTYPES - SEXP (*cap)(pDevDesc dd); -#else - SEXP (*cap)(); -#endif - /* - * device_Size is called whenever the device is - * resized. - * The function returns (left, right, bottom, and top) for the - * new device size. - * This is not usually called directly by the graphics - * engine because the detection of device resizes - * (e.g., a window resize) are usually detected by - * device-specific code. - * An example is ... - * - * static void X11_Size(double *left, double *right, - * double *bottom, double *top, - * pDevDesc dd); - * - * R_GE_gcontext parameters that should be honoured (if possible): - * col, fill, gamma, lty, lwd - * - * As from R 2.13.2 this can be left unimplemented as NULL. - */ -#if R_USE_PROTOTYPES - void (*size)(double *left, double *right, double *bottom, double *top, - pDevDesc dd); -#else - void (*size)(); -#endif - /* - * device_StrWidth should return the width of the given - * string in DEVICE units. - * An example is ... - * - * static double X11_StrWidth(const char *str, - * const pGEcontext gc, - * pDevDesc dd) - * - * R_GE_gcontext parameters that should be honoured (if possible): - * font, cex, ps - */ -#if R_USE_PROTOTYPES - double (*strWidth)(const char *str, const pGEcontext gc, pDevDesc dd); -#else - double (*strWidth)(); -#endif - /* - * device_Text should have the side-effect that the - * given text is drawn at the given location. - * The text should be rotated according to rot (degrees) - * An example is ... - * - * static void X11_Text(double x, double y, const char *str, - * double rot, double hadj, - * const pGEcontext gc, - * pDevDesc dd); - * - * R_GE_gcontext parameters that should be honoured (if possible): - * font, cex, ps, col, gamma - */ -#if R_USE_PROTOTYPES - void (*text)(double x, double y, const char *str, double rot, - double hadj, const pGEcontext gc, pDevDesc dd); -#else - void (*text)(); -#endif - /* - * device_onExit is called by GEonExit when the user has aborted - * some operation, and so an R_ProcessEvents call may not return normally. - * It need not be set to any value; if null, it will not be called. - * - * An example is ... - * - * static void GA_onExit(pDevDesc dd); - */ -#if R_USE_PROTOTYPES - void (*onExit)(pDevDesc dd); -#else - void (*onExit)(); -#endif - /* - * device_getEvent is no longer used, but the slot is kept for back - * compatibility of the structure. - */ - SEXP (*getEvent)(SEXP, const char *); - - /* --------- Optional features introduced in 2.7.0 --------- */ - - /* Does the device have a device-specific way to confirm a - new frame (for e.g. par(ask=TRUE))? - This should be NULL if it does not. - If it does, it returns TRUE if the device handled this, and - FALSE if it wants the engine to do so. - - There is an example in the windows() device. - - Can be left unimplemented as NULL. - */ -#if R_USE_PROTOTYPES - Rboolean (*newFrameConfirm)(pDevDesc dd); -#else - Rboolean (*newFrameConfirm)(); -#endif - - /* Some devices can plot UTF-8 text directly without converting - to the native encoding, e.g. windows(), quartz() .... - - If this flag is true, all text *not in the symbol font* is sent - in UTF8 to the textUTF8/strWidthUTF8 entry points. - - If the flag is TRUE, the metricInfo entry point should - accept negative values for 'c' and treat them as indicating - Unicode points (as well as positive values in a MBCS locale). - */ - Rboolean hasTextUTF8; /* and strWidthUTF8 */ -#if R_USE_PROTOTYPES - void (*textUTF8)(double x, double y, const char *str, double rot, - double hadj, const pGEcontext gc, pDevDesc dd); - double (*strWidthUTF8)(const char *str, const pGEcontext gc, pDevDesc dd); -#else - void (*textUTF8)(); - double (*strWidthUTF8)(); -#endif - Rboolean wantSymbolUTF8; - - /* Is rotated text good enough to be preferable to Hershey in - contour labels? Old default was FALSE. - */ - Rboolean useRotatedTextInContour; - - /* --------- Post-2.7.0 features --------- */ - - /* Added in 2.12.0: Changed graphics event handling. */ - - SEXP eventEnv; /* This is an environment holding event handlers. */ - /* - * eventHelper(dd, 1) is called by do_getGraphicsEvent before looking for a - * graphics event. It will then call R_ProcessEvents() and eventHelper(dd, 2) - * until this or another device returns sets a non-null result value in eventEnv, - * at which time eventHelper(dd, 0) will be called. - * - * An example is ... - * - * static SEXP GA_eventHelper(pDevDesc dd, int code); - - * Can be left unimplemented as NULL - */ -#if R_USE_PROTOTYPES - void (*eventHelper)(pDevDesc dd, int code); -#else - void (*eventHelper)(); -#endif - - /* added in 2.14.0, only used by screen devices. - - Allows graphics devices to have multiple levels of suspension: - when this reaches zero output is flushed. - - Can be left unimplemented as NULL. - */ -#if R_USE_PROTOTYPES - int (*holdflush)(pDevDesc dd, int level); -#else - int (*holdflush)(); -#endif - - /* added in 2.14.0, for dev.capabilities. - In all cases 0 means NA (unset). - */ - int haveTransparency; /* 1 = no, 2 = yes */ - int haveTransparentBg; /* 1 = no, 2 = fully, 3 = semi */ - int haveRaster; /* 1 = no, 2 = yes, 3 = except for missing values */ - int haveCapture, haveLocator; /* 1 = no, 2 = yes */ - - - /* Area for future expansion. - By zeroing this, devices are more likely to work if loaded - into a later version of R than that they were compiled under. - */ - char reserved[64]; -}; - - - /********************************************************/ - /* the device-driver entry point is given a device */ - /* description structure that it must set up. this */ - /* involves several important jobs ... */ - /* (1) it must ALLOCATE a new device-specific parameters*/ - /* structure and FREE that structure if anything goes */ - /* wrong (i.e., it won't report a successful setup to */ - /* the graphics engine (the graphics engine is NOT */ - /* responsible for allocating or freeing device-specific*/ - /* resources or parameters) */ - /* (2) it must initialise the device-specific resources */ - /* and parameters (mostly done by calling device_Open) */ - /* (3) it must initialise the generic graphical */ - /* parameters that are not initialised by GInit (because*/ - /* only the device knows what values they should have) */ - /* see Graphics.h for the official list of these */ - /* (4) it may reset generic graphics parameters that */ - /* have already been initialised by GInit (although you */ - /* should know what you are doing if you do this) */ - /* (5) it must attach the device-specific parameters */ - /* structure to the device description structure */ - /* e.g., dd->deviceSpecfic = (void *) xd; */ - /* (6) it must FREE the overall device description if */ - /* it wants to bail out to the top-level */ - /* the graphics engine is responsible for allocating */ - /* the device description and freeing it in most cases */ - /* but if the device driver freaks out it needs to do */ - /* the clean-up itself */ - /********************************************************/ - -/* moved from Rgraphics.h */ - -/* - * Some Notes on Color - * - * R uses a 24-bit color model. Colors are specified in 32-bit - * integers which are partitioned into 4 bytes as follows. - * - * <-- most sig least sig --> - * +-------------------------------+ - * | 0 | blue | green | red | - * +-------------------------------+ - * - * The red, green and blue bytes can be extracted as follows. - * - * red = ((color ) & 255) - * green = ((color >> 8) & 255) - * blue = ((color >> 16) & 255) - */ -/* - * Changes as from 1.4.0: use top 8 bits as an alpha channel. - * 0 = opaque, 255 = transparent. - */ -/* - * Changes as from 2.0.0: use top 8 bits as full alpha channel - * 255 = opaque, 0 = transparent - * [to conform with SVG, PDF and others] - * and everything in between is used - * [which means that NA is not stored as an internal colour; - * it is converted to R_RGBA(255, 255, 255, 0)] - */ - -#define R_RGB(r,g,b) ((r)|((g)<<8)|((b)<<16)|0xFF000000) -#define R_RGBA(r,g,b,a) ((r)|((g)<<8)|((b)<<16)|((a)<<24)) -#define R_RED(col) (((col) )&255) -#define R_GREEN(col) (((col)>> 8)&255) -#define R_BLUE(col) (((col)>>16)&255) -#define R_ALPHA(col) (((col)>>24)&255) -#define R_OPAQUE(col) (R_ALPHA(col) == 255) -#define R_TRANSPARENT(col) (R_ALPHA(col) == 0) - /* - * A transparent white - */ -#define R_TRANWHITE (R_RGBA(255, 255, 255, 0)) - - -/* used in various devices */ - -#define curDevice Rf_curDevice -#define killDevice Rf_killDevice -#define ndevNumber Rf_ndevNumber -#define NewFrameConfirm Rf_NewFrameConfirm -#define nextDevice Rf_nextDevice -#define NoDevices Rf_NoDevices -#define NumDevices Rf_NumDevices -#define prevDevice Rf_prevDevice -#define selectDevice Rf_selectDevice -#define AdobeSymbol2utf8 Rf_AdobeSymbol2utf8 - -/* Properly declared version of devNumber */ -int ndevNumber(pDevDesc ); - -/* Formerly in Rdevices.h */ - -/* How many devices exist ? (>= 1) */ -int NumDevices(void); - -/* Check for an available device slot */ -void R_CheckDeviceAvailable(void); -Rboolean R_CheckDeviceAvailableBool(void); - -/* Return the number of the current device. */ -int curDevice(void); - -/* Return the number of the next device. */ -int nextDevice(int); - -/* Return the number of the previous device. */ -int prevDevice(int); - -/* Make the specified device (specified by number) the current device */ -int selectDevice(int); - -/* Kill device which is identified by number. */ -void killDevice(int); - -int NoDevices(void); /* used in engine, graphics, plot, grid */ - -void NewFrameConfirm(pDevDesc); /* used in graphics.c, grid */ - - -/* Graphics events: defined in gevents.c */ - -/* These give the indices of some known keys */ - -typedef enum {knUNKNOWN = -1, - knLEFT = 0, knUP, knRIGHT, knDOWN, - knF1, knF2, knF3, knF4, knF5, knF6, knF7, knF8, knF9, knF10, - knF11, knF12, - knPGUP, knPGDN, knEND, knHOME, knINS, knDEL} R_KeyName; - -/* These are the three possible mouse events */ - -typedef enum {meMouseDown = 0, - meMouseUp, - meMouseMove} R_MouseEvent; - -#define leftButton 1 -#define middleButton 2 -#define rightButton 4 - -#define doKeybd Rf_doKeybd -#define doMouseEvent Rf_doMouseEvent - -void doMouseEvent(pDevDesc dd, R_MouseEvent event, - int buttons, double x, double y); -void doKeybd(pDevDesc dd, R_KeyName rkey, - const char *keyname); - - -/* For use in third-party devices when setting up a device: - * duplicates Defn.h which is used internally. - * (Tested in devNull.c) - */ - -#ifndef BEGIN_SUSPEND_INTERRUPTS -/* Macros for suspending interrupts */ -#define BEGIN_SUSPEND_INTERRUPTS do { \ - Rboolean __oldsusp__ = R_interrupts_suspended; \ - R_interrupts_suspended = TRUE; -#define END_SUSPEND_INTERRUPTS R_interrupts_suspended = __oldsusp__; \ - if (R_interrupts_pending && ! R_interrupts_suspended) \ - Rf_onintr(); \ -} while(0) - -#include <R_ext/libextern.h> -LibExtern Rboolean R_interrupts_suspended; -LibExtern int R_interrupts_pending; -extern void Rf_onintr(void); -LibExtern Rboolean mbcslocale; -#endif - -/* Useful for devices: translates Adobe symbol encoding to UTF-8 */ -extern void *AdobeSymbol2utf8(char*out, const char *in, int nwork); -/* Translates Unicode point to UTF-8 */ -extern size_t Rf_ucstoutf8(char *s, const unsigned int c); - -#ifdef __cplusplus -} -#endif - -#endif /* R_GRAPHICSDEVICE_ */ diff --git a/sourcecodes/localscore/GraphicsEngine.h b/sourcecodes/localscore/GraphicsEngine.h deleted file mode 100644 index 8d4a8748..00000000 --- a/sourcecodes/localscore/GraphicsEngine.h +++ /dev/null @@ -1,514 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2001-11 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* Used by graphics.c, grid and by third-party graphics devices */ - -#ifndef R_GRAPHICSENGINE_H_ -#define R_GRAPHICSENGINE_H_ - -#ifdef __cplusplus -extern "C" { -#endif - -/* - * The current graphics engine (including graphics device) API version - * MUST be integer - * - * This number should be bumped whenever there are changes to - * GraphicsEngine.h or GraphicsDevice.h so that add-on packages - * that compile against these headers (graphics systems such as - * graphics and grid; graphics devices such as gtkDevice, RSvgDevice) - * can detect any version mismatch. - * - * Version 1: Introduction of the version number. - * Version 2: GEDevDesc *dd dropped from GEcontourLines(). - * Version 3: R_GE_str2col() added to API. (r41887) - * Version 4: UTF-8 text hooks, useRotatedTextInContour, - * add newFrameConfirm() to NewDevDesc. - * New API: GEaddDevice[2] GEgetDevice, GEkillDevice, - * ndevNumber. (R 2.7.0) - * Version 5: Clean up 1.4.0/2.0.0 changes! - * Remove newDevStruct from GEDevDesc and NewDevDesc. - * Remove asp, dot(), hold(), open() from NewDevDesc. - * Move displayList, DLlastElt, savedSnapshot from - * NewDevDesc to GEDevDesc. - * Add 'ask' to GEDevDesc. (R 2.8.0) - * Version 6: Add dev_Raster() and dev_Cap() (R 2.11.0) - * Version 7: Change graphics event handling, adding eventEnv and eventHelper() - * to DevDesc. (R 2.12.0) - * Version 8: Add dev_Path() (R 2.12.0) - * Version 9: Add dev_HoldFlush(), haveTrans*, haveRaster, - * haveCapture, haveLocator. (R 2.14.0) - */ - -#define R_GE_version 9 - -int R_GE_getVersion(void); - -void R_GE_checkVersionOrDie(int version); - -/* The graphics engine will only accept locations and dimensions - * in native device coordinates, but it provides the following functions - * for converting between a couple of simple alternative coordinate - * systems and device coordinates: - * DEVICE = native units of the device - * NDC = Normalised device coordinates - * INCHES = inches (!) - * CM = centimetres (!!) - */ - -typedef enum { - GE_DEVICE = 0, /* native device coordinates (rasters) */ - GE_NDC = 1, /* normalised device coordinates x=(0,1), y=(0,1) */ - GE_INCHES = 2, - GE_CM = 3 -} GEUnit; - -#define MAX_GRAPHICS_SYSTEMS 24 - -typedef enum { - /* In response to this event, the registered graphics system - * should allocate and initialise the systemSpecific structure - * - * Should return R_NilValue on failure so that engine - * can tidy up memory allocation - */ - GE_InitState = 0, - /* This event gives the registered system a chance to undo - * anything done in the initialisation. - */ - GE_FinaliseState = 1, - /* This is sent by the graphics engine prior to initialising - * the display list. It give the graphics system the chance - * to squirrel away information it will need for redrawing the - * the display list - */ - GE_SaveState = 2, - /* This is sent by the graphics engine prior to replaying the - * display list. It gives the graphics system the chance to - * restore any information it saved on the GE_SaveState event - */ - GE_RestoreState = 6, - /* Copy system state information to the current device. - * This is used when copying graphics from one device to another - * so all the graphics system needs to do is to copy across - * the bits required for the display list to draw faithfully - * on the new device. - */ - GE_CopyState = 3, - /* Create a snapshot of the system state that is sufficient - * for the current "image" to be reproduced - */ - GE_SaveSnapshotState = 4, - /* Restore the system state that is saved by GE_SaveSnapshotState - */ - GE_RestoreSnapshotState = 5, - /* When replaying the display list, the graphics engine - * checks, after each replayed action, that the action - * produced valid output. This is the graphics system's - * chance to say that the output is crap (in which case the - * graphics engine will abort the display list replay). - */ - GE_CheckPlot = 7, - /* The device wants to scale the current pointsize - * (for scaling an image) - * This is not a nice general solution, but a quick fix for - * the Windows device. - */ - GE_ScalePS = 8 -} GEevent; - -/* - * Some line end/join constants - */ -typedef enum { - GE_ROUND_CAP = 1, - GE_BUTT_CAP = 2, - GE_SQUARE_CAP = 3 -} R_GE_lineend; - -typedef enum { - GE_ROUND_JOIN = 1, - GE_MITRE_JOIN = 2, - GE_BEVEL_JOIN = 3 -} R_GE_linejoin; - -/* - * A structure containing graphical parameters - * - * This is how graphical parameters are passed from graphics systems - * to the graphics engine AND from the graphics engine to graphics - * devices. - * - * Devices are not *required* to honour graphical parameters - * (e.g., alpha transparency is going to be tough for some) - */ -typedef struct { - /* - * Colours - * - * NOTE: Alpha transparency included in col & fill - */ - int col; /* pen colour (lines, text, borders, ...) */ - int fill; /* fill colour (for polygons, circles, rects, ...) */ - double gamma; /* Gamma correction */ - /* - * Line characteristics - */ - double lwd; /* Line width (roughly number of pixels) */ - int lty; /* Line type (solid, dashed, dotted, ...) */ - R_GE_lineend lend; /* Line end */ - R_GE_linejoin ljoin; /* line join */ - double lmitre; /* line mitre */ - /* - * Text characteristics - */ - double cex; /* Character expansion (font size = fontsize*cex) */ - double ps; /* Font size in points */ - double lineheight; /* Line height (multiply by font size) */ - int fontface; /* Font face (plain, italic, bold, ...) */ - char fontfamily[201]; /* Font family */ -} R_GE_gcontext; - -typedef R_GE_gcontext* pGEcontext; - - -#include <R_ext/GraphicsDevice.h> /* needed for DevDesc */ - -typedef struct _GEDevDesc GEDevDesc; - -typedef SEXP (* GEcallback)(GEevent, GEDevDesc *, SEXP); - -typedef struct { - /* An array of information about each graphics system that - * has registered with the graphics engine. - * This is used to store graphics state for each graphics - * system on each device. - */ - void *systemSpecific; - /* - * An array of function pointers, one per graphics system that - * has registered with the graphics engine. - * - * system_Callback is called when the graphics engine wants - * to give a graphics system the chance to play with its - * device-specific information (stored in systemSpecific) - * There are two parameters: an "event" to tell the graphics - * system why the graphics engine has called this function, - * and the systemSpecific pointer. The graphics engine - * has to pass the systemSpecific pointer because only - * the graphics engine will know what array index to use. - */ - GEcallback callback; -} GESystemDesc; - -struct _GEDevDesc { - /* - * Stuff that the devices can see (and modify). - * All detailed in GraphicsDevice.h - */ - pDevDesc dev; - /* - * Stuff about the device that only the graphics engine sees - * (the devices don't see it). - */ - Rboolean displayListOn; /* toggle for display list status */ - SEXP displayList; /* display list */ - SEXP DLlastElt; /* A pointer to the end of the display list - to avoid tranversing pairlists */ - SEXP savedSnapshot; /* The last element of the display list - * just prior to when the display list - * was last initialised - */ - Rboolean dirty; /* Has the device received any output? */ - Rboolean recordGraphics; /* Should a graphics call be stored - * on the display list? - * Set to FALSE by do_recordGraphics, - * do_dotcallgr, and do_Externalgr - * so that nested calls are not - * recorded on the display list - */ - /* - * Stuff about the device that only graphics systems see. - * The graphics engine has no idea what is in here. - * Used by graphics systems to store system state per device. - */ - GESystemDesc *gesd[MAX_GRAPHICS_SYSTEMS]; - - /* per-device setting for 'ask' (use NewFrameConfirm) */ - Rboolean ask; -}; - -typedef GEDevDesc* pGEDevDesc; - -/* functions from devices.c for use by graphics devices */ - -#define desc2GEDesc Rf_desc2GEDesc -/* map DevDesc to enclosing GEDevDesc */ -pGEDevDesc desc2GEDesc(pDevDesc dd); -int GEdeviceNumber(pGEDevDesc); -pGEDevDesc GEgetDevice(int); -void GEaddDevice(pGEDevDesc); -void GEaddDevice2(pGEDevDesc, const char *); -void GEkillDevice(pGEDevDesc); -pGEDevDesc GEcreateDevDesc(pDevDesc dev); - -void GEdestroyDevDesc(pGEDevDesc dd); -void *GEsystemState(pGEDevDesc dd, int index); -void GEregisterWithDevice(pGEDevDesc dd); -void GEregisterSystem(GEcallback callback, int *systemRegisterIndex); -void GEunregisterSystem(int registerIndex); -SEXP GEhandleEvent(GEevent event, pDevDesc dev, SEXP data); - -#define fromDeviceX GEfromDeviceX -#define toDeviceX GEtoDeviceX -#define fromDeviceY GEfromDeviceY -#define toDeviceY GEtoDeviceY -#define fromDeviceWidth GEfromDeviceWidth -#define toDeviceWidth GEtoDeviceWidth -#define fromDeviceHeight GEfromDeviceHeight -#define toDeviceHeight GEtoDeviceHeight - -double fromDeviceX(double value, GEUnit to, pGEDevDesc dd); -double toDeviceX(double value, GEUnit from, pGEDevDesc dd); -double fromDeviceY(double value, GEUnit to, pGEDevDesc dd); -double toDeviceY(double value, GEUnit from, pGEDevDesc dd); -double fromDeviceWidth(double value, GEUnit to, pGEDevDesc dd); -double toDeviceWidth(double value, GEUnit from, pGEDevDesc dd); -double fromDeviceHeight(double value, GEUnit to, pGEDevDesc dd); -double toDeviceHeight(double value, GEUnit from, pGEDevDesc dd); - -/*------------------------------------------------------------------- - * - * COLOUR CODE is concerned with the internals of R colour representation - * - * From colors.c, used in par.c, grid/src/gpar.c - */ - -#define RGBpar Rf_RGBpar -#define RGBpar3 Rf_RGBpar3 -#define col2name Rf_col2name -#define name2col Rf_name2col - -/* Convert an element of a R colour specification (which might be a - number or a string) into an internal colour specification. */ -unsigned int RGBpar(SEXP, int); -unsigned int RGBpar3(SEXP, int, unsigned int); - -/* Convert an internal colour specification to/from a colour name */ -const char *col2name(unsigned int col); /* used in par.c, grid */ -unsigned int name2col(const char *); /* used by plotmath.c */ - -/* Convert either a name or a #RRGGBB[AA] string to internal. - Because people were using it, it also converts "1", "2" ... - to a colour in the palette, and "0" to transparent white. -*/ -unsigned int R_GE_str2col(const char *s); - - - -/* - * Some Notes on Line Textures - * - * Line textures are stored as an array of 4-bit integers within - * a single 32-bit word. These integers contain the lengths of - * lines to be drawn with the pen alternately down and then up. - * The device should try to arrange that these values are measured - * in points if possible, although pixels is ok on most displays. - * - * If newlty contains a line texture description it is decoded - * as follows: - * - * ndash = 0; - * for(i=0 ; i<8 && newlty & 15 ; i++) { - * dashlist[ndash++] = newlty & 15; - * newlty = newlty>>4; - * } - * dashlist[0] = length of pen-down segment - * dashlist[1] = length of pen-up segment - * etc - * - * An integer containing a zero terminates the pattern. Hence - * ndash in this code fragment gives the length of the texture - * description. If a description contains an odd number of - * elements it is replicated to create a pattern with an - * even number of elements. (If this is a pain, do something - * different its not crucial). - * - */ - -/*--- The basic numbered & names line types; Here device-independent: - e.g. "dashed" == "44", "dotdash" == "1343" -*/ - -/* NB: was also in Rgraphics.h in R < 2.7.0 */ -#define LTY_BLANK -1 -#define LTY_SOLID 0 -#define LTY_DASHED 4 + (4<<4) -#define LTY_DOTTED 1 + (3<<4) -#define LTY_DOTDASH 1 + (3<<4) + (4<<8) + (3<<12) -#define LTY_LONGDASH 7 + (3<<4) -#define LTY_TWODASH 2 + (2<<4) + (6<<8) + (2<<12) - -R_GE_lineend GE_LENDpar(SEXP value, int ind); -SEXP GE_LENDget(R_GE_lineend lend); -R_GE_linejoin GE_LJOINpar(SEXP value, int ind); -SEXP GE_LJOINget(R_GE_linejoin ljoin); - -void GESetClip(double x1, double y1, double x2, double y2, pGEDevDesc dd); -void GENewPage(const pGEcontext gc, pGEDevDesc dd); -void GELine(double x1, double y1, double x2, double y2, - const pGEcontext gc, pGEDevDesc dd); -void GEPolyline(int n, double *x, double *y, - const pGEcontext gc, pGEDevDesc dd); -void GEPolygon(int n, double *x, double *y, - const pGEcontext gc, pGEDevDesc dd); -SEXP GEXspline(int n, double *x, double *y, double *s, Rboolean open, - Rboolean repEnds, Rboolean draw, - const pGEcontext gc, pGEDevDesc dd); -void GECircle(double x, double y, double radius, - const pGEcontext gc, pGEDevDesc dd); -void GERect(double x0, double y0, double x1, double y1, - const pGEcontext gc, pGEDevDesc dd); -void GEPath(double *x, double *y, - int npoly, int *nper, - Rboolean winding, - const pGEcontext gc, pGEDevDesc dd); -void GERaster(unsigned int *raster, int w, int h, - double x, double y, double width, double height, - double angle, Rboolean interpolate, - const pGEcontext gc, pGEDevDesc dd); -SEXP GECap(pGEDevDesc dd); -void GEText(double x, double y, const char * const str, cetype_t enc, - double xc, double yc, double rot, - const pGEcontext gc, pGEDevDesc dd); -void GEMode(int mode, pGEDevDesc dd); -void GESymbol(double x, double y, int pch, double size, - const pGEcontext gc, pGEDevDesc dd); -void GEPretty(double *lo, double *up, int *ndiv); -void GEMetricInfo(int c, const pGEcontext gc, - double *ascent, double *descent, double *width, - pGEDevDesc dd); -double GEStrWidth(const char *str, cetype_t enc, - const pGEcontext gc, pGEDevDesc dd); -double GEStrHeight(const char *str, cetype_t enc, - const pGEcontext gc, pGEDevDesc dd); -void GEStrMetric(const char *str, cetype_t enc, const pGEcontext gc, - double *ascent, double *descent, double *width, - pGEDevDesc dd); -int GEstring_to_pch(SEXP pch); - -/*------------------------------------------------------------------- - * - * LINE TEXTURE CODE is concerned with the internals of R - * line texture representation. - */ -unsigned int GE_LTYpar(SEXP, int); -SEXP GE_LTYget(unsigned int); - -/* - * Raster operations - */ -void R_GE_rasterScale(unsigned int *sraster, int sw, int sh, - unsigned int *draster, int dw, int dh); -void R_GE_rasterInterpolate(unsigned int *sraster, int sw, int sh, - unsigned int *draster, int dw, int dh); -void R_GE_rasterRotatedSize(int w, int h, double angle, - int *wnew, int *hnew); -void R_GE_rasterRotatedOffset(int w, int h, double angle, int botleft, - double *xoff, double *yoff); -void R_GE_rasterResizeForRotation(unsigned int *sraster, - int w, int h, - unsigned int *newRaster, - int wnew, int hnew, - const pGEcontext gc); -void R_GE_rasterRotate(unsigned int *sraster, int w, int h, double angle, - unsigned int *draster, const pGEcontext gc, - Rboolean perPixelAlpha); - - -/* - * From plotmath.c - */ -double GEExpressionWidth(SEXP expr, - const pGEcontext gc, pGEDevDesc dd); -double GEExpressionHeight(SEXP expr, - const pGEcontext gc, pGEDevDesc dd); -void GEExpressionMetric(SEXP expr, const pGEcontext gc, - double *ascent, double *descent, double *width, - pGEDevDesc dd); -void GEMathText(double x, double y, SEXP expr, - double xc, double yc, double rot, - const pGEcontext gc, pGEDevDesc dd); -/* - * (End from plotmath.c) - */ - -/* - * From plot3d.c : used in package clines - */ -SEXP GEcontourLines(double *x, int nx, double *y, int ny, - double *z, double *levels, int nl); -/* - * (End from plot3d.c) - */ - -/* - * From vfonts.c - */ -double R_GE_VStrWidth(const char *s, cetype_t enc, const pGEcontext gc, pGEDevDesc dd); - -double R_GE_VStrHeight(const char *s, cetype_t enc, const pGEcontext gc, pGEDevDesc dd); -void R_GE_VText(double x, double y, const char * const s, cetype_t enc, - double x_justify, double y_justify, double rotation, - const pGEcontext gc, pGEDevDesc dd); -/* - * (End from vfonts.c) - */ - -/* Also in Graphics.h */ -#define DEG2RAD 0.01745329251994329576 - -pGEDevDesc GEcurrentDevice(void); -Rboolean GEdeviceDirty(pGEDevDesc dd); -void GEdirtyDevice(pGEDevDesc dd); -Rboolean GEcheckState(pGEDevDesc dd); -Rboolean GErecording(SEXP call, pGEDevDesc dd); -void GErecordGraphicOperation(SEXP op, SEXP args, pGEDevDesc dd); -void GEinitDisplayList(pGEDevDesc dd); -void GEplayDisplayList(pGEDevDesc dd); -void GEcopyDisplayList(int fromDevice); -SEXP GEcreateSnapshot(pGEDevDesc dd); -void GEplaySnapshot(SEXP snapshot, pGEDevDesc dd); -void GEonExit(void); -void GEnullDevice(void); - - -/* From ../../main/plot.c, used by ../../library/grid/src/grid.c */ -#define CreateAtVector Rf_CreateAtVector -SEXP CreateAtVector(double*, double*, int, Rboolean); -/* From ../../main/graphics.c, used by ../../library/grDevices/src/axis_scales.c */ -#define GAxisPars Rf_GAxisPars -void GAxisPars(double *min, double *max, int *n, Rboolean log, int axis); - -#ifdef __cplusplus -} -#endif - -#endif /* R_GRAPHICSENGINE_ */ diff --git a/sourcecodes/localscore/Lapack.h b/sourcecodes/localscore/Lapack.h deleted file mode 100644 index ad044ef7..00000000 --- a/sourcecodes/localscore/Lapack.h +++ /dev/null @@ -1,3072 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2003-12 The R Core Team. - * Copyright (C) 2008 The R Foundation - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* - C declarations of LAPACK Fortran subroutines included in R. - Just those used (currently or previously) by C routines in R itself. - - Part of the API. - - R packages that use these should have PKG_LIBS in src/Makevars include - $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) - */ - - -#ifndef R_LAPACK_H -#define R_LAPACK_H - -#include <R_ext/RS.h> /* for F77_... */ -#include <R_ext/Complex.h> /* for Rcomplex */ -#include <R_ext/BLAS.h> - -/* - LAPACK function names are [dz]<name>(), where d denotes the real - version of the function, z the complex version. (Only - double-precision versions are used in R.) -*/ - -#ifdef __cplusplus -extern "C" { -#endif - -// Never defined by R itself. -#ifndef La_extern -#define La_extern extern -#endif - -/* Utilities for Lapack-using packages : */ - -/* matrix norms: converting typstr[] to one of {'M', 'O', 'I', 'F'} - * or signal error(): */ -La_extern char La_norm_type(const char *typstr); - -/* matrix (reciprocal) condition numbers: convert typstr[] to 'O'(ne) or 'I'(nf) - * or signal error(): */ -La_extern char La_rcond_type(const char *typstr); - - - -/* Selected Double Precision Lapack Routines - ======== - */ - -/* Double precision BiDiagonal matrices */ - -/* DBDSQR - compute the singular value decomposition (SVD) of a real */ -/* N-by-N (upper or lower) bidiagonal matrix B */ -La_extern void -F77_NAME(dbdsqr)(const char* uplo, const int* n, const int* ncvt, - const int* nru, const int* ncc, double* d, double* e, - double* vt, const int* ldvt, double* u, const int* ldu, - double* c, const int* ldc, double* work, int* info); -/* DDISNA - compute the reciprocal condition numbers for the */ -/* eigenvectors of a real symmetric or complex Hermitian matrix or */ -/* for the left or right singular vectors of a general m-by-n */ -/* matrix */ -La_extern void -F77_NAME(ddisna)(const char* job, const int* m, const int* n, - double* d, double* sep, int* info); - -/* Double precision General Banded matrices */ - -/* DGBBRD - reduce a real general m-by-n band matrix A to upper */ -/* bidiagonal form B by an orthogonal transformation */ -La_extern void -F77_NAME(dgbbrd)(const char* vect, const int* m, const int* n, - const int* ncc, const int* kl, const int* ku, - double* ab, const int* ldab, - double* d, double* e, double* q, - const int* ldq, double* pt, const int* ldpt, - double* c, const int* ldc, - double* work, int* info); -/* DGBCON - estimate the reciprocal of the condition number of a */ -/* real general band matrix A, in either the 1-norm or the */ -/* infinity-norm */ -La_extern void -F77_NAME(dgbcon)(const char* norm, const int* n, const int* kl, - const int* ku, double* ab, const int* ldab, - int* ipiv, const double* anorm, double* rcond, - double* work, int* iwork, int* info); -/* DGBEQU - compute row and column scalings intended to equilibrate */ -/* an M-by-N band matrix A and reduce its condition number */ -La_extern void -F77_NAME(dgbequ)(const int* m, const int* n, const int* kl, const int* ku, - double* ab, const int* ldab, double* r, double* c, - double* rowcnd, double* colcnd, double* amax, int* info); -/* DGBRFS - improve the computed solution to a system of linear */ -/* equations when the coefficient matrix is banded, and provides */ -/* error bounds and backward error estimates for the solution */ -La_extern void -F77_NAME(dgbrfs)(const char* trans, const int* n, const int* kl, - const int* ku, const int* nrhs, double* ab, - const int* ldab, double* afb, const int* ldafb, - int* ipiv, double* b, const int* ldb, - double* x, const int* ldx, double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DGBSV - compute the solution to a real system of linear */ -/* equations A * X = B, where A is a band matrix of order N with */ -/* KL subdiagonals and KU superdiagonals, and X and B are */ -/* N-by-NRHS matrices */ -La_extern void -F77_NAME(dgbsv)(const int* n, const int* kl,const int* ku, - const int* nrhs, double* ab, const int* ldab, - int* ipiv, double* b, const int* ldb, int* info); -/* DGBSVX - use the LU factorization to compute the solution to a */ -/* real system of linear equations A * X = B or A**T * X = B */ -La_extern void -F77_NAME(dgbsvx)(const int* fact, const char* trans, - const int* n, const int* kl,const int* ku, - const int* nrhs, double* ab, const int* ldab, - double* afb, const int* ldafb, int* ipiv, - const char* equed, double* r, double* c, - double* b, const int* ldb, - double* x, const int* ldx, - double* rcond, double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DGBTF2 - compute an LU factorization of a real m-by-n band */ -/* matrix A using partial pivoting with row interchanges */ -La_extern void -F77_NAME(dgbtf2)(const int* m, const int* n, const int* kl,const int* ku, - double* ab, const int* ldab, int* ipiv, int* info); -/* DGBTRF - compute an LU factorization of a real m-by-n band */ -/* matrix A using partial pivoting with row interchanges */ -La_extern void -F77_NAME(dgbtrf)(const int* m, const int* n, const int* kl,const int* ku, - double* ab, const int* ldab, int* ipiv, int* info); -/* DGBTRS - solve a system of linear equations A * X = B or */ -/* A' * X = B with a general band matrix A using the LU */ -/* factorization computed by DGBTRF */ -La_extern void -F77_NAME(dgbtrs)(const char* trans, const int* n, - const int* kl, const int* ku, const int* nrhs, - const double* ab, const int* ldab, const int* ipiv, - double* b, const int* ldb, int* info); - -/* Double precision GEneral matrices */ - -/* DGEBAK - form the right or left eigenvectors of a real general */ -/* matrix by backward transformation on the computed eigenvectors */ -/* of the balanced matrix output by DGEBAL */ -La_extern void -F77_NAME(dgebak)(const char* job, const char* side, const int* n, - const int* ilo, const int* ihi, double* scale, - const int* m, double* v, const int* ldv, int* info); -/* DGEBAL - balance a general real matrix A */ -La_extern void -F77_NAME(dgebal)(const char* job, const int* n, double* a, const int* lda, - int* ilo, int* ihi, double* scale, int* info); -/* DGEBD2 - reduce a real general m by n matrix A to upper or */ -/* lower bidiagonal form B by an orthogonal transformation */ -La_extern void -F77_NAME(dgebd2)(const int* m, const int* n, double* a, const int* lda, - double* d, double* e, double* tauq, double* taup, - double* work, int* info); -/* DGEBRD - reduce a general real M-by-N matrix A to upper or */ -/* lower bidiagonal form B by an orthogonal transformation */ -La_extern void -F77_NAME(dgebrd)(const int* m, const int* n, double* a, const int* lda, - double* d, double* e, double* tauq, double* taup, - double* work, const int* lwork, int* info); -/* DGECON - estimate the reciprocal of the condition number of a */ -/* general real matrix A, in either the 1-norm or the */ -/* infinity-norm, using the LU factorization computed by DGETRF */ -La_extern void -F77_NAME(dgecon)(const char* norm, const int* n, - const double* a, const int* lda, - const double* anorm, double* rcond, - double* work, int* iwork, int* info); -/* DGEEQU - compute row and column scalings intended to equilibrate */ -/* an M-by-N matrix A and reduce its condition number */ -La_extern void -F77_NAME(dgeequ)(const int* m, const int* n, double* a, const int* lda, - double* r, double* c, double* rowcnd, double* colcnd, - double* amax, int* info); -/* DGEES - compute for an N-by-N real nonsymmetric matrix A, the */ -/* eigenvalues, the real Schur form T, and, optionally, the matrix */ -/* of Schur vectors Z */ -La_extern void -F77_NAME(dgees)(const char* jobvs, const char* sort, - int (*select)(const double*, const double*), - const int* n, double* a, const int* lda, - int* sdim, double* wr, double* wi, - double* vs, const int* ldvs, - double* work, const int* lwork, int* bwork, int* info); -/* DGEESX - compute for an N-by-N real nonsymmetric matrix A, the */ -/* eigenvalues, the real Schur form T, and, optionally, the matrix */ -/* of Schur vectors Z */ -La_extern void -F77_NAME(dgeesx)(const char* jobvs, const char* sort, - int (*select)(const double*, const double*), - const char* sense, const int* n, double* a, - const int* lda, int* sdim, double* wr, double* wi, - double* vs, const int* ldvs, double* rconde, - double* rcondv, double* work, const int* lwork, - int* iwork, const int* liwork, int* bwork, int* info); -/* DGEEV - compute for an N-by-N real nonsymmetric matrix A, the */ -/* eigenvalues and, optionally, the left and/or right eigenvectors */ -La_extern void -F77_NAME(dgeev)(const char* jobvl, const char* jobvr, - const int* n, double* a, const int* lda, - double* wr, double* wi, double* vl, const int* ldvl, - double* vr, const int* ldvr, - double* work, const int* lwork, int* info); -/* DGEEVX - compute for an N-by-N real nonsymmetric matrix A, the */ -/* eigenvalues and, optionally, the left and/or right eigenvectors */ -La_extern void -F77_NAME(dgeevx)(const char* balanc, const char* jobvl, const char* jobvr, - const char* sense, const int* n, double* a, const int* lda, - double* wr, double* wi, double* vl, const int* ldvl, - double* vr, const int* ldvr, int* ilo, int* ihi, - double* scale, double* abnrm, double* rconde, double* rcondv, - double* work, const int* lwork, int* iwork, int* info); -/* DGEGV - compute for a pair of n-by-n real nonsymmetric */ -/* matrices A and B, the generalized eigenvalues (alphar +/- */ -/* alphai*i, beta);, and optionally, the left and/or right */ -/* generalized eigenvectors (VL and VR); */ -La_extern void -F77_NAME(dgegv)(const char* jobvl, const char* jobvr, - const int* n, double* a, const int* lda, - double* b, const int* ldb, - double* alphar, double* alphai, - const double* beta, double* vl, const int* ldvl, - double* vr, const int* ldvr, - double* work, const int* lwork, int* info); -/* DGEHD2 - reduce a real general matrix A to upper Hessenberg */ -/* form H by an orthogonal similarity transformation */ -La_extern void -F77_NAME(dgehd2)(const int* n, const int* ilo, const int* ihi, - double* a, const int* lda, double* tau, - double* work, int* info); -/* DGEHRD - reduce a real general matrix A to upper Hessenberg */ -/* form H by an orthogonal similarity transformation */ -La_extern void -F77_NAME(dgehrd)(const int* n, const int* ilo, const int* ihi, - double* a, const int* lda, double* tau, - double* work, const int* lwork, int* info); -/* DGELQ2 - compute an LQ factorization of a real m by n matrix A */ -La_extern void -F77_NAME(dgelq2)(const int* m, const int* n, - double* a, const int* lda, double* tau, - double* work, int* info); -/* DGELQF - compute an LQ factorization of a real M-by-N matrix A */ -La_extern void -F77_NAME(dgelqf)(const int* m, const int* n, - double* a, const int* lda, double* tau, - double* work, const int* lwork, int* info); -/* DGELS - solve overdetermined or underdetermined real linear */ -/* systems involving an M-by-N matrix A, or its transpose, using a */ -/* QR or LQ factorization of A */ -La_extern void -F77_NAME(dgels)(const char* trans, const int* m, const int* n, - const int* nrhs, double* a, const int* lda, - double* b, const int* ldb, - double* work, const int* lwork, int* info); -/* DGELSS - compute the minimum norm solution to a real linear */ -/* least squares problem */ -La_extern void -F77_NAME(dgelss)(const int* m, const int* n, const int* nrhs, - double* a, const int* lda, double* b, const int* ldb, - double* s, double* rcond, int* rank, - double* work, const int* lwork, int* info); -/* DGELSY - compute the minimum-norm solution to a real linear */ -/* least squares problem */ -La_extern void -F77_NAME(dgelsy)(const int* m, const int* n, const int* nrhs, - double* a, const int* lda, double* b, const int* ldb, - int* jpvt, const double* rcond, int* rank, - double* work, const int* lwork, int* info); -/* DGEQL2 - compute a QL factorization of a real m by n matrix A */ -La_extern void -F77_NAME(dgeql2)(const int* m, const int* n, double* a, const int* lda, - double* tau, double* work, int* info); -/* DGEQLF - compute a QL factorization of a real M-by-N matrix A */ -La_extern void -F77_NAME(dgeqlf)(const int* m, const int* n, - double* a, const int* lda, double* tau, - double* work, const int* lwork, int* info); -/* DGEQP3 - compute a QR factorization with column pivoting of a */ -/* real M-by-N matrix A using level 3 BLAS */ -La_extern void -F77_NAME(dgeqp3)(const int* m, const int* n, double* a, const int* lda, - int* jpvt, double* tau, double* work, const int* lwork, - int* info); -/* DGEQPF - compute a QR factorization with column pivoting of a */ -/* real M-by-N matrix A */ -La_extern void -F77_NAME(dgeqpf)(const int* m, const int* n, double* a, const int* lda, - int* jpvt, double* tau, double* work, int* info); -/* DGEQR2 - compute a QR factorization of a real m by n matrix A */ -La_extern void -F77_NAME(dgeqr2)(const int* m, const int* n, double* a, const int* lda, - double* tau, double* work, int* info); -/* DGEQRF - compute a QR factorization of a real M-by-N matrix A */ -La_extern void -F77_NAME(dgeqrf)(const int* m, const int* n, double* a, const int* lda, - double* tau, double* work, const int* lwork, int* info); -/* DGERFS - improve the computed solution to a system of linear */ -/* equations and provides error bounds and backward error */ -/* estimates for the solution */ -La_extern void -F77_NAME(dgerfs)(const char* trans, const int* n, const int* nrhs, - double* a, const int* lda, double* af, const int* ldaf, - int* ipiv, double* b, const int* ldb, - double* x, const int* ldx, double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DGERQ2 - compute an RQ factorization of a real m by n matrix A */ -La_extern void -F77_NAME(dgerq2)(const int* m, const int* n, double* a, const int* lda, - double* tau, double* work, int* info); -/* DGERQF - compute an RQ factorization of a real M-by-N matrix A */ -La_extern void -F77_NAME(dgerqf)(const int* m, const int* n, double* a, const int* lda, - double* tau, double* work, const int* lwork, int* info); -/* DGESV - compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dgesv)(const int* n, const int* nrhs, double* a, const int* lda, - int* ipiv, double* b, const int* ldb, int* info); -/* DGESVD - compute the singular value decomposition (SVD); of a */ -/* real M-by-N matrix A, optionally computing the left and/or */ -/* right singular vectors */ -La_extern void -F77_NAME(dgesvd)(const char* jobu, const char* jobvt, const int* m, - const int* n, double* a, const int* lda, double* s, - double* u, const int* ldu, double* vt, const int* ldvt, - double* work, const int* lwork, int* info); -/* DGESVX - use the LU factorization to compute the solution to a */ -/* real system of linear equations A * X = B, */ -La_extern void -F77_NAME(dgesvx)(const int* fact, const char* trans, const int* n, - const int* nrhs, double* a, const int* lda, - double* af, const int* ldaf, int* ipiv, - char *equed, double* r, double* c, - double* b, const int* ldb, - double* x, const int* ldx, - double* rcond, double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DGETF2 - compute an LU factorization of a general m-by-n */ -/* matrix A using partial pivoting with row interchanges */ -La_extern void -F77_NAME(dgetf2)(const int* m, const int* n, double* a, const int* lda, - int* ipiv, int* info); -/* DGETRF - compute an LU factorization of a general M-by-N */ -/* matrix A using partial pivoting with row interchanges */ -La_extern void -F77_NAME(dgetrf)(const int* m, const int* n, double* a, const int* lda, - int* ipiv, int* info); -/* DGETRI - compute the inverse of a matrix using the LU */ -/* factorization computed by DGETRF */ -La_extern void -F77_NAME(dgetri)(const int* n, double* a, const int* lda, - int* ipiv, double* work, const int* lwork, int* info); -/* DGETRS - solve a system of linear equations A * X = B or A' * */ -/* X = B with a general N-by-N matrix A using the LU factorization */ -/* computed by DGETRF */ -La_extern void -F77_NAME(dgetrs)(const char* trans, const int* n, const int* nrhs, - const double* a, const int* lda, const int* ipiv, - double* b, const int* ldb, int* info); - -/* Double precision General matrices Generalized problems */ - -/* DGGBAK - form the right or left eigenvectors of a real */ -/* generalized eigenvalue problem A*x = lambda*B*x, by backward */ -/* transformation on the computed eigenvectors of the balanced */ -/* pair of matrices output by DGGBAL */ -La_extern void -F77_NAME(dggbak)(const char* job, const char* side, - const int* n, const int* ilo, const int* ihi, - double* lscale, double* rscale, const int* m, - double* v, const int* ldv, int* info); -/* DGGBAL - balance a pair of general real matrices (A,B); */ -La_extern void -F77_NAME(dggbal)(const char* job, const int* n, double* a, const int* lda, - double* b, const int* ldb, int* ilo, int* ihi, - double* lscale, double* rscale, double* work, int* info); -/* DGGES - compute for a pair of N-by-N real nonsymmetric */ -/* matrices A, B the generalized eigenvalues, the generalized */ -/* real Schur form (S,T), optionally, the left and/or right matrices */ -/* of Schur vectors (VSL and VSR)*/ -La_extern void -F77_NAME(dgges)(const char* jobvsl, const char* jobvsr, const char* sort, - int (*delztg)(double*, double*, double*), - const int* n, double* a, const int* lda, - double* b, const int* ldb, double* alphar, - double* alphai, const double* beta, - double* vsl, const int* ldvsl, - double* vsr, const int* ldvsr, - double* work, const int* lwork, int* bwork, int* info); - -/* DGGGLM - solve a general Gauss-Markov linear model (GLM) problem */ -La_extern void -F77_NAME(dggglm)(const int* n, const int* m, const int* p, - double* a, const int* lda, double* b, const int* ldb, - double* d, double* x, double* y, - double* work, const int* lwork, int* info); -/* DGGHRD - reduce a pair of real matrices (A,B); to generalized */ -/* upper Hessenberg form using orthogonal transformations, where A */ -/* is a general matrix and B is upper triangular */ -La_extern void -F77_NAME(dgghrd)(const char* compq, const char* compz, const int* n, - const int* ilo, const int* ihi, double* a, const int* lda, - double* b, const int* ldb, double* q, const int* ldq, - double* z, const int* ldz, int* info); -/* DGGLSE - solve the linear equality-constrained least squares */ -/* (LSE) problem */ -La_extern void -F77_NAME(dgglse)(const int* m, const int* n, const int* p, - double* a, const int* lda, - double* b, const int* ldb, - double* c, double* d, double* x, - double* work, const int* lwork, int* info); -/* DGGQRF - compute a generalized QR factorization of an N-by-M */ -/* matrix A and an N-by-P matrix B */ -La_extern void -F77_NAME(dggqrf)(const int* n, const int* m, const int* p, - double* a, const int* lda, double* taua, - double* b, const int* ldb, double* taub, - double* work, const int* lwork, int* info); -/* DGGRQF - compute a generalized RQ factorization of an M-by-N */ -/* matrix A and a P-by-N matrix B */ -La_extern void -F77_NAME(dggrqf)(const int* m, const int* p, const int* n, - double* a, const int* lda, double* taua, - double* b, const int* ldb, double* taub, - double* work, const int* lwork, int* info); -/* DGGSVD - compute the generalized singular value decomposition */ -/* (GSVD) of an M-by-N real matrix A and P-by-N real matrix B */ -La_extern void -F77_NAME(dggsvd)(const char* jobu, const char* jobv, const char* jobq, - const int* m, const int* n, const int* p, - const int* k, const int* l, - double* a, const int* lda, - double* b, const int* ldb, - const double* alpha, const double* beta, - double* u, const int* ldu, - double* v, const int* ldv, - double* q, const int* ldq, - double* work, int* iwork, int* info); - -/* Double precision General Tridiagonal matrices */ - -/* DGTCON - estimate the reciprocal of the condition number of a real */ -/* tridiagonal matrix A using the LU factorization as computed by DGTTRF */ -La_extern void -F77_NAME(dgtcon)(const char* norm, const int* n, double* dl, double* d, - double* du, double* du2, int* ipiv, const double* anorm, - double* rcond, double* work, int* iwork, int* info); -/* DGTRFS - improve the computed solution to a system of linear equations */ -/* when the coefficient matrix is tridiagonal, and provides error bounds */ -/* and backward error estimates for the solution */ -La_extern void -F77_NAME(dgtrfs)(const char* trans, const int* n, const int* nrhs, - double* dl, double* d, double* du, double* dlf, - double* df, double* duf, double* du2, - int* ipiv, double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DGTSV - solve the equation A*X = B, */ -La_extern void -F77_NAME(dgtsv)(const int* n, const int* nrhs, - double* dl, double* d, double* du, - double* b, const int* ldb, int* info); -/* DGTSVX - use the LU factorization to compute the solution to a */ -/* real system of linear equations A * X = B or A**T * X = B, */ -La_extern void -F77_NAME(dgtsvx)(const int* fact, const char* trans, - const int* n, const int* nrhs, - double* dl, double* d, double* du, - double* dlf, double* df, double* duf, - double* du2, int* ipiv, - double* b, const int* ldb, - double* x, const int* ldx, - double* rcond, double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DGTTRF - compute an LU factorization of a real tridiagonal matrix */ -/* A using elimination with partial pivoting and row interchanges */ -La_extern void -F77_NAME(dgttrf)(const int* n, double* dl, double* d, - double* du, double* du2, int* ipiv, int* info); -/* DGTTRS - solve one of the systems of equations A*X = B or */ -/* A'*X = B, */ -La_extern void -F77_NAME(dgttrs)(const char* trans, const int* n, const int* nrhs, - double* dl, double* d, double* du, double* du2, - int* ipiv, double* b, const int* ldb, int* info); - -/* Double precision Orthogonal matrices */ - -/* DOPGTR - generate a real orthogonal matrix Q which is defined */ -/* as the product of n-1 elementary reflectors H(i); of order n, */ -/* as returned by DSPTRD using packed storage */ -La_extern void -F77_NAME(dopgtr)(const char* uplo, const int* n, - const double* ap, const double* tau, - double* q, const int* ldq, - double* work, int* info); -/* DOPMTR - overwrite the general real M-by-N matrix C with */ -/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dopmtr)(const char* side, const char* uplo, - const char* trans, const int* m, const int* n, - const double* ap, const double* tau, - double* c, const int* ldc, - double* work, int* info); -/* DORG2L - generate an m by n real matrix Q with orthonormal */ -/* columns, */ -La_extern void -F77_NAME(dorg2l)(const int* m, const int* n, const int* k, - double* a, const int* lda, - const double* tau, double* work, int* info); -/* DORG2R - generate an m by n real matrix Q with orthonormal */ -/* columns, */ -La_extern void -F77_NAME(dorg2r)(const int* m, const int* n, const int* k, - double* a, const int* lda, - const double* tau, double* work, int* info); -/* DORGBR - generate one of the real orthogonal matrices Q or */ -/* P**T determined by DGEBRD when reducing a real matrix A to */ -/* bidiagonal form */ -La_extern void -F77_NAME(dorgbr)(const char* vect, const int* m, - const int* n, const int* k, - double* a, const int* lda, - const double* tau, double* work, - const int* lwork, int* info); -/* DORGHR - generate a real orthogonal matrix Q which is defined */ -/* as the product of IHI-ILO elementary reflectors of order N, as */ -/* returned by DGEHRD */ -La_extern void -F77_NAME(dorghr)(const int* n, const int* ilo, const int* ihi, - double* a, const int* lda, const double* tau, - double* work, const int* lwork, int* info); -/* DORGL2 - generate an m by n real matrix Q with orthonormal */ -/* rows, */ -La_extern void -F77_NAME(dorgl2)(const int* m, const int* n, const int* k, - double* a, const int* lda, const double* tau, - double* work, int* info); -/* DORGLQ - generate an M-by-N real matrix Q with orthonormal */ -/* rows, */ -La_extern void -F77_NAME(dorglq)(const int* m, const int* n, const int* k, - double* a, const int* lda, - const double* tau, double* work, - const int* lwork, int* info); -/* DORGQL - generate an M-by-N real matrix Q with orthonormal */ -/* columns, */ -La_extern void -F77_NAME(dorgql)(const int* m, const int* n, const int* k, - double* a, const int* lda, - const double* tau, double* work, - const int* lwork, int* info); -/* DORGQR - generate an M-by-N real matrix Q with orthonormal */ -/* columns, */ -La_extern void -F77_NAME(dorgqr)(const int* m, const int* n, const int* k, - double* a, const int* lda, const double* tau, - double* work, const int* lwork, int* info); -/* DORGR2 - generate an m by n real matrix Q with orthonormal */ -/* rows, */ -La_extern void -F77_NAME(dorgr2)(const int* m, const int* n, const int* k, - double* a, const int* lda, const double* tau, - double* work, int* info); -/* DORGRQ - generate an M-by-N real matrix Q with orthonormal rows */ -La_extern void -F77_NAME(dorgrq)(const int* m, const int* n, const int* k, - double* a, const int* lda, const double* tau, - double* work, const int* lwork, int* info); -/* DORGTR - generate a real orthogonal matrix Q which is defined */ -/* as the product of n-1 elementary reflectors of order const int* n, as */ -/* returned by DSYTRD */ -La_extern void -F77_NAME(dorgtr)(const char* uplo, const int* n, - double* a, const int* lda, const double* tau, - double* work, const int* lwork, int* info); -/* DORM2L - overwrite the general real m by n matrix C with Q * */ -/* C if SIDE = 'L' and TRANS = 'N', or Q'* C if SIDE = 'L' and */ -/* TRANS = 'T', or C * Q if SIDE = 'R' and TRANS = 'N', or C * */ -/* Q' if SIDE = 'R' and TRANS = 'T', */ -La_extern void -F77_NAME(dorm2l)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, - const double* tau, double* c, const int* ldc, - double* work, int* info); -/* DORM2R - overwrite the general real m by n matrix C with Q * C */ -/* if SIDE = 'L' and TRANS = 'N', or Q'* C if SIDE = 'L' and */ -/* TRANS = 'T', or C * Q if SIDE = 'R' and TRANS = 'N', or C * */ -/* Q' if SIDE = 'R' and TRANS = 'T', */ -La_extern void -F77_NAME(dorm2r)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, const double* tau, - double* c, const int* ldc, double* work, int* info); -/* DORMBR - VECT = 'Q', DORMBR overwrites the general real M-by-N */ -/* matrix C with SIDE = 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dormbr)(const char* vect, const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, const double* tau, - double* c, const int* ldc, - double* work, const int* lwork, int* info); -/* DORMHR - overwrite the general real M-by-N matrix C with */ -/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dormhr)(const char* side, const char* trans, const int* m, - const int* n, const int* ilo, const int* ihi, - const double* a, const int* lda, const double* tau, - double* c, const int* ldc, - double* work, const int* lwork, int* info); -/* DORML2 - overwrite the general real m by n matrix C with Q * */ -/* C if SIDE = 'L' and TRANS = 'N', or Q'* C if SIDE = 'L' and */ -/* TRANS = 'T', or C * Q if SIDE = 'R' and TRANS = 'N', or C * */ -/* Q' if SIDE = 'R' and TRANS = 'T', */ -La_extern void -F77_NAME(dorml2)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, const double* tau, - double* c, const int* ldc, double* work, int* info); -/* DORMLQ - overwrite the general real M-by-N matrix C with */ -/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dormlq)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, - const double* tau, double* c, const int* ldc, - double* work, const int* lwork, int* info); -/* DORMQL - overwrite the general real M-by-N matrix C with */ -/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dormql)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, - const double* tau, double* c, const int* ldc, - double* work, const int* lwork, int* info); -/* DORMQR - overwrite the general real M-by-N matrix C with SIDE = */ -/* 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dormqr)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, - const double* tau, double* c, const int* ldc, - double* work, const int* lwork, int* info); -/* DORMR2 - overwrite the general real m by n matrix C with Q * */ -/* C if SIDE = 'L' and TRANS = 'N', or Q'* C if SIDE = 'L' and */ -/* TRANS = 'T', or C * Q if SIDE = 'R' and TRANS = 'N', or C * */ -/* Q' if SIDE = 'R' and TRANS = 'T', */ -La_extern void -F77_NAME(dormr2)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, - const double* tau, double* c, const int* ldc, - double* work, int* info); -/* DORMRQ - overwrite the general real M-by-N matrix C with */ -/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dormrq)(const char* side, const char* trans, - const int* m, const int* n, const int* k, - const double* a, const int* lda, - const double* tau, double* c, const int* ldc, - double* work, const int* lwork, int* info); -/* DORMTR - overwrite the general real M-by-N matrix C with */ -/* SIDE = 'L' SIDE = 'R' TRANS = 'N' */ -La_extern void -F77_NAME(dormtr)(const char* side, const char* uplo, - const char* trans, const int* m, const int* n, - const double* a, const int* lda, - const double* tau, double* c, const int* ldc, - double* work, const int* lwork, int* info); - -/* Double precision Positive definite Band matrices */ - -/* DPBCON - estimate the reciprocal of the condition number (in */ -/* the 1-norm); of a real symmetric positive definite band matrix */ -/* using the Cholesky factorization A = U**T*U or A = L*L**T */ -/* computed by DPBTRF */ -La_extern void -F77_NAME(dpbcon)(const char* uplo, const int* n, const int* kd, - const double* ab, const int* ldab, - const double* anorm, double* rcond, - double* work, int* iwork, int* info); -/* DPBEQU - compute row and column scalings intended to */ -/* equilibrate a symmetric positive definite band matrix A and */ -/* reduce its condition number (with respect to the two-norm); */ -La_extern void -F77_NAME(dpbequ)(const char* uplo, const int* n, const int* kd, - const double* ab, const int* ldab, - double* s, double* scond, double* amax, int* info); -/* DPBRFS - improve the computed solution to a system of linear */ -/* equations when the coefficient matrix is symmetric positive */ -/* definite and banded, and provides error bounds and backward */ -/* error estimates for the solution */ -La_extern void -F77_NAME(dpbrfs)(const char* uplo, const int* n, - const int* kd, const int* nrhs, - const double* ab, const int* ldab, - const double* afb, const int* ldafb, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DPBSTF - compute a split Cholesky factorization of a real */ -/* symmetric positive definite band matrix A */ -La_extern void -F77_NAME(dpbstf)(const char* uplo, const int* n, const int* kd, - double* ab, const int* ldab, int* info); -/* DPBSV - compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dpbsv)(const char* uplo, const int* n, - const int* kd, const int* nrhs, - double* ab, const int* ldab, - double* b, const int* ldb, int* info); -/* DPBSVX - use the Cholesky factorization A = U**T*U or A = */ -/* L*L**T to compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dpbsvx)(const int* fact, const char* uplo, const int* n, - const int* kd, const int* nrhs, - double* ab, const int* ldab, - double* afb, const int* ldafb, - char* equed, double* s, - double* b, const int* ldb, - double* x, const int* ldx, double* rcond, - double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DPBTF2 - compute the Cholesky factorization of a real */ -/* symmetric positive definite band matrix A */ -La_extern void -F77_NAME(dpbtf2)(const char* uplo, const int* n, const int* kd, - double* ab, const int* ldab, int* info); -/* DPBTRF - compute the Cholesky factorization of a real */ -/* symmetric positive definite band matrix A */ -La_extern void -F77_NAME(dpbtrf)(const char* uplo, const int* n, const int* kd, - double* ab, const int* ldab, int* info); -/* DPBTRS - solve a system of linear equations A*X = B with a */ -/* symmetric positive definite band matrix A using the Cholesky */ -/* factorization A = U**T*U or A = L*L**T computed by DPBTRF */ -La_extern void -F77_NAME(dpbtrs)(const char* uplo, const int* n, - const int* kd, const int* nrhs, - const double* ab, const int* ldab, - double* b, const int* ldb, int* info); - -/* Double precision Positive definite matrices */ - -/* DPOCON - estimate the reciprocal of the condition number (in */ -/* the 1-norm); of a real symmetric positive definite matrix using */ -/* the Cholesky factorization A = U**T*U or A = L*L**T computed by */ -/* DPOTRF */ -La_extern void -F77_NAME(dpocon)(const char* uplo, const int* n, - const double* a, const int* lda, - const double* anorm, double* rcond, - double* work, int* iwork, int* info); -/* DPOEQU - compute row and column scalings intended to */ -/* equilibrate a symmetric positive definite matrix A and reduce */ -/* its condition number (with respect to the two-norm); */ -La_extern void -F77_NAME(dpoequ)(const int* n, const double* a, const int* lda, - double* s, double* scond, double* amax, int* info); -/* DPORFS - improve the computed solution to a system of linear */ -/* equations when the coefficient matrix is symmetric positive */ -/* definite, */ -La_extern void -F77_NAME(dporfs)(const char* uplo, const int* n, const int* nrhs, - const double* a, const int* lda, - const double* af, const int* ldaf, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DPOSV - compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dposv)(const char* uplo, const int* n, const int* nrhs, - double* a, const int* lda, - double* b, const int* ldb, int* info); -/* DPOSVX - use the Cholesky factorization A = U**T*U or A = */ -/* L*L**T to compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dposvx)(const int* fact, const char* uplo, - const int* n, const int* nrhs, - double* a, const int* lda, - double* af, const int* ldaf, char* equed, - double* s, double* b, const int* ldb, - double* x, const int* ldx, double* rcond, - double* ferr, double* berr, double* work, - int* iwork, int* info); -/* DPOTF2 - compute the Cholesky factorization of a real */ -/* symmetric positive definite matrix A */ -La_extern void -F77_NAME(dpotf2)(const char* uplo, const int* n, - double* a, const int* lda, int* info); -/* DPOTRF - compute the Cholesky factorization of a real */ -/* symmetric positive definite matrix A */ -La_extern void -F77_NAME(dpotrf)(const char* uplo, const int* n, - double* a, const int* lda, int* info); -/* DPOTRI - compute the inverse of a real symmetric positive */ -/* definite matrix A using the Cholesky factorization A = U**T*U */ -/* or A = L*L**T computed by DPOTRF */ -La_extern void -F77_NAME(dpotri)(const char* uplo, const int* n, - double* a, const int* lda, int* info); -/* DPOTRS - solve a system of linear equations A*X = B with a */ -/* symmetric positive definite matrix A using the Cholesky */ -/* factorization A = U**T*U or A = L*L**T computed by DPOTRF */ -La_extern void -F77_NAME(dpotrs)(const char* uplo, const int* n, - const int* nrhs, const double* a, const int* lda, - double* b, const int* ldb, int* info); -/* DPPCON - estimate the reciprocal of the condition number (in */ -/* the 1-norm); of a real symmetric positive definite packed */ -/* matrix using the Cholesky factorization A = U**T*U or A = */ -/* L*L**T computed by DPPTRF */ -La_extern void -F77_NAME(dppcon)(const char* uplo, const int* n, - const double* ap, const double* anorm, double* rcond, - double* work, int* iwork, int* info); -/* DPPEQU - compute row and column scalings intended to */ -/* equilibrate a symmetric positive definite matrix A in packed */ -/* storage and reduce its condition number (with respect to the */ -/* two-norm); */ -La_extern void -F77_NAME(dppequ)(const char* uplo, const int* n, - const double* ap, double* s, double* scond, - double* amax, int* info); - -/* Double precision Positive definite matrices in Packed storage */ - -/* DPPRFS - improve the computed solution to a system of linear */ -/* equations when the coefficient matrix is symmetric positive */ -/* definite and packed, and provides error bounds and backward */ -/* error estimates for the solution */ -La_extern void -F77_NAME(dpprfs)(const char* uplo, const int* n, const int* nrhs, - const double* ap, const double* afp, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DPPSV - compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dppsv)(const char* uplo, const int* n, - const int* nrhs, const double* ap, - double* b, const int* ldb, int* info); -/* DPPSVX - use the Cholesky factorization A = U**T*U or A = */ -/* L*L**T to compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dppsvx)(const int* fact, const char* uplo, - const int* n, const int* nrhs, double* ap, - double* afp, char* equed, double* s, - double* b, const int* ldb, - double* x, const int* ldx, - double* rcond, double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DPPTRF - compute the Cholesky factorization of a real */ -/* symmetric positive definite matrix A stored in packed format */ -La_extern void -F77_NAME(dpptrf)(const char* uplo, const int* n, double* ap, int* info); -/* DPPTRI - compute the inverse of a real symmetric positive */ -/* definite matrix A using the Cholesky factorization A = U**T*U */ -/* or A = L*L**T computed by DPPTRF */ -La_extern void -F77_NAME(dpptri)(const char* uplo, const int* n, double* ap, int* info); -/* DPPTRS - solve a system of linear equations A*X = B with a */ -/* symmetric positive definite matrix A in packed storage using */ -/* the Cholesky factorization A = U**T*U or A = L*L**T computed by */ -/* DPPTRF */ -La_extern void -F77_NAME(dpptrs)(const char* uplo, const int* n, - const int* nrhs, const double* ap, - double* b, const int* ldb, int* info); - -/* Double precision symmetric Positive definite Tridiagonal matrices */ - -/* DPTCON - compute the reciprocal of the condition number (in */ -/* the 1-norm); of a real symmetric positive definite tridiagonal */ -/* matrix using the factorization A = L*D*L**T or A = U**T*D*U */ -/* computed by DPTTRF */ -La_extern void -F77_NAME(dptcon)(const int* n, - const double* d, const double* e, - const double* anorm, double* rcond, - double* work, int* info); -/* DPTEQR - compute all eigenvalues and, optionally, eigenvectors */ -/* of a symmetric positive definite tridiagonal matrix by first */ -/* factoring the matrix using DPTTRF, and then calling DBDSQR to */ -/* compute the singular values of the bidiagonal factor */ -La_extern void -F77_NAME(dpteqr)(const char* compz, const int* n, double* d, - double* e, double* z, const int* ldz, - double* work, int* info); -/* DPTRFS - improve the computed solution to a system of linear */ -/* equations when the coefficient matrix is symmetric positive */ -/* definite and tridiagonal, and provides error bounds and */ -/* backward error estimates for the solution */ -La_extern void -F77_NAME(dptrfs)(const int* n, const int* nrhs, - const double* d, const double* e, - const double* df, const double* ef, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* info); -/* DPTSV - compute the solution to a real system of linear */ -/* equations A*X = B, where A is an N-by-N symmetric positive */ -/* definite tridiagonal matrix, and X and B are N-by-NRHS matrices */ -La_extern void -F77_NAME(dptsv)(const int* n, const int* nrhs, double* d, - double* e, double* b, const int* ldb, int* info); -/* DPTSVX - use the factorization A = L*D*L**T to compute the */ -/* solution to a real system of linear equations A*X = B, where A */ -/* is an N-by-N symmetric positive definite tridiagonal matrix and */ -/* X and B are N-by-NRHS matrices */ -La_extern void -F77_NAME(dptsvx)(const int* fact, const int* n, - const int* nrhs, - const double* d, const double* e, - double* df, double* ef, - const double* b, const int* ldb, - double* x, const int* ldx, double* rcond, - double* ferr, double* berr, - double* work, int* info); -/* DPTTRF - compute the factorization of a real symmetric */ -/* positive definite tridiagonal matrix A */ -La_extern void -F77_NAME(dpttrf)(const int* n, double* d, double* e, int* info); -/* DPTTRS - solve a system of linear equations A * X = B with a */ -/* symmetric positive definite tridiagonal matrix A using the */ -/* factorization A = L*D*L**T or A = U**T*D*U computed by DPTTRF */ -La_extern void -F77_NAME(dpttrs)(const int* n, const int* nrhs, - const double* d, const double* e, - double* b, const int* ldb, int* info); -/* DRSCL - multiply an n-element real vector x by the real scalar */ -/* 1/a */ -La_extern void -F77_NAME(drscl)(const int* n, const double* da, - double* x, const int* incx); - -/* Double precision Symmetric Band matrices */ - -/* DSBEV - compute all the eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric band matrix A */ -La_extern void -F77_NAME(dsbev)(const char* jobz, const char* uplo, - const int* n, const int* kd, - double* ab, const int* ldab, - double* w, double* z, const int* ldz, - double* work, int* info); -/* DSBEVD - compute all the eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric band matrix A */ -La_extern void -F77_NAME(dsbevd)(const char* jobz, const char* uplo, - const int* n, const int* kd, - double* ab, const int* ldab, - double* w, double* z, const int* ldz, - double* work, const int* lwork, - int* iwork, const int* liwork, int* info); -/* DSBEVX - compute selected eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric band matrix A */ -La_extern void -F77_NAME(dsbevx)(const char* jobz, const char* range, - const char* uplo, const int* n, const int* kd, - double* ab, const int* ldab, - double* q, const int* ldq, - const double* vl, const double* vu, - const int* il, const int* iu, - const double* abstol, - int* m, double* w, - double* z, const int* ldz, - double* work, int* iwork, - int* ifail, int* info); -/* DSBGST - reduce a real symmetric-definite banded generalized */ -/* eigenproblem A*x = lambda*B*x to standard form C*y = lambda*y, */ -La_extern void -F77_NAME(dsbgst)(const char* vect, const char* uplo, - const int* n, const int* ka, const int* kb, - double* ab, const int* ldab, - double* bb, const int* ldbb, - double* x, const int* ldx, - double* work, int* info); -/* DSBGV - compute all the eigenvalues, and optionally, the */ -/* eigenvectors of a real generalized symmetric-definite banded */ -/* eigenproblem, of the form A*x=(lambda);*B*x */ -La_extern void -F77_NAME(dsbgv)(const char* jobz, const char* uplo, - const int* n, const int* ka, const int* kb, - double* ab, const int* ldab, - double* bb, const int* ldbb, - double* w, double* z, const int* ldz, - double* work, int* info); -/* DSBTRD - reduce a real symmetric band matrix A to symmetric */ -/* tridiagonal form T by an orthogonal similarity transformation */ -La_extern void -F77_NAME(dsbtrd)(const char* vect, const char* uplo, - const int* n, const int* kd, - double* ab, const int* ldab, - double* d, double* e, - double* q, const int* ldq, - double* work, int* info); - -/* Double precision Symmetric Packed matrices */ - -/* DSPCON - estimate the reciprocal of the condition number (in */ -/* the 1-norm); of a real symmetric packed matrix A using the */ -/* factorization A = U*D*U**T or A = L*D*L**T computed by DSPTRF */ -La_extern void -F77_NAME(dspcon)(const char* uplo, const int* n, - const double* ap, const int* ipiv, - const double* anorm, double* rcond, - double* work, int* iwork, int* info); -/* DSPEV - compute all the eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric matrix A in packed storage */ -La_extern void -F77_NAME(dspev)(const char* jobz, const char* uplo, const int* n, - double* ap, double* w, double* z, const int* ldz, - double* work, int* info); -/* DSPEVD - compute all the eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric matrix A in packed storage */ -La_extern void -F77_NAME(dspevd)(const char* jobz, const char* uplo, - const int* n, double* ap, double* w, - double* z, const int* ldz, - double* work, const int* lwork, - int* iwork, const int* liwork, int* info); -/* DSPEVX - compute selected eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric matrix A in packed storage */ -La_extern void -F77_NAME(dspevx)(const char* jobz, const char* range, - const char* uplo, const int* n, double* ap, - const double* vl, const double* vu, - const int* il, const int* iu, - const double* abstol, - int* m, double* w, - double* z, const int* ldz, - double* work, int* iwork, - int* ifail, int* info); -/* DSPGST - reduce a real symmetric-definite generalized */ -/* eigenproblem to standard form, using packed storage */ -La_extern void -F77_NAME(dspgst)(const int* itype, const char* uplo, - const int* n, double* ap, double* bp, int* info); -/* DSPGV - compute all the eigenvalues and, optionally, the */ -/* eigenvectors of a real generalized symmetric-definite */ -/* eigenproblem, of the form A*x=(lambda)*B*x, A*Bx=(lambda)*x, */ -/* or B*A*x=(lambda)*x */ -La_extern void -F77_NAME(dspgv)(const int* itype, const char* jobz, - const char* uplo, const int* n, - double* ap, double* bp, double* w, - double* z, const int* ldz, - double* work, int* info); - -/* DSPRFS - improve the computed solution to a system of linear */ -/* equations when the coefficient matrix is symmetric indefinite */ -/* and packed, and provides error bounds and backward error */ -/* estimates for the solution */ -La_extern void -F77_NAME(dsprfs)(const char* uplo, const int* n, - const int* nrhs, const double* ap, - const double* afp, const int* ipiv, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); - -/* DSPSV - compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dspsv)(const char* uplo, const int* n, - const int* nrhs, double* ap, int* ipiv, - double* b, const int* ldb, int* info); - -/* DSPSVX - use the diagonal pivoting factorization A = U*D*U**T */ -/* or A = L*D*L**T to compute the solution to a real system of */ -/* linear equations A * X = B, where A is an N-by-N symmetric */ -/* matrix stored in packed format and X and B are N-by-NRHS */ -/* matrices */ -La_extern void -F77_NAME(dspsvx)(const int* fact, const char* uplo, - const int* n, const int* nrhs, - const double* ap, double* afp, int* ipiv, - const double* b, const int* ldb, - double* x, const int* ldx, - double* rcond, double* ferr, double* berr, - double* work, int* iwork, int* info); - -/* DSPTRD - reduce a real symmetric matrix A stored in packed */ -/* form to symmetric tridiagonal form T by an orthogonal */ -/* similarity transformation */ -La_extern void -F77_NAME(dsptrd)(const char* uplo, const int* n, - double* ap, double* d, double* e, - double* tau, int* info); - -/* DSPTRF - compute the factorization of a real symmetric matrix */ -/* A stored in packed format using the Bunch-Kaufman diagonal */ -/* pivoting method */ -La_extern void -F77_NAME(dsptrf)(const char* uplo, const int* n, - double* ap, int* ipiv, int* info); - -/* DSPTRI - compute the inverse of a real symmetric indefinite */ -/* matrix A in packed storage using the factorization A = U*D*U**T */ -/* or A = L*D*L**T computed by DSPTRF */ -La_extern void -F77_NAME(dsptri)(const char* uplo, const int* n, - double* ap, const int* ipiv, - double* work, int* info); - -/* DSPTRS - solve a system of linear equations A*X = B with a */ -/* real symmetric matrix A stored in packed format using the */ -/* factorization A = U*D*U**T or A = L*D*L**T computed by DSPTRF */ -La_extern void -F77_NAME(dsptrs)(const char* uplo, const int* n, - const int* nrhs, const double* ap, - const int* ipiv, double* b, const int* ldb, int* info); - -/* Double precision Symmetric Tridiagonal matrices */ - -/* DSTEBZ - compute the eigenvalues of a symmetric tridiagonal */ -/* matrix T */ -La_extern void -F77_NAME(dstebz)(const char* range, const char* order, const int* n, - const double* vl, const double* vu, - const int* il, const int* iu, - const double *abstol, - const double* d, const double* e, - int* m, int* nsplit, double* w, - int* iblock, int* isplit, - double* work, int* iwork, - int* info); -/* DSTEDC - compute all eigenvalues and, optionally, eigenvectors */ -/* of a symmetric tridiagonal matrix using the divide and conquer */ -/* method */ -La_extern void -F77_NAME(dstedc)(const char* compz, const int* n, - double* d, double* e, - double* z, const int* ldz, - double* work, const int* lwork, - int* iwork, const int* liwork, int* info); -/* DSTEIN - compute the eigenvectors of a real symmetric */ -/* tridiagonal matrix T corresponding to specified eigenvalues, */ -/* using inverse iteration */ -La_extern void -F77_NAME(dstein)(const int* n, const double* d, const double* e, - const int* m, const double* w, - const int* iblock, const int* isplit, - double* z, const int* ldz, - double* work, int* iwork, - int* ifail, int* info); -/* DSTEQR - compute all eigenvalues and, optionally, eigenvectors */ -/* of a symmetric tridiagonal matrix using the implicit QL or QR */ -/* method */ -La_extern void -F77_NAME(dsteqr)(const char* compz, const int* n, double* d, double* e, - double* z, const int* ldz, double* work, int* info); -/* DSTERF - compute all eigenvalues of a symmetric tridiagonal */ -/* matrix using the Pal-Walker-Kahan variant of the QL or QR */ -/* algorithm */ -La_extern void -F77_NAME(dsterf)(const int* n, double* d, double* e, int* info); -/* DSTEV - compute all eigenvalues and, optionally, eigenvectors */ -/* of a real symmetric tridiagonal matrix A */ -La_extern void -F77_NAME(dstev)(const char* jobz, const int* n, - double* d, double* e, - double* z, const int* ldz, - double* work, int* info); -/* DSTEVD - compute all eigenvalues and, optionally, eigenvectors */ -/* of a real symmetric tridiagonal matrix */ -La_extern void -F77_NAME(dstevd)(const char* jobz, const int* n, - double* d, double* e, - double* z, const int* ldz, - double* work, const int* lwork, - int* iwork, const int* liwork, int* info); -/* DSTEVX - compute selected eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric tridiagonal matrix A */ -La_extern void -F77_NAME(dstevx)(const char* jobz, const char* range, - const int* n, double* d, double* e, - const double* vl, const double* vu, - const int* il, const int* iu, - const double* abstol, - int* m, double* w, - double* z, const int* ldz, - double* work, int* iwork, - int* ifail, int* info); - -/* Double precision SYmmetric matrices */ - -/* DSYCON - estimate the reciprocal of the condition number (in */ -/* the 1-norm); of a real symmetric matrix A using the */ -/* factorization A = U*D*U**T or A = L*D*L**T computed by DSYTRF */ -La_extern void -F77_NAME(dsycon)(const char* uplo, const int* n, - const double* a, const int* lda, - const int* ipiv, - const double* anorm, double* rcond, - double* work, int* iwork, int* info); -/* DSYEV - compute all eigenvalues and, optionally, eigenvectors */ -/* of a real symmetric matrix A */ -La_extern void -F77_NAME(dsyev)(const char* jobz, const char* uplo, - const int* n, double* a, const int* lda, - double* w, double* work, const int* lwork, int* info); -/* DSYEVD - compute all eigenvalues and, optionally, eigenvectors */ -/* of a real symmetric matrix A */ -La_extern void -F77_NAME(dsyevd)(const char* jobz, const char* uplo, - const int* n, double* a, const int* lda, - double* w, double* work, const int* lwork, - int* iwork, const int* liwork, int* info); -/* DSYEVX - compute selected eigenvalues and, optionally, */ -/* eigenvectors of a real symmetric matrix A */ -La_extern void -F77_NAME(dsyevx)(const char* jobz, const char* range, - const char* uplo, const int* n, - double* a, const int* lda, - const double* vl, const double* vu, - const int* il, const int* iu, - const double* abstol, - int* m, double* w, - double* z, const int* ldz, - double* work, const int* lwork, int* iwork, - int* ifail, int* info); -/* DSYEVR - compute all eigenvalues and, optionally, eigenvectors */ -/* of a real symmetric matrix A */ -La_extern void -F77_NAME(dsyevr)(const char *jobz, const char *range, const char *uplo, - const int *n, double *a, const int *lda, - const double *vl, const double *vu, - const int *il, const int *iu, - const double *abstol, int *m, double *w, - double *z, const int *ldz, int *isuppz, - double *work, const int *lwork, - int *iwork, const int *liwork, - int *info); -/* DSYGS2 - reduce a real symmetric-definite generalized */ -/* eigenproblem to standard form */ -La_extern void -F77_NAME(dsygs2)(const int* itype, const char* uplo, - const int* n, double* a, const int* lda, - const double* b, const int* ldb, int* info); -/* DSYGST - reduce a real symmetric-definite generalized */ -/* eigenproblem to standard form */ -La_extern void -F77_NAME(dsygst)(const int* itype, const char* uplo, - const int* n, double* a, const int* lda, - const double* b, const int* ldb, int* info); -/* DSYGV - compute all the eigenvalues, and optionally, the */ -/* eigenvectors of a real generalized symmetric-definite */ -/* eigenproblem, of the form A*x=(lambda);*B*x, A*Bx=(lambda);*x, */ -/* or B*A*x=(lambda);*x */ -La_extern void -F77_NAME(dsygv)(const int* itype, const char* jobz, - const char* uplo, const int* n, - double* a, const int* lda, - double* b, const int* ldb, - double* w, double* work, const int* lwork, - int* info); -/* DSYRFS - improve the computed solution to a system of linear */ -/* equations when the coefficient matrix is symmetric indefinite, */ -/* and provides error bounds and backward error estimates for the */ -/* solution */ -La_extern void -F77_NAME(dsyrfs)(const char* uplo, const int* n, - const int* nrhs, - const double* a, const int* lda, - const double* af, const int* ldaf, - const int* ipiv, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); - -/* DSYSV - compute the solution to a real system of linear */ -/* equations A * X = B, */ -La_extern void -F77_NAME(dsysv)(const char* uplo, const int* n, - const int* nrhs, - double* a, const int* lda, int* ipiv, - double* b, const int* ldb, - double* work, const int* lwork, int* info); - -/* DSYSVX - use the diagonal pivoting factorization to compute */ -/* the solution to a real system of linear equations A * X = B, */ -La_extern void -F77_NAME(dsysvx)(const int* fact, const char* uplo, - const int* n, const int* nrhs, - const double* a, const int* lda, - double* af, const int* ldaf, int* ipiv, - const double* b, const int* ldb, - double* x, const int* ldx, double* rcond, - double* ferr, double* berr, - double* work, const int* lwork, - int* iwork, int* info); - -/* DSYTD2 - reduce a real symmetric matrix A to symmetric */ -/* tridiagonal form T by an orthogonal similarity transformation */ -La_extern void -F77_NAME(dsytd2)(const char* uplo, const int* n, - double* a, const int* lda, - double* d, double* e, double* tau, - int* info); - -/* DSYTF2 - compute the factorization of a real symmetric matrix */ -/* A using the Bunch-Kaufman diagonal pivoting method */ -La_extern void -F77_NAME(dsytf2)(const char* uplo, const int* n, - double* a, const int* lda, - int* ipiv, int* info); - -/* DSYTRD - reduce a real symmetric matrix A to real symmetric */ -/* tridiagonal form T by an orthogonal similarity transformation */ -La_extern void -F77_NAME(dsytrd)(const char* uplo, const int* n, - double* a, const int* lda, - double* d, double* e, double* tau, - double* work, const int* lwork, int* info); - -/* DSYTRF - compute the factorization of a real symmetric matrix */ -/* A using the Bunch-Kaufman diagonal pivoting method */ -La_extern void -F77_NAME(dsytrf)(const char* uplo, const int* n, - double* a, const int* lda, int* ipiv, - double* work, const int* lwork, int* info); - -/* DSYTRI - compute the inverse of a real symmetric indefinite */ -/* matrix A using the factorization A = U*D*U**T or A = L*D*L**T */ -/* computed by DSYTRF */ -La_extern void -F77_NAME(dsytri)(const char* uplo, const int* n, - double* a, const int* lda, const int* ipiv, - double* work, int* info); - -/* DSYTRS - solve a system of linear equations A*X = B with a */ -/* real symmetric matrix A using the factorization A = U*D*U**T or */ -/* A = L*D*L**T computed by DSYTRF */ -La_extern void -F77_NAME(dsytrs)(const char* uplo, const int* n, - const int* nrhs, - const double* a, const int* lda, - const int* ipiv, - double* b, const int* ldb, int* info); - -/* Double precision Triangular Band matrices */ - -/* DTBCON - estimate the reciprocal of the condition number of a */ -/* triangular band matrix A, in either the 1-norm or the */ -/* infinity-norm */ -La_extern void -F77_NAME(dtbcon)(const char* norm, const char* uplo, - const char* diag, const int* n, const int* kd, - const double* ab, const int* ldab, - double* rcond, double* work, - int* iwork, int* info); -/* DTBRFS - provide error bounds and backward error estimates for */ -/* the solution to a system of linear equations with a triangular */ -/* band coefficient matrix */ -La_extern void -F77_NAME(dtbrfs)(const char* uplo, const char* trans, - const char* diag, const int* n, const int* kd, - const int* nrhs, - const double* ab, const int* ldab, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); -/* DTBTRS - solve a triangular system of the form A * X = B or */ -/* A**T * X = B, */ -La_extern void -F77_NAME(dtbtrs)(const char* uplo, const char* trans, - const char* diag, const int* n, - const int* kd, const int* nrhs, - const double* ab, const int* ldab, - double* b, const int* ldb, int* info); - -/* Double precision Triangular matrices Generalized problems */ - -/* DTGEVC - compute some or all of the right and/or left */ -/* generalized eigenvectors of a pair of real upper triangular */ -/* matrices (A,B); */ -La_extern void -F77_NAME(dtgevc)(const char* side, const char* howmny, - const int* select, const int* n, - const double* a, const int* lda, - const double* b, const int* ldb, - double* vl, const int* ldvl, - double* vr, const int* ldvr, - const int* mm, int* m, double* work, int* info); - -/* DTGSJA - compute the generalized singular value decomposition */ -/* (GSVD); of two real upper triangular (or trapezoidal); matrices */ -/* A and B */ -La_extern void -F77_NAME(dtgsja)(const char* jobu, const char* jobv, const char* jobq, - const int* m, const int* p, const int* n, - const int* k, const int* l, - double* a, const int* lda, - double* b, const int* ldb, - const double* tola, const double* tolb, - double* alpha, double* beta, - double* u, const int* ldu, - double* v, const int* ldv, - double* q, const int* ldq, - double* work, int* ncycle, int* info); - -/* Double precision Triangular matrices Packed storage */ - -/* DTPCON - estimate the reciprocal of the condition number of a */ -/* packed triangular matrix A, in either the 1-norm or the */ -/* infinity-norm */ -La_extern void -F77_NAME(dtpcon)(const char* norm, const char* uplo, - const char* diag, const int* n, - const double* ap, double* rcond, - double* work, int* iwork, int* info); - -/* DTPRFS - provide error bounds and backward error estimates for */ -/* the solution to a system of linear equations with a triangular */ -/* packed coefficient matrix */ -La_extern void -F77_NAME(dtprfs)(const char* uplo, const char* trans, - const char* diag, const int* n, - const int* nrhs, const double* ap, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); - -/* Double precision TRiangular matrices */ - -/* DTPTRI - compute the inverse of a real upper or lower */ -/* triangular matrix A stored in packed format */ -La_extern void -F77_NAME(dtptri)(const char* uplo, const char* diag, - const int* n, double* ap, int* info); - -/* DTPTRS - solve a triangular system of the form A * X = B or */ -/* A**T * X = B, */ -La_extern void -F77_NAME(dtptrs)(const char* uplo, const char* trans, - const char* diag, const int* n, - const int* nrhs, const double* ap, - double* b, const int* ldb, int* info); - -/* DTRCON - estimate the reciprocal of the condition number of a */ -/* triangular matrix A, in either the 1-norm or the infinity-norm */ -La_extern void -F77_NAME(dtrcon)(const char* norm, const char* uplo, - const char* diag, const int* n, - const double* a, const int* lda, - double* rcond, double* work, - int* iwork, int* info); - -/* DTREVC - compute some or all of the right and/or left */ -/* eigenvectors of a real upper quasi-triangular matrix T */ -La_extern void -F77_NAME(dtrevc)(const char* side, const char* howmny, - const int* select, const int* n, - const double* t, const int* ldt, - double* vl, const int* ldvl, - double* vr, const int* ldvr, - const int* mm, int* m, double* work, int* info); - -/* DTREXC - reorder the real Schur factorization of a real matrix */ -/* A = Q*T*Q**T, so that the diagonal block of T with row index */ -/* IFST is moved to row ILST */ -La_extern void -F77_NAME(dtrexc)(const char* compq, const int* n, - double* t, const int* ldt, - double* q, const int* ldq, - int* ifst, int* ILST, - double* work, int* info); - -/* DTRRFS - provide error bounds and backward error estimates for */ -/* the solution to a system of linear equations with a triangular */ -/* coefficient matrix */ -La_extern void -F77_NAME(dtrrfs)(const char* uplo, const char* trans, - const char* diag, const int* n, const int* nrhs, - const double* a, const int* lda, - const double* b, const int* ldb, - double* x, const int* ldx, - double* ferr, double* berr, - double* work, int* iwork, int* info); - -/* DTRSEN - reorder the real Schur factorization of a real matrix */ -/* A = Q*T*Q**T, so that a selected cluster of eigenvalues appears */ -/* in the leading diagonal blocks of the upper quasi-triangular */ -/* matrix T, */ -La_extern void -F77_NAME(dtrsen)(const char* job, const char* compq, - const int* select, const int* n, - double* t, const int* ldt, - double* q, const int* ldq, - double* wr, double* wi, - int* m, double* s, double* sep, - double* work, const int* lwork, - int* iwork, const int* liwork, int* info); - -/* DTRSNA - estimate reciprocal condition numbers for specified */ -/* eigenvalues and/or right eigenvectors of a real upper */ -/* quasi-triangular matrix T (or of any matrix Q*T*Q**T with Q */ -/* orthogonal); */ -La_extern void -F77_NAME(dtrsna)(const char* job, const char* howmny, - const int* select, const int* n, - const double* t, const int* ldt, - const double* vl, const int* ldvl, - const double* vr, const int* ldvr, - double* s, double* sep, const int* mm, - int* m, double* work, const int* lwork, - int* iwork, int* info); - -/* DTRSYL - solve the real Sylvester matrix equation */ -La_extern void -F77_NAME(dtrsyl)(const char* trana, const char* tranb, - const int* isgn, const int* m, const int* n, - const double* a, const int* lda, - const double* b, const int* ldb, - double* c, const int* ldc, - double* scale, int* info); - -/* DTRTI2 - compute the inverse of a real upper or lower */ -/* triangular matrix */ -La_extern void -F77_NAME(dtrti2)(const char* uplo, const char* diag, - const int* n, double* a, const int* lda, - int* info); - -/* DTRTRI - compute the inverse of a real upper or lower */ -/* triangular matrix A */ -La_extern void -F77_NAME(dtrtri)(const char* uplo, const char* diag, - const int* n, double* a, const int* lda, - int* info); - -/* DTRTRS - solve a triangular system of the form A * X = B or */ -/* A**T * X = B */ -La_extern void -F77_NAME(dtrtrs)(const char* uplo, const char* trans, - const char* diag, const int* n, const int* nrhs, - const double* a, const int* lda, - double* b, const int* ldb, int* info); - -/* DTZRQF - reduce the M-by-N ( M<=N ); real upper trapezoidal */ -/* matrix A to upper triangular form by means of orthogonal */ -/* transformations */ -La_extern void -F77_NAME(dtzrqf)(const int* m, const int* n, - double* a, const int* lda, - double* tau, int* info); - - - -/* Double precision utilties in Lapack */ -/* DHGEQZ - implement a single-/double-shift version of the QZ */ -/* method for finding the generalized eigenvalues */ -/* w(j);=(ALPHAR(j); + i*ALPHAI(j););/BETAR(j); of the equation */ -/* det( A - w(i); B ); = 0 In addition, the pair A,B may be */ -/* reduced to generalized Schur form */ -La_extern void -F77_NAME(dhgeqz)(const char* job, const char* compq, const char* compz, - const int* n, const int *ILO, const int* IHI, - double* a, const int* lda, - double* b, const int* ldb, - double* alphar, double* alphai, const double* beta, - double* q, const int* ldq, - double* z, const int* ldz, - double* work, const int* lwork, int* info); -/* DHSEIN - use inverse iteration to find specified right and/or */ -/* left eigenvectors of a real upper Hessenberg matrix H */ -La_extern void -F77_NAME(dhsein)(const char* side, const char* eigsrc, - const char* initv, int* select, - const int* n, double* h, const int* ldh, - double* wr, double* wi, - double* vl, const int* ldvl, - double* vr, const int* ldvr, - const int* mm, int* m, double* work, - int* ifaill, int* ifailr, int* info); -/* DHSEQR - compute the eigenvalues of a real upper Hessenberg */ -/* matrix H and, optionally, the matrices T and Z from the Schur */ -/* decomposition H = Z T Z**T, where T is an upper */ -/* quasi-triangular matrix (the Schur form);, and Z is the */ -/* orthogonal matrix of Schur vectors */ -La_extern void -F77_NAME(dhseqr)(const char* job, const char* compz, const int* n, - const int* ilo, const int* ihi, - double* h, const int* ldh, - double* wr, double* wi, - double* z, const int* ldz, - double* work, const int* lwork, int* info); -/* DLABAD - take as input the values computed by SLAMCH for */ -/* underflow and overflow, and returns the square root of each of */ -/* these values if the log of LARGE is sufficiently large */ -La_extern void -F77_NAME(dlabad)(double* small, double* large); -/* DLABRD - reduce the first NB rows and columns of a real */ -/* general m by n matrix A to upper or lower bidiagonal form by an */ -/* orthogonal transformation Q' * A * P, and returns the matrices */ -/* X and Y which are needed to apply the transformation to the */ -/* unreduced part of A */ -La_extern void -F77_NAME(dlabrd)(const int* m, const int* n, const int* nb, - double* a, const int* lda, double* d, double* e, - double* tauq, double* taup, - double* x, const int* ldx, double* y, const int* ldy); -/* DLACON - estimate the 1-norm of a square, real matrix A */ -La_extern void -F77_NAME(dlacon)(const int* n, double* v, double* x, - int* isgn, double* est, int* kase); -/* DLACPY - copy all or part of a two-dimensional matrix A to */ -/* another matrix B */ -La_extern void -F77_NAME(dlacpy)(const char* uplo, const int* m, const int* n, - const double* a, const int* lda, - double* b, const int* ldb); -/* DLADIV - perform complex division in real arithmetic */ -La_extern void -F77_NAME(dladiv)(const double* a, const double* b, - const double* c, const double* d, - double* p, double* q); -/* DLAE2 - compute the eigenvalues of a 2-by-2 symmetric matrix [ A B ] */ -/* [ B C ] */ -La_extern void -F77_NAME(dlae2)(const double* a, const double* b, const double* c, - double* rt1, double* rt2); -/* DLAEBZ - contain the iteration loops which compute and use the */ -/* function N(w);, which is the count of eigenvalues of a */ -/* symmetric tridiagonal matrix T less than or equal to its */ -/* argument w */ -La_extern void -F77_NAME(dlaebz)(const int* ijob, const int* nitmax, const int* n, - const int* mmax, const int* minp, const int* nbmin, - const double* abstol, const double* reltol, - const double* pivmin, double* d, double* e, - double* e2, int* nval, double* ab, double* c, - int* mout, int* nab, double* work, int* iwork, - int* info); -/* DLAED0 - compute all eigenvalues and corresponding */ -/* eigenvectors of a symmetric tridiagonal matrix using the divide */ -/* and conquer method */ -La_extern void -F77_NAME(dlaed0)(const int* icompq, const int* qsiz, const int* n, - double* d, double* e, double* q, const int* ldq, - double* qstore, const int* ldqs, - double* work, int* iwork, int* info); -/* DLAED1 - compute the updated eigensystem of a diagonal matrix */ -/* after modification by a rank-one symmetric matrix */ -La_extern void -F77_NAME(dlaed1)(const int* n, double* d, double* q, const int* ldq, - int* indxq, const double* rho, const int* cutpnt, - double* work, int* iwork, int* info); -/* DLAED2 - merge the two sets of eigenvalues together into a */ -/* single sorted set */ -La_extern void -F77_NAME(dlaed2)(const int* k, const int* n, double* d, - double* q, const int* ldq, int* indxq, - double* rho, const int* cutpnt, double* z, - double* dlamda, double* q2, const int *ldq2, - int* indxc, int* w, int* indxp, int* indx, - int* coltyp, int* info); -/* DLAED3 - find the roots of the secular equation, as defined by */ -/* the values in double* d, W, and RHO, between KSTART and KSTOP */ -La_extern void -F77_NAME(dlaed3)(const int* k, const int* kstart, - const int *kstop, const int* n, - double* d, double* q, const int* ldq, - const double* rho, const int* cutpnt, - double* dlamda, int* q2, const int* ldq2, - int* indxc, int* ctot, double* w, - double* s, const int* lds, int* info); -/* DLAED4 - subroutine computes the I-th updated eigenvalue of a */ -/* symmetric rank-one modification to a diagonal matrix whose */ -/* elements are given in the array d, and that D(i); < D(j); for */ -/* i < j and that RHO > 0 */ -La_extern void -F77_NAME(dlaed4)(const int* n, const int* i, const double* d, - const double* z, const double* delta, - const double* rho, double* dlam, int* info); -/* DLAED5 - subroutine computes the I-th eigenvalue of a */ -/* symmetric rank-one modification of a 2-by-2 diagonal matrix */ -/* diag( D ); + RHO The diagonal elements in the array D are */ -/* assumed to satisfy D(i); < D(j); for i < j */ -La_extern void -F77_NAME(dlaed5)(const int* i, const double* d, const double* z, - double* delta, const double* rho, double* dlam); -/* DLAED6 - compute the positive or negative root (closest to the */ -/* origin); of z(1); z(2); z(3); f(x); = rho + --------- + */ -/* ---------- + --------- d(1);-x d(2);-x d(3);-x It is assumed */ -/* that if ORGATI = .true */ -La_extern void -F77_NAME(dlaed6)(const int* kniter, const int* orgati, - const double* rho, const double* d, - const double* z, const double* finit, - double* tau, int* info); -/* DLAED7 - compute the updated eigensystem of a diagonal matrix */ -/* after modification by a rank-one symmetric matrix */ -La_extern void -F77_NAME(dlaed7)(const int* icompq, const int* n, - const int* qsiz, const int* tlvls, - const int* curlvl, const int* curpbm, - double* d, double* q, const int* ldq, - int* indxq, const double* rho, const int* cutpnt, - double* qstore, double* qptr, const int* prmptr, - const int* perm, const int* givptr, - const int* givcol, const double* givnum, - double* work, int* iwork, int* info); -/* DLAED8 - merge the two sets of eigenvalues together into a */ -/* single sorted set */ -La_extern void -F77_NAME(dlaed8)(const int* icompq, const int* k, - const int* n, const int* qsiz, - double* d, double* q, const int* ldq, - const int* indxq, double* rho, - const int* cutpnt, const double* z, - double* dlamda, double* q2, const int* ldq2, - double* w, int* perm, int* givptr, - int* givcol, double* givnum, int* indxp, - int* indx, int* info); -/* DLAED9 - find the roots of the secular equation, as defined by */ -/* the values in double* d, Z, and RHO, between KSTART and KSTOP */ -La_extern void -F77_NAME(dlaed9)(const int* k, const int* kstart, const int* kstop, - const int* n, double* d, double* q, const int* ldq, - const double* rho, const double* dlamda, - const double* w, double* s, const int* lds, int* info); -/* DLAEDA - compute the Z vector corresponding to the merge step */ -/* in the CURLVLth step of the merge process with TLVLS steps for */ -/* the CURPBMth problem */ -La_extern void -F77_NAME(dlaeda)(const int* n, const int* tlvls, const int* curlvl, - const int* curpbm, const int* prmptr, const int* perm, - const int* givptr, const int* givcol, - const double* givnum, const double* q, - const int* qptr, double* z, double* ztemp, int* info); -/* DLAEIN - use inverse iteration to find a right or left */ -/* eigenvector corresponding to the eigenvalue (WR,WI); of a real */ -/* upper Hessenberg matrix H */ -La_extern void -F77_NAME(dlaein)(const int* rightv, const int* noinit, const int* n, - const double* h, const int* ldh, - const double* wr, const double* wi, - double* vr, double* vi, - double* b, const int* ldb, double* work, - const double* eps3, const double* smlnum, - const double* bignum, int* info); -/* DLAEV2 - compute the eigendecomposition of a 2-by-2 symmetric */ -/* matrix [ A B ] [ B C ] */ -La_extern void -F77_NAME(dlaev2)(const double* a, const double* b, const double* c, - double* rt1, double* rt2, double* cs1, double *sn1); -/* DLAEXC - swap adjacent diagonal blocks T11 and T22 of order 1 */ -/* or 2 in an upper quasi-triangular matrix T by an orthogonal */ -/* similarity transformation */ -La_extern void -F77_NAME(dlaexc)(const int* wantq, const int* n, double* t, const int* ldt, - double* q, const int* ldq, const int* j1, - const int* n1, const int* n2, double* work, int* info); -/* DLAG2 - compute the eigenvalues of a 2 x 2 generalized */ -/* eigenvalue problem A - w B, with scaling as necessary to aextern void */ -/* over-/underflow */ -La_extern void -F77_NAME(dlag2)(const double* a, const int* lda, const double* b, - const int* ldb, const double* safmin, - double* scale1, double* scale2, - double* wr1, double* wr2, double* wi); -/* DLAGS2 - compute 2-by-2 orthogonal matrices U, V and Q, such */ -/* that if ( UPPER ); then U'*A*Q = U'*( A1 A2 );*Q = ( x 0 ); */ -/* ( 0 A3 ); ( x x ); and V'*B*Q = V'*( B1 B2 );*Q = ( x 0 ); ( */ -/* 0 B3 ); ( x x ); or if ( .NOT.UPPER ); then U'*A*Q = U'*( A1 */ -/* 0 );*Q = ( x x ); ( A2 A3 ); ( 0 x ); and V'*B*Q = V'*( B1 0 */ -/* );*Q = ( x x ); ( B2 B3 ); ( 0 x ); The rows of the */ -/* transformed A and B are parallel, where U = ( CSU SNU );, V = */ -/* ( CSV SNV );, Q = ( CSQ SNQ ); ( -SNU CSU ); ( -SNV CSV ); ( */ -/* -SNQ CSQ ); Z' denotes the transpose of Z */ -La_extern void -F77_NAME(dlags2)(const int* upper, - const double* a1, const double* a2, const double* a3, - const double* b1, const double* b2, const double* b3, - double* csu, double* snu, - double* csv, double* snv, double *csq, double *snq); -/* DLAGTF - factorize the matrix (T - lambda*I);, where T is an n */ -/* by n tridiagonal matrix and lambda is a scalar, as T - */ -/* lambda*I = PLU, */ -La_extern void -F77_NAME(dlagtf)(const int* n, double* a, const double* lambda, - double* b, double* c, const double *tol, - double* d, int* in, int* info); -/* DLAGTM - perform a matrix-vector product of the form B := */ -/* alpha * A * X + beta * B where A is a tridiagonal matrix of */ -/* order N, B and X are N by NRHS matrices, and alpha and beta are */ -/* real scalars, each of which may be 0., 1., or -1 */ -La_extern void -F77_NAME(dlagtm)(const char* trans, const int* n, const int* nrhs, - const double* alpha, const double* dl, - const double* d, const double* du, - const double* x, const int* ldx, const double* beta, - double* b, const int* ldb); -/* DLAGTS - may be used to solve one of the systems of equations */ -/* (T - lambda*I);*x = y or (T - lambda*I);'*x = y, */ -La_extern void -F77_NAME(dlagts)(const int* job, const int* n, - const double* a, const double* b, - const double* c, const double* d, - const int* in, double* y, double* tol, int* info); -/* DLAHQR - an auxiliary routine called by DHSEQR to update the */ -/* eigenvalues and Schur decomposition already computed by DHSEQR, */ -/* by dealing with the Hessenberg submatrix in rows and columns */ -/* ILO to IHI */ -La_extern void -F77_NAME(dlahqr)(const int* wantt, const int* wantz, const int* n, - const int* ilo, const int* ihi, - double* H, const int* ldh, double* wr, double* wi, - const int* iloz, const int* ihiz, - double* z, const int* ldz, int* info); -/* DLAHRD - reduce the first NB columns of a real general */ -/* n-by-(n-k+1); matrix A so that elements below the k-th */ -/* subdiagonal are zero */ -La_extern void -F77_NAME(dlahrd)(const int* n, const int* k, const int* nb, - double* a, const int* lda, - double* tau, double* t, const int* ldt, - double* y, const int* ldy); -/* DLAIC1 - apply one step of incremental condition estimation in */ -/* its simplest version */ -La_extern void -F77_NAME(dlaic1)(const int* job, const int* j, const double* x, - const double* sest, const double* w, - const double* gamma, double* sestpr, - double* s, double* c); -/* DLALN2 - solve a system of the form (ca A - w D ); X = s B or */ -/* (ca A' - w D); X = s B with possible scaling ("s"); and */ -/* perturbation of A */ -La_extern void -F77_NAME(dlaln2)(const int* ltrans, const int* na, const int* nw, - const double* smin, const double* ca, - const double* a, const int* lda, - const double* d1, const double* d2, - const double* b, const int* ldb, - const double* wr, const double* wi, - double* x, const int* ldx, double* scale, - double* xnorm, int* info); -/* DLAMCH - determine double precision machine parameters */ -La_extern double -F77_NAME(dlamch)(const char* cmach); -/* DLAMRG - will create a permutation list which will merge the */ -/* elements of A (which is composed of two independently sorted */ -/* sets); into a single set which is sorted in ascending order */ -La_extern void -F77_NAME(dlamrg)(const int* n1, const int* n2, const double* a, - const int* dtrd1, const int* dtrd2, int* index); -/* DLANGB - return the value of the one norm, or the Frobenius */ -/* norm, or the infinity norm, or the element of largest absolute */ -/* value of an n by n band matrix A, with kl sub-diagonals and ku */ -/* super-diagonals */ -La_extern double -F77_NAME(dlangb)(const char* norm, const int* n, - const int* kl, const int* ku, const double* ab, - const int* ldab, double* work); -/* DLANGE - return the value of the one norm, or the Frobenius */ -/* norm, or the infinity norm, or the element of largest absolute */ -/* value of a real matrix A */ -La_extern double -F77_NAME(dlange)(const char* norm, const int* m, const int* n, - const double* a, const int* lda, double* work); -/* DLANGT - return the value of the one norm, or the Frobenius */ -/* norm, or the infinity norm, or the element of largest absolute */ -/* value of a real tridiagonal matrix A */ -La_extern double -F77_NAME(dlangt)(const char* norm, const int* n, - const double* dl, const double* d, - const double* du); -/* DLANHS - return the value of the one norm, or the Frobenius */ -/* norm, or the infinity norm, or the element of largest absolute */ -/* value of a Hessenberg matrix A */ -La_extern double -F77_NAME(dlanhs)(const char* norm, const int* n, - const double* a, const int* lda, double* work); -/* DLANSB - return the value of the one norm, or the Frobenius */ -/* norm, or the infinity norm, or the element of largest absolute */ -/* value of an n by n symmetric band matrix A, with k */ -/* super-diagonals */ -La_extern double -F77_NAME(dlansb)(const char* norm, const char* uplo, - const int* n, const int* k, - const double* ab, const int* ldab, double* work); -/* DLANSP - return the value of the one norm, or the Frobenius */ -/* norm, or the infinity norm, or the element of largest absolute */ -/* value of a real symmetric matrix A, supplied in packed form */ -La_extern double -F77_NAME(dlansp)(const char* norm, const char* uplo, - const int* n, const double* ap, double* work); -/* DLANST - return the value of the one norm, or the Frobenius */ -/* norm, or the infinity norm, or the element of largest absolute */ -/* value of a real symmetric tridiagonal matrix A */ -La_extern double -F77_NAME(dlanst)(const char* norm, const int* n, - const double* d, const double* e); -/* DLANSY - return the value of the one norm, or the Frobenius */ -/* norm, or the infinity norm, or the element of largest absolute */ -/* value of a real symmetric matrix A */ -La_extern double -F77_NAME(dlansy)(const char* norm, const char* uplo, const int* n, - const double* a, const int* lda, double* work); -/* DLANTB - return the value of the one norm, or the Frobenius */ -/* norm, or the infinity norm, or the element of largest absolute */ -/* value of an n by n triangular band matrix A, with ( k + 1 ) diagonals */ -La_extern double -F77_NAME(dlantb)(const char* norm, const char* uplo, - const char* diag, const int* n, const int* k, - const double* ab, const int* ldab, double* work); -/* DLANTP - return the value of the one norm, or the Frobenius */ -/* norm, or the infinity norm, or the element of largest absolute */ -/* value of a triangular matrix A, supplied in packed form */ -La_extern double -F77_NAME(dlantp)(const char* norm, const char* uplo, const char* diag, - const int* n, const double* ap, double* work); -/* DLANTR - return the value of the one norm, or the Frobenius */ -/* norm, or the infinity norm, or the element of largest absolute */ -/* value of a trapezoidal or triangular matrix A */ -La_extern double -F77_NAME(dlantr)(const char* norm, const char* uplo, - const char* diag, const int* m, const int* n, - const double* a, const int* lda, double* work); -/* DLANV2 - compute the Schur factorization of a real 2-by-2 */ -/* nonsymmetric matrix in standard form */ -La_extern void -F77_NAME(dlanv2)(double* a, double* b, double* c, double* d, - double* rt1r, double* rt1i, double* rt2r, double* rt2i, - double* cs, double *sn); -/* DLAPLL - two column vectors X and Y, let A = ( X Y ); */ -La_extern void -F77_NAME(dlapll)(const int* n, double* x, const int* incx, - double* y, const int* incy, double* ssmin); -/* DLAPMT - rearrange the columns of the M by N matrix X as */ -/* specified by the permutation K(1);,K(2);,...,K(N); of the */ -/* integers 1,...,N */ -La_extern void -F77_NAME(dlapmt)(const int* forwrd, const int* m, const int* n, - double* x, const int* ldx, const int* k); -/* DLAPY2 - return sqrt(x**2+y**2);, taking care not to cause */ -/* unnecessary overflow */ -La_extern double -F77_NAME(dlapy2)(const double* x, const double* y); -/* DLAPY3 - return sqrt(x**2+y**2+z**2);, taking care not to */ -/* cause unnecessary overflow */ -La_extern double -F77_NAME(dlapy3)(const double* x, const double* y, const double* z); -/* DLAQGB - equilibrate a general M by N band matrix A with KL */ -/* subdiagonals and KU superdiagonals using the row and scaling */ -/* factors in the vectors R and C */ -La_extern void -F77_NAME(dlaqgb)(const int* m, const int* n, - const int* kl, const int* ku, - double* ab, const int* ldab, - double* r, double* c, - double* rowcnd, double* colcnd, - const double* amax, char* equed); -/* DLAQGE - equilibrate a general M by N matrix A using the row */ -/* and scaling factors in the vectors R and C */ -La_extern void -F77_NAME(dlaqge)(const int* m, const int* n, - double* a, const int* lda, - double* r, double* c, - double* rowcnd, double* colcnd, - const double* amax, char* equed); -/* DLAQSB - equilibrate a symmetric band matrix A using the */ -/* scaling factors in the vector S */ -La_extern void -F77_NAME(dlaqsb)(const char* uplo, const int* n, const int* kd, - double* ab, const int* ldab, const double* s, - const double* scond, const double* amax, char* equed); -/* DLAQSP - equilibrate a symmetric matrix A using the scaling */ -/* factors in the vector S */ -La_extern void -F77_NAME(dlaqsp)(const char* uplo, const int* n, - double* ap, const double* s, const double* scond, - const double* amax, int* equed); -/* DLAQSY - equilibrate a symmetric matrix A using the scaling */ -/* factors in the vector S */ -La_extern void -F77_NAME(dlaqsy)(const char* uplo, const int* n, - double* a, const int* lda, - const double* s, const double* scond, - const double* amax, int* equed); -/* DLAQTR - solve the real quasi-triangular system */ -/* op(T) * p = scale*c */ -La_extern void -F77_NAME(dlaqtr)(const int* ltran, const int* lreal, const int* n, - const double* t, const int* ldt, - const double* b, const double* w, - double* scale, double* x, double* work, int* info); -/* DLAR2V - apply a vector of real plane rotations from both */ -/* sides to a sequence of 2-by-2 real symmetric matrices, defined */ -/* by the elements of the vectors x, y and z */ -La_extern void -F77_NAME(dlar2v)(const int* n, double* x, double* y, - double* z, const int* incx, - const double* c, const double* s, - const int* incc); -/* DLARF - apply a real elementary reflector H to a real m by n */ -/* matrix C, from either the left or the right */ -La_extern void -F77_NAME(dlarf)(const char* side, const int* m, const int* n, - const double* v, const int* incv, const double* tau, - double* c, const int* ldc, double* work); -/* DLARFB - apply a real block reflector H or its transpose H' */ -/* to a real m by n matrix C, from either the left or the right */ -La_extern void -F77_NAME(dlarfb)(const char* side, const char* trans, - const char* direct, const char* storev, - const int* m, const int* n, const int* k, - const double* v, const int* ldv, - const double* t, const int* ldt, - double* c, const int* ldc, - double* work, const int* lwork); -/* DLARFG - generate a real elementary reflector H of order n, */ -/* such that H * ( alpha ) = ( beta ), H' * H = I */ -La_extern void -F77_NAME(dlarfg)(const int* n, const double* alpha, - double* x, const int* incx, double* tau); -/* DLARFT - form the triangular factor T of a real block */ -/* reflector H of order n, which is defined as a product of k */ -/* elementary reflectors */ -La_extern void -F77_NAME(dlarft)(const char* direct, const char* storev, - const int* n, const int* k, double* v, const int* ldv, - const double* tau, double* t, const int* ldt); -/* DLARFX - apply a real elementary reflector H to a real m by n */ -/* matrix C, from either the left or the right */ -La_extern void -F77_NAME(dlarfx)(const char* side, const int* m, const int* n, - const double* v, const double* tau, - double* c, const int* ldc, double* work); -/* DLARGV - generate a vector of real plane rotations, determined */ -/* by elements of the real vectors x and y */ -La_extern void -F77_NAME(dlargv)(const int* n, double* x, const int* incx, - double* y, const int* incy, double* c, const int* incc); -/* DLARNV - return a vector of n random real numbers from a */ -/* uniform or normal distribution */ -La_extern void -F77_NAME(dlarnv)(const int* idist, int* iseed, const int* n, double* x); -/* DLARTG - generate a plane rotation so that [ CS SN ] */ -La_extern void -F77_NAME(dlartg)(const double* f, const double* g, double* cs, - double* sn, double *r); -/* DLARTV - apply a vector of real plane rotations to elements of */ -/* the real vectors x and y */ -La_extern void -F77_NAME(dlartv)(const int* n, double* x, const int* incx, - double* y, const int* incy, - const double* c, const double* s, - const int* incc); -/* DLARUV - return a vector of n random real numbers from a */ -/* uniform (0,1); */ -La_extern void -F77_NAME(dlaruv)(int* iseed, const int* n, double* x); - -/* DLAS2 - compute the singular values of the 2-by-2 matrix */ -/* [ F G ] [ 0 H ] */ -La_extern void -F77_NAME(dlas2)(const double* f, const double* g, const double* h, - double* ssmin, double* ssmax); - -/* DLASCL - multiply the M by N real matrix A by the real scalar */ -/* CTO/CFROM */ -La_extern void -F77_NAME(dlascl)(const char* type, - const int* kl,const int* ku, - double* cfrom, double* cto, - const int* m, const int* n, - double* a, const int* lda, int* info); - -/* DLASET - initialize an m-by-n matrix A to BETA on the diagonal */ -/* and ALPHA on the offdiagonals */ -La_extern void -F77_NAME(dlaset)(const char* uplo, const int* m, const int* n, - const double* alpha, const double* beta, - double* a, const int* lda); -/* DLASQ1 - DLASQ1 computes the singular values of a real N-by-N */ -/* bidiagonal matrix with diagonal D and off-diagonal E */ -La_extern void -F77_NAME(dlasq1)(const int* n, double* d, double* e, - double* work, int* info); -/* DLASQ2 - DLASQ2 computes the singular values of a real N-by-N */ -/* unreduced bidiagonal matrix with squared diagonal elements in */ -/* Q and squared off-diagonal elements in E */ -La_extern void -F77_NAME(dlasq2)(const int* m, double* q, double* e, - double* qq, double* ee, const double* eps, - const double* tol2, const double* small2, - double* sup, int* kend, int* info); -/* DLASQ3 - DLASQ3 is the workhorse of the whole bidiagonal SVD */ -/* algorithm */ -La_extern void -F77_NAME(dlasq3)(int* n, double* q, double* e, double* qq, - double* ee, double* sup, double *sigma, - int* kend, int* off, int* iphase, - const int* iconv, const double* eps, - const double* tol2, const double* small2); -/* DLASQ4 - DLASQ4 estimates TAU, the smallest eigenvalue of a */ -/* matrix */ -La_extern void -F77_NAME(dlasq4)(const int* n, const double* q, const double* e, - double* tau, double* sup); -/* DLASR - perform the transformation A := P*A, when SIDE = 'L' */ -/* or 'l' ( Left-hand side ); A := A*P', when SIDE = 'R' or 'r' */ -/* ( Right-hand side ); where A is an m by n real matrix and P is */ -/* an orthogonal matrix, */ -La_extern void -F77_NAME(dlasr)(const char* side, const char* pivot, - const char* direct, const int* m, const int* n, - const double* c, const double* s, - double* a, const int* lda); -/* DLASRT - the numbers in D in increasing order (if ID = 'I'); */ -/* or in decreasing order (if ID = 'D' ); */ -La_extern void -F77_NAME(dlasrt)(const char* id, const int* n, double* d, int* info); -/* DLASSQ - return the values scl and smsq such that ( scl**2 */ -/* );*smsq = x( 1 );**2 +...+ x( n );**2 + ( scale**2 );*sumsq, */ -La_extern void -F77_NAME(dlassq)(const int* n, const double* x, const int* incx, - double* scale, double* sumsq); -/* DLASV2 - compute the singular value decomposition of a 2-by-2 */ -/* triangular matrix [ F G ] [ 0 H ] */ -La_extern void -F77_NAME(dlasv2)(const double* f, const double* g, const double* h, - double* ssmin, double* ssmax, double* snr, double* csr, - double* snl, double* csl); -/* DLASWP - perform a series of row interchanges on the matrix A */ -La_extern void -F77_NAME(dlaswp)(const int* n, double* a, const int* lda, - const int* k1, const int* k2, - const int* ipiv, const int* incx); -/* DLASY2 - solve for the N1 by N2 matrix double* x, 1 <= N1,N2 <= 2, in */ -/* op(TL);*X + ISGN*X*op(TR); = SCALE*B, */ -La_extern void -F77_NAME(dlasy2)(const int* ltranl, const int* ltranr, - const int* isgn, const int* n1, const int* n2, - const double* tl, const int* ldtl, - const double* tr, const int* ldtr, - const double* b, const int* ldb, - double* scale, double* x, const int* ldx, - double* xnorm, int* info); -/* DLASYF - compute a partial factorization of a real symmetric */ -/* matrix A using the Bunch-Kaufman diagonal pivoting method */ -La_extern void -F77_NAME(dlasyf)(const char* uplo, const int* n, - const int* nb, const int* kb, - double* a, const int* lda, int* ipiv, - double* w, const int* ldw, int* info); -/* DLATBS - solve one of the triangular systems A *x = s*b or */ -/* A'*x = s*b with scaling to prevent overflow, where A is an */ -/* upper or lower triangular band matrix */ -La_extern void -F77_NAME(dlatbs)(const char* uplo, const char* trans, - const char* diag, const char* normin, - const int* n, const int* kd, - const double* ab, const int* ldab, - double* x, double* scale, double* cnorm, int* info); -/* DLATPS - solve one of the triangular systems A *x = s*b or */ -/* A'*x = s*b with scaling to prevent overflow, where A is an */ -/* upper or lower triangular matrix stored in packed form */ -La_extern void -F77_NAME(dlatps)(const char* uplo, const char* trans, - const char* diag, const char* normin, - const int* n, const double* ap, - double* x, double* scale, double* cnorm, int* info); -/* DLATRD - reduce NB rows and columns of a real symmetric matrix */ -/* A to symmetric tridiagonal form by an orthogonal similarity */ -/* transformation Q' * A * Q, and returns the matrices V and W */ -/* which are needed to apply the transformation to the unreduced */ -/* part of A */ -La_extern void -F77_NAME(dlatrd)(const char* uplo, const int* n, const int* nb, - double* a, const int* lda, double* e, double* tau, - double* w, const int* ldw); -/* DLATRS - solve one of the triangular systems A *x = s*b or */ -/* A'*x = s*b with scaling to prevent overflow */ -La_extern void -F77_NAME(dlatrs)(const char* uplo, const char* trans, - const char* diag, const char* normin, - const int* n, const double* a, const int* lda, - double* x, double* scale, double* cnorm, int* info); -/* DLATZM - apply a Householder matrix generated by DTZRQF to a */ -/* matrix */ -La_extern void -F77_NAME(dlatzm)(const char* side, const int* m, const int* n, - const double* v, const int* incv, - const double* tau, double* c1, double* c2, - const int* ldc, double* work); -/* DLAUU2 - compute the product U * U' or L' * const int* l, where the */ -/* triangular factor U or L is stored in the upper or lower */ -/* triangular part of the array A */ -La_extern void -F77_NAME(dlauu2)(const char* uplo, const int* n, - double* a, const int* lda, int* info); -/* DLAUUM - compute the product U * U' or L' * L, where the */ -/* triangular factor U or L is stored in the upper or lower */ -/* triangular part of the array A */ -La_extern void -F77_NAME(dlauum)(const char* uplo, const int* n, - double* a, const int* lda, int* info); - - -/* ======================================================================== */ - -/* Selected Double Complex Lapack Routines - ======== - */ - -/* IZMAX1 finds the index of the element whose real part has maximum - * absolute value. */ -La_extern int -F77_NAME(izmax1)(const int *n, Rcomplex *cx, const int *incx); - - -/* ZGECON estimates the reciprocal of the condition number of a general - * complex matrix A, in either the 1-norm or the infinity-norm, using - * the LU factorization computed by ZGETRF. - */ -La_extern void -F77_NAME(zgecon)(const char *norm, const int *n, - const Rcomplex *a, const int *lda, - const double *anorm, double *rcond, - Rcomplex *work, double *rwork, int *info); - -/* ZGESV computes the solution to a complex system of linear equations */ -La_extern void -F77_NAME(zgesv)(const int *n, const int *nrhs, Rcomplex *a, - const int *lda, int *ipiv, Rcomplex *b, - const int *ldb, int *info); - -/* ZGEQP3 computes a QR factorization with column pivoting */ -La_extern void -F77_NAME(zgeqp3)(const int *m, const int *n, - Rcomplex *a, const int *lda, - int *jpvt, Rcomplex *tau, - Rcomplex *work, const int *lwork, - double *rwork, int *info); - -/* ZUNMQR applies Q or Q**H from the Left or Right */ -La_extern void -F77_NAME(zunmqr)(const char *side, const char *trans, - const int *m, const int *n, const int *k, - Rcomplex *a, const int *lda, - Rcomplex *tau, - Rcomplex *c, const int *ldc, - Rcomplex *work, const int *lwork, int *info); - -/* ZTRTRS solves triangular systems */ -La_extern void -F77_NAME(ztrtrs)(const char *uplo, const char *trans, const char *diag, - const int *n, const int *nrhs, - Rcomplex *a, const int *lda, - Rcomplex *b, const int *ldb, int *info); -/* ZGESVD - compute the singular value decomposition (SVD); of a */ -/* real M-by-N matrix A, optionally computing the left and/or */ -/* right singular vectors */ -La_extern void -F77_NAME(zgesvd)(const char *jobu, const char *jobvt, - const int *m, const int *n, - Rcomplex *a, const int *lda, double *s, - Rcomplex *u, const int *ldu, - Rcomplex *vt, const int *ldvt, - Rcomplex *work, const int *lwork, double *rwork, - int *info); - -/* ZGHEEV - compute all eigenvalues and, optionally, eigenvectors */ -/* of a Hermitian matrix A */ -La_extern void -F77_NAME(zheev)(const char *jobz, const char *uplo, - const int *n, Rcomplex *a, const int *lda, - double *w, Rcomplex *work, const int *lwork, - double *rwork, int *info); - -/* ZGGEEV - compute all eigenvalues and, optionally, eigenvectors */ -/* of a complex non-symmetric matrix A */ -La_extern void -F77_NAME(zgeev)(const char *jobvl, const char *jobvr, - const int *n, Rcomplex *a, const int *lda, - Rcomplex *wr, Rcomplex *vl, const int *ldvl, - Rcomplex *vr, const int *ldvr, - Rcomplex *work, const int *lwork, - double *rwork, int *info); - - -/* NOTE: The following entry points were traditionally in this file, - but are not provided by R's libRlapack */ - -/* DZSUM1 - take the sum of the absolute values of a complex */ -/* vector and returns a double precision result */ -La_extern double -F77_NAME(dzsum1)(const int *n, Rcomplex *CX, const int *incx); - -/* ZLACN2 estimates the 1-norm of a square, complex matrix A. - * Reverse communication is used for evaluating matrix-vector products. -*/ -La_extern void -F77_NAME(zlacn2)(const int *n, Rcomplex *v, Rcomplex *x, - double *est, int *kase, int *isave); - -/* ZLANTR - return the value of the one norm, or the Frobenius norm, */ -/* or the infinity norm, or the element of largest absolute value of */ -/* a trapezoidal or triangular matrix A */ -La_extern double -F77_NAME(zlantr)(const char *norm, const char *uplo, const char *diag, - const int *m, const int *n, Rcomplex *a, - const int *lda, double *work); - -/* ======================================================================== */ - -/* Other double precision and double complex Lapack routines - provided by libRlapack. - - These are extracted from the CLAPACK headers. -*/ - -La_extern void -F77_NAME(dbdsdc)(char *uplo, char *compq, int *n, double * - d, double *e, double *u, int *ldu, double *vt, - int *ldvt, double *q, int *iq, double *work, int * iwork, int *info); - -La_extern void -F77_NAME(dgegs)(char *jobvsl, char *jobvsr, int *n, - double *a, int *lda, double *b, int *ldb, double * - alphar, double *alphai, double *beta, double *vsl, - int *ldvsl, double *vsr, int *ldvsr, double *work, - int *lwork, int *info); - -La_extern void -F77_NAME(dgelsd)(int *m, int *n, int *nrhs, - double *a, int *lda, double *b, int *ldb, double * - s, double *rcond, int *rank, double *work, int *lwork, - int *iwork, int *info); - -La_extern void -F77_NAME(dgelsx)(int *m, int *n, int *nrhs, - double *a, int *lda, double *b, int *ldb, int * - jpvt, double *rcond, int *rank, double *work, int * - info); - -La_extern void -F77_NAME(dgesc2)(int *n, double *a, int *lda, - double *rhs, int *ipiv, int *jpiv, double *scale); - -/* DGESDD - compute the singular value decomposition (SVD); of a */ -/* real M-by-N matrix A, optionally computing the left and/or */ -/* right singular vectors. If singular vectors are desired, it uses a */ -/* divide-and-conquer algorithm. */ -La_extern void -F77_NAME(dgesdd)(const char *jobz, - const int *m, const int *n, - double *a, const int *lda, double *s, - double *u, const int *ldu, - double *vt, const int *ldvt, - double *work, const int *lwork, int *iwork, int *info); - -La_extern void -F77_NAME(dgetc2)(int *n, double *a, int *lda, int - *ipiv, int *jpiv, int *info); - -typedef int (*L_fp)(); -La_extern void -F77_NAME(dggesx)(char *jobvsl, char *jobvsr, char *sort, L_fp - delctg, char *sense, int *n, double *a, int *lda, - double *b, int *ldb, int *sdim, double *alphar, - double *alphai, double *beta, double *vsl, int *ldvsl, - double *vsr, int *ldvsr, double *rconde, double * - rcondv, double *work, int *lwork, int *iwork, int * - liwork, int *bwork, int *info); - -La_extern void -F77_NAME(dggev)(char *jobvl, char *jobvr, int *n, double * - a, int *lda, double *b, int *ldb, double *alphar, - double *alphai, double *beta, double *vl, int *ldvl, - double *vr, int *ldvr, double *work, int *lwork, - int *info); - -La_extern void -F77_NAME(dggevx)(char *balanc, char *jobvl, char *jobvr, char * - sense, int *n, double *a, int *lda, double *b, - int *ldb, double *alphar, double *alphai, double * - beta, double *vl, int *ldvl, double *vr, int *ldvr, - int *ilo, int *ihi, double *lscale, double *rscale, - double *abnrm, double *bbnrm, double *rconde, double * - rcondv, double *work, int *lwork, int *iwork, int * - bwork, int *info); - -La_extern void -F77_NAME(dggsvp)(char *jobu, char *jobv, char *jobq, int *m, - int *p, int *n, double *a, int *lda, double *b, - int *ldb, double *tola, double *tolb, int *k, int - *l, double *u, int *ldu, double *v, int *ldv, - double *q, int *ldq, int *iwork, double *tau, - double *work, int *info); - -La_extern void -F77_NAME(dgtts2)(int *itrans, int *n, int *nrhs, - double *dl, double *d, double *du, double *du2, - int *ipiv, double *b, int *ldb); -La_extern void -F77_NAME(dlagv2)(double *a, int *lda, double *b, int *ldb, double *alphar, - double *alphai, double * beta, double *csl, double *snl, - double *csr, double * snr); - -La_extern void -F77_NAME(dlals0)(int *icompq, int *nl, int *nr, - int *sqre, int *nrhs, double *b, int *ldb, double - *bx, int *ldbx, int *perm, int *givptr, int *givcol, - int *ldgcol, double *givnum, int *ldgnum, double * - poles, double *difl, double *difr, double *z, int * - k, double *c, double *s, double *work, int *info); - -La_extern void -F77_NAME(dlalsa)(int *icompq, int *smlsiz, int *n, - int *nrhs, double *b, int *ldb, double *bx, int * - ldbx, double *u, int *ldu, double *vt, int *k, - double *difl, double *difr, double *z, double * - poles, int *givptr, int *givcol, int *ldgcol, int * - perm, double *givnum, double *c, double *s, double * - work, int *iwork, int *info); - -La_extern void -F77_NAME(dlalsd)(char *uplo, int *smlsiz, int *n, int - *nrhs, double *d, double *e, double *b, int *ldb, - double *rcond, int *rank, double *work, int *iwork, - int *info); - -La_extern void -F77_NAME(dlamc1)(int *beta, int *t, int *rnd, int - *ieee1); - -La_extern void -F77_NAME(dlamc2)(int *beta, int *t, int *rnd, - double *eps, int *emin, double *rmin, int *emax, - double *rmax); - -La_extern double -F77_NAME(dlamc3)(double *a, double *b); - -La_extern void -F77_NAME(dlamc4)(int *emin, double *start, int *base); - -La_extern void -F77_NAME(dlamc5)(int *beta, int *p, int *emin, - int *ieee, int *emax, double *rmax); - -La_extern void -F77_NAME(dlaqp2)(int *m, int *n, int *offset, - double *a, int *lda, int *jpvt, double *tau, - double *vn1, double *vn2, double *work); - -La_extern void -F77_NAME(dlaqps)(int *m, int *n, int *offset, int - *nb, int *kb, double *a, int *lda, int *jpvt, - double *tau, double *vn1, double *vn2, double *auxv, - double *f, int *ldf); - -La_extern void -F77_NAME(dlar1v)(int *n, int *b1, int *bn, double - *sigma, double *d, double *l, double *ld, double * - lld, double *gersch, double *z, double *ztz, double - *mingma, int *r, int *isuppz, double *work); - -La_extern void -F77_NAME(dlarrb)(int *n, double *d, double *l, - double *ld, double *lld, int *ifirst, int *ilast, - double *sigma, double *reltol, double *w, double * - wgap, double *werr, double *work, int *iwork, int * - info); - -La_extern void -F77_NAME(dlarre)(int *n, double *d, double *e, - double *tol, int *nsplit, int *isplit, int *m, - double *w, double *woff, double *gersch, double *work, - int *info); - -La_extern void -F77_NAME(dlarrf)(int *n, double *d, double *l, - double *ld, double *lld, int *ifirst, int *ilast, - double *w, double *dplus, double *lplus, double *work, - int *iwork, int *info); - -La_extern void -F77_NAME(dlarrv)(int *n, double *d, double *l, - int *isplit, int *m, double *w, int *iblock, - double *gersch, double *tol, double *z, int *ldz, - int *isuppz, double *work, int *iwork, int *info); - -La_extern void -F77_NAME(dlarz)(char *side, int *m, int *n, int *l, - double *v, int *incv, double *tau, double *c, - int *ldc, double *work); - -La_extern void -F77_NAME(dlarzb)(char *side, char *trans, char *direct, char * - storev, int *m, int *n, int *k, int *l, double *v, - int *ldv, double *t, int *ldt, double *c, int * - ldc, double *work, int *ldwork); - -La_extern void -F77_NAME(dlarzt)(char *direct, char *storev, int *n, int * - k, double *v, int *ldv, double *tau, double *t, - int *ldt); - -La_extern void -F77_NAME(dlasd0)(int *n, int *sqre, double *d, - double *e, double *u, int *ldu, double *vt, int * - ldvt, int *smlsiz, int *iwork, double *work, int * - info); - -La_extern void -F77_NAME(dlasd1)(int *nl, int *nr, int *sqre, - double *d, double *alpha, double *beta, double *u, - int *ldu, double *vt, int *ldvt, int *idxq, int * - iwork, double *work, int *info); - -La_extern void -F77_NAME(dlasd2)(int *nl, int *nr, int *sqre, int - *k, double *d, double *z, double *alpha, double * - beta, double *u, int *ldu, double *vt, int *ldvt, - double *dsigma, double *u2, int *ldu2, double *vt2, - int *ldvt2, int *idxp, int *idx, int *idxc, int * - idxq, int *coltyp, int *info); - -La_extern void -F77_NAME(dlasd3)(int *nl, int *nr, int *sqre, int - *k, double *d, double *q, int *ldq, double *dsigma, - double *u, int *ldu, double *u2, int *ldu2, - double *vt, int *ldvt, double *vt2, int *ldvt2, - int *idxc, int *ctot, double *z, int *info); - -La_extern void -F77_NAME(dlasd4)(int *n, int *i, double *d, - double *z, double *delta, double *rho, double * - sigma, double *work, int *info); - -La_extern void -F77_NAME(dlasd5)(int *i, double *d, double *z, - double *delta, double *rho, double *dsigma, double * - work); - -La_extern void -F77_NAME(dlasd6)(int *icompq, int *nl, int *nr, - int *sqre, double *d, double *vf, double *vl, - double *alpha, double *beta, int *idxq, int *perm, - int *givptr, int *givcol, int *ldgcol, double *givnum, - int *ldgnum, double *poles, double *difl, double * - difr, double *z, int *k, double *c, double *s, - double *work, int *iwork, int *info); - -La_extern void -F77_NAME(dlasd7)(int *icompq, int *nl, int *nr, - int *sqre, int *k, double *d, double *z, - double *zw, double *vf, double *vfw, double *vl, - double *vlw, double *alpha, double *beta, double * - dsigma, int *idx, int *idxp, int *idxq, int *perm, - int *givptr, int *givcol, int *ldgcol, double *givnum, - int *ldgnum, double *c, double *s, int *info); - -La_extern void -F77_NAME(dlasd8)(int *icompq, int *k, double *d, - double *z, double *vf, double *vl, double *difl, - double *difr, int *lddifr, double *dsigma, double * - work, int *info); - -La_extern void -F77_NAME(dlasd9)(int *icompq, int *ldu, int *k, - double *d, double *z, double *vf, double *vl, - double *difl, double *difr, double *dsigma, double * - work, int *info); - -La_extern void -F77_NAME(dlasda)(int *icompq, int *smlsiz, int *n, - int *sqre, double *d, double *e, double *u, int - *ldu, double *vt, int *k, double *difl, double *difr, - double *z, double *poles, int *givptr, int *givcol, - int *ldgcol, int *perm, double *givnum, double *c, - double *s, double *work, int *iwork, int *info); - -La_extern void -F77_NAME(dlasdq)(char *uplo, int *sqre, int *n, int * - ncvt, int *nru, int *ncc, double *d, double *e, - double *vt, int *ldvt, double *u, int *ldu, - double *c, int *ldc, double *work, int *info); - -La_extern void -F77_NAME(dlasdt)(int *n, int *lvl, int *nd, int * - inode, int *ndiml, int *ndimr, int *msub); - -La_extern void -F77_NAME(dlasq5)(int *i0, int *n0, double *z, - int *pp, double *tau, double *dmin, double *dmin1, - double *dmin2, double *dn, double *dnm1, double *dnm2, - int *ieee); - -La_extern void -F77_NAME(dlasq6)(int *i0, int *n0, double *z, - int *pp, double *dmin, double *dmin1, double *dmin2, - double *dn, double *dnm1, double *dnm2); - -La_extern void -F77_NAME(dlatdf)(int *ijob, int *n, double *z, - int *ldz, double *rhs, double *rdsum, double *rdscal, - int *ipiv, int *jpiv); - -La_extern void -F77_NAME(dlatrz)(int *m, int *n, int *l, double * - a, int *lda, double *tau, double *work); - -La_extern void -F77_NAME(dormr3)(char *side, char *trans, int *m, int *n, - int *k, int *l, double *a, int *lda, double *tau, - double *c, int *ldc, double *work, int *info); - -La_extern void -F77_NAME(dormrz)(char *side, char *trans, int *m, int *n, - int *k, int *l, double *a, int *lda, double *tau, - double *c, int *ldc, double *work, int *lwork, - int *info); - -La_extern void -F77_NAME(dptts2)(int *n, int *nrhs, double *d, - double *e, double *b, int *ldb); - -La_extern void -F77_NAME(dsbgvd)(char *jobz, char *uplo, int *n, int *ka, - int *kb, double *ab, int *ldab, double *bb, int * - ldbb, double *w, double *z, int *ldz, double *work, - int *lwork, int *iwork, int *liwork, int *info); - -La_extern void -F77_NAME(dsbgvx)(char *jobz, char *range, char *uplo, int *n, - int *ka, int *kb, double *ab, int *ldab, double * - bb, int *ldbb, double *q, int *ldq, double *vl, - double *vu, int *il, int *iu, double *abstol, int - *m, double *w, double *z, int *ldz, double *work, - int *iwork, int *ifail, int *info); - -La_extern void -F77_NAME(dspgvd)(int *itype, char *jobz, char *uplo, int * - n, double *ap, double *bp, double *w, double *z, - int *ldz, double *work, int *lwork, int *iwork, - int *liwork, int *info); - -La_extern void -F77_NAME(dspgvx)(int *itype, char *jobz, char *range, char * - uplo, int *n, double *ap, double *bp, double *vl, - double *vu, int *il, int *iu, double *abstol, int - *m, double *w, double *z, int *ldz, double *work, - int *iwork, int *ifail, int *info); - -La_extern void -F77_NAME(dstegr)(char *jobz, char *range, int *n, double * - d, double *e, double *vl, double *vu, int *il, - int *iu, double *abstol, int *m, double *w, - double *z, int *ldz, int *isuppz, double *work, - int *lwork, int *iwork, int *liwork, int *info); - -La_extern void -F77_NAME(dstevr)(char *jobz, char *range, int *n, double * - d, double *e, double *vl, double *vu, int *il, - int *iu, double *abstol, int *m, double *w, - double *z, int *ldz, int *isuppz, double *work, - int *lwork, int *iwork, int *liwork, int *info); - -La_extern void -F77_NAME(dsygvd)(int *itype, char *jobz, char *uplo, int * - n, double *a, int *lda, double *b, int *ldb, - double *w, double *work, int *lwork, int *iwork, - int *liwork, int *info); - -La_extern void -F77_NAME(dsygvx)(int *itype, char *jobz, char *range, char * - uplo, int *n, double *a, int *lda, double *b, int - *ldb, double *vl, double *vu, int *il, int *iu, - double *abstol, int *m, double *w, double *z, - int *ldz, double *work, int *lwork, int *iwork, - int *ifail, int *info); - -La_extern void -F77_NAME(dtgex2)(int *wantq, int *wantz, int *n, - double *a, int *lda, double *b, int *ldb, double * - q, int *ldq, double *z, int *ldz, int *j1, int * - n1, int *n2, double *work, int *lwork, int *info); - -La_extern void -F77_NAME(dtgexc)(int *wantq, int *wantz, int *n, - double *a, int *lda, double *b, int *ldb, double * - q, int *ldq, double *z, int *ldz, int *ifst, - int *ilst, double *work, int *lwork, int *info); - -La_extern void -F77_NAME(dtgsen)(int *ijob, int *wantq, int *wantz, - int *select, int *n, double *a, int *lda, double * - b, int *ldb, double *alphar, double *alphai, double * - beta, double *q, int *ldq, double *z, int *ldz, - int *m, double *pl, double *pr, double *dif, - double *work, int *lwork, int *iwork, int *liwork, - int *info); - -La_extern void -F77_NAME(dtgsna)(char *job, char *howmny, int *select, - int *n, double *a, int *lda, double *b, int *ldb, - double *vl, int *ldvl, double *vr, int *ldvr, - double *s, double *dif, int *mm, int *m, double * - work, int *lwork, int *iwork, int *info); - -La_extern void -F77_NAME(dtgsy2)(char *trans, int *ijob, int *m, int * - n, double *a, int *lda, double *b, int *ldb, - double *c, int *ldc, double *d, int *ldd, - double *e, int *lde, double *f, int *ldf, double * - scale, double *rdsum, double *rdscal, int *iwork, int - *pq, int *info); - -La_extern void -F77_NAME(dtgsyl)(char *trans, int *ijob, int *m, int * - n, double *a, int *lda, double *b, int *ldb, - double *c, int *ldc, double *d, int *ldd, - double *e, int *lde, double *f, int *ldf, double * - scale, double *dif, double *work, int *lwork, int * - iwork, int *info); - -La_extern void -F77_NAME(dtzrzf)(int *m, int *n, double *a, int * - lda, double *tau, double *work, int *lwork, int *info); - -La_extern void -F77_NAME(dpstrf)(const char* uplo, const int* n, - double* a, const int* lda, int* piv, int* rank, - double* tol, double *work, int* info); - - -La_extern int -F77_NAME(lsame)(char *ca, char *cb); - -La_extern void -F77_NAME(zbdsqr)(char *uplo, int *n, int *ncvt, int * - nru, int *ncc, double *d, double *e, Rcomplex *vt, - int *ldvt, Rcomplex *u, int *ldu, Rcomplex *c, - int *ldc, double *rwork, int *info); - -La_extern void -F77_NAME(zdrot)(int *n, Rcomplex *cx, int *incx, - Rcomplex *cy, int *incy, double *c, double *s); - -La_extern void -F77_NAME(zgebak)(char *job, char *side, int *n, int *ilo, - int *ihi, double *scale, int *m, Rcomplex *v, - int *ldv, int *info); - -La_extern void -F77_NAME(zgebal)(char *job, int *n, Rcomplex *a, int - *lda, int *ilo, int *ihi, double *scale, int *info); - -La_extern void -F77_NAME(zgebd2)(int *m, int *n, Rcomplex *a, - int *lda, double *d, double *e, Rcomplex *tauq, - Rcomplex *taup, Rcomplex *work, int *info); - -La_extern void -F77_NAME(zgebrd)(int *m, int *n, Rcomplex *a, - int *lda, double *d, double *e, Rcomplex *tauq, - Rcomplex *taup, Rcomplex *work, int *lwork, int * - info); -La_extern void -F77_NAME(zgehd2)(int *n, int *ilo, int *ihi, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *info); - -La_extern void -F77_NAME(zgehrd)(int *n, int *ilo, int *ihi, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *lwork, int *info); - -La_extern void -F77_NAME(zgelq2)(int *m, int *n, Rcomplex *a, - int *lda, Rcomplex *tau, Rcomplex *work, int *info); - -La_extern void -F77_NAME(zgelqf)(int *m, int *n, Rcomplex *a, - int *lda, Rcomplex *tau, Rcomplex *work, int *lwork, - int *info); - -La_extern void -F77_NAME(zgeqr2)(int *m, int *n, Rcomplex *a, - int *lda, Rcomplex *tau, Rcomplex *work, int *info); - -La_extern void -F77_NAME(zgeqrf)(int *m, int *n, Rcomplex *a, - int *lda, Rcomplex *tau, Rcomplex *work, int *lwork, - int *info); - -La_extern void -F77_NAME(zgetf2)(int *m, int *n, Rcomplex *a, - int *lda, int *ipiv, int *info); - -La_extern void -F77_NAME(zgetrf)(int *m, int *n, Rcomplex *a, - int *lda, int *ipiv, int *info); - -La_extern void -F77_NAME(zgetrs)(char *trans, int *n, int *nrhs, - Rcomplex *a, int *lda, int *ipiv, Rcomplex *b, - int *ldb, int *info); - - -La_extern void -F77_NAME(zhetd2)(char *uplo, int *n, Rcomplex *a, int *lda, double *d, - double *e, Rcomplex *tau, int *info); - -La_extern void -F77_NAME(zhetrd)(char *uplo, int *n, Rcomplex *a, - int *lda, double *d, double *e, Rcomplex *tau, - Rcomplex *work, int *lwork, int *info); - -La_extern void -F77_NAME(zhseqr)(char *job, char *compz, int *n, int *ilo, - int *ihi, Rcomplex *h, int *ldh, Rcomplex *w, - Rcomplex *z, int *ldz, Rcomplex *work, int *lwork, - int *info); - -La_extern void -F77_NAME(zlabrd)(int *m, int *n, int *nb, - Rcomplex *a, int *lda, double *d, double *e, - Rcomplex *tauq, Rcomplex *taup, Rcomplex *x, int * - ldx, Rcomplex *y, int *ldy); - -La_extern void -F77_NAME(zlacgv)(int *n, Rcomplex *x, int *incx); - -La_extern void -F77_NAME(zlacpy)(char *uplo, int *m, int *n, - Rcomplex *a, int *lda, Rcomplex *b, int *ldb); - -La_extern void -F77_NAME(zlahqr)(int *wantt, int *wantz, int *n, - int *ilo, int *ihi, Rcomplex *h, int *ldh, - Rcomplex *w, int *iloz, int *ihiz, Rcomplex *z, - int *ldz, int *info); - -La_extern void -F77_NAME(zlahrd)(int *n, int *k, int *nb, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex *t, - int *ldt, Rcomplex *y, int *ldy); - -La_extern double -F77_NAME(zlange)(char *norm, int *m, int *n, Rcomplex *a, int *lda, - double *work); - -La_extern double -F77_NAME(zlanhe)(char *norm, char *uplo, int *n, Rcomplex *a, - int *lda, double *work); - -La_extern double -F77_NAME(zlanhs)(char *norm, int *n, Rcomplex *a, int *lda, double *work); - - -La_extern void -F77_NAME(zlaqp2)(int *m, int *n, int *offset, - Rcomplex *a, int *lda, int *jpvt, Rcomplex *tau, - double *vn1, double *vn2, Rcomplex *work); - -La_extern void -F77_NAME(zlaqps)(int *m, int *n, int *offset, int - *nb, int *kb, Rcomplex *a, int *lda, int *jpvt, - Rcomplex *tau, double *vn1, double *vn2, Rcomplex * - auxv, Rcomplex *f, int *ldf); - -La_extern void -F77_NAME(zlarf)(char *side, int *m, int *n, Rcomplex - *v, int *incv, Rcomplex *tau, Rcomplex *c, int * - ldc, Rcomplex *work); - -La_extern void -F77_NAME(zlarfb)(char *side, char *trans, char *direct, char * - storev, int *m, int *n, int *k, Rcomplex *v, int - *ldv, Rcomplex *t, int *ldt, Rcomplex *c, int * - ldc, Rcomplex *work, int *ldwork); - -La_extern void -F77_NAME(zlarfg)(int *n, Rcomplex *alpha, Rcomplex * - x, int *incx, Rcomplex *tau); - -La_extern void -F77_NAME(zlarft)(char *direct, char *storev, int *n, int * - k, Rcomplex *v, int *ldv, Rcomplex *tau, Rcomplex * - t, int *ldt); - -La_extern void -F77_NAME(zlarfx)(char *side, int *m, int *n, - Rcomplex *v, Rcomplex *tau, Rcomplex *c, int * - ldc, Rcomplex *work); - -La_extern void -F77_NAME(zlascl)(char *type, int *kl, int *ku, - double *cfrom, double *cto, int *m, int *n, - Rcomplex *a, int *lda, int *info); - -La_extern void -F77_NAME(zlaset)(char *uplo, int *m, int *n, - Rcomplex *alpha, Rcomplex *beta, Rcomplex *a, int * - lda); - -La_extern void -F77_NAME(zlasr)(char *side, char *pivot, char *direct, int *m, - int *n, double *c, double *s, Rcomplex *a, - int *lda); - -La_extern void -F77_NAME(zlassq)(int *n, Rcomplex *x, int *incx, - double *scale, double *sumsq); - -La_extern void -F77_NAME(zlaswp)(int *n, Rcomplex *a, int *lda, - int *k1, int *k2, int *ipiv, int *incx); - -La_extern void -F77_NAME(zlatrd)(char *uplo, int *n, int *nb, - Rcomplex *a, int *lda, double *e, Rcomplex *tau, - Rcomplex *w, int *ldw); - -La_extern void -F77_NAME(zlatrs)(char *uplo, char *trans, char *diag, char * - normin, int *n, Rcomplex *a, int *lda, Rcomplex *x, - double *scale, double *cnorm, int *info); - -La_extern void -F77_NAME(zsteqr)(char *compz, int *n, double *d, - double *e, Rcomplex *z, int *ldz, double *work, - int *info); - -/* ZTRCON estimates the reciprocal of the condition number of a - * triangular matrix A, in either the 1-norm or the infinity-norm. - */ -La_extern void -F77_NAME(ztrcon)(const char *norm, const char *uplo, const char *diag, - const int *n, const Rcomplex *a, const int *lda, - double *rcond, Rcomplex *work, double *rwork, int *info); - -La_extern void -F77_NAME(ztrevc)(char *side, char *howmny, int *select, - int *n, Rcomplex *t, int *ldt, Rcomplex *vl, - int *ldvl, Rcomplex *vr, int *ldvr, int *mm, int - *m, Rcomplex *work, double *rwork, int *info); - -La_extern void -F77_NAME(zung2l)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *info); - -La_extern void -F77_NAME(zung2r)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *info); - -La_extern void -F77_NAME(zungbr)(char *vect, int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *lwork, int *info); - -La_extern void -F77_NAME(zunghr)(int *n, int *ilo, int *ihi, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *lwork, int *info); - -La_extern void -F77_NAME(zungl2)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *info); - -La_extern void -F77_NAME(zunglq)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *lwork, int *info); - -La_extern void -F77_NAME(zungql)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *lwork, int *info); - -La_extern void -F77_NAME(zungqr)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *lwork, int *info); - -La_extern void -F77_NAME(zungr2)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *info); - -La_extern void -F77_NAME(zungrq)(int *m, int *n, int *k, - Rcomplex *a, int *lda, Rcomplex *tau, Rcomplex * - work, int *lwork, int *info); - -La_extern void -F77_NAME(zungtr)(char *uplo, int *n, Rcomplex *a, - int *lda, Rcomplex *tau, Rcomplex *work, int *lwork, - int *info); - -La_extern void -F77_NAME(zunm2r)(char *side, char *trans, int *m, int *n, - int *k, Rcomplex *a, int *lda, Rcomplex *tau, - Rcomplex *c, int *ldc, Rcomplex *work, int *info); - -La_extern void -F77_NAME(zunmbr)(char *vect, char *side, char *trans, int *m, - int *n, int *k, Rcomplex *a, int *lda, Rcomplex - *tau, Rcomplex *c, int *ldc, Rcomplex *work, int * - lwork, int *info); - -La_extern void -F77_NAME(zunml2)(char *side, char *trans, int *m, int *n, - int *k, Rcomplex *a, int *lda, Rcomplex *tau, - Rcomplex *c, int *ldc, Rcomplex *work, int *info); - -La_extern void -F77_NAME(zunmlq)(char *side, char *trans, int *m, int *n, - int *k, Rcomplex *a, int *lda, Rcomplex *tau, - Rcomplex *c, int *ldc, Rcomplex *work, int *lwork, - int *info); - -#ifdef __cplusplus -} -#endif - -#endif /* R_LAPACK_H */ diff --git a/sourcecodes/localscore/Linpack.h b/sourcecodes/localscore/Linpack.h deleted file mode 100644 index 95cb753e..00000000 --- a/sourcecodes/localscore/Linpack.h +++ /dev/null @@ -1,89 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1997 Robert Gentleman and Ross Ihaka - * Copyright (C) 1999-2002 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* - C declarations of double-precision LINPACK Fortran subroutines - included in R, and some others. - - Those which are listed as part of R are in the API - */ - -#ifndef R_LINPACK_H_ -#define R_LINPACK_H_ - -#include <R_ext/RS.h> /* for F77_... */ -#include <R_ext/BLAS.h> - -#ifdef __cplusplus -extern "C" { -#endif - - /* Double Precision Linpack */ - -extern void F77_NAME(dchdc)(double*, int*, int*, double*, int*, int*, int*); -extern void F77_NAME(dpbfa)(double*, int*, int*, int*, int*); -extern void F77_NAME(dpbsl)(double*, int*, int*, int*, double*); -extern void F77_NAME(dpoco)(double*, int*, int*, double*, double*, int*); -extern void F77_NAME(dpodi)(double*, int*, int*, double*, int*); -extern void F77_NAME(dpofa)(double*, int*, int*, int*); -extern void F77_NAME(dposl)(double*, int*, int*, double*); -extern void F77_NAME(dqrdc)(double*, int*, int*, int*, double*, int*, double*, int*); -extern void F77_NAME(dqrsl)(double*, int*, int*, int*, double*, double*, double*, double*, double*, double*, double*, int*, int*); -extern void F77_NAME(dsvdc)(double*, int*, int*, int*, double*, double*, double*, int*, double*, int*, double*, int*, int*); -extern void F77_NAME(dtrco)(double*, int*, int*, double*, double*, int*); -extern void F77_NAME(dtrsl)(double*, int*, int*, double*, int*, int*); - - -/* The following routines are listed as they have always been declared - here, but they are not currently included in R */ -extern void F77_NAME(dchdc)(double*, int*, int*, double*, int*, int*, int*); -extern void F77_NAME(dchdd)(double*, int*, int*, double*, double*, int*, int*, double*, double*, double*, double*, int*); -extern void F77_NAME(dchex)(double*, int*, int*, int*, int*, double*, int*, int*, double*, double*, int*); -extern void F77_NAME(dchud)(double*, int*, int*, double*, double*, int*, int*, double*, double*, double*, double*); -extern void F77_NAME(dgbco)(double*, int*, int*, int*, int*, int*, double*, double*); -extern void F77_NAME(dgbdi)(double*, int*, int*, int*, int*, int*, double*); -extern void F77_NAME(dgbfa)(double*, int*, int*, int*, int*, int*, int*); -extern void F77_NAME(dgbsl)(double*, int*, int*, int*, int*, int*, double*, int*); -extern void F77_NAME(dgeco)(double*, int*, int*, int*, double*, double*); -extern void F77_NAME(dgedi)(double*, int*, int*, int*, double*, double*, int*); -extern void F77_NAME(dgefa)(double*, int*, int*, int*, int*); -extern void F77_NAME(dgesl)(double*, int*, int*, int*, double*, int*); -extern void F77_NAME(dgtsl)(int*, double*, double*, double*, double*, int*); -extern void F77_NAME(dpbco)(double*, int*, int*, int*, double*, double*, int*); -extern void F77_NAME(dpbdi)(double*, int*, int*, int*, double*); -extern void F77_NAME(dppco)(double*, int*, double*, double*, int*); -extern void F77_NAME(dppdi)(double*, int*, double*, int*); -extern void F77_NAME(dppfa)(double*, int*, int*); -extern void F77_NAME(dppsl)(double*, int*, double*); -extern void F77_NAME(dptsl)(int*, double*, double*, double*); -extern void F77_NAME(dsico)(double*, int*, int*, int*, double*, double*); -extern void F77_NAME(dsidi)(double*, int*, int*, int*, double*, int*, double*, int*); -extern void F77_NAME(dsifa)(double*, int*, int*, int*, int*); -extern void F77_NAME(dsisl)(double*, int*, int*, int*, double*); -extern void F77_NAME(dspco)(double*, int*, int*, double*, double*); -extern void F77_NAME(dspdi)(double*, int*, int*, double*, int*, double*, int*); -extern void F77_NAME(dspfa)(double*, int*, int*, int*); -extern void F77_NAME(dspsl)(double*, int*, int*, double*); - -#ifdef __cplusplus -} -#endif - -#endif /* R_LINPACK_H_ */ diff --git a/sourcecodes/localscore/MathThreads.h b/sourcecodes/localscore/MathThreads.h deleted file mode 100644 index 41234442..00000000 --- a/sourcecodes/localscore/MathThreads.h +++ /dev/null @@ -1,39 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2000, 2001 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* - Experimental: included by src/library/stats/src/distance.c -*/ - -#ifndef R_EXT_MATHTHREADS_H_ -#define R_EXT_MATHTHREADS_H_ - -#ifdef __cplusplus -extern "C" { -#endif - -#include <R_ext/libextern.h> -LibExtern int R_num_math_threads; -LibExtern int R_max_num_math_threads; - -#ifdef __cplusplus -} -#endif - -#endif /* R_EXT_MATHTHREADS_H_ */ diff --git a/sourcecodes/localscore/Memory.h b/sourcecodes/localscore/Memory.h deleted file mode 100644 index 306c9835..00000000 --- a/sourcecodes/localscore/Memory.h +++ /dev/null @@ -1,49 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1998-2007 The R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - * - * - * Memory Allocation (garbage collected) --- INCLUDING S compatibility --- - */ - -/* Included by R.h: API */ - -#ifndef R_EXT_MEMORY_H_ -#define R_EXT_MEMORY_H_ - -#ifndef NO_C_HEADERS -# include <stddef.h> /* for size_t */ -#endif - -#ifdef __cplusplus -extern "C" { -#endif - -void* vmaxget(void); -void vmaxset(const void *); - -void R_gc(void); - -char* R_alloc(size_t, int); -char* S_alloc(long, int); -char* S_realloc(char *, long, long, int); - -#ifdef __cplusplus -} -#endif - -#endif /* R_EXT_MEMORY_H_ */ diff --git a/sourcecodes/localscore/Parse.h b/sourcecodes/localscore/Parse.h deleted file mode 100644 index a1d8cc87..00000000 --- a/sourcecodes/localscore/Parse.h +++ /dev/null @@ -1,47 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1998-2006 R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* NOTE: - This file exports a part of the current internal parse interface. - It is subject to change at any minor (x.y.0) version of R. - */ - -#ifndef R_EXT_PARSE_H_ -#define R_EXT_PARSE_H_ - -#ifdef __cplusplus -extern "C" { -#endif - -/* PARSE_NULL will not be returned by R_ParseVector */ -typedef enum { - PARSE_NULL, - PARSE_OK, - PARSE_INCOMPLETE, - PARSE_ERROR, - PARSE_EOF -} ParseStatus; - -SEXP R_ParseVector(SEXP, int, ParseStatus *, SEXP); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/sourcecodes/localscore/Print.h b/sourcecodes/localscore/Print.h deleted file mode 100644 index 7beeaf17..00000000 --- a/sourcecodes/localscore/Print.h +++ /dev/null @@ -1,50 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1998-2010 The R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* Included by R.h: API */ - -#ifndef R_EXT_PRINT_H_ -#define R_EXT_PRINT_H_ - -#ifdef __cplusplus -/* If the vprintf interface is defined at all in C++ it may only be - defined in namespace std. */ -# ifdef R_USE_C99_IN_CXX -# include <cstdarg> -# ifdef __SUNPRO_CC -using _STLP_VENDOR_CSTD::va_list; -# endif -# endif -extern "C" { -#else -# include <stdarg.h> -#endif - -void Rprintf(const char *, ...); -void REprintf(const char *, ...); -#if !defined(__cplusplus) || defined R_USE_C99_IN_CXX -void Rvprintf(const char *, va_list); -void REvprintf(const char *, va_list); -#endif - -#ifdef __cplusplus -} -#endif - -#endif /* R_EXT_PRINT_H_ */ diff --git a/sourcecodes/localscore/PrtUtil.h b/sourcecodes/localscore/PrtUtil.h deleted file mode 100644 index 1ef06d9a..00000000 --- a/sourcecodes/localscore/PrtUtil.h +++ /dev/null @@ -1,71 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1998-2012 The R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* - * These functions are not part of the API. - */ -#ifndef PRTUTIL_H_ -#define PRTUTIL_H_ - -#include <R_ext/Complex.h> -#include <R_ext/Print.h> - -#define formatLogical Rf_formatLogical -#define formatInteger Rf_formatInteger -#define formatReal Rf_formatReal -#define formatComplex Rf_formatComplex -#define EncodeLogical Rf_EncodeLogical -#define EncodeInteger Rf_EncodeInteger -#define EncodeReal Rf_EncodeReal -#define EncodeComplex Rf_EncodeComplex -#define VectorIndex Rf_VectorIndex -#define printIntegerVector Rf_printIntegerVector -#define printRealVector Rf_printRealVector -#define printComplexVector Rf_printComplexVector - -#ifdef __cplusplus -extern "C" { -#endif - -/* Computation of printing formats */ -void formatLogical(int *, int, int *); -void formatInteger(int *, int, int *); -void formatReal(double *, int, int *, int *, int *, int); -void formatComplex(Rcomplex *, int, int *, int *, int *, int *, int *, int *, int); - -/* Formating of values */ -const char *EncodeLogical(int, int); -const char *EncodeInteger(int, int); -const char *EncodeReal(double, int, int, int, char); -const char *EncodeComplex(Rcomplex, int, int, int, int, int, int, char); - -/* Printing */ -void VectorIndex(int, int); - -void printLogicalVector(int *, int, int); -void printIntegerVector(int *, int, int); -void printRealVector (double *, int, int); -void printComplexVector(Rcomplex *,int, int); - -/* char *Rsprintf(char*, ...); */ -#ifdef __cplusplus -} -#endif - -#endif /* PRTUTIL_H_ */ diff --git a/sourcecodes/localscore/QuartzDevice.h b/sourcecodes/localscore/QuartzDevice.h deleted file mode 100644 index ceb513e2..00000000 --- a/sourcecodes/localscore/QuartzDevice.h +++ /dev/null @@ -1,235 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2007 The R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - * - *--------------------------------------------------------------------- - * This header file constitutes the (unofficial) API to the Quartz - * device. Being unofficial, the API may change at any point without - * warning. - * - * Quartz is a general device-independent way of drawing in Mac OS X, - * therefore the Quartz device modularizes the actual drawing target - * implementation into separate modules (e.g. Carbon and Cocoa for - * on-screen display and PDF, Bitmap for off-screen drawing). The API - * below is used by the modules to talk to the Quartz device without - * having to know anything about R graphics device API. - * - * Key functions are listed here: - * QuartzDevice_Create - creates a Quartz device - * QuartzDevice_ResetContext - should be called after the target - * context has been created to initialize it. - * QuartzDevice_Kill - closes the Quartz device (e.g. on window close) - * QuartzDevice_SetScaledSize - resize device (does not include - * re-painting, it should be followed by a call to - * QuartzDevice_ReplayDisplayList) - * QuartzDevice_ReplayDisplayList - replays all plot commands - * - * Key concepts - * - all Quartz modules are expected to provide a device context - * (CGContextRef) for drawing. A device can temporarily return NULL - * (e.g. if the context is not available immediately) and replay - * the display list later to catch up. - * - * - interactive devices can use QuartzDevice_SetScaledSize to resize - * the device (no context is necessary), then prepare the context - * (call QuartzDevice_ResetContext if a new context was created) - * and finally re-draw using QuartzDevice_ReplayDisplayList. - * - * - snapshots can be created either off the current display list - * (last=0) or off the last known one (last=1). NewPage callback - * can only use last=1 as there is no display list during that - * call. Restored snapshots become the current display list and - * thus can be extended by further painting (yet the original saved - * copy is not influenced). Also note that all snapshots are SEXPs - * (the declaration doesn't use SEXP as to not depend on - * Rinternals.h) therefore must be protected or preserved immediately - * (i.e. the Quartz device does NOT protect them - except in the - * call to RestoreSnapshot). - * - * - dirty flag: the dirty flag is not used internally by the Quartz - * device, but can be useful for the modules to determine whether - * the current graphics is a restored copy or in-progress - * drawing. The Quartz device manages the flag as follows: a) - * display list replay does NOT change the flag, b) snapshot - * restoration resets the flag, c) all other paint operations - * (i.e. outside of restore/replay) set the flag. Most common use - * is to determine whether restored snapshots have been - * subsequently modified. - * - * - history: currently the history management is not used by any - * modules and as such is untested and strictly experimental. It - * may be removed in the future as it is not clear whether it makes - * sense to be part of the device. See Cocoa module for a - * module-internal implementation of the display history. - * - * Quartz device creation path: - * quartz() function -> SEXP Quartz(args) -> - * setup QuartzParameters_t, call backend constructor - * [e.g. QuartzCocoa_DeviceCreate(dd, fn, QuartzParameters_t *pars)] -> - * create backend definition (QuartzBackend_t backend) -> - * fn->Create(dd, &backend), return the result - */ - -#ifndef R_EXT_QUARTZDEVICE_H_ -#define R_EXT_QUARTZDEVICE_H_ - -/* FIXME: this is installed, but can it really work without config.h */ - -#ifdef HAVE_CONFIG_H -#include <config.h> -#endif - -#ifdef __cplusplus -extern "C" { -#endif - -#if HAVE_AQUA -#include <ApplicationServices/ApplicationServices.h> -#else - typedef void* CGContextRef; -#endif - -/* flags passed to the newPage callback */ -#define QNPF_REDRAW 0x0001 /* is set when NewPage really means re-draw of an existing page */ - -/* flags passed to QuartzDevice_Create (as fs parameter) */ -#define QDFLAG_DISPLAY_LIST 0x0001 -#define QDFLAG_INTERACTIVE 0x0002 -#define QDFLAG_RASTERIZED 0x0004 /* rasterized media - may imply disabling AA paritally for rects etc. */ - -/* parameter flags (they should not conflict with QDFLAGS to allow chaining) */ -#define QPFLAG_ANTIALIAS 0x0100 - -typedef void* QuartzDesc_t; - -typedef struct QuartzBackend_s { - int size; /* structure size */ - double width, height; - double scalex, scaley, pointsize; - int bg, canvas; - int flags; - void* userInfo; - CGContextRef (*getCGContext)(QuartzDesc_t dev, void*userInfo); /* Get the context for this device */ - int (*locatePoint)(QuartzDesc_t dev, void*userInfo, double*x, double*y); - void (*close)(QuartzDesc_t dev, void*userInfo); - void (*newPage)(QuartzDesc_t dev, void*userInfo, int flags); - void (*state)(QuartzDesc_t dev, void*userInfo, int state); - void* (*par)(QuartzDesc_t dev, void*userInfo, int set, const char *key, void *value); - void (*sync)(QuartzDesc_t dev, void*userInfo); - void* (*cap)(QuartzDesc_t dev, void*userInfo); -} QuartzBackend_t; - -/* parameters that are passed to functions that create backends */ -typedef struct QuartzParameters_s { - int size; /* structure size */ - const char *type, *file, *title; - double x, y, width, height, pointsize; - const char *family; - int flags; - int connection; - int bg, canvas; - double *dpi; - /* the following parameters can be used to pass custom parameters when desired */ - double pard1, pard2; - int pari1, pari2; - const char *pars1, *pars2; - void *parv; -} QuartzParameters_t; - -/* all device implementations have to call this general Quartz device constructor at some point */ -QuartzDesc_t QuartzDevice_Create(void *dd, QuartzBackend_t* def); - -typedef struct QuartzFunctons_s { - void* (*Create)(void *, QuartzBackend_t *); /* create a new device */ - int (*DevNumber)(QuartzDesc_t desc); /* returns device number */ - void (*Kill)(QuartzDesc_t desc); /* call to close the device */ - void (*ResetContext)(QuartzDesc_t desc); /* notifies Q back-end that the implementation has created a new context */ - double (*GetWidth)(QuartzDesc_t desc); /* get device width (in inches) */ - double (*GetHeight)(QuartzDesc_t desc); /* get device height (in inches) */ - void (*SetSize)(QuartzDesc_t desc, double width, double height); /* set device size (in inches) */ - - double (*GetScaledWidth)(QuartzDesc_t desc); /* get device width (in pixels) */ - double (*GetScaledHeight)(QuartzDesc_t desc); /* get device height (in pixels) */ - void (*SetScaledSize)(QuartzDesc_t desc, double width, double height); /* set device size (in pixels) */ - - double (*GetXScale)(QuartzDesc_t desc); /* get x scale factor (px/pt ratio) */ - double (*GetYScale)(QuartzDesc_t desc); /* get y scale factor (px/pt ratio) */ - void (*SetScale)(QuartzDesc_t desc,double scalex, double scaley); /* sets both scale factors (px/pt ratio) */ - - void (*SetTextScale)(QuartzDesc_t desc,double scale); /* sets text scale factor */ - double (*GetTextScale)(QuartzDesc_t desc); /* sets text scale factor */ - - void (*SetPointSize)(QuartzDesc_t desc,double ps); /* sets point size */ - double (*GetPointSize)(QuartzDesc_t desc); /* gets point size */ - - int (*GetDirty)(QuartzDesc_t desc); /* sets dirty flag */ - void (*SetDirty)(QuartzDesc_t desc,int dirty); /* gets dirty flag */ - - void (*ReplayDisplayList)(QuartzDesc_t desc); /* replay display list - Note: it inhibits sync calls during repaint, - the caller is responsible for calling sync if needed. - Dirty flag is kept unmodified */ - void* (*GetSnapshot)(QuartzDesc_t desc, int last); - /* create a (replayable) snapshot of the device contents. - when 'last' is set then the last stored display list is used, - otherwise a new snapshot is created */ - void (*RestoreSnapshot)(QuartzDesc_t desc,void* snapshot); - /* restore a snapshot. also clears the dirty flag */ - - int (*GetAntialias)(QuartzDesc_t desc); /* get anti-alias flag */ - void (*SetAntialias)(QuartzDesc_t desc, int aa); /* set anti-alias flag */ - - int (*GetBackground)(QuartzDesc_t desc); /* get background color */ - void (*Activate)(QuartzDesc_t desc); /* activate/select the device */ - /* get/set Quartz-specific parameters. desc can be NULL for global parameters */ - void* (*SetParameter)(QuartzDesc_t desc, const char *key, void *value); - void* (*GetParameter)(QuartzDesc_t desc, const char *key); -} QuartzFunctions_t; - -#define QuartzParam_EmbeddingFlags "embeddeding flags" /* value: int[1] */ -#define QP_Flags_CFLoop 0x0001 /* drives application event loop */ -#define QP_Flags_Cocoa 0x0002 /* Cocoa is fully initialized */ -#define QP_Flags_Front 0x0004 /* is front application */ - -/* from unix/aqua.c - loads grDevices if necessary and returns NULL on failure */ -QuartzFunctions_t *getQuartzFunctions(); - -/* type of a Quartz contructor */ -typedef QuartzDesc_t (*quartz_create_fn_t)(void *dd, QuartzFunctions_t *fn, QuartzParameters_t *par); - -/* grDevices currently supply following constructors: - QuartzCocoa_DeviceCreate, QuartzCarbon_DeviceCreate, - QuartzBitmap_DeviceCreate, QuartzPDF_DeviceCreate */ - -/* embedded Quartz support hook (defined in unix/aqua.c): - dd = should be passed-through to QuartzDevice_Create - fn = Quartz API functions - par = parameters (see above) */ -#ifndef IN_AQUA_C - extern -#endif - QuartzDesc_t (*ptr_QuartzBackend)(void *dd, QuartzFunctions_t *fn, QuartzParameters_t *par); - -/* C version of the Quartz call (experimental) - returns 0 on success, error code on failure */ -QuartzDesc_t Quartz_C(QuartzParameters_t *par, quartz_create_fn_t q_create, int *errorCode); - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/sourcecodes/localscore/R-ftp-http.h b/sourcecodes/localscore/R-ftp-http.h deleted file mode 100644 index 665bfb87..00000000 --- a/sourcecodes/localscore/R-ftp-http.h +++ /dev/null @@ -1,65 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2001-6 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* Advertized entry points, for that part of libxml included in - * the internet module. - */ - -#ifndef R_FTP_HTTP_H_ -#define R_FTP_HTTP_H_ - -#ifdef __cplusplus -extern "C" { -#endif - -void *R_HTTPOpen(const char *url); -int R_HTTPRead(void *ctx, char *dest, int len); -void R_HTTPClose(void *ctx); - -void *R_FTPOpen(const char *url); -int R_FTPRead(void *ctx, char *dest, int len); -void R_FTPClose(void *ctx); - -void * RxmlNanoHTTPOpen(const char *URL, char **contentType, const char *headers, int cacheOK); -int RxmlNanoHTTPRead(void *ctx, void *dest, int len); -void RxmlNanoHTTPClose(void *ctx); -int RxmlNanoHTTPReturnCode(void *ctx); -char * RxmlNanoHTTPStatusMsg(void *ctx); -int RxmlNanoHTTPContentLength(void *ctx); -char * RxmlNanoHTTPContentType(void *ctx); -void RxmlNanoHTTPTimeout(int delay); - -void * RxmlNanoFTPOpen(const char *URL); -int RxmlNanoFTPRead(void *ctx, void *dest, int len); -int RxmlNanoFTPClose(void *ctx); -void RxmlNanoFTPTimeout(int delay); -int RxmlNanoFTPContentLength(void *ctx); - -void RxmlMessage(int level, const char *format, ...); - -/* not currently used */ - -void RxmlNanoFTPCleanup(void); -void RxmlNanoHTTPCleanup(void); - -#ifdef __cplusplus -} -#endif - -#endif /* R_FTP_HTTP_H_ */ diff --git a/sourcecodes/localscore/R.h b/sourcecodes/localscore/R.h deleted file mode 100644 index 5c5696b3..00000000 --- a/sourcecodes/localscore/R.h +++ /dev/null @@ -1,65 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2000-2010 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -#ifndef R_R_H -#define R_R_H - -#ifndef USING_R -# define USING_R -#endif - -#ifndef NO_C_HEADERS -#include <stdlib.h> -#include <stdio.h> /* Used by several packages, remove in due course */ -#include <limits.h> /* for INT_MAX */ -#include <math.h> -#endif - -#include "Rconfig.h" -#include "Arith.h" /* R_FINITE, ISNAN, ... */ -#include "Boolean.h" /* Rboolean type */ -#include "Complex.h" /* Rcomplex type */ -#include "Constants.h" /* PI, DOUBLE_EPS, etc */ -#include "Error.h" /* error and warning */ -#include "Memory.h" /* R_alloc and S_alloc */ -#include "Print.h" /* Rprintf etc */ -#include "Random.h" /* RNG interface */ -#include "Utils.h" /* sort routines et al */ -#include "RS.h" -/* for PROBLEM ... Calloc, Realloc, Free, Memcpy, F77_xxxx */ - - -typedef double Sfloat; -typedef int Sint; -#define SINT_MAX INT_MAX -#define SINT_MIN INT_MIN - -#ifdef __cplusplus -extern "C" { -#endif - -void R_FlushConsole(void); -/* always declared, but only usable under Win32 and Aqua */ -void R_ProcessEvents(void); - -#ifdef __cplusplus -} -#endif - -#endif /* !R_R_H */ diff --git a/sourcecodes/localscore/RConverters.h b/sourcecodes/localscore/RConverters.h deleted file mode 100644 index 9ac0da33..00000000 --- a/sourcecodes/localscore/RConverters.h +++ /dev/null @@ -1,131 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1998-2006 The R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - * - * - */ - -/* - Not part of the API, concerns .C() converters which are deprecated. - */ - -#ifndef R_CCONVERTERS_H -#define R_CCONVERTERS_H - -#include <Rinternals.h> - -#ifdef __cplusplus -extern "C" { -#endif - -#define freeCConverter RC_freeCConverter -#define R_addToCConverter RC_addToCConverter -#define R_converterMatchClass RC_converterMatchClass -#define R_converterMatchClass RC_converterMatchClass -#define R_getToCConverterByDescription RC_getToCConverterByDescription -#define R_getToCConverterByIndex RC_getToCConverterByIndex -#define R_getToCConverterByIndex RC_getToCConverterByIndex -#define R_removeToCConverter RC_removeToCConverter - - /* Context information controlling how the conversion is performed, passed - to RObjToCPtr in dotcode.c and the different user level converters. */ - typedef struct { - int naok; - int narg; - int dup; - int Fort; - - char const * name ; - - SEXP classes; - } R_CConvertInfo; - - - /* Typedefs for structs defined below with future/cross-referencing. */ - typedef struct RtoCConverter R_toCConverter; - typedef struct RFromCConvertInfo R_FromCConvertInfo; - - - /* The matching routine which determines whether the converter can process the given SEXP. */ - typedef Rboolean (*R_ToCPredicate)(SEXP obj, R_CConvertInfo *info, R_toCConverter *el); - - /* The converter routine that returns the value to be passed to the C routine. - (We may have to make the return type a union to handle the different types.) */ - typedef void* (*R_ToCConverter)(SEXP obj, R_CConvertInfo *info, R_toCConverter *el); - - /* The reverse converter from the C argument to the R object that is returned via the .C() call. */ - typedef SEXP (*R_FromCConverter)(void *value, SEXP arg, R_FromCConvertInfo *info, - R_toCConverter *el); - - - /* The definition of the converter element which are stored as a linked list. */ - struct RtoCConverter { - R_ToCPredicate matcher; /* check if converter applies to R object */ - R_ToCConverter converter; /* convert the R object to C value */ - R_FromCConverter reverse; /* convert the C value back to an R object. */ - char *description; /* user-readable string describing the converter. */ - void *userData; /* additional information used in (any of) the matcher, - converter, and reverse routines to parameterize them. */ - Rboolean active; /* allows the converter to be in the list but ignored temporarily. */ - - R_toCConverter *next; /* next element in the linked list. */ - }; - - - /* Information used to convert C values to R objects at the end of do_dotCode() */ - struct RFromCConvertInfo { - const char *functionName; /* the name of the routine being called (S's name for it). */ - - int argIndex; /* the pariticular argument being processed. */ - - /* We provide all of the arguments and the corresponding C values. - This gives the full context of the call to the reverse converter */ - SEXP allArgs; - void **cargs; - int nargs; - }; - - - - /* Internal mechanism for employing the converter mechanism, used in do_dotCode() in dotcode.c */ - void *Rf_convertToC(SEXP s, R_CConvertInfo *info, int *success, R_toCConverter **converter); - - /* Converter management facilities. */ - R_toCConverter *R_addToCConverter(R_ToCPredicate match, R_ToCConverter converter, - R_FromCConverter reverse, - void *userData, char *desc); - R_toCConverter *R_getToCConverterByIndex(int which); - R_toCConverter *R_getToCConverterByDescription(const char *desc); - void R_removeToCConverter(R_toCConverter *el); - - Rboolean R_converterMatchClass(SEXP obj, R_CConvertInfo *inf, R_toCConverter *el); - void freeCConverter(R_toCConverter *el); - - /* The routines corresponding to the .Internal() providing access to the - management facilities of the converter list. - */ - SEXP do_getNumRtoCConverters(SEXP call, SEXP op, SEXP args, SEXP env); - SEXP do_getRtoCConverterDescriptions(SEXP call, SEXP op, SEXP args, SEXP env); - SEXP do_getRtoCConverterStatus(SEXP call, SEXP op, SEXP args, SEXP env); - SEXP do_setToCConverterActiveStatus(SEXP call, SEXP op, SEXP args, SEXP env); - - -#ifdef __cplusplus -} -#endif - -#endif /* R_CCONVERTERS_H */ diff --git a/sourcecodes/localscore/RS.h b/sourcecodes/localscore/RS.h deleted file mode 100644 index e8ce2ef2..00000000 --- a/sourcecodes/localscore/RS.h +++ /dev/null @@ -1,96 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1999-2007 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* Included by R.h: API */ - -#ifndef R_RS_H -#define R_RS_H - -#ifndef NO_C_HEADERS -# include <string.h> /* for memcpy */ -#endif - -#include "Rconfig.h" /* for F77_APPEND_UNDERSCORE */ - -#ifdef __cplusplus -extern "C" { -#endif - -/* S Like Error Handling */ - -#include "Error.h" /* for error and warning */ - -#ifndef STRICT_R_HEADERS - -#define R_PROBLEM_BUFSIZE 4096 -/* Parentheses added for FC4 with gcc4 and -D_FORTIFY_SOURCE=2 */ -#define PROBLEM {char R_problem_buf[R_PROBLEM_BUFSIZE];(sprintf)(R_problem_buf, -#define MESSAGE {char R_problem_buf[R_PROBLEM_BUFSIZE];(sprintf)(R_problem_buf, -#define ERROR ),error(R_problem_buf);} -#define RECOVER(x) ),error(R_problem_buf);} -#define WARNING(x) ),warning(R_problem_buf);} -#define LOCAL_EVALUATOR /**/ -#define NULL_ENTRY /**/ -#define WARN WARNING(NULL) - -#endif - -/* S Like Memory Management */ - -extern void *R_chk_calloc(size_t, size_t); -extern void *R_chk_realloc(void *, size_t); -extern void R_chk_free(void *); - -#ifndef STRICT_R_HEADERS -/* S-PLUS 3.x but not 5.x NULLs the pointer in the following */ -#define Calloc(n, t) (t *) R_chk_calloc( (size_t) (n), sizeof(t) ) -#define Realloc(p,n,t) (t *) R_chk_realloc( (void *)(p), (size_t)((n) * sizeof(t)) ) -#define Free(p) (R_chk_free( (void *)(p) ), (p) = NULL) -#endif -#define R_Calloc(n, t) (t *) R_chk_calloc( (size_t) (n), sizeof(t) ) -#define R_Realloc(p,n,t) (t *) R_chk_realloc( (void *)(p), (size_t)((n) * sizeof(t)) ) -#define R_Free(p) (R_chk_free( (void *)(p) ), (p) = NULL) - -#define Memcpy(p,q,n) memcpy( p, q, (size_t)( (n) * sizeof(*p) ) ) - -#define CallocCharBuf(n) (char *) R_chk_calloc((size_t) ((n)+1), sizeof(char)) - -/* S Like Fortran Interface */ -/* These may not be adequate everywhere. Convex had _ prepending common - blocks, and some compilers may need to specify Fortran linkage */ - -#ifdef HAVE_F77_UNDERSCORE -# define F77_CALL(x) x ## _ -#else -# define F77_CALL(x) x -#endif -#define F77_NAME(x) F77_CALL(x) -#define F77_SUB(x) F77_CALL(x) -#define F77_COM(x) F77_CALL(x) -#define F77_COMDECL(x) F77_CALL(x) - -#ifndef NO_CALL_R -void call_R(char*, long, void**, char**, long*, char**, long, char**); -#endif - -#ifdef __cplusplus -} -#endif - -#endif /* R_RS_H */ diff --git a/sourcecodes/localscore/RStartup.h b/sourcecodes/localscore/RStartup.h deleted file mode 100644 index 5b89e7fe..00000000 --- a/sourcecodes/localscore/RStartup.h +++ /dev/null @@ -1,107 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1999-2010 The R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* - C functions to be called from alternative front-ends. - - Part of the API for such front-ends but not for packages. -*/ - -#ifndef R_EXT_RSTARTUP_H_ -#define R_EXT_RSTARTUP_H_ - -#include <R_ext/Boolean.h> /* TRUE/FALSE */ - -#ifdef __cplusplus -extern "C" { -#endif - -#ifdef Win32 -typedef int (*blah1) (const char *, char *, int, int); -typedef void (*blah2) (const char *, int); -typedef void (*blah3) (void); -typedef void (*blah4) (const char *); -/* Return value here is expected to be 1 for Yes, -1 for No and 0 for Cancel: - symbolic constants in graphapp.h */ -typedef int (*blah5) (const char *); -typedef void (*blah6) (int); -typedef void (*blah7) (const char *, int, int); -typedef enum {RGui, RTerm, LinkDLL} UImode; -#endif - -/* Startup Actions */ -typedef enum { - SA_NORESTORE,/* = 0 */ - SA_RESTORE, - SA_DEFAULT,/* was === SA_RESTORE */ - SA_NOSAVE, - SA_SAVE, - SA_SAVEASK, - SA_SUICIDE -} SA_TYPE; - -typedef struct -{ - Rboolean R_Quiet; - Rboolean R_Slave; - Rboolean R_Interactive; - Rboolean R_Verbose; - Rboolean LoadSiteFile; - Rboolean LoadInitFile; - Rboolean DebugInitFile; - SA_TYPE RestoreAction; - SA_TYPE SaveAction; - size_t vsize; - size_t nsize; - size_t max_vsize; - size_t max_nsize; - size_t ppsize; - int NoRenviron; - -#ifdef Win32 - char *rhome; /* R_HOME */ - char *home; /* HOME */ - blah1 ReadConsole; - blah2 WriteConsole; - blah3 CallBack; - blah4 ShowMessage; - blah5 YesNoCancel; - blah6 Busy; - UImode CharacterMode; - blah7 WriteConsoleEx; /* used only if WriteConsole is NULL */ -#endif -} structRstart; - -typedef structRstart *Rstart; - -void R_DefParams(Rstart); -void R_SetParams(Rstart); -void R_SetWin32(Rstart); -void R_SizeFromEnv(Rstart); -void R_common_command_line(int *, char **, Rstart); - -void R_set_command_line_arguments(int argc, char **argv); - -void setup_Rmainloop(void); // also in Rembedded.h - -#ifdef __cplusplus -} -#endif - -#endif diff --git a/sourcecodes/localscore/Random.h b/sourcecodes/localscore/Random.h deleted file mode 100644 index 1615778d..00000000 --- a/sourcecodes/localscore/Random.h +++ /dev/null @@ -1,75 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1998-2011 The R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* Included by R.h: API */ - -#ifndef R_RANDOM_H -#define R_RANDOM_H - -#ifdef __cplusplus -extern "C" { -#endif - -#include "Boolean.h" - -typedef enum { - WICHMANN_HILL, - MARSAGLIA_MULTICARRY, - SUPER_DUPER, - MERSENNE_TWISTER, - KNUTH_TAOCP, - USER_UNIF, - KNUTH_TAOCP2, - LECUYER_CMRG -} RNGtype; - -/* Different kinds of "N(0,1)" generators :*/ -typedef enum { - BUGGY_KINDERMAN_RAMAGE, - AHRENS_DIETER, - BOX_MULLER, - USER_NORM, - INVERSION, - KINDERMAN_RAMAGE -} N01type; - - -void GetRNGstate(void); -void PutRNGstate(void); - -double unif_rand(void); -/* These are also defined in Rmath.h */ -double norm_rand(void); -double exp_rand(void); - -typedef unsigned int Int32; -double * user_unif_rand(void); -void user_unif_init(Int32); -int * user_unif_nseed(void); -int * user_unif_seedloc(void); - -double * user_norm_rand(void); - -void FixupProb(double *, int, int, Rboolean); - -#ifdef __cplusplus -} -#endif - -#endif /* R_RANDOM_H */ diff --git a/sourcecodes/localscore/Rconfig.h b/sourcecodes/localscore/Rconfig.h deleted file mode 100644 index 2541c8a9..00000000 --- a/sourcecodes/localscore/Rconfig.h +++ /dev/null @@ -1,20 +0,0 @@ -/* Rconfig.h. Generated automatically */ -#ifndef R_RCONFIG_H -#define R_RCONFIG_H - -#ifndef R_CONFIG_H - -#define HAVE_F77_UNDERSCORE 1 -#define IEEE_754 1 -/* #undef WORDS_BIGENDIAN */ -#define R_INLINE inline -#define HAVE_VISIBILITY_ATTRIBUTE 1 -#define SUPPORT_UTF8 1 -#define SUPPORT_MBCS 1 -#define ENABLE_NLS 1 -/* #undef HAVE_AQUA */ -#define SUPPORT_OPENMP 1 - -#endif /* not R_CONFIG_H */ - -#endif /* not R_RCONFIG_H */ diff --git a/sourcecodes/localscore/Rdynload.h b/sourcecodes/localscore/Rdynload.h deleted file mode 100644 index 982b571a..00000000 --- a/sourcecodes/localscore/Rdynload.h +++ /dev/null @@ -1,129 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2001-12 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* - C functions used to register compiled code in packages. - - Those needed for that purpose are part of the API. - */ - -#ifndef R_EXT_DYNLOAD_H_ -#define R_EXT_DYNLOAD_H_ - -#include <R_ext/Boolean.h> - -/* called with a variable argument set */ -typedef void * (*DL_FUNC)(); - -typedef unsigned int R_NativePrimitiveArgType; - -#define SINGLESXP 302 /* Don't have a single type for this. */ - -/* In the future, we will want to allow people register their own types - and then refer to these in other contexts. Something like the Gtk type - system may be appropriate. -*/ -typedef unsigned int R_NativeObjectArgType; - - -/* In the near future, we may support registering - information about the arguments of native routines - and whether they are used to return information. - The hope is that we can minimize copying objects even - further. Not currently in use. -*/ -typedef enum {R_ARG_IN, R_ARG_OUT, R_ARG_IN_OUT, R_IRRELEVANT} R_NativeArgStyle; - - - -/* - These are very similar to those in unix/dynload.c - but we maintain them separately to give us more freedom to do - some computations on the internal versions that are derived from - these definitions. -*/ -typedef struct { - const char *name; - DL_FUNC fun; - int numArgs; - - R_NativePrimitiveArgType *types; - R_NativeArgStyle *styles; - -} R_CMethodDef; - -typedef R_CMethodDef R_FortranMethodDef; - - - -typedef struct { - const char *name; - DL_FUNC fun; - int numArgs; -/* In the future, we will put types in here for the different arguments. - We need a richer type system to do this effectively so that one - can specify types for new classes. -*/ -} R_CallMethodDef; -typedef R_CallMethodDef R_ExternalMethodDef; - - -typedef struct _DllInfo DllInfo; - -/* - Currently ignore the graphics routines, accessible via .External.graphics() - and .Call.graphics(). - */ -#ifdef __cplusplus -extern "C" { -#endif -int R_registerRoutines(DllInfo *info, const R_CMethodDef * const croutines, - const R_CallMethodDef * const callRoutines, - const R_FortranMethodDef * const fortranRoutines, - const R_ExternalMethodDef * const externalRoutines); - -Rboolean R_useDynamicSymbols(DllInfo *info, Rboolean value); - -DllInfo *R_getDllInfo(const char *name); - -/* to be used by applications embedding R to register their symbols - that are not related to any dynamic module */ -DllInfo *R_getEmbeddingDllInfo(void); - -typedef struct Rf_RegisteredNativeSymbol R_RegisteredNativeSymbol; -typedef enum {R_ANY_SYM=0, R_C_SYM, R_CALL_SYM, R_FORTRAN_SYM, R_EXTERNAL_SYM} NativeSymbolType; - - -DL_FUNC R_FindSymbol(char const *, char const *, - R_RegisteredNativeSymbol *symbol); - - -/* Experimental interface for exporting and importing functions from - one package for use from C code in a package. The registration - part probably ought to be integrated with the other registrations. - The naming of these routines may be less than ideal. */ - -void R_RegisterCCallable(const char *package, const char *name, DL_FUNC fptr); -DL_FUNC R_GetCCallable(const char *package, const char *name); - -#ifdef __cplusplus -} -#endif - -#endif /* R_EXT_DYNLOAD_H_ */ diff --git a/sourcecodes/localscore/Riconv.h b/sourcecodes/localscore/Riconv.h deleted file mode 100644 index 13864ee6..00000000 --- a/sourcecodes/localscore/Riconv.h +++ /dev/null @@ -1,46 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2005 the R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* - Interface to R's platform-independent implementation of iconv. - - Part of the API. -*/ - -#ifndef R_ICONV_H -#define R_ICONV_H - -#ifdef __cplusplus -extern "C" { -#endif - -/* from sysutils.c */ -#undef Riconv_open -#undef Riconv -#undef Riconv_close -void * Riconv_open (const char* tocode, const char* fromcode); -size_t Riconv (void * cd, const char **inbuf, size_t *inbytesleft, - char **outbuf, size_t *outbytesleft); -int Riconv_close (void * cd); - -#ifdef __cplusplus -} -#endif - -#endif /* R_ICONV_H */ diff --git a/sourcecodes/localscore/Rmath.h b/sourcecodes/localscore/Rmath.h deleted file mode 100644 index 1acd1dbb..00000000 --- a/sourcecodes/localscore/Rmath.h +++ /dev/null @@ -1,657 +0,0 @@ -/* -*- C -*- - * Mathlib : A C Library of Special Functions - * Copyright (C) 1998-2011 The R Core Team - * Copyright (C) 2004 The R Foundation - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - * - - * Rmath.h should contain ALL headers from R's C code in `src/nmath' - ------- such that ``the Math library'' can be used by simply - - ``#include <Rmath.h> '' - - and nothing else. - - It is part of the API and supports 'standalone Rmath'. - -*/ -#ifndef RMATH_H -#define RMATH_H - -/* Note that on some systems we need to include math.h before the - defines below, to avoid redefining ftrunc */ -#ifndef NO_C_HEADERS -# include <math.h> -#endif - -/*-- Mathlib as part of R -- define this for standalone : */ -/* #undef MATHLIB_STANDALONE */ - -#define R_VERSION_STRING "2.15.2" - -#ifndef HAVE_EXPM1 -# define HAVE_EXPM1 1 -#endif - -#ifndef HAVE_HYPOT -# define HAVE_HYPOT 1 -#endif - -#ifndef HAVE_LOG1P -# define HAVE_LOG1P 1 -#endif - -#ifndef HAVE_WORKING_LOG1P -# define HAVE_WORKING_LOG1P 1 -#endif - -#if defined(HAVE_LOG1P) && !defined(HAVE_WORKING_LOG1P) -/* remap to avoid problems with getting the right entry point */ -double Rlog1p(double); -#define log1p Rlog1p -#endif - - - /* Undo SGI Madness */ - -#ifdef ftrunc -# undef ftrunc -#endif -#ifdef qexp -# undef qexp -#endif -#ifdef qgamma -# undef qgamma -#endif - - -/* ----- The following constants and entry points are part of the R API ---- */ - -/* 30 Decimal-place constants */ -/* Computed with bc -l (scale=32; proper round) */ - -/* SVID & X/Open Constants */ -/* Names from Solaris math.h */ - -#ifndef M_E -#define M_E 2.718281828459045235360287471353 /* e */ -#endif - -#ifndef M_LOG2E -#define M_LOG2E 1.442695040888963407359924681002 /* log2(e) */ -#endif - -#ifndef M_LOG10E -#define M_LOG10E 0.434294481903251827651128918917 /* log10(e) */ -#endif - -#ifndef M_LN2 -#define M_LN2 0.693147180559945309417232121458 /* ln(2) */ -#endif - -#ifndef M_LN10 -#define M_LN10 2.302585092994045684017991454684 /* ln(10) */ -#endif - -#ifndef M_PI -#define M_PI 3.141592653589793238462643383280 /* pi */ -#endif - -#ifndef M_2PI -#define M_2PI 6.283185307179586476925286766559 /* 2*pi */ -#endif - -#ifndef M_PI_2 -#define M_PI_2 1.570796326794896619231321691640 /* pi/2 */ -#endif - -#ifndef M_PI_4 -#define M_PI_4 0.785398163397448309615660845820 /* pi/4 */ -#endif - -#ifndef M_1_PI -#define M_1_PI 0.318309886183790671537767526745 /* 1/pi */ -#endif - -#ifndef M_2_PI -#define M_2_PI 0.636619772367581343075535053490 /* 2/pi */ -#endif - -#ifndef M_2_SQRTPI -#define M_2_SQRTPI 1.128379167095512573896158903122 /* 2/sqrt(pi) */ -#endif - -#ifndef M_SQRT2 -#define M_SQRT2 1.414213562373095048801688724210 /* sqrt(2) */ -#endif - -#ifndef M_SQRT1_2 -#define M_SQRT1_2 0.707106781186547524400844362105 /* 1/sqrt(2) */ -#endif - -/* R-Specific Constants */ - -#ifndef M_SQRT_3 -#define M_SQRT_3 1.732050807568877293527446341506 /* sqrt(3) */ -#endif - -#ifndef M_SQRT_32 -#define M_SQRT_32 5.656854249492380195206754896838 /* sqrt(32) */ -#endif - -#ifndef M_LOG10_2 -#define M_LOG10_2 0.301029995663981195213738894724 /* log10(2) */ -#endif - -#ifndef M_SQRT_PI -#define M_SQRT_PI 1.772453850905516027298167483341 /* sqrt(pi) */ -#endif - -#ifndef M_1_SQRT_2PI -#define M_1_SQRT_2PI 0.398942280401432677939946059934 /* 1/sqrt(2pi) */ -#endif - -#ifndef M_SQRT_2dPI -#define M_SQRT_2dPI 0.797884560802865355879892119869 /* sqrt(2/pi) */ -#endif - - -#ifndef M_LN_SQRT_PI -#define M_LN_SQRT_PI 0.572364942924700087071713675677 /* log(sqrt(pi)) - == log(pi)/2 */ -#endif - -#ifndef M_LN_SQRT_2PI -#define M_LN_SQRT_2PI 0.918938533204672741780329736406 /* log(sqrt(2*pi)) - == log(2*pi)/2 */ -#endif - -#ifndef M_LN_SQRT_PId2 -#define M_LN_SQRT_PId2 0.225791352644727432363097614947 /* log(sqrt(pi/2)) */ -#endif - - -#ifdef MATHLIB_STANDALONE -# ifndef R_EXT_BOOLEAN_H_ -/* "copy-paste" R_ext/Boolean.h if not already included: */ - #define R_EXT_BOOLEAN_H_ - #undef FALSE - #undef TRUE - typedef enum { FALSE = 0, TRUE } Rboolean; -# endif -#else -# include "Boolean.h" -#endif - - -#ifndef MATHLIB_STANDALONE -#define bessel_i Rf_bessel_i -#define bessel_j Rf_bessel_j -#define bessel_k Rf_bessel_k -#define bessel_y Rf_bessel_y -#define bessel_i_ex Rf_bessel_i_ex -#define bessel_j_ex Rf_bessel_j_ex -#define bessel_k_ex Rf_bessel_k_ex -#define bessel_y_ex Rf_bessel_y_ex -#define beta Rf_beta -#define choose Rf_choose -#define dbeta Rf_dbeta -#define dbinom Rf_dbinom -#define dcauchy Rf_dcauchy -#define dchisq Rf_dchisq -#define dexp Rf_dexp -#define df Rf_df -#define dgamma Rf_dgamma -#define dgeom Rf_dgeom -#define dhyper Rf_dhyper -#define digamma Rf_digamma -#define dlnorm Rf_dlnorm -#define dlogis Rf_dlogis -#define dnbeta Rf_dnbeta -#define dnbinom Rf_dnbinom -#define dnchisq Rf_dnchisq -#define dnf Rf_dnf -#define dnorm4 Rf_dnorm4 -#define dnt Rf_dnt -#define dpois Rf_dpois -#define dpsifn Rf_dpsifn -#define dsignrank Rf_dsignrank -#define dt Rf_dt -#define dtukey Rf_dtukey -#define dunif Rf_dunif -#define dweibull Rf_dweibull -#define dwilcox Rf_dwilcox -#define fmax2 Rf_fmax2 -#define fmin2 Rf_fmin2 -#define fprec Rf_fprec -#define fround Rf_fround -#define ftrunc Rf_ftrunc -#define fsign Rf_fsign -#define gammafn Rf_gammafn -#define imax2 Rf_imax2 -#define imin2 Rf_imin2 -#define lbeta Rf_lbeta -#define lchoose Rf_lchoose -#define lgammafn Rf_lgammafn -#define lgammafn_sign Rf_lgammafn_sign -#define lgamma1p Rf_lgamma1p -#define log1pmx Rf_log1pmx -#define logspace_add Rf_logspace_add -#define logspace_sub Rf_logspace_sub -#define pbeta Rf_pbeta -#define pbeta_raw Rf_pbeta_raw -#define pbinom Rf_pbinom -#define pcauchy Rf_pcauchy -#define pchisq Rf_pchisq -#define pentagamma Rf_pentagamma -#define pexp Rf_pexp -#define pf Rf_pf -#define pgamma Rf_pgamma -#define pgeom Rf_pgeom -#define phyper Rf_phyper -#define plnorm Rf_plnorm -#define plogis Rf_plogis -#define pnbeta Rf_pnbeta -#define pnbinom Rf_pnbinom -#define pnchisq Rf_pnchisq -#define pnf Rf_pnf -#define pnorm5 Rf_pnorm5 -#define pnorm_both Rf_pnorm_both -#define pnt Rf_pnt -#define ppois Rf_ppois -#define psignrank Rf_psignrank -#define psigamma Rf_psigamma -#define pt Rf_pt -#define ptukey Rf_ptukey -#define punif Rf_punif -#define pythag Rf_pythag -#define pweibull Rf_pweibull -#define pwilcox Rf_pwilcox -#define qbeta Rf_qbeta -#define qbinom Rf_qbinom -#define qcauchy Rf_qcauchy -#define qchisq Rf_qchisq -#define qchisq_appr Rf_qchisq_appr -#define qexp Rf_qexp -#define qf Rf_qf -#define qgamma Rf_qgamma -#define qgeom Rf_qgeom -#define qhyper Rf_qhyper -#define qlnorm Rf_qlnorm -#define qlogis Rf_qlogis -#define qnbeta Rf_qnbeta -#define qnbinom Rf_qnbinom -#define qnchisq Rf_qnchisq -#define qnf Rf_qnf -#define qnorm5 Rf_qnorm5 -#define qnt Rf_qnt -#define qpois Rf_qpois -#define qsignrank Rf_qsignrank -#define qt Rf_qt -#define qtukey Rf_qtukey -#define qunif Rf_qunif -#define qweibull Rf_qweibull -#define qwilcox Rf_qwilcox -#define rbeta Rf_rbeta -#define rbinom Rf_rbinom -#define rcauchy Rf_rcauchy -#define rchisq Rf_rchisq -#define rexp Rf_rexp -#define rf Rf_rf -#define rgamma Rf_rgamma -#define rgeom Rf_rgeom -#define rhyper Rf_rhyper -#define rlnorm Rf_rlnorm -#define rlogis Rf_rlogis -#define rnbeta Rf_rnbeta -#define rnbinom Rf_rnbinom -#define rnchisq Rf_rnchisq -#define rnf Rf_rnf -#define rnorm Rf_rnorm -#define rnt Rf_rnt -#define rpois Rf_rpois -#define rsignrank Rf_rsignrank -#define rt Rf_rt -#define rtukey Rf_rtukey -#define runif Rf_runif -#define rweibull Rf_rweibull -#define rwilcox Rf_rwilcox -#define sign Rf_sign -#define tetragamma Rf_tetragamma -#define trigamma Rf_trigamma -#endif - -#define rround fround -#define prec fprec -#undef trunc -#define trunc ftrunc - -#ifdef __cplusplus -extern "C" { -#endif - /* R's versions with !R_FINITE checks */ - -double R_pow(double x, double y); -double R_pow_di(double, int); - - /* Random Number Generators */ - -double norm_rand(void); -double unif_rand(void); -double exp_rand(void); -#ifdef MATHLIB_STANDALONE -void set_seed(unsigned int, unsigned int); -void get_seed(unsigned int *, unsigned int *); -#endif - - /* Normal Distribution */ - -#define pnorm pnorm5 -#define qnorm qnorm5 -#define dnorm dnorm4 - -double dnorm(double, double, double, int); -double pnorm(double, double, double, int, int); -double qnorm(double, double, double, int, int); -double rnorm(double, double); -void pnorm_both(double, double *, double *, int, int);/* both tails */ - - /* Uniform Distribution */ - -double dunif(double, double, double, int); -double punif(double, double, double, int, int); -double qunif(double, double, double, int, int); -double runif(double, double); - - /* Gamma Distribution */ - -double dgamma(double, double, double, int); -double pgamma(double, double, double, int, int); -double qgamma(double, double, double, int, int); -double rgamma(double, double); - -double log1pmx(double); -double log1pexp(double); // <-- ../nmath/plogis.c -double lgamma1p(double); -double logspace_add(double, double); -double logspace_sub(double, double); - - /* Beta Distribution */ - -double dbeta(double, double, double, int); -double pbeta(double, double, double, int, int); -double qbeta(double, double, double, int, int); -double rbeta(double, double); - - /* Lognormal Distribution */ - -double dlnorm(double, double, double, int); -double plnorm(double, double, double, int, int); -double qlnorm(double, double, double, int, int); -double rlnorm(double, double); - - /* Chi-squared Distribution */ - -double dchisq(double, double, int); -double pchisq(double, double, int, int); -double qchisq(double, double, int, int); -double rchisq(double); - - /* Non-central Chi-squared Distribution */ - -double dnchisq(double, double, double, int); -double pnchisq(double, double, double, int, int); -double qnchisq(double, double, double, int, int); -double rnchisq(double, double); - - /* F Distibution */ - -double df(double, double, double, int); -double pf(double, double, double, int, int); -double qf(double, double, double, int, int); -double rf(double, double); - - /* Student t Distibution */ - -double dt(double, double, int); -double pt(double, double, int, int); -double qt(double, double, int, int); -double rt(double); - - /* Binomial Distribution */ - -double dbinom(double, double, double, int); -double pbinom(double, double, double, int, int); -double qbinom(double, double, double, int, int); -double rbinom(double, double); - - /* Multnomial Distribution */ - -void rmultinom(int, double*, int, int*); - - /* Cauchy Distribution */ - -double dcauchy(double, double, double, int); -double pcauchy(double, double, double, int, int); -double qcauchy(double, double, double, int, int); -double rcauchy(double, double); - - /* Exponential Distribution */ - -double dexp(double, double, int); -double pexp(double, double, int, int); -double qexp(double, double, int, int); -double rexp(double); - - /* Geometric Distribution */ - -double dgeom(double, double, int); -double pgeom(double, double, int, int); -double qgeom(double, double, int, int); -double rgeom(double); - - /* Hypergeometric Distibution */ - -double dhyper(double, double, double, double, int); -double phyper(double, double, double, double, int, int); -double qhyper(double, double, double, double, int, int); -double rhyper(double, double, double); - - /* Negative Binomial Distribution */ - -double dnbinom(double, double, double, int); -double pnbinom(double, double, double, int, int); -double qnbinom(double, double, double, int, int); -double rnbinom(double, double); - -double dnbinom_mu(double, double, double, int); -double pnbinom_mu(double, double, double, int, int); -double qnbinom_mu(double, double, double, int, int); -double rnbinom_mu(double, double); - - /* Poisson Distribution */ - -double dpois(double, double, int); -double ppois(double, double, int, int); -double qpois(double, double, int, int); -double rpois(double); - - /* Weibull Distribution */ - -double dweibull(double, double, double, int); -double pweibull(double, double, double, int, int); -double qweibull(double, double, double, int, int); -double rweibull(double, double); - - /* Logistic Distribution */ - -double dlogis(double, double, double, int); -double plogis(double, double, double, int, int); -double qlogis(double, double, double, int, int); -double rlogis(double, double); - - /* Non-central Beta Distribution */ - -double dnbeta(double, double, double, double, int); -double pnbeta(double, double, double, double, int, int); -double qnbeta(double, double, double, double, int, int); -double rnbeta(double, double, double); - - /* Non-central F Distribution */ - -double dnf(double, double, double, double, int); -double pnf(double, double, double, double, int, int); -double qnf(double, double, double, double, int, int); - - /* Non-central Student t Distribution */ - -double dnt(double, double, double, int); -double pnt(double, double, double, int, int); -double qnt(double, double, double, int, int); - - /* Studentized Range Distribution */ - -double ptukey(double, double, double, double, int, int); -double qtukey(double, double, double, double, int, int); - - /* Wilcoxon Rank Sum Distribution */ - -double dwilcox(double, double, double, int); -double pwilcox(double, double, double, int, int); -double qwilcox(double, double, double, int, int); -double rwilcox(double, double); - - /* Wilcoxon Signed Rank Distribution */ - -double dsignrank(double, double, int); -double psignrank(double, double, int, int); -double qsignrank(double, double, int, int); -double rsignrank(double); - - /* Gamma and Related Functions */ -double gammafn(double); -double lgammafn(double); -double lgammafn_sign(double, int*); -void dpsifn(double, int, int, int, double*, int*, int*); -double psigamma(double, double); -double digamma(double); -double trigamma(double); -double tetragamma(double); -double pentagamma(double); - -double beta(double, double); -double lbeta(double, double); - -double choose(double, double); -double lchoose(double, double); - - /* Bessel Functions */ - -double bessel_i(double, double, double); -double bessel_j(double, double); -double bessel_k(double, double, double); -double bessel_y(double, double); -double bessel_i_ex(double, double, double, double *); -double bessel_j_ex(double, double, double *); -double bessel_k_ex(double, double, double, double *); -double bessel_y_ex(double, double, double *); - - - /* General Support Functions */ - -#ifndef HAVE_HYPOT -double hypot(double, double); -#endif -double pythag(double, double); -#ifndef HAVE_EXPM1 -double expm1(double); /* = exp(x)-1 {care for small x} */ -#endif -#ifndef HAVE_LOG1P -double log1p(double); /* = log(1+x) {care for small x} */ -#endif -int imax2(int, int); -int imin2(int, int); -double fmax2(double, double); -double fmin2(double, double); -double sign(double); -double fprec(double, double); -double fround(double, double); -double fsign(double, double); -double ftrunc(double); - -double log1pmx(double); /* Accurate log(1+x) - x, {care for small x} */ -double lgamma1p(double);/* accurate log(gamma(x+1)), small x (0 < x < 0.5) */ - -/* Compute the log of a sum or difference from logs of terms, i.e., - * - * log (exp (logx) + exp (logy)) - * or log (exp (logx) - exp (logy)) - * - * without causing overflows or throwing away too much accuracy: - */ -double logspace_add(double logx, double logy); -double logspace_sub(double logx, double logy); - - - - -/* ----------------- Private part of the header file ------------------- */ - - /* old-R Compatibility */ - -#ifdef OLD_RMATH_COMPAT -# define snorm norm_rand -# define sunif unif_rand -# define sexp exp_rand -#endif - -#if defined(MATHLIB_STANDALONE) && !defined(MATHLIB_PRIVATE_H) -/* second is defined by nmath.h */ - -/* If isnan is a macro, as C99 specifies, the C++ - math header will undefine it. This happens on OS X */ -# ifdef __cplusplus - int R_isnancpp(double); /* in mlutils.c */ -# define ISNAN(x) R_isnancpp(x) -# else -# define ISNAN(x) (isnan(x)!=0) -# endif - -# define R_FINITE(x) R_finite(x) -int R_finite(double); - -# ifdef WIN32 /* not Win32 as no config information */ -# ifdef RMATH_DLL -# define R_EXTERN extern __declspec(dllimport) -# else -# define R_EXTERN extern -# endif -R_EXTERN double NA_REAL; -R_EXTERN double R_PosInf; -R_EXTERN double R_NegInf; -R_EXTERN int N01_kind; -# undef R_EXTERN -#else -extern int N01_kind; -# endif - -#endif /* MATHLIB_STANDALONE */ - -#ifdef __cplusplus -} -#endif - -#endif /* RMATH_H */ diff --git a/sourcecodes/localscore/Utils.h b/sourcecodes/localscore/Utils.h deleted file mode 100644 index 61efaaaa..00000000 --- a/sourcecodes/localscore/Utils.h +++ /dev/null @@ -1,115 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1998-2005 The R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - * - * - * Generally useful UTILITIES *NOT* relying on R internals (from Defn.h) - */ - -/* Included by R.h: API */ - -#ifndef R_EXT_UTILS_H_ -#define R_EXT_UTILS_H_ - -#include "Boolean.h" -#include "Complex.h" - -#define revsort Rf_revsort -#define iPsort Rf_iPsort -#define rPsort Rf_rPsort -#define cPsort Rf_cPsort -#define IndexWidth Rf_IndexWidth -#define setIVector Rf_setIVector -#define setRVector Rf_setRVector -#define StringFalse Rf_StringFalse -#define StringTrue Rf_StringTrue -#define isBlankString Rf_isBlankString -#define hsv2rgb Rf_hsv2rgb -#define rgb2hsv Rf_rgb2hsv - -#ifdef __cplusplus -extern "C" { -#endif - -/* ../../main/sort.c : */ -void R_isort(int*, int); -void R_rsort(double*, int); -void R_csort(Rcomplex*, int); -void rsort_with_index(double *, int *, int); -void revsort(double*, int*, int);/* reverse; sort i[] alongside */ -void iPsort(int*, int, int); -void rPsort(double*, int, int); -void cPsort(Rcomplex*, int, int); - -/* ../../main/qsort.c : */ -void R_qsort (double *v, int i, int j); -void R_qsort_I (double *v, int *I, int i, int j); -void R_qsort_int (int *iv, int i, int j); -void R_qsort_int_I(int *iv, int *I, int i, int j); -#ifdef R_RS_H -void F77_NAME(qsort4)(double *v, int *indx, int *ii, int *jj); -void F77_NAME(qsort3)(double *v, int *ii, int *jj); -#endif - -/* ../../main/printutils.c : */ -int IndexWidth(int); -/* ../../main/util.c and others : */ -const char *R_ExpandFileName(const char *); -void setIVector(int*, int, int); -void setRVector(double*, int, double); -Rboolean StringFalse(const char *); -Rboolean StringTrue(const char *); -Rboolean isBlankString(const char *); - -/* These two are guaranteed to use '.' as the decimal point, - and to accept "NA". - */ -double R_atof(const char *str); -double R_strtod(const char *c, char **end); - -char *R_tmpnam(const char *prefix, const char *tempdir); -char *R_tmpnam2(const char *prefix, const char *tempdir, const char *fileext); - -void hsv2rgb(double h, double s, double v, - double *r, double *g, double *b); -void rgb2hsv(double r, double g, double b, - double *h, double *s, double *v); - -void R_CheckUserInterrupt(void); -void R_CheckStack(void); - - -/* ../../appl/interv.c: also in Applic.h */ -int findInterval(double *xt, int n, double x, - Rboolean rightmost_closed, Rboolean all_inside, int ilo, - int *mflag); -#ifdef R_RS_H -int F77_SUB(interv)(double *xt, int *n, double *x, - Rboolean *rightmost_closed, Rboolean *all_inside, - int *ilo, int *mflag); -#endif -void find_interv_vec(double *xt, int *n, double *x, int *nx, - int *rightmost_closed, int *all_inside, int *indx); - -/* ../../appl/maxcol.c: also in Applic.h */ -void R_max_col(double *matrix, int *nr, int *nc, int *maxes, int *ties_meth); - -#ifdef __cplusplus -} -#endif - -#endif /* R_EXT_UTILS_H_ */ diff --git a/sourcecodes/localscore/Visibility.h b/sourcecodes/localscore/Visibility.h deleted file mode 100644 index aa35e342..00000000 --- a/sourcecodes/localscore/Visibility.h +++ /dev/null @@ -1,39 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2008 the R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* - Definitions controlling visibility on some platforms. - - Part of the API. -*/ - -#ifndef R_EXT_VISIBILITY_H_ -#define R_EXT_VISIBILITY_H_ - -#include <Rconfig.h> - -#ifdef HAVE_VISIBILITY_ATTRIBUTE -# define attribute_visible __attribute__ ((visibility ("default"))) -# define attribute_hidden __attribute__ ((visibility ("hidden"))) -#else -# define attribute_visible -# define attribute_hidden -#endif - -#endif /* R_EXT_VISIBILITY_H_ */ diff --git a/sourcecodes/localscore/eventloop.h b/sourcecodes/localscore/eventloop.h deleted file mode 100644 index 842cf9bb..00000000 --- a/sourcecodes/localscore/eventloop.h +++ /dev/null @@ -1,97 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2000-2007 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* - For use by alternative front-ends and packages which need to share - the R event loop (on all platforms). - - Not part of the API and subject to change without notice. - */ - -#ifndef R_EXT_EVENTLOOP_H -#define R_EXT_EVENTLOOP_H - -#ifndef NO_C_HEADERS -#ifdef HAVE_SYS_SELECT_H -# include <sys/select.h> /* for fd_set according to recent POSIX */ -#endif -/* NOTE: Needed at least on FreeBSD so that fd_set is defined. */ -# include <sys/types.h> -#endif - -#ifdef __cplusplus -extern "C" { -#endif - -#define XActivity 1 -#define StdinActivity 2 - -typedef void (*InputHandlerProc)(void *userData); - -typedef struct _InputHandler { - - int activity; - int fileDescriptor; - InputHandlerProc handler; - - struct _InputHandler *next; - - /* Whether we should be listening to this file descriptor or not. */ - int active; - - /* Data that can be passed to the routine as its only argument. - This might be a user-level function or closure when we implement - a callback to R mechanism. - */ - void *userData; - -} InputHandler; - - -extern InputHandler *initStdinHandler(void); -extern void consoleInputHandler(unsigned char *buf, int len); - -extern InputHandler *addInputHandler(InputHandler *handlers, int fd, InputHandlerProc handler, int activity); -extern InputHandler *getInputHandler(InputHandler *handlers, int fd); -extern int removeInputHandler(InputHandler **handlers, InputHandler *it); -extern InputHandler *getSelectedHandler(InputHandler *handlers, fd_set *mask); -extern fd_set *R_checkActivity(int usec, int ignore_stdin); -extern fd_set *R_checkActivityEx(int usec, int ignore_stdin, void (*intr)(void)); -extern void R_runHandlers(InputHandler *handlers, fd_set *mask); - -extern int R_SelectEx(int n, fd_set *readfds, fd_set *writefds, - fd_set *exceptfds, struct timeval *timeout, - void (*intr)(void)); - -#ifdef __SYSTEM__ -#ifndef __cplusplus /* Would get duplicate conflicting symbols*/ -InputHandler *R_InputHandlers; -#endif -#else -extern InputHandler *R_InputHandlers; -#endif - -extern void (* R_PolledEvents)(void); -extern int R_wait_usec; - -#ifdef __cplusplus -} -#endif - -#endif /* R_EXT_EVENTLOOP_H */ diff --git a/sourcecodes/localscore/index.html b/sourcecodes/localscore/index.html deleted file mode 100644 index 429668c7..00000000 --- a/sourcecodes/localscore/index.html +++ /dev/null @@ -1,6 +0,0 @@ -<html> -<head> -<title>Bayesian Network Web Server</title> -<meta HTTP-EQUIV="REFRESH" content="0; url=http://compbio.uthsc.edu/BNW/sourcecodes/home.php"> -</head> -</html> diff --git a/sourcecodes/localscore/libRmath.so b/sourcecodes/localscore/libRmath.so deleted file mode 100644 index 8c56eb4f..00000000 --- a/sourcecodes/localscore/libRmath.so +++ /dev/null Binary files differdiff --git a/sourcecodes/localscore/libextern.h b/sourcecodes/localscore/libextern.h deleted file mode 100644 index 3f61fb1e..00000000 --- a/sourcecodes/localscore/libextern.h +++ /dev/null @@ -1,48 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2001, 2004 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -/* Included by R.h: API on Windows */ - -/* don't disallow including this one more than once */ - -/* This is intended to be called from other header files, so not callable - from C++ */ - -#undef LibExtern -#undef LibImport -#undef LibExport - -/* Don't try to include CYGWIN here: decorating some symbols breaks - the auto-export that it relies on, even if R_DLL_BUILD were set. */ -#ifdef WIN32 /* WIN32 as does not depend on config.h */ -#define LibImport __declspec(dllimport) -#define LibExport __declspec(dllexport) -#else -#define LibImport -#define LibExport -#endif - -#ifdef __MAIN__ -#define LibExtern LibExport -#define extern -#elif defined(R_DLL_BUILD) -#define LibExtern extern -#else -#define LibExtern extern LibImport -#endif diff --git a/sourcecodes/localscore/matrix.h b/sourcecodes/localscore/matrix.h deleted file mode 100644 index b37772b4..00000000 --- a/sourcecodes/localscore/matrix.h +++ /dev/null @@ -1,42 +0,0 @@ -/* -*- Mode: C -*- - * matrix.h --- - * Author : Claus Dethlefsen - * Created On : Thu Mar 14 06:47:52 2002 - * Last Modified By: Claus Dethlefsen - * Last Modified On: Tue May 07 09:39:46 2002 - * Update Count : 22 - * Status : Unknown, Use with caution! - */ - -/* - ## -## Copyright (C) 2002 Susanne Gammelgaard Bøttcher, Claus Dethlefsen -## -## This program is free software; you can redistribute it and/or modify -## it under the terms of the GNU General Public License as published by -## the Free Software Foundation; either version 2 of the License, or -## (at your option) any later version. -## -## This program is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with this program; if not, write to the Free Software -## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -###################################################################### -*/ - -extern double ** dmatrix( int, int, int, int ); -extern int * ivector( int, int ); -extern void free_ivector( int *, int, int ); - -extern int invers(double **a, int n, double **b, int m); -extern void printmat( double **, int, int); -extern void asmatrix( double *, double **, int, int); -extern double** matcopy(double **, int, int); -extern double** matmult(double **,double **, int, int, int); -extern double** matsum(double **a, double **b, int nr, int nc); -extern double** matminus(double **a, double **b, int nr, int nc); -extern double** transp (double **a, int n, int m); diff --git a/sourcecodes/localscore/modified_matrix.c b/sourcecodes/localscore/modified_matrix.c deleted file mode 100644 index 8737b51b..00000000 --- a/sourcecodes/localscore/modified_matrix.c +++ /dev/null @@ -1,252 +0,0 @@ -/* -*- Mode: C -*- - * matrix.c --- Simple matrix functions for use with postc.c - * Author : Claus Dethlefsen - * Created On : Thu Mar 14 06:48:02 2002 - * Last Modified By: Claus Dethlefsen - * Last Modified On: Wed Jun 04 11:56:23 2003 - * Update Count : 36 - * Status : Ready - */ - -/* - ## -## Copyright (C) 2002 Susanne Gammelgaard Bøttcher, Claus Dethlefsen -## -## This program is free software; you can redistribute it and/or modify -## it under the terms of the GNU General Public License as published by -## the Free Software Foundation; either version 2 of the License, or -## (at your option) any later version. -## -## This program is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with this program; if not, write to the Free Software -## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -###################################################################### -*/ - - -#include "matrix.h" -#include "R.h" -#include "Rmath.h" - - -int *ivector(int nl, int nh) -{ - int *v; - - v=(int *) calloc((unsigned) (nh-nl+1)*sizeof(int),sizeof(int)); - if ( v == NULL ){ - //error("memory allocation failure in ivector()"); return(NULL); - } - return v-nl; -} - -void free_ivector(int *v, int nl, int nh) { free((char*) (v+nl)); } - -double **dmatrix(int nrl, int nrh, int ncl, int nch) -{ - int i; - double **m; - - m=(double **) calloc((unsigned) (nrh-nrl+1)*sizeof(double*),sizeof(double*)); - - m -= nrl; - - for(i=nrl;i<=nrh;i++) { - m[i]=(double *) calloc((unsigned) (nch-ncl+1)*sizeof(double),sizeof(double)); - - m[i] -= ncl; - } - return m; -} - -void free_dmatrix(double **m, int nrl, int nrh, int ncl, int nch) -{ - int i; - - for(i=nrh;i>=nrl;i--) free((char*) (m[i]+ncl)); - free((char*) (m+nrl)); -} - -void printmat(double **mat, int nr, int nc) { - int i,j; - -} - -void asmatrix(double *vek, double **mat, int nr, int nc) { - int i,j; - for (i=1; i<=nr; i++) { - for (j=1; j<=nc; j++) { - mat[i][j] = vek[j-1+(i-1)*nc]; - } - } - -} - -double** matcopy(double **mat, int nr, int nc) { - /* copy mat[i][j] into nat[i][j] */ - int i,j; - double **nat; - nat = dmatrix(1,nr,1,nc); -/* Rprintf("(nr=%d,nc=%d)\n",nr,nc); - Rprintf("(mat=%d)\n",mat); - Rprintf("(mat[1][1]=%f)\n",mat[1][1]); -*/ - - for (i=1; i<=nr; i++) { - for (j=1; j<=nc; j++) { - nat[i][j] = mat[i][j]; - } - } - return(nat); -} - -double** matmult(double **a, double **b, int nra, int nca, int ncb) { - double **c; - int i,j,k; - c = dmatrix(1,nra,1,ncb); - for (i=1; i<=nra; i++) - for (j=1; j<=ncb; j++) - c[i][j] = 0.0; - - for (i=1; i<=nra; i++) - for (k=1; k<=ncb; k++) - for (j=1; j<=nca; j++) - c[i][k] += a[i][j]*b[j][k]; - return(c); -} - - -double** modified_matmult(double **a, double **b, int nra, int nca, int ncb) { - double **c; - int i,j,k; - c = dmatrix(1,nra,1,ncb); - for (i=1; i<=nra; i++) - for (j=1; j<=ncb; j++) - c[i][j] = 0.0; - - for (i=1; i<=nra; i++) - for (k=1; k<=ncb; k++) - for (j=1; j<=nca; j++) - c[i][k] += a[i][j]*b[j][k]; - - for (i=1; i<=nra; i++) - { - for (j=1; j<=ncb; j++) - printf("%lf\t",c[i][j]); - printf("\n"); - } - - - return(c); -} - - -double** matsum(double **a, double **b, int nr, int nc) { - double **c; - int i,j; - c = dmatrix(1,nr,1,nc); - - for (i=1; i<=nr; i++) - for (j=1; j<=nc; j++) - c[i][j] = a[i][j] + b[i][j]; - return(c); -} - -double** matminus(double **a, double **b, int nr, int nc) { - double **c; - int i,j; - c = dmatrix(1,nr,1,nc); - - for (i=1; i<=nr; i++) - for (j=1; j<=nc; j++) - c[i][j] = a[i][j] - b[i][j]; - return(c); -} - -double** transp (double **a, int n, int m) { - double **b; - int i,j; - b = dmatrix(1,m,1,n); - for (i=1; i<=n; i++) - for (j=1; j<=m; j++) - b[j][i] = a[i][j]; - return(b); -} - -int invers(double **a, int n, double **b, int m) -{ - int *indxc,*indxr,*ipiv; - int i,icol=1,irow=1,j,k,l,ll; - double big,dum,pivinv; - -// if( (indxc = ivector(1,n)) == NULL){ return(-1); } - // if( (indxr = ivector(1,n)) == NULL){ return(-1); } - // if( (ipiv = ivector(1,n)) == NULL){ return(-1); } - if( (indxc=(int *)calloc((unsigned)(n+1)*sizeof(int),sizeof(int))) == NULL){ return(-1); } - if( (indxr=(int *)calloc((unsigned)(n+1)*sizeof(int),sizeof(int))) == NULL){ return(-1); } - if( (ipiv=(int *)calloc((unsigned)(n+1)*sizeof(int),sizeof(int))) == NULL){ return(-1); } - - - for (j=1;j<=n;j++) ipiv[j]=0; - for (i=1;i<=n;i++) { - big=0.0; - for (j=1;j<=n;j++) - if (ipiv[j] != 1) - for (k=1;k<=n;k++) { - if (ipiv[k] == 0) { - if (fabs(a[j][k]) >= big) { - big=fabs(a[j][k]); - irow=j; - icol=k; - } - } else if (ipiv[k] > 1){ - - return(-1); - } - } - ++(ipiv[icol]); - if (irow != icol) { - for (l=1;l<=n;l++){ - double temp=a[irow][l]; a[irow][l]=a[icol][l]; a[icol][l]=temp; - } - for (l=1;l<=m;l++){ - double temp=b[irow][l]; b[irow][l]=b[icol][l]; b[icol][l]=temp; - } - } - indxr[i]=irow; - indxc[i]=icol; - if (a[icol][icol] == 0.0){ - //error("Invers: Singular Matrix-2"); - return(-1); - } - pivinv=1.0/a[icol][icol]; - a[icol][icol]=1.0; - for (l=1;l<=n;l++) a[icol][l] *= pivinv; - for (l=1;l<=m;l++) b[icol][l] *= pivinv; - for (ll=1;ll<=n;ll++) - if (ll != icol) { - dum=a[ll][icol]; - a[ll][icol]=0.0; - for (l=1;l<=n;l++) a[ll][l] -= a[icol][l]*dum; - for (l=1;l<=m;l++) b[ll][l] -= b[icol][l]*dum; - } - } - for (l=n;l>=1;l--) { - if (indxr[l] != indxc[l]){ - for (k=1;k<=n;k++){ - double temp = a[k][indxr[l]]; - a[k][indxr[l]] = a[k][indxc[l]]; - a[k][indxc[l]] = temp; - } - } - } - free(indxc); free(indxr); free(ipiv); - return(0); -} - - diff --git a/sourcecodes/localscore/modified_postc.c b/sourcecodes/localscore/modified_postc.c deleted file mode 100644 index f223fdb8..00000000 --- a/sourcecodes/localscore/modified_postc.c +++ /dev/null @@ -1,171 +0,0 @@ -/* -*- Mode: C -*- - * postc.c --- Posterior for continuous node with continuous parents - * Author : Claus Dethlefsen - * Created On : Tue Mar 12 06:44:35 2002 - * Last Modified By: Claus Dethlefsen - * Last Modified On: Wed Jun 04 11:56:51 2003 - * Update Count : 227 - * Status : Unknown, Use with caution! - */ - -/* - ## -## Copyright (C) 2002 Susanne Gammelgaard Bøttcher, Claus Dethlefsen -## -## This program is free software; you can redistribute it and/or modify -## it under the terms of the GNU General Public License as published by -## the Free Software Foundation; either version 2 of the License, or -## (at your option) any later version. -## -## This program is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with this program; if not, write to the Free Software -## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -###################################################################### -*/ - -#include "R.h" -#include "Rmath.h" -#include "matrix.h" -#include "modified_matrix.c" - -void postc(double *mu, double *tau, double *rho, double *phi, double - *loglik, double *y, double *z, int *n, int *d) -{ - int i,j,ii,jj; - double logscale,logk,mscore; - double **mtau, **mmu, **tauinv=0; - double **zero, **zi, **ziy; - double **oldtau, **oldmu; - //temp pointers - double **tm1,**tm2,**tm3,**tm4,**mm1,**sm1,**sm2,**tt1,**tt2; - - /* allocate space for matrices */ - mtau = dmatrix(1,*d,1,*d); - oldtau = dmatrix(1,*d,1,*d); - - zi = dmatrix(1,*d,1,1); - ziy = dmatrix(1,*d,1,1); - mmu = dmatrix(1,*d,1,1); - oldmu = dmatrix(1,*d,1,1); - zero = dmatrix(1,*d,1,1); - tauinv = dmatrix(1,*d,1,*d); - - - - /* copy arguments into the matrices */ - asmatrix(mu,mmu,*d,1); - asmatrix(tau,mtau,*d,*d); - - /* show input */ - - for(i = 1; i <= *n; i++) { - for (ii=1; ii<=*d; ii++) { - for (jj=1; jj<=*d; jj++) { - tauinv[ii][jj] = mtau[ii][jj]; - } - } - - invers(tauinv, *d, zero, 1); - - for (j=1; j<=*d; j++) { - zi[j][1] = z[j-1+(i-1)*(*d)]; - } - //define once - tt1=transp(zi,*d,1); - - tm1=matmult(tauinv,zi,*d,*d,1); - tm2=matmult(tt1,tm1,1,*d,1); - - logscale = log(*phi) + log1p(tm2[1][1]); - - free_dmatrix(tm1,1,*d,1,*d); - free_dmatrix(tm2,1,1,1,*d); - - - logk = lgammafn( 0.5*(1.0+*rho) ) - lgammafn(*rho*0.5); - logk -= 0.5*(logscale + log(M_PI)); - - tm1=matmult(tt1,mmu,1,*d,1); - - - mscore = logk - 0.5*(*rho+1)*log1p((y[i-1] - tm1[1][1])*(y[i-1] - tm1[1][1])/exp(logscale)); - *loglik += mscore; - - free_dmatrix(tm1,1,1,1,1); - - for (ii=1; ii<=*d; ii++) { - for (jj=1; jj<=*d; jj++) { - oldtau[ii][jj] = mtau[ii][jj]; - } - } - - - for (jj=1; jj<=*d; jj++) { - oldmu[jj][1] = mmu[jj][1]; - } - - tm1=matmult(zi,tt1,*d,1,*d); - sm1=matsum(mtau,tm1,*d,*d); - free_dmatrix(mtau,1,*d,1,*d); - mtau = sm1; - free_dmatrix(tm1,1,*d,1,*d); - - for (ii=1; ii<=*d; ii++) { - for (jj=1; jj<=*d; jj++) { - tauinv[ii][jj] = mtau[ii][jj]; - } - } - - - invers(tauinv, *d, zero, 1); - - for (j=1;j<=*d;j++) - ziy[j][1] = zi[j][1]*y[i-1]; - - - tm1=matmult(oldtau,mmu,*d,*d,1); - sm2=matsum(tm1,ziy,*d,1); - free_dmatrix(mmu,1,*d,1,1); - mmu=matmult(tauinv,sm2,*d,*d,1); - free_dmatrix(tm1,1,*d,1,*d); - free_dmatrix(sm2,1,*d,1,1); - - - (*rho)++; - - tm1=matmult(tt1,mmu,1,*d,1); - mm1=matminus(oldmu,mmu,*d,1); - tt2=transp(mm1,*d,1); - tm3=matmult(oldtau,oldmu,*d,*d,1); - tm4=matmult(tt2,tm3,1,*d,1); - - (*phi) += (y[i-1]-tm1[1][1])*y[i-1] + tm4[1][1]; - - - free_dmatrix(tm1,1,1,1,*d); - free_dmatrix(mm1,1,*d,1,1); - free_dmatrix(tt2,1,1,1,*d); - free_dmatrix(tm3,1,*d,1,*d); - free_dmatrix(tm4,1,1,1,*d); - - free_dmatrix(tt1,1,1,1,*d); - - - } - - free_dmatrix(mtau,1,*d,1,*d); - free_dmatrix(zi,1,*d,1,1); - free_dmatrix(ziy,1,*d,1,1); - free_dmatrix(mmu,1,*d,1,1); - free_dmatrix(zero,1,*d,1,1); - free_dmatrix(tauinv,1,*d,1,*d); - free_dmatrix(oldtau,1,*d,1,*d); - free_dmatrix(oldmu,1,*d,1,1); - -} - diff --git a/sourcecodes/localscore/network_score.c b/sourcecodes/localscore/network_score.c deleted file mode 100644 index c50a520e..00000000 --- a/sourcecodes/localscore/network_score.c +++ /dev/null @@ -1,1441 +0,0 @@ -#include<stdio.h> -#include <stdlib.h> -#include<string.h> -#define MATHLIB_STANDALONE 1 -#include "matrix.h" -#include "postc0.c" -#include "modified_postc.c" // only line that has been changed in this code -//#define OUT_DIR "./Result/" //WHERE BENE READ DATA FOR STRUCTURE LEARNING //change it to #define OUT_DIR "/var/www/html/compbio/BNW/bene-0.9-4/example/resdir/" for server. Also change from sprintf(line+9,"%d",i); to sprintf(line+52,"%d",i); - -struct white{ -int n; -int *list; -}; - -struct ban{ -int n; -int *list; -}; - -struct ndata{ -int idx,type,score_i; -char **ddata; -char **label; //for descrete node -int lindex; -double *prob,*cdata,*post_alpha; -double score_zeroparent; -double *score; -struct white wlist; -struct ban blist; -}; - - -struct nd{ -int num,nd,*discrete,nc,*continuous,row; -double score; -struct ndata *node; -}; - -void get_next_seq(int *,int *,int); -void learn_node(struct nd *); -double learn_parent(struct nd *,int,int); - -double run_strtof (const char * input) //Convert string to double -{ - double output; - char * end; - output = strtod (input, & end); - if (end == input) { - return 0.0; - } - else { - return output; - } -} - - -char* itoa(int val, int base){ //convert number to string - - static char buf[32] = {0}; - - int i = 30; - - for(; val && i ; --i, val /= base) - - buf[i] = "0123456789abcdef"[val % base]; - - return &buf[i+1]; - -} - -double standarizedata(double val,double mean,double std) -{ - return (val-mean)/std; - -} - -double mean(double *a,int l) -{ -int i; -double m; -m=0; -for(i=0;i<l;i++) -{ - m+=a[i]; -} -m=m/l; -return m; -} - - -double stdev(double *a,int l,double m) -{ -int i; -double sqsum=0.0; - -for(i=0;i<l;i++) -{ - sqsum+=(a[i]-m)*(a[i]-m); - -} - -return sqrt(sqsum/(l-1)); -} - - -main(int argc, char *argv[]) -{ - FILE * pFile,*banf,*whitef; - int i,s_i,j,k,l,m,id,ic,c,row,imatch,flag,bit,bit_count,ccount,maxccount; - int n = 0,ban_flag,white_flag,white_flag_all; - char line[2500],nf[250],nt[250],*file_name; - char **name; //name of variables - double tc,tcm,score_val; - struct nd network; - int MAX_PARENT; - FILE **inputFiles; - - - double min_score; - - - if(argc<=5) - { - printf("Use 5 arguments: 1. input data file name. 2. ban list file name. 3. white list file name. 4. integer value of the maximum number of parents are allowed and 5. output file directory\n"); - return; - } - - - - pFile=fopen (argv[1],"r"); - - - if (pFile==NULL) perror ("Error opening file"); - else - {//reading data from input file - - - row=0; - do{ row++; - } while (fgets (line,2500,pFile)!=NULL); - - row-=3; - network.row=row; - fclose(pFile); - pFile=fopen (argv[1],"r"); - ccount=0; - maxccount=0; - do { - c = fgetc (pFile); - if (c == '\t') - { - n++; - if(maxccount<ccount) - maxccount=ccount; - ccount=0; - } - else - ccount++; - - - } while (c != '\n'); - - - network.num=n+1; - network.discrete=(int *)malloc(sizeof(int)*network.num); - network.continuous=(int *)malloc(sizeof(int)*network.num); - network.node=(struct ndata *)malloc(sizeof(struct ndata)*network.num); - - MAX_PARENT=atoi(argv[4]); //maximum number of parents for each node - if(MAX_PARENT==0) //no restriction on parents - MAX_PARENT=network.num+1; - - name=(char **)malloc(sizeof(char *)*network.num); - - for(i=0;i<network.num;i++) - name[i]=(char *)malloc(sizeof(char)*(maxccount+1)); - - - - id=0; - ic=0; - for(i=0;i<=n;i++) - { - fscanf(pFile,"%d",&c); - network.node[i].idx=i; - network.node[i].type=c; - if(c==1) - { - network.continuous[ic]=i; - ic++; - network.node[i].prob=(double *)malloc(sizeof(double)*2); //probability array of size 2 for continuous node - network.node[i].prob[0]=0.0; //initialization - network.node[i].prob[1]=0.0; - network.node[i].cdata=(double *)malloc(sizeof(double)*row); //data matrix for continuous node - } - else - { - network.discrete[id]=i; - network.node[i].post_alpha=(double *)calloc(network.node[i].type,sizeof(double)); //prepare total count of each discrete data lebel initialize with zero by calloc which is used in learnnode - id++; - network.node[i].prob=(double *)malloc(sizeof(double)*c); //probability array of size equals to number of levels for discrete node - network.node[i].ddata=(char **)malloc(sizeof(char *)*row); //data matrix for continuous node - network.node[i].label=(char **)malloc(sizeof(char *)*c); //label array - for(j=0;j<c;j++) - network.node[i].prob[j]=1.0/c; - } - } - network.nd=id; network.nc=ic; - j=0; - - do{ //calculate average and prob for each node - for(i=0;i<=n;i++) //n is nimber of column in the data matrix - { - if(network.node[i].type==1) //if continuous - { - fscanf(pFile,"%s",line); - tc=run_strtof(line); - //network.node[i].prob[1]+=tc; //summation for average - network.node[i].cdata[j]=tc; // data values in data column vector - } - else //discrete - { - fscanf(pFile,"%s",line); - network.node[i].ddata[j]=(char *)malloc(sizeof(char)*strlen(line)); - if(j==0) //first iteration of do while - { - network.node[i].lindex=0; - network.node[i].label[0]=(char *)malloc(sizeof(char)*strlen(line)); - strcpy(network.node[i].label[0],line); //new label assigned to label list - network.node[i].post_alpha[0]=1; - - } - else //store different label for discrete node also count number of ocarance of each label for calculation of post alpha score - { - imatch=0; - for(k=0;k<=network.node[i].lindex;k++) - { - if(strcmp(network.node[i].label[k],line)==0) - { - imatch=1; - network.node[i].post_alpha[k]+=1; - break; - } - } - if(imatch==0) - { - network.node[i].lindex++; - k=network.node[i].lindex; - network.node[i].label[k]=(char *)malloc(sizeof(char)*strlen(line)); - strcpy(network.node[i].label[k],line); //new label assigned to label list - network.node[i].post_alpha[k]+=1; - } - } - strcpy(network.node[i].ddata[j],line); - } - - } - j++; - } while (fgets (line,250,pFile)!=NULL); //end of do while to read the input file - - //////////////normalize continuous data///////////// - for(i=0;i<=n;i++) - { - if(network.node[i].type==1) - { - - tcm=mean(network.node[i].cdata,row); - tc=stdev(network.node[i].cdata,row,tcm); - for(j=0;j<row;j++) - { - network.node[i].cdata[j]=standarizedata(network.node[i].cdata[j],tcm,tc); //dataval.data mean, standard deviation - } - } - } - - //////////////////adjust average and prob for normalized data - for(i=0;i<=n;i++) - { - if(network.node[i].type==1) //claculate average and prob for continuous nodes - { - network.node[i].prob[1]=mean(network.node[i].cdata,row); - - for(j=0;j<row;j++) - { - network.node[i].prob[0]+=(network.node[i].cdata[j]-network.node[i].prob[1])*(network.node[i].cdata[j]-network.node[i].prob[1]); - } - network.node[i].prob[0]*=1.0/(double)(row-1); - network.node[i].prob[0]*=(double)(row-1.0)/(double)row; - - } - } - - fclose (pFile); - }//end of else part for open input file - - pFile=fopen (argv[1],"r"); - - for(i=0;i<network.num;i++) - fscanf(pFile,"%s",name[i]); - - fclose(pFile); - - learn_node(&network); //call function to learn network and get local score whell 0 parent for all nodes - - - - //printf("%.2lf\n",learn_parent(&network,6,176)); - // printf("%.2lf\n",learn_parent(&network,6,47)); - // printf("%.2lf\n",learn_parent(&network,6,18)); - //printf("%.2lf\n",learn_parent(&network,7,80)); - ////////printing trylist to a file//////////////////////////////// - - //fprintf(outfile,"Number of nodes\n%d\n",network.num); - //fprintf(outfile,"Possible sets of parents per node\n"); - j=(int)pow(2.0,network.nd-1); //possible number of parents for discrete node - k=(int)pow(2.0,network.num-1); //possible number of parents for continuous nodes - - - for(i=0;i<network.num;i++) - { - network.node[i].score=(double *)malloc(sizeof(double)*(k+1)); - network.node[i].score_i=0; - - - network.node[i].wlist.n=0; - network.node[i].blist.n=0; - network.node[i].blist.list=(int *)malloc(sizeof(int)*network.num); - network.node[i].wlist.list=(int *)malloc(sizeof(int)*network.num); - // if(network.node[i].type>1) //discrete - // fprintf(outfile,"%d\t",j); - //else //continuous - // fprintf(outfile,"%d\t",k); - } - - banf=fopen (argv[2],"r"); //ban list file name - whitef=fopen (argv[3],"r"); //white list file name - - //read banlist -// fgets (line,2500,banf); //header - - -strcpy(nf,""); -strcpy(nt,""); - -while (fgets (line,2500,banf)!=NULL){ - - fscanf(banf,"%s",nf); //node from - fscanf(banf,"%s",nt); //node to - - for(i=0;i<network.num;i++) - { - if(strcmp(name[i],nt)==0) - { - j=network.node[i].blist.n; - for(l=0;l<network.num;l++) - { - if(strcmp(name[l],nf)==0) - { - ban_flag=0; - for(k=0;k<network.node[i].blist.n;k++) - { - if(network.node[i].blist.list[k]==l) - { - ban_flag=1; - break; - } - } - if(ban_flag==0) - { - network.node[i].blist.list[j]=l; - j++; - network.node[i].blist.n=j; - } - - } - } - } - } - -} - - - -//read whitelist -//fgets (line,2500,whitef); //header - -strcpy(nf,""); -strcpy(nt,""); - -while (fgets (line,2500,whitef)!=NULL){ - -fscanf(whitef,"%s",nf); //node from -fscanf(whitef,"%s",nt); //node to - -for(i=0;i<network.num;i++) - { - if(strcmp(name[i],nt)==0) - { - j=network.node[i].wlist.n; - for(l=0;l<network.num;l++) - { - if(strcmp(name[l],nf)==0) - { - white_flag=0; - for(k=0;k<network.node[i].wlist.n;k++) - { - if(network.node[i].wlist.list[k]==l) - { - white_flag=1; - break; - } - } - if(white_flag==0) - { - - network.node[i].wlist.list[j]=l; - j++; - network.node[i].wlist.n=j; - } - - } - } - } - } - -} - - //fprintf(outfile,"\nChild Parents Score\n"); - - m=(int)pow(2.0,network.num)-1; //number of combinations of parents - min_score=1.0; - for(i=0;i<network.num;i++) - { - - if(network.node[i].wlist.n==0) - { - network.node[i].score[0]=network.node[i].score_zeroparent; - if(min_score>network.node[i].score_zeroparent) - min_score=network.node[i].score_zeroparent; - - //fprintf(outfile,"%d\t0\t%lf\n",i+1,network.node[i].score_zeroparent); //printing score for zero parent - } - else - { - network.node[i].score[0]=1.0; - //fprintf(outfile,"%d\t0\t0.0\n",i+1); - - } - network.node[i].score_i=1; - - - for(j=0;j<m;j++) - { - - ban_flag=0; - - bit= (j+1 >> i) & 1; - - if(bit!=1) //check if the child itself is present in parent list - { - - bit_count=0; - //fprintf(outfile,"%d\t",i+1); - for(l=0;l<network.num;l++) - { - bit= (j+1 >> l) & 1; - if(bit==1) - { - //fprintf(outfile,"%d",l+1); - bit_count++; - - } - - } - - - if(network.node[i].type>1) //if discrete node checck if any continuous node is included in the parent list - { - flag=0; - ban_flag=0; - for(l=0;l<network.num;l++) - { - bit= (j+1 >> l) & 1; - - if(bit==1 && network.node[l].type==1) //check if continuous is parent of discrete - { - flag=1; - break; - } - if(bit==1) - { - for(k=0;k<network.node[i].blist.n;k++) - { - if(network.node[i].blist.list[k]==l) - { - ban_flag=1; - break; - } - } - - - if(ban_flag==1) - break; - } - - - - } - if(flag==0) //if no continuous parent for discrete node then learn the network with the list of parents - { - - if(bit_count>MAX_PARENT) - { - //fprintf(outfile,"\t0.0\n"); - - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - - - - } - else if(ban_flag==1) - { - //fprintf(outfile,"\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - } - else // calculate score if white list check get satisfied - { - if(network.node[i].wlist.n==0) - { - score_val=learn_parent(&network,i,j); - - if(min_score>score_val) - min_score=score_val; - - - - //fprintf(outfile,"\t%lf\n",score_val); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=score_val; - network.node[i].score_i=s_i+1; - } - else if(bit_count<network.node[i].wlist.n) //white list is greater than list of parents - { - //fprintf(outfile,"\tfor white\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - } - else - { - white_flag=0; - white_flag_all=0; - - for(l=0;l<network.num;l++) - { - bit= (j+1 >> l) & 1; - - if(bit==1) - { - for(k=0;k<network.node[i].wlist.n;k++) - { - if(network.node[i].wlist.list[k]==l) - { - white_flag++; - //changed from white_flag=1; - break; - } - } - if(white_flag>=network.node[i].wlist.n) - { //!=1 - white_flag_all=1; - break; - - } - - } - } - if(white_flag_all==1) - { - score_val=learn_parent(&network,i,j); - if(min_score>score_val) - min_score=score_val; - - //fprintf(outfile,"\t%lf\n",score_val); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=score_val; - network.node[i].score_i=s_i+1; - } - else - { - //fprintf(outfile,"\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - } - - } - } - - } - else //fill up data when continuous is parent of discrete - { - //fprintf(outfile,"\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - - } - } - else //if continuous node then learn the network with the parent set - { - - ban_flag=0; - - - for(l=0;l<network.num;l++) - { - bit= (j+1 >> l) & 1; - if(bit==1) - { - - for(k=0;k<network.node[i].blist.n;k++) - { - if(network.node[i].blist.list[k]==l) - { - ban_flag=1; - break; - } - } - if(ban_flag==1) - break; - } - - - } - if(bit_count>MAX_PARENT) - { - //fprintf(outfile,"\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - } - else if(ban_flag==1) - { - //fprintf(outfile,"\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - } - else - { - if(network.node[i].wlist.n==0) - { - score_val=learn_parent(&network,i,j); - if(min_score>score_val) - min_score=score_val; - - //fprintf(outfile,"\t%lf\n",score_val); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=score_val; - network.node[i].score_i=s_i+1; - } - else if(bit_count<network.node[i].wlist.n) //white list is greater than list of parents - { - //fprintf(outfile,"\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - } - else - { - white_flag=0; - white_flag_all=0; - - for(l=0;l<network.num;l++) - { - bit= (j+1 >> l) & 1; - - if(bit==1) - { - for(k=0;k<network.node[i].wlist.n;k++) - { - if(network.node[i].wlist.list[k]==l) - { - white_flag++; - break; - } - } - if(white_flag>=network.node[i].wlist.n) - { //!=1 - white_flag_all=1; - break; - - } - - } - } - if(white_flag_all==1) - { - score_val=learn_parent(&network,i,j); - if(min_score>score_val) - min_score=score_val; - - //fprintf(outfile,"\t%lf\n",score_val); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=score_val; - network.node[i].score_i=s_i+1; - } - else - { - // fprintf(outfile,"\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - } - - } - } - - - } - - - } - } - } - - -//print scores to separate files - -min_score*=10; -inputFiles= (FILE **) malloc(network.num * sizeof(FILE*)); - -printf("%s\n",argv[5]); - -for(i=0;i<network.num;i++) -{ - strcpy(line,argv[5]); - sprintf(line+10,"/%d",i); //sprintf(line+52,"%d",i); - - // strcat(line,".txt"); - - inputFiles[i] = fopen(line, "wb"); - - //print content - for(j=0;j<network.node[i].score_i;j++) - { - if(network.node[i].score[j]<1.0) - fwrite(&network.node[i].score[j],sizeof(double),1,inputFiles[i]); -// fprintf(inputFiles[i],"%lf\n",network.node[i].score[j]); - else - fwrite(&min_score,sizeof(double),1,inputFiles[i]); -//fprintf(inputFiles[i],"%lf\n",min_score); - } - - fclose(inputFiles[i]); -} - - - - - - -fclose(banf); -fclose(whitef); - - -// printf("Time elapsed: %f\n", ((double)clock() - start) / CLOCKS_PER_SEC); - -} - - -/* learn the network for zero parent */ - -void learn_node(struct nd *net) -{ - int i,j,k,nk,l,m,i1,j1; - long num,temp; - double n,N,s2; - struct nd network=*net; //create a local copy - double *alpha,nu,rho,mu,phi,tau; - double post_nu,post_rho,post_mu,post_phi,post_tau; - double loglik,post_loglik; - - num=network.num; - - nk=1; - - for(i=0;i<num;i++) - { - if(network.node[i].type>1) - nk*=network.node[i].type; - } - - - - - for(i=0;i<num;i++) - { - if(network.node[i].type>1) - { - - alpha=(double *)malloc(sizeof(double)*network.node[i].type); - k=1; - - for(j=0;j<num;j++) - { - if(i!=j && network.node[j].type>1) - k*=network.node[j].type; - - } - N=0.0; n=0.0; - for(j=0;j<network.node[i].type;j++) - { - alpha[j]=2.0*k; - network.node[i].post_alpha[j]+=alpha[j]; - ////////update loglik from udisclik - n+=alpha[j]; - N+=network.node[i].post_alpha[j]; - } - - - loglik=0.0; - post_loglik=0.0; - - for(j=0;j<network.node[i].type;j++) - post_loglik+=lgammafn(network.node[i].post_alpha[j])-lgammafn(alpha[j]); - - post_loglik+=lgammafn(n); - post_loglik-=lgammafn(N); - - - } - else - { - nu=nk*2.0; - tau=nu; - rho=nk*2.0; - mu=network.node[i].prob[1]; - phi=network.node[i].prob[0]*nk; - loglik=0.0; - post_mu=mu; - post_tau=tau; - post_rho=rho; - post_phi=phi; - post_loglik=loglik; - - postc0(&post_mu,&post_tau,&post_rho,&post_phi,&post_loglik,network.node[i].cdata,&network.row); - - - } - network.node[i].score_zeroparent=post_loglik; // store the zero parent score - - } - - if(nk!=1) - free(alpha); - - *net=network; //coppied back to original -} - - -/* -learn node for a list of parents -*/ - -double learn_parent(struct nd *net,int child,int p) -{ - int i,j,jj,k,nk,l,m,i1,j1,k1,k2,cn_send; - long num,temp; - double n,N,s2; - struct nd network=*net; //create a local copy - int cn,ds,bit,*discrete,*continuous; - double alpha,*postalpha,alpha_parent,*postalpha_parent,nu,rho,mu,phi,tau; - double post_nu,post_rho,*post_mu,post_phi,post_tau; - double loglik,post_loglik=0,post_loglik_parent=0; - double *mu_mat,**tau_mat,tau11,tau12,tau22,div,phiinv; - char **label; - int *a,*l_list,flag,y_count,z_count; - double *y,mu_p,phi_p,*tau_send,*z_send,loglik_sum; - - - - num=network.num; - - continuous=(int *)malloc(sizeof(int)*network.nc); - discrete=(int *)malloc(sizeof(int)*network.nd); - - nk=1; - for(i=0;i<num;i++) - { - if(network.node[i].type>1) - nk*=network.node[i].type; - } - -//list of discrete snd continuous parents - cn=0; - ds=0; - alpha_parent=0; - alpha=2; - - k1=network.node[child].type; - k2=1; - - //printf("%d\n",child); - for(j=0;j<network.num;j++) //list the continuous parents and discrete parents - { - bit= (p+1 >> j) & 1; - - - if(bit==1 && j!=child) - { - - if(network.node[j].type>1) - { - discrete[ds]=j; - //printf("discrete parent=%d\n",j); - k1*=network.node[j].type; - k2*=network.node[j].type; - ds++; - } - else - { - continuous[cn]=j; - //printf("continuous parent=%d\n",j); - cn++; - } - } - else if(j!=child) - { - alpha*=network.node[j].type; - } - } - - if(network.nd<=2) - alpha=2; - - i=child; //i is the node with changes in its parrent nodes - - if(network.node[i].type>1 && cn==0) // no continuous node //prepare alpha and post alpha and then calculate local score - { - - k=k1; - postalpha=(double *)calloc(network.node[i].type,sizeof(double)); - - label=(char **)malloc(sizeof(char *)*(ds+1)); //label array - a=(int *)calloc((ds+1),sizeof(int)); - l_list=(int *)malloc(sizeof(int)*(ds+1)); - - for(j=0;j<=ds;j++) - label[j]=(char *)malloc(sizeof(char)*100); - - for(j=0;j<ds;j++) - { - l=discrete[j]; - l_list[j]=network.node[l].type; - - } - l_list[ds]=network.node[i].type; - - for(j=0;j<k;j++) - { - - get_next_seq(a,l_list,ds+1); // prepare a new combination of labels for parent - for(i1=0;i1<ds;i1++) - { - j1=a[i1]; - l=discrete[i1]; - strcpy(label[i1],network.node[l].label[j1]); - } - - j1=a[i1]; - strcpy(label[i1],network.node[child].label[j1]); - for(i1=0;i1<network.node[i].type;i1++) - postalpha[i1]=0; - for(i1=0;i1<network.row;i1++) // search through parents data and count how many number of matches for current label list. prepare post alpha from count+alpha - { - flag=0; - for(m=0;m<ds;m++) - { - j1=a[m]; - l=discrete[m]; - if(strcmp(label[m],network.node[l].ddata[i1])!=0) - { - flag=1; - } - } - j1=a[m]; - if(strcmp(label[m],network.node[child].ddata[i1])!=0) - { - flag=1; - } - if(flag==0) - { - j1=a[ds]; - postalpha[j1]+=1; - - } - } - for(m=0;m<network.node[i].type;m++) - { - if(postalpha[m]!=0) - { - postalpha[m]+=alpha; - post_loglik+=lgammafn(postalpha[m])-lgammafn(alpha); - } - } - } - - - k=k2; // repeat the last step of preparing alpha and post alpha for only parent set. this time exclude the child node label from computation. prepare alpha_parent and post_alphaparent - l=discrete[ds-1]; - postalpha_parent=(double *)calloc(network.node[l].type,sizeof(double)); - - for(j=0;j<ds;j++) - { - l=discrete[j]; - l_list[j]=network.node[l].type; - a[j]=0; - - } - for(j=0;j<k1/k2;j++) - alpha_parent+=alpha; - for(j=0;j<k;j++) - { - get_next_seq(a,l_list,ds); - - for(i1=0;i1<ds;i1++) - { - j1=a[i1]; - l=discrete[i1]; - strcpy(label[i1],network.node[l].label[j1]); - - } - - l=discrete[ds-1]; - for(i1=0;i1<network.node[l].type;i1++) - postalpha_parent[i1]=0; - - for(i1=0;i1<network.row;i1++) - { - flag=0; - for(m=0;m<ds;m++) - { - j1=a[m]; - l=discrete[m]; - if(strcmp(label[m],network.node[l].ddata[i1])!=0) - { - flag=1; - } - } - - if(flag==0) - { - j1=a[ds-1]; - postalpha_parent[j1]+=1; - - } - } - l=discrete[ds-1]; - for(m=0;m<network.node[l].type;m++) - { - if(postalpha_parent[m]!=0) - { - postalpha_parent[m]+=alpha_parent; - post_loglik_parent+=lgammafn(postalpha_parent[m])-lgammafn(alpha_parent); - } - } - } - - - loglik=post_loglik-post_loglik_parent; - free(postalpha); - free(postalpha_parent); - for(j=0;j<=ds;j++) - free(label[j]); - free(label); - free(a); - free(l_list); - - } - else if(network.node[i].type==1 && ds==0) // no discrete node //prepare continuous parameter set - { - z_count=0; - tau_mat=(double **)malloc(sizeof(double *)*(cn+1)); - - z_send=(double *)malloc(sizeof(double)*(cn+1)*network.row); - tau_send=(double *)malloc(sizeof(double)*(cn+1)*(cn+1)); - - mu_mat=(double *)malloc(sizeof(double)*(cn+1)); - nu=nk*2.0; rho=nk*2.0+cn; - mu_mat[0]=network.node[i].prob[1]; - for(j=0;j<cn;j++) - { - mu_mat[j+1]=0; - tau_mat[j]=(double *)malloc(sizeof(double)*(cn+1)); - - } - - tau_mat[j]=(double *)malloc(sizeof(double)*(cn+1)); - - for(j=0;j<network.row;j++) - { - z_send[z_count]=1; - z_count++; - for(j1=0;j1<cn;j1++) - { - l=continuous[j1]; - z_send[z_count]=network.node[l].cdata[j]; - z_count++; - } - - } - - phi=network.node[i].prob[0]*nk; - - //preparing tau - - //**tau_mat - for(j=0;j<=cn;j++) - for(m=0;m<=cn;m++) - { - tau_mat[j][m]=1.0; - } - - for(j=0;j<cn;j++) - { - l=continuous[j]; - mu_p=network.node[l].prob[1]; - phi_p=network.node[l].prob[0]*nk; - phiinv=1/phi_p; - tau11 = 1/nu + mu_p*phiinv*mu_p; - tau22 = phiinv; - tau12 = -mu_p*phiinv; - div=tau11*tau22-tau12*tau12; - if(j==0) - tau_mat[0][0]=tau22/div; - tau_mat[0][j+1]=-tau12/div; - tau_mat[j+1][0]=tau_mat[0][j+1]; - tau_mat[j+1][j+1]=tau11/div; - } - - for(j=0;j<=cn;j++) - for(m=0;m<=cn;m++) - { - if(tau_mat[j][m]==1.0) - { - tau_mat[j][m]=tau_mat[0][j]*(tau_mat[0][m]/tau_mat[0][0]); - - } - j1=j*(cn+1)+m; - tau_send[j1]=tau_mat[j][m]; - - } - - loglik=0.0; - - cn_send=cn+1; - - postc(mu_mat,tau_send,&rho,&phi,&loglik,network.node[i].cdata,z_send,&network.row,&cn_send); - - - free(z_send); - free(tau_send); - for(j=0;j<=cn;j++) - free(tau_mat[j]); - free(tau_mat); - free(mu_mat); - - } - else //hybrid cases - { - if(cn==0) //if parents are all discrete and child is continuous - { - - ///////////////////prepare y array and run c code//////////////////////////////// - loglik_sum=0; - k=k2; - y=(double *)calloc(network.row,sizeof(double)); - label=(char **)malloc(sizeof(char *)*(ds)); //label array - a=(int *)calloc((ds+1),sizeof(int)); - l_list=(int *)malloc(sizeof(int)*(ds)); - - for(j=0;j<ds;j++) - label[j]=(char *)malloc(sizeof(char)*100); - - for(j=0;j<ds;j++) - { - l=discrete[j]; - l_list[j]=network.node[l].type; - - } - - - for(j=0;j<k;j++) - { - - nu=(nk*2.0)/k2; - tau=nu; - rho=nu; - mu=network.node[i].prob[1]; - phi=network.node[i].prob[0]*nu/2; - loglik=0.0; - - get_next_seq(a,l_list,ds); // prepare a new combination of labels for parent - for(i1=0;i1<ds;i1++) - { - j1=a[i1]; - l=discrete[i1]; - strcpy(label[i1],network.node[l].label[j1]); - } - y_count=0; - for(i1=0;i1<network.row;i1++) // search through parents data and count how many number of matches for current label list. prepare post alpha from count+alpha - { - flag=0; - for(m=0;m<ds;m++) - { - - l=discrete[m]; - if(strcmp(label[m],network.node[l].ddata[i1])!=0) - { - flag=1; - } - } - - if(flag==0) - { - y[y_count]=network.node[i].cdata[i1]; - y_count++; - - } - } - - postc0(&mu,&tau,&rho,&phi,&loglik,y,&y_count); - loglik_sum+=loglik; - - - } - - loglik=loglik_sum; - - free(y); - for(j=0;j<ds;j++) - free(label[j]); - free(label); - free(a); - free(l_list); - - - }//end of continuous node discrete parent check - else //all the other hybrid cases when parents are both continuous and discrete - { - - - tau_mat=(double **)malloc(sizeof(double *)*(cn+1)); - z_send=(double *)malloc(sizeof(double)*(cn+1)*network.row); - tau_send=(double *)malloc(sizeof(double)*(cn+1)*(cn+1)); - mu_mat=(double *)malloc(sizeof(double)*(cn+1)); - - for(j=0;j<cn;j++) - { - tau_mat[j]=(double *)malloc(sizeof(double)*(cn+1)); - } - - - tau_mat[j]=(double *)malloc(sizeof(double)*(cn+1)); - - ///////////////////prepare parameters and run c code//////////////////////////////// - loglik_sum=0.0; - k=k2; - y=(double *)calloc(network.row,sizeof(double)); - label=(char **)malloc(sizeof(char *)*(ds)); //label array - a=(int *)calloc((ds+1),sizeof(int)); - l_list=(int *)malloc(sizeof(int)*(ds)); - - for(j=0;j<ds;j++) - label[j]=(char *)malloc(sizeof(char)*100); - - for(j=0;j<ds;j++) - { - l=discrete[j]; - l_list[j]=network.node[l].type; - - } - - - for(jj=0;jj<k;jj++) - { - - nu=(nk*2.0)/k2; - rho=nu+cn; - mu_mat[0]=network.node[i].prob[1]; - - for(j1=0;j1<cn;j1++) - mu_mat[j1+1]=0; - - phi=network.node[i].prob[0]*nu/2; - //preparing tau - //**tau_mat - for(j=0;j<=cn;j++) - for(m=0;m<=cn;m++) - { - tau_mat[j][m]=1.0; - } - - for(j=0;j<cn;j++) - { - l=continuous[j]; - mu_p=network.node[l].prob[1]; - phi_p=network.node[l].prob[0]*(nk/k2); - - phiinv=1/phi_p; - tau11 = 1/nu + mu_p*phiinv*mu_p; - tau22 = phiinv; - tau12 = -mu_p*phiinv; - div=tau11*tau22-tau12*tau12; - if(j==0) - tau_mat[0][0]=tau22/div; - - tau_mat[0][j+1]=-tau12/div; - tau_mat[j+1][0]=tau_mat[0][j+1]; - tau_mat[j+1][j+1]=tau11/div; - - - } - for(j=0;j<=cn;j++) - for(m=0;m<=cn;m++) - { - if(tau_mat[j][m]==1.0) - { - tau_mat[j][m]=tau_mat[0][j]*(tau_mat[0][m]/tau_mat[0][0]); - } - - j1=j*(cn+1)+m; - tau_send[j1]=tau_mat[j][m]; - - //printf("%.2lf\t",tau_mat[j][m]); - } - //printf("\n"); - loglik=0.0; - - - cn_send=cn+1; - - - get_next_seq(a,l_list,ds); // prepare a new combination of labels for parent - for(i1=0;i1<ds;i1++) - { - j1=a[i1]; - l=discrete[i1]; - strcpy(label[i1],network.node[l].label[j1]); - } - y_count=0; - z_count=0; - for(i1=0;i1<network.row;i1++) // search through parents data and count how many number of matches for current label list. prepare post alpha from count+alpha - { - flag=0; - for(m=0;m<ds;m++) - { - - l=discrete[m]; - if(strcmp(label[m],network.node[l].ddata[i1])!=0) - { - flag=1; - } - } - - if(flag==0) - { - y[y_count]=network.node[i].cdata[i1]; - - //prepare z send matrix - z_send[z_count]=1; - z_count++; - for(j1=0;j1<cn;j1++) - { - l=continuous[j1]; - z_send[z_count]=network.node[l].cdata[i1]; - z_count++; - } - y_count++; - } - } - - postc(mu_mat,tau_send,&rho,&phi,&loglik,y,z_send,&y_count,&cn_send); - - loglik_sum+=loglik; - - - } - - loglik=loglik_sum; - - free(y); - //free(z); - free(z_send); - free(tau_send); - for(j=0;j<=cn;j++) - free(tau_mat[j]); - free(tau_mat); - free(mu_mat); - for(j=0;j<ds;j++) - free(label[j]); - free(label); - free(a); - free(l_list); - - }//end of else part for hybrid when parents are mixed - - }//end of else part for hybrid - - free(continuous); - free(discrete); - return loglik; - - -} - -void get_next_seq(int *a,int *l,int size) -{ - int j,idx; - idx=size-1; - a[idx]+=1; - if(a[idx]==l[idx]) - { - a[idx]=0; - for(j=idx-1;j>=0;j--){ - a[j]+=1; - if(a[j]==l[j]) - a[j]=0; - else - break; - } - } -} - - diff --git a/sourcecodes/localscore/network_score_old.c b/sourcecodes/localscore/network_score_old.c deleted file mode 100644 index b1ca59a9..00000000 --- a/sourcecodes/localscore/network_score_old.c +++ /dev/null @@ -1,1438 +0,0 @@ -#include<stdio.h> -#include <stdlib.h> -#include<string.h> -#define MATHLIB_STANDALONE 1 -#include "matrix.h" -#include "postc0.c" -#include "modified_postc.c" // only line that has been changed in this code -//#define OUT_DIR "./Result/" //WHERE BENE READ DATA FOR STRUCTURE LEARNING //change it to #define OUT_DIR "/var/www/html/compbio/BNW/bene-0.9-4/example/resdir/" for server. Also change from sprintf(line+9,"%d",i); to sprintf(line+52,"%d",i); - -struct white{ -int n; -int *list; -}; - -struct ban{ -int n; -int *list; -}; - -struct ndata{ -int idx,type,score_i; -char **ddata; -char **label; //for descrete node -int lindex; -double *prob,*cdata,*post_alpha; -double score_zeroparent; -double *score; -struct white wlist; -struct ban blist; -}; - - -struct nd{ -int num,nd,*discrete,nc,*continuous,row; -double score; -struct ndata *node; -}; - -void get_next_seq(int *,int *,int); -void learn_node(struct nd *); -double learn_parent(struct nd *,int,int); - -double run_strtof (const char * input) //Convert string to double -{ - double output; - char * end; - output = strtod (input, & end); - if (end == input) { - return 0.0; - } - else { - return output; - } -} - - -char* itoa(int val, int base){ //convert number to string - - static char buf[32] = {0}; - - int i = 30; - - for(; val && i ; --i, val /= base) - - buf[i] = "0123456789abcdef"[val % base]; - - return &buf[i+1]; - -} - -double standarizedata(double val,double mean,double std) -{ - return (val-mean)/std; - -} - -double mean(double *a,int l) -{ -int i; -double m; -m=0; -for(i=0;i<l;i++) -{ - m+=a[i]; -} -m=m/l; -return m; -} - - -double stdev(double *a,int l,double m) -{ -int i; -double sqsum=0.0; - -for(i=0;i<l;i++) -{ - sqsum+=(a[i]-m)*(a[i]-m); - -} - -return sqrt(sqsum/(l-1)); -} - - -main(int argc, char *argv[]) -{ - FILE * pFile,*banf,*whitef; - int i,s_i,j,k,l,m,id,ic,c,row,imatch,flag,bit,bit_count,ccount,maxccount; - int n = 0,ban_flag,white_flag,white_flag_all; - char line[2500],nf[250],nt[250],*file_name; - char **name; //name of variables - double tc,tcm,score_val; - struct nd network; - int MAX_PARENT; - FILE **inputFiles; - - - double min_score; - - - if(argc<=5) - { - printf("Use 5 arguments: 1. input data file name. 2. ban list file name. 3. white list file name. 4. integer value of the maximum number of parents are allowed and 5. output file directory\n"); - return; - } - - - - pFile=fopen (argv[1],"r"); - - - if (pFile==NULL) perror ("Error opening file"); - else - {//reading data from input file - - - row=0; - do{ row++; - } while (fgets (line,2500,pFile)!=NULL); - - row-=3; - network.row=row; - fclose(pFile); - pFile=fopen (argv[1],"r"); - ccount=0; - maxccount=0; - do { - c = fgetc (pFile); - if (c == '\t') - { - n++; - if(maxccount<ccount) - maxccount=ccount; - ccount=0; - } - else - ccount++; - - - } while (c != '\n'); - - - network.num=n+1; - network.discrete=(int *)malloc(sizeof(int)*network.num); - network.continuous=(int *)malloc(sizeof(int)*network.num); - network.node=(struct ndata *)malloc(sizeof(struct ndata)*network.num); - - MAX_PARENT=atoi(argv[4]); //maximum number of parents for each node - if(MAX_PARENT==0) //no restriction on parents - MAX_PARENT=network.num+1; - - name=(char **)malloc(sizeof(char *)*network.num); - - for(i=0;i<network.num;i++) - name[i]=(char *)malloc(sizeof(char)*(maxccount+1)); - - - - id=0; - ic=0; - for(i=0;i<=n;i++) - { - fscanf(pFile,"%d",&c); - network.node[i].idx=i; - network.node[i].type=c; - if(c==1) - { - network.continuous[ic]=i; - ic++; - network.node[i].prob=(double *)malloc(sizeof(double)*2); //probability array of size 2 for continuous node - network.node[i].prob[0]=0.0; //initialization - network.node[i].prob[1]=0.0; - network.node[i].cdata=(double *)malloc(sizeof(double)*row); //data matrix for continuous node - } - else - { - network.discrete[id]=i; - network.node[i].post_alpha=(double *)calloc(network.node[i].type,sizeof(double)); //prepare total count of each discrete data lebel initialize with zero by calloc which is used in learnnode - id++; - network.node[i].prob=(double *)malloc(sizeof(double)*c); //probability array of size equals to number of levels for discrete node - network.node[i].ddata=(char **)malloc(sizeof(char *)*row); //data matrix for continuous node - network.node[i].label=(char **)malloc(sizeof(char *)*c); //label array - for(j=0;j<c;j++) - network.node[i].prob[j]=1.0/c; - } - } - network.nd=id; network.nc=ic; - j=0; - - do{ //calculate average and prob for each node - for(i=0;i<=n;i++) //n is nimber of column in the data matrix - { - if(network.node[i].type==1) //if continuous - { - fscanf(pFile,"%s",line); - tc=run_strtof(line); - //network.node[i].prob[1]+=tc; //summation for average - network.node[i].cdata[j]=tc; // data values in data column vector - } - else //discrete - { - fscanf(pFile,"%s",line); - network.node[i].ddata[j]=(char *)malloc(sizeof(char)*strlen(line)); - if(j==0) //first iteration of do while - { - network.node[i].lindex=0; - network.node[i].label[0]=(char *)malloc(sizeof(char)*strlen(line)); - strcpy(network.node[i].label[0],line); //new label assigned to label list - network.node[i].post_alpha[0]=1; - - } - else //store different label for discrete node also count number of ocarance of each label for calculation of post alpha score - { - imatch=0; - for(k=0;k<=network.node[i].lindex;k++) - { - if(strcmp(network.node[i].label[k],line)==0) - { - imatch=1; - network.node[i].post_alpha[k]+=1; - break; - } - } - if(imatch==0) - { - network.node[i].lindex++; - k=network.node[i].lindex; - network.node[i].label[k]=(char *)malloc(sizeof(char)*strlen(line)); - strcpy(network.node[i].label[k],line); //new label assigned to label list - network.node[i].post_alpha[k]+=1; - } - } - strcpy(network.node[i].ddata[j],line); - } - - } - j++; - } while (fgets (line,250,pFile)!=NULL); //end of do while to read the input file - - //////////////normalize continuous data///////////// - for(i=0;i<=n;i++) - { - if(network.node[i].type==1) - { - - tcm=mean(network.node[i].cdata,row); - tc=stdev(network.node[i].cdata,row,tcm); - for(j=0;j<row;j++) - { - network.node[i].cdata[j]=standarizedata(network.node[i].cdata[j],tcm,tc); //dataval.data mean, standard deviation - } - } - } - - //////////////////adjust average and prob for normalized data - for(i=0;i<=n;i++) - { - if(network.node[i].type==1) //claculate average and prob for continuous nodes - { - network.node[i].prob[1]=mean(network.node[i].cdata,row); - - for(j=0;j<row;j++) - { - network.node[i].prob[0]+=(network.node[i].cdata[j]-network.node[i].prob[1])*(network.node[i].cdata[j]-network.node[i].prob[1]); - } - network.node[i].prob[0]*=1.0/(double)(row-1); - network.node[i].prob[0]*=(double)(row-1.0)/(double)row; - - } - } - - fclose (pFile); - }//end of else part for open input file - - pFile=fopen (argv[1],"r"); - - for(i=0;i<network.num;i++) - fscanf(pFile,"%s",name[i]); - - fclose(pFile); - - learn_node(&network); //call function to learn network and get local score whell 0 parent for all nodes - - - - //printf("%.2lf\n",learn_parent(&network,6,176)); - // printf("%.2lf\n",learn_parent(&network,6,47)); - // printf("%.2lf\n",learn_parent(&network,6,18)); - //printf("%.2lf\n",learn_parent(&network,7,80)); - ////////printing trylist to a file//////////////////////////////// - - //fprintf(outfile,"Number of nodes\n%d\n",network.num); - //fprintf(outfile,"Possible sets of parents per node\n"); - j=(int)pow(2.0,network.nd-1); //possible number of parents for discrete node - k=(int)pow(2.0,network.num-1); //possible number of parents for continuous nodes - - - for(i=0;i<network.num;i++) - { - network.node[i].score=(double *)malloc(sizeof(double)*(k+1)); - network.node[i].score_i=0; - - - network.node[i].wlist.n=0; - network.node[i].blist.n=0; - network.node[i].blist.list=(int *)malloc(sizeof(int)*network.num); - network.node[i].wlist.list=(int *)malloc(sizeof(int)*network.num); - // if(network.node[i].type>1) //discrete - // fprintf(outfile,"%d\t",j); - //else //continuous - // fprintf(outfile,"%d\t",k); - } - - banf=fopen (argv[2],"r"); //ban list file name - whitef=fopen (argv[3],"r"); //white list file name - - //read banlist -// fgets (line,2500,banf); //header - - -strcpy(nf,""); -strcpy(nt,""); - -while (fgets (line,2500,banf)!=NULL){ - - fscanf(banf,"%s",nf); //node from - fscanf(banf,"%s",nt); //node to - - for(i=0;i<network.num;i++) - { - if(strcmp(name[i],nt)==0) - { - j=network.node[i].blist.n; - for(l=0;l<network.num;l++) - { - if(strcmp(name[l],nf)==0) - { - ban_flag=0; - for(k=0;k<network.node[i].blist.n;k++) - { - if(network.node[i].blist.list[k]==l) - { - ban_flag=1; - break; - } - } - if(ban_flag==0) - { - network.node[i].blist.list[j]=l; - j++; - network.node[i].blist.n=j; - } - - } - } - } - } - -} - - - -//read whitelist -//fgets (line,2500,whitef); //header - -strcpy(nf,""); -strcpy(nt,""); - -while (fgets (line,2500,whitef)!=NULL){ - -fscanf(whitef,"%s",nf); //node from -fscanf(whitef,"%s",nt); //node to - -for(i=0;i<network.num;i++) - { - if(strcmp(name[i],nt)==0) - { - j=network.node[i].wlist.n; - for(l=0;l<network.num;l++) - { - if(strcmp(name[l],nf)==0) - { - white_flag=0; - for(k=0;k<network.node[i].wlist.n;k++) - { - if(network.node[i].wlist.list[k]==l) - { - white_flag=1; - break; - } - } - if(white_flag==0) - { - - network.node[i].wlist.list[j]=l; - j++; - network.node[i].wlist.n=j; - } - - } - } - } - } - -} - - //fprintf(outfile,"\nChild Parents Score\n"); - - m=(int)pow(2.0,network.num)-1; //number of combinations of parents - min_score=1.0; - for(i=0;i<network.num;i++) - { - - if(network.node[i].wlist.n==0) - { - network.node[i].score[0]=network.node[i].score_zeroparent; - if(min_score>network.node[i].score_zeroparent) - min_score=network.node[i].score_zeroparent; - - //fprintf(outfile,"%d\t0\t%lf\n",i+1,network.node[i].score_zeroparent); //printing score for zero parent - } - else - { - network.node[i].score[0]=1.0; - //fprintf(outfile,"%d\t0\t0.0\n",i+1); - - } - network.node[i].score_i=1; - - - for(j=0;j<m;j++) - { - - ban_flag=0; - - bit= (j+1 >> i) & 1; - - if(bit!=1) //check if the child itself is present in parent list - { - - bit_count=0; - //fprintf(outfile,"%d\t",i+1); - for(l=0;l<network.num;l++) - { - bit= (j+1 >> l) & 1; - if(bit==1) - { - //fprintf(outfile,"%d",l+1); - bit_count++; - - } - - } - - - if(network.node[i].type>1) //if discrete node checck if any continuous node is included in the parent list - { - flag=0; - ban_flag=0; - for(l=0;l<network.num;l++) - { - bit= (j+1 >> l) & 1; - - if(bit==1 && network.node[l].type==1) //check if continuous is parent of discrete - { - flag=1; - break; - } - if(bit==1) - { - for(k=0;k<network.node[i].blist.n;k++) - { - if(network.node[i].blist.list[k]==l) - { - ban_flag=1; - break; - } - } - - - if(ban_flag==1) - break; - } - - - - } - if(flag==0) //if no continuous parent for discrete node then learn the network with the list of parents - { - - if(bit_count>MAX_PARENT) - { - //fprintf(outfile,"\t0.0\n"); - - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - - - - } - else if(ban_flag==1) - { - //fprintf(outfile,"\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - } - else // calculate score if white list check get satisfied - { - if(network.node[i].wlist.n==0) - { - score_val=learn_parent(&network,i,j); - - if(min_score>score_val) - min_score=score_val; - - - - //fprintf(outfile,"\t%lf\n",score_val); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=score_val; - network.node[i].score_i=s_i+1; - } - else if(bit_count<network.node[i].wlist.n) //white list is greater than list of parents - { - //fprintf(outfile,"\tfor white\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - } - else - { - white_flag=0; - white_flag_all=0; - - for(l=0;l<network.num;l++) - { - bit= (j+1 >> l) & 1; - - if(bit==1) - { - for(k=0;k<network.node[i].wlist.n;k++) - { - if(network.node[i].wlist.list[k]==l) - { - white_flag=1; - break; - } - } - if(white_flag!=1) - { - white_flag_all=1; - break; - - } - - } - } - if(white_flag_all==0) - { - score_val=learn_parent(&network,i,j); - if(min_score>score_val) - min_score=score_val; - - //fprintf(outfile,"\t%lf\n",score_val); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=score_val; - network.node[i].score_i=s_i+1; - } - else - { - //fprintf(outfile,"\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - } - - } - } - - } - else //fill up data when continuous is parent of discrete - { - //fprintf(outfile,"\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - - } - } - else //if continuous node then learn the network with the parent set - { - - ban_flag=0; - - - for(l=0;l<network.num;l++) - { - bit= (j+1 >> l) & 1; - if(bit==1) - { - - for(k=0;k<network.node[i].blist.n;k++) - { - if(network.node[i].blist.list[k]==l) - { - ban_flag=1; - break; - } - } - if(ban_flag==1) - break; - } - - - } - if(bit_count>MAX_PARENT) - { - //fprintf(outfile,"\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - } - else if(ban_flag==1) - { - //fprintf(outfile,"\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - } - else - { - if(network.node[i].wlist.n==0) - { - score_val=learn_parent(&network,i,j); - if(min_score>score_val) - min_score=score_val; - - //fprintf(outfile,"\t%lf\n",score_val); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=score_val; - network.node[i].score_i=s_i+1; - } - else if(bit_count<network.node[i].wlist.n) //white list is greater than list of parents - { - //fprintf(outfile,"\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - } - else - { - white_flag=0; - white_flag_all=0; - - for(l=0;l<network.num;l++) - { - bit= (j+1 >> l) & 1; - - if(bit==1) - { - for(k=0;k<network.node[i].wlist.n;k++) - { - if(network.node[i].wlist.list[k]==l) - { - white_flag=1; - break; - } - } - if(white_flag!=1) - { - white_flag_all=1; - break; - - } - - } - } - if(white_flag_all==0) - { - score_val=learn_parent(&network,i,j); - if(min_score>score_val) - min_score=score_val; - - //fprintf(outfile,"\t%lf\n",score_val); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=score_val; - network.node[i].score_i=s_i+1; - } - else - { - // fprintf(outfile,"\t0.0\n"); - s_i=network.node[i].score_i; - network.node[i].score[s_i]=1.0; - network.node[i].score_i=s_i+1; - } - - } - } - - - } - - - } - } - } - - -//print scores to separate files - -min_score*=10; -inputFiles= (FILE **) malloc(network.num * sizeof(FILE*)); - -printf("%s\n",argv[5]); - -for(i=0;i<network.num;i++) -{ - strcpy(line,argv[5]); - sprintf(line+10,"/%d",i); //sprintf(line+52,"%d",i); - - // strcat(line,".txt"); - - inputFiles[i] = fopen(line, "wb"); - - //print content - for(j=0;j<network.node[i].score_i;j++) - { - if(network.node[i].score[j]<1.0) - fwrite(&network.node[i].score[j],sizeof(double),1,inputFiles[i]); // fprintf(inputFiles[i],"%lf\n",network.node[i].score[j]); - else - fwrite(&min_score,sizeof(double),1,inputFiles[i]); //fprintf(inputFiles[i],"%lf\n",min_score); - } - - fclose(inputFiles[i]); -} - - - - - - -fclose(banf); -fclose(whitef); - - -// printf("Time elapsed: %f\n", ((double)clock() - start) / CLOCKS_PER_SEC); - -} - - -/* learn the network for zero parent */ - -void learn_node(struct nd *net) -{ - int i,j,k,nk,l,m,i1,j1; - long num,temp; - double n,N,s2; - struct nd network=*net; //create a local copy - double *alpha,nu,rho,mu,phi,tau; - double post_nu,post_rho,post_mu,post_phi,post_tau; - double loglik,post_loglik; - - num=network.num; - - nk=1; - - for(i=0;i<num;i++) - { - if(network.node[i].type>1) - nk*=network.node[i].type; - } - - - - - for(i=0;i<num;i++) - { - if(network.node[i].type>1) - { - - alpha=(double *)malloc(sizeof(double)*network.node[i].type); - k=1; - - for(j=0;j<num;j++) - { - if(i!=j && network.node[j].type>1) - k*=network.node[j].type; - - } - N=0.0; n=0.0; - for(j=0;j<network.node[i].type;j++) - { - alpha[j]=2.0*k; - network.node[i].post_alpha[j]+=alpha[j]; - ////////update loglik from udisclik - n+=alpha[j]; - N+=network.node[i].post_alpha[j]; - } - - - loglik=0.0; - post_loglik=0.0; - - for(j=0;j<network.node[i].type;j++) - post_loglik+=lgammafn(network.node[i].post_alpha[j])-lgammafn(alpha[j]); - - post_loglik+=lgammafn(n); - post_loglik-=lgammafn(N); - - - } - else - { - nu=nk*2.0; - tau=nu; - rho=nk*2.0; - mu=network.node[i].prob[1]; - phi=network.node[i].prob[0]*nk; - loglik=0.0; - post_mu=mu; - post_tau=tau; - post_rho=rho; - post_phi=phi; - post_loglik=loglik; - - postc0(&post_mu,&post_tau,&post_rho,&post_phi,&post_loglik,network.node[i].cdata,&network.row); - - - } - network.node[i].score_zeroparent=post_loglik; // store the zero parent score - - } - - if(nk!=1) - free(alpha); - - *net=network; //coppied back to original -} - - -/* -learn node for a list of parents -*/ - -double learn_parent(struct nd *net,int child,int p) -{ - int i,j,jj,k,nk,l,m,i1,j1,k1,k2,cn_send; - long num,temp; - double n,N,s2; - struct nd network=*net; //create a local copy - int cn,ds,bit,*discrete,*continuous; - double alpha,*postalpha,alpha_parent,*postalpha_parent,nu,rho,mu,phi,tau; - double post_nu,post_rho,*post_mu,post_phi,post_tau; - double loglik,post_loglik=0,post_loglik_parent=0; - double *mu_mat,**tau_mat,tau11,tau12,tau22,div,phiinv; - char **label; - int *a,*l_list,flag,y_count,z_count; - double *y,mu_p,phi_p,*tau_send,*z_send,loglik_sum; - - - - num=network.num; - - continuous=(int *)malloc(sizeof(int)*network.nc); - discrete=(int *)malloc(sizeof(int)*network.nd); - - nk=1; - for(i=0;i<num;i++) - { - if(network.node[i].type>1) - nk*=network.node[i].type; - } - -//list of discrete snd continuous parents - cn=0; - ds=0; - alpha_parent=0; - alpha=2; - - k1=network.node[child].type; - k2=1; - - //printf("%d\n",child); - for(j=0;j<network.num;j++) //list the continuous parents and discrete parents - { - bit= (p+1 >> j) & 1; - - - if(bit==1 && j!=child) - { - - if(network.node[j].type>1) - { - discrete[ds]=j; - //printf("discrete parent=%d\n",j); - k1*=network.node[j].type; - k2*=network.node[j].type; - ds++; - } - else - { - continuous[cn]=j; - //printf("continuous parent=%d\n",j); - cn++; - } - } - else if(j!=child) - { - alpha*=network.node[j].type; - } - } - - if(network.nd<=2) - alpha=2; - - i=child; //i is the node with changes in its parrent nodes - - if(network.node[i].type>1 && cn==0) // no continuous node //prepare alpha and post alpha and then calculate local score - { - - k=k1; - postalpha=(double *)calloc(network.node[i].type,sizeof(double)); - - label=(char **)malloc(sizeof(char *)*(ds+1)); //label array - a=(int *)calloc((ds+1),sizeof(int)); - l_list=(int *)malloc(sizeof(int)*(ds+1)); - - for(j=0;j<=ds;j++) - label[j]=(char *)malloc(sizeof(char)*100); - - for(j=0;j<ds;j++) - { - l=discrete[j]; - l_list[j]=network.node[l].type; - - } - l_list[ds]=network.node[i].type; - - for(j=0;j<k;j++) - { - - get_next_seq(a,l_list,ds+1); // prepare a new combination of labels for parent - for(i1=0;i1<ds;i1++) - { - j1=a[i1]; - l=discrete[i1]; - strcpy(label[i1],network.node[l].label[j1]); - } - - j1=a[i1]; - strcpy(label[i1],network.node[child].label[j1]); - for(i1=0;i1<network.node[i].type;i1++) - postalpha[i1]=0; - for(i1=0;i1<network.row;i1++) // search through parents data and count how many number of matches for current label list. prepare post alpha from count+alpha - { - flag=0; - for(m=0;m<ds;m++) - { - j1=a[m]; - l=discrete[m]; - if(strcmp(label[m],network.node[l].ddata[i1])!=0) - { - flag=1; - } - } - j1=a[m]; - if(strcmp(label[m],network.node[child].ddata[i1])!=0) - { - flag=1; - } - if(flag==0) - { - j1=a[ds]; - postalpha[j1]+=1; - - } - } - for(m=0;m<network.node[i].type;m++) - { - if(postalpha[m]!=0) - { - postalpha[m]+=alpha; - post_loglik+=lgammafn(postalpha[m])-lgammafn(alpha); - } - } - } - - - k=k2; // repeat the last step of preparing alpha and post alpha for only parent set. this time exclude the child node label from computation. prepare alpha_parent and post_alphaparent - l=discrete[ds-1]; - postalpha_parent=(double *)calloc(network.node[l].type,sizeof(double)); - - for(j=0;j<ds;j++) - { - l=discrete[j]; - l_list[j]=network.node[l].type; - a[j]=0; - - } - for(j=0;j<k1/k2;j++) - alpha_parent+=alpha; - for(j=0;j<k;j++) - { - get_next_seq(a,l_list,ds); - - for(i1=0;i1<ds;i1++) - { - j1=a[i1]; - l=discrete[i1]; - strcpy(label[i1],network.node[l].label[j1]); - - } - - l=discrete[ds-1]; - for(i1=0;i1<network.node[l].type;i1++) - postalpha_parent[i1]=0; - - for(i1=0;i1<network.row;i1++) - { - flag=0; - for(m=0;m<ds;m++) - { - j1=a[m]; - l=discrete[m]; - if(strcmp(label[m],network.node[l].ddata[i1])!=0) - { - flag=1; - } - } - - if(flag==0) - { - j1=a[ds-1]; - postalpha_parent[j1]+=1; - - } - } - l=discrete[ds-1]; - for(m=0;m<network.node[l].type;m++) - { - if(postalpha_parent[m]!=0) - { - postalpha_parent[m]+=alpha_parent; - post_loglik_parent+=lgammafn(postalpha_parent[m])-lgammafn(alpha_parent); - } - } - } - - - loglik=post_loglik-post_loglik_parent; - free(postalpha); - free(postalpha_parent); - for(j=0;j<=ds;j++) - free(label[j]); - free(label); - free(a); - free(l_list); - - } - else if(network.node[i].type==1 && ds==0) // no discrete node //prepare continuous parameter set - { - z_count=0; - tau_mat=(double **)malloc(sizeof(double *)*(cn+1)); - - z_send=(double *)malloc(sizeof(double)*(cn+1)*network.row); - tau_send=(double *)malloc(sizeof(double)*(cn+1)*(cn+1)); - - mu_mat=(double *)malloc(sizeof(double)*(cn+1)); - nu=nk*2.0; rho=nk*2.0+cn; - mu_mat[0]=network.node[i].prob[1]; - for(j=0;j<cn;j++) - { - mu_mat[j+1]=0; - tau_mat[j]=(double *)malloc(sizeof(double)*(cn+1)); - - } - - tau_mat[j]=(double *)malloc(sizeof(double)*(cn+1)); - - for(j=0;j<network.row;j++) - { - z_send[z_count]=1; - z_count++; - for(j1=0;j1<cn;j1++) - { - l=continuous[j1]; - z_send[z_count]=network.node[l].cdata[j]; - z_count++; - } - - } - - phi=network.node[i].prob[0]*nk; - - //preparing tau - - //**tau_mat - for(j=0;j<=cn;j++) - for(m=0;m<=cn;m++) - { - tau_mat[j][m]=1.0; - } - - for(j=0;j<cn;j++) - { - l=continuous[j]; - mu_p=network.node[l].prob[1]; - phi_p=network.node[l].prob[0]*nk; - phiinv=1/phi_p; - tau11 = 1/nu + mu_p*phiinv*mu_p; - tau22 = phiinv; - tau12 = -mu_p*phiinv; - div=tau11*tau22-tau12*tau12; - if(j==0) - tau_mat[0][0]=tau22/div; - tau_mat[0][j+1]=-tau12/div; - tau_mat[j+1][0]=tau_mat[0][j+1]; - tau_mat[j+1][j+1]=tau11/div; - } - - for(j=0;j<=cn;j++) - for(m=0;m<=cn;m++) - { - if(tau_mat[j][m]==1.0) - { - tau_mat[j][m]=tau_mat[0][j]*(tau_mat[0][m]/tau_mat[0][0]); - - } - j1=j*(cn+1)+m; - tau_send[j1]=tau_mat[j][m]; - - } - - loglik=0.0; - - cn_send=cn+1; - - postc(mu_mat,tau_send,&rho,&phi,&loglik,network.node[i].cdata,z_send,&network.row,&cn_send); - - - free(z_send); - free(tau_send); - for(j=0;j<=cn;j++) - free(tau_mat[j]); - free(tau_mat); - free(mu_mat); - - } - else //hybrid cases - { - if(cn==0) //if parents are all discrete and child is continuous - { - - ///////////////////prepare y array and run c code//////////////////////////////// - loglik_sum=0; - k=k2; - y=(double *)calloc(network.row,sizeof(double)); - label=(char **)malloc(sizeof(char *)*(ds)); //label array - a=(int *)calloc((ds+1),sizeof(int)); - l_list=(int *)malloc(sizeof(int)*(ds)); - - for(j=0;j<ds;j++) - label[j]=(char *)malloc(sizeof(char)*100); - - for(j=0;j<ds;j++) - { - l=discrete[j]; - l_list[j]=network.node[l].type; - - } - - - for(j=0;j<k;j++) - { - - nu=(nk*2.0)/k2; - tau=nu; - rho=nu; - mu=network.node[i].prob[1]; - phi=network.node[i].prob[0]*nu/2; - loglik=0.0; - - get_next_seq(a,l_list,ds); // prepare a new combination of labels for parent - for(i1=0;i1<ds;i1++) - { - j1=a[i1]; - l=discrete[i1]; - strcpy(label[i1],network.node[l].label[j1]); - } - y_count=0; - for(i1=0;i1<network.row;i1++) // search through parents data and count how many number of matches for current label list. prepare post alpha from count+alpha - { - flag=0; - for(m=0;m<ds;m++) - { - - l=discrete[m]; - if(strcmp(label[m],network.node[l].ddata[i1])!=0) - { - flag=1; - } - } - - if(flag==0) - { - y[y_count]=network.node[i].cdata[i1]; - y_count++; - - } - } - - postc0(&mu,&tau,&rho,&phi,&loglik,y,&y_count); - loglik_sum+=loglik; - - - } - - loglik=loglik_sum; - - free(y); - for(j=0;j<ds;j++) - free(label[j]); - free(label); - free(a); - free(l_list); - - - }//end of continuous node discrete parent check - else //all the other hybrid cases when parents are both continuous and discrete - { - - - tau_mat=(double **)malloc(sizeof(double *)*(cn+1)); - z_send=(double *)malloc(sizeof(double)*(cn+1)*network.row); - tau_send=(double *)malloc(sizeof(double)*(cn+1)*(cn+1)); - mu_mat=(double *)malloc(sizeof(double)*(cn+1)); - - for(j=0;j<cn;j++) - { - tau_mat[j]=(double *)malloc(sizeof(double)*(cn+1)); - } - - - tau_mat[j]=(double *)malloc(sizeof(double)*(cn+1)); - - ///////////////////prepare parameters and run c code//////////////////////////////// - loglik_sum=0.0; - k=k2; - y=(double *)calloc(network.row,sizeof(double)); - label=(char **)malloc(sizeof(char *)*(ds)); //label array - a=(int *)calloc((ds+1),sizeof(int)); - l_list=(int *)malloc(sizeof(int)*(ds)); - - for(j=0;j<ds;j++) - label[j]=(char *)malloc(sizeof(char)*100); - - for(j=0;j<ds;j++) - { - l=discrete[j]; - l_list[j]=network.node[l].type; - - } - - - for(jj=0;jj<k;jj++) - { - - nu=(nk*2.0)/k2; - rho=nu+cn; - mu_mat[0]=network.node[i].prob[1]; - - for(j1=0;j1<cn;j1++) - mu_mat[j1+1]=0; - - phi=network.node[i].prob[0]*nu/2; - //preparing tau - //**tau_mat - for(j=0;j<=cn;j++) - for(m=0;m<=cn;m++) - { - tau_mat[j][m]=1.0; - } - - for(j=0;j<cn;j++) - { - l=continuous[j]; - mu_p=network.node[l].prob[1]; - phi_p=network.node[l].prob[0]*(nk/k2); - - phiinv=1/phi_p; - tau11 = 1/nu + mu_p*phiinv*mu_p; - tau22 = phiinv; - tau12 = -mu_p*phiinv; - div=tau11*tau22-tau12*tau12; - if(j==0) - tau_mat[0][0]=tau22/div; - - tau_mat[0][j+1]=-tau12/div; - tau_mat[j+1][0]=tau_mat[0][j+1]; - tau_mat[j+1][j+1]=tau11/div; - - - } - for(j=0;j<=cn;j++) - for(m=0;m<=cn;m++) - { - if(tau_mat[j][m]==1.0) - { - tau_mat[j][m]=tau_mat[0][j]*(tau_mat[0][m]/tau_mat[0][0]); - } - - j1=j*(cn+1)+m; - tau_send[j1]=tau_mat[j][m]; - - //printf("%.2lf\t",tau_mat[j][m]); - } - //printf("\n"); - loglik=0.0; - - - cn_send=cn+1; - - - get_next_seq(a,l_list,ds); // prepare a new combination of labels for parent - for(i1=0;i1<ds;i1++) - { - j1=a[i1]; - l=discrete[i1]; - strcpy(label[i1],network.node[l].label[j1]); - } - y_count=0; - z_count=0; - for(i1=0;i1<network.row;i1++) // search through parents data and count how many number of matches for current label list. prepare post alpha from count+alpha - { - flag=0; - for(m=0;m<ds;m++) - { - - l=discrete[m]; - if(strcmp(label[m],network.node[l].ddata[i1])!=0) - { - flag=1; - } - } - - if(flag==0) - { - y[y_count]=network.node[i].cdata[i1]; - - //prepare z send matrix - z_send[z_count]=1; - z_count++; - for(j1=0;j1<cn;j1++) - { - l=continuous[j1]; - z_send[z_count]=network.node[l].cdata[i1]; - z_count++; - } - y_count++; - } - } - - postc(mu_mat,tau_send,&rho,&phi,&loglik,y,z_send,&y_count,&cn_send); - - loglik_sum+=loglik; - - - } - - loglik=loglik_sum; - - free(y); - //free(z); - free(z_send); - free(tau_send); - for(j=0;j<=cn;j++) - free(tau_mat[j]); - free(tau_mat); - free(mu_mat); - for(j=0;j<ds;j++) - free(label[j]); - free(label); - free(a); - free(l_list); - - }//end of else part for hybrid when parents are mixed - - }//end of else part for hybrid - - free(continuous); - free(discrete); - return loglik; - - -} - -void get_next_seq(int *a,int *l,int size) -{ - int j,idx; - idx=size-1; - a[idx]+=1; - if(a[idx]==l[idx]) - { - a[idx]=0; - for(j=idx-1;j>=0;j--){ - a[j]+=1; - if(a[j]==l[j]) - a[j]=0; - else - break; - } - } -} - - diff --git a/sourcecodes/localscore/postc0.c b/sourcecodes/localscore/postc0.c deleted file mode 100644 index 16e9ccec..00000000 --- a/sourcecodes/localscore/postc0.c +++ /dev/null @@ -1,81 +0,0 @@ -/* -*- Mode: C -*- - * postc0.c --- Posterior for continuous node with 0 parents - * Author : Claus Dethlefsen - * Created On : Tue Mar 12 06:44:35 2002 - * Last Modified By: Claus Dethlefsen - * Last Modified On: Wed Jun 04 11:57:10 2003 - * Update Count : 55 - * Status : Unknown, Use with caution! - */ - -/* - ## -## Copyright (C) 2002 Susanne Gammelgaard Bøttcher, Claus Dethlefsen -## -## This program is free software; you can redistribute it and/or modify -## it under the terms of the GNU General Public License as published by -## the Free Software Foundation; either version 2 of the License, or -## (at your option) any later version. -## -## This program is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with this program; if not, write to the Free Software -## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -###################################################################### -*/ - -#include "R.h" -#include "Rmath.h" - - -void postc0(double *mu, double *tau, double *rho, double *phi, double - *loglik, double *y, int *n) -{ - int i; - double logscale,logk,mscore; - double oldtau,oldmu; - -/* Rprintf("her er mu=%f\n",*mu); - Rprintf("her er tau=%f\n",*tau); - Rprintf("her er rho=%f\n",*rho); - Rprintf("her er phi=%f\n",*phi); - Rprintf("her er loglik=%f\n",*loglik); -*/ - - for(i = 0; i < *n; i++) { - - logscale = log(*phi)+log1p(1.0/(*tau)); - logk = lgammafn( 0.5*(1.0+*rho) ) - lgammafn(*rho*0.5); - logk -= 0.5*(logscale + log(M_PI)); - mscore = logk - 0.5*(*rho+1.0)*log1p( (y[i]-*mu)*(y[i]-*mu)/exp(logscale)); - *loglik += mscore; - - oldtau = *tau; - oldmu = *mu; - - (*tau)++; - (*rho)++; -/* Rprintf("her er oldmu=%f\n",oldmu); - Rprintf("her er oldtau=%f\n",oldtau); - Rprintf("her er mu=%f\n",*mu); - Rprintf("her er tau=%f\n",*tau); -*/ - *mu = (oldtau*(*mu)+y[i])/(*tau); - *phi+= (y[i]-(*mu))*y[i] + (oldmu-(*mu))*oldtau*oldmu; -/* Rprintf("logscale=%f\n",logscale); - Rprintf("logk=%f\n",logk); - Rprintf("mscore=%f\n",mscore); - Rprintf("loglik=%f\n",*loglik); - - Rprintf("her er mu=%f\n",*mu); - Rprintf("her er tau=%f\n",*tau); - Rprintf("her er rho=%f\n",*rho); - Rprintf("her er phi=%f\n",*phi); - Rprintf("her er loglik=%f\n",*loglik); -*/ - } -} diff --git a/sourcecodes/localscore/rlocale.h b/sourcecodes/localscore/rlocale.h deleted file mode 100644 index ac08f341..00000000 --- a/sourcecodes/localscore/rlocale.h +++ /dev/null @@ -1,118 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2005-12 The R Core Team - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - - -/* This file was contributed by Ei-ji Nakama. - * See also the comments in src/main/rlocale.c. - - * For use in R only. - */ - -#ifndef R_LOCALE_H -#define R_LOCALE_H - -#ifndef NO_C_HEADERS -#include <wchar.h> -#include <ctype.h> -#include <wctype.h> -#endif - -#ifdef __cplusplus -extern "C" { -#endif - -extern const char *locale2charset(const char *); - -/* - * Windows CJK - * In Unicode, there is not a rule about character width. - * A letter of breadth is used in a CJK (China, Japan, Korea, - * Taiwan, Hong Kong, and Singapore) area, and there are a - * letter and a standard (character width is not still prescribed) - * of a cord in a country. - * Letter width is a problem of a font, but it is a rule route - * besides a alphanumeric character that use a breadth letter. - * It is generally defined as a breadth letter for a font such - * as Japanese. - * - Win32 - - * Attempted explanation by BDR - * The display widths of characters are not prescribed in Unicode. - * Double-width characters are used in the CJK area: their width can - * be font-specific, with different fonts in use in different parts - * of the CJK area. The tables supplied in many OSes and by Marcus - * Kuhn are not do not take the exact locale into account. The - * tables supplied in rlocale_data.h allow different widths for - * different parts of the CJK area, and also where needed different - * widths on Windows. (The Windows differences are in zh_CN, and - * apply to European characters.) - * - */ -extern int Ri18n_wcwidth(wchar_t); -extern int Ri18n_wcswidth (const wchar_t *, size_t); - -/* Mac OSX CJK and WindowXP(Japanese) - * iswctypes of MacOSX calls isctypes. no i18n. - * For example, iswprint of Windows does not accept a macron of - * Japanese "a-ru" of R as a letter. - * Therefore Japanese "Buraian.Ripuri-" of "Brian Ripley" is - * shown of hex-string.:-) - * We define alternatives to be used if - * defined(Win32) || defined(__APPLE_CC__) || defined(_AIX) - */ -extern wctype_t Ri18n_wctype(const char *); -extern int Ri18n_iswctype(wint_t, wctype_t); - -#ifndef IN_RLOCALE_C -/* We want to avoid these redefinitions in rlocale.c itself */ -#undef iswupper -#undef iswlower -#undef iswalpha -#undef iswdigit -#undef iswxdigit -#undef iswspace -#undef iswprint -#undef iswgraph -#undef iswblank -#undef iswcntrl -#undef iswpunct -#undef iswalnum -#undef wctype -#undef iswctype - -#define iswupper(__x) Ri18n_iswctype(__x, Ri18n_wctype("upper")) -#define iswlower(__x) Ri18n_iswctype(__x, Ri18n_wctype("lower")) -#define iswalpha(__x) Ri18n_iswctype(__x, Ri18n_wctype("alpha")) -#define iswdigit(__x) Ri18n_iswctype(__x, Ri18n_wctype("digit")) -#define iswxdigit(__x) Ri18n_iswctype(__x, Ri18n_wctype("xdigit")) -#define iswspace(__x) Ri18n_iswctype(__x, Ri18n_wctype("space")) -#define iswprint(__x) Ri18n_iswctype(__x, Ri18n_wctype("print")) -#define iswgraph(__x) Ri18n_iswctype(__x, Ri18n_wctype("graph")) -#define iswblank(__x) Ri18n_iswctype(__x, Ri18n_wctype("blank")) -#define iswcntrl(__x) Ri18n_iswctype(__x, Ri18n_wctype("cntrl")) -#define iswpunct(__x) Ri18n_iswctype(__x, Ri18n_wctype("punct")) -#define iswalnum(__x) Ri18n_iswctype(__x, Ri18n_wctype("alnum")) -#define wctype(__x) Ri18n_wctype(__x) -#define iswctype(__x,__y) Ri18n_iswctype(__x,__y) -#endif - -#ifdef __cplusplus -} -#endif -#endif /* R_LOCALE_H */ diff --git a/sourcecodes/localscore/stats_package.h b/sourcecodes/localscore/stats_package.h deleted file mode 100644 index 3717c482..00000000 --- a/sourcecodes/localscore/stats_package.h +++ /dev/null @@ -1,71 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2007 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -#ifndef R_STATS_PACKAGE_H -#define R_STATS_PACKAGE_H -#include <Rconfig.h> - -#ifdef HAVE_VISIBILITY_ATTRIBUTE -# define attribute_hidden __attribute__ ((visibility ("hidden"))) -#else -# define attribute_hidden -#endif - -enum AlgType {NREG = 1, OPT = 2}; - /* 0-based indices into v */ -enum VPos {F = 9, F0 = 12, FDIF = 10, G = 27, HC = 70}; - /* 0-based indices into iv */ -enum IVPos {AI = 90, AM = 94, ALGSAV = 50, COVMAT = 25, - COVPRT = 13, COVREQ = 14, DRADPR = 100, - DTYPE = 15, IERR = 74, INITH = 24, INITS = 24, - IPIVOT = 75, IVNEED = 2, LASTIV = 42, LASTV = 44, - LMAT = 41, MXFCAL = 16, MXITER = 17, NEXTV = 46, - NFCALL = 5, NFCOV = 51, NFGCAL = 6, NGCOV = 52, - NITER = 30, NVDFLT = 49, NVSAVE = 8, OUTLEV = 18, - PARPRT = 19, PARSAV = 48, PERM = 57, PRUNIT = 20, - QRTYP = 79, RDREQ = 56, RMAT = 77, SOLPRT = 21, - STATPR = 22, TOOBIG = 1, VNEED = 3, VSAVE = 59, - X0PRT = 23}; - -void attribute_hidden -S_Rf_divset(int alg, int iv[], int liv, int lv, double v[]); - -void attribute_hidden -S_nlsb_iterate(double b[], double d[], double dr[], int iv[], - int liv, int lv, int n, int nd, int p, - double r[], double rd[], double v[], double x[]); - -void attribute_hidden -S_nlminb_iterate(double b[], double d[], double fx, double g[], - double h[], int iv[], int liv, int lv, int n, - double v[], double x[]); - -static R_INLINE int S_v_length(int alg, int n) -{ - return (alg - 1) ? (105 + (n * (2 * n + 20))) : - (130 + (n * (n + 27))/2); -} - -static R_INLINE int S_iv_length(int alg, int n) -{ - return (alg - 1) ? (82 + 4 * n) : (78 + 3 * n); -} - -#endif /* R_STATS_PACKAGE_H */ - diff --git a/sourcecodes/localscore/stats_stubs.h b/sourcecodes/localscore/stats_stubs.h deleted file mode 100644 index bc46821e..00000000 --- a/sourcecodes/localscore/stats_stubs.h +++ /dev/null @@ -1,68 +0,0 @@ -/* - * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 2007 The R Core Team. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation; either version 2.1 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, a copy is available at - * http://www.r-project.org/Licenses/ - */ - -#include <Rconfig.h> -#include <Rinternals.h> -#include <R_ext/Rdynload.h> - -#ifdef HAVE_VISIBILITY_ATTRIBUTE -# define attribute_hidden __attribute__ ((visibility ("hidden"))) -#else -# define attribute_hidden -#endif - -void attribute_hidden -S_Rf_divset(int alg, int iv[], int liv, int lv, double v[]) -{ - static void(*fun)(int,int[],int,int,double[]) = NULL; - if (fun == NULL) - fun = (void(*)(int,int[],int,int,double[])) - R_GetCCallable("stats", "Rf_divset"); - fun(alg, iv, liv, lv, v); -} - -void attribute_hidden -S_nlminb_iterate(double b[], double d[], double fx, double g[], double h[], - int iv[], int liv, int lv, int n, double v[], double x[]) -{ - static void(*fun)(double[],double[],double,double[],double[], - int[],int,int,int,double[],double[]) = NULL; - if (fun == NULL) - fun = (void(*)(double[],double[],double,double[],double[], - int[],int,int,int,double[],double[])) - R_GetCCallable("stats", "nlminb_iterate"); - fun(b, d, fx, g, h, iv, liv, lv, n, v, x); -} - -void attribute_hidden -S_nlsb_iterate(double b[], double d[], double dr[], int iv[], int liv, - int lv, int n, int nd, int p, double r[], double rd[], - double v[], double x[]) -{ - static void(*fun)(double[],double[],double[],int[],int,int, - int,int,int,double[],double[],double[], - double[]) = NULL; - if (fun == NULL) - fun = (void(*)(double[],double[],double[],int[],int, - int, int,int,int,double[], - double[],double[],double[])) - R_GetCCallable("stats", "nlsb_iterate"); - fun(b, d, dr, iv, liv, lv, n, nd, p, r, rd, v, x); -} - |