r2rs-stats 0.1.1

use crate::sexprec::{SEXP, SEXPREC, SEXPTYPE};
use ::libc;
extern "C" {
    /* nil = NULL */
    /* symbols */
    /* lists of dotted pairs */
    /* closures */
    /* environments */
    /* promises: [un]evaluated closure arguments */
    /* language constructs (special lists) */
    /* special forms */
    /* builtin non-special forms */
    /* "scalar" string type (internal only)*/
    /* logical vectors */
    /* 11 and 12 were factors and ordered factors in the 1990s */
    /* integer vectors */
    /* 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 */
    #[no_mangle]
    static mut R_PosInf: libc::c_double;
    /* Vector Access Functions */
    #[no_mangle]
    fn LENGTH(x: SEXP) -> libc::c_int;
    #[no_mangle]
    fn INTEGER(x: SEXP) -> *mut libc::c_int;
    #[no_mangle]
    fn REAL(x: SEXP) -> *mut libc::c_double;
    #[no_mangle]
    fn SET_VECTOR_ELT(x: SEXP, i: R_xlen_t, v: SEXP) -> SEXP;
    #[no_mangle]
    fn lengthgets(_: SEXP, _: R_len_t) -> 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 mkNamed(_: SEXPTYPE, _: *mut *const libc::c_char) -> SEXP;
    #[no_mangle]
    fn protect(_: SEXP) -> SEXP;
    #[no_mangle]
    fn unprotect(_: libc::c_int);
}
pub type ptrdiff_t = libc::c_long;
/* type for length of (standard, not long) vectors etc */
pub type R_len_t = libc::c_int;
/* 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"
 */
/*
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 2001-2017 The R Core Team.
 *  Copyright (C) 2003-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/
 */
/* --- Isotonic regression ---
 * code simplified from VR_mds_fn() which is part of MASS.c,
 * Copyright (C) 1995  Brian Ripley
 * ---
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 2003 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/
 */
#[no_mangle]
pub unsafe extern "C" fn isoreg(mut y: SEXP) -> SEXP {
    let mut n: libc::c_int = LENGTH(y);
    let mut i: libc::c_int = 0;
    let mut ip: libc::c_int = 0;
    let mut known: libc::c_int = 0;
    let mut n_ip: libc::c_int = 0;
    let mut tmp: libc::c_double = 0.;
    let mut slope: libc::c_double = 0.;
    let mut yc: SEXP = 0 as *mut SEXPREC;
    let mut yf: SEXP = 0 as *mut SEXPREC;
    let mut iKnots: SEXP = 0 as *mut SEXPREC;
    let mut ans: SEXP = 0 as *mut SEXPREC;
    let mut anms: [*const libc::c_char; 5] = [
        b"y\x00" as *const u8 as *const libc::c_char,
        b"yc\x00" as *const u8 as *const libc::c_char,
        b"yf\x00" as *const u8 as *const libc::c_char,
        b"iKnots\x00" as *const u8 as *const libc::c_char,
        b"\x00" as *const u8 as *const libc::c_char,
    ];
    /* unneeded: y = coerceVector(y, REALSXP); */
    ans = mkNamed(19 as libc::c_int as SEXPTYPE, anms.as_mut_ptr()); /* avoid segfault below */
    protect(ans);
    SET_VECTOR_ELT(ans, 0 as libc::c_int as R_xlen_t, y);
    yc = allocVector(
        14 as libc::c_int as SEXPTYPE,
        (n + 1 as libc::c_int) as R_xlen_t,
    );
    SET_VECTOR_ELT(ans, 1 as libc::c_int as R_xlen_t, yc);
    yf = allocVector(14 as libc::c_int as SEXPTYPE, n as R_xlen_t);
    SET_VECTOR_ELT(ans, 2 as libc::c_int as R_xlen_t, yf);
    iKnots = allocVector(13 as libc::c_int as SEXPTYPE, n as R_xlen_t);
    SET_VECTOR_ELT(ans, 3 as libc::c_int as R_xlen_t, iKnots);
    if n == 0 as libc::c_int {
        return ans;
    }
    /* yc := cumsum(0,y) */
    *REAL(yc).offset(0 as libc::c_int as isize) = 0.0f64; /*1e+200*/
    tmp = 0.0f64; /* tmp := max{i= kn+1,.., n} slope(p[kn] -> p[i])  and
                   *  ip = argmax{...}... */
    i = 0 as libc::c_int;
    while i < n {
        tmp += *REAL(y).offset(i as isize);
        *REAL(yc).offset((i + 1 as libc::c_int) as isize) = tmp;
        i += 1
    }
    known = 0 as libc::c_int;
    ip = 0 as libc::c_int;
    n_ip = 0 as libc::c_int;
    loop {
        slope = R_PosInf;
        i = known + 1 as libc::c_int;
        while i <= n {
            tmp = (*REAL(yc).offset(i as isize) - *REAL(yc).offset(known as isize))
                / (i - known) as libc::c_double;
            if tmp < slope {
                slope = tmp;
                ip = i
            }
            i += 1
        }
        let fresh0 = n_ip;
        n_ip = n_ip + 1;
        *INTEGER(iKnots).offset(fresh0 as isize) = ip;
        i = known;
        while i < ip {
            *REAL(yf).offset(i as isize) = (*REAL(yc).offset(ip as isize)
                - *REAL(yc).offset(known as isize))
                / (ip - known) as libc::c_double;
            i += 1
        }
        known = ip;
        if !(known < n) {
            break;
        }
    }
    if n_ip < n {
        SET_VECTOR_ELT(ans, 3 as libc::c_int as R_xlen_t, lengthgets(iKnots, n_ip));
    }
    unprotect(1 as libc::c_int);
    return ans;
}