% Deeltaak 1
contract([],[]). % lege lijst
contract([A|T],Uit) :- % niet-lege lijst
    contract([A|T],1,Uit). % beginwaarde accumulator: 1

contract([A],N1,[N1-A]). % Voor wanneer er 1 element over is
contract([A,A|T],N,Lijst) :-  % Indien de eerste twee elementen uit de lijst hetzelfde zijn
    N1 is N+1,
    contract([A|T],N1,Lijst). % Ga hierna nogmaals door de lijst met de nieuwe frequentie en zonder het eerste element
contract([A,A1|T],N,Lijst) :-
    A\=A1,
    contract([A1|T],1,L2),
    append([N-A],L2,Lijst).

% Deeltaak 2
% Merge 4 keer is dit echt nodig?
merge(P1,tree(L1,K1,R1),P2,tree(L2,K2,R2),P,tree(tree(L1,K1,R1),Yield,tree(L2,K2,R2))) :- P is P1+P2, append(K1,K2,Yield).
merge(P1,tree(L1,K1,R1),P2,K2,P,tree(tree(L1,K1,R1),Yield,leaf(K2))) :- P is P1+P2, append(K1,[K2],Yield).
merge(P1,K1,P2,tree(L2,K2,R2),P,tree(leaf(K1),Yield,tree(L2,K2,R2))) :- P is P1+P2, append([K1],K2,Yield).
merge(P1,K1,P2,K2,P,tree(leaf(K1),Yield,leaf(K2))) :- P is P1+P2, append([K1],[K2],Yield).

heap_to_tree(Heap,Tree) :-
    singleton_heap(Heap,_,Tree).

heap_to_tree(Heap, Tree) :-
    get_from_heap(Heap,P0,K0,H0),
    get_from_heap(H0,P1,K1,H1),
    merge(P1,K1,P0,K0,P2,K2),
    add_to_heap(H1,P2,K2,H2),
    heap_to_tree(H2,Tree).

% Deeltaak 3
% Dit moet met verschillijsten
member(X,[X|_]).
member(X,[_|T])  :-  member(X,T).

symbol_code(A,leaf(A),CodeRest,CodeRest).
symbol_code(A,tree(Links,Yield,_),[0|Code],CodeRest) :- member(A,Yield), symbol_code(A,Links,Code,CodeRest).
symbol_code(A,tree(_,Yield,Rechts),[1|Code],CodeRest) :- member(A,Yield), symbol_code(A,Rechts,Code,CodeRest).

% Deeltaak 4
encode([],_) --> [].
encode([H|T],Tree) --> symbol_code(H,Tree),encode(T,Tree).

% Deeltaak 5
export_dcg(CodeList) :-
    tell('huffdcg.pl'),
    % format/2 code voor het schrijven van de DCG regels
    maplist(format("huff([~q|L]) --> ~i~w,huff(L).\n"),CodeList),
    format("huff([]) --> [].",[]), % laatste regel/grensgeval
    told.





% Modelleren en programmeren 2014-15. Inleveropdracht 4: testpredicaten

% Wikipedia: http://en.wikipedia.org/wiki/Huffman_coding

% We gebruiken de heaps library voor priority queues:

:- use_module(library(heaps)).

% Twee testpredicaten: huffman/2 voor klein voorbeeld,
% huffman/1 voor invoer van een compleet tekstbestand.

% huffman/1: file invoer

time(huffman(File)) :-
    read_file_to_codes(File,Codes,[]),
    atom_codes(L,Codes),
    huffman(L,_).

% huffman/2: simpele teststring (L: atom)

huffman(L,Tree) :-
%
%   bijvoorbeeld L = 'this is an example of a huffman tree',
%
    atom_chars(L, LA), % zet tekst om in losse karakters
    msort(LA, LS), % multiset sorting
    contract(LS, PL), % DEELTAAK 1
    list_to_heap(PL,Heap), % cf library(heaps)
    heap_to_tree(Heap,Tree), % DEELTAAK 2
%
% schermuitvoer:
%
    sort(PL,PLs),
    reverse(PLs,LAs),
    code_list(LAs,Tree,Codes),
    print_codes(Codes),nl,
    encode(LA,Tree,Code,[]),nl, % DEELTAAK 3 (symbol_code) en 4
    length(Code,K),
%   kies een van beide format/2 instructies hieronder
    format("Code: ~w~nLengte (in bits): ~d\n",[Code,K]),
%   format("Length encoded message (bits): ~d\n",[K]),
    length(LA,Length), % lengte invoer in karakters
    stats(Codes,Length,SumL,SumH), % statistiek
    format("Weighted path length L(C): ~f\nEntropy H(A): ~f\n",[SumL,SumH]),
%
% DCG uitvoer (als bestand huffdcg.pl):
%
    export_dcg(Codes), % DEELTAAK 5
    consult('huffdcg.pl'). % check of de DCG foutloos laadt

% Invoer/Uitvoerroutines

code_list([P-K|Rest],Tree,[[K,P,Code]|Codes]) :-
    symbol_code(K,Tree,Code,[]),
    code_list(Rest,Tree,Codes).
code_list([],_,[]).

% print_codes/1

% Elementen van CodeList zijn [Key,Priority,Code] tupels
% format/2 documentatie:
% ~q zorgt ervoor dat atomen waar nodig aanhalingstekens krijgen

print_codes(CodeList) :-
    maplist(format("~q\t~d\t~w\n"),CodeList).

% statistics

stats(Codes,K,L,H) :-
    % Codes: list of [Key,Priority,Code] triples,
    % K: length message (in symbols)
    lh(Codes,K,LWs,Hs),
    sum_list(LWs,L),
    sum_list(Hs,H).

% lh/4: computes L(C) and H(A)
% Input: list of [Key,Priority,Code] tupels; N: lengte tekst

lh([],_,[],[]).
lh([[_,P,C]|R],N,[L|T],[H|S]) :-
    P1 is P/N,length(C,CodeLength),
    L is P1*CodeLength, % weighted path length
    log2(P1,Log2),H is -P1*Log2, % entropy
    lh(R,N,T,S).

% log2, defined from built-in arithmetic function log/1

log2(N,Log2) :- Log2 is log(N)/log(2).