r2rs-stats 0.1.1

use crate::sexprec::{SEXP, SEXPTYPE};
use ::libc;
extern "C" {
    #[no_mangle]
    fn memset(_: *mut libc::c_void, _: libc::c_int, _: libc::c_ulong) -> *mut libc::c_void;

    #[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 choose(_: libc::c_double, _: libc::c_double) -> libc::c_double;
    #[no_mangle]
    fn dcgettext(
        __domainname: *const libc::c_char,
        __msgid: *const libc::c_char,
        __category: libc::c_int,
    ) -> *mut libc::c_char;
    /* Vector Access Functions */
    #[no_mangle]
    fn LENGTH(x: SEXP) -> libc::c_int;
    #[no_mangle]
    fn REAL(x: SEXP) -> *mut libc::c_double;
    #[no_mangle]
    fn coerceVector(_: SEXP, _: SEXPTYPE) -> SEXP;
    #[no_mangle]
    fn asInteger(x: SEXP) -> libc::c_int;
    /* 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;
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"
 */
/* 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 */
/*
 *  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/
 *
 */
/* ansari.c
Compute the exact distribution of the Ansari-Bradley test statistic.
*/
// for floor
unsafe extern "C" fn w_init(
    mut m: libc::c_int,
    mut n: libc::c_int,
) -> *mut *mut *mut libc::c_double {
    let mut i: libc::c_int = 0;
    let mut w: *mut *mut *mut libc::c_double = 0 as *mut *mut *mut libc::c_double;
    w = R_alloc(
        (m + 1 as libc::c_int) as size_t,
        ::std::mem::size_of::<*mut *mut libc::c_double>() as libc::c_ulong as libc::c_int,
    ) as *mut *mut *mut libc::c_double;
    memset(
        w as *mut libc::c_void,
        '\u{0}' as i32,
        ((m + 1 as libc::c_int) as libc::c_ulong)
            .wrapping_mul(::std::mem::size_of::<*mut *mut libc::c_double>() as libc::c_ulong),
    );
    i = 0 as libc::c_int;
    while i <= m {
        let ref mut fresh0 = *w.offset(i as isize);
        *fresh0 = R_alloc(
            (n + 1 as libc::c_int) as size_t,
            ::std::mem::size_of::<*mut libc::c_double>() as libc::c_ulong as libc::c_int,
        ) as *mut *mut libc::c_double;
        memset(
            *w.offset(i as isize) as *mut libc::c_void,
            '\u{0}' as i32,
            ((n + 1 as libc::c_int) as libc::c_ulong)
                .wrapping_mul(::std::mem::size_of::<*mut libc::c_double>() as libc::c_ulong),
        );
        i += 1
    }
    return w;
}
unsafe extern "C" fn cansari(
    mut k: libc::c_int,
    mut m: libc::c_int,
    mut n: libc::c_int,
    mut w: *mut *mut *mut libc::c_double,
) -> libc::c_double {
    let mut i: libc::c_int = 0;
    let mut l: libc::c_int = 0;
    let mut u: libc::c_int = 0;
    l = (m + 1 as libc::c_int) * (m + 1 as libc::c_int) / 4 as libc::c_int;
    u = l + m * n / 2 as libc::c_int;
    if k < l || k > u {
        return 0 as libc::c_int as libc::c_double;
    }
    if (*(*w.offset(m as isize)).offset(n as isize)).is_null() {
        let ref mut fresh1 = *(*w.offset(m as isize)).offset(n as isize);
        *fresh1 = R_alloc(
            (u + 1 as libc::c_int) as size_t,
            ::std::mem::size_of::<libc::c_double>() as libc::c_ulong as libc::c_int,
        ) as *mut libc::c_double;
        memset(
            *(*w.offset(m as isize)).offset(n as isize) as *mut libc::c_void,
            '\u{0}' as i32,
            ((u + 1 as libc::c_int) as libc::c_ulong)
                .wrapping_mul(::std::mem::size_of::<libc::c_double>() as libc::c_ulong),
        );
        i = 0 as libc::c_int;
        while i <= u {
            *(*(*w.offset(m as isize)).offset(n as isize)).offset(i as isize) =
                -(1 as libc::c_int) as libc::c_double;
            i += 1
        }
    }
    if *(*(*w.offset(m as isize)).offset(n as isize)).offset(k as isize)
        < 0 as libc::c_int as libc::c_double
    {
        if m == 0 as libc::c_int {
            *(*(*w.offset(m as isize)).offset(n as isize)).offset(k as isize) =
                (k == 0 as libc::c_int) as libc::c_int as libc::c_double
        } else if n == 0 as libc::c_int {
            *(*(*w.offset(m as isize)).offset(n as isize)).offset(k as isize) =
                (k == l) as libc::c_int as libc::c_double
        } else {
            *(*(*w.offset(m as isize)).offset(n as isize)).offset(k as isize) =
                cansari(k, m, n - 1 as libc::c_int, w)
                    + cansari(
                        k - (m + n + 1 as libc::c_int) / 2 as libc::c_int,
                        m - 1 as libc::c_int,
                        n,
                        w,
                    )
        }
    }
    return *(*(*w.offset(m as isize)).offset(n as isize)).offset(k as isize);
}
unsafe extern "C" fn pansari(
    mut len: libc::c_int,
    mut Q: *mut libc::c_double,
    mut P: *mut libc::c_double,
    mut m: libc::c_int,
    mut n: libc::c_int,
) {
    let mut i: libc::c_int = 0;
    let mut j: libc::c_int = 0;
    let mut l: libc::c_int = 0;
    let mut u: libc::c_int = 0;
    let mut c: libc::c_double = 0.;
    let mut p: libc::c_double = 0.;
    let mut q: libc::c_double = 0.;
    let mut w: *mut *mut *mut libc::c_double = 0 as *mut *mut *mut libc::c_double;
    w = w_init(m, n);
    l = (m + 1 as libc::c_int) * (m + 1 as libc::c_int) / 4 as libc::c_int;
    u = l + m * n / 2 as libc::c_int;
    c = choose((m + n) as libc::c_double, m as libc::c_double);
    i = 0 as libc::c_int;
    while i < len {
        q = (*Q.offset(i as isize) + 1e-7f64).floor();
        if q < l as libc::c_double {
            *P.offset(i as isize) = 0 as libc::c_int as libc::c_double
        } else if q > u as libc::c_double {
            *P.offset(i as isize) = 1 as libc::c_int as libc::c_double
        } else {
            p = 0 as libc::c_int as libc::c_double;
            j = l;
            while j as libc::c_double <= q {
                p += cansari(j, m, n, w);
                j += 1
            }
            *P.offset(i as isize) = p / c
        }
        i += 1
    }
}
unsafe extern "C" fn qansari(
    mut len: libc::c_int,
    mut P: *mut libc::c_double,
    mut Q: *mut libc::c_double,
    mut m: libc::c_int,
    mut n: libc::c_int,
) {
    let mut i: libc::c_int = 0;
    let mut l: libc::c_int = 0;
    let mut u: libc::c_int = 0;
    let mut c: libc::c_double = 0.;
    let mut p: libc::c_double = 0.;
    let mut xi: libc::c_double = 0.;
    let mut w: *mut *mut *mut libc::c_double = 0 as *mut *mut *mut libc::c_double;
    w = w_init(m, n);
    l = (m + 1 as libc::c_int) * (m + 1 as libc::c_int) / 4 as libc::c_int;
    u = l + m * n / 2 as libc::c_int;
    c = choose((m + n) as libc::c_double, m as libc::c_double);
    i = 0 as libc::c_int;
    while i < len {
        xi = *P.offset(i as isize);
        if xi < 0 as libc::c_int as libc::c_double || xi > 1 as libc::c_int as libc::c_double {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"probabilities outside [0,1] in qansari()\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        if xi == 0 as libc::c_int as libc::c_double {
            *Q.offset(i as isize) = l as libc::c_double
        } else if xi == 1 as libc::c_int as libc::c_double {
            *Q.offset(i as isize) = u as libc::c_double
        } else {
            p = 0.0f64;
            let mut q: libc::c_int = 0 as libc::c_int;
            loop {
                p += cansari(q, m, n, w) / c;
                if p >= xi {
                    break;
                }
                q += 1
            }
            *Q.offset(i as isize) = q as libc::c_double
        }
        i += 1
    }
}
#[no_mangle]
pub unsafe extern "C" fn pAnsari(mut q: SEXP, mut sm: SEXP, mut sn: SEXP) -> SEXP {
    let mut m: libc::c_int = asInteger(sm);
    let mut n: libc::c_int = asInteger(sn);
    q = protect(coerceVector(q, 14 as libc::c_int as SEXPTYPE));
    let mut len: libc::c_int = LENGTH(q);
    let mut p: SEXP = protect(allocVector(14 as libc::c_int as SEXPTYPE, len as R_xlen_t));
    pansari(len, REAL(q), REAL(p), m, n);
    unprotect(2 as libc::c_int);
    return p;
}
#[no_mangle]
pub unsafe extern "C" fn qAnsari(mut p: SEXP, mut sm: SEXP, mut sn: SEXP) -> SEXP {
    let mut m: libc::c_int = asInteger(sm);
    let mut n: libc::c_int = asInteger(sn);
    p = protect(coerceVector(p, 14 as libc::c_int as SEXPTYPE));
    let mut len: libc::c_int = LENGTH(p);
    let mut q: SEXP = protect(allocVector(14 as libc::c_int as SEXPTYPE, len as R_xlen_t));
    qansari(len, REAL(p), REAL(q), m, n);
    unprotect(2 as libc::c_int);
    return q;
}