r2rs-stats 0.1.1

use crate::sexprec::{SEXP, SEXPTYPE};
use ::libc;
extern "C" {
    /* IEEE -Inf */
    #[no_mangle]
    static mut R_NaReal: libc::c_double;
    #[no_mangle]
    fn error(_: *const libc::c_char, _: ...) -> !;
    /*
     *  R : A Computer Language for Statistical Data Analysis
     *  Copyright (C) 1998-2016    The R Core Team
     *
     *  This header file 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 file is part of R. R is distributed under the terms of the
     *  GNU General Public License, either Version 2, June 1991 or Version 3,
     *  June 2007. See doc/COPYRIGHTS for details of the copyright status of R.
     *
     *  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
     *  https://www.R-project.org/Licenses/
     */
    /* Included by R.h: API */
    #[no_mangle]
    fn Rprintf(_: *const libc::c_char, _: ...);
    #[no_mangle]
    fn XLENGTH(x: SEXP) -> R_xlen_t;
    #[no_mangle]
    fn REAL(x: SEXP) -> *mut libc::c_double;
    #[no_mangle]
    fn SET_STRING_ELT(x: SEXP, i: R_xlen_t, v: SEXP);
    #[no_mangle]
    fn SET_VECTOR_ELT(x: SEXP, i: R_xlen_t, v: SEXP) -> SEXP;
    /* "name" */
    #[no_mangle]
    static mut R_NamesSymbol: SEXP;
    #[no_mangle]
    fn coerceVector(_: SEXP, _: SEXPTYPE) -> SEXP;
    #[no_mangle]
    fn asInteger(x: SEXP) -> libc::c_int;
    #[no_mangle]
    fn asReal(x: SEXP) -> libc::c_double;
    #[no_mangle]
    fn mkChar(_: *const libc::c_char) -> SEXP;
    #[no_mangle]
    fn setAttrib(_: SEXP, _: SEXP, _: SEXP) -> SEXP;
    /* Defining NO_RINLINEDFUNS disables use to simulate platforms where
    this is not available */
    /* need remapped names here for use with R_NO_REMAP */
    /*
       These are the inlinable functions that are provided in Rinlinedfuns.h
       It is *essential* that these do not appear in any other header file,
       with or without the Rf_ prefix.
    */
    #[no_mangle]
    fn allocVector(_: SEXPTYPE, _: R_xlen_t) -> SEXP;
    #[no_mangle]
    fn protect(_: SEXP) -> SEXP;
    #[no_mangle]
    fn unprotect(_: libc::c_int);
    #[no_mangle]
    fn dcgettext(
        __domainname: *const libc::c_char,
        __msgid: *const libc::c_char,
        __category: libc::c_int,
    ) -> *mut libc::c_char;
}
pub type ptrdiff_t = libc::c_long;
/* both config.h and Rconfig.h set SIZEOF_SIZE_T, but Rconfig.h is
skipped if config.h has already been included. */
pub type R_xlen_t = ptrdiff_t;
/* Fundamental Data Types:  These are largely Lisp
 * influenced structures, with the exception of LGLSXP,
 * INTSXP, REALSXP, CPLXSXP and STRSXP which are the
 * element types for S-like data objects.
 *
 *   --> TypeTable[] in ../main/util.c for  typeof()
 */
/* UUID identifying the internals version -- packages using compiled
code should be re-installed when this changes */
/*  These exact numeric values are seldom used, but they are, e.g., in
 *  ../main/subassign.c, and they are serialized.
*/
/* NOT YET using enum:
 *  1) The SEXPREC struct below has 'SEXPTYPE type : 5'
 * (making FUNSXP and CLOSXP equivalent in there),
 * giving (-Wall only ?) warnings all over the place
 * 2) Many switch(type) { case ... } statements need a final `default:'
 * added in order to avoid warnings like [e.g. l.170 of ../main/util.c]
 *   "enumeration value `FUNSXP' not handled in switch"
 */
/* string vectors */
/* dot-dot-dot object */
/* make "any" args work.
Used in specifying types for symbol
registration to mean anything is okay  */
/* generic vectors */
/* expressions vectors */
/* byte code */
/* external pointer */
/* weak reference */
/* raw bytes */
/* S4, non-vector */
/* used for detecting PROTECT issues in memory.c */
/* fresh node created in new page */
/* node released by GC */
/* Closure or Builtin or Special */
/* NOT YET */
/* These are also used with the write barrier on, in attrib.c and util.c */
/*
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 1998-2016 The R Foundation
 *
 *  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
 *  https://www.R-project.org/Licenses/
 */
unsafe extern "C" fn dokern(mut x: libc::c_double, mut kern: libc::c_int) -> libc::c_double {
    if kern == 1 as libc::c_int {
        return 1.0f64;
    }
    if kern == 2 as libc::c_int {
        return (-0.5f64 * x * x).exp();
    }
    return 0.0f64;
    /* -Wall */
}
unsafe extern "C" fn BDRksmooth(
    mut x: *mut libc::c_double,
    mut y: *mut libc::c_double,
    mut n: R_xlen_t,
    mut xp: *mut libc::c_double,
    mut yp: *mut libc::c_double,
    mut np: R_xlen_t,
    mut kern: libc::c_int,
    mut bw: libc::c_double,
) {
    let mut imin: R_xlen_t = 0 as libc::c_int as R_xlen_t;
    let mut cutoff: libc::c_double = 0.0f64;
    let mut num: libc::c_double = 0.;
    let mut den: libc::c_double = 0.;
    let mut x0: libc::c_double = 0.;
    let mut w: libc::c_double = 0.;
    /* bandwidth is in units of half inter-quartile range. */
    if kern == 1 as libc::c_int {
        bw *= 0.5f64;
        cutoff = bw
    }
    if kern == 2 as libc::c_int {
        bw *= 0.3706506f64;
        cutoff = 4 as libc::c_int as libc::c_double * bw
    }
    while *x.offset(imin as isize) < *xp.offset(0 as libc::c_int as isize) - cutoff && imin < n {
        imin += 1
    }
    let mut j: R_xlen_t = 0 as libc::c_int as R_xlen_t;
    while j < np {
        den = 0.0f64;
        num = den;
        x0 = *xp.offset(j as isize);
        let mut i: R_xlen_t = imin;
        while i < n {
            if *x.offset(i as isize) < x0 - cutoff {
                imin = i
            } else {
                if *x.offset(i as isize) > x0 + cutoff {
                    break;
                }
                w = dokern((*x.offset(i as isize) - x0).abs() / bw, kern);
                num += w * *y.offset(i as isize);
                den += w
            }
            i += 1
        }
        if den > 0 as libc::c_int as libc::c_double {
            *yp.offset(j as isize) = num / den
        } else {
            *yp.offset(j as isize) = R_NaReal
        }
        j += 1
    }
}
// called only from  spline()  in ./ppr.f
#[no_mangle]
pub unsafe extern "C" fn bdrsplerr_() -> ! {
    error(dcgettext(
        b"stats\x00" as *const u8 as *const libc::c_char,
        b"only 2500 rows are allowed for sm.method=\"spline\"\x00" as *const u8
            as *const libc::c_char,
        5 as libc::c_int,
    ));
}
#[no_mangle]
pub unsafe extern "C" fn splineprt_(
    mut df: *mut libc::c_double,
    mut gcvpen: *mut libc::c_double,
    mut ismethod: *mut libc::c_int,
    mut lambda: *mut libc::c_double,
    mut edf: *mut libc::c_double,
) {
    Rprintf(
        b"spline(df=%5.3g, g.pen=%11.6g, ismeth.=%+2d) -> (lambda, edf) = (%.7g, %5.2f)\n\x00"
            as *const u8 as *const libc::c_char,
        *df,
        *gcvpen,
        *ismethod,
        *lambda,
        *edf,
    );
}
// called only from smooth(..., trace=TRUE)  in ./ppr.f :
#[no_mangle]
pub unsafe extern "C" fn smoothprt_(
    mut span: *mut libc::c_double,
    mut iper: *mut libc::c_int,
    mut var: *mut libc::c_double,
    mut cvar: *mut libc::c_double,
) {
    Rprintf(
        b"smooth(span=%4g, iper=%+2d) -> (var, cvar) = (%g, %g)\n\x00" as *const u8
            as *const libc::c_char,
        *span,
        *iper,
        *var,
        *cvar,
    );
}
#[no_mangle]
pub unsafe extern "C" fn ksmooth(
    mut x: SEXP,
    mut y: SEXP,
    mut xp: SEXP,
    mut skrn: SEXP,
    mut sbw: SEXP,
) -> SEXP {
    let mut krn: libc::c_int = asInteger(skrn);
    let mut bw: libc::c_double = asReal(sbw);
    x = protect(coerceVector(x, 14 as libc::c_int as SEXPTYPE));
    y = protect(coerceVector(y, 14 as libc::c_int as SEXPTYPE));
    xp = protect(coerceVector(xp, 14 as libc::c_int as SEXPTYPE));
    let mut nx: R_xlen_t = XLENGTH(x);
    let mut np: R_xlen_t = XLENGTH(xp);
    let mut yp: SEXP = protect(allocVector(14 as libc::c_int as SEXPTYPE, np));
    BDRksmooth(REAL(x), REAL(y), nx, REAL(xp), REAL(yp), np, krn, bw);
    let mut ans: SEXP = protect(allocVector(
        19 as libc::c_int as SEXPTYPE,
        2 as libc::c_int as R_xlen_t,
    ));
    SET_VECTOR_ELT(ans, 0 as libc::c_int as R_xlen_t, xp);
    SET_VECTOR_ELT(ans, 1 as libc::c_int as R_xlen_t, yp);
    let mut nm: SEXP = allocVector(16 as libc::c_int as SEXPTYPE, 2 as libc::c_int as R_xlen_t);
    setAttrib(ans, R_NamesSymbol, nm);
    SET_STRING_ELT(
        nm,
        0 as libc::c_int as R_xlen_t,
        mkChar(b"x\x00" as *const u8 as *const libc::c_char),
    );
    SET_STRING_ELT(
        nm,
        1 as libc::c_int as R_xlen_t,
        mkChar(b"y\x00" as *const u8 as *const libc::c_char),
    );
    unprotect(5 as libc::c_int);
    return ans;
}