#include "bad_selection_strategy.h"
#include "bad_reduction.h"
#include "bad_regularize.h"
#include "bad_quadruple.h"
#include "bad_Rosenfeld_Groebner.h"
#include "bad_global.h"
#include "bad_base_field.h"
#include "bad_stats.h"

/*
 * blad_indent: -l120
 */

/*
 * texinfo: bad_Rosenfeld_Groebner
 * Apply a version of the @dfn{RosenfeldGrobner} algorithm.
 *
 * This version handles as well differential systems as non differential
 * ones. For a better legibility, this documentation assumes that the
 * system is differential.
 *
 * Assign to @var{ideal} a set of differential regular chains.
 * These differential regular chains define differential ideals whose
 * intersection is equal to the radical of the differential ideal
 * @math{[P \cup A_0]:(S \cup H_{A_0})^\infty}. 
 *
 * The argument @var{A0} provides a starting regular differential chain.
 * If it is nonempty then all computed regular differential
 * chains extend it.
 * 
 * The function @code{bad_fast_primality_test_regchain} is applied
 * over each component of @var{ideal}. Thus some output regular
 * differential chains may have the prime ideal property set.
 * 
 * The intersection may involve redundant components.
 * The function @code{bad_remove_redundant_components_intersectof_regchain},
 * which may detect and remove some of them is not called.
 * 
 * The argument @var{S} may be zero.
 * 
 * If different from zero, @var{K0} contains a description
 * of the base field of the differential polynomials. In this case,
 * every nonzero polynomial @var{p} lying in the base field is
 * considered as nonzero by @dfn{RosenfeldGroebner}: the 
 * case @math{p = 0} is not discussed.
 * If @var{K0} involves a non trivial regular differential
 * chain then the elements of this chain are incorporated to each
 * output regular differential chain.
 * If @var{K0} is zero then the base field is supposed to be
 * the purely transcendental extension of the field of the 
 * rational numbers with the independent variables.
 * 
 * The properties of @var{ideal} are supposed to be set by the calling
 * function. Exception @code{BAD_ERRIBF} is raised if the properties
 * of the regular chain of @var{K0} are not compatible with those
 * of @var{ideal}. Exceptions @code{BAD_ERRIAC} or @code{BAD_ERRCRC}
 * are raised if the regular chain @var{A0} is not compatible with
 * the one of @var{K0} or with the properties of @var{ideal}.
 *
 * The argument @var{C}, which may be zero, permits to control the
 * splitting mechanism of @dfn{RosenfeldGroebner}.
 *
 * The argument @var{T}, which may be zero, permits to compute
 * and return a description of the splitting tree implicitly 
 * generated by @dfn{RosenfeldGroebner}.
 * When @dfn{RosenfeldGroebner} is used to perform the differential
 * elimination stage of the @dfn{DenefLipshitz} algorithm, the
 * field @code{DenefLipshitz} of @var{C} should be set to @code{true} 
 * and the activity of @var{tree} should be either 
 * @code{bad_quiet_splitting_tree} or @code{bad_verbose_splitting_tree}.
 */

BAD_DLL void
bad_Rosenfeld_Groebner (
    struct bad_intersectof_regchain *ideal,
    struct bad_splitting_tree *T,
    struct bap_tableof_polynom_mpz *P,
    struct bap_tableof_polynom_mpz *S,
    struct bad_base_field *K0,
    struct bad_regchain *A0,
    struct bad_splitting_control *C)
{
  struct bad_regchain *A;
  struct bad_base_field *K;
  struct bad_selection_strategy *strategy;
  struct bad_splitting_control *control;
  struct bad_splitting_tree *tree;

  struct bad_tableof_quadruple tabG;

  enum bad_typeof_reduction type_red;
  struct bap_product_mpz prod, prod_sep, prod_ini;
  struct bap_polynom_mpz sep, sepuctum, ini, reductum, *p = BAP_NOT_A_POLYNOM_mpz;
  struct bav_tableof_term *thetas;
  struct bav_tableof_variable *leaders;
  struct ba0_tableof_bool keep;
  struct ba0_mark M;
  ba0_int_p counter;
  ba0_int_p i, numberof_input_equations = 0;
  bool use_dimlb = false;
  bool discarded_branch;

  ba0_push_another_stack ();
  ba0_record (&M);
/*
 * Initialize stats
 */
  bad_init_stats ();
  bad_global.stats.begin = time (0);
/*
 * Resulting regular chains get the properties automatically derived from that of ideal
 */
  ideal->inter.size = 0;
  bad_set_automatic_properties_attchain (&ideal->attrib);
/*
 * The type of reduction
 */
  if (bad_has_property_attchain (&ideal->attrib, bad_differential_ideal_property))
    type_red = bad_full_reduction;
  else
    type_red = bad_algebraic_reduction;
/*
 * From now on, use control
 */
  if (C == (struct bad_splitting_control *) 0)
    control = bad_new_splitting_control ();
  else
    control = C;
/*
 * From now on, use base field K
 */
  if (K0 == (struct bad_base_field *) 0)
    K = bad_new_base_field ();
  else
    {
      if (!bad_is_a_compatible_base_field (K0, &ideal->attrib))
        BA0_RAISE_EXCEPTION (BAD_ERRIBF);
      if (bad_has_property_attchain (&ideal->attrib, bad_autoreduced_property))
        {
/*
 * If ideal holds the autoreduced property, set K->assume_reduced 
 */
          if (K0->assume_reduced)
            K = K0;
          else
            {
              K = bad_new_base_field ();
              bad_set_base_field (K, K0);
              K->assume_reduced = true;
            }
        }
      else
        K = K0;
    }
/*
 * From now on use regular chain A
 */
  if (A0 == (struct bad_regchain *) 0)
    A = bad_new_regchain ();
  else
    {
      if (!bad_is_a_compatible_regchain (A0, &ideal->attrib))
        BA0_RAISE_EXCEPTION (BAD_ERRIAC);
      A = A0;
    }
/*
 * The new equation as a polynomial / product
 */
  p = bap_new_polynom_mpz ();
  bap_init_product_mpz (&prod);
/*
 * For handling separants and initials
 */
  bap_init_polynom_mpz (&sep);
  bap_init_polynom_mpz (&sepuctum);
  bap_init_polynom_mpz (&ini);
  bap_init_polynom_mpz (&reductum);
  bap_init_product_mpz (&prod_sep);
  bap_init_product_mpz (&prod_ini);
/*
 * Which factors should be kept?
 */
  ba0_init_table ((struct ba0_table *) &keep);
/*
 * The selection strategy is the default one
 */
  strategy = bad_new_selection_strategy ();
/*
 * The stack of quadruples
 */
  ba0_init_table ((struct ba0_table *) &tabG);
/*
 * From now on, use tree, which is supposed to belong to the same stack as ideal
 */
  if (T == (struct bad_splitting_tree *) 0)
    tree = bad_new_splitting_tree ();
  else
    tree = T;
/*
 * The bad_first_quadruple function stores P and S in the components P and S of quadruples and stores them in tabG
 * The base field defining equations are removed from P
 */
  bad_first_quadruple (&tabG, &ideal->attrib, P, S, type_red, K, A);

  if (tabG.size == 1)
    {
      struct bad_quadruple *G = tabG.tab[0];
      ba0_int_p father = 0;     // the root vertex number
      ba0_int_p child;
      bool differential;
/*
 * Splitting tree: a single first edge from root to G
 */
      ba0_pull_stack ();
      bad_set_next_number_quadruple (G, tree);
      child = bad_get_number_quadruple (tabG.tab[0]);
      bad_set_first_vertex_splitting_tree (tree, child, true);
      bad_add_edge_novar_splitting_tree (tree, bad_first_edge, father, child);
      ba0_push_another_stack ();
/*
 * set use_dimlb and numberof_input_equations which permit to reject quadruples by means of a dimension argument
 */
      differential = bad_defines_a_differential_ideal_attchain (&ideal->attrib);
      use_dimlb =
              bad_apply_dimension_lower_bound_splitting_control (control, A,
              G->P, K, differential, &numberof_input_equations);
    }
/*
 * thetas, leaders, tabL are used by the splitting tree
 */
  if (tree->activity != bad_inactive_splitting_tree)
    {
      thetas = (struct bav_tableof_term *) ba0_new_table ();
      leaders = (struct bav_tableof_variable *) ba0_new_table ();
    }
  else
    {
      thetas = (struct bav_tableof_term *) 0;
      leaders = (struct bav_tableof_variable *) 0;
    }
/*
 *                  _             _
 *  _ __ ___   __ _(_)_ __       | | ___   ___  _ __
 * | '_ ` _ \ / _` | | '_ \      | |/ _ \ / _ \| '_ \
 * | | | | | | (_| | | | | |     | | (_) | (_) | |_) |
 * |_| |_| |_|\__,_|_|_| |_|     |_|\___/ \___/| .__/
 *                                             |_|
 *
 * Stop if there is not any quadruple to process anymore or if the splitting control variable tells us to do so
 */
  counter = 0;
  while (tabG.size > 0 && (!control->first_leaf_only || ideal->inter.size == 0))
    {
      struct bad_quadruple *G = tabG.tab[tabG.size - 1];
      ba0_int_p father = bad_get_number_quadruple (G);

      counter += 1;

      if (tree->activity == bad_verbose_splitting_tree)
        {
          ba0_printf ("------------------------------------------------\n");
          ba0_printf ("Round %d, |tabG| = %d\n", counter, tabG.size);
          ba0_printf ("Handling quadruple %d\n", father);
          ba0_printf ("%quadruple\n", G);
        }

      if (use_dimlb && bad_codimension_regchain (&G->A, K) > numberof_input_equations)
        {
/*
 * use_dimlb and numberof_input_equations may be used to reject quadruples using a dimension argument
 */
          if (tree->activity == bad_verbose_splitting_tree)
            ba0_printf ("Rejecting quadruple %d (dimension argument)\n", father);
          bad_set_vertex_shape_splitting_tree (tree, father, bad_parallelogram_vertex);
          tabG.size -= 1;
        }
/*
 *                         _                          _            _     _   _
 *  _ __ ___  __ _     ___| |__   __ _ _ __ __ _  ___| |_ ___ _ __(_)___| |_(_) ___
 * | '__/ _ \/ _` |   / __| '_ \ / _` | '__/ _` |/ __| __/ _ \ '__| / __| __| |/ __|
 * | | |  __/ (_| |  | (__| | | | (_| | | | (_| | (__| ||  __/ |  | \__ \ |_| | (__
 * |_|  \___|\__, |___\___|_| |_|\__,_|_|  \__,_|\___|\__\___|_|  |_|___/\__|_|\___|
 *           |___/_____|
 */
      else if (bad_is_a_listof_rejected_critical_pair (G->D) && G->P == (struct bap_listof_polynom_mpz *) 0)
        {
          ba0_int_p i, c = ideal->inter.size;
/*
 * G is pulled out of the stack and transformed into finitely many regchains which are stacked over ideal
 */
          if (tree->activity == bad_verbose_splitting_tree)
            ba0_printf ("Calling reg_characteristic on quadruple %d\n", father);

          tabG.size -= 1;

          ba0_pull_stack ();

          bad_reg_characteristic_quadruple (ideal, G, (struct bad_regchain *) 0, K);

          if (tree->activity == bad_verbose_splitting_tree)
            ba0_printf ("|ideal| = %d\n", ideal->inter.size);

          bad_set_vertex_shape_splitting_tree (tree, father, bad_hexagon_vertex);

          for (i = c; i < ideal->inter.size; i++)
            {
              ba0_int_p child = bad_next_number_splitting_tree (tree);
              bad_set_number_regchain (ideal->inter.tab[i], child);
              bad_add_edge_novar_splitting_tree (tree, bad_reg_characteristic_edge, father, child);
              bad_set_vertex_shape_splitting_tree (tree, child, bad_box_vertex);
            }

          ba0_push_another_stack ();
        }
/*
 *        _      _                          _
 *  _ __ (_) ___| | __       __ _ _ __   __| |      _ __ ___ _ __ ___   _____   _____
 * | '_ \| |/ __| |/ /      / _` | '_ \ / _` |     | '__/ _ \ '_ ` _ \ / _ \ \ / / _ \
 * | |_) | | (__|   <      | (_| | | | | (_| |     | | |  __/ | | | | | (_) \ V /  __/
 * | .__/|_|\___|_|\_\      \__,_|_| |_|\__,_|     |_|  \___|_| |_| |_|\___/ \_/ \___|
 * |_|
 */
      else
        {
          struct bad_critical_pair *pair;
          bool reduced_to_zero_by_A;
          bool algebraic_pair;

          bad_pick_and_remove_quadruple (p, G, &pair, strategy);

          algebraic_pair = pair != (struct bad_critical_pair *) 0 && bad_is_an_algebraic_critical_pair (pair);

          if (tree->activity != bad_inactive_splitting_tree && pair != (struct bad_critical_pair *) 0)
            {
              struct bav_variable *v, *w;
              ba0_int_p child = bad_next_number_splitting_tree (tree);
/*
 * Splitting tree management: count the reductions involved in the delta-polynomial computation
 */
              bad_thetas_and_leaders_critical_pair (thetas, leaders, pair);

              ba0_pull_stack ();
              bad_set_number_quadruple (G, child);
              if (!bap_is_numeric_polynom_mpz (p))
                bad_add_edge_novar_splitting_tree (tree, bad_critical_pair_edge, father, child);
              else
                bad_add_edge_novar_splitting_tree (tree, bad_critical_pair_novar_edge, father, child);
              bad_merge_thetas_leaders_vertex_splitting_tree (tree, father, thetas, leaders);
              ba0_push_another_stack ();

              father = bad_get_number_quadruple (G);
              if (tree->activity == bad_verbose_splitting_tree)
                ba0_printf ("Current quadruple is now Quadruple %d\n", father);
            }

          if (tree->activity == bad_verbose_splitting_tree)
            ba0_printf ("New equation from quadruple %d: %Az\n", father, p);
/*
 * If the reduction to zero test is probabilistic, apply it before the actual reduction
 */
          if (bad_initialized_global.reduction.redzero_strategy ==
              bad_probabilistic_redzero_strategy && bad_is_a_reduced_to_zero_polynom_by_regchain (p, &G->A, type_red))
            {
              ba0_int_p child = bad_next_number_splitting_tree (tree);
/*
 * Splitting tree: beware, it gets incorrect if we enter here
 */
              if (tree->activity == bad_verbose_splitting_tree)
                ba0_printf ("New equation is reduced to zero\n");

              ba0_pull_stack ();
              bad_set_number_quadruple (G, child);
              bad_add_edge_novar_splitting_tree (tree, bad_redzero_edge, father, child);
              ba0_push_another_stack ();

              father = bad_get_number_quadruple (G);
/*
 * Non-splitting tree instructions
 */
              reduced_to_zero_by_A = true;
              bad_global.stats.reductions_to_zero += 1;
            }
          else
            reduced_to_zero_by_A = false;
/*
 *               _            _   _
 *  _ __ ___  __| |_   _  ___| |_(_) ___  _ __
 * | '__/ _ \/ _` | | | |/ __| __| |/ _ \| '_ \
 * | | |  __/ (_| | |_| | (__| |_| | (_) | | | |
 * |_|  \___|\__,_|\__,_|\___|\__|_|\___/|_| |_|
 * 
 * reduced_to_zero_by_A may have been set to false with p equal to zero: case of a zero delta-polynomial
 */
          if (!reduced_to_zero_by_A)
            {
              bad_reduce_polynom_by_regchain (&prod,
                  (struct bap_product_mpz *) 0, thetas, p, &G->A, type_red, bad_all_derivatives_to_reduce);

              if (tree->activity != bad_inactive_splitting_tree)
                {
/*
 * Splitting tree: count the reductions involved in the Ritt reduction process
 */
                  bad_leaders_of_regchain (leaders, &G->A);
                  ba0_pull_stack ();
                  bad_merge_thetas_leaders_vertex_splitting_tree (tree, father, thetas, leaders);
                  ba0_push_another_stack ();
                }
/*
 * The new equation p = 0 has now become a product prod = 0
 */
              if (bap_is_zero_product_mpz (&prod))
                {
                  ba0_int_p child = bad_next_number_splitting_tree (tree);
/*
 * Case of a reduction to zero
 * Splitting tree
 */
                  ba0_pull_stack ();
                  bad_add_edge_novar_splitting_tree (tree, bad_redzero_edge, father, child);
                  ba0_push_another_stack ();

                  bad_set_number_quadruple (G, child);
                  father = child;
/*
 * Non-splitting tree
 */
                  if (tree->activity == bad_verbose_splitting_tree)
                    ba0_printf ("New equation is reduced to zero\n");

                  reduced_to_zero_by_A = true;
                  bad_global.stats.reductions_to_zero += 1;
                }
            }
/*
 *   __            _
 *  / _| __ _  ___| |_ ___  _ __
 * | |_ / _` |/ __| __/ _ \| '__|
 * |  _| (_| | (__| || (_) | |
 * |_|  \__,_|\___|\__\___/|_|
 * 
 * The new equation is now reduced. The result is in the product prod
 */
          if (!reduced_to_zero_by_A)
            {
              baz_factor_easy_product_mpz (&prod, &keep, &prod, G->S);
              bad_tag_product_factors_base_field (&prod, &keep, K);
/*
 * Splitting tree: generate triangle vertices immediately and set i to the first kept factor of prod
 */
              ba0_pull_stack ();
              father = bad_get_number_quadruple (G);
              for (i = 0; i < prod.size && !keep.tab[i]; i++)
                {
                  ba0_int_p child = bad_next_number_splitting_tree (tree);
                  bad_add_edge_splitting_tree (tree, bad_factor_edge, father,
                      child, BAV_NOT_A_VARIABLE, prod.tab[i].exponent);
                  bad_set_vertex_shape_splitting_tree (tree, child, bad_triangle_vertex);
                  i += 1;
                }
              ba0_push_another_stack ();
/*
 * Case of a product equivalent to 1 = 0
 */
              if (keep.size == 0 || !keep.tab[keep.size - 1])
                {
                  if (tree->activity == bad_verbose_splitting_tree)
                    ba0_printf ("Rejecting inconsistent quadruple %d\n", father);
                  tabG.size -= 1;
                }
/*
 * The product involves at least one kept factor
 */
              else
                {
                  struct bav_variable *v;
                  bool split_cases_on_the_separant;
                  ba0_int_p g = tabG.size - 1;
/*
 * Assume prod is f_1 ... f_n = 0 (considering only the kept factors)
 * The bad_split_on_factors_of_equations_quadruple function performs:
 * 	for i = 1 to n-1 do  // note: n-1, not n
 * 	    H = G, "f_i = 0"
 * 	    G = G, "f_i != 0"
 * 	done
 * So that, afterwards, G involves f1 != 0, ..., f_{n-1} != 0 and the only case left is: f_n = 0
 */
                  father = bad_get_number_quadruple (G);

                  bad_split_on_factors_of_equations_quadruple (&tabG, tree, &prod, &keep, (struct bap_polynom_mpz *) 0);
                  bad_set_next_number_quadruple (G, tree);
/*
 * Splitting tree: generate immediately triangle vertices
 */
                  ba0_pull_stack ();
                  for (i = g; i < tabG.size; i++)
                    {
                      ba0_int_p child = bad_get_number_quadruple (tabG.tab[i]);
                      bad_add_edge_splitting_tree (tree, bad_factor_edge,
                          father, child, BAV_NOT_A_VARIABLE, prod.tab[i - g].exponent);
                    }
                  ba0_push_another_stack ();
/*
 * the number of G has been changed above to acknowledge the arrival of the new inequations
 */
                  father = bad_get_number_quadruple (G);
                  if (tree->activity == bad_verbose_splitting_tree)
                    ba0_printf ("Current quadruple is now Quadruple %d\n", father);
/*
 * The last case to be processed is the vanishing of the last factor fn of prod which is now in p
 */
                  BA0_SWAP (struct bap_polynom_mpz,
                      *p,
                      prod.tab[prod.size - 1].factor);

                  v = bap_leader_polynom_mpz (p);
/*
 *                                       _
 *  ___  ___ _ __   __ _ _ __ __ _ _ __ | |_
 * / __|/ _ \ '_ \ / _` | '__/ _` | '_ \| __|
 * \__ \  __/ |_) | (_| | | | (_| | | | | |_
 * |___/\___| .__/ \__,_|_|  \__,_|_| |_|\__|
 *          |_|
 * 
 * split_cases_on_the_separant = in principle, we should split cases on the separant
 *                             = squarefree property and not a an algebraic critical pair
 */
                  split_cases_on_the_separant =
                      bad_has_property_regchain (&G->A, bad_squarefree_property) && !algebraic_pair;

                  if (split_cases_on_the_separant)
                    {
                      ba0_int_p zero_vertex;
                      bool edge_to_zero_vertex_needed;
/*
 * Splitting tree: intermediate vertex between G and the many different vertices considering the separant vanishing
 */
                      zero_vertex = bad_next_number_splitting_tree (tree);
                      edge_to_zero_vertex_needed = false;

                      g = tabG.size - 1;

                      bap_separant_and_sepuctum_polynom_mpz (&sep, &sepuctum, p);
                      if (!bad_member_nonzero_polynom_base_field (&sep, K)
                          && !bad_member_nonzero_polynom_base_field (&sepuctum, K))
                        {
                          baz_factor_easy_polynom_mpz (&prod_sep, &keep, &sep, G->S);
                          bad_tag_product_factors_base_field (&prod_sep, &keep, K);
/*
 * Splitting tree: generate the triangle vertices immediately
 */
                          ba0_pull_stack ();
                          for (i = 0; i < keep.size && !keep.tab[i]; i++)
                            {
                              ba0_int_p child = bad_next_number_splitting_tree (tree);
                              edge_to_zero_vertex_needed = true;
                              bad_add_edge_splitting_tree (tree,
                                  bad_factor_edge, zero_vertex, child, BAV_NOT_A_VARIABLE, prod_sep.tab[i].exponent);
                              bad_set_vertex_shape_splitting_tree (tree, child, bad_triangle_vertex);
                            }
                          ba0_push_another_stack ();
/*
 * Actual splittings
 */
                          bad_split_on_factors_of_equations_quadruple (&tabG, tree, &prod_sep, &keep, &sepuctum);
                        }
/*
 * the number of G is changed to acknowledge the arrival of the inequations: sep != 0
 */
                      bad_set_next_number_quadruple (G, tree);
/*
 * Splitting tree: one factor branch between zero_vertex and each new quadruple
 */
                      ba0_pull_stack ();
                      for (i = g; i < tabG.size - 1; i++)
                        {
                          ba0_int_p child = bad_get_number_quadruple (tabG.tab[i]);
                          edge_to_zero_vertex_needed = true;
                          bad_add_edge_splitting_tree (tree, bad_factor_edge,
                              zero_vertex, child, BAV_NOT_A_VARIABLE, prod_sep.tab[i - g].exponent);
                        }
/*
 * Splitting tree: generate the separant branch from father to zero_vertex only if needed
 */
                      if (edge_to_zero_vertex_needed)
                        bad_add_edge_splitting_tree (tree, bad_separant_edge, father, zero_vertex, v, 0);
/*
 * Splitting tree: generate the separant branch from father to G if any
 */
                      if (g < tabG.size)
                        {
                          ba0_int_p child = bad_get_number_quadruple (tabG.tab[tabG.size - 1]);
                          bad_add_edge_splitting_tree (tree, bad_separant_edge, father, child, v, 0);
                        }
                      ba0_push_another_stack ();
                      father = bad_get_number_quadruple (G);
                    }
/*
 *  _       _ _   _       _
 * (_)_ __ (_) |_(_) __ _| |
 * | | '_ \| | __| |/ _` | |
 * | | | | | | |_| | (_| | |
 * |_|_| |_|_|\__|_|\__,_|_|
 * 
 * Split cases if there is a chance to get a factor not already considered when dealing with the separant
 * Note: the structure of the code is slightly different from the one for the separant because separant
 *       branches have a special meaning in the DenefLipshitz algorithm
 */
                  if (!split_cases_on_the_separant || bap_leading_degree_polynom_mpz (p) > 1)
                    {
                      ba0_int_p zero_vertex;
                      bool edge_to_zero_vertex_needed;
/*
 * Splitting tree: intermediate vertex between G and the many different vertices considering the initial vanishing
 */
                      zero_vertex = bad_next_number_splitting_tree (tree);
                      edge_to_zero_vertex_needed = false;

                      g = tabG.size - 1;

                      bap_initial_and_reductum_polynom_mpz (&ini, &reductum, p);
                      if (!bad_member_nonzero_polynom_base_field (&ini, K) &&
                          !bad_member_nonzero_polynom_base_field (&reductum, K))
                        {
/*
 * Common factors of the initial and the separant are automatically marked as unkept
 */
                          baz_factor_easy_polynom_mpz (&prod_ini, &keep, &ini, G->S);
                          bad_tag_product_factors_base_field (&prod_ini, &keep, K);
/*
 * Splitting tree: generate the triangle vertices just after factor_easy
 */
                          ba0_pull_stack ();
                          for (i = 0; i < keep.size && !keep.tab[i]; i++)
                            {
                              ba0_int_p child = bad_next_number_splitting_tree (tree);
                              edge_to_zero_vertex_needed = true;
                              bad_add_edge_splitting_tree (tree,
                                  bad_factor_edge, zero_vertex, child, BAV_NOT_A_VARIABLE, prod_ini.tab[i].exponent);
                              bad_set_vertex_shape_splitting_tree (tree, child, bad_triangle_vertex);
                            }
                          ba0_push_another_stack ();
/*
 * Actual splittings
 */
                          bad_split_on_factors_of_equations_quadruple (&tabG, tree, &prod_ini, &keep, &reductum);
/*
 * the number of G is changed to acknowledge the arrival of the inequations ini != 0
 */
                          father = bad_get_number_quadruple (G);
                          bad_set_next_number_quadruple (G, tree);
/*
 * Splitting tree: generate one initial branch between zero_vertex and each new quadruple
 */
                          ba0_pull_stack ();
                          for (i = g; i < tabG.size - 1; i++)
                            {
                              ba0_int_p child = bad_get_number_quadruple (tabG.tab[i]);
                              edge_to_zero_vertex_needed = true;
                              bad_add_edge_splitting_tree (tree, bad_factor_edge,
                                  zero_vertex, child, BAV_NOT_A_VARIABLE, prod_ini.tab[i - g].exponent);
                            }
/*
 * Splitting tree: generate the initial branch from father to zero_vertex only if needed
 */
                          if (edge_to_zero_vertex_needed)
                            bad_add_edge_splitting_tree (tree, bad_initial_edge, father, zero_vertex, BAV_NOT_A_VARIABLE, 0);
/*
 * Splitting tree: generate the initial branch from father to G if any
 */
                          if (g < tabG.size)
                            {
                              ba0_int_p child = bad_get_number_quadruple (tabG.tab[tabG.size - 1]);
                              bad_add_edge_splitting_tree (tree, bad_initial_edge, father, child, BAV_NOT_A_VARIABLE, 0);
                            }
                          ba0_push_another_stack ();
                          father = bad_get_number_quadruple (G);
                        }
                    }

                  if (tree->activity == bad_verbose_splitting_tree)
                    ba0_printf ("Current quadruple is now Quadruple %d\n", father);
/*
 *                            _      _
 *   ___ ___  _ __ ___  _ __ | | ___| |_ ___
 *  / __/ _ \| '_ ` _ \| '_ \| |/ _ \ __/ _ \
 * | (_| (_) | | | | | | |_) | |  __/ ||  __/
 *  \___\___/|_| |_| |_| .__/|_|\___|\__\___|
 *                     |_|
 */
                  g = tabG.size - 1;

                  bad_complete_quadruple (&tabG, thetas, &discarded_branch,
                      tree, p, (struct bad_regchain *) 0, K, strategy);
/*
 * Splitting tree: count the reductions performed to keep 
 * - A partially autoreduced and
 * - S partially reduced with respect to A
 */
                  if (tree->activity != bad_inactive_splitting_tree)
                    {
                      bad_leaders_of_regchain (leaders, &G->A);
                      ba0_pull_stack ();
                      bad_merge_thetas_leaders_vertex_splitting_tree (tree, father, thetas, leaders);
                      ba0_push_another_stack ();
                    }
/*
 * Splitting tree: is this sufficient?
 */
                  ba0_pull_stack ();
                  if (discarded_branch && tree->activity != bad_inactive_splitting_tree)
                    {
                      ba0_int_p child = bad_next_number_splitting_tree (tree);
                      bad_add_edge_novar_splitting_tree (tree, bad_regularize_edge, father, child);
                      bad_set_vertex_shape_splitting_tree (tree, child, bad_triangle_vertex);
                    }
                  ba0_push_another_stack ();

                  if (g == tabG.size)
                    {
/*
 * bad_complete_quadruple has concluded that G is inconsistent
 */
                      if (tree->activity == bad_verbose_splitting_tree)
                        ba0_printf ("quadruple %d removed by bad_complete_quadruple\n", father);
                    }
                  else
                    {
/*
 * bad_complete_quadruple has generated at least one quadruple
 */
                      ba0_pull_stack ();
                      for (i = g; i < tabG.size; i++)
                        {
                          ba0_int_p child = bad_get_number_quadruple (tabG.tab[i]);
                          bad_add_edge_novar_splitting_tree (tree, bad_regularize_edge, father, child);
                        }
                      ba0_push_another_stack ();
                    }
                }
            }
        }
    }
/*
 * End of MAIN LOOP
 */
  ba0_pull_stack ();
/*
 * All explicit regchains get the prime attribute
 */
  bad_fast_primality_test_intersectof_regchain (ideal);
  ba0_restore (&M);
  bad_global.stats.end = time (0);
}

/*
 * texinfo: bad_first_quadruple
 * Initialize the field @code{A} of the first quadruple of @var{tabG} with the 
 * defining equations of @var{K}, extended with the polynomials of @var{A}.
 * Initialize the field @code{P} with @var{P}.
 * Initialize the field @code{S} with @var{S} and the initials of @var{A} 
 * (plus the separants if @var{attrib} holds the squarefree property).
 */

BAD_DLL void
bad_first_quadruple (
    struct bad_tableof_quadruple *tabG,
    struct bad_attchain *attrib,
    struct bap_tableof_polynom_mpz *P,
    struct bap_tableof_polynom_mpz *S,
    enum bad_typeof_reduction type_red,
    struct bad_base_field *K,
    struct bad_regchain *A)
{
  struct bad_quadruple *G;
  struct bap_product_mpz prod;
  struct ba0_tableof_bool keep;
  struct bap_polynom_mpz poly;
  struct ba0_mark M;
  ba0_int_p i, j;

  if (tabG->size != 0)
    BA0_RAISE_EXCEPTION (BA0_ERRALG);

  ba0_realloc2_table ((struct ba0_table *) tabG, 1, (ba0_new_function *) bad_new_quadruple);
  G = tabG->tab[0];
  tabG->size = 1;
/*
 * The relations of K are directly stored in G->A
 * Overwrite the properties of K->relations.attrib with attrib
 */
  if (K != (struct bad_base_field *) 0)
    bad_set_regchain (&G->A, &K->relations);
/*
 * Append the polynomials of A to G->A
 * Insert in G->S the initials (and separants) of A
 * Setting G->A.attrib is necessary to have the squarefree property correctly set
 */
  bad_set_attchain (&G->A.attrib, attrib);
  if (A != (struct bad_regchain *) 0)
    bad_extend_quadruple_regchain (G, A, K);
/*
 * Do it again because the above call may have erased G->A.attrib
 */
  bad_set_attchain (&G->A.attrib, attrib);

  ba0_push_another_stack ();
  ba0_record (&M);
  bap_init_product_mpz (&prod);
  ba0_init_table ((struct ba0_table *) &keep);
  bap_init_polynom_mpz (&poly);
  ba0_pull_stack ();
/*
 * First process the inequations.
 * No splitting occurs since "p*q != 0" is just "p != 0", "q != 0".
 * However, the quadruple G may be proved inconsistent and discarded.
 */
  if (S)
    {
      for (i = 0; i < S->size && tabG->size == 1; i++)
        {
/*
 * An inequation might be reduced to zero by an existing equation of A
 */
          ba0_push_another_stack ();
          if (! bad_is_zero_regchain (&G->A))
            {
              bad_reduce_polynom_by_regchain (&prod,
                  (struct bap_product_mpz *) 0, (struct bav_tableof_term *) 0,
                  S->tab[i], &G->A, type_red, bad_all_derivatives_to_reduce);
              bap_expand_product_mpz (&poly, &prod);
            }
          else
            bap_set_polynom_mpz (&poly, S->tab[i]);

          baz_factor_easy_polynom_mpz (&prod, &keep, &poly, G->S);
          bad_tag_product_factors_base_field (&prod, &keep, K);
          ba0_pull_stack ();
/*
 * In the case "0 != 0", remove the quadruple G from the stack.
 */
          if (bap_is_zero_product_mpz (&prod))
            tabG->size -= 1;
          else
            {
              for (j = 0; j < prod.size; j++)
                G->S = bad_insert_in_listof_polynom_mpz (&prod.tab[j].factor, G->S);
            }
        }
    }
  ba0_restore (&M);
/*
 * Then process the equations
 */
  if (tabG->size > 0)
    {
      for (i = 0; i < P->size && tabG->size == 1; i++)
        {
          if (bap_is_numeric_polynom_mpz (P->tab[i]))
            {
              if (!bap_is_zero_polynom_mpz (P->tab[i]))
                tabG->size -= 1;
            }
          else if (bad_is_zero_regchain (A))
            G->P = bad_insert_in_listof_polynom_mpz (P->tab[i], G->P);
          else if (!bad_is_a_reduced_to_zero_polynom_by_regchain (P->tab[i], &G->A, type_red))
            G->P = bad_insert_in_listof_polynom_mpz (P->tab[i], G->P);
        }
    }
}
