{(C)2k4 Andr3K, Distribute under GPL 2.0 ;-)}
{BTW, chce to tab characters @ 1 TAB=4 sp}
program radix_trie;

const DEBUG=true;
	FIND_PARTS=false; {ci ma test() hladat aj casti slov... radsej nie :)}

type pnode=^node;
	node=record
		pocet: integer;
		znacka: boolean;
		synovia: array['a'..'z'] of pnode;
	end;

var root, out: pnode;
	c: char;

{item maker :)}
procedure make(var item: pnode);
begin
	new(item);
	item^.pocet:=1;
	item^.znacka:=false;
	for c:='a' to 'z' do
		item^.synovia[c]:=nil;
end;

{interna funkcia...}
function test2(var root: pnode; co: string; var out: pnode; check: boolean):boolean;
var i: integer;
	cn: pnode;
	found: boolean;
begin
	if (DEBUG) then write('TEST: ', co, ': ');

	cn:=root;
	i:=1;
	found:=true;

	while (i<=length(co)) and (found) do begin
		if (cn^.synovia[co[i]]=nil) then found:=false
		else begin
		    if (i<=length(co)) then {kvoli OUT}
				cn:=cn^.synovia[co[i]];
		    if (check) then
				inc(cn^.pocet);
		    i:=i+1;
		end;
	end;

	test2:=found;
	if (found) then out:=cn
	else out:=nil;
end;

function test(root: pnode; co: string):boolean;
var kam: pnode;
begin
	test:=test2(root, co, kam, false);
	if (not FIND_PARTS) then
		if (not kam^.znacka) then test:=false;
end;

function insert(var root: pnode; co: string):boolean;
var ft: pnode;
	i: integer;
	cn: pnode;
	found: boolean;
begin
	if (root=nil) then make(root);

	if (DEBUG) then write('INSERT: ', co, ': ');
	if (test2(root, co, ft, false)=true) then begin {uz tam nieco je}
		if (DEBUG) then write('DONE => ');
		if (ft^.znacka=false) then begin {keby niekto nahodou chcel pridavat to iste slovo viackrat}
			test2(root, co, ft, true);
			if (DEBUG) then write('n>1 => ');
		end;
        {v kazdom pripade, oznacime to za slovo}
		ft^.znacka:=true;
		insert:=false;
	end else begin {nemali sme stastie, slovo treba pridat :-/) }
		cn:=root;
		i:=1;
		found:=true;

        {najprf najdeme cast slova, ktora sa tam da dat...}
		while (i<=length(co)) and (found) do begin
			if (cn^.synovia[co[i]]=nil) then found:=false
			else begin
				inc(cn^.pocet);
				cn:=cn^.synovia[co[i]]; {troxu to urychlime vypustenim if-u, ktory bude vzdy true :)}
				i:=i+1;
			end;
		end;
		inc(cn^.pocet);

		if (DEBUG) then write(i, '... ');
		{teraz este musime pridat minimalne 1 item :) }
		while (i<=length(co)) do begin
			make(cn^.synovia[co[i]]);
			cn:=cn^.synovia[co[i]];
			i:=i+1;
		end;
        {a oznacit to za slovo}
		cn^.znacka:=true;
		insert:=true;
	end;
end;

function remove(var root: pnode; co: string):boolean;
var n, nn, np: pnode;
	i: integer;
begin
	if (DEBUG) then write('REMOVE: ', co, ': ');

	if (test2(root, co, n, false)=false) then begin {slovo neexistuje...}
		if (DEBUG) then write('FALSE => ');
		remove:=false;
	end else begin
		if (DEBUG) then write('TRUE => ');
		if (n^.znacka=true) then begin
			if (DEBUG) then write('OK => ');
			{
			 vymazat je mozne (v tejto implementacii) len pridane slovo...
			 technicky by sa dali vymazavat aj nepridane slova, ale bolo
			 by to zrejme zbytocne a zbytocne by potom bolo aj pouzitie
			 premennej node.pocet...
			}

			i:=1;
			n:=root^.synovia[co[1]];
			np:=root;

			while (i<=length(co)) do begin
				if (n^.pocet=1) then begin {taketo pismeno uz mozeme vymazat (a btw, aj dalsie)}
					if (np<>nil) then
						np^.synovia[co[i]]:=nil;
					nn:=n^.synovia[co[i+1]];
					dispose(n);
					n:=nn;
					np:=nil;
				end else begin {inak iba zmensime pocet pouziti...}
					dec(n^.pocet);
					np:=n;
					n:=n^.synovia[co[i+1]];
				end;
				i:=i+1;
			end;
			remove:=true;
		end else remove:=false;
	end;
end;

{help function: vypise pocty pouziti pismen daneho retazca...}
procedure wrnums(root: pnode; co: string);
var i: integer;
	c: pnode;
begin
	write(co, ': ');
	c:=root^.synovia[co[1]];

	for i:=1 to length(co) do begin
		if (c<>nil) then begin
			write(c^.pocet, ' ');
			c:=c^.synovia[co[i+1]];
		end else write('0 ');
	end;
	writeln;
end;

begin
	{DEMO USE}
    writeln('"', insert(root, 'testik'), '"');
    if (DEBUG) then wrnums(root, 'testik');
    writeln('"', insert(root, 'test'), '"');
    if (DEBUG) then wrnums(root, 'testik');
    writeln('"', insert(root, 'andrek'), '"');
    {if (DEBUG) then wrnums(root, 'testik');}
    writeln('"', insert(root, 'temp'), '"');
    if (DEBUG) then wrnums(root, 'testik');

    writeln(test(root, 'test'));
    writeln(test(root, 'testik'));
    writeln(test(root, 'tem'));
    writeln(test(root, 'andrek'));
    writeln(test(root, 'testiky'));

    writeln(remove(root, 'test'));

    writeln(remove(root, 'te'));
    writeln(remove(root, 'testicek'));

    writeln(test(root, 'test'), ' [==TRUE]');
    writeln(remove(root, 'testik'));
    writeln(test(root, 'testik'), ' [==FALSE]; ', test(root, 'test'), ' [==FALSE]');

    writeln(remove(root, 'temp'));

    writeln(test(root, 'temp'));

    writeln(remove(root, 'andrek'));
    writeln('"', insert(root, 'death_test'), '"');
    writeln(test(root, 'death_test'));

    writeln('-------------------------');
    {freeall nebolo v zadani, ale dalo by sa to rekurzivne velmi rychlo :) }
end.