Huffman Tree in LISP


huff xs -> xs.sort.{[x@xs ys:_:@{l=>l.lhd!=x}]=>[[x@xs] @ys.rec]}
           |> map x~>[x.len x.lhd] |> sort by={a b => a|0 < b|0}
           |> {[x]=>x|1;[a b @xs]=>nins a|0+b|0 [a|1 b|1] xs |> rec}
           |> {bs x=>[[x bs]]; bs [a b]=>conc rec,[@bs 0],a rec,[@bs 1],b} []
usage example:

(repl "huff \"The algorithm for generating a Huffman tree is very simple.\"")
((\y (0 0 0 0 0))   (\h (0 0 0 0 1))   (\m (0 0 0 1))   
 (\n (0 0 1 0))     (\t (0 0 1 1))     (\f (0 1 0 0))   
 (\g (0 1 0 1))     (\e (0 1 1))       (\u (1 0 0 0 0 0))
 (\v (1 0 0 0 0 1)) (\. (1 0 0 0 1 0)) (\H (1 0 0 0 1 1))
 (\T (1 0 0 1 0 0)) (\p (1 0 0 1 0 1)) (\l (1 0 0 1 1)) 
 (\o (1 0 1 0 0))   (\s (1 0 1 0 1))   (\a (1 0 1 1))   
 (\i (1 1 0 0))     (\r (1 1 0 1))     (\Space (1 1 1))  )

>>39
BTW, traditional Lisp also have these `assoc` and `getf` for treating lists as namespaces, but they are slow!

>>41
If you're dealing with large association lists, you might as well use a hashtable or something more efficient, however for tiny ones, an alist would be faster.

>>42
Hashtables are inconvenient as you cant process them like lists.

"It is better to have 100 functions operate on one data structure than 10 functions on 10 data structures." -- Alan Perlis

>>43
Perl fixed this problem.

Consider memory latency.  You can compute a hash with only one memory request and then some arithmetic which would likely be quicker than another memory access, so two requests are to be performed to fetch a value (more if you use buckets and there are collisions) while with assoc list you can only get the first value with two requests (or with one request if it is stored linearly)

>>44
How?

>>45
Premature optimization is the root of all evil.

>>46
my @a = qw/key1 val1 key2 val2/;
my %h = @a;

or at least I think so. You may have to do some coercion but a hash is basically an array with keys at even indices and values at odd indices.

>>48
It is a usual hashtable boilerplate, not a list. And what are these "my @" and "my %"? Make me unsee!

>>49
Oh no, non-alphanumeric symbols in symbol names! Next you'll be complaining about whitespace being syntactically significant in Haskell and Python.

>>49
Are you serious? Get out.

>>50>>51
Enjoy your static typing.

>>52
my %h = @a;
Yes, of course.

>>53
You should steal type inference engine from Haskell people, then you can omit %@

>>40
Stop calling it repl, idiot. Write a proper repl or rename this function to rep.

>>55
Long time ago it was real REPL, now it is implemented in hosted language itself, like follow

e:m:loop expr -> {=>do $expr (rec)}
repl -> (read).eval.pp.loop

but I'm to lazy to change names with semantics.

together with semantics
self fix

i'll skip coke this year

>>44
Perl fixes ^_everything!

>>1
Looks like shit. You should be ashamed for writing such unreadable code.

>>60
You should be ashamed of loving Pascal.

Just for fags, I've a readable version, it looks verbose as fuck

uses crt;
type
  ana= record
   sayi, ytree :integer;
   dur, yer    :byte;
  end;
var
  A:array[1..50] of ana; Tree:array[1..512] of integer;
  binary_dizi:array[1..10] of byte; toplam_dizi:array[1..200] of byte;
  i,j,k,l,m,n,t,z,top,t_d:integer; ch:char;
 
Procedure oku;
begin
 write('Size of array:');read(n);
 for i:=1 to n do
  begin
   read(A[i].sayi);
  end;
end;
 
Procedure BubbleSort;
var yedek:integer;
begin
  for i:=1 to n-1 do
   for j:=1 to n-i do
     if A[j].sayi > A[j+1].sayi then
      begin
       yedek:=A[j].sayi;
       A[j].sayi:=A[j+1].sayi;
       A[j+1].sayi:=yedek;
      end;
end;
 
Procedure Huffman_Tree;
begin
{******************Total Array**********************}
 for i:=1 to 50 do a[i].dur:=0;
 i:=1; z:=0;
 while z=0 do
  begin
   top:=A[i].sayi+A[i+1].sayi;
   k:=i+1;
   t:=0;
   while t=0 do
     if (A[k].sayi<top)and(A[k].sayi<>0) then
           inc(k)
         else
          begin
           for  l:=n+1 downto k+1 do
            begin
             A[l].sayi:=A[l-1].sayi;
             A[l].dur:=A[l-1].dur;
            end;
           A[k].sayi:=top;
           A[k].dur:=1;
           t:=1;
           inc(n);
           A[k].yer:=i;
          end;
   inc(i,2);
   if A[i+1].sayi=0 then z:=1;
  end;
{------------------ Total Array ----------------------}
 
{******************Huffman Tree**********************}
 Tree[1]:=A[n].sayi;A[n].ytree:=1;
 Tree[2]:=A[A[n].yer].sayi;  A[A[n].yer].ytree:=2;
 Tree[3]:=A[A[n].yer+1].sayi;A[A[n].yer+1].ytree:=3;
 for i:=n-1 downto 1 do
   if A[i].dur=1 then
    begin
     j:=A[i].ytree;
     t:=A[i].yer;
     Tree[j+j]:=A[t].sayi;
     A[t].ytree:=j+j;
     Tree[j+j+1]:=A[t+1].sayi;
     A[t+1].ytree:=j+j+1;
    end;
{------------------Huffman Tree ----------------------}
end;
 
Procedure binary;
var yedek:integer;
begin
{******************Binary Code**********************}
 for i:=1 to n do
  begin
   if A[i].dur=0 then
     begin
      j:=A[i].ytree;
      k:=0;
      while j>1 do
       if (j mod 2)=0 then
         begin
          j:=j div 2;
          inc(k);
          binary_dizi[k]:=0;
         end
        else
         begin
          j:=(j-1) div 2;
          inc(k);
          binary_dizi[k]:=1;
         end;
      inc(k);
      binary_dizi[k]:=1;
      t:=k;
      for j:=1 to (k div 2) do
        begin
         yedek:=binary_dizi[j];
         binary_dizi[j]:=binary_dizi[t];
         binary_dizi[t]:=yedek;
         t:=t-1;
        end;
      write(A[i].sayi:3,'. number´s equivalent: ');
      for j:=1 to k do
       begin
        write(binary_dizi[j]);
        inc(t_d);
        toplam_dizi[t_d]:=binary_dizi[j];
       end;
      writeln;
     end;
  end;
{------------------Binary Code----------------------}
end;
 
Procedure TotalArray;
begin
 writeln(' Total array...');
 for i:=1 to t_d do write(Toplam_dizi[i]); writeln;
end;
 
Procedure decode;
begin
{******************Conversion from Binary to number**********************}
 
 writeln('From above array original numbers are generated...');
 i:=2; j:=1;
 while i<=t_d do
  begin
   if Toplam_dizi[i]=0 then
      j:=j+j
     else
      j:=j+j+1;
   if (Tree[j+j]=0)and(Tree[j+j+1]=0) then
      begin
       writeln('Number:', Tree[j]);
       inc(i);
       j:=1;
      end;
   inc(i);
  end;
{------------------ Conversion from Binary to number----------------------}
end;
 
BEGIN
 clrscr;
 oku;
 BubbleSort;
 Huffman_Tree;
 t_d:=0;
 binary;
 TotalArray;
 decode;
 repeat ch:=readkey; until ch=#27; {Press Esc for exit}
END.

J, the one of most cryptic and succinct languages in existence, still requires a good amout of code compared to 3 lines of >>13

http://rosettacode.org/wiki/Huffman_coding#J

hc=: 4 : 0 
 if. 1=#x do. y
 else. ((i{x),+/j{x) hc (i{y),<j{y [ i=. (i.#x) -. j=. 2{./:x end.
)
 
hcodes=: 4 : 0
 assert. x -:&$ y           NB. weights and words have same shape
 assert. (0<:x) *. 1=#$x    NB. weights are non-negative
 assert. 1 >: L.y           NB. words are boxed not more than once
 w=. ,&.> y                 NB. standardized words
 assert. w -: ~.w           NB. words are unique
 t=. 0 {:: x hc w           NB. minimal weight binary tree
 ((< S: 0 t) i. w) { <@(1&=)@; S: 1 {:: t
)

   ;"1":L:0(#/.~ (],.(<'    '),.hcodes) ,&.>@~.)'this is an example for huffman encoding'
 t    0 1 0 1 0
 h    1 1 1 1 1
 i    1 0 0 1 
 s    0 0 1 0 
      1 0 1   
 a    1 1 0 0 
 n    0 0 0   
 e    1 1 0 1 
 x    0 1 0 1 1
 m    0 0 1 1 
 p    0 1 1 0 0
 l    0 1 1 0 1
 f    1 1 1 0 
 o    0 1 0 0 
 r    0 1 1 1 0
 u    0 1 1 1 1
 c    1 0 0 0 0
 d    1 0 0 0 1
 g    1 1 1 1 0

>>63
You can remove the asserts, you know.

>>63
And both are a pain to read, and most likely a pain to write and debug. I'd rather take something which is easy to write and easy to understand/debug than some unreadable mess.

>>65
The >>13 code was pretty easy to write and required no debugging. It uses a stream processing approach, just like Unix BASH language ("|>" stands for usual "|" from bash), so I can easily decompose it into several simplier functions at expense of making it more verbose.

BTW, as anyone, who readed SICP, knows, you can use stream-processing for everything, if your Lisp-system supports generated lists with memoization.

>>67
So, one can even replace Unix with Lisp, making Lisp a self-sufficient operating system.

So is this a Lisp-1 or a Lisp-2?

>>69
Lisp-1, as I like to use lambdas a lot and dont like funcall'ing manually.

>>68
LISP Machines.

>>71
LMs supported IPC using generated lists?

Common Lisp (CL was used on LMs, isnt it?) uses these ugly "Gray Streams", that cant be uniformly processed as ordinary lists.

>>73
On LM's they used ZetaLisp (also known as Lisp Machine Lisp). ZL, and some other Lisps (including Scheme) contributed a lot to the development of ANSI Common Lisp. Common Lisp was created to unify current popular Lisp implementations, and given the package system, it's not that hard (or at least, they tried to make it that way) to take a CL-like dialect and mold it into a standards-compliant CL, so Genera/OpenGenera (Lisp Machine's OS) supported CL after standardization, and various newer parts of it were indeed written in CL instead of ZetaLisp. I'd say that if you know CL, you can read ZetaLisp without much trouble, at least if you try to read OpenGenera's source code, it's quite readable and an interesting piece of code to study. There are some major differences between CL and ZL, especially in the object system as ZL was made before CLOS (relatively new), so they mostly use the Flavours dialect for OO.

As for Gray Streams, they're not in the CL standard, but were proposed as a means of extending the streams using CLOS (similar to how MOP extends CLOS using CLOS). Gray streams kind of fall out naturally out of the design of CL, so I had no trouble at all using them, although most of the time I'm using other people's extensions which use gray streams (for things like in-memory streams, or streams which allow one to grab the data from disk or memory and then interpret it in some way, for example parsing unicode or various foreign encodings). Gray streams are mostly good, but they miss a few generic functions which one might find very useful, but those are supported (along with Gray Streams) by most major CL implementations, so it's not a big deal.

>>74
You cant `mapcar` or `filter` gray streams.

>>75
Neither one can mapcar strings of arrays.

>>75
>>76
my other mapcar is a mdrcdr

U MENA mdpcdr.

gay streams

>>75
Actually you can easily make a stream class which filters (one way or both ways, if it's read/write) elements in a stream. Some libraries provide you with such functionality (portably), but you can easily implement it yourself. I don't see why I would want to mapcar it since it's not a list, and in general, lists are not an efficient way to store a stream (memory usage can be high, not very fast, seeking only works in one direction, unless you use a doubly linked list, but even then, it costs a lot of memory accesses). I use what's more suitable for the job, and using linked lists to store binary files or strings is rarely suitable. Lazy lists are a bit better, but they do come with costs as well. If you want to implement transparent encoding/compression/encryption/whatever, there are plenty of ways to do this using standard CL + gray streams (or use a library which already does it for you).