Add a bunch of new languages

Task/99_Bottles_of_Beer/ActionScript/99_bottles_of_beer.as

@@ -0,0 +1,7 @@
+for(var numBottles:uint = 99; numBottles > 0; numBottles--)
+{
+	trace(numBottles, " bottles of beer on the wall");
+	trace(numBottles, " bottles of beer");
+	trace("Take one down, pass it around");
+	trace(numBottles - 1, " bottles of beer on the wall\n");		
+}

Task/99_Bottles_of_Beer/Babel/99_bottles_of_beer.pb

@@ -0,0 +1,17 @@
+main: { 99 bottles }
+
+bottles!:
+    { x set
+        { bw
+        bx cr <<
+        "Take one down, pass it around\n" <<
+        1 x -=
+        bw "\n" << }
+    x times }
+
+b  : " bottles of beer"
+bx!: { x %d << b }
+w  : " on the wall"
+bw!: { bx w . cr << }
+
+x: [0]

Task/99_Bottles_of_Beer/Dylan/99_bottles_of_beer.dylan

@@ -0,0 +1,10 @@
+Module: bottles
+define method bottles (n :: <integer>)
+  for (n from 99 to 1 by -1)
+    format-out("%d bottles of beer on the wall,\n"
+               "%d bottles of beer\n"
+               "Take one down, pass it around\n"
+               "%d bottles of beer on the wall\n",
+               n, n, n - 1);
+  end
+end method

Task/99_Bottles_of_Beer/Prolog/99_bottles_of_beer-2.pro

@@ -0,0 +1,19 @@
+line1(X):- line2(X),write(' on the wall').
+line2(0):- write('no more bottles of beer').
+line2(1):- write('1 bottle of beer').
+line2(X):- writef('%t bottles of beer',[X]).
+line3(1):- write('Take it down, pass it around').
+line3(X):- write('Take one down, pass it around').
+line4(X):- line1(X).
+
+bottles(0):-!.
+bottles(X):-	
+    succ(XN,X),
+    line1(X),nl,
+    line2(X),nl,
+    line3(X),nl,
+    line4(XN),nl,nl,
+    !,
+    bottles(XN).
+
+:- bottles(99).

Task/99_Bottles_of_Beer/Prolog/99_bottles_of_beer.pro

@@ -0,0 +1,10 @@
+bottles(0):-!.
+bottles(X):-
+    writef('%t bottles of beer on the wall \n',[X]),
+    writef('%t bottles of beer\n',[X]),
+    write('Take one down, pass it around\n'),
+    succ(XN,X),
+    writef('%t bottles of beer on the wall \n\n',[XN]),
+    bottles(XN).
+
+:- bottles(99).

Task/99_Bottles_of_Beer/R/99_bottles_of_beer-2.r

@@ -0,0 +1,5 @@
+#only one line!
+cat(paste(99:1,ifelse((99:1)!=1," bottles"," bottle")," of beer on the wall\n",99:1,ifelse((99:1)!=1," bottles"," bottle")," of beer\n","Take one down, pass it around\n",98:0,ifelse((98:0)!=1," bottles"," bottle")," of beer on the wall\n\n",sep=""),sep="")
+
+#alternative
+cat(paste(lapply(99:1,function(i){paste(paste(rep(paste(i,' bottle',if(i!=1)'s',' of beer',sep=''),2),collapse =' on the wall\n'),'Take one down, pass it around',paste(i-1,' bottle',if(i!=2)'s',' of beer on the wall',sep=''), sep='\n')}),collapse='\n\n'))

Task/99_Bottles_of_Beer/R/99_bottles_of_beer.r

@@ -0,0 +1,16 @@
+#a naive function to sing for N bottles of beer...
+
+song = function(bottles){
+
+  for(i in bottles:1){ #for every integer bottles, bottles-1 ... 1
+
+    cat(bottles," bottles of beer on the wall \n",bottles," bottles of beer \nTake one down, pass it around \n",
+        bottles-1, " bottles of beer on the wall \n"," \n" ,sep="")       #join and print the text (\n means new line)
+
+        bottles = bottles - 1 #take one down...
+
+  }
+
+}
+
+song(99)#play the song by calling the function

Task/99_Bottles_of_Beer/Racket/99_bottles_of_beer.rkt

@@ -0,0 +1,11 @@
+#lang racket
+
+(define (plural n)
+  (string-append (number->string n) " bottle" (if (equal? n 1) "" "s")))
+
+(define (sing bottles)
+    (printf "~a of beer on the wall\n~a of beer\nTake on down, pass it around\n~a of beer on the wall\n\n"
+            (plural bottles) (plural bottles) (plural (sub1 bottles))))
+
+(for ((i (in-range 100 0 -1)))
+  (sing i))

Task/99_Bottles_of_Beer/Sather/99_bottles_of_beer.sa

@@ -0,0 +1,14 @@
+class MAIN is
+  main is
+    s :STR;
+    p1 ::= "<##> bottle<#> of beer";
+    w  ::= " on the wall";
+    t  ::= "Take one down, pass it around\n";
+    loop i ::= 99.downto!(0);
+      if i /= 1 then s := "s" else s := ""; end;
+      #OUT + #FMT(p1 + w + "\n", i, "s");
+      #OUT + #FMT(p1 + "\n", i, "s");
+      if i > 0 then #OUT + t; end;
+    end;
+  end;
+end;

Task/99_Bottles_of_Beer/Scheme/99_bottles_of_beer.ss

@@ -0,0 +1,7 @@
+(define (bottles x)
+	(format #t "~a bottles of beer on the wall~%" x)
+	(format #t "~a bottles of beer~%" x)
+	(format #t "Take one down, pass it around~%")
+	(format #t "~a bottles of beer on the wall~%" (- x 1))
+	(if (> (- x 1) 0)
+		(bottles (- x 1))))

Task/99_Bottles_of_Beer/Smalltalk/99_bottles_of_beer.st

@@ -0,0 +1,15 @@
+Smalltalk at: #sr put: 0 ; at: #s put: 0 !
+sr := Dictionary new.
+sr at: 0 put: ' bottle' ;
+   at: 1 put: ' bottles' ;
+   at: 2 put: ' of beer' ;
+   at: 3 put: ' on the wall' ;
+   at: 4 put: 'Take one down, pass it around' !
+99 to: 0 by: -1 do: [:v | v print.
+         ( v == 1 ) ifTrue: [ s := 0. ]
+	            ifFalse: [ s := 1. ].
+	 Transcript show: (sr at:s) ; show: (sr at:2) ; show: (sr at:3) ; cr.
+	            v print.
+	 Transcript show: (sr at:s) ; show: (sr at:2) ; cr.
+		    (v ~~ 0) ifTrue: [ Transcript show: (sr at:4) ; cr. ].
+   ].

Task/Anagrams/Prolog/anagrams.pro

@@ -0,0 +1,49 @@
+:- use_module(library( http/http_open )).
+
+anagrams:-
+        % we read the URL of the words
+	http_open('http://www.puzzlers.org/pub/wordlists/unixdict.txt',	In, []),
+	read_file(In, [], Out),
+	close(In),
+
+        % we get a list of pairs key-value where key = a-word value = <list-of-its-codes>
+        % this list must be sorted
+	msort(Out, MOut),
+
+        % in order to gather values with the same keys
+	group_pairs_by_key(MOut, GPL),
+
+        % we sorted this list in decreasing order of the length of values
+	predsort(my_compare, GPL, GPLSort),
+
+	% we extract the first 6 items
+        GPLSort = [_H1-T1, _H2-T2, _H3-T3, _H4-T4, _H5-T5, _H6-T6 | _],
+
+        % Tnn are lists of codes (97 for 'a'), we create the strings
+	maplist(maplist(atom_codes), L, [T1, T2, T3, T4, T5, T6] ),
+
+	maplist(writeln, L).
+
+
+read_file(In, L, L1) :-
+	read_line_to_codes(In, W),
+	(   W == end_of_file ->
+               % the file is read
+	       L1 = L
+	       ;
+               % we sort the list of codes of the line
+	       msort(W, W1),
+
+               % to create the key in alphabetic order
+	       atom_codes(A, W1),
+
+               % and we have the pair Key-Value in the result list
+	       read_file(In, [A-W | L], L1)).
+
+% predicate for sorting list of pairs Key-Values
+% if the lentgh of values is the same
+% we sort the keys in alhabetic order
+my_compare(R, K1-V1, K2-V2) :-
+	length(V1, L1),
+	length(V2, L2),
+	(   L1 < L2 -> R = >; L1 > L2 -> R = <; compare(R, K1, K2)).

Task/Anagrams/R/anagrams.r

@@ -0,0 +1,22 @@
+words <- readLines("http://www.puzzlers.org/pub/wordlists/unixdict.txt")
+word_group <- sapply(
+    strsplit(words, split=""), # this will split all words to single letters...
+    function(x) paste(sort(x), collapse="") # ...which we sort and paste again
+)
+
+counts <- tapply(words, word_group, length) # group words by class to get number of anagrams
+anagrams <- tapply(words, word_group, paste, collapse=", ") # group to get string with all anagrams
+
+# Results
+table(counts)
+counts
+    1     2     3     4     5
+22263  1111   155    31     6
+
+anagrams[counts == max(counts)]
+                               abel                               acert
+     "abel, able, bale, bela, elba" "caret, carte, cater, crate, trace"
+                              aegln                               aeglr
+"angel, angle, galen, glean, lange" "alger, glare, lager, large, regal"
+                               aeln                                eilv
+     "elan, lane, lean, lena, neal"      "evil, levi, live, veil, vile"

Task/Anagrams/Racket/anagrams-2.rkt

@@ -0,0 +1,6 @@
+'(("neal" "lena" "lean" "lane" "elan")
+  ("trace" "crate" "cater" "carte" "caret")
+  ("regal" "large" "lager" "glare" "alger")
+  ("elba" "bela" "bale" "able" "abel")
+  ("lange" "glean" "galen" "angle" "angel")
+  ("vile" "veil" "live" "levi" "evil"))

Task/Anagrams/Racket/anagrams.rkt

@@ -0,0 +1,21 @@
+#lang racket
+
+(require net/url)
+
+(define (get-lines url-string)
+  (define port (get-pure-port (string->url url-string)))
+  (for/list ([l (in-lines port)]) l))
+
+(define (hash-words words)
+  (for/fold ([ws-hash (hash)]) ([w words])
+    (hash-update ws-hash
+                 (list->string (sort (string->list w) < #:key (λ (c) (char->integer c))))
+                 (λ (ws) (cons w ws))
+                 (λ () '()))))
+
+(define (get-maxes h)
+  (define max-ws (apply max (map length (hash-values h))))
+  (define max-keys (filter (λ (k) (= (length (hash-ref h k)) max-ws)) (hash-keys h)))
+  (map (λ (k) (hash-ref h k)) max-keys))
+
+(get-maxes (hash-words (get-lines "http://www.puzzlers.org/pub/wordlists/unixdict.txt")))

Task/Anagrams/Smalltalk/anagrams-2.st

@@ -0,0 +1,10 @@
+d := Dictionary new.
+'unixdict.txt' asFilename
+    readingLinesDo:[:eachWord |
+      (d at:eachWord copy sort ifAbsentPut:[OrderedCollection new]) add:eachWord
+    ].
+
+((d values select:[:s | s size > 1])
+  sortBySelector:#size)
+    reverse
+      do:[:s | s printCR]

Task/Anagrams/Smalltalk/anagrams-3.st

@@ -0,0 +1 @@
+'http://www.puzzlers.org/pub/wordlists/unixdict.txt' asURI contents asCollectionOfLines do:[:eachWord | ...

Task/Anagrams/Smalltalk/anagrams.st

@@ -0,0 +1,7 @@
+list:= (FillInTheBlank request: 'myMessageBoxTitle') subStrings: String crlf.
+dict:= Dictionary new.
+list do: [:val|
+	(dict at: val copy sort ifAbsent: [dict at: val copy sort put: OrderedCollection new])
+		add: val.
+	].
+sorted:=dict asSortedCollection: [:a :b| a size > b size].

Task/Bulls_and_cows/Prolog/bulls_and_cows.pro

@@ -0,0 +1,56 @@
+:- use_module(library(lambda)).
+:- use_module(library(clpfd)).
+
+% Parameters of the server
+
+% length of the guess
+proposition(4).
+
+% Numbers of digits
+% 0 -> 8
+digits(8).
+
+
+bulls_and_cows_server :-
+	proposition(LenGuess),
+	length(Solution, LenGuess),
+	choose(Solution),
+	repeat,
+	write('Your guess : '),
+	read(Guess),
+	(   study(Solution, Guess, Bulls, Cows)
+	->  format('Bulls : ~w Cows : ~w~n', [Bulls, Cows]),
+	    Bulls = LenGuess
+	;   digits(Digits), Max is Digits + 1,
+	    format('Guess must be of ~w digits between 1 and ~w~n',
+		   [LenGuess, Max]),
+	    fail).
+
+choose(Solution) :-
+	digits(Digits),
+	Max is Digits + 1,
+	repeat,
+	maplist(\X^(X is random(Max) + 1), Solution),
+	all_distinct(Solution),
+	!.
+
+study(Solution, Guess, Bulls, Cows) :-
+	proposition(LenGuess),
+	digits(Digits),
+	
+	% compute the transformation 1234 => [1,2,3,4]
+	atom_chars(Guess, Chars),
+	maplist(\X^Y^(atom_number(X, Y)), Chars, Ms),
+	
+	% check that the guess is well formed
+	length(Ms, LenGuess),
+	maplist(\X^(X > 0, X =< Digits+1), Ms),
+
+	% compute the digit in good place
+	foldl(\X^Y^V0^V1^((X = Y->V1 is V0+1; V1 = V0)),Solution, Ms, 0, Bulls),
+	
+	% compute the digits in bad place
+	foldl(\Y1^V2^V3^(foldl(\X2^Z2^Z3^(X2 = Y1 -> Z3 is Z2+1; Z3 = Z2), Ms, 0, TT1),
+			 V3 is V2+ TT1),
+	      Solution, 0, TT),
+	Cows is TT - Bulls.

Task/Bulls_and_cows/R/bulls_and_cows.r

@@ -0,0 +1,19 @@
+target <- sample(1:9,4)
+bulls <- 0
+cows <- 0
+attempts <- 0
+while (bulls != 4)
+  {
+  input <- readline("Guess a 4-digit number with no duplicate digits or 0s: ")
+  if (nchar(input) == 4)
+    {
+    input <- as.integer(strsplit(input,"")[[1]])
+    if ((sum(is.na(input)+sum(input==0))>=1) | (length(table(input)) != 4)) {print("Malformed input!")} else {
+      bulls <- sum(input == target)
+      cows <- sum(input %in% target)-bulls
+      cat("\n",bulls," Bull(s) and ",cows, " Cow(s)\n")
+      attempts <- attempts + 1
+      }
+    } else {print("Malformed input!")}
+  }
+print(paste("You won in",attempts,"attempt(s)!"))

Task/Bulls_and_cows/Scheme/bulls_and_cows.ss

@@ -0,0 +1,65 @@
+;generate a random non-repeating list of 4 digits, 1-9 inclusive
+(define (get-num)
+  (define (gen lst)
+    (if (= (length lst) 4) lst
+        (let ((digit (+ (random 9) 1)))
+          (if (member digit lst) ;make sure the new digit isn't in the
+                                 ;list
+              (gen lst)
+              (gen (cons digit lst))))))
+  (string->list (apply string-append (map number->string (gen '())))))
+
+;is g a valid guess (that is, non-repeating, four digits 1-9
+;inclusive?)
+(define (valid-guess? g)
+  (let ((g-num (string->number (apply string g))))
+    ;does the same digit appear twice in lst?
+    (define (repeats? lst)
+      (cond ((null? lst) #f)
+            ((member (car lst) (cdr lst)) #t)
+            (else (repeats? (cdr lst)))))
+    (and g-num
+         (> g-num 1233)
+         (< g-num 9877)
+         (not (repeats? g)))))
+
+;return '(cows bulls) for the given guess
+(define (score answer guess)
+  ;total cows + bulls
+  (define (cows&bulls a g)
+    (cond ((null? a) 0)
+          ((member (car a) g) (+ 1 (cows&bulls (cdr a) g)))
+          (else (cows&bulls (cdr a) g))))
+  ;bulls only
+  (define (bulls a g)
+    (cond ((null? a) 0)
+          ((equal? (car a) (car g)) (+ 1 (bulls (cdr a) (cdr g))))
+          (else (bulls (cdr a) (cdr g)))))
+  (list (- (cows&bulls answer guess) (bulls answer guess)) (bulls answer guess)))
+
+;play the game
+(define (bull-cow answer)
+  ;get the user's guess as a list
+  (define (get-guess)
+    (let ((e (read)))
+      (if (number? e)
+          (string->list (number->string e))
+          (string->list (symbol->string e)))))
+  (display "Enter a guess: ")
+  (let ((guess (get-guess)))
+    (if (valid-guess? guess)
+        (let ((bulls (cadr (score answer guess)))
+              (cows (car (score answer guess))))
+          (if (= bulls 4)
+              (display "You win!\n")
+              (begin
+                (display bulls)
+                (display " bulls, ")
+                (display cows)
+                (display " cows.\n")
+                (bull-cow answer))))
+        (begin
+          (display "Invalid guess.\n")
+          (bull-cow answer)))))
+
+(bull-cow (get-num))

Task/Bulls_and_cows/Smalltalk/bulls_and_cows.st

@@ -0,0 +1,58 @@
+Object subclass: BullsCows [
+  |number|
+  BullsCows class >> new: secretNum [ |i|
+    i := self basicNew.
+    (self isValid: secretNum)
+       ifFalse: [ SystemExceptions.InvalidArgument
+                    signalOn: secretNum
+                    reason: 'You need 4 unique digits from 1 to 9' ].
+    i setNumber: secretNum.
+    ^ i
+  ]
+  BullsCows class >> new [ |b| b := Set new.
+     [ b size < 4 ]
+       whileTrue: [ b add: ((Random between: 1 and: 9) displayString first) ].
+     ^ self new: (b asString)
+  ]
+  BullsCows class >> isValid: num [
+    ^ (num asSet size = 4) & ((num asSet includes: $0) not)
+  ]
+  setNumber: num [ number := num ]
+  check: guess [ |bc| bc := Bag new.
+     1 to: 4 do: [ :i |
+       (number at: i) = (guess at: i)
+         ifTrue: [ bc add: 'bulls' ]
+         ifFalse: [
+             (number includes: (guess at: i))
+               ifTrue: [ bc add: 'cows' ]
+         ]
+     ].
+     ^ bc
+  ]
+].
+
+'Guess the 4-digits number (digits from 1 to 9, no repetition)' displayNl.
+
+|guessMe d r tries|
+[
+  tries := 0.
+  guessMe := BullsCows new.
+  [
+    [
+      'Write 4 digits: ' display.
+      d := stdin nextLine.
+      (BullsCows isValid: d)
+    ] whileFalse: [
+         'Insert 4 digits, no repetition, exclude the digit 0' displayNl
+    ].
+    r := guessMe check: d.
+    tries := tries + 1.
+    (r occurrencesOf: 'bulls') = 4
+  ] whileFalse: [
+    ('%1 cows, %2 bulls' % { r occurrencesOf: 'cows'. r occurrencesOf: 'bulls' })
+      displayNl.
+  ].
+  ('Good, you guessed it in %1 tries!' % { tries }) displayNl.
+  'Do you want to play again? [y/n]' display.
+  ( (stdin nextLine) = 'y' )
+] whileTrue: [ Character nl displayNl ].

Task/Comments/Babel/comments.pb

@@ -0,0 +1,7 @@
+-- This is a line-comment
+
+#
+    This is a block-comment
+    It goes until de-dent
+
+dedent: 0x42 -- The comment block above is now closed

Task/Comments/Prolog/comments-2.pro

@@ -0,0 +1,2 @@
+/* This is a
+multi-line comment */

Task/Comments/Prolog/comments.pro

@@ -0,0 +1 @@
+% this is a single-line comment that extends to the end of the line

Task/Comments/R/comments.r

@@ -0,0 +1 @@
+# end of line comment

Task/Comments/Racket/comments.rkt

@@ -0,0 +1,2 @@
+; this is a coment
+#;(this expression is ignored)

Task/Comments/Sather/comments.sa

@@ -0,0 +1 @@
+-- a single line comment

Task/Comments/Scheme/comments.ss

@@ -0,0 +1,9 @@
+; Basically the same as Common Lisp
+; While R5RS does not provide block comments, they are defined in SRFI-30, as in Common Lisp :
+
+#| comment
+... #| nested comment
+... |#
+|#
+
+; See http://srfi.schemers.org/srfi-30/srfi-30.html

Task/Comments/Smalltalk/comments.st

@@ -0,0 +1,6 @@
+"Comments traditionally are in double quotes."
+"Multiline comments are also supported.
+ Comments are saved as metadata along with the source to a method.
+ A comment just after a method signature is often given to explain the
+ usage of the method. The class browser may display such comments
+ specially."

Task/Entropy/R/entropy.r

@@ -0,0 +1,5 @@
+entropy = function(s)
+   {freq = prop.table(table(strsplit(s, '')[1]))
+    -sum(freq * log(freq, base = 2))}
+
+print(entropy("1223334444"))   # 1.846439

Task/Entropy/Racket/entropy.rkt

@@ -0,0 +1,17 @@
+#lang racket
+(require math)
+
+(define (log2 x)
+  (/ (log x) (log 2)))
+
+(define (digits x)
+  (for/list ([c (number->string x)])
+    (- (char->integer c) (char->integer #\0))))
+
+(define (entropy x)
+  (define ds (digits x))
+  (define n (length ds))
+  (- (for/sum ([(d c) (in-hash (samples->hash ds))])
+       (* (/ d n) (log2 (/ d n))))))
+
+(entropy 1223334444)

Task/FizzBuzz/ActionScript/fizzbuzz.as

@@ -0,0 +1,10 @@
+for (var i:int = 1; i <= 100; i++) {
+  if (i % 15 == 0)
+    trace('FizzBuzz');
+  else if (i % 5 == 0)
+    trace('Buzz');
+  else if (i % 3 == 0)
+    trace('Fizz');
+  else
+    trace(i);
+}

Task/FizzBuzz/Babel/fizzbuzz.pb

@@ -0,0 +1,22 @@
+main:
+     { { iter 1 + dup
+
+        15 %
+            { "FizzBuzz" <<
+                zap }
+            { dup
+            3 %
+                { "Fizz" <<
+                    zap }
+                { dup
+                5 %
+                    { "Buzz" <<
+                        zap}
+                    { %d << }
+                if }
+            if }
+        if
+
+        "\n" << }
+
+    100 times }

Task/FizzBuzz/Prolog/fizzbuzz-2.pro

@@ -0,0 +1,6 @@
+fizzbuzz(X) :- 0 is X mod 15, write('FizzBuzz').
+fizzbuzz(X) :- 0 is X mod 3, write('Fizz').
+fizzbuzz(X) :- 0 is X mod 5, write('Buzz').
+fizzbuzz(X) :- write(X).
+
+dofizzbuzz :- foreach(between(1, 100, X), (fizzbuzz(X),nl)).

Task/FizzBuzz/Prolog/fizzbuzz.pro

@@ -0,0 +1,13 @@
+fizzbuzz :-
+        foreach(between(1, 100, X), print_item(X)).
+
+print_item(X) :-
+        (  0 is X mod 15
+        -> print('FizzBuzz')
+        ;  0 is X mod 3
+        -> print('Fizz')
+        ;  0 is X mod 5
+        -> print('Buzz')
+        ;  print(X)
+        ),
+        nl.

Task/FizzBuzz/R/fizzbuzz-2.r

@@ -0,0 +1,2 @@
+x <- paste(rep("", 100), c("", "", "Fizz"), c("", "", "", "", "Buzz"), sep="")
+cat(ifelse(x == "", 1:100, x), "\n")

Task/FizzBuzz/R/fizzbuzz-3.r

@@ -0,0 +1,4 @@
+x <- 1:100
+ifelse(x %% 15 == 0, 'FizzBuzz',
+       ifelse(x %% 5 == 0, 'Buzz',
+              ifelse(x %% 3 == 0, 'Fizz', x)))

Task/FizzBuzz/R/fizzbuzz.r

@@ -0,0 +1,6 @@
+x <- 1:100
+xx <- as.character(x)
+xx[x%%3==0] <- "Fizz"
+xx[x%%5==0] <- "Buzz"
+xx[x%%15==0] <- "FizzBuzz"
+xx

Task/FizzBuzz/Racket/fizzbuzz.rkt

@@ -0,0 +1,7 @@
+(for ([n (in-range 1 101)])
+  (displayln
+   (match (gcd n 15)
+     [15 "fizzbuzz"]
+     [3 "fizz"]
+     [5 "buzz"]
+     [_ n])))

Task/FizzBuzz/Sather/fizzbuzz.sa

@@ -0,0 +1,14 @@
+class MAIN is
+  main is
+    loop i ::= 1.upto!(100);
+      s:STR := "";
+      if i % 3 = 0 then s := "Fizz"; end;
+      if i % 5 = 0 then s := s + "Buzz"; end;
+      if s.length > 0 then
+        #OUT + s + "\n";
+      else
+        #OUT + i + "\n";
+      end;
+    end;
+  end;
+end;

Task/FizzBuzz/Scheme/fizzbuzz.ss

@@ -0,0 +1,8 @@
+(do ((i 1 (+ i 1)))
+    ((> i 100))
+    (display
+      (cond ((= 0 (modulo i 15)) "FizzBuzz")
+            ((= 0 (modulo i 3))  "Fizz")
+            ((= 0 (modulo i 5))  "Buzz")
+            (else                i)))
+    (newline))

Task/FizzBuzz/Smalltalk/fizzbuzz-2.st

@@ -0,0 +1,9 @@
+(1 to: 100) do:
+	[:n |
+		((n \\ 3)*(n \\ 5)) isZero
+                        ifFalse: [Transcript show: n].
+		(n \\ 3) isZero
+			ifTrue: [Transcript show: 'Fizz'].
+		(n \\ 5) isZero
+			ifTrue: [Transcript show: 'Buzz'].
+		Transcript cr.]

Task/FizzBuzz/Smalltalk/fizzbuzz-3.st

@@ -0,0 +1,8 @@
+fizzbuzz := Dictionary with: #(true true)->'FizzBuzz'
+                       with: #(true false)->'Fizz'
+                       with: #(false true)->'Buzz'.
+
+1 to: 100 do:
+	[ :i | Transcript show:
+               (fizzbuzz at: {i isDivisibleBy: 3. i isDivisibleBy: 5}
+		         ifAbsent: [ i ]); cr]

Task/FizzBuzz/Smalltalk/fizzbuzz-4.st

@@ -0,0 +1,10 @@
+1 to: 100 do: [:n | |r|
+	r := n rem: 15.
+	Transcript show: (r isZero
+	   ifTrue:['fizzbuzz']
+	   ifFalse: [(#(3 6 9 12) includes: r)
+		ifTrue:['fizz']
+		ifFalse:[((#(5 10) includes: r))
+			ifTrue:['buzz']
+			ifFalse:[n]]]);
+	cr].

Task/FizzBuzz/Smalltalk/fizzbuzz-5.st

@@ -0,0 +1,5 @@
+fbz := (1 to: 100) asOrderedCollection.
+ 3 to: 100 by:  3 do: [:i | fbz at: i put: 'Fizz'].
+ 5 to: 100 by:  5 do: [:i | fbz at: i put: 'Buzz'].
+15 to: 100 by: 15 do: [:i | fbz at: i put: 'FizzBuzz'].
+fbz do: [:i | Transcript show: i; cr].

Task/FizzBuzz/Smalltalk/fizzbuzz-6.st

@@ -0,0 +1,5 @@
+1 to: 100 do: [:i | |fb s|
+	fb := {i isDivisibleBy: 3. i isDivisibleBy: 5. nil}.
+	fb at: 3 put: (fb first | fb second) not.
+	s := '<1?Fizz:><2?Buzz:><3?{1}:>' format: {i printString}.
+	Transcript show: (s expandMacrosWithArguments: fb); cr].

Task/FizzBuzz/Smalltalk/fizzbuzz.st

@@ -0,0 +1,9 @@
+Integer extend [
+    fizzbuzz [
+        | fb |
+        fb := '%<Fizz|>1%<Buzz|>2' % {
+            self \\ 3 == 0.  self \\ 5 == 0 }.
+        ^fb isEmpty ifTrue: [ self ] ifFalse: [ fb ]
+    ]
+]
+1 to: 100 do: [ :i | i fizzbuzz displayNl ]

Task/Infinity/ActionScript/infinity.as

@@ -0,0 +1,2 @@
+trace(5 / 0); // outputs "Infinity"
+trace(isFinite(5 / 0)); // outputs "false"

Task/Infinity/Eiffel/infinity.e

@@ -0,0 +1,18 @@
+class
+	APPLICATION
+inherit
+	ARGUMENTS
+create
+	make
+feature {NONE} -- Initialization
+	number:REAL_64
+	make
+			-- Run application.
+		do
+			number := 2^2000
+			print(number)
+			print("%N")
+			print(number.is_positive_infinity)
+			print("%N")
+		end
+end

Task/Infinity/R/infinity.r

@@ -0,0 +1,11 @@
+ Inf                    #positive infinity
+ -Inf                   #negative infinity
+ .Machine$double.xmax   # largest finite floating-point number
+ is.finite              # function to test to see if a number is finite
+
+# function that returns the input if it is finite, otherwise returns (plus or minus) the largest finite floating-point number
+ forcefinite <- function(x) ifelse(is.finite(x), x, sign(x)*.Machine$double.xmax)
+
+ forcefinite(c(1, -1, 0, .Machine$double.xmax, -.Machine$double.xmax, Inf, -Inf))
+# [1]   1.000000e+00  -1.000000e+00   0.000000e+00  1.797693e+308
+# [5] -1.797693e+308  1.797693e+308 -1.797693e+308

Task/Infinity/Racket/infinity.rkt

@@ -0,0 +1,5 @@
+#lang racket
+
++inf.0 ; positive infinity
+(define (finite? x) (< -inf.0 x +inf.0))
+(define (infinite? x) (not (finite? x)))

Task/Infinity/Scheme/infinity.ss

@@ -0,0 +1,3 @@
++inf.0 ; positive infinity
+(define (finite? x) (< -inf.0 x +inf.0))
+(define (infinite? x) (not (finite? x)))

Task/Infinity/Smalltalk/infinity-2.st

@@ -0,0 +1,6 @@
+[
+  1.0 / 0.0
+] on: ZeroDivide do:[:ex |
+  ex proceedWith: (Float infinity)
+]
+-> INF

Task/Infinity/Smalltalk/infinity.st

@@ -0,0 +1,2 @@
+Float infinity -> INF
+1.0 / 0.0 -> "ZeroDivide exception"

Task/JSON/R/json-2.r

@@ -0,0 +1 @@
+cat(toJSON(data))

Task/JSON/R/json.r

@@ -0,0 +1,3 @@
+library(rjson)
+data <- fromJSON('{ "foo": 1, "bar": [10, "apples"] }')
+data

Task/JSON/Racket/json.rkt

@@ -0,0 +1,8 @@
+#lang racket
+
+(require json)
+
+(string->jsexpr
+ "{\"foo\":[1,2,3],\"bar\":null,\"baz\":\"blah\"}")
+
+(write-json '(1 2 "three" #hash((x . 1) (y . 2) (z . 3))))

Task/Knuth_shuffle/R/knuth_shuffle-2.r

@@ -0,0 +1,21 @@
+fisheryatesknuthshuffle <- function(n)
+{
+   a <- seq_len(n)
+   while(n >=2)
+   {
+      k <- sample.int(n, 1)
+      if(k != n)
+      {
+         temp <- a[k]
+         a[k] <- a[n]
+         a[n] <- temp
+      }
+      n <- n - 1
+   }
+   a
+}
+
+#Example usage:
+fisheryatesshuffle(6)                # e.g. 1 3 6 2 4 5
+x <- c("foo", "bar", "baz", "quux")
+x[fisheryatesknuthshuffle(4)]        # e.g. "bar"  "baz"  "quux" "foo"

Task/Knuth_shuffle/R/knuth_shuffle.r

@@ -0,0 +1,12 @@
+fisheryatesshuffle <- function(n)
+{
+  pool <- seq_len(n)
+  a <- c()
+  while(length(pool) > 0)
+  {
+     k <- sample.int(length(pool), 1)
+     a <- c(a, pool[k])
+     pool <- pool[-k]
+  }
+  a
+}

Task/Knuth_shuffle/Scheme/knuth_shuffle.ss

@@ -0,0 +1,10 @@
+(define (swap vec i j)
+  (let ([tmp (vector-ref vec i)])
+    (vector-set! vec i (vector-ref vec j))
+    (vector-set! vec j tmp)))
+
+(define (shuffle vec)
+  (for ((i (in-range (- (vector-length vec) 1) 0 -1)))
+    (let ((r (random i)))
+      (swap vec i r)))
+  vec)

Task/Knuth_shuffle/Smalltalk/knuth_shuffle-2.st

@@ -0,0 +1,6 @@
+"Test"
+|c|
+c := OrderedCollection new.
+c addAll: #( 1 2 3 4 5 6 7 8 9 ).
+Shuffler Knuth: c.
+c display.

Task/Knuth_shuffle/Smalltalk/knuth_shuffle.st

@@ -0,0 +1,22 @@
+"The selector swap:with: is documented, but it seems not
+ implemented (GNU Smalltalk version 3.0.4); so here it is an implementation"
+SequenceableCollection extend [
+  swap: i with: j [
+    |t|
+    t := self at: i.
+    self at: i put: (self at: j).
+    self at: j put: t.
+  ]
+].
+
+Object subclass: Shuffler [
+  Shuffler class >> Knuth: aSequenceableCollection [
+    |n k|
+    n := aSequenceableCollection size.
+    [ n > 1 ] whileTrue: [
+      k := Random between: 1 and: n.
+      aSequenceableCollection swap: n with: k.
+      n := n - 1
+    ]
+  ]
+].

Task/Ordered_words/Prolog/ordered_words.pro

@@ -0,0 +1,44 @@
+:- use_module(library( http/http_open )).
+
+ordered_words :-
+        % we read the URL of the words
+	http_open('http://www.puzzlers.org/pub/wordlists/unixdict.txt',	In, []),
+	read_file(In, [], Out),
+	close(In),
+
+        % we get a list of pairs key-value where key = Length and value = <list-of-its-codes>
+        % this list must be sorted
+	msort(Out, MOut),
+
+	group_pairs_by_key(MOut, POut),
+
+       % we sorted this list in decreasing order of the length of values
+	predsort(my_compare, POut, [_N-V | _OutSort]),
+	maplist(mwritef, V).
+
+
+mwritef(V) :-
+	writef('%s\n', [V]).
+
+read_file(In, L, L1) :-
+	read_line_to_codes(In, W),
+	(   W == end_of_file ->
+               % the file is read
+	       L1 = L
+	       ;
+               % we sort the list of codes of the line
+	       % and keep only the "goods word"
+	       (   msort(W, W) ->
+	           length(W, N), L2 = [N-W | L], (len = 6 -> writef('%s\n', [W]); true)
+	       ;
+	           L2 = L
+	       ),
+
+               % and we have the pair Key-Value in the result list
+	       read_file(In, L2, L1)).
+
+% predicate for sorting list of pairs Key-Values
+% if the lentgh of values is the same
+% we sort the keys in alhabetic order
+my_compare(R, K1-_V1, K2-_V2) :-
+	(   K1 < K2 -> R = >; K1 > K2 -> R = <; =).

Task/Ordered_words/Scheme/ordered_words.ss

@@ -0,0 +1,20 @@
+(define sorted-words
+  (let ((port (open-input-file "unixdict.txt")))
+    (let loop ((char (read-char port)) (word '()) (result '(())))
+      (cond
+       ((eof-object? char)
+	(reverse (map (lambda (word) (apply string word)) result)))
+       ((eq? #\newline char)
+	(loop (read-char port) '()
+	      (let ((best-length (length (car result))) (word-length (length word)))
+		(cond
+		 ((or (< word-length best-length) (not (apply char>=? word))) result)
+		 ((> word-length best-length) (list (reverse word)))
+		 (else (cons (reverse word) result))))))
+       (else (loop (read-char port) (cons char word) result))))))
+
+(map (lambda (x)
+       (begin
+	 (display x)
+	 (newline)))
+     sorted-words)

Task/Ordered_words/Smalltalk/ordered_words.st

@@ -0,0 +1,17 @@
+|file dict r t|
+file := FileStream open: 'unixdict.txt' mode: FileStream read.
+dict := Set new.
+
+"load the whole dict into the set before, 'filter' later"
+[ file atEnd ] whileFalse: [
+  dict add: (file upTo: Character nl) ].
+
+"find those with the sorted letters, and sort them by length"
+r := ((dict
+       select: [ :w | (w asOrderedCollection sort) = (w asOrderedCollection) ] )
+     asSortedCollection: [:a :b| (a size) > (b size) ] ).
+
+"get those that have length = to the max length, and sort alphabetically"
+r := (r select: [:w| (w size) = ((r at: 1) size)]) asSortedCollection.
+
+r do: [:e| e displayNl].

Task/Pi/Racket/pi.rkt

@@ -0,0 +1,4 @@
+#lang racket
+(require math/bigfloat)
+(bf-precision (exact-floor (/ (* 200 (log 10)) (log 2))))
+pi.bf

Task/Quine/Prolog/quine.pro

@@ -0,0 +1,2 @@
+quine :-
+	listing(quine).

Task/Quine/R/quine.r

@@ -0,0 +1 @@
+(function(){x<-intToUtf8(34);s<-"(function(){x<-intToUtf8(34);s<-%s%s%s;cat(sprintf(s,x,s,x))})()";cat(sprintf(s,x,s,x))})()

Task/Quine/Scheme/quine-2.ss

@@ -0,0 +1 @@
+((lambda (q) (quasiquote ((unquote q) (quote (unquote q))))) (quote (lambda (q) (quasiquote ((unquote q) (quote (unquote q)))))))

Task/Quine/Scheme/quine-3.ss

@@ -0,0 +1 @@
+((lambda (q) `(,q ',q)) '(lambda (q) `(,q ',q)))

Task/Quine/Scheme/quine.ss

@@ -0,0 +1 @@
+((lambda (s) (display (list s (list (quote quote) s)))) (quote (lambda (s) (display (list s (list (quote quote) s))))))

Task/Quine/Smalltalk/quine-2.st

@@ -0,0 +1 @@
+' print; displayNl' print; displayNl

Task/Quine/Smalltalk/quine.st

@@ -0,0 +1 @@
+[:s| Transcript show: s, s printString; cr ] value: '[:s| Transcript show: s, s printString; cr ] value: '

Task/Search_a_list/ActionScript/search_a_list-2.as

@@ -0,0 +1,7 @@
+package {
+	public class StringNotFoundError extends Error {
+		public function StringNotFoundError(message:String) {
+			super(message);
+		}
+	}
+}

Task/Search_a_list/ActionScript/search_a_list-3.as

@@ -0,0 +1,17 @@
+import StringNotFoundError;
+var list:Vector.<String> = Vector.<String>(["Zig", "Zag", "Wally", "Ronald", "Bush", "Krusty", "Charlie", "Bush", "Boz", "Zag"]);
+function lowIndex(listToSearch:Vector.<String>, searchString:String):int
+{
+	var index:int = listToSearch.indexOf(searchString);
+	if(index == -1)
+		throw new StringNotFoundError("String not found: " + searchString);
+	return index;
+}
+
+function highIndex(listToSearch:Vector.<String>, searchString:String):int
+{
+	var index:int = listToSearch.lastIndexOf(searchString);
+	if(index == -1)
+		throw new StringNotFoundError("String not found: " + searchString);
+	return index;
+}

Task/Search_a_list/ActionScript/search_a_list.as

@@ -0,0 +1,16 @@
+var list:Vector.<String> = Vector.<String>(["Zig", "Zag", "Wally", "Ronald", "Bush", "Krusty", "Charlie", "Bush", "Boz", "Zag"]);
+function lowIndex(listToSearch:Vector.<String>, searchString:String):int
+{
+	var index:int = listToSearch.indexOf(searchString);
+	if(index == -1)
+		throw new Error("String not found: " + searchString);
+	return index;
+}
+
+function highIndex(listToSearch:Vector.<String>, searchString:String):int
+{
+	var index:int = listToSearch.lastIndexOf(searchString);
+	if(index == -1)
+		throw new Error("String not found: " + searchString);
+	return index;
+}

Task/Search_a_list/Prolog/search_a_list.pro

@@ -0,0 +1,23 @@
+search_a_list(N1, N2) :-
+	L = ["Zig", "Zag", "Wally", "Ronald", "Bush", "Krusty", "Charlie", "Bush", "Boz", "Zag"],
+
+	write('List is :'), maplist(my_write, L), nl, nl,
+
+	(   nth1(Ind1, L, N1) ->
+	    format('~s is in position ~w~n', [N1, Ind1])
+	;   format('~s is not present~n', [N1])),
+	(   nth1(Ind2, L, N2) ->
+	    format('~s is in position ~w~n', [N2, Ind2])
+	;   format('~s is not present~n', [N2])),
+	(   reverse_nth1(Ind3, L, N1) ->
+	    format('~s last position is ~w~n', [N1, Ind3])
+	;   format('~s is not present~n', [N1])).
+
+reverse_nth1(Ind, L, N) :-
+	reverse(L, RL),
+	length(L, Len),
+	nth1(Ind1, RL, N),
+	Ind is Len - Ind1 + 1.
+
+my_write(Name) :-
+	writef(' %s', [Name]).

Task/Search_a_list/R/search_a_list-2.r

@@ -0,0 +1,8 @@
+haystack1 <- c("where", "is", "the", "needle", "I", "wonder")
+haystack2 <- c("no", "sewing", "equipment", "in", "here")
+haystack3 <- c("oodles", "of", "needles", "needles", "needles", "in", "here")
+
+find.needle(haystack1)                              # 4
+find.needle(haystack2)                              # error
+find.needle(haystack3)                              # 3
+find.needle(haystack3, needle="needles", ret=TRUE)  # 3 5

Task/Search_a_list/R/search_a_list.r

@@ -0,0 +1,6 @@
+find.needle <- function(haystack, needle="needle", return.last.index.too=FALSE)
+{
+   indices <- which(haystack %in% needle)
+   if(length(indices)==0) stop("no needles in the haystack")
+   if(return.last.index.too) range(indices) else min(indices)
+}

Task/Search_a_list/Racket/search_a_list-2.rkt

@@ -0,0 +1,4 @@
+(define (index-last xs y)
+  (for/last ([(x i) (in-indexed xs)]
+             #:when (equal? x y))
+    i))

Task/Search_a_list/Racket/search_a_list-3.rkt

@@ -0,0 +1,7 @@
+(define haystack '("Zig" "Zag" "Wally" "Ronald" "Bush" "Krusty" "Charlie" "Bush" "Bozo"))
+
+(for/list ([needle '("Bender" "Bush")])
+    (index haystack needle))
+
+(for/list ([needle '("Bender" "Bush")])
+    (index-last haystack needle))

Task/Search_a_list/Racket/search_a_list.rkt

@@ -0,0 +1,4 @@
+(define (index xs y)
+  (for/first ([(x i) (in-indexed xs)]
+              #:when (equal? x y))
+    i))

Task/Search_a_list/Sather/search_a_list.sa

@@ -0,0 +1,14 @@
+class MAIN is
+   main is
+      haystack :ARRAY{STR} := |"Zig", "Zag", "Wally", "Ronald", "Bush", "Krusty", "Charlie", "Bush", "Bozo"|;
+      needles :ARRAY{STR} := | "Washington", "Bush" |;
+      loop needle ::= needles.elt!;
+	 index ::= haystack.index_of(needle);
+	 if index < 0 then
+	    #OUT + needle + " is not in the haystack\n";
+	 else
+	    #OUT + index + " " + needle + "\n";
+	 end;
+      end;
+   end;
+end;

Task/Search_a_list/Scheme/search_a_list.ss

@@ -0,0 +1,16 @@
+(define haystack
+  '("Zig" "Zag" "Wally" "Ronald" "Bush" "Krusty" "Charlie" "Bush" "Bozo"))
+
+(define index-of
+  (lambda (needle hackstack)
+    (let ((tail (member needle haystack)))
+      (if tail
+          (- (length haystack) (length tail))
+          (throw 'needle-missing)))))
+
+(define last-index-of
+  (lambda (needle hackstack)
+    (let ((tail (member needle (reverse haystack))))
+      (if tail
+          (- (length tail) 1)
+          (throw 'needle-missing)))))

Task/Search_a_list/Smalltalk/search_a_list.st

@@ -0,0 +1,14 @@
+| haystack |
+haystack :=
+   'Zig,Zag,Wally,Ronald,Bush,Krusty,Charlie,Bush,Bozo' subStrings: $,.
+{ 'Washington' . 'Bush'  } do: [:i|
+  |t l|
+  t := (haystack indexOf: i).
+  (t = 0) ifTrue: [ ('%1 is not in the haystack' % { i }) displayNl ]
+          ifFalse: [ ('%1 is at index %2' % { i . t }) displayNl.
+                     l := ( (haystack size) - (haystack reverse indexOf: i) + 1 ).
+                     ( t = l ) ifFalse: [
+                       ('last occurence of %1 is at index %2' %
+                             { i . l }) displayNl ]
+                   ]
+].