/*
================================================================================
  RPL/2 (R) version 4.1.32
  Copyright (C) 1989-2020 Dr. BERTRAND Joël

  This file is part of RPL/2.

  RPL/2 is free software; you can redistribute it and/or modify it
  under the terms of the CeCILL V2 License as published by the french
  CEA, CNRS and INRIA.
 
  RPL/2 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 CeCILL V2 License
  for more details.
 
  You should have received a copy of the CeCILL License
  along with RPL/2. If not, write to info@cecill.info.
================================================================================
*/


#include "rpl-conv.h"


/*
================================================================================
  Fonction 'mean'
================================================================================
  Entrées : pointeur sur une structure struct_processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_mean(struct_processus *s_etat_processus)
{
	struct_objet						*s_objet_statistique;
	struct_objet						*s_objet_resultat;
	struct_objet						*s_objet_temporaire;

	integer8							nombre_colonnes;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  MEAN ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(moyenne)\n\n");
		}
		else
		{
			printf("(mean)\n\n");
		}

		printf("->  1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}

	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
		{
			return;
		}
	}

	/*
	 * Recherche d'une variable globale référencée par SIGMA
	 */

	if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
	{
		/*
		 * Aucune variable SIGMA
		 */

		(*s_etat_processus).erreur_systeme = d_es;

		if ((*s_etat_processus).erreur_execution == d_ex)
		{
			(*s_etat_processus).erreur_execution = d_ex_absence_observations;
		}

		return;
	}
	else
	{
		if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
				.type != MIN) && ((*(*(*s_etat_processus)
				.pointeur_variable_courante).objet).type != MRL))
		{
			(*s_etat_processus).erreur_execution =
					d_ex_matrice_statistique_invalide;
			return;
		}

		nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
				.pointeur_variable_courante).objet).objet)).nombre_colonnes;
	}

	s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
			.objet;

	if (((*s_objet_statistique).type == MIN) ||
			((*s_objet_statistique).type == MRL))
	{
		if ((s_objet_resultat = allocation(s_etat_processus, NON)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if (((*s_objet_resultat).objet = moyenne_statistique(s_etat_processus,
				(struct_matrice *) (*s_objet_statistique).objet)) == NULL)
		{
			(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
			return;
		}

		if (nombre_colonnes == 1)
		{
			if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
			{
				(*s_objet_resultat).type = VIN;
				s_objet_temporaire = s_objet_resultat;

				if ((s_objet_resultat = allocation(s_etat_processus, INT))
						== NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				(*((integer8 *) (*s_objet_resultat).objet)) =
						((integer8 *) (*((struct_vecteur *)
						(*s_objet_temporaire).objet)).tableau)[0];

				liberation(s_etat_processus, s_objet_temporaire);
			}
			else
			{
				(*s_objet_resultat).type = VRL;
				s_objet_temporaire = s_objet_resultat;

				if ((s_objet_resultat = allocation(s_etat_processus, REL))
						== NULL)
				{
					(*s_etat_processus).erreur_systeme =
							d_es_allocation_memoire;
					return;
				}

				(*((real8 *) (*s_objet_resultat).objet)) =
						((real8 *) (*((struct_vecteur *)
						(*s_objet_temporaire).objet)).tableau)[0];

				liberation(s_etat_processus, s_objet_temporaire);
			}
		}
		else
		{
			if ((*((struct_vecteur *) (*s_objet_resultat).objet)).type == 'I')
			{
				(*s_objet_resultat).type = VIN;
			}
			else
			{
				(*s_objet_resultat).type = VRL;
			}
		}

		if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
				s_objet_resultat) == d_erreur)
		{
			return;
		}
	}
	else
	{
		(*s_etat_processus).erreur_execution =
				d_ex_matrice_statistique_invalide;
		return;
	}

	return;
}


/*
================================================================================
  Fonction 'mins'
================================================================================
  Entrées : pointeur sur une structure struct_processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_mins(struct_processus *s_etat_processus)
{
	long								i;
	long								j;

	struct_objet						*s_objet_statistique;
	struct_objet						*s_objet_resultat;

	integer8							nombre_colonnes;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  MINS ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(minimum de la matrice statistique)\n\n");
		}
		else
		{
			printf("(statistical matrix minimum)\n\n");
		}

		printf("->  1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}

	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
		{
			return;
		}
	}

	/*
	 * Recherche d'une variable globale référencée par SIGMA
	 */

	if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
	{
		/*
		 * Aucune variable SIGMA
		 */

		(*s_etat_processus).erreur_systeme = d_es;

		if ((*s_etat_processus).erreur_execution == d_ex)
		{
			(*s_etat_processus).erreur_execution = d_ex_absence_observations;
		}

		return;
	}
	else
	{
		if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
				.type != MIN) && ((*(*(*s_etat_processus)
				.pointeur_variable_courante).objet).type != MRL))
		{
			(*s_etat_processus).erreur_execution =
					d_ex_matrice_statistique_invalide;
			return;
		}

		nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
				.pointeur_variable_courante).objet).objet)).nombre_colonnes;
	}

	s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
			.objet;

	if (nombre_colonnes == 1)
	{
		if ((*s_objet_statistique).type == MRL)
		{
			if ((s_objet_resultat = allocation(s_etat_processus, REL))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			(*((real8 *) (*s_objet_resultat).objet)) = ((real8 **)
					(*((struct_matrice *) (*s_objet_statistique).objet))
					.tableau)[0][0];

			for(i = 1; i < (*((struct_matrice *) (*s_objet_statistique)
					.objet)).nombre_lignes; i++)
			{
				if ((*((real8 *) (*s_objet_resultat).objet)) > ((real8 **)
						(*((struct_matrice *) (*s_objet_statistique).objet))
						.tableau)[i][0])
				{
					(*((real8 *) (*s_objet_resultat).objet)) = ((real8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[i][0];
				}
			}
		}
		else
		{
			if ((s_objet_resultat = allocation(s_etat_processus, INT))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			(*((integer8 *) (*s_objet_resultat).objet)) = ((integer8 **)
					(*((struct_matrice *) (*s_objet_statistique).objet))
					.tableau)[0][0];

			for(i = 1; i < (*((struct_matrice *) (*s_objet_statistique)
					.objet)).nombre_lignes; i++)
			{
				if ((*((integer8 *) (*s_objet_resultat).objet)) > ((integer8 **)
						(*((struct_matrice *) (*s_objet_statistique).objet))
						.tableau)[i][0])
				{
					(*((integer8 *) (*s_objet_resultat).objet)) = ((integer8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[i][0];
				}
			}
		}
	}
	else
	{
		if ((*s_objet_statistique).type == MRL)
		{
			if ((s_objet_resultat = allocation(s_etat_processus, VRL))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			(*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
					nombre_colonnes;

			if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
					malloc(((size_t) nombre_colonnes) * sizeof(real8))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			for(j = 0; j < nombre_colonnes; j++)
			{
				((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
						.tableau)[j] = ((real8 **) (*((struct_matrice *)
						(*s_objet_statistique).objet)).tableau)[0][j];

				for(i = 1; i < (*((struct_matrice *)
						(*s_objet_statistique).objet)).nombre_lignes; i++)
				{
					if (((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
							.objet)).tableau)[j] > ((real8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[i][j])
					{
						((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
								.objet)).tableau)[j] = ((real8 **)
								(*((struct_matrice *) (*s_objet_statistique)
								.objet)).tableau)[i][j];
					}
				}
			}
		}
		else
		{
			if ((s_objet_resultat = allocation(s_etat_processus, VIN))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			(*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
					nombre_colonnes;

			if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
					malloc(((size_t) nombre_colonnes) * sizeof(integer8)))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			for(j = 0; j < nombre_colonnes; j++)
			{
				((integer8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
						.tableau)[j] = ((integer8 **) (*((struct_matrice *)
						(*s_objet_statistique).objet)).tableau)[0][j];

				for(i = 1; i < (*((struct_matrice *)
						(*s_objet_statistique).objet)).nombre_lignes; i++)
				{
					if (((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
							.objet)).tableau)[j] > ((integer8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[i][j])
					{
						((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
								.objet)).tableau)[j] = ((integer8 **)
								(*((struct_matrice *) (*s_objet_statistique)
								.objet)).tableau)[i][j];
					}
				}
			}
		}
	}

	if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			s_objet_resultat) == d_erreur)
	{
		return;
	}

	return;
}


/*
================================================================================
  Fonction 'maxs'
================================================================================
  Entrées : pointeur sur une structure struct_processus
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

void
instruction_maxs(struct_processus *s_etat_processus)
{
	long								i;
	long								j;

	struct_objet						*s_objet_statistique;
	struct_objet						*s_objet_resultat;

	integer8							nombre_colonnes;

	(*s_etat_processus).erreur_execution = d_ex;

	if ((*s_etat_processus).affichage_arguments == 'Y')
	{
		printf("\n  MAXS ");

		if ((*s_etat_processus).langue == 'F')
		{
			printf("(maximum de la matrice statistique)\n\n");
		}
		else
		{
			printf("(statistical matrix maximum)\n\n");
		}

		printf("->  1: %s, %s, %s, %s\n", d_INT, d_REL, d_VIN, d_VRL);

		return;
	}
	else if ((*s_etat_processus).test_instruction == 'Y')
	{
		(*s_etat_processus).nombre_arguments = -1;
		return;
	}

	if (test_cfsf(s_etat_processus, 31) == d_vrai)
	{
		if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
		{
			return;
		}
	}

	/*
	 * Recherche d'une variable globale référencée par SIGMA
	 */

	if (recherche_variable_globale(s_etat_processus, ds_sdat) == d_faux)
	{
		/*
		 * Aucune variable SIGMA
		 */

		(*s_etat_processus).erreur_systeme = d_es;

		if ((*s_etat_processus).erreur_execution == d_ex)
		{
			(*s_etat_processus).erreur_execution = d_ex_absence_observations;
		}

		return;
	}
	else
	{
		if (((*(*(*s_etat_processus).pointeur_variable_courante).objet)
				.type != MIN) && ((*(*(*s_etat_processus)
				.pointeur_variable_courante).objet).type != MRL))
		{
			(*s_etat_processus).erreur_execution =
					d_ex_matrice_statistique_invalide;
			return;
		}

		nombre_colonnes = (*((struct_matrice *) (*(*(*s_etat_processus)
				.pointeur_variable_courante).objet).objet)).nombre_colonnes;
	}

	s_objet_statistique = (*(*s_etat_processus).pointeur_variable_courante)
			.objet;

	if (nombre_colonnes == 1)
	{
		if ((*s_objet_statistique).type == MRL)
		{
			if ((s_objet_resultat = allocation(s_etat_processus, REL))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			(*((real8 *) (*s_objet_resultat).objet)) = ((real8 **)
					(*((struct_matrice *) (*s_objet_statistique).objet))
					.tableau)[0][0];

			for(i = 1; i < (*((struct_matrice *) (*s_objet_statistique)
					.objet)).nombre_lignes; i++)
			{
				if ((*((real8 *) (*s_objet_resultat).objet)) < ((real8 **)
						(*((struct_matrice *) (*s_objet_statistique).objet))
						.tableau)[i][0])
				{
					(*((real8 *) (*s_objet_resultat).objet)) = ((real8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[i][0];
				}
			}
		}
		else
		{
			if ((s_objet_resultat = allocation(s_etat_processus, INT))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			(*((integer8 *) (*s_objet_resultat).objet)) = ((integer8 **)
					(*((struct_matrice *) (*s_objet_statistique).objet))
					.tableau)[0][0];

			for(i = 1; i < (*((struct_matrice *) (*s_objet_statistique)
					.objet)).nombre_lignes; i++)
			{
				if ((*((integer8 *) (*s_objet_resultat).objet)) < ((integer8 **)
						(*((struct_matrice *) (*s_objet_statistique).objet))
						.tableau)[i][0])
				{
					(*((integer8 *) (*s_objet_resultat).objet)) = ((integer8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[i][0];
				}
			}
		}
	}
	else
	{
		if ((*s_objet_statistique).type == MRL)
		{
			if ((s_objet_resultat = allocation(s_etat_processus, VRL))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			(*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
					nombre_colonnes;

			if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
					malloc(((size_t) nombre_colonnes) * sizeof(real8))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			for(j = 0; j < nombre_colonnes; j++)
			{
				((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
						.tableau)[j] = ((real8 **) (*((struct_matrice *)
						(*s_objet_statistique).objet)).tableau)[0][j];

				for(i = 1; i < (*((struct_matrice *)
						(*s_objet_statistique).objet)).nombre_lignes; i++)
				{
					if (((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
							.objet)).tableau)[j] < ((real8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[i][j])
					{
						((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
								.objet)).tableau)[j] = ((real8 **)
								(*((struct_matrice *) (*s_objet_statistique)
								.objet)).tableau)[i][j];
					}
				}
			}
		}
		else
		{
			if ((s_objet_resultat = allocation(s_etat_processus, VIN))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			(*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
					nombre_colonnes;

			if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau =
					malloc(((size_t) nombre_colonnes) * sizeof(integer8)))
					== NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			for(j = 0; j < nombre_colonnes; j++)
			{
				((integer8 *) (*((struct_vecteur *) (*s_objet_resultat).objet))
						.tableau)[j] = ((integer8 **) (*((struct_matrice *)
						(*s_objet_statistique).objet)).tableau)[0][j];

				for(i = 1; i < (*((struct_matrice *)
						(*s_objet_statistique).objet)).nombre_lignes; i++)
				{
					if (((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
							.objet)).tableau)[j] < ((integer8 **)
							(*((struct_matrice *) (*s_objet_statistique).objet))
							.tableau)[i][j])
					{
						((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
								.objet)).tableau)[j] = ((integer8 **)
								(*((struct_matrice *) (*s_objet_statistique)
								.objet)).tableau)[i][j];
					}
				}
			}
		}
	}

	if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
			s_objet_resultat) == d_erreur)
	{
		return;
	}

	return;
}

// vim: ts=4