r2rs-stats 0.1.1

use crate::sexprec::{SEXP, SEXPREC, SEXPTYPE};
use ::libc;
extern "C" {
    #[no_mangle]
    fn strcmp(_: *const libc::c_char, _: *const libc::c_char) -> libc::c_int;
    #[no_mangle]
    fn sqrt(_: libc::c_double) -> libc::c_double;

    #[no_mangle]
    fn snprintf(
        _: *mut libc::c_char,
        _: libc::c_ulong,
        _: *const libc::c_char,
        _: ...
    ) -> libc::c_int;
    /* True for special NaN, *not* for NA */
    #[no_mangle]
    fn R_finite(_: 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 warning(_: *const libc::c_char, _: ...);
    #[no_mangle]
    fn vmaxget() -> *mut libc::c_void;
    #[no_mangle]
    fn vmaxset(_: *const libc::c_void);
    /*
     *  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, _: ...);
    /* Define SWITH_TO_REFCNT to use reference counting instead of the
    'NAMED' mechanism. */
    //#define SWITCH_TO_REFCNT
    // ======================= USE_RINTERNALS section
    /* not USE_RINTERNALS */
    // ======================= not USE_RINTERNALS section
    #[no_mangle]
    fn R_CHAR(x: SEXP) -> *const libc::c_char;
    /* Various tests with macro versions in the second USE_RINTERNALS section */
    #[no_mangle]
    fn isNull(s: SEXP) -> Rboolean;
    #[no_mangle]
    fn isLogical(s: SEXP) -> Rboolean;
    #[no_mangle]
    fn isReal(s: SEXP) -> Rboolean;
    #[no_mangle]
    fn isEnvironment(s: SEXP) -> Rboolean;
    #[no_mangle]
    fn isString(s: SEXP) -> Rboolean;
    #[no_mangle]
    fn TYPEOF(x: SEXP) -> libc::c_int;
    #[no_mangle]
    fn NAMED(x: SEXP) -> libc::c_int;
    #[no_mangle]
    fn MARK_NOT_MUTABLE(x: SEXP);
    /* Vector Access Functions */
    #[no_mangle]
    fn LENGTH(x: SEXP) -> libc::c_int;
    #[no_mangle]
    fn REAL(x: SEXP) -> *mut libc::c_double;
    //SEXP (STRING_ELT)(SEXP x, R_xlen_t i);
    #[no_mangle]
    fn VECTOR_ELT(x: SEXP, i: R_xlen_t) -> SEXP;
    #[no_mangle]
    fn SET_VECTOR_ELT(x: SEXP, i: R_xlen_t, v: SEXP) -> SEXP;
    /* Evaluation Environment */
    #[no_mangle]
    static mut R_GlobalEnv: SEXP;
    /* An empty environment at the root of the
    environment tree */
    #[no_mangle]
    static mut R_BaseEnv: SEXP;
    /* "name" */
    #[no_mangle]
    static mut R_NamesSymbol: 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 asReal(x: SEXP) -> libc::c_double;
    #[no_mangle]
    fn allocMatrix(_: SEXPTYPE, _: libc::c_int, _: libc::c_int) -> SEXP;
    #[no_mangle]
    fn defineVar(_: SEXP, _: SEXP, _: SEXP);
    #[no_mangle]
    fn duplicate(_: SEXP) -> SEXP;
    #[no_mangle]
    fn eval(_: SEXP, _: SEXP) -> SEXP;
    #[no_mangle]
    fn findVar(_: SEXP, _: SEXP) -> SEXP;
    #[no_mangle]
    fn getAttrib(_: SEXP, _: SEXP) -> SEXP;
    #[no_mangle]
    fn install(_: *const libc::c_char) -> SEXP;
    #[no_mangle]
    fn setAttrib(_: SEXP, _: SEXP, _: SEXP) -> SEXP;
    #[no_mangle]
    fn translateChar(_: SEXP) -> *const libc::c_char;
    /* 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 isFunction(_: SEXP) -> Rboolean;
    #[no_mangle]
    fn isInteger(_: SEXP) -> Rboolean;
    #[no_mangle]
    fn isNewList(_: SEXP) -> Rboolean;
    #[no_mangle]
    fn isNumeric(_: SEXP) -> Rboolean;
    #[no_mangle]
    fn lang1(_: SEXP) -> SEXP;
    #[no_mangle]
    fn lang2(_: SEXP, _: SEXP) -> SEXP;
    #[no_mangle]
    fn length(_: SEXP) -> R_len_t;
    #[no_mangle]
    fn mkNamed(_: SEXPTYPE, _: *mut *const libc::c_char) -> SEXP;
    #[no_mangle]
    fn mkString(_: *const libc::c_char) -> SEXP;
    #[no_mangle]
    fn ScalarInteger(_: libc::c_int) -> SEXP;
    #[no_mangle]
    fn ScalarLogical(_: libc::c_int) -> SEXP;
    #[no_mangle]
    fn ScalarReal(_: libc::c_double) -> SEXP;
    #[no_mangle]
    fn protect(_: SEXP) -> SEXP;
    #[no_mangle]
    fn unprotect(_: libc::c_int);
    #[no_mangle]
    fn STRING_ELT(x: SEXP, i: R_xlen_t) -> SEXP;
    #[no_mangle]
    fn dcgettext(
        __domainname: *const libc::c_char,
        __msgid: *const libc::c_char,
        __category: libc::c_int,
    ) -> *mut libc::c_char;
}
/*
 *  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 */
/* 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"
 */
/* 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 */
/*
 *  Routines used in calculating least squares solutions in a
 *  nonlinear model in nls library for R.
 *
 *  Copyright 1999-2001 Douglas M. Bates
 *                      Saikat DebRoy
 *
 *  Copyright 2005--2016  The R Core Team
 *  Copyright 2006   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/
 */
/*
 * get the list element named str. names is the name attribute of list
 */
unsafe extern "C" fn getListElement(
    mut list: SEXP,
    mut names: SEXP,
    mut str: *const libc::c_char,
) -> SEXP {
    let mut elmt: SEXP = 0 as *mut libc::c_void as SEXP; /* ASCII only */
    let mut tempChar: *const libc::c_char = 0 as *const libc::c_char;
    let mut i: libc::c_int = 0;
    i = 0 as libc::c_int;
    while i < length(list) {
        tempChar = R_CHAR(STRING_ELT(names, i as R_xlen_t));
        if strcmp(tempChar, str) == 0 as libc::c_int {
            elmt = VECTOR_ELT(list, i as R_xlen_t);
            break;
        } else {
            i += 1
        }
    }
    return elmt;
}
/*
 * put some convergence-related information into list
 */
unsafe extern "C" fn ConvInfoMsg(
    mut msg: *mut libc::c_char,
    mut iter: libc::c_int,
    mut whystop: libc::c_int,
    mut _fac: libc::c_double,
    mut _minFac: libc::c_double,
    mut _maxIter: libc::c_int,
    mut convNew: libc::c_double,
) -> SEXP {
    let mut nms: [*const libc::c_char; 6] = [
        b"isConv\x00" as *const u8 as *const libc::c_char,
        b"finIter\x00" as *const u8 as *const libc::c_char,
        b"finTol\x00" as *const u8 as *const libc::c_char,
        b"stopCode\x00" as *const u8 as *const libc::c_char,
        b"stopMessage\x00" as *const u8 as *const libc::c_char,
        b"\x00" as *const u8 as *const libc::c_char,
    ]; /* isConv */
    let mut ans: SEXP = 0 as *mut SEXPREC; /* finIter */
    ans = mkNamed(19 as libc::c_int as SEXPTYPE, nms.as_mut_ptr()); /* finTol */
    protect(ans); /* stopCode */
    SET_VECTOR_ELT(
        ans,
        0 as libc::c_int as R_xlen_t,
        ScalarLogical((whystop == 0 as libc::c_int) as libc::c_int),
    ); /* stopMessage */
    SET_VECTOR_ELT(ans, 1 as libc::c_int as R_xlen_t, ScalarInteger(iter));
    SET_VECTOR_ELT(ans, 2 as libc::c_int as R_xlen_t, ScalarReal(convNew));
    SET_VECTOR_ELT(ans, 3 as libc::c_int as R_xlen_t, ScalarInteger(whystop));
    SET_VECTOR_ELT(ans, 4 as libc::c_int as R_xlen_t, mkString(msg));
    unprotect(1 as libc::c_int);
    return ans;
}
/*
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 1997-2007   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/
 */
/*
 *  call to nls_iter from R --- .Call("nls_iter", m, control, doTrace)
 *  where m and control are nlsModel and nlsControl objects
 *             doTrace is a logical value.
 *  m is modified; the return value is a "convergence-information" list.
 */
#[no_mangle]
pub unsafe extern "C" fn nls_iter(mut m: SEXP, mut control: SEXP, mut doTraceArg: SEXP) -> SEXP {
    let mut dev: libc::c_double = 0.;
    let mut fac: libc::c_double = 0.;
    let mut minFac: libc::c_double = 0.;
    let mut tolerance: libc::c_double = 0.;
    let mut newDev: libc::c_double = 0.;
    let mut convNew: libc::c_double = -1.0f64;
    let mut i: libc::c_int = 0;
    let mut j: libc::c_int = 0;
    let mut maxIter: libc::c_int = 0;
    let mut hasConverged: libc::c_int = 0;
    let mut nPars: libc::c_int = 0;
    let mut doTrace: libc::c_int = 0;
    let mut evaltotCnt: libc::c_int = -(1 as libc::c_int);
    let mut warnOnly: libc::c_int = 0;
    let mut printEval: libc::c_int = 0;
    let mut tmp: SEXP = 0 as *mut SEXPREC;
    let mut conv: SEXP = 0 as *mut SEXPREC;
    let mut incr: SEXP = 0 as *mut SEXPREC;
    let mut deviance: SEXP = 0 as *mut SEXPREC;
    let mut setPars: SEXP = 0 as *mut SEXPREC;
    let mut getPars: SEXP = 0 as *mut SEXPREC;
    let mut pars: SEXP = 0 as *mut SEXPREC;
    let mut newPars: SEXP = 0 as *mut SEXPREC;
    let mut trace: SEXP = 0 as *mut SEXPREC;
    doTrace = asLogical(doTraceArg);
    if isNewList(control) as u64 == 0 {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"\'control\' must be a list\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    if isNewList(m) as u64 == 0 {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"\'m\' must be a list\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    tmp = getAttrib(control, R_NamesSymbol);
    protect(tmp);
    conv = getListElement(
        control,
        tmp,
        b"maxiter\x00" as *const u8 as *const libc::c_char,
    );
    if conv.is_null() || isNumeric(conv) as u64 == 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"\'%s\' absent\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"control$maxiter\x00" as *const u8 as *const libc::c_char,
        );
    }
    maxIter = asInteger(conv);
    conv = getListElement(control, tmp, b"tol\x00" as *const u8 as *const libc::c_char);
    if conv.is_null() || isNumeric(conv) as u64 == 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"\'%s\' absent\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"control$tol\x00" as *const u8 as *const libc::c_char,
        );
    }
    tolerance = asReal(conv);
    conv = getListElement(
        control,
        tmp,
        b"minFactor\x00" as *const u8 as *const libc::c_char,
    );
    if conv.is_null() || isNumeric(conv) as u64 == 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"\'%s\' absent\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"control$minFactor\x00" as *const u8 as *const libc::c_char,
        );
    }
    minFac = asReal(conv);
    conv = getListElement(
        control,
        tmp,
        b"warnOnly\x00" as *const u8 as *const libc::c_char,
    );
    if conv.is_null() || isLogical(conv) as u64 == 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"\'%s\' absent\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"control$warnOnly\x00" as *const u8 as *const libc::c_char,
        );
    }
    warnOnly = asLogical(conv);
    conv = getListElement(
        control,
        tmp,
        b"printEval\x00" as *const u8 as *const libc::c_char,
    );
    if conv.is_null() || isLogical(conv) as u64 == 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"\'%s\' absent\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"control$printEval\x00" as *const u8 as *const libc::c_char,
        );
    }
    printEval = asLogical(conv);
    /*-Wall*/
    /* now get parts from 'm' */
    tmp = getAttrib(m, R_NamesSymbol);
    conv = getListElement(m, tmp, b"conv\x00" as *const u8 as *const libc::c_char);
    if conv.is_null() || isFunction(conv) as u64 == 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"\'%s\' absent\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"m$conv()\x00" as *const u8 as *const libc::c_char,
        );
    }
    conv = lang1(conv);
    protect(conv);
    incr = getListElement(m, tmp, b"incr\x00" as *const u8 as *const libc::c_char);
    if incr.is_null() || isFunction(incr) as u64 == 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"\'%s\' absent\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"m$incr()\x00" as *const u8 as *const libc::c_char,
        );
    }
    incr = lang1(incr);
    protect(incr);
    deviance = getListElement(m, tmp, b"deviance\x00" as *const u8 as *const libc::c_char);
    if deviance.is_null() || isFunction(deviance) as u64 == 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"\'%s\' absent\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"m$deviance()\x00" as *const u8 as *const libc::c_char,
        );
    }
    deviance = lang1(deviance);
    protect(deviance);
    trace = getListElement(m, tmp, b"trace\x00" as *const u8 as *const libc::c_char);
    if trace.is_null() || isFunction(trace) as u64 == 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"\'%s\' absent\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"m$trace()\x00" as *const u8 as *const libc::c_char,
        );
    }
    trace = lang1(trace);
    protect(trace);
    setPars = getListElement(m, tmp, b"setPars\x00" as *const u8 as *const libc::c_char);
    if setPars.is_null() || isFunction(setPars) as u64 == 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"\'%s\' absent\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"m$setPars()\x00" as *const u8 as *const libc::c_char,
        );
    }
    protect(setPars);
    getPars = getListElement(m, tmp, b"getPars\x00" as *const u8 as *const libc::c_char);
    if getPars.is_null() || isFunction(getPars) as u64 == 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"\'%s\' absent\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"m$getPars()\x00" as *const u8 as *const libc::c_char,
        );
    }
    getPars = lang1(getPars);
    protect(getPars);
    pars = eval(getPars, R_GlobalEnv);
    protect(pars);
    nPars = LENGTH(pars);
    dev = asReal(eval(deviance, R_GlobalEnv));
    if doTrace != 0 {
        eval(trace, R_GlobalEnv);
    }
    fac = 1.0f64;
    hasConverged = FALSE as libc::c_int;
    newPars = allocVector(14 as libc::c_int as SEXPTYPE, nPars as R_xlen_t);
    protect(newPars);
    if printEval != 0 {
        evaltotCnt = 1 as libc::c_int
    }
    i = 0 as libc::c_int;
    while i < maxIter {
        let mut newIncr: SEXP = 0 as *mut SEXPREC;
        let mut evalCnt: libc::c_int = -(1 as libc::c_int);
        convNew = asReal(eval(conv, R_GlobalEnv));
        if convNew < tolerance {
            hasConverged = TRUE as libc::c_int;
            break;
        } else {
            newIncr = eval(incr, R_GlobalEnv);
            protect(newIncr);
            if printEval != 0 {
                evalCnt = 1 as libc::c_int
            }
            while fac >= minFac {
                if printEval != 0 {
                    Rprintf(
                        b"  It. %3d, fac= %11.6g, eval (no.,total): (%2d,%3d):\x00" as *const u8
                            as *const libc::c_char,
                        i + 1 as libc::c_int,
                        fac,
                        evalCnt,
                        evaltotCnt,
                    );
                    evalCnt += 1;
                    evaltotCnt += 1
                }
                j = 0 as libc::c_int;
                while j < nPars {
                    *REAL(newPars).offset(j as isize) =
                        *REAL(pars).offset(j as isize) + fac * *REAL(newIncr).offset(j as isize);
                    j += 1
                }
                tmp = lang2(setPars, newPars);
                protect(tmp);
                if asLogical(eval(tmp, R_GlobalEnv)) != 0 {
                    /* singular gradient */
                    unprotect(11 as libc::c_int);
                    if warnOnly != 0 {
                        warning(dcgettext(
                            b"stats\x00" as *const u8 as *const libc::c_char,
                            b"singular gradient\x00" as *const u8 as *const libc::c_char,
                            5 as libc::c_int,
                        ));
                        return ConvInfoMsg(
                            dcgettext(
                                b"stats\x00" as *const u8 as *const libc::c_char,
                                b"singular gradient\x00" as *const u8 as *const libc::c_char,
                                5 as libc::c_int,
                            ),
                            i,
                            1 as libc::c_int,
                            fac,
                            minFac,
                            maxIter,
                            convNew,
                        );
                    } else {
                        error(dcgettext(
                            b"stats\x00" as *const u8 as *const libc::c_char,
                            b"singular gradient\x00" as *const u8 as *const libc::c_char,
                            5 as libc::c_int,
                        ));
                    }
                }
                unprotect(1 as libc::c_int);
                newDev = asReal(eval(deviance, R_GlobalEnv));
                if printEval != 0 {
                    Rprintf(
                        b" new dev = %g\n\x00" as *const u8 as *const libc::c_char,
                        newDev,
                    );
                }
                if newDev <= dev {
                    dev = newDev;
                    fac = if 2 as libc::c_int as libc::c_double * fac
                        < 1 as libc::c_int as libc::c_double
                    {
                        (2 as libc::c_int as libc::c_double) * fac
                    } else {
                        1 as libc::c_int as libc::c_double
                    };
                    tmp = newPars;
                    newPars = pars;
                    pars = tmp;
                    break;
                } else {
                    fac /= 2.0f64
                }
            }
            unprotect(1 as libc::c_int);
            if fac < minFac {
                unprotect(9 as libc::c_int);
                if warnOnly != 0 {
                    let mut msgbuf: [libc::c_char; 1000] = [0; 1000];
                    warning(
                        dcgettext(
                            b"stats\x00" as *const u8 as *const libc::c_char,
                            b"step factor %g reduced below \'minFactor\' of %g\x00" as *const u8
                                as *const libc::c_char,
                            5 as libc::c_int,
                        ),
                        fac,
                        minFac,
                    );
                    snprintf(
                        msgbuf.as_mut_ptr(),
                        1000 as libc::c_int as libc::c_ulong,
                        dcgettext(
                            b"stats\x00" as *const u8 as *const libc::c_char,
                            b"step factor %g reduced below \'minFactor\' of %g\x00" as *const u8
                                as *const libc::c_char,
                            5 as libc::c_int,
                        ),
                        fac,
                        minFac,
                    );
                    return ConvInfoMsg(
                        msgbuf.as_mut_ptr(),
                        i,
                        2 as libc::c_int,
                        fac,
                        minFac,
                        maxIter,
                        convNew,
                    );
                } else {
                    error(
                        dcgettext(
                            b"stats\x00" as *const u8 as *const libc::c_char,
                            b"step factor %g reduced below \'minFactor\' of %g\x00" as *const u8
                                as *const libc::c_char,
                            5 as libc::c_int,
                        ),
                        fac,
                        minFac,
                    );
                }
            }
            if doTrace != 0 {
                eval(trace, R_GlobalEnv);
            }
            i += 1
        }
    }
    unprotect(9 as libc::c_int);
    if hasConverged == 0 {
        if warnOnly != 0 {
            let mut msgbuf_0: [libc::c_char; 1000] = [0; 1000];
            warning(
                dcgettext(
                    b"stats\x00" as *const u8 as *const libc::c_char,
                    b"number of iterations exceeded maximum of %d\x00" as *const u8
                        as *const libc::c_char,
                    5 as libc::c_int,
                ),
                maxIter,
            );
            snprintf(
                msgbuf_0.as_mut_ptr(),
                1000 as libc::c_int as libc::c_ulong,
                dcgettext(
                    b"stats\x00" as *const u8 as *const libc::c_char,
                    b"number of iterations exceeded maximum of %d\x00" as *const u8
                        as *const libc::c_char,
                    5 as libc::c_int,
                ),
                maxIter,
            );
            return ConvInfoMsg(
                msgbuf_0.as_mut_ptr(),
                i,
                3 as libc::c_int,
                fac,
                minFac,
                maxIter,
                convNew,
            );
        } else {
            error(
                dcgettext(
                    b"stats\x00" as *const u8 as *const libc::c_char,
                    b"number of iterations exceeded maximum of %d\x00" as *const u8
                        as *const libc::c_char,
                    5 as libc::c_int,
                ),
                maxIter,
            );
        }
    }
    return ConvInfoMsg(
        dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"converged\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ),
        i,
        0 as libc::c_int,
        fac,
        minFac,
        maxIter,
        convNew,
    );
}
/* else */
/*
 *  call to numeric_deriv from R -
 *  .Call("numeric_deriv", expr, theta, rho)
 *  Returns: ans
 */
#[no_mangle]
pub unsafe extern "C" fn numeric_deriv(
    mut expr: SEXP,
    mut theta: SEXP,
    mut rho: SEXP,
    mut dir: SEXP,
) -> SEXP {
    let mut ans: SEXP = 0 as *mut SEXPREC;
    let mut gradient: SEXP = 0 as *mut SEXPREC;
    let mut pars: SEXP = 0 as *mut SEXPREC;
    let mut eps: libc::c_double = sqrt(2.2204460492503131e-16f64);
    let mut rDir: *mut libc::c_double = 0 as *mut libc::c_double;
    let mut start: libc::c_int = 0;
    let mut i: libc::c_int = 0;
    let mut j: libc::c_int = 0;
    let mut k: libc::c_int = 0;
    let mut lengthTheta: libc::c_int = 0 as libc::c_int;
    if isString(theta) as u64 == 0 {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"\'theta\' should be of type character\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    if isNull(rho) as u64 != 0 {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"use of NULL environment is defunct\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    } else {
        if isEnvironment(rho) as u64 == 0 {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"\'rho\' should be an environment\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
    }
    dir = coerceVector(dir, 14 as libc::c_int as SEXPTYPE);
    protect(dir);
    if TYPEOF(dir) != 14 as libc::c_int || LENGTH(dir) != LENGTH(theta) {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"\'dir\' is not a numeric vector of the correct length\x00" as *const u8
                as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    rDir = REAL(dir);
    pars = allocVector(19 as libc::c_int as SEXPTYPE, LENGTH(theta) as R_xlen_t);
    protect(pars);
    ans = duplicate(eval(expr, rho));
    protect(ans);
    if isReal(ans) as u64 == 0 {
        let mut temp: SEXP = coerceVector(ans, 14 as libc::c_int as SEXPTYPE);
        unprotect(1 as libc::c_int);
        ans = temp;
        protect(ans);
    }
    i = 0 as libc::c_int;
    while i < LENGTH(ans) {
        if R_finite(*REAL(ans).offset(i as isize)) == 0 {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"Missing value or an infinity produced when evaluating the model\x00" as *const u8
                    as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        i += 1
    }
    let mut vmax: *const libc::c_void = vmaxget();
    i = 0 as libc::c_int;
    while i < LENGTH(theta) {
        let mut name: *const libc::c_char = translateChar(STRING_ELT(theta, i as R_xlen_t));
        let mut s_name: SEXP = install(name);
        let mut temp_0: SEXP = findVar(s_name, rho);
        if isInteger(temp_0) as u64 != 0 {
            error(
                dcgettext(
                    b"stats\x00" as *const u8 as *const libc::c_char,
                    b"variable \'%s\' is integer, not numeric\x00" as *const u8
                        as *const libc::c_char,
                    5 as libc::c_int,
                ),
                name,
            );
        }
        if isReal(temp_0) as u64 == 0 {
            error(
                dcgettext(
                    b"stats\x00" as *const u8 as *const libc::c_char,
                    b"variable \'%s\' is not numeric\x00" as *const u8 as *const libc::c_char,
                    5 as libc::c_int,
                ),
                name,
            );
        }
        if NAMED(temp_0) > 1 as libc::c_int {
            /* We'll be modifying the variable, so need to make sure it's unique PR#15849 */
            temp_0 = duplicate(temp_0);
            defineVar(s_name, temp_0, rho);
        }
        MARK_NOT_MUTABLE(temp_0);
        SET_VECTOR_ELT(pars, i as R_xlen_t, temp_0);
        lengthTheta += LENGTH(VECTOR_ELT(pars, i as R_xlen_t));
        i += 1
    }
    vmaxset(vmax);
    gradient = allocMatrix(14 as libc::c_int as SEXPTYPE, LENGTH(ans), lengthTheta);
    protect(gradient);
    i = 0 as libc::c_int;
    start = 0 as libc::c_int;
    while i < LENGTH(theta) {
        j = 0 as libc::c_int;
        while j < LENGTH(VECTOR_ELT(pars, i as R_xlen_t)) {
            let mut ans_del: SEXP = 0 as *mut SEXPREC;
            let mut origPar: libc::c_double = 0.;
            let mut xx: libc::c_double = 0.;
            let mut delta: libc::c_double = 0.;
            origPar = *REAL(VECTOR_ELT(pars, i as R_xlen_t)).offset(j as isize);
            xx = origPar.abs();
            delta = if xx == 0 as libc::c_int as libc::c_double {
                eps
            } else {
                (xx) * eps
            };
            *REAL(VECTOR_ELT(pars, i as R_xlen_t)).offset(j as isize) +=
                *rDir.offset(i as isize) * delta;
            ans_del = eval(expr, rho);
            protect(ans_del);
            if isReal(ans_del) as u64 == 0 {
                ans_del = coerceVector(ans_del, 14 as libc::c_int as SEXPTYPE)
            }
            unprotect(1 as libc::c_int);
            k = 0 as libc::c_int;
            while k < LENGTH(ans) {
                if R_finite(*REAL(ans_del).offset(k as isize)) == 0 {
                    error(dcgettext(
                        b"stats\x00" as *const u8 as *const libc::c_char,
                        b"Missing value or an infinity produced when evaluating the model\x00"
                            as *const u8 as *const libc::c_char,
                        5 as libc::c_int,
                    ));
                }
                *REAL(gradient).offset((start + k) as isize) = *rDir.offset(i as isize)
                    * (*REAL(ans_del).offset(k as isize) - *REAL(ans).offset(k as isize))
                    / delta;
                k += 1
            }
            *REAL(VECTOR_ELT(pars, i as R_xlen_t)).offset(j as isize) = origPar;
            j += 1;
            start += LENGTH(ans)
        }
        i += 1
    }
    setAttrib(
        ans,
        install(b"gradient\x00" as *const u8 as *const libc::c_char),
        gradient,
    );
    unprotect(4 as libc::c_int);
    return ans;
}