x64 Ubuntu : Intel® Q6600® one core
Computer Language Benchmarks Game      [[ Play ]]

- all benchmarks - n-body fannkuch-redux meteor-contest fasta fasta-redux spectral-norm reverse-complement mandelbrot k-nucleotide regex-dna pidigits chameneos-redux thread-ring binary-trees-redux binary-trees - all languages - Ada 2005 GNAT ATS C gcc Clojure C# Mono C++ g++ Dart Erlang HiPE F# Mono Fortran Intel Go Haskell GHC Java 7 JavaScript V8 Lisp SBCL Lua OCaml Pascal Free Pascal Perl PHP Python 3 Racket Ruby 2.0 Ruby JRuby Scala Smalltalk VisualWorks x86 one core x64 quad-core x86 quad-core x64 one core

 performance measurements

Each table row shows performance measurements for this Racket program with a particular command-line input value N.

N	CPU secs	Elapsed secs	Memory KB	Code B	≈ CPU Load
60,000	3.75	3.76	92,204	791	0% 0% 0% 100%
600,000	33.14	33.17	98,588	791	0% 0% 0% 100%
6,000,000	332.14	332.35	101,612	791	0% 0% 0% 100%

Read the ↓ make, command line, and program output logs to see how this program was run.

Read chameneos-redux benchmark to see what this program should do.

 notes

Welcome to Racket v5.3.4.

 chameneos-redux Racket program source code

#lang racket/base

;;; The Computer Language Benchmarks Game
;;; http://benchmarksgame.alioth.debian.org/

;;; contributed by Matthew Flatt
;;;
;;; Uses Racket threads

(require racket/cmdline
         racket/match)

(define (change c1 c2)
  (case c1
    [(red)
     (case c2 [(blue) 'yellow] [(yellow) 'blue] [else c1])]
    [(yellow)
     (case c2 [(blue) 'red] [(red) 'blue] [else c1])]
    [(blue)
     (case c2 [(yellow) 'red] [(red) 'yellow] [else c1])]))
  
(let ([colors '(blue red yellow)])
  (for* ([a colors][b colors])
    (printf "~a + ~a -> ~a\n" a b (change a b))))

(define (place meeting-ch n)
  (thread
   (lambda ()
     (let loop ([n n])
       (if (zero? n)
           ;; Fade all:
           (let loop ()
             (let ([c (channel-get meeting-ch)])
               (channel-put (car c) #f)
               (loop)))
           ;; Let two meet:
           (match-let ([(cons ch1 v1) (channel-get meeting-ch)]
                       [(cons ch2 v2) (channel-get meeting-ch)])
             (channel-put ch1 v2)
             (channel-put ch2 v1)
             (loop (sub1 n))))))))

(define (creature color meeting-ch result-ch)
  (thread 
   (lambda ()
     (let ([ch (make-channel)]
           [name (gensym)])
       (let loop ([color color][met 0][same 0])
         (channel-put meeting-ch (cons ch (cons color name)))
         (match (channel-get ch)
           [(cons other-color other-name)
            ;; Meet:
            (sleep) ; avoid imbalance from weak fairness
            (loop (change color other-color) 
                  (add1 met)
                  (+ same (if (eq? name other-name)
                              1
                              0)))]
           [#f
            ;; Done:
            (channel-put result-ch (cons met same))]))))))

(define (spell n)
  (for ([i (number->string n)])
    (display " ")
    (display (hash-ref digits i))))
  
(define digits
  #hash((#\0 . "zero")
        (#\1 . "one")
        (#\2 . "two")
        (#\3 . "three")
        (#\4 . "four")
        (#\5 . "five")
        (#\6 . "six")
        (#\7 . "seven")
        (#\8 . "eight")
        (#\9 . "nine")))

(define (go n inits)
  (let ([result-ch (make-channel)]
        [meeting-ch (make-channel)])
    (place meeting-ch n)
    (newline)
    (for ([init inits])
      (printf " ~a" init)
      (creature init meeting-ch result-ch))
    (newline)
    (let ([results (for/list ([i inits])
                     (channel-get result-ch))])
      (for ([r results])
        (display (car r))
        (spell (cdr r))
        (newline))
      (spell (apply + (map car results)))
      (newline))))

(let ([n (command-line #:args (n) (string->number n))])
  (go n '(blue red yellow))
  (go n '(blue red yellow red yellow blue red yellow red blue))
  (newline))

 make, command-line, and program output logs

Sat, 11 May 2013 17:50:40 GMT

COMMAND LINE:
/usr/local/src/racket-5.3.4/bin/racket  chameneosredux.racket 6000000

PROGRAM OUTPUT:
blue + blue -> blue
blue + red -> yellow
blue + yellow -> red
red + blue -> yellow
red + red -> red
red + yellow -> blue
yellow + blue -> red
yellow + red -> blue
yellow + yellow -> yellow

 blue red yellow
3999999 zero
4000014 zero
3999987 zero
 one two zero zero zero zero zero zero

 blue red yellow red yellow blue red yellow red blue
1199998 zero
1200000 zero
1200000 zero
1200001 zero
1200000 zero
1199999 zero
1200001 zero
1200003 zero
1199997 zero
1200001 zero
 one two zero zero zero zero zero zero

  Home   Conclusions   License   Play