huffman :-
L = 'this is an example for huffman encoding',
atom_chars(L, LA),
msort(LA, LS),
packList(LS, PL),
sort(PL, PLS),
build_tree(PLS, A),
coding(A, [], C),
sort(C, SC),
format('Symbol~t Weight~t~30|Code~n'),
maplist(print_code, SC).




build_tree([[V1|R1], [V2|R2]], [V, [V1|R1], [V2|R2]]) :-
V is V1+V2.


build_tree([[V1|R1], [V2|R2] | T], AF) :-
V is V1 + V2,
A = [V, [V1|R1], [V2|R2]],
sort([A| T], NT),
build_tree(NT, AF).


coding([_A,FG,FD], Code, CF) :-
( is_node(FG) ->
coding(FG, [0 | Code], C1);
leaf_coding(FG, [0|Code], C1)
),
( is_node(FD) ->
coding(FD, [1 | Code], C2);
leaf_coding(FD, [1 | Code], C2)
),
append(C1, C2, CF).

leaf_coding([FG,FD], Code, CF) :-
reverse(Code, CodeR),
CF = [[FG, FD, CodeR]] .


is_node([_V, _FG, _FD]).


print_code([N, Car, Code]):-
format('~w :~t~w~t~30|', [Car, N]),
forall(member(V, Code), write(V)),
nl.


Хаскель


import Data.List
import Control.Arrow
import Data.Ord

data HTree a = Leaf a | Branch (HTree a) (HTree a)
deriving (Show, Eq, Ord)

freq :: (Ord a) => [a] -> [(Int, a)]
freq = map(length &&& head). group. sort

serialize :: HTree d -> [(d, String)]
serialize (Branch l r) = map (second('0':)) (serialize l) ++ map (second('1':)) (serialize r)
serialize (Leaf x) = [(x, "")]

htree :: (Ord t, Num t) => [(t, HTree a)] -> HTree a
htree [(_, t)] = t
htree ((w1,t1):(w2,t2):wts) =
htree $ insertBy (comparing fst) (w1 + w2, Branch t1 t2) wts

huffman :: (Ord w, Num w) => [(w, a)] -> [(a, String)]
huffman = serialize. htree. sortBy (comparing fst). map (second Leaf)

huffman :-
L = 'this is an example for huffman encoding',
atom_chars(L, LA),
msort(LA, LS),
packList(LS, PL),
sort(PL, PLS),
build_tree(PLS, A),
coding(A, [], C),
sort(C, SC),
format('Symbol~t Weight~t~30|Code~n'),
maplist(print_code, SC).




build_tree([[V1|R1], [V2|R2]], [V, [V1|R1], [V2|R2]]) :-
V is V1+V2.


build_tree([[V1|R1], [V2|R2] | T], AF) :-
V is V1 + V2,
A = [V, [V1|R1], [V2|R2]],
sort([A| T], NT),
build_tree(NT, AF).


coding([_A,FG,FD], Code, CF) :-
( is_node(FG) ->
coding(FG, [0 | Code], C1);
leaf_coding(FG, [0|Code], C1)
),
( is_node(FD) ->
coding(FD, [1 | Code], C2);
leaf_coding(FD, [1 | Code], C2)
),
append(C1, C2, CF).

leaf_coding([FG,FD], Code, CF) :-
reverse(Code, CodeR),
CF = [[FG, FD, CodeR]] .


is_node([_V, _FG, _FD]).


print_code([N, Car, Code]):-
format('~w :~t~w~t~30|', [Car, N]),
forall(member(V, Code), write(V)),
nl.



packList([],[]).

packList([X],[[1,X]]) :- !.

packList([X|Rest],[XRun|Packed]):-
run(X,Rest, XRun,RRest),
packList(RRest,Packed).

run(Var,[],[1,Var],[]).

run(Var,[Var|LRest],[N1,Var],RRest):-
run(Var,LRest,[N, Var],RRest),
N1 is N + 1.

run(Var,[Other|RRest], [1,Var],[Other|RRest]):-
dif(Var,Other).

import Data.List
import Control.Arrow
import Data.Ord

data HTree a = Leaf a | Branch (HTree a) (HTree a)
deriving (Show, Eq, Ord)

freq :: (Ord a) => [a] -> [(Int, a)]
freq = map(length &&& head). group. sort

serialize :: HTree d -> [(d, String)]
serialize (Branch l r) = map (second('0':)) (serialize l) ++ map (second('1':)) (serialize r)
serialize (Leaf x) = [(x, "")]

htree :: (Ord t, Num t) => [(t, HTree a)] -> HTree a
htree [(_, t)] = t
htree ((w1,t1):(w2,t2):wts) =
htree $ insertBy (comparing fst) (w1 + w2, Branch t1 t2) wts

huffman :: (Ord w, Num w) => [(w, a)] -> [(a, String)]
huffman = serialize. htree. sortBy (comparing fst). map (second Leaf)