September 2017 Update

Task/Binary-digits/6502-Assembly/binary-digits.6502

@@ -0,0 +1,90 @@
+; C64 - Binary digits
+;       http://rosettacode.org/wiki/Binary_digits
+
+; *** labels ***
+
+declow      = $fb
+dechigh     = $fc
+binstrptr   = $fd               ; $fe is used for the high byte of the address
+chkcom      = $aefd
+frmnum      = $ad8a
+getadr      = $b7f7
+strout      = $ab1e
+
+; *** main ***
+
+            *=$033c             ; sys828 tbuffer ($033c-$03fb)
+
+            jsr chkcom          ; check for and skip comma
+            jsr frmnum          ; evaluate numeric expression
+            jsr getadr          ; convert floating point number to two-byte int
+            jsr dec2bin         ; convert two-byte int to binary string
+            lda #<binstr        ; load the address of the binary string - low
+            ldy #>binstr        ; high byte
+            jsr skiplz          ; skip leading zeros, return an address in a/y
+                                ;   that points to the first "1"
+            jsr strout          ; print the result
+            rts
+
+; *** subroutines ****
+
+; Converts a 16 bit integer to a binary string.
+; Input: y - low byte of the integer
+;        a - high byte of the integer
+; Output: a 16 byte string stored at 'binstr'
+dec2bin     sty declow          ; store the two-byte integer
+            sta dechigh
+            lda #<binstr        ; store the binary string address on the zero page
+            sta binstrptr
+            lda #>binstr
+            sta binstrptr+1
+            ldx #$01            ; start conversion with the high byte
+wordloop    ldy #$00            ; bit counter
+byteloop    asl declow,x        ; shift left, bit 7 is shifted into carry
+            bcs one             ; carry set? jump
+            lda #"0"            ; a="0"
+            bne writebit
+one         lda #"1"            ; a="1"
+writebit    sta (binstrptr),y   ; write the digit to the string
+            iny                 ; y++
+            cpy #$08            ; y==8 all bits converted?
+            bne byteloop        ;   no -> convert next bit
+            clc                 ; clear carry
+            lda #$08            ; a=8
+            adc binstrptr       ; add 8 to the string address pointer
+            sta binstrptr
+            bcc nooverflow      ; address low byte did overflow?
+            inc binstrptr+1     ;   yes -> increase the high byte
+nooverflow  dex                 ; x--
+            bpl wordloop        ; x<0? no -> convert the low byte
+            rts                 ;   yes -> conversion finished, return
+
+; Skip leading zeros.
+; Input:  a - low byte of the byte string address
+;         y - high byte -"-
+; Output: a - low byte of string start address without leading zeros
+;         y - high byte -"-
+skiplz      sta binstrptr       ; store the binary string address on the zero page
+            sty binstrptr+1
+            ldy #$00            ; byte counter
+skiploop    lda (binstrptr),y   ; load a byte from the string
+            iny                 ; y++
+            cpy #$11            ; y==17
+            beq endreached      ;   yes -> end of string reached without a "1"
+            cmp #"1"            ; a=="1"
+            bne skiploop        ;   no -> take the next byte
+            beq add2ptr         ;   yes -> jump
+endreached  dey                 ; move the pointer to the last 0
+add2ptr     clc
+            dey
+            tya                 ; a=y
+            adc binstrptr       ; move the pointer to the first "1" in the string
+            bcc loadhigh        ; overflow?
+            inc binstrptr+1     ;  yes -> increase high byte
+loadhigh    ldy binstrptr+1
+            rts
+
+; *** data ***
+
+binstr      .repeat 16, $00     ; reserve 16 bytes for the binary digits
+            .byte $0d, $00      ; newline + null terminator

Task/Binary-digits/Ada/binary-digits.ada

@@ -1,28 +1,11 @@
-with Ada.Text_IO;
-
-procedure Binary_Output is
-
-   package IIO is new Ada.Text_IO.Integer_IO(Integer);
-
-   function To_Binary(N: Natural) return String is
-      S: String(1 .. 1000); -- more than plenty!
-      Left:  Positive := S'First;
-      Right: Positive := S'Last;
-   begin
-      IIO.Put(To => S, Item => N, Base => 2); -- This is the conversion!
-      -- Now S is a String with many spaces and some "2#...#" somewhere.
-      -- We only need the "..." part without spaces or base markers.
-      while S(Left) /= '#' loop
-         Left := Left + 1;
-      end loop;
-      while S(Right) /= '#' loop
-         Right := Right - 1;
-      end loop;
-      return S(Left+1 .. Right-1);
-   end To_Binary;
-
+with ada.text_io;use ada.text_io;
+procedure binary is
+-- the digits in base 2
+  bit : array (0..1) of string (1..1) := ("0","1");
+-- the conversion function itself
+  function bin_image (n : Natural) return string is (if n<2 then bit (n) else bin_image (n/2)&bit(n mod 2));
+-- the values we want to test
+  test_values : array (1..3) of Natural := (5,50,9000);
 begin
-   Ada.Text_IO.Put_Line(To_Binary(5));    -- 101
-   Ada.Text_IO.Put_Line(To_Binary(50));   -- 110010
-   Ada.Text_IO.Put_Line(To_Binary(9000)); -- 10001100101000
-end Binary_Output;
+  for test of test_values loop put_line ("Output for"&test'img&" is "&bin_image (test)); end loop;
+end binary;

Task/Binary-digits/AppleScript/binary-digits-1.applescript

@@ -0,0 +1,90 @@
+-- showBin :: Int -> String
+on showBin(n)
+    script binaryChar
+        on |λ|(n)
+            text item (n + 1) of "01"
+        end |λ|
+    end script
+    showIntAtBase(2, binaryChar, n, "")
+end showBin
+
+-- GENERIC FUNCTIONS ----------------------------------------------------------
+
+-- showIntAtBase :: Int -> (Int -> Char) -> Int -> String -> String
+on showIntAtBase(base, toChr, n, rs)
+    script showIt
+        on |λ|(nd_, r)
+            set {n, d} to nd_
+            set r_ to toChr's |λ|(d) & r
+            if n > 0 then
+                |λ|(quotRem(n, base), r_)
+            else
+                r_
+            end if
+        end |λ|
+    end script
+
+    if base ≤ 1 then
+        "error: showIntAtBase applied to unsupported base: " & base as string
+    else if n < 0 then
+        "error: showIntAtBase applied to negative number: " & base as string
+    else
+        showIt's |λ|(quotRem(n, base), rs)
+    end if
+end showIntAtBase
+
+--  quotRem :: Integral a => a -> a -> (a, a)
+on quotRem(m, n)
+    {m div n, m mod n}
+end quotRem
+
+-- TEST -----------------------------------------------------------------------
+on run
+    script
+        on |λ|(n)
+            intercalate(" -> ", {n as string, showBin(n)})
+        end |λ|
+    end script
+
+    return unlines(map(result, {5, 50, 9000}))
+end run
+
+
+-- GENERIC FUNCTIONS FOR TEST -------------------------------------------------
+
+-- intercalate :: Text -> [Text] -> Text
+on intercalate(strText, lstText)
+    set {dlm, my text item delimiters} to {my text item delimiters, strText}
+    set strJoined to lstText as text
+    set my text item delimiters to dlm
+    return strJoined
+end intercalate
+
+-- map :: (a -> b) -> [a] -> [b]
+on map(f, xs)
+    tell mReturn(f)
+        set lng to length of xs
+        set lst to {}
+        repeat with i from 1 to lng
+            set end of lst to |λ|(item i of xs, i, xs)
+        end repeat
+        return lst
+    end tell
+end map
+
+-- Lift 2nd class handler function into 1st class script wrapper
+-- mReturn :: Handler -> Script
+on mReturn(f)
+    if class of f is script then
+        f
+    else
+        script
+            property |λ| : f
+        end script
+    end if
+end mReturn
+
+-- unlines :: [String] -> String
+on unlines(xs)
+    intercalate(linefeed, xs)
+end unlines

Task/Binary-digits/AppleScript/binary-digits-2.applescript

@@ -0,0 +1,9 @@
+-- showBin :: Int -> String
+on showBin(n)
+    script binaryChar
+        on |λ|(n)
+            text item (n + 1) of "〇一"
+        end |λ|
+    end script
+    showIntAtBase(2, binaryChar, n, "")
+end showBin

Task/Binary-digits/AppleScript/binary-digits.applescript

@@ -1,80 +0,0 @@
--- binaryString :: Int -> String
-on binaryString(n)
-
-    showIntAtBase(2, n)
-
-end binaryString
-
-
--- showIntAtBase :: Int -> Int -> String
-on showIntAtBase(base, n)
-    if base > 1 then
-        if n > 0 then
-            set m to n mod base
-            set r to n - m
-            if r > 0 then
-                set prefix to showIntAtBase(base, r div base)
-            else
-                set prefix to ""
-            end if
-
-            if m < 10 then
-                set baseCode to 48 -- "0"
-            else
-                set baseCode to 55 -- "A" - 10
-            end if
-
-            prefix & character id (baseCode + m)
-        else
-            "0"
-        end if
-    else
-        missing value
-    end if
-end showIntAtBase
-
-
--- TEST
-on run
-
-    intercalate(linefeed, ¬
-        map(binaryString, [5, 50, 9000]))
-
-end run
-
-
-
-
--- GENERIC FUNCTIONS FOR TESTING
-
--- map :: (a -> b) -> [a] -> [b]
-on map(f, xs)
-    tell mReturn(f)
-        set lng to length of xs
-        set lst to {}
-        repeat with i from 1 to lng
-            set end of lst to lambda(item i of xs, i, xs)
-        end repeat
-        return lst
-    end tell
-end map
-
--- intercalate :: Text -> [Text] -> Text
-on intercalate(strText, lstText)
-    set {dlm, my text item delimiters} to {my text item delimiters, strText}
-    set strJoined to lstText as text
-    set my text item delimiters to dlm
-    return strJoined
-end intercalate
-
--- Lift 2nd class handler function into 1st class script wrapper
--- mReturn :: Handler -> Script
-on mReturn(f)
-    if class of f is script then
-        f
-    else
-        script
-            property lambda : f
-        end script
-    end if
-end mReturn

Task/Binary-digits/BASIC/binary-digits-4.basic

@@ -0,0 +1,14 @@
+10 N = 5 : GOSUB 100
+20 N = 50 : GOSUB 100
+30 N = 9000 : GOSUB 100
+40 END
+90 REM *** SUBROUTINE: CONVERT DECIMAL TO BINARY
+100 N2 =  ABS(INT(N))
+110 B$ = ""
+120 FOR N1 = N2 TO 0 STEP 0
+130 :  N2 =  INT(N1 / 2)
+140 :  B$ =  STR$(N1 - N2 * 2) + B$
+150 :  N1 = N2
+160 NEXT N1
+170 PRINT B$
+180 RETURN

Task/Binary-digits/BaCon/binary-digits.bacon

@@ -0,0 +1,8 @@
+' Binary digits
+OPTION MEMTYPE int
+INPUT n$
+IF VAL(n$) = 0 THEN
+    PRINT "0"
+ELSE
+    PRINT CHOP$(BIN$(VAL(n$)), "0", 1)
+ENDIF

Task/Binary-digits/Bc/binary-digits.bc

@@ -0,0 +1,5 @@
+obase = 2
+5
+50
+9000
+quit

Task/Binary-digits/C++/binary-digits-5.cpp

@@ -0,0 +1,11 @@
+#include <iostream>
+
+std::string binary(int n) {
+  return n == 0 ? "" : binary(n >> 1) + std::to_string(n & 1);
+}
+
+int main(int argc, char* argv[]) {
+  for (int i = 1; i < argc; ++i) {
+    std::cout << binary(std::stoi(argv[i])) << std::endl;
+  }
+}

Task/Binary-digits/C/binary-digits-1.c

@@ -1,20 +0,0 @@
-#include <stdio.h>
-
-void bin(int x, char *s)
-{
-	char*_(int x){
-		*(s = x ? _(x >> 1) : s) = (x & 1) + '0';
-		return ++s;
-	}
-	*_(x) = 0;
-}
-
-int main()
-{
-	char a[100];
-	int i;
-	for (i = 0; i <= 1984; i += 31)
-		bin(i, a), printf("%4d: %s\n", i, a);
-
-	return 0;
-}

Task/Binary-digits/C/binary-digits-2.c

@@ -1,30 +0,0 @@
-#include <stdio.h>
-
-void IntToBitString(unsigned int number)
-{
-    int num_bits = sizeof(unsigned int) * 8;
-
-    bool startPrinting = false;
-    for (int bit_pos=num_bits-1; bit_pos >= 0; bit_pos--)
-    {
-        bool isBitSet = (number & (1<<bit_pos)) != 0;
-
-        if (!startPrinting && isBitSet)
-            startPrinting = true;
-
-        if (startPrinting || bit_pos==0)
-            printf("%s", isBitSet ? "1":"0");
-    }
-
-    printf("\r\n");
-}
-
-int main()
-{
-    IntToBitString(0);
-    IntToBitString(5);
-    IntToBitString(50);
-    IntToBitString(9000);
-
-    return 0;
-}

Task/Binary-digits/Dc/binary-digits.dc

@@ -0,0 +1 @@
+2o 5p 50p 9000p

Task/Binary-digits/Elena/binary-digits.elena

@@ -1,11 +1,10 @@
-#define system.
-#define system'routines.
-#define extensions.
+import system'routines.
+import extensions.
 
-#symbol program =
+program =
 [
-    (5,50,9000) run &each: n
+    (5,50,9000) forEach(:n)
     [
-        console writeLine:(n toLiteral &base:2).
+        console printLine(n toLiteral base:2).
     ].
 ].

Task/Binary-digits/Gambas/binary-digits.gambas

@@ -0,0 +1,9 @@
+Public Sub Main()
+Dim siBin As Short[] = [5, 50, 9000]
+Dim siCount As Short
+
+For siCount = 0 To siBin.Max
+  Print Bin(siBin[siCount])
+Next
+
+End

Task/Binary-digits/Haskell/binary-digits.hs

@@ -9,6 +9,14 @@ toBin n = showIntAtBase 2 ("01" !!) n ""
 toBin1 0 = []
 toBin1 x =  (toBin1 $ x `div` 2) ++ (show $ x `mod` 2)
 
+-- Or even more efficient (due to fusion) and universal implementation
+toBin2 = foldMap show . reverse . toBase 2
+
+toBase base = unfoldr modDiv
+  where modDiv 0 = Nothing
+        modDiv n = let (q, r) = (n `divMod` base) in Just (r, q)
+
+
 printToBin n = putStrLn $ printf "%4d  %14s  %14s" n (toBin n) (toBin1 n)
 
 main = do

Task/Binary-digits/JavaScript/binary-digits-1.js

@@ -1,7 +1,9 @@
 function toBinary(number) {
-  return new Number(number).toString(2);
+    return new Number(number)
+        .toString(2);
 }
 var demoValues = [5, 50, 9000];
-for (var i=0; i<demoValues.length; ++i) {
-  print(toBinary(demoValues[i])); // alert() in a browser, wscript.echo in WSH, etc.
+for (var i = 0; i < demoValues.length; ++i) {
+    // alert() in a browser, wscript.echo in WSH, etc.
+    print(toBinary(demoValues[i]));
 }

Task/Binary-digits/JavaScript/binary-digits-2.js

@@ -1,7 +1,30 @@
-console.log(
+(() => {
 
-    [5, 50, 9000].map(function (n) {
-        return (n).toString(2);
-    }).join('\n')
+    // showIntAtBase_ :: // Int -> Int -> String
+    const showIntAtBase_ = (base, n) => (n)
+        .toString(base);
 
-)
+    // showBin :: Int -> String
+    const showBin = n => showIntAtBase_(2, n);
+
+    // GENERIC FUNCTIONS FOR TEST ---------------------------------------------
+
+    // intercalate :: String -> [a] -> String
+    const intercalate = (s, xs) => xs.join(s);
+
+    // map :: (a -> b) -> [a] -> [b]
+    const map = (f, xs) => xs.map(f);
+
+    // unlines :: [String] -> String
+    const unlines = xs => xs.join('\n');
+
+    // show :: a -> String
+    const show = x => JSON.stringify(x);
+
+    // TEST -------------------------------------------------------------------
+
+    return unlines(map(
+        n => intercalate(' -> ', [show(n), showBin(n)]),
+        [5, 50, 9000]
+    ));
+})();

Task/Binary-digits/JavaScript/binary-digits-3.js

@@ -0,0 +1,47 @@
+(() => {
+
+    // showBin :: Int -> String
+    const showBin = n => {
+        const binaryChar = n => n !== 0 ? '一' : '〇';
+
+        return showIntAtBase(2, binaryChar, n, '');
+    };
+
+    // showIntAtBase :: Int -> (Int -> Char) -> Int -> String -> String
+    const showIntAtBase = (base, toChr, n, rs) => {
+        const showIt = ([n, d], r) => {
+            const r_ = toChr(d) + r;
+            return n !== 0 ? (
+                showIt(quotRem(n, base), r_)
+            ) : r_;
+        };
+        return base <= 1 ? (
+            'error: showIntAtBase applied to unsupported base'
+        ) : n < 0 ? (
+            'error: showIntAtBase applied to negative number'
+        ) : showIt(quotRem(n, base), rs);
+    };
+
+    // quotRem :: Integral a => a -> a -> (a, a)
+    const quotRem = (m, n) => [Math.floor(m / n), m % n];
+
+    // GENERIC FUNCTIONS FOR TEST ---------------------------------------------
+
+    // intercalate :: String -> [a] -> String
+    const intercalate = (s, xs) => xs.join(s);
+
+    // map :: (a -> b) -> [a] -> [b]
+    const map = (f, xs) => xs.map(f);
+
+    // unlines :: [String] -> String
+    const unlines = xs => xs.join('\n');
+
+    // show :: a -> String
+    const show = x => JSON.stringify(x);
+
+    // TEST -------------------------------------------------------------------
+
+    return unlines(map(
+        n => intercalate(' -> ', [show(n), showBin(n)]), [5, 50, 9000]
+    ));
+})();

Task/Binary-digits/Kotlin/binary-digits.kotlin

@@ -0,0 +1,6 @@
+// version 1.0.5-2
+
+fun main(args: Array<String>) {
+    val numbers = intArrayOf(5, 50, 9000)
+    for (number in numbers) println("%4d".format(number) + " -> " + Integer.toBinaryString(number))
+}

Task/Binary-digits/MLite/binary-digits.mlite

@@ -0,0 +1,5 @@
+fun binary
+		(0, b)	=	implode ` map (fn x = if int x then chr (x + 48) else x) b
+	|	(n, b)	=	binary (n div 2, n mod 2 :: b)
+	|	n	=	binary (n, [])
+;	

Task/Binary-digits/Objeck/binary-digits.objeck

@@ -1,9 +1,7 @@
-bundle Default {
-  class Binary {
-    function : Main(args : String[]) ~ Nil {
-      5->ToBinaryString()->PrintLine();
-      50->ToBinaryString()->PrintLine();
-      9000->ToBinaryString()->PrintLine();
-    }
+class Binary {
+  function : Main(args : String[]) ~ Nil {
+    5->ToBinaryString()->PrintLine();
+    50->ToBinaryString()->PrintLine();
+    9000->ToBinaryString()->PrintLine();
   }
 }

Task/Binary-digits/SkookumScript/binary-digits-2.skookum

@@ -0,0 +1 @@
+{5 50 9000}.do[println(item.binary)]

Task/Binary-digits/Zkl/binary-digits-1.zkl

@@ -0,0 +1 @@
+(9000).toString(2)

Task/Binary-digits/Zkl/binary-digits-2.zkl

@@ -0,0 +1 @@
+T(5,50,9000).apply("toString",2) //--> L("101","110010","10001100101000")

Task/Binary-digits/Zkl/binary-digits-3.zkl

@@ -0,0 +1 @@
+"%.2B".fmt(9000)