/*
================================================================================
  RPL/2 (R) version 4.0.15
  Copyright (C) 1989-2010 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)
{
	logical1							presence_variable;

	long								i;

	struct_objet						*s_objet_statistique;
	struct_objet						*s_objet_resultat;
	struct_objet						*s_objet_temporaire;

	unsigned long						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(s_etat_processus, ds_sdat) == d_faux)
	{
		/*
		 * Aucune variable SIGMA
		 */

		(*s_etat_processus).erreur_systeme = d_es;
		(*s_etat_processus).erreur_execution = d_ex_absence_observations;
		return;
	}
	else
	{
		/*
		 * Il existe une variable locale SIGMA. Reste à vérifier l'existence
		 * d'une variable SIGMA globale...
		 */

		i = (*s_etat_processus).position_variable_courante;
		presence_variable = d_faux;

		while(i >= 0)
		{
			if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
					ds_sdat) == 0) && ((*s_etat_processus)
					.s_liste_variables[i].niveau == 1))
			{
				presence_variable = d_vrai;
				break;
			}

			i--;
		}

		if (presence_variable == d_faux)
		{
			(*s_etat_processus).erreur_execution = d_ex_absence_observations;
			return;
		}
		else
		{
			(*s_etat_processus).position_variable_courante = i;

			if ((*s_etat_processus).s_liste_variables[i].objet == NULL)
			{
				(*s_etat_processus).erreur_execution = d_ex_variable_partagee;
				return;
			}

			if (((*((*s_etat_processus).s_liste_variables
					[(*s_etat_processus).position_variable_courante].objet))
					.type != MIN) && ((*((*s_etat_processus)
					.s_liste_variables[(*s_etat_processus)
					.position_variable_courante].objet)).type != MRL))
			{
				(*s_etat_processus).erreur_execution =
						d_ex_matrice_statistique_invalide;
				return;
			}

			nombre_colonnes = (*((struct_matrice *) (*((*s_etat_processus)
					.s_liste_variables[(*s_etat_processus)
					.position_variable_courante].objet)).objet))
					.nombre_colonnes;
		}
	}

	s_objet_statistique = ((*s_etat_processus).s_liste_variables
			[(*s_etat_processus).position_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((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)
{
	logical1							presence_variable;

	long								i;
	long								j;

	struct_objet						*s_objet_statistique;
	struct_objet						*s_objet_resultat;

	unsigned long						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(s_etat_processus, ds_sdat) == d_faux)
	{
		/*
		 * Aucune variable SIGMA
		 */

		(*s_etat_processus).erreur_systeme = d_es;
		(*s_etat_processus).erreur_execution = d_ex_absence_observations;
		return;
	}
	else
	{
		/*
		 * Il existe une variable locale SIGMA. Reste à vérifier l'existence
		 * d'une variable SIGMA globale...
		 */

		i = (*s_etat_processus).position_variable_courante;
		presence_variable = d_faux;

		while(i >= 0)
		{
			if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
					ds_sdat) == 0) && ((*s_etat_processus)
					.s_liste_variables[i].niveau == 1))
			{
				presence_variable = d_vrai;
				break;
			}

			i--;
		}

		if (presence_variable == d_faux)
		{
			(*s_etat_processus).erreur_execution = d_ex_absence_observations;
			return;
		}
		else
		{
			(*s_etat_processus).position_variable_courante = i;

			if ((*s_etat_processus).s_liste_variables[i].objet == NULL)
			{
				(*s_etat_processus).erreur_execution = d_ex_variable_partagee;
				return;
			}

			if (((*((*s_etat_processus).s_liste_variables
					[(*s_etat_processus).position_variable_courante].objet))
					.type != MIN) && ((*((*s_etat_processus)
					.s_liste_variables[(*s_etat_processus)
					.position_variable_courante].objet)).type != MRL))
			{
				(*s_etat_processus).erreur_execution =
						d_ex_matrice_statistique_invalide;
				return;
			}

			nombre_colonnes = (*((struct_matrice *) (*((*s_etat_processus)
					.s_liste_variables[(*s_etat_processus)
					.position_variable_courante].objet)).objet))
					.nombre_colonnes;
		}
	}

	s_objet_statistique = ((*s_etat_processus).s_liste_variables
			[(*s_etat_processus).position_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 < (long) (*((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 < (long) (*((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(nombre_colonnes * sizeof(real8))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			for(j = 0; j < (long) 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 < (long) (*((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(nombre_colonnes * sizeof(integer8))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			for(j = 0; j < (long) 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 < (long) (*((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)
{
	logical1							presence_variable;

	long								i;
	long								j;

	struct_objet						*s_objet_statistique;
	struct_objet						*s_objet_resultat;

	unsigned long						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(s_etat_processus, ds_sdat) == d_faux)
	{
		/*
		 * Aucune variable SIGMA
		 */

		(*s_etat_processus).erreur_systeme = d_es;
		(*s_etat_processus).erreur_execution = d_ex_absence_observations;
		return;
	}
	else
	{
		/*
		 * Il existe une variable locale SIGMA. Reste à vérifier l'existence
		 * d'une variable SIGMA globale...
		 */

		i = (*s_etat_processus).position_variable_courante;
		presence_variable = d_faux;

		while(i >= 0)
		{
			if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
					ds_sdat) == 0) && ((*s_etat_processus)
					.s_liste_variables[i].niveau == 1))
			{
				presence_variable = d_vrai;
				break;
			}

			i--;
		}

		if (presence_variable == d_faux)
		{
			(*s_etat_processus).erreur_execution = d_ex_absence_observations;
			return;
		}
		else
		{
			(*s_etat_processus).position_variable_courante = i;

			if ((*s_etat_processus).s_liste_variables[i].objet == NULL)
			{
				(*s_etat_processus).erreur_execution = d_ex_variable_partagee;
				return;
			}

			if (((*((*s_etat_processus).s_liste_variables
					[(*s_etat_processus).position_variable_courante].objet))
					.type != MIN) && ((*((*s_etat_processus)
					.s_liste_variables[(*s_etat_processus)
					.position_variable_courante].objet)).type != MRL))
			{
				(*s_etat_processus).erreur_execution =
						d_ex_matrice_statistique_invalide;
				return;
			}

			nombre_colonnes = (*((struct_matrice *) (*((*s_etat_processus)
					.s_liste_variables[(*s_etat_processus)
					.position_variable_courante].objet)).objet))
					.nombre_colonnes;
		}
	}

	s_objet_statistique = ((*s_etat_processus).s_liste_variables
			[(*s_etat_processus).position_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 < (long) (*((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 < (long) (*((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(nombre_colonnes * sizeof(real8))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			for(j = 0; j < (long) 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 < (long) (*((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(nombre_colonnes * sizeof(integer8))) == NULL)
			{
				(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
				return;
			}

			for(j = 0; j < (long) 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 < (long) (*((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