r2rs-stats 0.1.1

use crate::{
    rcont::rcont2,
    sexprec::{SEXP, SEXPTYPE},
};
use ::libc;
extern "C" {
    #[no_mangle]
    fn R_alloc(_: size_t, _: libc::c_int) -> *mut libc::c_char;
    #[no_mangle]
    fn GetRNGstate();
    #[no_mangle]
    fn PutRNGstate();
    /* 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 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) 2001-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/
 */
/* Driver routine to call RCONT2 from R, B times.
   Calculates the Pearson chi-squared for each generated table.

   Mostly here for historical reasons now that we have r2dtable().
*/
unsafe extern "C" fn chisqsim(
    mut nrow: *mut libc::c_int,
    mut ncol: *mut libc::c_int,
    mut nrowt: *mut libc::c_int,
    mut ncolt: *mut libc::c_int,
    mut n: *mut libc::c_int,
    mut B: libc::c_int,
    mut expected: *mut libc::c_double,
    mut observed: *mut libc::c_int,
    mut fact: *mut libc::c_double,
    mut jwork: *mut libc::c_int,
    mut results: *mut libc::c_double,
) {
    let mut i: libc::c_int = 0;
    let mut j: libc::c_int = 0;
    let mut ii: libc::c_int = 0;
    let mut iter: libc::c_int = 0;
    let mut chisq: libc::c_double = 0.;
    let mut e: libc::c_double = 0.;
    let mut o: libc::c_double = 0.;
    /* Calculate log-factorials.  fact[i] = lgamma(i+1) */
    let ref mut fresh0 = *fact.offset(1 as libc::c_int as isize);
    *fresh0 = 0.0f64;
    *fact.offset(0 as libc::c_int as isize) = *fresh0;
    i = 2 as libc::c_int;
    while i <= *n {
        *fact.offset(i as isize) =
            *fact.offset((i - 1 as libc::c_int) as isize) + (i as libc::c_double).ln();
        i += 1
    }
    GetRNGstate();
    iter = 0 as libc::c_int;
    while iter < B {
        rcont2(nrow, ncol, nrowt, ncolt, n, fact, jwork, observed);
        /* Calculate chi-squared value from the random table. */
        chisq = 0.0f64;
        j = 0 as libc::c_int;
        while j < *ncol {
            i = 0 as libc::c_int;
            ii = j * *nrow;
            while i < *nrow {
                e = *expected.offset(ii as isize);
                o = *observed.offset(ii as isize) as libc::c_double;
                chisq += (o - e) * (o - e) / e;
                i += 1;
                ii += 1
            }
            j += 1
        }
        *results.offset(iter as isize) = chisq;
        iter += 1
    }
    PutRNGstate();
}
/* Driver routine to call RCONT2 from R, B times.
   Calculates the log probability for each generated table.

   Mostly here for historical reasons now that we have r2dtable().
*/
unsafe extern "C" fn fisher_sim(
    mut nrow: *mut libc::c_int,
    mut ncol: *mut libc::c_int,
    mut nrowt: *mut libc::c_int,
    mut ncolt: *mut libc::c_int,
    mut n: *mut libc::c_int,
    mut B: libc::c_int,
    mut observed: *mut libc::c_int,
    mut fact: *mut libc::c_double,
    mut jwork: *mut libc::c_int,
    mut results: *mut libc::c_double,
) {
    let mut i: libc::c_int = 0;
    let mut j: libc::c_int = 0;
    let mut ii: libc::c_int = 0;
    let mut iter: libc::c_int = 0;
    let mut ans: libc::c_double = 0.;
    /* Calculate log-factorials.  fact[i] = lgamma(i+1) */
    let ref mut fresh1 = *fact.offset(1 as libc::c_int as isize);
    *fresh1 = 0.0f64;
    *fact.offset(0 as libc::c_int as isize) = *fresh1;
    i = 2 as libc::c_int;
    while i <= *n {
        *fact.offset(i as isize) =
            *fact.offset((i - 1 as libc::c_int) as isize) + (i as libc::c_double).ln();
        i += 1
    }
    GetRNGstate();
    iter = 0 as libc::c_int;
    while iter < B {
        rcont2(nrow, ncol, nrowt, ncolt, n, fact, jwork, observed);
        /* Calculate log-prob value from the random table. */
        ans = 0.0f64;
        j = 0 as libc::c_int;
        while j < *ncol {
            i = 0 as libc::c_int;
            ii = j * *nrow;
            while i < *nrow {
                ans -= *fact.offset(*observed.offset(ii as isize) as isize);
                i += 1;
                ii += 1
            }
            j += 1
        }
        *results.offset(iter as isize) = ans;
        iter += 1
    }
    PutRNGstate();
}
#[no_mangle]
pub unsafe extern "C" fn Fisher_sim(mut sr: SEXP, mut sc: SEXP, mut sB: SEXP) -> SEXP {
    sr = protect(coerceVector(sr, 13 as libc::c_int as SEXPTYPE));
    sc = protect(coerceVector(sc, 13 as libc::c_int as SEXPTYPE));
    let mut nr: libc::c_int = LENGTH(sr);
    let mut nc: libc::c_int = LENGTH(sc);
    let mut B: libc::c_int = asInteger(sB);
    let mut n: libc::c_int = 0 as libc::c_int;
    let mut isr: *mut libc::c_int = INTEGER(sr);
    let mut i: libc::c_int = 0 as libc::c_int;
    while i < nr {
        n += *isr.offset(i as isize);
        i += 1
    }
    let mut observed: *mut libc::c_int = R_alloc(
        (nr * nc) as size_t,
        ::std::mem::size_of::<libc::c_int>() as libc::c_ulong as libc::c_int,
    ) as *mut libc::c_int;
    let mut fact: *mut libc::c_double = R_alloc(
        (n + 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;
    let mut jwork: *mut libc::c_int = R_alloc(
        nc as size_t,
        ::std::mem::size_of::<libc::c_int>() as libc::c_ulong as libc::c_int,
    ) as *mut libc::c_int;
    let mut ans: SEXP = protect(allocVector(14 as libc::c_int as SEXPTYPE, B as R_xlen_t));
    fisher_sim(
        &mut nr,
        &mut nc,
        isr,
        INTEGER(sc),
        &mut n,
        B,
        observed,
        fact,
        jwork,
        REAL(ans),
    );
    unprotect(3 as libc::c_int);
    return ans;
}
#[no_mangle]
pub unsafe extern "C" fn chisq_sim(mut sr: SEXP, mut sc: SEXP, mut sB: SEXP, mut E: SEXP) -> SEXP {
    sr = protect(coerceVector(sr, 13 as libc::c_int as SEXPTYPE));
    sc = protect(coerceVector(sc, 13 as libc::c_int as SEXPTYPE));
    E = protect(coerceVector(E, 14 as libc::c_int as SEXPTYPE));
    let mut nr: libc::c_int = LENGTH(sr);
    let mut nc: libc::c_int = LENGTH(sc);
    let mut B: libc::c_int = asInteger(sB);
    let mut n: libc::c_int = 0 as libc::c_int;
    let mut isr: *mut libc::c_int = INTEGER(sr);
    let mut i: libc::c_int = 0 as libc::c_int;
    while i < nr {
        n += *isr.offset(i as isize);
        i += 1
    }
    let mut observed: *mut libc::c_int = R_alloc(
        (nr * nc) as size_t,
        ::std::mem::size_of::<libc::c_int>() as libc::c_ulong as libc::c_int,
    ) as *mut libc::c_int;
    let mut fact: *mut libc::c_double = R_alloc(
        (n + 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;
    let mut jwork: *mut libc::c_int = R_alloc(
        nc as size_t,
        ::std::mem::size_of::<libc::c_int>() as libc::c_ulong as libc::c_int,
    ) as *mut libc::c_int;
    let mut ans: SEXP = protect(allocVector(14 as libc::c_int as SEXPTYPE, B as R_xlen_t));
    chisqsim(
        &mut nr,
        &mut nc,
        isr,
        INTEGER(sc),
        &mut n,
        B,
        REAL(E),
        observed,
        fact,
        jwork,
        REAL(ans),
    );
    unprotect(4 as libc::c_int);
    return ans;
}