r2rs-stats 0.1.1

use crate::sexprec::{SEXP, SEXPTYPE};
use ::libc;
extern "C" {
    #[no_mangle]
    fn sqrt(_: libc::c_double) -> libc::c_double;
    /* IEEE -Inf */
    #[no_mangle]
    static mut R_NaReal: libc::c_double;
    /* NA_REAL: IEEE */
    #[no_mangle]
    static mut R_NaInt: libc::c_int;
    /* NA_INTEGER:= INT_MIN currently */
    /* #define NA_FACTOR R_NaInt  unused */
    /* NA_STRING is a SEXP, so defined in Rinternals.h */
    #[no_mangle]
    fn R_IsNA(_: libc::c_double) -> libc::c_int;
    /*
     *  R : A Computer Language for Statistical Data Analysis
     *  Copyright (C) 1998-2005   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 error(_: *const libc::c_char, _: ...) -> !;
    #[no_mangle]
    fn R_alloc(_: size_t, _: libc::c_int) -> *mut libc::c_char;
    #[no_mangle]
    fn TYPEOF(x: SEXP) -> libc::c_int;
    #[no_mangle]
    fn XLENGTH(x: SEXP) -> R_xlen_t;
    #[no_mangle]
    fn INTEGER(x: SEXP) -> *mut libc::c_int;
    #[no_mangle]
    fn REAL(x: SEXP) -> *mut libc::c_double;
    /* "dimnames" */
    #[no_mangle]
    static mut R_DimSymbol: SEXP;
    #[no_mangle]
    fn coerceVector(_: SEXP, _: SEXPTYPE) -> SEXP;
    #[no_mangle]
    fn asLogical(x: SEXP) -> libc::c_int;
    #[no_mangle]
    fn asInteger(x: SEXP) -> libc::c_int;
    #[no_mangle]
    fn ncols(_: SEXP) -> libc::c_int;
    #[no_mangle]
    fn nrows(_: SEXP) -> libc::c_int;
    #[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);
}
pub type size_t = libc::c_ulong;
/*
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 2000, 2001 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 */
pub type Rboolean = libc::c_uint;
pub const TRUE: Rboolean = 1;
pub const FALSE: Rboolean = 0;
pub type ptrdiff_t = libc::c_long;
/*, MAYBE */
/* 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"
 */
/* real variables */
/* complex variables */
/* 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) 1999-2016   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
*  https://www.R-project.org/Licenses/.
*/
// currently ISNAN includes NAs
#[no_mangle]
pub unsafe extern "C" fn cfilter(
    mut sx: SEXP,
    mut sfilter: SEXP,
    mut ssides: SEXP,
    mut scircular: SEXP,
) -> SEXP {
    if TYPEOF(sx) != 14 as libc::c_int || TYPEOF(sfilter) != 14 as libc::c_int {
        error(b"invalid input\x00" as *const u8 as *const libc::c_char); /* circular */
    }
    let mut nx: R_xlen_t = XLENGTH(sx);
    let mut nf: R_xlen_t = XLENGTH(sfilter);
    let mut sides: libc::c_int = asInteger(ssides);
    let mut circular: libc::c_int = asLogical(scircular);
    if sides == R_NaInt || circular == R_NaInt {
        error(b"invalid input\x00" as *const u8 as *const libc::c_char);
    }
    let mut ans: SEXP = allocVector(14 as libc::c_int as SEXPTYPE, nx);
    let mut i: R_xlen_t = 0;
    let mut j: R_xlen_t = 0;
    let mut nshift: R_xlen_t = 0;
    let mut z: libc::c_double = 0.;
    let mut tmp: libc::c_double = 0.;
    let mut x: *mut libc::c_double = REAL(sx);
    let mut filter: *mut libc::c_double = REAL(sfilter);
    let mut out: *mut libc::c_double = REAL(ans);
    if sides == 2 as libc::c_int {
        nshift = nf / 2 as libc::c_int as libc::c_long
    } else {
        nshift = 0 as libc::c_int as R_xlen_t
    }
    if circular == 0 {
        let mut current_block_14: u64;
        i = 0 as libc::c_int as R_xlen_t;
        while i < nx {
            z = 0 as libc::c_int as libc::c_double;
            if (i + nshift - (nf - 1 as libc::c_int as libc::c_long))
                < 0 as libc::c_int as libc::c_long
                || i + nshift >= nx
            {
                *out.offset(i as isize) = R_NaReal
            } else {
                j = if (0 as libc::c_int as libc::c_long) < nshift + i - nx {
                    (nshift + i) - nx
                } else {
                    0 as libc::c_int as libc::c_long
                };
                loop {
                    if !(j
                        < (if nf < i + nshift + 1 as libc::c_int as libc::c_long {
                            nf
                        } else {
                            (i + nshift) + 1 as libc::c_int as libc::c_long
                        }))
                    {
                        current_block_14 = 2668756484064249700;
                        break;
                    }
                    tmp = *x.offset((i + nshift - j) as isize);
                    if (R_IsNA(tmp) == 0) as libc::c_int
                        & !(tmp.is_nan() as i32 != 0 as libc::c_int) as libc::c_int
                        != 0
                    {
                        z += *filter.offset(j as isize) * tmp;
                        j += 1
                    } else {
                        *out.offset(i as isize) = R_NaReal;
                        current_block_14 = 2868539653012386629;
                        break;
                    }
                }
                match current_block_14 {
                    2868539653012386629 => {}
                    _ => *out.offset(i as isize) = z,
                }
            }
            i += 1
        }
    } else {
        let mut current_block_27: u64;
        i = 0 as libc::c_int as R_xlen_t;
        while i < nx {
            z = 0 as libc::c_int as libc::c_double;
            j = 0 as libc::c_int as R_xlen_t;
            loop {
                if !(j < nf) {
                    current_block_27 = 14072441030219150333;
                    break;
                }
                let mut ii: R_xlen_t = i + nshift - j;
                if ii < 0 as libc::c_int as libc::c_long {
                    ii += nx
                }
                if ii >= nx {
                    ii -= nx
                }
                tmp = *x.offset(ii as isize);
                if (R_IsNA(tmp) == 0) as libc::c_int
                    & !(tmp.is_nan() as i32 != 0 as libc::c_int) as libc::c_int
                    != 0
                {
                    z += *filter.offset(j as isize) * tmp;
                    j += 1
                } else {
                    *out.offset(i as isize) = R_NaReal;
                    current_block_27 = 6669252993407410313;
                    break;
                }
            }
            match current_block_27 {
                14072441030219150333 => *out.offset(i as isize) = z,
                _ => {}
            }
            i += 1
        }
    }
    return ans;
}
/* recursive filtering */
#[no_mangle]
pub unsafe extern "C" fn rfilter(mut x: SEXP, mut filter: SEXP, mut out: SEXP) -> SEXP {
    if TYPEOF(x) != 14 as libc::c_int
        || TYPEOF(filter) != 14 as libc::c_int
        || TYPEOF(out) != 14 as libc::c_int
    {
        error(b"invalid input\x00" as *const u8 as *const libc::c_char);
    }
    let mut nx: R_xlen_t = XLENGTH(x);
    let mut nf: R_xlen_t = XLENGTH(filter);
    let mut sum: libc::c_double = 0.;
    let mut tmp: libc::c_double = 0.;
    let mut r: *mut libc::c_double = REAL(out);
    let mut rx: *mut libc::c_double = REAL(x);
    let mut rf: *mut libc::c_double = REAL(filter);
    let mut current_block_6: u64;
    let mut i: R_xlen_t = 0 as libc::c_int as R_xlen_t;
    while i < nx {
        sum = *rx.offset(i as isize);
        let mut j: R_xlen_t = 0 as libc::c_int as R_xlen_t;
        loop {
            if !(j < nf) {
                current_block_6 = 7651349459974463963;
                break;
            }
            tmp = *r.offset((nf + i - j - 1 as libc::c_int as libc::c_long) as isize);
            if (R_IsNA(tmp) == 0) as libc::c_int
                & !(tmp.is_nan() as i32 != 0 as libc::c_int) as libc::c_int
                != 0
            {
                sum += tmp * *rf.offset(j as isize);
                j += 1
            } else {
                *r.offset((nf + i) as isize) = R_NaReal;
                current_block_6 = 10680521327981672866;
                break;
            }
        }
        match current_block_6 {
            7651349459974463963 => *r.offset((nf + i) as isize) = sum,
            _ => {}
        }
        i += 1
    }
    return out;
}
/* now allows missing values */
unsafe extern "C" fn acf0(
    mut x: *mut libc::c_double,
    mut n: libc::c_int,
    mut ns: libc::c_int,
    mut nl: libc::c_int,
    mut correlation: Rboolean,
    mut acf_0: *mut libc::c_double,
) {
    let mut d1: libc::c_int = nl + 1 as libc::c_int;
    let mut d2: libc::c_int = ns * d1;
    let mut u: libc::c_int = 0 as libc::c_int;
    while u < ns {
        let mut v: libc::c_int = 0 as libc::c_int;
        while v < ns {
            let mut lag: libc::c_int = 0 as libc::c_int;
            while lag <= nl {
                let mut sum: libc::c_double = 0.0f64;
                let mut nu: libc::c_int = 0 as libc::c_int;
                let mut i: libc::c_int = 0 as libc::c_int;
                while i < n - lag {
                    if !((*x.offset((i + lag + n * u) as isize)).is_nan() as i32
                        != 0 as libc::c_int)
                        && !((*x.offset((i + n * v) as isize)).is_nan() as i32 != 0 as libc::c_int)
                    {
                        nu += 1;
                        sum +=
                            *x.offset((i + lag + n * u) as isize) * *x.offset((i + n * v) as isize)
                    }
                    i += 1
                }
                *acf_0.offset((lag + d1 * u + d2 * v) as isize) = if nu > 0 as libc::c_int {
                    (sum) / (nu + lag) as libc::c_double
                } else {
                    R_NaReal
                };
                lag += 1
            }
            v += 1
        }
        u += 1
    }
    if correlation as u64 != 0 {
        if n == 1 as libc::c_int {
            let mut u_0: libc::c_int = 0 as libc::c_int;
            while u_0 < ns {
                *acf_0.offset((0 as libc::c_int + d1 * u_0 + d2 * u_0) as isize) = 1.0f64;
                u_0 += 1
            }
        } else {
            let mut se: *mut libc::c_double = R_alloc(
                ns as size_t,
                ::std::mem::size_of::<libc::c_double>() as libc::c_ulong as libc::c_int,
            ) as *mut libc::c_double;
            let mut u_1: libc::c_int = 0 as libc::c_int;
            while u_1 < ns {
                *se.offset(u_1 as isize) =
                    sqrt(*acf_0.offset((0 as libc::c_int + d1 * u_1 + d2 * u_1) as isize));
                u_1 += 1
            }
            let mut u_2: libc::c_int = 0 as libc::c_int;
            while u_2 < ns {
                let mut v_0: libc::c_int = 0 as libc::c_int;
                while v_0 < ns {
                    let mut lag_0: libc::c_int = 0 as libc::c_int;
                    while lag_0 <= nl {
                        // ensure correlations remain in  [-1,1] :
                        let mut a: libc::c_double = *acf_0
                            .offset((lag_0 + d1 * u_2 + d2 * v_0) as isize)
                            / (*se.offset(u_2 as isize) * *se.offset(v_0 as isize));
                        *acf_0.offset((lag_0 + d1 * u_2 + d2 * v_0) as isize) = if a > 1.0f64 {
                            1.0f64
                        } else if a < -1.0f64 {
                            -1.0f64
                        } else {
                            a
                        };
                        lag_0 += 1
                    }
                    v_0 += 1
                }
                u_2 += 1
            }
        }
    };
}
/*
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 2001-2017 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
 *  https://www.R-project.org/Licenses/
 */
#[no_mangle]
pub unsafe extern "C" fn acf(mut x: SEXP, mut lmax: SEXP, mut sCor: SEXP) -> SEXP {
    let mut nx: libc::c_int = nrows(x);
    let mut ns: libc::c_int = ncols(x);
    let mut lagmax: libc::c_int = asInteger(lmax);
    let mut cor: libc::c_int = asLogical(sCor);
    x = protect(coerceVector(x, 14 as libc::c_int as SEXPTYPE));
    let mut ans: SEXP = protect(allocVector(
        14 as libc::c_int as SEXPTYPE,
        ((lagmax + 1 as libc::c_int) * ns * ns) as R_xlen_t,
    ));
    acf0(REAL(x), nx, ns, lagmax, cor as Rboolean, REAL(ans));
    let mut d: SEXP = protect(allocVector(
        13 as libc::c_int as SEXPTYPE,
        3 as libc::c_int as R_xlen_t,
    ));
    *INTEGER(d).offset(0 as libc::c_int as isize) = lagmax + 1 as libc::c_int;
    let ref mut fresh0 = *INTEGER(d).offset(2 as libc::c_int as isize);
    *fresh0 = ns;
    *INTEGER(d).offset(1 as libc::c_int as isize) = *fresh0;
    setAttrib(ans, R_DimSymbol, d);
    unprotect(3 as libc::c_int);
    return ans;
}