1 /* External and interal API of C and Fortran routines in robustbase */
2
3 #include <R.h>
4 // for SEXP
5 #include <Rinternals.h>
6
7 /**< For internationalized messages */
8 #ifdef ENABLE_NLS
9 #include <libintl.h>
10 #define _(String) dgettext ("Matrix", String)
11 #else
12 #define _(String) (String)
13 #define dngettext(pkg, String, StringP, N) (N > 1 ? StringP : String)
14 #endif
15
16
17
18 /* --------- ./qn_sn.c : -------- */
19 #define Sint int
20
21 void Qn0(double *x, Sint *n, double *k, Sint *len_k, double *res);
22
23 void Sn0(double *x, Sint *n, Sint *is_sorted, double *res, double *a2);
24 /*
25 * void Qn (double *x, Sint *n, Sint *h, Sint *finite_corr, double *res);
26 * void Sn (double *x, Sint *n, Sint *finite_corr, double *res);
27 */
28
29 /* call via .C() from R : */
30 void wgt_himed_i(double *x, Sint *n, Sint *iw, double *res);
31 void wgt_himed (double *x, Sint *n, double *w, double *res);
32
33 /* call from C: */
34 double pull(double *a, int n, int k);
35
36 double whimed_i(double *a, int *iw, int n,
37 double *acand, double *a_srt, int *iw_cand);
38 double whimed(double *a, double *w, int n,
39 double *acand, double *a_srt, double *w_cand);
40
41 /* --------- ./mc.c -------- */
42
43 /* call via .C() from R : */
44 void mc_C(double *z, int *in, double *eps, int *iter, double *out, int *scale);
45
46 /* call from C: *iter is both input and output */
47 double mc_C_d(const double z[], int n, const double eps[], int *iter, int scale);
48
49
50
51
52 /* --------- ./lmrob.c --------- */
53
54 static inline
is_redescender(int ipsi)55 Rboolean is_redescender(int ipsi) {// a simple wrapper for readability
56 // for now, fastest:
57 if(ipsi == 0)
58 return FALSE;
59 return TRUE;
60 /* if have many more, maybe
61 switch(ipsi) {
62 default: error(_("ipsi=%d not implemented."), ipsi);
63 case 0: // huber and future other non-redescenders
64 return FALSE;
65 case 1: case 2: case 3: case 4: case 5: case 6:
66 return TRUE;
67 }
68 */
69 }
70
71 SEXP R_rho_inf(SEXP cc, SEXP ipsi);
72
73 void R_lmrob_S(double *X, double *y, int *n, int *P,
74 int *nRes, double *scale, double *beta_s,
75 double *C, int *iipsi, double *bb,
76 int *best_r, int *Groups, int *N_group,
77 int *K_s, int *max_k, int *max_it_scale,
78 double *rel_tol, double *inv_tol, double *scale_tol,
79 // ^^^^^^^^^ = refine.tol in R
80 int* converged, int *trace_lev, int *mts, int *ss, int *cutoff);
81
82 void R_lmrob_M_S(double *X1, double *X2, double *y, double *res,
83 int *n, int *p1, int *p2, int *nRes, int *max_it_scale,
84 double *scale, double *b1, double *b2,
85 double *rho_c, int *ipsi, double *bb,
86 int *K_m_s, int *max_k, double *rel_tol, double *inv_tol, double *scale_tol,
87 int *converged, int *trace_lev,
88 int *orthogonalize, int *subsample,
89 int *descent, int *mts, int *ss);
90
91 void R_lmrob_MM(double *X, double *y, int *n, int *P,
92 double *beta_initial, double *scale,
93 double *beta_m, double *resid,
94 int *max_it,
95 double *rho_c, int *ipsi, double *loss, double *rel_tol,
96 int *converged, int *trace_lev, int *mts, int *ss);
97
98 void R_subsample(const double *x, const double *y, int *n, int *m,
99 double *beta, int *ind_space, int *idc, int *idr,
100 double *lu, double *v, int *p,
101 double *_Dr, double *_Dc, int *_rowequ, int *_colequ,
102 int *status, int *sample, int *mts, int *ss, double *tol_inv,
103 int *solve);
104
105 SEXP R_psifun(SEXP x_, SEXP c_, SEXP ipsi_, SEXP deriv_);
106 SEXP R_chifun(SEXP x_, SEXP c_, SEXP ipsi_, SEXP deriv_);
107 SEXP R_wgtfun(SEXP x_, SEXP c_, SEXP ipsi_);
108
109 double rho(double x, const double c[], int ipsi);
110 double psi(double x, const double c[], int ipsi);
111 double psip(double x, const double c[], int ipsi);// psi'
112 double psi2(double x, const double c[], int ipsi);// psi''
113 double wgt(double x, const double c[], int ipsi);
114 double rho_inf (const double c[], int ipsi); // == \rho(\infty)
115 double normcnst(const double c[], int ipsi); // == 1 / \rho(\infty) == 1 / rho_inf()
116
117
118 void R_find_D_scale(double *rr, double *kkappa, double *ttau, int *llength,
119 double *sscale, double *cc, int *iipsi, int *ttype, double *rel_tol,
120 int *max_k, int *converged);
121
122 void R_calc_fitted(double *XX, double *bbeta, double *RR, int *nn, int *pp, int *nnrep,
123 int *nnproc, int *nnerr);
124
125 // ------- ./rob-utils.c ---------------
126 SEXP R_wgt_flex(SEXP x_, SEXP c_, SEXP h_);
127
128 // ------- ./rowMedians.c ---------------
129 SEXP R_rowMedians(SEXP x, SEXP naRm, SEXP hasNA, SEXP byRow, SEXP keepNms);
130
131 /* ------- ./rffastmcd.f ------------ */
132 void F77_NAME(rffastmcd)(
133 double *dat, int *n, int *nvar, int *nhalff, int *krep, // 5
134 int *nmini, int *kmini, // 7
135 double *initcov, double *initmean, int *inbest, double *det, // 11
136 int *weight, int *fit, double *coeff, int *kount, double *adcov, // 16
137 int *temp, int *index1, int *index2, int *indexx, double *nmahad,// 21
138 double *ndist, double *am, double *am2, // 24
139 double *slutn, double *med, double *mad, double *sd, // 28
140 double *means, double *bmeans, double *w, double *fv1, // 32
141 double *fv2, double *rec, double *sscp1, double *cova1, // 36
142 double *corr1, double *cinv1, double *cova2, // 39
143 double *cinv2, double *z__, double *cstock, double *mstock, // 43
144 double *c1stock, double *m1stock, double *dath, // 46
145 double *cutoff, double *chimed, int *i_trace); // 49 args
146
147 /* ------- ./rfltsreg.f ------------ */
148 void F77_NAME(rfltsreg)(
149 double *dat, int *n, int *nvar,
150 int *nhalff, int *krep, int *inbest, double *objfct,
151 int *intercept, int *intadjust, int *nvad, double *datt, double *weights,
152 int *temp, int *index1, int *index2, double *aw2, double *aw,
153 double *residu, double *y, double *nmahad, double *ndist,
154 double *am, double *am2, double *slutn, int *jmiss,
155 double *xmed, double *xmad, double *a, double *da,
156 double *h__, double *hvec,
157 double *c__, double *cstock, double *mstock, double *c1stock, double *m1stock,
158 double *dath, double *sd, double *means, double *bmeans, int *i_trace);
159
160 /* ------- ./rllarsbi.f -------------- */
161 void F77_NAME(rllarsbi)(
162 double *X, double *Y, int *N, int *NP, int *MDX, int *MDT,
163 double *TOL, int *NIT, int *K, int *KODE, double *SIGMA, double *THETA,
164 double *RS, double *SC1, double *SC2, double *SC3, double *SC4,
165 double *BET0);
166