Lazy List in C

#include <stdio.h>
#include <stdlib.h>

typedef struct list_ {
  int x;
  struct closure_int_int_list_ *tail;
} *list;

typedef struct closure_int_int_list_ {
  list (*call)(int, int);
  int x1;
  int x2;
} *closure_int_int_list;

closure_int_int_list newclosure(list call(int, int), int x1, int x2)
{
  closure_int_int_list c;
  c = (closure_int_int_list)malloc(sizeof(*c));
  c->call = call;
  c->x1 = x1;
  c->x2 = x2;
  return c;
}

list newlist(int x, closure_int_int_list tail)
{
  list xs = (list)malloc(sizeof(struct list_));
  xs->x = x;
  xs->tail = tail;
  return xs;
}

list listtail(list xs)
{
  if (xs->tail == NULL) return NULL;
  return xs->tail->call(xs->tail->x1, xs->tail->x2);
}

void deletelist(list xs)
{
  free(xs->tail);
  free(xs);
}

int *takelist(int num, list xs)
{
  int *array;
  int i;
  list p;
  array = (int *)malloc(sizeof(int) * num);
  p = xs;
  for (i = 0; i < num; ++i) {
    array[i] = p->x;
    p = listtail(p);
  }
  return array;
}

list fibnext(int a, int b)
{
  return newlist(b, newclosure(fibnext, b, a + b));
}

void printarray(int *xs, int size)
{
  int i;
  for (i = 0; i < size; ++i) {
    printf("%d ", xs[i]);
  }
}

int main(int argc, char const* argv[])
{
  list xs;
  int *array;
  xs = newlist(1, newclosure(fibnext, 1, 1));
  array = takelist(10, xs);
  printarray(array, 10);
  free(array);
  deletelist(xs);
  return 0;
}

result:

1 1 2 3 5 8 13 21 34 55 

Type Inferences of Ambiguous Literals

The Haskell code below works.

main = print $ x + y
x = 1
y = 2.3

This results 3.3. x isn't Int because x is used with (+) operator that also takes 2.3.

On the other hand, the code below causes a type error in compile time.

main = print $ x + y
x = 1
y = 2.3

z = x :: Int

error:

No instance for (Fractional Int)
  arising from the literal `2.3'
Possible fix: add an instance declaration for (Fractional Int)
In the expression: 2.3
In an equation for `y': y = 2.3

You can make x ambiguous with NoMonomorphismRestriction option.

{-# LANGUAGE NoMonomorphismRestriction #-}

or -XNoMonomorphismRestriction in command line option.

• http://stackoverflow.com/questions/7055146/why-do-3-and-x-which-was-assigned-3-have-different-inferred-types-in-haskell

Thanks @ikegami__!

Lossless Data Compressions

Run-length encoding

http://en.wikipedia.org/wiki/Run-length_encoding

One of the easiest encoding method to write.

An implementatin in Haskell:

import Data.List (group)
main = do
  print $ runlength "AAAAABBCBADDDDDDDD"

runlength = concatMap f . group
  where
    f xs@(x:_) = x : show (length xs)

"A5B2C1B1A1D8"

Huffman coding

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

An implementatin in Haskell:

import Data.List (group, sort, sortBy)
import Data.Function (on)
import Data.Map (fromList, lookup)
import Data.Maybe (fromJust)
import Prelude hiding (lookup)

main = print $ huffman "AAAAABBCBADDDDDDDD"

huffman s = flip concatMap s $ fromJust . flip lookup (huffmanMap s)

huffmanMap s =
  let x = map head . sortBy (compare `on` length) . group . sort $ s in
      fromList $ zipWith ((,)) x (bits $ length x)
bits :: Int -> [[Int]]
bits length = (take length $ repeat 1) : reverse (take (length - 1) $ iterate (1 :) [0])

[1,0,1,0,1,0,1,0,1,0,1,1,0,1,1,0,1,1,1,1,1,1,0,1,0,0,0,0,0,0,0,0,0]

BPE: Byte Pair Encoding

http://en.wikipedia.org/wiki/Byte_pair_encoding

import Data.List (group, sort, sortBy, (\\))
import Data.Function (on)
import qualified Data.Map as M
import Data.Map (insert, empty, notMember)
import Data.Maybe (fromJust)
import Safe (fromJustDef)

main = do
  let orig = "ABCDCDABCDCDE"
  print orig
  let (encoded, table) = bpe orig
  print (encoded, table)
  print $ bpeDecode encoded table

bpe xs = bpe' xs empty
bpe' xs table =
  let x = head $ sortBy (flip compare `on` length) $ group $ sort $ zipWith ((,)) xs (tail xs) in
      if length x == 1
         then (xs, table)
         else let (a, b) = head x
                  new = pickupOther xs table in
                  bpe' (replace2 xs a b new) (insert new (a, b) table)

bpeDecode xs table = concatMap (replace (expand (M.map (\(a, b) -> [a, b]) table))) xs
  where
    replace :: M.Map Char String -> Char -> String
    replace expandedTable c = maybe [c] id $ M.lookup c expandedTable
    expand :: M.Map Char String -> M.Map Char String
    expand table = M.map (concatMap f) table
      where
        f :: Char -> String
        f c = maybe [c] (concatMap f) $ M.lookup c table

pickupOther xs table =
  head $ filter (flip notMember table) $ ['Z', 'Y'..'A'] \\ xs

replace2 (a:[]) _ _ _ = [a]
replace2 (a:b:xs) c d e
  | a == c && b == d = e : replace2 xs c d e
  | otherwise = a : replace2 (b : xs) c d e

• "ABCDCDABCDCDE"
• ("WWE",fromList [('W',('X','Z')),('X',('Y','Z')),('Y',('A','B')),('Z',('C','D'))])
• "ABCDCDABCDCDE"