ICI Back to the Win32 Shootout
Back to dada's perl lab

[The Original Shootout]   [NEWS]   [FAQ]   [Methodology]   [Platform Details]   [Acknowledgements]   [Scorecard]  
All Source For ici
Ackermann's Function
// $Id: ackermann.ici,v 1.0 2003/01/03 11:12:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

static
Ack(M, N)
{
    return M ? (Ack(M - 1, N ? Ack(M, N - 1) : 1)) : N + 1;
}

n := argv[1] ? int(argv[1]) : 1;
printf("Ack(3,%d): %d\n", n, Ack(3, n));
Array Access
// $Id: ary3.ici,v 1.0 2003/01/03 12:16:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

n = argv[1] ? int(argv[1]) : 1;

x = build(n);
for (i = 0; i < n; ++i)
    x[i] = i + 1;

y = build(n, "c", 0);

for (k = 0; k < 1000; ++k)
{
    for (i = n - 1; i >= 0; --i)
        y[i] += x[i];
}

printf("%d %d\n", y[0], y[n - 1]);
Count Lines/Words/Chars
// $Id: wc.ici,v 1.0 2003/01/03 12:08:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

nl = nw = nc = 0;
while (l = getline())
{
    ++nl;
    nc += nels(l) + 1;
    nw += nels(smash(l, #\S+#, ""));
}
printf("%d %d %d\n", nl, nw, nc);
Echo Client/Server
// $Id: echo.ici,v 1.0 2003/01/03 11:26:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

/*
 * This is a thread based version of the client-server echo test.
 * sys.fork() is available on UNIX-like systems, but is not core
 * language, and is not available on Windows.
 */
n = argv[1] ? int(argv[1]) : 1;
data = "Hello there sailor\n";

static
echo_client(n, port)
{
    sock := net.connect(net.socket("tcp/ip"), port);
    for (i := 0; i < n; ++i)
    {
        net.send(sock, data);
        if ((ans := net.recv(sock, nels(data))) != data)
            printf("received \"%s\", expected \"%s\"", ans, data);
    }
    net.close(sock);
    return 1;
}

ssock = net.listen(net.bind(net.socket("tcp/ip"), 0));
client = thread(echo_client, n, net.getportno(ssock));
csock = net.accept(ssock);
t = 0;
while (str = net.recv(csock, nels(data)))
{
    net.send(csock, str);
    t += nels(str);
}
waitfor(client.result; client)
    ;
printf("server processed %d bytes\n", t);
Exception Mechanisms
// $Id: except.ici,v 1.0 2003/01/03 11:28:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long


N = argv[1] ? int(argv[1]) : 1;

static HI = 0;
static LO = 0;

static
blowup(n)
{
    fail(n & 1 ? "low" : "hi");
}

static
lo_function (n)
{
    try
        blowup(n);
    onerror
    {
        if (error !~ #low#)
            fail(error);
        ++LO;
    }
}

static
hi_function(n)
{
    try
        lo_function(n);
    onerror
        ++HI;
}

static
some_function(n)
{
    try
        hi_function(n);
    onerror
        fail(error + " -- we shouldn't get here");
}

while (N)
    some_function(N--);

printf("Exceptions: HI=%d / LO=%d\n", HI, LO);
Fibonacci Numbers
// $Id: fibo.ici,v 1.0 2003/01/03 11:14:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

static
fib(n)
{
    return n < 2 ? 1 : fib(n - 2) + fib(n - 1);
}

printf("%d\n", fib(argv[1] ? int(argv[1]) : 1));
Hash (Associative Array) Access
// $Id: hash.ici,v 1.0 2003/01/03 11:44:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

n = argv[1] ? int(argv[1]) : 1;

x = struct();
for (i = 1; i < n + 1; ++i)
    x[sprintf("%x", i)] = i;

c = 0;
for (i = n; i > 0; --i)
    c += x[string(i)] != NULL;

printf("%d\n", c);
Hashes, Part II
// $Id: hash2.ici,v 1.0 2003/01/03 11:46:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

n = argv[1] ? int(argv[1]) : 1;

h1 = struct();
for (i = 0; i < 10000; ++i)
    h1[sprintf("foo_%d", i)] = i;

h2 = struct();
for (i = 0; i < n; ++i)
{
    forall (v, k in h1)
    {
        if (h2[k] == NULL)
            h2[k] = 0;
        h2[k] += h1[k];
    }
}

printf("%d %d %d %d\n", h1["foo_1"], h1["foo_9999"], h2["foo_1"], h2["foo_9999"]);
Heapsort
// $Id: heapsort.ici,v 1.0 2003/01/03 12:19:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

static IM = 139968;
static IA = 3877;
static IC = 29573;

static
gen_random(max)
{
    static last = 42;

    return max * (last = (last * IA + IC) % IM) / IM ;
}

static
heapsort(n, ra)
{
    ir = n;
    l = (n >> 1) + 1;
    for (;;)
    {
        if (l > 1)
        {
            rra = ra[--l];
        }
        else
        {
            rra = ra[ir];
            ra[ir] = ra[1];
            if (--ir == 1)
            {
                ra[1] = rra;
                return;
            }
        }
        i = l;
        j = l << 1;
        while (j <= ir)
        {
            if (j < ir && ra[j] < ra[j+1])
                ++j;
            if (rra < ra[j])
            {
                ra[i] = ra[j];
                j += (i = j);
            }
            else
            {
                j = ir + 1;
            }
        }
        ra[i] = rra;
    }
}

N = argv[1] ? int(argv[1]) : 1;
ary = array();
for (i = 0; i <= N; ++i)
    ary[i] = gen_random(1.0);
heapsort(N, ary);
printf("%.10f\n", ary[N]);
Hello World
// $Id: hello.ici,v 1.0 2003/01/03 12:11:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

put("hello world\n");
List Operations
// $Id: lists.ici,v 1.0 2003/01/03 12:20:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

NUM = argv[1] ? int(argv[1]) : 1;

static SIZE = 10000;

static
test_lists()
{
    li1 = array();
    for (i := 0; i < SIZE; )
        i = li1[i] = i + 1;
    li2 = copy(li1);
    li3 = array();
    while(nels(li2))
        push(li3, rpop(li2));
    while (nels(li3))
        push(li2, pop(li3));
    n := SIZE / 2;
    for (i := 0; i < n; ++i)
        li1[i] <=> li1[SIZE - i - 1];
    if (li1[0] != SIZE || li1 != li2)
        return 0;
    return nels(li1);
}

for (i = 0; i < NUM; ++i)
    result = test_lists();
printf("%d\n", result);
Matrix Multiplication
// $Id: matrix.ici,v 1.0 2003/01/03 11:58:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

static
mkmatrix(rows, cols)
{
    m = build(rows, cols);
    count = 0;
    forall (col in m)
    {
        forall (val, i in col)
            col[i] = ++count;
    }
    return m;
}

static
mmult(rows, cols, m1, m2, m3)
{
    forall (col, i in m3)
    {
        m1i = m1[i];
        forall (val, j in col)
        {
            val = 0;
            forall (m1ik, k in m1i)
                val += m1ik * m2[k][j];
            col[j] = val;
        }
    }
}

SIZE := 30;
n := argv[1] ? int(argv[1]) : 1;
m1 := mkmatrix(SIZE, SIZE);
m2 := mkmatrix(SIZE, SIZE);
mm := build(SIZE, SIZE);
for (i = 0; i < n; ++i)
    mmult(SIZE, SIZE, m1, m2, mm);
printf("%d %d %d %d\n", mm[0][0], mm[2][3], mm[3][2], mm[4][4]);
Method Calls
// $Id: methcall.ici,v 1.0 2003/01/03 12:02:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

static Toggle = [class

    new(start_state)
    {
        t := this:^new();
        t.state := start_state;
        return t;
    }

    activate()
    {
        state = !state;
        return this;
    }
    
    value()
    {
        return state;
    }
];

static NthToggle = [class:Toggle,

    new(start_state, count_max)
    {
        t := this:^new(start_state);
        t.count_max := count_max;
        t.counter := 0;
        return t;
    }

    activate()
    {
        this:^activate();
        if (++counter >= count_max)
        {
            state = !state;
            counter = 0;
        }
        return this;
    }
];

n := argv[1] ? int(argv[1]) : 1;

toggle := Toggle:new(1);
for (i = 0; i < n; ++i)
    val = toggle:activate():value();
printf(val ? "true\n" : "false\n");

ntoggle := NthToggle:new(val, 3);
for (i = 0; i < n; ++i)
    val = ntoggle:activate():value();
printf(val ? "true\n" : "false\n");
Nested Loops
// $Id: nestedloop.ici,v 1.0 2003/01/03 11:26:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

n := argv[1] ? int(argv[1]) : 1;
x := 0;

z := array();
for (i = 0; i < n; ++i)
    z[i] = i;
forall (a in z)
    forall (b in z)
        forall (c in z)
            forall (d in z)
                forall (e in z)
                    forall (f in z)
                        ++x;

/*
 * These simple nested for loops are perhaps a more natural construct.
 * But other languages use the above contruct in their implementations,
 * and it is slightly faster.
 */
/*
for (a = n; a--; )
    for (b = n; b--; )
        for (c = n; c--; )
            for (d = n; d--; )
                for (e = n; e--; )
                    for (f = n; f--; )
                        ++x;
*/

printf("%d\n", x);
Object Instantiation
// $Id: objinst.ici,v 1.0 2003/01/03 12:00:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long


static Toggle = [class

    new(start_state)
    {
        t := this:^new();
        t.state := start_state;
        return t;
    }

    activate()
    {
        state = !state;
        return this;
    }
    
    value()
    {
        return state;
    }
];

static NthToggle = [class:Toggle,

    new(start_state, count_max)
    {
        t := this:^new(start_state);
        t.count_max := count_max;
        t.counter := 0;
        return t;
    }

    activate()
    {
        this:^activate();
        if (++counter >= count_max)
        {
            state = !state;
            counter = 0;
        }
        return this;
    }
];

n := argv[1] ? int(argv[1]) : 1;

toggle := Toggle:new(1);
for (i = 0; i < 5; ++i)
    printf(toggle:activate():value() ? "true\n" : "false\n");
    
for (i = 0; i < n; ++i)
    toggle := Toggle:new(1);
    
printf("\n");

ntoggle := NthToggle:new(1, 3);
for (i = 0; i < 8; ++i)
    printf(ntoggle:activate():value() ? "true\n" : "false\n");

for (i = 0; i < n; ++i)
    ntoggle := NthToggle:new(1, 3);
Producer/Consumer Threads
// $Id: prodcons.ici,v 1.0 2003/01/03 12:06:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

static n = argv[1] ? int(argv[1]) : 1;
static count = 0;
static consumed = 0;
static produced = 0;
static data = 0;

static
producer()
{
    for (i := 1; i <= n; ++i)
    {
        waitfor (count == 0; "access")
        {
            data = i;
            count = 1;
            wakeup("access");
        }
        ++produced;
    }
    return 1;
}

static
consumer()
{
    do
    {
        waitfor (count != 0; "access")
        {
            i = data;
            count = 0;
            wakeup("access");
        }
        ++consumed;

    } while (i != n);
    return 1;
}

p := thread(producer);
c := thread(consumer);
waitfor (p.result; p)
    ;
waitfor (c.result; c)
    ;
printf("%d %d\n", produced, consumed);
Random Number Generator
// $Id: random.ici,v 1.0 2003/01/03 11:48:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

static IM = 139968;
static IA = 3877;
static IC = 29573;
static last = 42;

static
gen_random(max)
{
    return max * (last = (last * $IA + $IC) % $IM) / $IM;
}

n = argv[1] ? int(argv[1]) : 1;
while (n--)
    result = gen_random(100.0);
printf("%.9f\n", result);
Regular Expression Matching
// $Id: regexmatch.ici,v 1.0 2003/01/03 12:07:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

n := argv[1] ? int(argv[1]) : 1;
lines = gettokens(stdin, '\n', "");
j = 0;
while (--n)
{
    forall (l in lines)
    {
        a = l ~~~ #^[^\d(]*(?:\((\d\d\d)\)|(\d\d\d)) (\d\d\d)[ -](\d\d\d\d)(?:\D|$)#;
        if (n == 1 && a)
            printf("%d: (%s%s) %s-%s\n", ++j, a[0], a[1], a[2], a[3]);
    }
}

/*
 * The second last line of the test data is "foo (213 222-2222 bar", which
 * by my reading of the spec should match. But it is in the "shouldn't match"
 * section and no other programs matches it. So the above regexp is tailored
 * not to match it too.
 */
Reverse a File
// $Id: reversefile.ici,v 1.0 2003/01/03 12:14:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

f = smash(getfile(), #[^\n]*\n#, "\\&");
r = array();
forall (l in f)
    rpush(r, l);
put(implode(r));

/*
 * This is probably more natural, but slower...
 */
/*
f = smash(getfile(), #[^\n]*\n#, "\\&");
while (nels(f))
    put(pop(f));
*/
Sieve of Erathostenes
// $Id: sieve.ici,v 1.0 2003/01/03 11:16:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

n := argv[1] ? int(argv[1]) : 1;
while (n--)
{
    count := 0;
    flags := build(8193, "c", 1);
    for (i := 2; i <= 8192; ++i)
    {
        if (flags[i])
        {
            for (k := i + i; k <= 8192; k += i)
                flags[k] = 0;
            ++count;
        }
    }
}
printf("Count: %d\n", count);
Spell Checker
// $Id: spellcheck.ici,v 1.0 2003/01/03 12:21:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

dict := set();
forall (w in gettokens(fopen("Usr.Dict.Words"), "\n", ""))
    dict[w] = 1;

while (w = getline())
{
    if (!dict[w])
        printf("%s\n", w);
}
Statistical Moments
// $Id: moments.ici,v 1.0 2003/01/03 11:55:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

sum := 0.0;
nums := array();
forall (f in gettokens(stdin, "\n", ""))
{
    push(nums, f = float(f));
    sum += f;
}

n := nels(nums);
mean := sum / n;

deviation := 0.0;
average_deviation := 0.0;
standard_deviation := 0.0;
variance := 0.0;
skew := 0.0;
kurtosis := 0.0;

forall (num in nums)
{
    deviation = num - mean;
    average_deviation += abs(deviation);
    variance += (t := deviation * deviation);
    skew += (t *= deviation);
    kurtosis += (t *= deviation);
}
average_deviation /= n;
variance /= (n - 1);
standard_deviation = sqrt(variance);

if (variance > 0.0)
{
    skew /= n * variance * standard_deviation;
    kurtosis = kurtosis / (n * variance * variance) - 3.0;
}

sort(nums);
mid := n / 2;
if (n % 2 == 0)
    median = (nums[mid] + nums[mid - 1])/2;
else
    median = nums[mid];
    
printf("n:                  %d\n", n);
printf("median:             %f\n", median);
printf("mean:               %f\n", mean);
printf("average_deviation:  %f\n", average_deviation);
printf("standard_deviation: %f\n", standard_deviation);
printf("variance:           %f\n", variance);
printf("skew:               %f\n", skew);
printf("kurtosis:           %f\n", kurtosis);
String Concatenation
// $Id: strcat.ici,v 1.0 2003/01/03 11:29:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

n := argv[1] ? int(argv[1]) : 1;
s := "";
for (i = 0; i < n; ++i)
    s += "hello\n";
printf("%d\n", nels(s));
Sum a Column of Integers
// $Id: sumcol.ici,v 1.0 2003/01/03 11:23:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

count := 0;
while (l = getline())
    count += int(l);
printf("%d\n", count);
Word Frequency Count
// $Id: wordfreq.ici,v 1.0 2003/01/03 12:23:00 dada Exp $
// http://dada.perl.it/shootout
//
// contributed by Tim Long

static counts = struct();

static
tolower(s)
{
    s = explode(s);
    forall (c, i in s)
    {
        if (c >= 'A' && c <= 'Z')
            s[i] += 'a' - 'A';
    }
    return implode(s);
}

while (l = getline())
{
    forall (w in smash(l, #\w+#, "\\&"))
    {
        if (w ~ #[A-Z]#)
            w = tolower(w);
        if (counts[w] == NULL)
            counts[w] = 1;
        else
            ++counts[w];
    }
}

out = array();
forall (c, w in counts)
    push(out, sprintf("%7d\t%s\n", c, w));
sort(out, [func(a, b){return a > b ? -1 : a < b;}]);
put(implode(out));