
#line 1 "../gen/tmpl/lib.c"
/*
  gsl_Poly.c
  Ruby/Numo::GSL - GSL wrapper for Ruby/Numo::NArray

  created on: 2017-03-11
  Copyright (C) 2017 Masahiro Tanaka
*/

#include <ruby.h>
#include <assert.h>
#include "numo/narray.h"
#include "numo/template.h"
#include "../numo_gsl.h"
#line 15 "../gen/tmpl/lib.c"
#include <gsl/gsl_poly.h>
#include <assert.h>

static VALUE mG;



#line 1 "../gen/tmpl/module.c"
/*
  module definition: Numo::GSL::Poly
*/

#line 6 "../gen/tmpl/module.c"
static VALUE mPoly;


#line 1 "../gen/tmpl/class.c"
/*
  class definition: Numo::GSL::Poly::ComplexWorkspace
*/

static VALUE cComplexWorkspace;

static void
poly_complex_workspace_free(void *ptr)
{
    gsl_poly_complex_workspace_free(ptr);
}

static size_t
poly_complex_workspace_memsize(const void *ptr)
{
    return sizeof(gsl_poly_complex_workspace);
}

static const rb_data_type_t poly_complex_workspace_data_type = {
    "Numo::GSL::Poly::ComplexWorkspace",
    {NULL, poly_complex_workspace_free, poly_complex_workspace_memsize,},
    0, 0, RUBY_TYPED_FREE_IMMEDIATELY|RUBY_TYPED_WB_PROTECTED
};



#line 1 "../gen/tmpl/c_new_sizet.c"

#line 5 "../gen/tmpl/c_new_sizet.c"
/*
  @overload new(n)
  @param  [Integer]  n parameter

  allocate instance of ComplexWorkspace class.

 This function allocates space for a gsl_poly_complex_workspace
struct and a workspace suitable for solving a polynomial with n
coefficients using the routine gsl_poly_complex_solve.

The function returns a pointer to the newly allocated
gsl_poly_complex_workspace if no errors were detected, and a null
pointer in the case of error.
 */
static VALUE
poly_complex_workspace_s_new(VALUE self, VALUE v1)
{
    gsl_poly_complex_workspace *w;
    w = gsl_poly_complex_workspace_alloc(NUM2SIZET(v1));
    if (!w) {
        rb_raise(rb_eNoMemError,"fail to allocate struct");
    }
    return TypedData_Wrap_Struct(cComplexWorkspace, &poly_complex_workspace_data_type, (void*)w);
}


#line 1 "tmpl/poly_eval.c"
static inline int is_complex_nary(VALUE v)
{
    VALUE c = CLASS_OF(v);
    if (c == numo_cDComplex || c == numo_cSComplex || c == rb_cComplex)
        return 1;
    else
        return 0;
}

#line 20 "tmpl/poly_eval.c"
static void
iter_ff(na_loop_t *const lp)
{
    size_t n;
    double *c;
    double x;
    double y;

    assert(lp->args[0].ndim == 1);
    n = lp->args[0].shape[0];
    c = (double*)GET_PTR(lp,0);
    x = *(double*)GET_PTR(lp,1);
    y = gsl_poly_eval(c,n,x);
    *(double*)GET_PTR(lp,2) = y;
}

static VALUE
poly_eval_ff(VALUE v0, VALUE v1)
{
    ndfunc_arg_in_t ain[2] = {{cDF,1},{cDF,0}};
    ndfunc_arg_out_t aout[1] = {{cDF,0}};
    ndfunc_t ndf = {iter_ff,NO_LOOP|NDF_INPLACE|NDF_EXTRACT,2,1,ain,aout};
    return na_ndloop(&ndf,2,v0,v1);
}

#line 20 "tmpl/poly_eval.c"
static void
iter_fc(na_loop_t *const lp)
{
    size_t n;
    double *c;
    gsl_complex x;
    gsl_complex y;

    assert(lp->args[0].ndim == 1);
    n = lp->args[0].shape[0];
    c = (double*)GET_PTR(lp,0);
    x = *(gsl_complex*)GET_PTR(lp,1);
    y = gsl_poly_complex_eval(c,n,x);
    *(gsl_complex*)GET_PTR(lp,2) = y;
}

static VALUE
poly_eval_fc(VALUE v0, VALUE v1)
{
    ndfunc_arg_in_t ain[2] = {{cDF,1},{cDC,0}};
    ndfunc_arg_out_t aout[1] = {{cDC,0}};
    ndfunc_t ndf = {iter_fc,NO_LOOP|NDF_INPLACE|NDF_EXTRACT,2,1,ain,aout};
    return na_ndloop(&ndf,2,v0,v1);
}

#line 20 "tmpl/poly_eval.c"
static void
iter_cc(na_loop_t *const lp)
{
    size_t n;
    gsl_complex *c;
    gsl_complex x;
    gsl_complex y;

    assert(lp->args[0].ndim == 1);
    n = lp->args[0].shape[0];
    c = (gsl_complex*)GET_PTR(lp,0);
    x = *(gsl_complex*)GET_PTR(lp,1);
    y = gsl_complex_poly_complex_eval(c,n,x);
    *(gsl_complex*)GET_PTR(lp,2) = y;
}

static VALUE
poly_eval_cc(VALUE v0, VALUE v1)
{
    ndfunc_arg_in_t ain[2] = {{cDC,1},{cDC,0}};
    ndfunc_arg_out_t aout[1] = {{cDC,0}};
    ndfunc_t ndf = {iter_cc,NO_LOOP|NDF_INPLACE|NDF_EXTRACT,2,1,ain,aout};
    return na_ndloop(&ndf,2,v0,v1);
}

#line 46 "tmpl/poly_eval.c"
/*
  @overload eval(c,x)

  @param [Numo::DFloat or DComplex] c
  @param [Numo::DFloat or DComplex] x
  @return [Numo::DFloat or DComplex]

  This function calls gsl_poly_eval or gsl_poly_complex_eval
  or gsl_complex_poly_complex_eval according to
  whether argument is complex or not.

  This function evaluates a polynomial with real coefficients for the real variable x.

*/
static VALUE
poly_s_eval(VALUE mod, VALUE v0, VALUE v1)
{
    if (is_complex_nary(v0)) {
        return poly_eval_cc(v0,v1);
    } else if (is_complex_nary(v1)) {
        return poly_eval_fc(v0,v1);
    } else {
        return poly_eval_ff(v0,v1);
    }
}


#line 1 "tmpl/poly_eval_derivs.c"
static void
iter_poly_s_eval_derivs(na_loop_t *const lp)
{
    size_t lenc, lenres;
    double *c;
    double x;
    double *r;

    assert(lp->args[0].ndim == 1);
    assert(lp->args[2].ndim == 1);
    lenc   = lp->args[0].shape[0];
    lenres = lp->args[2].shape[0];
    c = (double*)GET_PTR(lp,0);
    x = *(double*)GET_PTR(lp,1);
    r = (double*)GET_PTR(lp,2);
    gsl_poly_eval_derivs(c,lenc,x,r,lenres);
}

/*
  @overload eval_derivs(c,x,lenres)

  @param [Numo::DFloat] c
  @param [Numo::DFloat] x
  @param [Integer]      lenres
  @return [Numo::DFloat]

  This function evaluates a polynomial and its derivatives storing the
results in the array res of size lenres.  The output array
contains the values of d^k P/d x^k for the specified value of
x starting with k = 0.

*/
static VALUE
poly_s_eval_derivs(VALUE mod, VALUE v0, VALUE v1, VALUE v2)
{
    size_t shape[1];
    ndfunc_arg_in_t ain[2] = {{cDF,1},{cDF,0}};
    ndfunc_arg_out_t aout[1] = {{cDF,1,shape}};
    ndfunc_t ndf = {iter_poly_s_eval_derivs,NO_LOOP|NDF_INPLACE|NDF_EXTRACT,2,1,ain,aout};

    shape[0] = NUM2SIZET(v2);
    return na_ndloop(&ndf,2,v0,v1);
}


#line 1 "../gen/tmpl/mod_func_noloop.c"
static void
iter_poly_s_solve_quadratic(na_loop_t *const lp)
{
    
    double c0;
    double c1;
    double c2;
    double c3;
    double c4;
    int c5;
    

    
    c0 = *(double*)GET_PTR(lp,0); //a
    c1 = *(double*)GET_PTR(lp,1); //b
    c2 = *(double*)GET_PTR(lp,2); //c
    
    
    
    
#line 18 "../gen/tmpl/mod_func_noloop.c"
    c5 = gsl_poly_solve_quadratic(c0,c1,c2,&c3,&c4);
    
    *(double*)GET_PTR(lp,3) = c3; //x0
    *(double*)GET_PTR(lp,4) = c4; //x1
    *(int*)GET_PTR(lp,5) = c5; //return
#line 21 "../gen/tmpl/mod_func_noloop.c"
}

/*
  @overload solve_quadratic(a,b,c)
  
  @param [Numo::DFloat] a
  @param [Numo::DFloat] b
  @param [Numo::DFloat] c
  @return [[Numo::DFloat, Numo::DFloat, Numo::Int]]  array of [x0, x1, return]

  This function finds the real roots of the quadratic equation,

a x^2 + b x + c = 0

The number of real roots (either zero, one or two) is returned, and
their locations are stored in x0 and x1.  If no real roots
are found then x0 and x1 are not modified.  If one real root
is found (i.e. if a=0) then it is stored in x0.  When two
real roots are found they are stored in x0 and x1 in
ascending order.  The case of coincident roots is not considered
special.  For example (x-1)^2=0 will have two roots, which happen
to have exactly equal values.

The number of roots found depends on the sign of the discriminant
b^2 - 4 a c.  This will be subject to rounding and cancellation
errors when computed in double precision, and will also be subject to
errors if the coefficients of the polynomial are inexact.  These errors
may cause a discrete change in the number of roots.  However, for
polynomials with small integer coefficients the discriminant can always
be computed exactly.

*/
static VALUE
poly_s_solve_quadratic(VALUE mod,VALUE v0,VALUE v1,VALUE v2)
{
    
    

#line 38 "../gen/tmpl/mod_func_noloop.c"
    ndfunc_arg_in_t ain[3] = {{cDF,0},{cDF,0},{cDF,0}};
    ndfunc_arg_out_t aout[3] = {{cDF,0},{cDF,0},{cI,0}};
    ndfunc_t ndf = {iter_poly_s_solve_quadratic,NO_LOOP|NDF_INPLACE|NDF_EXTRACT,
                    3,3,ain,aout};
    
    
#line 52 "../gen/tmpl/mod_func_noloop.c"
    return na_ndloop(&ndf,3,v0,v1,v2); 
#line 54 "../gen/tmpl/mod_func_noloop.c"
}


#line 1 "../gen/tmpl/mod_func_noloop.c"
static void
iter_poly_s_complex_solve_quadratic(na_loop_t *const lp)
{
    
    double c0;
    double c1;
    double c2;
    gsl_complex c3;
    gsl_complex c4;
    int c5;
    

    
    c0 = *(double*)GET_PTR(lp,0); //a
    c1 = *(double*)GET_PTR(lp,1); //b
    c2 = *(double*)GET_PTR(lp,2); //c
    
    
    
    
#line 18 "../gen/tmpl/mod_func_noloop.c"
    c5 = gsl_poly_complex_solve_quadratic(c0,c1,c2,&c3,&c4);
    
    *(gsl_complex*)GET_PTR(lp,3) = c3; //z0
    *(gsl_complex*)GET_PTR(lp,4) = c4; //z1
    *(int*)GET_PTR(lp,5) = c5; //return
#line 21 "../gen/tmpl/mod_func_noloop.c"
}

/*
  @overload complex_solve_quadratic(a,b,c)
  
  @param [Numo::DFloat] a
  @param [Numo::DFloat] b
  @param [Numo::DFloat] c
  @return [[Numo::DComplex, Numo::DComplex, Numo::Int]]  array of [z0, z1, return]

  
This function finds the complex roots of the quadratic equation,

a z^2 + b z + c = 0

The number of complex roots is returned (either one or two) and the
locations of the roots are stored in z0 and z1.  The roots
are returned in ascending order, sorted first by their real components
and then by their imaginary components.  If only one real root is found
(i.e. if a=0) then it is stored in z0.

*/
static VALUE
poly_s_complex_solve_quadratic(VALUE mod,VALUE v0,VALUE v1,VALUE v2)
{
    
    

#line 38 "../gen/tmpl/mod_func_noloop.c"
    ndfunc_arg_in_t ain[3] = {{cDF,0},{cDF,0},{cDF,0}};
    ndfunc_arg_out_t aout[3] = {{cDC,0},{cDC,0},{cI,0}};
    ndfunc_t ndf = {iter_poly_s_complex_solve_quadratic,NO_LOOP|NDF_INPLACE|NDF_EXTRACT,
                    3,3,ain,aout};
    
    
#line 52 "../gen/tmpl/mod_func_noloop.c"
    return na_ndloop(&ndf,3,v0,v1,v2); 
#line 54 "../gen/tmpl/mod_func_noloop.c"
}


#line 1 "../gen/tmpl/mod_func_noloop.c"
static void
iter_poly_s_solve_cubic(na_loop_t *const lp)
{
    
    double c0;
    double c1;
    double c2;
    double c3;
    double c4;
    double c5;
    int c6;
    

    
    c0 = *(double*)GET_PTR(lp,0); //a
    c1 = *(double*)GET_PTR(lp,1); //b
    c2 = *(double*)GET_PTR(lp,2); //c
    
    
    
    
    
#line 18 "../gen/tmpl/mod_func_noloop.c"
    c6 = gsl_poly_solve_cubic(c0,c1,c2,&c3,&c4,&c5);
    
    *(double*)GET_PTR(lp,3) = c3; //x0
    *(double*)GET_PTR(lp,4) = c4; //x1
    *(double*)GET_PTR(lp,5) = c5; //x2
    *(int*)GET_PTR(lp,6) = c6; //return
#line 21 "../gen/tmpl/mod_func_noloop.c"
}

/*
  @overload solve_cubic(a,b,c)
  
  @param [Numo::DFloat] a
  @param [Numo::DFloat] b
  @param [Numo::DFloat] c
  @return [[Numo::DFloat, Numo::DFloat, Numo::DFloat, Numo::Int]]  array of [x0, x1, x2, return]

  
This function finds the real roots of the cubic equation,

x^3 + a x^2 + b x + c = 0

with a leading coefficient of unity.  The number of real roots (either
one or three) is returned, and their locations are stored in x0,
x1 and x2.  If one real root is found then only x0
is modified.  When three real roots are found they are stored in
x0, x1 and x2 in ascending order.  The case of
coincident roots is not considered special.  For example, the equation
(x-1)^3=0 will have three roots with exactly equal values.  As
in the quadratic case, finite precision may cause equal or
closely-spaced real roots to move off the real axis into the complex
plane, leading to a discrete change in the number of real roots.
*/
static VALUE
poly_s_solve_cubic(VALUE mod,VALUE v0,VALUE v1,VALUE v2)
{
    
    

#line 38 "../gen/tmpl/mod_func_noloop.c"
    ndfunc_arg_in_t ain[3] = {{cDF,0},{cDF,0},{cDF,0}};
    ndfunc_arg_out_t aout[4] = {{cDF,0},{cDF,0},{cDF,0},{cI,0}};
    ndfunc_t ndf = {iter_poly_s_solve_cubic,NO_LOOP|NDF_INPLACE|NDF_EXTRACT,
                    3,4,ain,aout};
    
    
#line 52 "../gen/tmpl/mod_func_noloop.c"
    return na_ndloop(&ndf,3,v0,v1,v2); 
#line 54 "../gen/tmpl/mod_func_noloop.c"
}


#line 1 "../gen/tmpl/mod_func_noloop.c"
static void
iter_poly_s_complex_solve_cubic(na_loop_t *const lp)
{
    
    double c0;
    double c1;
    double c2;
    gsl_complex c3;
    gsl_complex c4;
    gsl_complex c5;
    int c6;
    

    
    c0 = *(double*)GET_PTR(lp,0); //a
    c1 = *(double*)GET_PTR(lp,1); //b
    c2 = *(double*)GET_PTR(lp,2); //c
    
    
    
    
    
#line 18 "../gen/tmpl/mod_func_noloop.c"
    c6 = gsl_poly_complex_solve_cubic(c0,c1,c2,&c3,&c4,&c5);
    
    *(gsl_complex*)GET_PTR(lp,3) = c3; //z0
    *(gsl_complex*)GET_PTR(lp,4) = c4; //z1
    *(gsl_complex*)GET_PTR(lp,5) = c5; //z2
    *(int*)GET_PTR(lp,6) = c6; //return
#line 21 "../gen/tmpl/mod_func_noloop.c"
}

/*
  @overload complex_solve_cubic(a,b,c)
  
  @param [Numo::DFloat] a
  @param [Numo::DFloat] b
  @param [Numo::DFloat] c
  @return [[Numo::DComplex, Numo::DComplex, Numo::DComplex, Numo::Int]]  array of [z0, z1, z2, return]

  
This function finds the complex roots of the cubic equation,

z^3 + a z^2 + b z + c = 0

The number of complex roots is returned (always three) and the locations
of the roots are stored in z0, z1 and z2.  The roots
are returned in ascending order, sorted first by their real components
and then by their imaginary components.

*/
static VALUE
poly_s_complex_solve_cubic(VALUE mod,VALUE v0,VALUE v1,VALUE v2)
{
    
    

#line 38 "../gen/tmpl/mod_func_noloop.c"
    ndfunc_arg_in_t ain[3] = {{cDF,0},{cDF,0},{cDF,0}};
    ndfunc_arg_out_t aout[4] = {{cDC,0},{cDC,0},{cDC,0},{cI,0}};
    ndfunc_t ndf = {iter_poly_s_complex_solve_cubic,NO_LOOP|NDF_INPLACE|NDF_EXTRACT,
                    3,4,ain,aout};
    
    
#line 52 "../gen/tmpl/mod_func_noloop.c"
    return na_ndloop(&ndf,3,v0,v1,v2); 
#line 54 "../gen/tmpl/mod_func_noloop.c"
}


#line 1 "tmpl/poly_complex_solve.c"
static void
iter_poly_s_complex_solve(na_loop_t *const lp)
{
    size_t   n;
    double  *a;
    gsl_complex_packed_ptr z;
    void   **opts;
    gsl_poly_complex_workspace *w;

    opts = (void **)(lp->opt_ptr);
    w    = (gsl_poly_complex_workspace*)(opts[0]);

    n = lp->args[0].shape[0];
    a = (double*)(lp->args[0].ptr + lp->args[0].iter[0].pos);
    z = (gsl_complex_packed_ptr)(lp->args[1].ptr + lp->args[1].iter[0].pos);
    gsl_poly_complex_solve(a, n, w, z);
}

/*
  @overload complex_solve(a)
  @param  [Numo::DFloat]    a
  @return [Numo::DComplex]  z result

  This function computes the roots of the general polynomial 
$P(x) = a_0 + a_1 x + a_2 x^2 + ... + a_{n-1} x^{n-1}$ 
P(x) = a_0 + a_1 x + a_2 x^2 + ... + a_[n-1] x^[n-1] using 
balanced-QR reduction of the companion matrix.  The parameter n
specifies the length of the coefficient array.  The coefficient of the
highest order term must be non-zero.  The function requires a workspace
w of the appropriate size.  The n-1 roots are returned in
the packed complex array z of length 2(n-1), alternating
real and imaginary parts.

The function returns GSL_SUCCESS if all the roots are found. If
the QR reduction does not converge, the error handler is invoked with
an error code of GSL_EFAILED.  Note that due to finite precision,
roots of higher multiplicity are returned as a cluster of simple roots
with reduced accuracy.  The solution of polynomials with higher-order
roots requires specialized algorithms that take the multiplicity
structure into account (see e.g. Z. Zeng, Algorithm 835, ACM
Transactions on Mathematical Software, Volume 30, Issue 2 (2004), pp
218--236).

*/
static VALUE
poly_s_complex_solve(VALUE mod, VALUE v1)
{
    size_t shape[0];
    ndfunc_arg_in_t ain[1] = {{cDF,1}};
    ndfunc_arg_out_t aout[1] = {{cDC,1,shape}};
    ndfunc_t ndf = {iter_poly_s_complex_solve, NO_LOOP, 1,1, ain,aout};
    gsl_poly_complex_workspace *w;
    void     *opts[1];
    VALUE     vz, vws;
    size_t    n;
    narray_t *na;

    v1 = rb_funcall(cDF, rb_intern("cast"), 1, v1);
    GetNArray(v1,na);
    if (na->ndim == 0) {
        rb_raise(nary_eDimensionError,"ndim(=%d) should >= %d", na->ndim, 0);
    }
    if (na->shape[na->ndim-1] < 2) {
        rb_raise(nary_eShapeError, "last axis size must be >= 2");
    }
    n = na->shape[na->ndim-1];
    shape[0] = n-1;

    vws = poly_complex_workspace_s_new(cComplexWorkspace, SIZET2NUM(n));
    TypedData_Get_Struct(vws, gsl_poly_complex_workspace, &poly_complex_workspace_data_type, w);
    opts[0] = w;

    vz = na_ndloop3(&ndf, opts, 1, v1);
    RB_GC_GUARD(vws);
    RB_GC_GUARD(v1);
    return vz;
}


#line 28 "../gen/tmpl/lib.c"
void
Init_poly(void)
{
    VALUE mN;
    mN = rb_define_module("Numo");
    mG = rb_define_module_under(mN, "GSL");

    


#line 1 "../gen/tmpl/init_module.c"

    /*
      Document-module: Numo::GSL::Poly
      
    */
    {
    
    mPoly = rb_define_module_under(mG, "Poly");
    
    
    
#line 1 "../gen/tmpl/init_class.c"

    /*
      Document-class: Numo::GSL::Poly::ComplexWorkspace
      
    */
    {
    cComplexWorkspace = rb_define_class_under(mPoly, "ComplexWorkspace", rb_cObject);
    
    rb_undef_alloc_func(cComplexWorkspace);
    rb_define_singleton_method(cComplexWorkspace, "new", poly_complex_workspace_s_new, 1);
#line 10 "../gen/tmpl/init_class.c"
    }

    rb_define_module_function(mPoly, "eval", poly_s_eval, 2);
    rb_define_module_function(mPoly, "eval_derivs", poly_s_eval_derivs, 3);
    rb_define_module_function(mPoly, "solve_quadratic", poly_s_solve_quadratic, 3);
    rb_define_module_function(mPoly, "complex_solve_quadratic", poly_s_complex_solve_quadratic, 3);
    rb_define_module_function(mPoly, "solve_cubic", poly_s_solve_cubic, 3);
    rb_define_module_function(mPoly, "complex_solve_cubic", poly_s_complex_solve_cubic, 3);
    rb_define_module_function(mPoly, "complex_solve", poly_s_complex_solve, 1);
#line 12 "../gen/tmpl/init_module.c"
    }
#line 41 "../gen/tmpl/lib.c"
}
