/*
================================================================================
  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 réalisant la somme de la matrice statistique
================================================================================
  Entrées : pointeur sur une matrice entière ou réelle
--------------------------------------------------------------------------------
  Sorties : renvoie NULL s'il y a defaut de mémoire
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

struct_vecteur *
sommation_statistique(struct_processus *s_etat_processus,
		struct_matrice *s_matrice)
{
	integer8					*cumul_entier;

	logical1					erreur_memoire;
	logical1					resultat_entier;

	real8						*colonne;

	struct_vecteur				*s_vecteur;

	integer8					i;
	integer8					j;

	if ((s_vecteur = (struct_vecteur *) malloc(sizeof(struct_vecteur)))
			== NULL)
	{
		return NULL;
	}

	/*
	 * Calculs en virgule fixe
	 */

	if ((*s_matrice).type == 'I')
	{
		if ((cumul_entier = (integer8 *) malloc(((size_t) (*s_matrice)
				.nombre_colonnes) * sizeof(integer8))) == NULL)
		{
			free(s_vecteur);
			return NULL;
		}

		for(j = 0; j < (*s_matrice).nombre_colonnes; cumul_entier[j++] = 0);

		for(resultat_entier = d_vrai, i = 0; (i < (*s_matrice).nombre_lignes)
				&& (resultat_entier == d_vrai); i++)
		{
			for(j = 0; (j < (*s_matrice).nombre_colonnes) &&
					(resultat_entier == d_vrai); j++)
			{
				if (depassement_addition(&(cumul_entier[j]), &(((integer8 **)
						(*s_matrice).tableau)[i][j]), &(cumul_entier[j]))
						== d_erreur)
				{
					resultat_entier = d_faux;
				}
			}
		}

		if (resultat_entier == d_vrai)
		{
			/*
			 * Pas de dépassement
			 */

			(*s_vecteur).type = 'I';
			(*s_vecteur).taille = (*s_matrice).nombre_colonnes;
			(*s_vecteur).tableau = cumul_entier;
		}
		else
		{
			/*
			 * Dépassement... Refaire le calcul en virgule flottante
			 */

			free(cumul_entier);

			if (((*s_vecteur).tableau = malloc(((size_t) (*s_matrice)
					.nombre_colonnes) * sizeof(real8))) == NULL)
			{
				free(s_vecteur);
				return NULL;
			}

			if ((colonne = (real8 *) malloc(((size_t) (*s_matrice)
					.nombre_lignes) * sizeof(real8))) == NULL)
			{
				free(s_vecteur);
				return NULL;
			}

			for(j = 0; j < (*s_matrice).nombre_colonnes; j++)
			{
				for(i = 0; i < (*s_matrice).nombre_lignes; i++)
				{
					colonne[i] = (real8) ((integer8 **)
							(*s_matrice).tableau)[i][j];
				}

				((real8 *) (*s_vecteur).tableau)[j] = sommation_vecteur_reel(
						colonne, &((*s_matrice).nombre_lignes),
						&erreur_memoire);

				if (erreur_memoire == d_vrai)
				{
					free(s_vecteur);
					return NULL;
				}
			}

			free(colonne);

			(*s_vecteur).type = 'R';
			(*s_vecteur).taille = (*s_matrice).nombre_colonnes;
		}
	}

	/*
	 * Calculs en virgule flottante
	 */

	else if ((*s_matrice).type == 'R')
	{
		if (((*s_vecteur).tableau = malloc(((size_t) (*s_matrice)
				.nombre_colonnes) * sizeof(real8))) == NULL)
		{
			free(s_vecteur);
			return NULL;
		}

		if ((colonne = (real8 *) malloc(((size_t) (*s_matrice).nombre_lignes) *
				sizeof(real8))) == NULL)
		{
			free(s_vecteur);
			return NULL;
		}

		for(j = 0; j < (*s_matrice).nombre_colonnes; j++)
		{
			for(i = 0; i < (*s_matrice).nombre_lignes; i++)
			{
				colonne[i] = ((real8 **) (*s_matrice).tableau)[i][j];
			}

			((real8 *) (*s_vecteur).tableau)[j] = sommation_vecteur_reel(
					colonne, &((*s_matrice).nombre_lignes), &erreur_memoire);

			if (erreur_memoire == d_vrai)
			{
				free(s_vecteur);
				return NULL;
			}
		}

		free(colonne);

		(*s_vecteur).type = 'R';
		(*s_vecteur).taille = (*s_matrice).nombre_colonnes;
	}

	return s_vecteur;
}


/*
================================================================================
  Fonction réalisant la somme des produits d'une colonne de la matrice
  statistique par une autre colonne
================================================================================
  Entrées : pointeur sur une matrice entière ou réelle
--------------------------------------------------------------------------------
  Sorties : renvoie NULL s'il y a defaut de mémoire
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

struct_vecteur *
sommation_produits_colonnes_statistiques(struct_processus *s_etat_processus,
		struct_matrice *s_matrice,
		integer8 position_1, integer8 position_2)
{
	integer8					*cumul_entier;
	integer8					tampon;

	logical1					erreur_memoire;
	logical1					resultat_entier;

	real8						*colonne;

	struct_vecteur				*s_vecteur;

	integer8					i;

	if ((s_vecteur = (struct_vecteur *) malloc(sizeof(struct_vecteur))) == NULL)
	{
		return NULL;
	}

	position_1--;
	position_2--;

	/*
	 * Calculs en virgule fixe
	 */

	if ((*s_matrice).type == 'I')
	{
		if ((cumul_entier = (integer8 *) malloc(sizeof(integer8))) == NULL)
		{
			free(s_vecteur);
			return NULL;
		}

		(*cumul_entier) = 0;

		for(resultat_entier = d_vrai, i = 0; (i < (*s_matrice).nombre_lignes)
				&& (resultat_entier == d_vrai); i++)
		{
			if (depassement_multiplication(&(((integer8 **) (*s_matrice)
					.tableau)[i][position_1]), &(((integer8 **) (*s_matrice)
					.tableau)[i][position_2]), &tampon) == d_erreur)
			{
				resultat_entier = d_faux;
			}
			else if (depassement_addition(cumul_entier, &tampon, cumul_entier)
					== d_erreur)
			{
				resultat_entier = d_faux;
			}
		}

		if (resultat_entier == d_vrai)
		{
			/*
			 * Pas de dépassement
			 */

			(*s_vecteur).type = 'I';
			(*s_vecteur).taille = 1;
			(*s_vecteur).tableau = cumul_entier;
		}
		else
		{
			/*
			 * Dépassement... Refaire le calcul en virgule flottante
			 */

			free(cumul_entier);

			if (((*s_vecteur).tableau = malloc(sizeof(real8))) == NULL)
			{
				free(s_vecteur);
				return NULL;
			}

			if ((colonne = (real8 *) malloc(((size_t) (*s_matrice)
					.nombre_lignes) * sizeof(real8))) == NULL)
			{
				free(s_vecteur);
				return NULL;
			}

			for(i = 0; i < (*s_matrice).nombre_lignes; i++)
			{
				colonne[i] = ((real8) ((integer8 **)
						(*s_matrice).tableau)[i][position_1]) *
						((real8) ((integer8 **) (*s_matrice).tableau)
						[i][position_2]);
			}

			(*((real8 *) (*s_vecteur).tableau)) = sommation_vecteur_reel(
					colonne, &((*s_matrice).nombre_lignes),
					&erreur_memoire);

			if (erreur_memoire == d_vrai)
			{
				free(s_vecteur);
				return NULL;
			}

			free(colonne);

			(*s_vecteur).type = 'R';
			(*s_vecteur).taille = 1;
		}
	}

	/*
	 * Calculs en virgule flottante
	 */

	else if ((*s_matrice).type == 'R')
	{
		if (((*s_vecteur).tableau = malloc(sizeof(real8))) == NULL)
		{
			free(s_vecteur);
			return NULL;
		}

		if ((colonne = (real8 *) malloc(((size_t) (*s_matrice).nombre_lignes) *
				sizeof(real8))) == NULL)
		{
			free(s_vecteur);
			return NULL;
		}

		for(i = 0; i < (*s_matrice).nombre_lignes; i++)
		{
			colonne[i] = ((real8 **) (*s_matrice).tableau)[i][position_1]
					* ((real8 **) (*s_matrice).tableau)[i][position_2];
		}

		(*((real8 *) (*s_vecteur).tableau)) = sommation_vecteur_reel(
				colonne, &((*s_matrice).nombre_lignes), &erreur_memoire);

		if (erreur_memoire == d_vrai)
		{
			free(s_vecteur);
			return NULL;
		}

		free(colonne);

		(*s_vecteur).type = 'R';
		(*s_vecteur).taille = 1;
	}

	return s_vecteur;
}


/*
================================================================================
  Fonction réalisant la somme d'une colonne de la matrice statistique
================================================================================
  Entrées : pointeur sur une matrice entière ou réelle
--------------------------------------------------------------------------------
  Sorties : renvoie NULL s'il y a defaut de mémoire
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

struct_vecteur *
sommation_colonne_statistique(struct_processus *s_etat_processus,
		struct_matrice *s_matrice, integer8 position)
{
	integer8					*cumul_entier;

	logical1					erreur_memoire;
	logical1					resultat_entier;

	real8						*colonne;

	struct_vecteur				*s_vecteur;

	integer8					i;

	if ((s_vecteur = (struct_vecteur *) malloc(sizeof(struct_vecteur))) == NULL)
	{
		return NULL;
	}

	position--;

	/*
	 * Calculs en virgule fixe
	 */

	if ((*s_matrice).type == 'I')
	{
		if ((cumul_entier = (integer8 *) malloc(sizeof(integer8))) == NULL)
		{
			free(s_vecteur);
			return NULL;
		}

		(*cumul_entier) = 0;

		for(resultat_entier = d_vrai, i = 0; (i < (*s_matrice).nombre_lignes)
				&& (resultat_entier == d_vrai); i++)
		{
			if (depassement_addition(cumul_entier, &(((integer8 **)
					(*s_matrice).tableau)[i][position]), cumul_entier)
					== d_erreur)
			{
				resultat_entier = d_faux;
			}
		}

		if (resultat_entier == d_vrai)
		{
			/*
			 * Pas de dépassement
			 */

			(*s_vecteur).type = 'I';
			(*s_vecteur).taille = 1;
			(*s_vecteur).tableau = cumul_entier;
		}
		else
		{
			/*
			 * Dépassement... Refaire le calcul en virgule flottante
			 */

			free(cumul_entier);

			if (((*s_vecteur).tableau = malloc(sizeof(real8))) == NULL)
			{
				free(s_vecteur);
				return NULL;
			}

			if ((colonne = (real8 *) malloc(((size_t) (*s_matrice)
					.nombre_lignes) * sizeof(real8))) == NULL)
			{
				free(s_vecteur);
				return NULL;
			}

			for(i = 0; i < (*s_matrice).nombre_lignes; i++)
			{
				colonne[i] = (real8) ((integer8 **)
						(*s_matrice).tableau)[i][position];
			}

			(*((real8 *) (*s_vecteur).tableau)) = sommation_vecteur_reel(
					colonne, &((*s_matrice).nombre_lignes),
					&erreur_memoire);

			if (erreur_memoire == d_vrai)
			{
				free(s_vecteur);
				return NULL;
			}

			free(colonne);

			(*s_vecteur).type = 'R';
			(*s_vecteur).taille = 1;
		}
	}

	/*
	 * Calculs en virgule flottante
	 */

	else if ((*s_matrice).type == 'R')
	{
		if (((*s_vecteur).tableau = malloc(sizeof(real8))) == NULL)
		{
			free(s_vecteur);
			return NULL;
		}

		if ((colonne = (real8 *) malloc(((size_t) (*s_matrice).nombre_lignes) *
				sizeof(real8))) == NULL)
		{
			free(s_vecteur);
			return NULL;
		}

		for(i = 0; i < (*s_matrice).nombre_lignes; i++)
		{
			colonne[i] = ((real8 **) (*s_matrice).tableau)[i][position];
		}

		(*((real8 *) (*s_vecteur).tableau)) = sommation_vecteur_reel(
				colonne, &((*s_matrice).nombre_lignes), &erreur_memoire);

		if (erreur_memoire == d_vrai)
		{
			free(s_vecteur);
			return NULL;
		}

		free(colonne);

		(*s_vecteur).type = 'R';
		(*s_vecteur).taille = 1;
	}

	return s_vecteur;
}


/*
================================================================================
  Fonction réalisant la moyenne de la matrice statistique
================================================================================
  Entrées : pointeur sur une matrice entière ou réelle
--------------------------------------------------------------------------------
  Sorties : renvoie NULL s'il y a defaut de mémoire
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

struct_vecteur *
moyenne_statistique(struct_processus *s_etat_processus,
		struct_matrice *s_matrice)
{
	integer8					*tampon;

	logical1					resultat_entier;

	struct_vecteur				*s_vecteur;

	integer8					i;

	if ((s_vecteur = sommation_statistique(s_etat_processus, s_matrice))
			== NULL)
	{
		return NULL;
	}

	if ((*s_vecteur).type == 'R')
	{
		for(i = 0; i < (*s_vecteur).taille; i++)
		{
			((real8 *) (*s_vecteur).tableau)[i] /= ((real8)
					(*s_matrice).nombre_lignes);
		}
	}
	else
	{
		resultat_entier = d_vrai;

		for(i = 0; i < (*s_vecteur).taille; i++)
		{
			if ((((integer8 *) (*s_vecteur).tableau)[i] %
					(*s_matrice).nombre_lignes) != 0)
			{
				resultat_entier = d_faux;
				break;
			}
		}

		if (resultat_entier == d_vrai)
		{
			for(i = 0; i < (*s_vecteur).taille; i++)
			{
				((integer8 *) (*s_vecteur).tableau)[i] /= ((integer8)
						(*s_matrice).nombre_lignes);
			}
		}
		else
		{
			tampon = (*s_vecteur).tableau;

			if (((*s_vecteur).tableau = malloc(((size_t) (*s_vecteur).taille) *
					sizeof(real8))) == NULL)
			{
				return NULL;
			}

			for(i = 0; i < (*s_vecteur).taille; i++)
			{
				((real8 *) (*s_vecteur).tableau)[i] = ((real8) tampon[i]) /
						((real8) (*s_matrice).nombre_lignes);
			}

			(*s_vecteur).type = 'R';
			free(tampon);
		}
	}

	return s_vecteur;
}


/*
================================================================================
  Fonction réalisant la variance de la matrice statistique
================================================================================
  Entrées : pointeur sur une matrice entière ou réelle et type.
  Type vaut 'E' ou 'P' selon qu'il s'agit de statistiques sur un échantillon
  ou sur la population entière.
--------------------------------------------------------------------------------
  Sorties : renvoie NULL s'il y a defaut de mémoire
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

struct_vecteur *
variance_statistique(struct_processus *s_etat_processus,
		struct_matrice *s_matrice, unsigned char type)
{
	integer8						*tampon;

	logical1						erreur_memoire;

	integer8						i;
	integer8						j;

	real8							*cumul;

	struct_vecteur					*s_moyenne;
	struct_vecteur					*s_variance;

	if ((s_moyenne = moyenne_statistique(s_etat_processus, s_matrice)) == NULL)
	{
		return NULL;
	}

	/*
	 * Le résultat de cette fonction est toujours réel.
	 */

	if ((cumul = (real8 *) malloc(((size_t) (*s_matrice).nombre_lignes) *
		   sizeof(real8))) == NULL)
	{
		return NULL;
	}

	if ((s_variance = (struct_vecteur *) malloc(sizeof(struct_vecteur)))
			== NULL)
	{
		return NULL;
	}

	if ((*s_moyenne).type == 'I') 
	{
		tampon = (*s_moyenne).tableau;

		if (((*s_moyenne).tableau = malloc(((size_t) (*s_moyenne).taille) *
				sizeof(real8))) == NULL)
		{
			return NULL;
		}

		for(i = 0; i < (*s_moyenne).taille; i++)
		{
			((real8 *) (*s_moyenne).tableau)[i] = (real8) (tampon[i]);
		}

		(*s_moyenne).type = 'R';
		free(tampon);
	}

	if (((*s_variance).tableau = malloc(((size_t) (*s_matrice).nombre_colonnes)
			* sizeof(real8))) == NULL)
	{
		return NULL;
	}

	if ((*s_matrice).type == 'I')
	{
		for(j = 0; j < (*s_matrice).nombre_colonnes; j++)
		{
			for(i = 0; i < (*s_matrice).nombre_lignes; i++)
			{
				cumul[i] = (((real8) ((integer8 **) (*s_matrice).tableau)
						[i][j]) - ((real8 *) (*s_moyenne).tableau)[j]) *
						(((real8) ((integer8 **) (*s_matrice).tableau)[i][j]) -
						((real8 *) (*s_moyenne).tableau)[j]);
			}

			((real8 *) (*s_variance).tableau)[j] = sommation_vecteur_reel(
					cumul, &((*s_matrice).nombre_lignes), &erreur_memoire);

			if (erreur_memoire == d_vrai)
			{
				return NULL;
			}

			if (type == 'E')
			{
				((real8 *) (*s_variance).tableau)[j] /= (real8)
						((*s_matrice).nombre_lignes - 1);
			}
			else
			{
				((real8 *) (*s_variance).tableau)[j] /= (real8)
						(*s_matrice).nombre_lignes;
			}
		}
	}
	else
	{
		for(j = 0; j < (*s_matrice).nombre_colonnes; j++)
		{
			for(i = 0; i < (*s_matrice).nombre_lignes; i++)
			{
				cumul[i] = (((real8 **) (*s_matrice).tableau)[i][j] -
						((real8 *) (*s_moyenne).tableau)[j]) *
						(((real8 **) (*s_matrice).tableau)[i][j] -
						((real8 *) (*s_moyenne).tableau)[j]);
			}

			((real8 *) (*s_variance).tableau)[j] = sommation_vecteur_reel(
					cumul, &((*s_matrice).nombre_lignes), &erreur_memoire);

			if (erreur_memoire == d_vrai)
			{
				return NULL;
			}

			if (type == 'E')
			{
				((real8 *) (*s_variance).tableau)[j] /= (real8)
						((*s_matrice).nombre_lignes - 1);
			}
			else
			{
				((real8 *) (*s_variance).tableau)[j] /= (real8)
						(*s_matrice).nombre_lignes;
			}
		}
	}

	free((*s_moyenne).tableau);
	free(s_moyenne);
	free(cumul);

	(*s_variance).type = 'R';
	(*s_variance).taille = (*s_matrice).nombre_colonnes;

	return s_variance;
}


/*
================================================================================
  Fonction réalisant l'écart-type de la matrice statistique
================================================================================
  Entrées : pointeur sur une matrice entière ou réelle
--------------------------------------------------------------------------------
  Sorties : renvoie NULL s'il y a defaut de mémoire
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

struct_vecteur *
ecart_type_statistique(struct_processus *s_etat_processus,
		struct_matrice *s_matrice, unsigned char type)
{
	struct_vecteur					*s_vecteur;

	integer8						i;

	if ((s_vecteur = variance_statistique(s_etat_processus, s_matrice, type))
			== NULL)
	{
		return NULL;
	}

	for(i = 0; i < (*s_vecteur).taille; i++)
	{
		((real8 *) (*s_vecteur).tableau)[i] = sqrt(((real8 *)
				(*s_vecteur).tableau)[i]);
	}

	return s_vecteur;
}


/*
================================================================================
  Fonction réalisant la corrélation de deux colonnes la matrice statistique
================================================================================
  Entrées : pointeur sur une matrice entière ou réelle
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

real8
correlation_statistique(struct_matrice *s_matrice,
		integer8 colonne_1, integer8 colonne_2, logical1 *erreur)
{
	logical1				erreur_memoire;

	real8					denominateur;
	real8					moyenne_colonne_1;
	real8					moyenne_colonne_2;
	real8					numerateur;
	real8					*vecteur;

	integer8				i;
	integer8				nombre_observations;

	(*erreur) = d_absence_erreur;

	if ((vecteur = sys_malloc(((size_t) (nombre_observations =
			(*s_matrice).nombre_lignes)) * sizeof(real8))) == NULL)
	{
		(*erreur) = d_erreur;
		return 0;
	}

	colonne_1--;
	colonne_2--;

	if ((*s_matrice).type == 'R')
	{
		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = ((real8 **) (*s_matrice).tableau)[i][colonne_1];
		}

		moyenne_colonne_1 = sommation_vecteur_reel(vecteur,
				&nombre_observations, &erreur_memoire) /
				((real8) nombre_observations);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}

		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = ((real8 **) (*s_matrice).tableau)[i][colonne_2];
		}

		moyenne_colonne_2 = sommation_vecteur_reel(vecteur,
				&nombre_observations, &erreur_memoire) /
				((real8) nombre_observations);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}

		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = (((real8 **) (*s_matrice).tableau)[i][colonne_1] -
					moyenne_colonne_1) * (((real8 **) (*s_matrice).tableau)
					[i][colonne_2] - moyenne_colonne_2);
		}

		numerateur = sommation_vecteur_reel(vecteur, &nombre_observations,
				&erreur_memoire);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}

		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = (((real8 **) (*s_matrice).tableau)[i][colonne_1] -
					moyenne_colonne_1) * (((real8 **) (*s_matrice).tableau)
					[i][colonne_1] - moyenne_colonne_1);
		}

		denominateur = sommation_vecteur_reel(vecteur, &nombre_observations,
				&erreur_memoire);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}

		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = (((real8 **) (*s_matrice).tableau)[i][colonne_2] -
					moyenne_colonne_2) * (((real8 **) (*s_matrice).tableau)
					[i][colonne_2] - moyenne_colonne_2);
		}

		denominateur *= sommation_vecteur_reel(vecteur, &nombre_observations,
				&erreur_memoire);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}

		denominateur = sqrt(denominateur);
	}
	else
	{
		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = (real8) ((integer8 **) (*s_matrice).tableau)
					[i][colonne_1];
		}

		moyenne_colonne_1 = sommation_vecteur_reel(vecteur,
				&nombre_observations, &erreur_memoire) /
				((real8) nombre_observations);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}

		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = (real8) ((integer8 **) (*s_matrice).tableau)
					[i][colonne_2];
		}

		moyenne_colonne_2 = sommation_vecteur_reel(vecteur,
				&nombre_observations, &erreur_memoire) /
				((real8) nombre_observations);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}

		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = (((real8) ((integer8 **) (*s_matrice).tableau)
					[i][colonne_1]) - moyenne_colonne_1) * (((real8)
					((integer8 **) (*s_matrice).tableau)
					[i][colonne_2]) - moyenne_colonne_2);
		}

		numerateur = sommation_vecteur_reel(vecteur, &nombre_observations,
				&erreur_memoire);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}

		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = (((real8) ((integer8 **) (*s_matrice).tableau)
					[i][colonne_1]) - moyenne_colonne_1) * (((real8)
					((integer8 **) (*s_matrice).tableau)
					[i][colonne_1]) - moyenne_colonne_1);
		}

		denominateur = sommation_vecteur_reel(vecteur, &nombre_observations,
				&erreur_memoire);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}

		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = (((real8) ((integer8 **) (*s_matrice).tableau)
					[i][colonne_2]) - moyenne_colonne_2) * (((real8)
					((integer8 **) (*s_matrice).tableau)
					[i][colonne_2]) - moyenne_colonne_2);
		}

		denominateur *= sommation_vecteur_reel(vecteur, &nombre_observations,
				&erreur_memoire);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}

		denominateur = sqrt(denominateur);
	}

	sys_free(vecteur);

	return numerateur / denominateur;
}


/*
================================================================================
  Fonction réalisant la covariance de deux colonnes la matrice statistique
================================================================================
  Entrées : pointeur sur une matrice entière ou réelle
--------------------------------------------------------------------------------
  Sorties :
--------------------------------------------------------------------------------
  Effets de bord : néant
================================================================================
*/

real8
covariance_statistique(struct_matrice *s_matrice, integer8 colonne_1,
		integer8 colonne_2, unsigned char type, logical1 *erreur)
{
	logical1				erreur_memoire;

	real8					denominateur;
	real8					moyenne_colonne_1;
	real8					moyenne_colonne_2;
	real8					numerateur;
	real8					*vecteur;

	integer8				i;
	integer8				nombre_observations;

	(*erreur) = d_absence_erreur;

	if ((vecteur = sys_malloc(((size_t) (nombre_observations =
			(*s_matrice).nombre_lignes)) * sizeof(real8))) == NULL)
	{
		(*erreur) = d_erreur;
		return 0;
	}

	colonne_1--;
	colonne_2--;

	if (type == 'E')
	{
		denominateur = ((real8) nombre_observations) - 1;
	}
	else
	{
		denominateur = ((real8) nombre_observations);
	}

	if ((*s_matrice).type == 'R')
	{
		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = ((real8 **) (*s_matrice).tableau)[i][colonne_1];
		}

		moyenne_colonne_1 = sommation_vecteur_reel(vecteur,
				&nombre_observations, &erreur_memoire) /
				((real8) nombre_observations);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}

		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = ((real8 **) (*s_matrice).tableau)[i][colonne_2];
		}

		moyenne_colonne_2 = sommation_vecteur_reel(vecteur,
				&nombre_observations, &erreur_memoire) /
				((real8) nombre_observations);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}

		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = (((real8 **) (*s_matrice).tableau)[i][colonne_1] -
					moyenne_colonne_1) * (((real8 **) (*s_matrice).tableau)
					[i][colonne_2] - moyenne_colonne_2);
		}

		numerateur = sommation_vecteur_reel(vecteur, &nombre_observations,
				&erreur_memoire);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}
	}
	else
	{
		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = (real8) ((integer8 **) (*s_matrice).tableau)
					[i][colonne_1];
		}

		moyenne_colonne_1 = sommation_vecteur_reel(vecteur,
				&nombre_observations, &erreur_memoire) /
				((real8) nombre_observations);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}

		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = (real8) ((integer8 **) (*s_matrice).tableau)
					[i][colonne_2];
		}

		moyenne_colonne_2 = sommation_vecteur_reel(vecteur,
				&nombre_observations, &erreur_memoire) /
				((real8) nombre_observations);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}

		for(i = 0; i < nombre_observations; i++)
		{
			vecteur[i] = (((real8) ((integer8 **) (*s_matrice).tableau)
					[i][colonne_1]) - moyenne_colonne_1) * (((real8)
					((integer8 **) (*s_matrice).tableau)
					[i][colonne_2]) - moyenne_colonne_2);
		}

		numerateur = sommation_vecteur_reel(vecteur, &nombre_observations,
				&erreur_memoire);

		if (erreur_memoire == d_vrai)
		{
			(*erreur) = d_erreur;
			return 0;
		}
	}

	sys_free(vecteur);

	return numerateur / denominateur;
}

// vim: ts=4