r2rs-stats 0.1.1

use crate::{
    sexprec::{SEXP, SEXPREC, SEXPREC_ALIGN, SEXPTYPE, VECSEXP},
    zeroin::R_zeroin2,
};
use ::libc;
extern "C" {
    pub type R_allocator;
    #[no_mangle]
    fn SET_STRING_ELT(x: SEXP, i: R_xlen_t, v: SEXP);
    #[no_mangle]
    fn SET_VECTOR_ELT(x: SEXP, i: R_xlen_t, v: SEXP) -> SEXP;
    #[no_mangle]
    fn ALTREP_LENGTH(x: SEXP) -> R_xlen_t;
    #[no_mangle]
    fn ALTVEC_DATAPTR(x: SEXP) -> *mut libc::c_void;
    #[no_mangle]
    fn ALTSTRING_ELT(_: SEXP, _: R_xlen_t) -> SEXP;
    #[no_mangle]
    fn R_BadLongVector(_: SEXP, _: *const libc::c_char, _: libc::c_int) -> !;
    #[no_mangle]
    fn SETCADR(x: SEXP, y: SEXP) -> SEXP;
    #[no_mangle]
    fn sqrt(_: libc::c_double) -> libc::c_double;

    /* IEEE Inf */
    #[no_mangle]
    static mut R_NegInf: 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 warning(_: *const libc::c_char, _: ...);
    #[no_mangle]
    fn R_alloc(_: size_t, _: libc::c_int) -> *mut libc::c_char;
    /*
     *  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, _: ...);
    /* Current srcref, for debuggers */
    /* Special Values */
    #[no_mangle]
    static mut R_NilValue: SEXP;
    #[no_mangle]
    static mut R_NamesSymbol: SEXP;
    #[no_mangle]
    static mut R_ClassSymbol: 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 allocVector3(_: SEXPTYPE, _: R_xlen_t, _: *mut R_allocator_t) -> SEXP;
    #[no_mangle]
    fn cons(_: SEXP, _: SEXP) -> SEXP;
    #[no_mangle]
    fn eval(_: SEXP, _: SEXP) -> SEXP;
    #[no_mangle]
    fn getAttrib(_: SEXP, _: SEXP) -> SEXP;
    #[no_mangle]
    fn install(_: *const libc::c_char) -> SEXP;
    #[no_mangle]
    fn mkChar(_: *const libc::c_char) -> SEXP;
    #[no_mangle]
    fn setAttrib(_: SEXP, _: SEXP, _: SEXP) -> SEXP;
    #[no_mangle]
    fn R_signal_protect_error() -> !;
    #[no_mangle]
    fn memcpy(_: *mut libc::c_void, _: *const libc::c_void, _: libc::c_ulong) -> *mut libc::c_void;
    #[no_mangle]
    fn strcmp(_: *const libc::c_char, _: *const libc::c_char) -> libc::c_int;
    #[no_mangle]
    static mut R_PPStackSize: libc::c_int;
    #[no_mangle]
    static mut R_PPStackTop: libc::c_int;
    #[no_mangle]
    static mut R_PPStack: *mut SEXP;
    /* INLINE_PROTECT */
    /* from dstruct.c */
    /*  length - length of objects  */
    #[no_mangle]
    fn envlength(rho: SEXP) -> libc::c_int;
    #[no_mangle]
    fn PrintDefaults();
    #[no_mangle]
    fn fdhess(
        n: libc::c_int,
        x: *mut libc::c_double,
        fval: libc::c_double,
        fun: fcn_p,
        state: *mut libc::c_void,
        h: *mut libc::c_double,
        nfd: libc::c_int,
        step: *mut libc::c_double,
        f: *mut libc::c_double,
        ndigit: libc::c_int,
        typx: *mut libc::c_double,
    );
    /* Also used in packages nlme, pcaPP */
    #[no_mangle]
    fn optif9(
        nr: libc::c_int,
        n: libc::c_int,
        x: *mut libc::c_double,
        fcn_0: fcn_p,
        d1fcn: fcn_p,
        d2fcn: d2fcn_p,
        state: *mut libc::c_void,
        typsiz: *mut libc::c_double,
        fscale: libc::c_double,
        method: libc::c_int,
        iexp: libc::c_int,
        msg: *mut libc::c_int,
        ndigit: libc::c_int,
        itnlim: libc::c_int,
        iagflg: libc::c_int,
        iahflg: libc::c_int,
        dlt: libc::c_double,
        gradtl: libc::c_double,
        stepmx: libc::c_double,
        steptl: libc::c_double,
        xpls: *mut libc::c_double,
        fpls: *mut libc::c_double,
        gpls: *mut libc::c_double,
        itrmcd: *mut libc::c_int,
        a: *mut libc::c_double,
        wrk: *mut libc::c_double,
        itncnt: *mut libc::c_int,
    );
    #[no_mangle]
    fn dcgettext(
        __domainname: *const libc::c_char,
        __msgid: *const libc::c_char,
        __category: libc::c_int,
    ) -> *mut libc::c_char;
}
pub type size_t = libc::c_ulong;
pub type ptrdiff_t = libc::c_long;
pub type R_xlen_t = ptrdiff_t;
/*
 *  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;
/*, 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_allocator_t = R_allocator;
/* For use in package stats */
/* appl/uncmin.c : */
/* type of pointer to the target and gradient functions */
pub type fcn_p = Option<
    unsafe extern "C" fn(
        _: libc::c_int,
        _: *mut libc::c_double,
        _: *mut libc::c_double,
        _: *mut libc::c_void,
    ) -> (),
>;
/* type of pointer to the hessian functions */
pub type d2fcn_p = Option<
    unsafe extern "C" fn(
        _: libc::c_int,
        _: libc::c_int,
        _: *mut libc::c_double,
        _: *mut libc::c_double,
        _: *mut libc::c_void,
    ) -> (),
>;
// Brent_fmin()
/* One Dimensional Minimization --- just wrapper for
 * Brent's "fmin" above */
#[derive(Copy, Clone)]
#[repr(C)]
pub struct callinfo {
    pub R_fcall: SEXP,
    pub R_env: SEXP,
}
#[derive(Copy, Clone)]
#[repr(C)]
pub struct function_info {
    pub R_fcall: SEXP,
    pub R_env: SEXP,
    pub have_gradient: libc::c_int,
    pub have_hessian: libc::c_int,
    pub FT_size: libc::c_int,
    pub FT_last: libc::c_int,
    pub Ftable: *mut ftable,
}
#[derive(Copy, Clone)]
#[repr(C)]
pub struct ftable {
    pub fval: libc::c_double,
    pub x: *mut libc::c_double,
    pub grad: *mut libc::c_double,
    pub hess: *mut libc::c_double,
}
/*
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
 *  Copyright (C) 1999-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/
 */
/* Internal header, not installed */
/* this header is always to be included from others.
  It is only called if COMPILING_R is defined (in util.c) or
  from GNU C systems.

  There are different conventions for inlining across compilation units.
  See http://www.greenend.org.uk/rjk/2003/03/inline.html
*/
/* Probably not able to use C99 semantics in gcc < 4.3.0 */
/* Apple's gcc build >5400 (since Xcode 3.0) doesn't support GNU inline in C99 mode */
/* This section is normally only used for versions of gcc which do not
   support C99 semantics.  __GNUC_STDC_INLINE__ is defined if
   GCC is following C99 inline semantics by default: we
   switch R's usage to the older GNU semantics via attributes.
   Do this even for __GNUC_GNUC_INLINE__ to shut up warnings in 4.2.x.
   __GNUC_STDC_INLINE__ and __GNUC_GNU_INLINE__ were added in gcc 4.2.0.
*/
/* ifdef COMPILING_R */
/* C99_INLINE_SEMANTICS */
/* for strlen, strcmp */
/* define inline-able functions */
#[inline]
unsafe extern "C" fn DATAPTR(mut x: SEXP) -> *mut libc::c_void {
    if (*x).sxpinfo.alt() != 0 {
        return ALTVEC_DATAPTR(x);
    } else {
        return (x as *mut SEXPREC_ALIGN).offset(1 as libc::c_int as isize) as *mut libc::c_void;
    };
}
#[inline]
unsafe extern "C" fn XLENGTH_EX(mut x: SEXP) -> R_xlen_t {
    return if (*x).sxpinfo.alt() as libc::c_int != 0 {
        ALTREP_LENGTH(x)
    } else {
        (*(x as VECSEXP)).vecsxp.length
    };
}
#[inline]
unsafe extern "C" fn LENGTH_EX(
    mut x: SEXP,
    mut file: *const libc::c_char,
    mut line: libc::c_int,
) -> libc::c_int {
    if x == R_NilValue {
        return 0 as libc::c_int;
    }
    let mut len: R_xlen_t = XLENGTH_EX(x);
    if len > 2147483647 as libc::c_int as libc::c_long {
        R_BadLongVector(x, file, line);
    }
    return len as libc::c_int;
}
#[inline]
unsafe extern "C" fn REAL0(mut x: SEXP) -> *mut libc::c_double {
    return (x as *mut SEXPREC_ALIGN).offset(1 as libc::c_int as isize) as *mut libc::c_void
        as *mut libc::c_double;
}
#[inline]
unsafe extern "C" fn SET_SCALAR_DVAL(mut x: SEXP, mut v: libc::c_double) {
    *REAL0(x).offset(0 as libc::c_int as isize) = v;
}
/* if not inlining use version in memory.c with more error checking */
#[inline]
unsafe extern "C" fn STRING_ELT(mut x: SEXP, mut i: R_xlen_t) -> SEXP {
    if (*x).sxpinfo.alt() != 0 {
        return ALTSTRING_ELT(x, i);
    } else {
        let mut ps: *mut SEXP = (x as *mut SEXPREC_ALIGN).offset(1 as libc::c_int as isize)
            as *mut libc::c_void as *mut SEXP;
        return *ps.offset(i as isize);
    };
}
#[inline]
unsafe extern "C" fn protect(mut s: SEXP) -> SEXP {
    if R_PPStackTop < R_PPStackSize {
        let fresh0 = R_PPStackTop;
        R_PPStackTop = R_PPStackTop + 1;
        let ref mut fresh1 = *R_PPStack.offset(fresh0 as isize);
        *fresh1 = s
    } else {
        R_signal_protect_error();
    }
    return s;
}
#[inline]
unsafe extern "C" fn unprotect(mut l: libc::c_int) {
    R_PPStackTop -= l;
}
/* TODO: a  Length(.) {say} which is  length() + dispatch (S3 + S4) if needed
         for one approach, see do_seq_along() in ../main/seq.c
*/
#[inline]
unsafe extern "C" fn length(mut s: SEXP) -> R_len_t {
    match (*s).sxpinfo.type_0() as libc::c_int {
        0 => return 0 as libc::c_int,
        10 | 13 | 14 | 15 | 16 | 9 | 19 | 20 | 24 => {
            return LENGTH_EX(
                s,
                b"../../../include/Rinlinedfuns.h\x00" as *const u8 as *const libc::c_char,
                522 as libc::c_int,
            )
        }
        2 | 6 | 17 => {
            let mut i: libc::c_int = 0 as libc::c_int;
            while !s.is_null() && s != R_NilValue {
                i += 1;
                s = (*s).u.listsxp.cdrval
            }
            return i;
        }
        4 => return envlength(s),
        _ => return 1 as libc::c_int,
    };
}
/* regular allocVector() as a special case of allocVector3() with no custom allocator */
#[inline]
unsafe extern "C" fn allocVector(mut type_0: SEXPTYPE, mut length: R_xlen_t) -> SEXP {
    return allocVector3(type_0, length, 0 as *mut R_allocator_t);
}
/* Shorthands for creating small lists */
#[inline]
unsafe extern "C" fn list1(mut s: SEXP) -> SEXP {
    return cons(s, R_NilValue);
}
/* Language based list constructs.  These are identical to the list */
/* constructs, but the results can be evaluated. */
/* Return a (language) dotted pair with the given car and cdr */
#[inline]
unsafe extern "C" fn lcons(mut car: SEXP, mut cdr: SEXP) -> SEXP {
    let mut e: SEXP = cons(car, cdr);
    (*e).sxpinfo.set_type_0(6 as libc::c_int as SEXPTYPE);
    return e;
}
#[inline]
unsafe extern "C" fn lang2(mut s: SEXP, mut t: SEXP) -> SEXP {
    protect(s);
    s = lcons(s, list1(t));
    unprotect(1 as libc::c_int);
    return s;
}
/* NOTE: R's inherits() is based on inherits3() in ../main/objects.c
 * Here, use char / CHAR() instead of the slower more general translateChar()
 */
#[inline]
unsafe extern "C" fn inherits(mut s: SEXP, mut name: *const libc::c_char) -> Rboolean {
    let mut klass: SEXP = 0 as *mut SEXPREC;
    let mut i: libc::c_int = 0;
    let mut nclass: libc::c_int = 0;
    if (*s).sxpinfo.obj() != 0 {
        klass = getAttrib(s, R_ClassSymbol);
        nclass = length(klass);
        i = 0 as libc::c_int;
        while i < nclass {
            if strcmp(
                (STRING_ELT(klass, i as R_xlen_t) as *mut SEXPREC_ALIGN)
                    .offset(1 as libc::c_int as isize) as *mut libc::c_void
                    as *const libc::c_char,
                name,
            ) == 0
            {
                return TRUE;
            }
            i += 1
        }
    }
    return FALSE;
}
#[inline]
unsafe extern "C" fn isFunction(mut s: SEXP) -> Rboolean {
    return ((*s).sxpinfo.type_0() as libc::c_int == 3 as libc::c_int
        || (*s).sxpinfo.type_0() as libc::c_int == 8 as libc::c_int
        || (*s).sxpinfo.type_0() as libc::c_int == 7 as libc::c_int) as libc::c_int
        as Rboolean;
}
#[inline]
unsafe extern "C" fn isInteger(mut s: SEXP) -> Rboolean {
    return ((*s).sxpinfo.type_0() as libc::c_int == 13 as libc::c_int
        && inherits(s, b"factor\x00" as *const u8 as *const libc::c_char) as u64 == 0)
        as libc::c_int as Rboolean;
}
/* Is an object of numeric type. */
/* FIXME:  the LGLSXP case should be excluded here
 * (really? in many places we affirm they are treated like INTs)*/
#[inline]
unsafe extern "C" fn isNumeric(mut s: SEXP) -> Rboolean {
    match (*s).sxpinfo.type_0() as libc::c_int {
        13 => {
            if inherits(s, b"factor\x00" as *const u8 as *const libc::c_char) as u64 != 0 {
                return FALSE;
            }
        }
        10 | 14 => {}
        _ => return FALSE,
    }
    return TRUE;
}
#[inline]
unsafe extern "C" fn ScalarReal(mut x: libc::c_double) -> SEXP {
    let mut ans: SEXP = allocVector(14 as libc::c_int as SEXPTYPE, 1 as libc::c_int as R_xlen_t);
    SET_SCALAR_DVAL(ans, x);
    return ans;
}
/*
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
 *  Copyright (C) 2003-2004  The R Foundation
 *  Copyright (C) 1998--2014  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/
 */
/* for DBL_MAX */
/* for Memcpy */
/* Formerly in src/appl/fmim.c */
/* fmin.f -- translated by f2c (version 19990503).
*/
/* R's  optimize() :   function fmin(ax,bx,f,tol)
   =    ==========  ~~~~~~~~~~~~~~~~~

        an approximation  x  to the point where  f  attains a minimum  on
    the interval  (ax,bx)  is determined.

    INPUT..

    ax    left endpoint of initial interval
    bx    right endpoint of initial interval
    f     function which evaluates  f(x, info)  for any  x
          in the interval  (ax,bx)
    tol   desired length of the interval of uncertainty of the final
          result ( >= 0.)

    OUTPUT..

    fmin  abcissa approximating the point where  f  attains a minimum

        The method used is a combination of  golden  section  search  and
    successive parabolic interpolation.  convergence is never much slower
    than  that  for  a  Fibonacci search.  If  f  has a continuous second
    derivative which is positive at the minimum (which is not  at  ax  or
    bx),  then  convergence  is  superlinear, and usually of the order of
    about  1.324....
        The function  f  is never evaluated at two points closer together
    than  eps*abs(fmin)+(tol/3), where eps is  approximately  the  square
    root  of  the  relative  machine  precision.   if   f   is a unimodal
    function and the computed values of   f   are  always  unimodal  when
    separated  by  at least  eps*abs(x)+(tol/3), then  fmin  approximates
    the abcissa of the global minimum of  f  on the interval  ax,bx  with
    an error less than  3*eps*abs(fmin)+tol.  if   f   is  not  unimodal,
    then fmin may approximate a local, but perhaps non-global, minimum to
    the same accuracy.
        This function subprogram is a slightly modified  version  of  the
    Algol  60 procedure  localmin  given in Richard Brent, Algorithms for
    Minimization without Derivatives, Prentice-Hall, Inc. (1973).
*/
/* DBL_EPSILON */
unsafe extern "C" fn Brent_fmin(
    mut ax: libc::c_double,
    mut bx: libc::c_double,
    mut f: Option<unsafe extern "C" fn(_: libc::c_double, _: *mut libc::c_void) -> libc::c_double>,
    mut info: *mut libc::c_void,
    mut tol: libc::c_double,
) -> libc::c_double {
    /*  c is the squared inverse of the golden ratio */
    let c: libc::c_double = (3.0f64 - sqrt(5.0f64)) * 0.5f64;
    /* Local variables */
    let mut a: libc::c_double = 0.;
    let mut b: libc::c_double = 0.;
    let mut d: libc::c_double = 0.;
    let mut e: libc::c_double = 0.;
    let mut p: libc::c_double = 0.;
    let mut q: libc::c_double = 0.;
    let mut r: libc::c_double = 0.;
    let mut u: libc::c_double = 0.;
    let mut v: libc::c_double = 0.;
    let mut w: libc::c_double = 0.;
    let mut x: libc::c_double = 0.;
    let mut t2: libc::c_double = 0.;
    let mut fu: libc::c_double = 0.;
    let mut fv: libc::c_double = 0.;
    let mut fw: libc::c_double = 0.;
    let mut fx: libc::c_double = 0.;
    let mut xm: libc::c_double = 0.;
    let mut eps: libc::c_double = 0.;
    let mut tol1: libc::c_double = 0.;
    let mut tol3: libc::c_double = 0.;
    /*  eps is approximately the square root of the relative machine precision. */
    eps = 2.2204460492503131e-16f64; /* the smallest 1.000... > 1 */
    tol1 = eps + 1.0f64; /* -Wall */
    eps = sqrt(eps);
    a = ax;
    b = bx;
    v = a + c * (b - a);
    w = v;
    x = v;
    d = 0.0f64;
    e = 0.0f64;
    fx = Some(f.expect("non-null function pointer")).expect("non-null function pointer")(x, info);
    fv = fx;
    fw = fx;
    tol3 = tol / 3.0f64;
    loop
    /*  main loop starts here ----------------------------------- */
    {
        xm = (a + b) * 0.5f64;
        tol1 = eps * x.abs() + tol3;
        t2 = tol1 * 2.0f64;
        /* check stopping criterion */
        if (x - xm).abs() <= t2 - (b - a) * 0.5f64 {
            break;
        }
        p = 0.0f64;
        q = 0.0f64;
        r = 0.0f64;
        if e.abs() > tol1 {
            /* fit parabola */
            r = (x - w) * (fx - fv);
            q = (x - v) * (fx - fw);
            p = (x - v) * q - (x - w) * r;
            q = (q - r) * 2.0f64;
            if q > 0.0f64 {
                p = -p
            } else {
                q = -q
            }
            r = e;
            e = d
        }
        if p.abs() >= (q * 0.5f64 * r).abs() || p <= q * (a - x) || p >= q * (b - x) {
            /* a golden-section step */
            if x < xm {
                e = b - x
            } else {
                e = a - x
            }
            d = c * e
        } else {
            /* a parabolic-interpolation step */
            d = p / q;
            u = x + d;
            /* f must not be evaluated too close to ax or bx */
            if u - a < t2 || b - u < t2 {
                d = tol1;
                if x >= xm {
                    d = -d
                }
            }
        }
        /* f must not be evaluated too close to x */
        if d.abs() >= tol1 {
            u = x + d
        } else if d > 0.0f64 {
            u = x + tol1
        } else {
            u = x - tol1
        }
        fu = Some(f.expect("non-null function pointer")).expect("non-null function pointer")(
            u, info,
        );
        /*  update  a, b, v, w, and x */
        if fu <= fx {
            if u < x {
                b = x
            } else {
                a = x
            }
            v = w;
            w = x;
            x = u;
            fv = fw;
            fw = fx;
            fx = fu
        } else {
            if u < x {
                a = u
            } else {
                b = u
            }
            if fu <= fw || w == x {
                v = w;
                fv = fw;
                w = u;
                fw = fu
            } else if fu <= fv || v == x || v == w {
                v = u;
                fv = fu
            }
        }
    }
    /* end of main loop */
    return x;
}
/*static SEXP R_fcall1;
static SEXP R_env1; */
unsafe extern "C" fn fcn1(mut x: libc::c_double, mut info: *mut callinfo) -> libc::c_double {
    let mut s: SEXP = 0 as *mut SEXPREC;
    let mut sx: SEXP = 0 as *mut SEXPREC;
    sx = ScalarReal(x);
    protect(sx);
    SETCADR((*info).R_fcall, sx);
    s = eval((*info).R_fcall, (*info).R_env);
    unprotect(1 as libc::c_int);
    match (*s).sxpinfo.type_0() as libc::c_int {
        13 => {
            if !(length(s) != 1 as libc::c_int) {
                if *(DATAPTR(s) as *mut libc::c_int).offset(0 as libc::c_int as isize) == R_NaInt {
                    warning(dcgettext(
                        b"stats\x00" as *const u8 as *const libc::c_char,
                        b"NA replaced by maximum positive value\x00" as *const u8
                            as *const libc::c_char,
                        5 as libc::c_int,
                    ));
                    return 1.7976931348623157e+308f64;
                } else {
                    return *(DATAPTR(s) as *mut libc::c_int).offset(0 as libc::c_int as isize)
                        as libc::c_double;
                }
            }
        }
        14 => {
            if !(length(s) != 1 as libc::c_int) {
                if (*(DATAPTR(s) as *mut libc::c_double).offset(0 as libc::c_int as isize))
                    .is_finite() as i32
                    == 0
                {
                    warning(dcgettext(
                        b"stats\x00" as *const u8 as *const libc::c_char,
                        b"NA/Inf replaced by maximum positive value\x00" as *const u8
                            as *const libc::c_char,
                        5 as libc::c_int,
                    ));
                    return 1.7976931348623157e+308f64;
                } else {
                    return *(DATAPTR(s) as *mut libc::c_double).offset(0 as libc::c_int as isize);
                }
            }
        }
        _ => {}
    }
    error(dcgettext(
        b"stats\x00" as *const u8 as *const libc::c_char,
        b"invalid function value in \'optimize\'\x00" as *const u8 as *const libc::c_char,
        5 as libc::c_int,
    ));
    /* for -Wall */
}
/* fmin(f, xmin, xmax tol) */
#[no_mangle]
pub unsafe extern "C" fn do_fmin(
    mut _call: SEXP,
    mut _op: SEXP,
    mut args: SEXP,
    mut rho: SEXP,
) -> SEXP {
    let mut xmin: libc::c_double = 0.;
    let mut xmax: libc::c_double = 0.;
    let mut tol: libc::c_double = 0.;
    let mut v: SEXP = 0 as *mut SEXPREC;
    let mut res: SEXP = 0 as *mut SEXPREC;
    let mut info: callinfo = callinfo {
        R_fcall: 0 as *mut SEXPREC,
        R_env: 0 as *mut SEXPREC,
    };
    args = (*args).u.listsxp.cdrval;
    PrintDefaults();
    /* the function to be minimized */
    v = (*args).u.listsxp.carval;
    if isFunction(v) as u64 == 0 {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"attempt to minimize non-function\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    args = (*args).u.listsxp.cdrval;
    /* xmin */
    xmin = asReal((*args).u.listsxp.carval);
    if xmin.is_finite() as i32 == 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"invalid \'%s\' value\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"xmin\x00" as *const u8 as *const libc::c_char,
        );
    }
    args = (*args).u.listsxp.cdrval;
    /* xmax */
    xmax = asReal((*args).u.listsxp.carval);
    if xmax.is_finite() as i32 == 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"invalid \'%s\' value\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"xmax\x00" as *const u8 as *const libc::c_char,
        );
    }
    if xmin >= xmax {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"\'xmin\' not less than \'xmax\'\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    args = (*args).u.listsxp.cdrval;
    /* tol */
    tol = asReal((*args).u.listsxp.carval);
    if tol.is_finite() as i32 == 0 || tol <= 0.0f64 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"invalid \'%s\' value\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"tol\x00" as *const u8 as *const libc::c_char,
        );
    }
    info.R_env = rho;
    info.R_fcall = lang2(v, R_NilValue);
    protect(info.R_fcall);
    res = allocVector(14 as libc::c_int as SEXPTYPE, 1 as libc::c_int as R_xlen_t);
    protect(res);
    *(DATAPTR(res) as *mut libc::c_double).offset(0 as libc::c_int as isize) = Brent_fmin(
        xmin,
        xmax,
        ::std::mem::transmute::<
            Option<unsafe extern "C" fn(_: libc::c_double, _: *mut callinfo) -> libc::c_double>,
            Option<unsafe extern "C" fn(_: libc::c_double, _: *mut libc::c_void) -> libc::c_double>,
        >(Some(
            fcn1 as unsafe extern "C" fn(_: libc::c_double, _: *mut callinfo) -> libc::c_double,
        )),
        &mut info as *mut callinfo as *mut libc::c_void,
        tol,
    );
    unprotect(2 as libc::c_int);
    return res;
}
// One Dimensional Root Finding --  just wrapper code for
// Brent's "zeroin"
// ---------------
unsafe extern "C" fn fcn2(mut x: libc::c_double, mut info: *mut callinfo) -> libc::c_double {
    let mut s: SEXP = 0 as *mut SEXPREC;
    let mut sx: SEXP = 0 as *mut SEXPREC;
    sx = ScalarReal(x);
    protect(sx);
    SETCADR((*info).R_fcall, sx);
    s = eval((*info).R_fcall, (*info).R_env);
    unprotect(1 as libc::c_int);
    match (*s).sxpinfo.type_0() as libc::c_int {
        13 => {
            if !(length(s) != 1 as libc::c_int) {
                if *(DATAPTR(s) as *mut libc::c_int).offset(0 as libc::c_int as isize) == R_NaInt {
                    warning(dcgettext(
                        b"stats\x00" as *const u8 as *const libc::c_char,
                        b"NA replaced by maximum positive value\x00" as *const u8
                            as *const libc::c_char,
                        5 as libc::c_int,
                    ));
                    return 1.7976931348623157e+308f64;
                } else {
                    return *(DATAPTR(s) as *mut libc::c_int).offset(0 as libc::c_int as isize)
                        as libc::c_double;
                }
            }
        }
        14 => {
            if !(length(s) != 1 as libc::c_int) {
                if (*(DATAPTR(s) as *mut libc::c_double).offset(0 as libc::c_int as isize))
                    .is_finite() as i32
                    == 0
                {
                    if *(DATAPTR(s) as *mut libc::c_double).offset(0 as libc::c_int as isize)
                        == R_NegInf
                    {
                        // keep sign for root finding !
                        warning(dcgettext(
                            b"stats\x00" as *const u8 as *const libc::c_char,
                            b"-Inf replaced by maximally negative value\x00" as *const u8
                                as *const libc::c_char,
                            5 as libc::c_int,
                        ));
                        return -1.7976931348623157e+308f64;
                    } else {
                        warning(dcgettext(
                            b"stats\x00" as *const u8 as *const libc::c_char,
                            b"NA/Inf replaced by maximum positive value\x00" as *const u8
                                as *const libc::c_char,
                            5 as libc::c_int,
                        ));
                        return 1.7976931348623157e+308f64;
                    }
                } else {
                    return *(DATAPTR(s) as *mut libc::c_double).offset(0 as libc::c_int as isize);
                }
            }
        }
        _ => {}
    }
    error(dcgettext(
        b"stats\x00" as *const u8 as *const libc::c_char,
        b"invalid function value in \'zeroin\'\x00" as *const u8 as *const libc::c_char,
        5 as libc::c_int,
    ));
    /* for -Wall */
}
/* zeroin2(f, ax, bx, f.ax, f.bx, tol, maxiter) */
#[no_mangle]
pub unsafe extern "C" fn zeroin2(
    mut _call: SEXP,
    mut _op: SEXP,
    mut args: SEXP,
    mut rho: SEXP,
) -> SEXP {
    let mut f_ax: libc::c_double = 0.;
    let mut f_bx: libc::c_double = 0.;
    let mut xmin: libc::c_double = 0.;
    let mut xmax: libc::c_double = 0.;
    let mut tol: libc::c_double = 0.;
    let mut iter: libc::c_int = 0;
    let mut v: SEXP = 0 as *mut SEXPREC;
    let mut res: SEXP = 0 as *mut SEXPREC;
    let mut info: callinfo = callinfo {
        R_fcall: 0 as *mut SEXPREC,
        R_env: 0 as *mut SEXPREC,
    };
    args = (*args).u.listsxp.cdrval;
    PrintDefaults();
    /* the function to be minimized */
    v = (*args).u.listsxp.carval;
    if isFunction(v) as u64 == 0 {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"attempt to minimize non-function\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    args = (*args).u.listsxp.cdrval;
    /* xmin */
    xmin = asReal((*args).u.listsxp.carval);
    if xmin.is_finite() as i32 == 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"invalid \'%s\' value\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"xmin\x00" as *const u8 as *const libc::c_char,
        );
    }
    args = (*args).u.listsxp.cdrval;
    /* xmax */
    xmax = asReal((*args).u.listsxp.carval);
    if xmax.is_finite() as i32 == 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"invalid \'%s\' value\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"xmax\x00" as *const u8 as *const libc::c_char,
        );
    }
    if xmin >= xmax {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"\'xmin\' not less than \'xmax\'\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    args = (*args).u.listsxp.cdrval;
    /* f(ax) = f(xmin) */
    f_ax = asReal((*args).u.listsxp.carval);
    if R_IsNA(f_ax) != 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"NA value for \'%s\' is not allowed\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"f.lower\x00" as *const u8 as *const libc::c_char,
        );
    }
    args = (*args).u.listsxp.cdrval;
    /* f(bx) = f(xmax) */
    f_bx = asReal((*args).u.listsxp.carval);
    if R_IsNA(f_bx) != 0 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"NA value for \'%s\' is not allowed\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"f.upper\x00" as *const u8 as *const libc::c_char,
        );
    }
    args = (*args).u.listsxp.cdrval;
    /* tol */
    tol = asReal((*args).u.listsxp.carval);
    if tol.is_finite() as i32 == 0 || tol <= 0.0f64 {
        error(
            dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"invalid \'%s\' value\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ),
            b"tol\x00" as *const u8 as *const libc::c_char,
        );
    }
    args = (*args).u.listsxp.cdrval;
    /* maxiter */
    iter = asInteger((*args).u.listsxp.carval); /* the info used in fcn2() */
    if iter <= 0 as libc::c_int {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"\'maxiter\' must be positive\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    info.R_env = rho;
    info.R_fcall = lang2(v, R_NilValue);
    protect(info.R_fcall);
    res = allocVector(14 as libc::c_int as SEXPTYPE, 3 as libc::c_int as R_xlen_t);
    protect(res);
    *(DATAPTR(res) as *mut libc::c_double).offset(0 as libc::c_int as isize) = R_zeroin2(
        xmin,
        xmax,
        f_ax,
        f_bx,
        ::std::mem::transmute::<
            Option<unsafe extern "C" fn(_: libc::c_double, _: *mut callinfo) -> libc::c_double>,
            Option<unsafe extern "C" fn(_: libc::c_double, _: *mut libc::c_void) -> libc::c_double>,
        >(Some(
            fcn2 as unsafe extern "C" fn(_: libc::c_double, _: *mut callinfo) -> libc::c_double,
        )),
        &mut info as *mut callinfo as *mut libc::c_void,
        &mut tol,
        &mut iter,
    );
    *(DATAPTR(res) as *mut libc::c_double).offset(1 as libc::c_int as isize) =
        iter as libc::c_double;
    *(DATAPTR(res) as *mut libc::c_double).offset(2 as libc::c_int as isize) = tol;
    unprotect(2 as libc::c_int);
    return res;
}
/* Initialize the storage in the table of computed function values */
unsafe extern "C" fn FT_init(
    mut n: libc::c_int,
    mut FT_size: libc::c_int,
    mut state: *mut function_info,
) {
    let mut i: libc::c_int = 0;
    let mut j: libc::c_int = 0;
    let mut have_gradient: libc::c_int = 0;
    let mut have_hessian: libc::c_int = 0;
    let mut Ftable: *mut ftable = 0 as *mut ftable;
    have_gradient = (*state).have_gradient;
    have_hessian = (*state).have_hessian;
    Ftable = R_alloc(
        FT_size as size_t,
        ::std::mem::size_of::<ftable>() as libc::c_ulong as libc::c_int,
    ) as *mut ftable;
    i = 0 as libc::c_int;
    while i < FT_size {
        let ref mut fresh2 = (*Ftable.offset(i as isize)).x;
        *fresh2 = R_alloc(
            n as size_t,
            ::std::mem::size_of::<libc::c_double>() as libc::c_ulong as libc::c_int,
        ) as *mut libc::c_double;
        /* initialize to unlikely parameter values */
        j = 0 as libc::c_int;
        while j < n {
            *(*Ftable.offset(i as isize)).x.offset(j as isize) = 1.7976931348623157e+308f64;
            j += 1
        }
        if have_gradient != 0 {
            let ref mut fresh3 = (*Ftable.offset(i as isize)).grad;
            *fresh3 = R_alloc(
                n as size_t,
                ::std::mem::size_of::<libc::c_double>() as libc::c_ulong as libc::c_int,
            ) as *mut libc::c_double;
            if have_hessian != 0 {
                let ref mut fresh4 = (*Ftable.offset(i as isize)).hess;
                *fresh4 = R_alloc(
                    (n * n) as size_t,
                    ::std::mem::size_of::<libc::c_double>() as libc::c_ulong as libc::c_int,
                ) as *mut libc::c_double
            }
        }
        i += 1
    }
    (*state).Ftable = Ftable;
    (*state).FT_size = FT_size;
    (*state).FT_last = -(1 as libc::c_int);
}
/* Store an entry in the table of computed function values */
unsafe extern "C" fn FT_store(
    mut n: libc::c_int,
    f: libc::c_double,
    mut x: *const libc::c_double,
    mut grad: *const libc::c_double,
    mut hess: *const libc::c_double,
    mut state: *mut function_info,
) {
    let mut ind: libc::c_int = 0;
    (*state).FT_last += 1;
    ind = (*state).FT_last % (*state).FT_size;
    (*(*state).Ftable.offset(ind as isize)).fval = f;
    memcpy(
        (*(*state).Ftable.offset(ind as isize)).x as *mut libc::c_void,
        x as *const libc::c_void,
        (n as size_t).wrapping_mul(::std::mem::size_of::<libc::c_double>() as libc::c_ulong),
    );
    if !grad.is_null() {
        memcpy(
            (*(*state).Ftable.offset(ind as isize)).grad as *mut libc::c_void,
            grad as *const libc::c_void,
            (n as size_t).wrapping_mul(::std::mem::size_of::<libc::c_double>() as libc::c_ulong),
        );
        if !hess.is_null() {
            memcpy(
                (*(*state).Ftable.offset(ind as isize)).hess as *mut libc::c_void,
                hess as *const libc::c_void,
                ((n * n) as size_t)
                    .wrapping_mul(::std::mem::size_of::<libc::c_double>() as libc::c_ulong),
            );
        }
    };
}
/* Check for stored values in the table of computed function values.
Returns the index in the table or -1 for failure */
unsafe extern "C" fn FT_lookup(
    mut n: libc::c_int,
    mut x: *const libc::c_double,
    mut state: *mut function_info,
) -> libc::c_int {
    let mut ftx: *mut libc::c_double = 0 as *mut libc::c_double;
    let mut i: libc::c_int = 0;
    let mut j: libc::c_int = 0;
    let mut ind: libc::c_int = 0;
    let mut matched: libc::c_int = 0;
    let mut FT_size: libc::c_int = 0;
    let mut FT_last: libc::c_int = 0;
    let mut Ftable: *mut ftable = 0 as *mut ftable;
    FT_last = (*state).FT_last;
    FT_size = (*state).FT_size;
    Ftable = (*state).Ftable;
    i = 0 as libc::c_int;
    while i < FT_size {
        ind = (FT_last - i) % FT_size;
        /* why can't they define modulus correctly */
        if ind < 0 as libc::c_int {
            ind += FT_size
        }
        ftx = (*Ftable.offset(ind as isize)).x;
        if !ftx.is_null() {
            matched = 1 as libc::c_int;
            j = 0 as libc::c_int;
            while j < n {
                if *x.offset(j as isize) != *ftx.offset(j as isize) {
                    matched = 0 as libc::c_int;
                    break;
                } else {
                    j += 1
                }
            }
            if matched != 0 {
                return ind;
            }
        }
        i += 1
    }
    return -(1 as libc::c_int);
}
/* This how the optimizer sees them */
unsafe extern "C" fn fcn(
    mut n: libc::c_int,
    mut x: *const libc::c_double,
    mut f: *mut libc::c_double,
    mut state: *mut function_info,
) {
    let mut current_block: u64;
    let mut s: SEXP = 0 as *mut SEXPREC;
    let mut R_fcall: SEXP = 0 as *mut SEXPREC;
    let mut Ftable: *mut ftable = 0 as *mut ftable;
    let mut g: *mut libc::c_double = 0 as *mut libc::c_double;
    let mut h: *mut libc::c_double = 0 as *mut libc::c_double;
    let mut i: libc::c_int = 0;
    R_fcall = (*state).R_fcall;
    Ftable = (*state).Ftable;
    i = FT_lookup(n, x, state);
    if i >= 0 as libc::c_int {
        *f = (*Ftable.offset(i as isize)).fval;
        return;
    }
    /* calculate for a new value of x */
    s = allocVector(14 as libc::c_int as SEXPTYPE, n as R_xlen_t);
    SETCADR(R_fcall, s);
    i = 0 as libc::c_int;
    while i < n {
        if (*x.offset(i as isize)).is_finite() as i32 == 0 {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"non-finite value supplied by \'nlm\'\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        *(DATAPTR(s) as *mut libc::c_double).offset(i as isize) = *x.offset(i as isize);
        i += 1
    }
    s = protect(eval((*state).R_fcall, (*state).R_env));
    match (*s).sxpinfo.type_0() as libc::c_int {
        13 => {
            if length(s) != 1 as libc::c_int {
                current_block = 11860839946601367817;
            } else {
                if *(DATAPTR(s) as *mut libc::c_int).offset(0 as libc::c_int as isize) == R_NaInt {
                    warning(dcgettext(
                        b"stats\x00" as *const u8 as *const libc::c_char,
                        b"NA replaced by maximum positive value\x00" as *const u8
                            as *const libc::c_char,
                        5 as libc::c_int,
                    ));
                    *f = 1.7976931348623157e+308f64
                } else {
                    *f = *(DATAPTR(s) as *mut libc::c_int).offset(0 as libc::c_int as isize)
                        as libc::c_double
                }
                current_block = 5689316957504528238;
            }
        }
        14 => {
            if length(s) != 1 as libc::c_int {
                current_block = 11860839946601367817;
            } else {
                if (*(DATAPTR(s) as *mut libc::c_double).offset(0 as libc::c_int as isize))
                    .is_finite() as i32
                    == 0
                {
                    warning(dcgettext(
                        b"stats\x00" as *const u8 as *const libc::c_char,
                        b"NA/Inf replaced by maximum positive value\x00" as *const u8
                            as *const libc::c_char,
                        5 as libc::c_int,
                    ));
                    *f = 1.7976931348623157e+308f64
                } else {
                    *f = *(DATAPTR(s) as *mut libc::c_double).offset(0 as libc::c_int as isize)
                }
                current_block = 5689316957504528238;
            }
        }
        _ => {
            current_block = 11860839946601367817;
        }
    }
    match current_block {
        11860839946601367817 => {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"invalid function value in \'nlm\' optimizer\x00" as *const u8
                    as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        _ => {
            if (*state).have_gradient != 0 {
                g = DATAPTR(protect(coerceVector(
                    getAttrib(
                        s,
                        install(b"gradient\x00" as *const u8 as *const libc::c_char),
                    ),
                    14 as libc::c_int as SEXPTYPE,
                ))) as *mut libc::c_double;
                if (*state).have_hessian != 0 {
                    h = DATAPTR(protect(coerceVector(
                        getAttrib(
                            s,
                            install(b"hessian\x00" as *const u8 as *const libc::c_char),
                        ),
                        14 as libc::c_int as SEXPTYPE,
                    ))) as *mut libc::c_double
                }
            }
            FT_store(n, *f, x, g, h, state);
            unprotect(1 as libc::c_int + (*state).have_gradient + (*state).have_hessian);
            return;
        }
    };
}
unsafe extern "C" fn Cd1fcn(
    mut n: libc::c_int,
    mut x: *const libc::c_double,
    mut g: *mut libc::c_double,
    mut state: *mut function_info,
) {
    let mut ind: libc::c_int = 0;
    ind = FT_lookup(n, x, state);
    if ind < 0 as libc::c_int {
        /* shouldn't happen */
        fcn(n, x, g, state);
        ind = FT_lookup(n, x, state);
        if ind < 0 as libc::c_int {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"function value caching for optimization is seriously confused\x00" as *const u8
                    as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
    }
    memcpy(
        g as *mut libc::c_void,
        (*(*state).Ftable.offset(ind as isize)).grad as *const libc::c_void,
        (n as size_t).wrapping_mul(::std::mem::size_of::<libc::c_double>() as libc::c_ulong),
    );
}
unsafe extern "C" fn Cd2fcn(
    mut _nr: libc::c_int,
    mut n: libc::c_int,
    mut x: *const libc::c_double,
    mut h: *mut libc::c_double,
    mut state: *mut function_info,
) {
    let mut j: libc::c_int = 0;
    let mut ind: libc::c_int = 0;
    ind = FT_lookup(n, x, state);
    if ind < 0 as libc::c_int {
        /* shouldn't happen */
        fcn(n, x, h, state);
        ind = FT_lookup(n, x, state);
        if ind < 0 as libc::c_int {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"function value caching for optimization is seriously confused\x00" as *const u8
                    as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
    }
    j = 0 as libc::c_int;
    while j < n {
        /* fill in lower triangle only */
        memcpy(
            h.offset((j * (n + 1 as libc::c_int)) as isize) as *mut libc::c_void,
            (*(*state).Ftable.offset(ind as isize))
                .hess
                .offset((j * (n + 1 as libc::c_int)) as isize) as *const libc::c_void,
            ((n - j) as size_t)
                .wrapping_mul(::std::mem::size_of::<libc::c_double>() as libc::c_ulong),
        );
        j += 1
    }
}
unsafe extern "C" fn fixparam(mut p: SEXP, mut n: *mut libc::c_int) -> *mut libc::c_double {
    let mut x: *mut libc::c_double = 0 as *mut libc::c_double;
    let mut i: libc::c_int = 0;
    if isNumeric(p) as u64 == 0 {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"numeric parameter expected\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    if *n != 0 {
        if LENGTH_EX(
            p,
            b"optimize.c\x00" as *const u8 as *const libc::c_char,
            599 as libc::c_int,
        ) != *n
        {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"conflicting parameter lengths\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
    } else {
        if LENGTH_EX(
            p,
            b"optimize.c\x00" as *const u8 as *const libc::c_char,
            603 as libc::c_int,
        ) <= 0 as libc::c_int
        {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"invalid parameter length\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        *n = LENGTH_EX(
            p,
            b"optimize.c\x00" as *const u8 as *const libc::c_char,
            605 as libc::c_int,
        )
    }
    x = R_alloc(
        *n as size_t,
        ::std::mem::size_of::<libc::c_double>() as libc::c_ulong as libc::c_int,
    ) as *mut libc::c_double;
    match (*p).sxpinfo.type_0() as libc::c_int {
        10 | 13 => {
            i = 0 as libc::c_int;
            while i < *n {
                if *(DATAPTR(p) as *mut libc::c_int).offset(i as isize) == R_NaInt {
                    error(dcgettext(
                        b"stats\x00" as *const u8 as *const libc::c_char,
                        b"missing value in parameter\x00" as *const u8 as *const libc::c_char,
                        5 as libc::c_int,
                    ));
                }
                *x.offset(i as isize) =
                    *(DATAPTR(p) as *mut libc::c_int).offset(i as isize) as libc::c_double;
                i += 1
            }
        }
        14 => {
            i = 0 as libc::c_int;
            while i < *n {
                if (*(DATAPTR(p) as *mut libc::c_double).offset(i as isize)).is_finite() as i32 == 0
                {
                    error(dcgettext(
                        b"stats\x00" as *const u8 as *const libc::c_char,
                        b"missing value in parameter\x00" as *const u8 as *const libc::c_char,
                        5 as libc::c_int,
                    ));
                }
                *x.offset(i as isize) = *(DATAPTR(p) as *mut libc::c_double).offset(i as isize);
                i += 1
            }
        }
        _ => {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"invalid parameter type\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
    }
    return x;
}
/* Fatal errors - we don't deliver an answer */
unsafe extern "C" fn opterror(mut nerr: libc::c_int) -> ! {
    match nerr {
        -1 => {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"non-positive number of parameters in nlm\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        -2 => {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"nlm is inefficient for 1-d problems\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        -3 => {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"invalid gradient tolerance in nlm\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        -4 => {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"invalid iteration limit in nlm\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        -5 => {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"minimization function has no good digits in nlm\x00" as *const u8
                    as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        -6 => {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"no analytic gradient to check in nlm!\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        -7 => {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"no analytic Hessian to check in nlm!\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        -21 => {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"probable coding error in analytic gradient\x00" as *const u8
                    as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        -22 => {
            error(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"probable coding error in analytic Hessian\x00" as *const u8
                    as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        _ => {
            error(
                dcgettext(
                    b"stats\x00" as *const u8 as *const libc::c_char,
                    b"*** unknown error message (msg = %d) in nlm()\n*** should not happen!\x00"
                        as *const u8 as *const libc::c_char,
                    5 as libc::c_int,
                ),
                nerr,
            );
        }
    };
}
/* Warnings - we return a value, but print a warning */
unsafe extern "C" fn optcode(mut code: libc::c_int) {
    match code {
        1 => {
            Rprintf(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"Relative gradient close to zero.\n\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
            Rprintf(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"Current iterate is probably solution.\n\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        2 => {
            Rprintf(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"Successive iterates within tolerance.\n\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
            Rprintf(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"Current iterate is probably solution.\n\x00" as *const u8 as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        3 => {
            Rprintf(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"Last global step failed to locate a point lower than x.\n\x00" as *const u8
                    as *const libc::c_char,
                5 as libc::c_int,
            ));
            Rprintf(dcgettext(b"stats\x00" as *const u8 as
                                  *const libc::c_char,
                              b"Either x is an approximate local minimum of the function,\nthe function is too non-linear for this algorithm,\nor steptol is too large.\n\x00"
                                  as *const u8 as *const libc::c_char,
                              5 as libc::c_int));
        }
        4 => {
            Rprintf(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"Iteration limit exceeded.  Algorithm failed.\n\x00" as *const u8
                    as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
        5 => {
            Rprintf(dcgettext(b"stats\x00" as *const u8 as
                                  *const libc::c_char,
                              b"Maximum step size exceeded 5 consecutive times.\nEither the function is unbounded below,\nbecomes asymptotic to a finite value\nfrom above in some direction,\nor stepmx is too small.\n\x00"
                                  as *const u8 as *const libc::c_char,
                              5 as libc::c_int));
        }
        _ => {}
    }
    Rprintf(b"\n\x00" as *const u8 as *const libc::c_char);
}
/* NOTE: The actual Dennis-Schnabel algorithm `optif9' is in ../../../appl/uncmin.c */
#[no_mangle]
pub unsafe extern "C" fn nlm(
    mut _call: SEXP,
    mut _op: SEXP,
    mut args: SEXP,
    mut rho: SEXP,
) -> SEXP {
    let mut value: SEXP = 0 as *mut SEXPREC;
    let mut names: SEXP = 0 as *mut SEXPREC;
    let mut v: SEXP = 0 as *mut SEXPREC;
    let mut R_gradientSymbol: SEXP = 0 as *mut SEXPREC;
    let mut R_hessianSymbol: SEXP = 0 as *mut SEXPREC;
    let mut x: *mut libc::c_double = 0 as *mut libc::c_double;
    let mut typsiz: *mut libc::c_double = 0 as *mut libc::c_double;
    let mut fscale: libc::c_double = 0.;
    let mut gradtl: libc::c_double = 0.;
    let mut stepmx: libc::c_double = 0.;
    let mut steptol: libc::c_double = 0.;
    let mut xpls: *mut libc::c_double = 0 as *mut libc::c_double;
    let mut gpls: *mut libc::c_double = 0 as *mut libc::c_double;
    let mut fpls: libc::c_double = 0.;
    let mut a: *mut libc::c_double = 0 as *mut libc::c_double;
    let mut wrk: *mut libc::c_double = 0 as *mut libc::c_double;
    let mut dlt: libc::c_double = 0.;
    let mut code: 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 itnlim: libc::c_int = 0;
    let mut method: libc::c_int = 0;
    let mut iexp: libc::c_int = 0;
    let mut omsg: libc::c_int = 0;
    let mut msg: libc::c_int = 0;
    let mut n: libc::c_int = 0;
    let mut ndigit: libc::c_int = 0;
    let mut iagflg: libc::c_int = 0;
    let mut iahflg: libc::c_int = 0;
    let mut want_hessian: libc::c_int = 0;
    let mut itncnt: libc::c_int = 0;
    /* .Internal(
     * nlm(function(x) f(x, ...), p, hessian, typsize, fscale,
     *     msg, ndigit, gradtol, stepmax, steptol, iterlim)
     */
    let mut state: *mut function_info = 0 as *mut function_info;
    args = (*args).u.listsxp.cdrval;
    PrintDefaults();
    state = R_alloc(
        1 as libc::c_int as size_t,
        ::std::mem::size_of::<function_info>() as libc::c_ulong as libc::c_int,
    ) as *mut function_info;
    /* the function to be minimized */
    v = (*args).u.listsxp.carval;
    if isFunction(v) as u64 == 0 {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"attempt to minimize non-function\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    (*state).R_fcall = lang2(v, R_NilValue);
    protect((*state).R_fcall);
    args = (*args).u.listsxp.cdrval;
    /* `p' : inital parameter value */
    n = 0 as libc::c_int;
    x = fixparam((*args).u.listsxp.carval, &mut n);
    args = (*args).u.listsxp.cdrval;
    /* `hessian' : H. required? */
    want_hessian = asLogical((*args).u.listsxp.carval);
    if want_hessian == R_NaInt {
        want_hessian = 0 as libc::c_int
    }
    args = (*args).u.listsxp.cdrval;
    /* `typsize' : typical size of parameter elements */
    typsiz = fixparam((*args).u.listsxp.carval, &mut n);
    args = (*args).u.listsxp.cdrval;
    /* `fscale' : expected function size */
    fscale = asReal((*args).u.listsxp.carval);
    if R_IsNA(fscale) != 0 {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"invalid NA value in parameter\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    args = (*args).u.listsxp.cdrval;
    /* `msg' (bit pattern) */
    msg = asInteger((*args).u.listsxp.carval);
    omsg = msg;
    if msg == R_NaInt {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"invalid NA value in parameter\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    args = (*args).u.listsxp.cdrval;
    ndigit = asInteger((*args).u.listsxp.carval);
    if ndigit == R_NaInt {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"invalid NA value in parameter\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    args = (*args).u.listsxp.cdrval;
    gradtl = asReal((*args).u.listsxp.carval);
    if R_IsNA(gradtl) != 0 {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"invalid NA value in parameter\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    args = (*args).u.listsxp.cdrval;
    stepmx = asReal((*args).u.listsxp.carval);
    if R_IsNA(stepmx) != 0 {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"invalid NA value in parameter\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    args = (*args).u.listsxp.cdrval;
    steptol = asReal((*args).u.listsxp.carval);
    if R_IsNA(steptol) != 0 {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"invalid NA value in parameter\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    args = (*args).u.listsxp.cdrval;
    /* `iterlim' (def. 100) */
    itnlim = asInteger((*args).u.listsxp.carval);
    if itnlim == R_NaInt {
        error(dcgettext(
            b"stats\x00" as *const u8 as *const libc::c_char,
            b"invalid NA value in parameter\x00" as *const u8 as *const libc::c_char,
            5 as libc::c_int,
        ));
    }
    (*state).R_env = rho;
    /* force one evaluation to check for the gradient and hessian */
    iagflg = 0 as libc::c_int; /* No analytic gradient */
    iahflg = 0 as libc::c_int; /* No analytic hessian */
    (*state).have_gradient = 0 as libc::c_int; /* value */
    (*state).have_hessian = 0 as libc::c_int;
    R_gradientSymbol = install(b"gradient\x00" as *const u8 as *const libc::c_char);
    R_hessianSymbol = install(b"hessian\x00" as *const u8 as *const libc::c_char);
    v = allocVector(14 as libc::c_int as SEXPTYPE, n as R_xlen_t);
    i = 0 as libc::c_int;
    while i < n {
        *(DATAPTR(v) as *mut libc::c_double).offset(i as isize) = *x.offset(i as isize);
        i += 1
    }
    SETCADR((*state).R_fcall, v);
    value = eval((*state).R_fcall, (*state).R_env);
    protect(value);
    v = getAttrib(value, R_gradientSymbol);
    if v != R_NilValue {
        if LENGTH_EX(
            v,
            b"optimize.c\x00" as *const u8 as *const libc::c_char,
            790 as libc::c_int,
        ) == n
            && ((*v).sxpinfo.type_0() as libc::c_int == 14 as libc::c_int
                || isInteger(v) as libc::c_uint != 0)
        {
            iagflg = 1 as libc::c_int;
            (*state).have_gradient = 1 as libc::c_int;
            v = getAttrib(value, R_hessianSymbol);
            if v != R_NilValue {
                if LENGTH_EX(
                    v,
                    b"optimize.c\x00" as *const u8 as *const libc::c_char,
                    796 as libc::c_int,
                ) == n * n
                    && ((*v).sxpinfo.type_0() as libc::c_int == 14 as libc::c_int
                        || isInteger(v) as libc::c_uint != 0)
                {
                    iahflg = 1 as libc::c_int;
                    (*state).have_hessian = 1 as libc::c_int
                } else {
                    warning(dcgettext(
                        b"stats\x00" as *const u8 as *const libc::c_char,
                        b"hessian supplied is of the wrong length or mode, so ignored\x00"
                            as *const u8 as *const libc::c_char,
                        5 as libc::c_int,
                    ));
                }
            }
        } else {
            warning(dcgettext(
                b"stats\x00" as *const u8 as *const libc::c_char,
                b"gradient supplied is of the wrong length or mode, so ignored\x00" as *const u8
                    as *const libc::c_char,
                5 as libc::c_int,
            ));
        }
    }
    unprotect(1 as libc::c_int);
    if msg / 4 as libc::c_int % 2 as libc::c_int != 0 && iahflg == 0 {
        /* skip check of analytic Hessian */
        msg -= 4 as libc::c_int
    }
    if msg / 2 as libc::c_int % 2 as libc::c_int != 0 && iagflg == 0 {
        /* skip check of analytic gradient */
        msg -= 2 as libc::c_int
    }
    FT_init(n, 5 as libc::c_int, state);
    /* Plug in the call to the optimizer here */
    method = 1 as libc::c_int; /* Line Search */
    iexp = if iahflg != 0 {
        0 as libc::c_int
    } else {
        1 as libc::c_int
    }; /* Function calls are expensive */
    dlt = 1.0f64;
    xpls = R_alloc(
        n as size_t,
        ::std::mem::size_of::<libc::c_double>() as libc::c_ulong as libc::c_int,
    ) as *mut libc::c_double;
    gpls = R_alloc(
        n as size_t,
        ::std::mem::size_of::<libc::c_double>() as libc::c_ulong as libc::c_int,
    ) as *mut libc::c_double;
    a = R_alloc(
        (n * n) as size_t,
        ::std::mem::size_of::<libc::c_double>() as libc::c_ulong as libc::c_int,
    ) as *mut libc::c_double;
    wrk = R_alloc(
        (8 as libc::c_int * n) as size_t,
        ::std::mem::size_of::<libc::c_double>() as libc::c_ulong as libc::c_int,
    ) as *mut libc::c_double;
    /*
     *  Dennis + Schnabel Minimizer
     *
     *   SUBROUTINE OPTIF9(NR,N,X,FCN,D1FCN,D2FCN,TYPSIZ,FSCALE,
     *  +    METHOD,IEXP,MSG,NDIGIT,ITNLIM,IAGFLG,IAHFLG,IPR,
     *  +    DLT,GRADTL,STEPMX,STEPTOL,
     *  +    XPLS,FPLS,GPLS,ITRMCD,A,WRK)
     *
     *
     *  Note: I have figured out what msg does.
     *  It is actually a sum of bit flags as follows
     *    1 = don't check/warn for 1-d problems
     *    2 = don't check analytic gradients
     *    4 = don't check analytic hessians
     *    8 = don't print start and end info
     *   16 = print at every iteration
     *  Using msg=9 is absolutely minimal
     *  I think we always check gradients and hessians
     */
    optif9(
        n,
        n,
        x,
        ::std::mem::transmute::<
            Option<
                unsafe extern "C" fn(
                    _: libc::c_int,
                    _: *const libc::c_double,
                    _: *mut libc::c_double,
                    _: *mut function_info,
                ) -> (),
            >,
            fcn_p,
        >(Some(
            fcn as unsafe extern "C" fn(
                _: libc::c_int,
                _: *const libc::c_double,
                _: *mut libc::c_double,
                _: *mut function_info,
            ) -> (),
        )),
        ::std::mem::transmute::<
            Option<
                unsafe extern "C" fn(
                    _: libc::c_int,
                    _: *const libc::c_double,
                    _: *mut libc::c_double,
                    _: *mut function_info,
                ) -> (),
            >,
            fcn_p,
        >(Some(
            Cd1fcn
                as unsafe extern "C" fn(
                    _: libc::c_int,
                    _: *const libc::c_double,
                    _: *mut libc::c_double,
                    _: *mut function_info,
                ) -> (),
        )),
        ::std::mem::transmute::<
            Option<
                unsafe extern "C" fn(
                    _: libc::c_int,
                    _: libc::c_int,
                    _: *const libc::c_double,
                    _: *mut libc::c_double,
                    _: *mut function_info,
                ) -> (),
            >,
            d2fcn_p,
        >(Some(
            Cd2fcn
                as unsafe extern "C" fn(
                    _: libc::c_int,
                    _: libc::c_int,
                    _: *const libc::c_double,
                    _: *mut libc::c_double,
                    _: *mut function_info,
                ) -> (),
        )),
        state as *mut libc::c_void,
        typsiz,
        fscale,
        method,
        iexp,
        &mut msg,
        ndigit,
        itnlim,
        iagflg,
        iahflg,
        dlt,
        gradtl,
        stepmx,
        steptol,
        xpls,
        &mut fpls,
        gpls,
        &mut code,
        a,
        wrk,
        &mut itncnt,
    );
    if msg < 0 as libc::c_int {
        opterror(msg);
    }
    if code != 0 as libc::c_int && omsg & 8 as libc::c_int == 0 as libc::c_int {
        optcode(code);
    }
    if want_hessian != 0 {
        value = allocVector(19 as libc::c_int as SEXPTYPE, 6 as libc::c_int as R_xlen_t);
        protect(value);
        names = allocVector(16 as libc::c_int as SEXPTYPE, 6 as libc::c_int as R_xlen_t);
        protect(names);
        fdhess(
            n,
            xpls,
            fpls,
            ::std::mem::transmute::<
                Option<
                    unsafe extern "C" fn(
                        _: libc::c_int,
                        _: *const libc::c_double,
                        _: *mut libc::c_double,
                        _: *mut function_info,
                    ) -> (),
                >,
                fcn_p,
            >(Some(
                fcn as unsafe extern "C" fn(
                    _: libc::c_int,
                    _: *const libc::c_double,
                    _: *mut libc::c_double,
                    _: *mut function_info,
                ) -> (),
            )),
            state as *mut libc::c_void,
            a,
            n,
            &mut *wrk.offset(0 as libc::c_int as isize),
            &mut *wrk.offset(n as isize),
            ndigit,
            typsiz,
        );
        i = 0 as libc::c_int;
        while i < n {
            j = 0 as libc::c_int;
            while j < i {
                *a.offset((i + j * n) as isize) = *a.offset((j + i * n) as isize);
                j += 1
            }
            i += 1
        }
    } else {
        value = allocVector(19 as libc::c_int as SEXPTYPE, 5 as libc::c_int as R_xlen_t);
        protect(value);
        names = allocVector(16 as libc::c_int as SEXPTYPE, 5 as libc::c_int as R_xlen_t);
        protect(names);
    }
    k = 0 as libc::c_int;
    SET_STRING_ELT(
        names,
        k as R_xlen_t,
        mkChar(b"minimum\x00" as *const u8 as *const libc::c_char),
    );
    SET_VECTOR_ELT(value, k as R_xlen_t, ScalarReal(fpls));
    k += 1;
    SET_STRING_ELT(
        names,
        k as R_xlen_t,
        mkChar(b"estimate\x00" as *const u8 as *const libc::c_char),
    );
    SET_VECTOR_ELT(
        value,
        k as R_xlen_t,
        allocVector(14 as libc::c_int as SEXPTYPE, n as R_xlen_t),
    );
    i = 0 as libc::c_int;
    while i < n {
        *(DATAPTR(*(DATAPTR(value) as *mut SEXP).offset(k as isize)) as *mut libc::c_double)
            .offset(i as isize) = *xpls.offset(i as isize);
        i += 1
    }
    k += 1;
    SET_STRING_ELT(
        names,
        k as R_xlen_t,
        mkChar(b"gradient\x00" as *const u8 as *const libc::c_char),
    );
    SET_VECTOR_ELT(
        value,
        k as R_xlen_t,
        allocVector(14 as libc::c_int as SEXPTYPE, n as R_xlen_t),
    );
    i = 0 as libc::c_int;
    while i < n {
        *(DATAPTR(*(DATAPTR(value) as *mut SEXP).offset(k as isize)) as *mut libc::c_double)
            .offset(i as isize) = *gpls.offset(i as isize);
        i += 1
    }
    k += 1;
    if want_hessian != 0 {
        SET_STRING_ELT(
            names,
            k as R_xlen_t,
            mkChar(b"hessian\x00" as *const u8 as *const libc::c_char),
        );
        SET_VECTOR_ELT(
            value,
            k as R_xlen_t,
            allocMatrix(14 as libc::c_int as SEXPTYPE, n, n),
        );
        i = 0 as libc::c_int;
        while i < n * n {
            *(DATAPTR(*(DATAPTR(value) as *mut SEXP).offset(k as isize)) as *mut libc::c_double)
                .offset(i as isize) = *a.offset(i as isize);
            i += 1
        }
        k += 1
    }
    SET_STRING_ELT(
        names,
        k as R_xlen_t,
        mkChar(b"code\x00" as *const u8 as *const libc::c_char),
    );
    SET_VECTOR_ELT(
        value,
        k as R_xlen_t,
        allocVector(13 as libc::c_int as SEXPTYPE, 1 as libc::c_int as R_xlen_t),
    );
    *(DATAPTR(*(DATAPTR(value) as *mut SEXP).offset(k as isize)) as *mut libc::c_int)
        .offset(0 as libc::c_int as isize) = code;
    k += 1;
    /* added by Jim K Lindsey */
    SET_STRING_ELT(
        names,
        k as R_xlen_t,
        mkChar(b"iterations\x00" as *const u8 as *const libc::c_char),
    );
    SET_VECTOR_ELT(
        value,
        k as R_xlen_t,
        allocVector(13 as libc::c_int as SEXPTYPE, 1 as libc::c_int as R_xlen_t),
    );
    *(DATAPTR(*(DATAPTR(value) as *mut SEXP).offset(k as isize)) as *mut libc::c_int)
        .offset(0 as libc::c_int as isize) = itncnt;
    k += 1;
    setAttrib(value, R_NamesSymbol, names);
    unprotect(3 as libc::c_int);
    return value;
}