program huffman;

	const
		MAX = 500;
	   {longueur maximale du texte entre' et code' en nombre de car.}
		N = 256;
		M = 2 * N - 1;
	type
		info = record
				lettre: char;
				nombre: integer;
			end;
		tableau_texte = array[1..MAX] of char;
		tableau_caracteres = array[0..255] of integer;
		tableau_lettres = array[1..N] of info;
		noeud = record
				filsG, filsD: 0..M;
				poids: integer;
				bool: boolean;
			   {le boolean bool est a vrai lorsque le noeud est a prendre en}
			   {compte pour le calcul du minimum }
			end;
		arbre = array[1..M] of noeud;
		motcode = string;
		pt = ^motcode;
		tableau_chaine = array[0..255] of pt;

	var
		occurence: tableau_caracteres;
	   {tableau permettant de compter les occurences de chaque caractere ascii}
		code_lettre: tableau_chaine;
	   {tableau donnant pour chaque lettre son code (suites de 0 ,1)}
		t: tableau_lettres;
	   {tableau indiquant dans les cases 1 a nbfeuille  une lettre apparaissant }
	   {avec son occurence non nulle}
		taille_texte: integer;
	   {taille du texte a coder en nombre de caracteres}
		taille_code: integer;
	   {taille du texte code' en nombre de caracteres}
		nbfeuille: integer;
	   {nombre del ettres distinctes du texte=nombre de feuilles de l'arbre}
		nbnoeud: integer;
	   {nombre de noeuds de l'arbre=2*nombre de feuilles -1 }
		h: arbre;
		texte, code: tableau_texte;
	   {texte a coder et texte code}
{--------------------------------------------------------------------------------------------------------------}
	procedure lire_texte;
	{lit le texte, construit les tableaux occurence et t definis ci-dessus}
	{la procedure affiche ensuite le tableau t.}
	{Le texte est ici une chaine de caracteres qui se termine}
	{par une fin de ligne (non comptee)}
		var
			c: char;
			i: integer;
	begin
		taille_texte := 0;
		nbfeuille := 0;
		for i := 0 to 255 do
			occurence[i] := 0;
		while not eoln do
			begin
				read(c);
				taille_texte := taille_texte + 1;
				texte[taille_texte] := c;
				occurence[ord(c)] := occurence[ord(c)] + 1;
			end;
		readln;
		for i := 0 to 255 do
			if (occurence[i] > 0) then
				begin
					nbfeuille := nbfeuille + 1;
					t[nbfeuille].lettre := chr(i);
					t[nbfeuille].nombre := occurence[i];
				end;
		for i := 1 to nbfeuille do
			begin
				write(t[i].lettre);
				write(' : ');
				writeln(t[i].nombre : 2);
			end;
		nbnoeud := 2 * nbfeuille - 1;
	end;

	procedure initialisation_arbre;
		var
			i: integer;
	begin
		for i := nbfeuille + 1 to nbnoeud do
			begin
				h[i].filsG := 0;
				h[i].filsD := 0;
				h[i].bool := false;
			end;
		for i := 1 to nbfeuille do
			begin
				h[i].filsG := 0;
				h[i].filsD := 0;
				h[i].poids := t[i].nombre;
				h[i].bool := true;
			end;
	end;
{------------------------------------   partie  principale --------------------------------------}
	function extraire_min: integer;
	{renvoie le numero du noeud de poids minimal parmi  les noeuds dont}
	{bool est vrai. Le booleen de ce noeud est mis a faux}
		var
			i, min, indicemin: integer;
	begin
		i := 1;
		while h[i].bool = false do
			i := i + 1;
		min := h[i].poids;
		indicemin := i;
		for i := indicemin to nbnoeud do
			begin
				if (h[i].bool = true) and (h[i].poids < min) then
					begin
						min := h[i].poids;
						indicemin := i;
					end;
			end;
		h[indicemin].bool := false;
		extraire_min := indicemin;
	end;

	procedure huffman;
		var
			i: integer;
	begin
		for i := nbfeuille + 1 to nbnoeud do
			begin
				h[i].filsG := extraire_min;
				h[i].filsD := extraire_min;
				h[i].poids := h[h[i].filsG].poids + h[h[i].filsD].poids;
				h[i].bool := true;
			end;
	end;
{-----------------------------------------------------------------------------------------------}
	procedure afficher_arbre;
		var
			i: integer;
	begin
		for i := 1 to nbnoeud do
			begin
				write(h[i].bool : 2, h[i].filsG : 2, h[i].filsD : 2, h[i].poids : 2);
				if i <= nbfeuille then
					write(t[i].lettre : 2);
				writeln;
			end;
	end;
{---------------------------------------------------------------------------------------------------------}

	procedure calcul_code;
		var
			i: integer;
			s: motcode;

		procedure calcul_code_rec (x: integer);
		begin
			if h[x].filsG = 0 then {on est sur une feuille}
				begin
					new(code_lettre[ord(t[x].lettre)]);
					code_lettre[ord(t[x].lettre)]^ := s
				end
			else
				begin
					s := concat(s, '0');
					calcul_code_rec(h[x].filsG);
					s := omit(s, length(s), length(s));
					s := concat(s, '1');
					calcul_code_rec(h[x].filsD);
					s := omit(s, length(s), length(s));
				end;
		end;

	begin
		i := 1;
		s := '';
		calcul_code_rec(nbnoeud);
	end;

	procedure coder;
		var
			i, j: integer;
	begin
		taille_code := 0;
		for i := 1 to taille_texte do
			for j := 1 to length(code_lettre[ord(texte[i])]^) do
				begin
					taille_code := taille_code + 1;
					code[taille_code] := code_lettre[ord(texte[i])]^[j];
				end;
		for i := 1 to taille_code do
			write(code[i]);
		writeln;
	end;

	procedure decoder;
		var
			c: char;
			i: integer;
		procedure parcours_rec (x: integer);
		begin
			if x <= nbfeuille then {x est une feuille}
				write(t[x].lettre)
			else
				begin
					c := code[i];
					i := i + 1;
					if c = '0' then
						parcours_rec(h[x].filsG)
					else
						parcours_rec(h[x].filsD);
				end;
		end;

	begin
		i := 1;
		while (i <= taille_code) do
			parcours_rec(nbnoeud);
		writeln;
	end;

{---------------------------------------------------------------------------------------------------------}
begin {principal}
	writeln('Entrer une suite de caracteres terminee par une fin de ligne : c''est le texte');
	lire_texte;
	initialisation_arbre;
	huffman;
	afficher_arbre;
	writeln('Le texte code est:');
	calcul_code;
	coder;
	writeln('Le texte decode est:');
	decoder;
end.  {principal}