langs a-z

Task/Gray-code/OCaml/gray-code.ocaml

@@ -0,0 +1,26 @@
+let gray_encode b =
+  b lxor (b lsr 1)
+
+let gray_decode n =
+  let rec aux p n =
+    if n = 0 then p
+    else aux (p lxor n) (n lsr 1)
+  in
+  aux n (n lsr 1)
+
+let bool_string len n =
+  let s = String.make len '0' in
+  let rec aux i n =
+    if n land 1 = 1 then s.[i] <- '1';
+    if i <= 0 then s
+    else aux (pred i) (n lsr 1)
+  in
+  aux (pred len) n
+
+let () =
+  let s = bool_string 5 in
+  for i = 0 to pred 32 do
+    let g = gray_encode i in
+    let b = gray_decode g in
+    Printf.printf "%2d : %s => %s => %s : %2d\n" i (s i) (s g) (s b) b
+  done

Task/Gray-code/PARI-GP/gray-code.pari

@@ -0,0 +1,5 @@
+toGray(n)=bitxor(n,n>>1);
+fromGray(n)=my(k=1,m=n);while(m>>k,n=bitxor(n,n>>k);k+=k);n;
+bin(n)=concat(apply(k->Str(k),binary(n)))
+
+for(n=0,31,print(n"\t"bin(n)"\t"bin(g=toGray(n))"\t"fromGray(g)))

Task/Gray-code/Perl-6/gray-code-1.pl6

@@ -0,0 +1,16 @@
+sub gray_encode ( Int $n --> Int ) {
+    return $n +^ ( $n +> 1 );
+}
+
+sub gray_decode ( Int $n is copy --> Int ) {
+    my $mask = 1 +< (32-2);
+    $n +^= $mask +> 1 if $n +& $mask while $mask +>= 1;
+    return $n;
+}
+
+for ^32 -> $n {
+    my $g = gray_encode($n);
+    my $d = gray_decode($g);
+    printf "%2d: %5b => %5b => %5b: %2d\n", $n, $n, $g, $d, $d;
+    die if $d != $n;
+}

Task/Gray-code/Perl-6/gray-code-2.pl6

@@ -0,0 +1,19 @@
+multi bin_to_gray ( [] ) { [] }
+multi bin_to_gray ( [$head, *@tail] ) {
+    return [ $head, ( @tail Z+^ ($head, @tail) ) ];
+}
+
+multi gray_to_bin ( [] ) { [] }
+multi gray_to_bin ( [$head, *@tail] ) {
+    my @bin := $head, (@tail Z+^ @bin);
+    return @bin.flat;
+}
+
+for ^32 -> $n {
+    my @b = $n.fmt('%b').comb;
+    my $g = bin_to_gray(@b);
+    my $d = gray_to_bin($g);
+    printf "%2d: %5s => %5s => %5s: %2d\n",
+            $n, @b.join, $g.join, $d.join, :2($d.join);
+    die if :2($d.join) != $n;
+}

Task/Gray-code/PowerBASIC/gray-code.powerbasic

@@ -0,0 +1,18 @@
+function gray%(byval n%)
+  gray%=n% xor (n%\2)
+end function
+
+function igray%(byval n%)
+  r%=0
+  while n%>0
+    r%=r% xor n%
+    shift right n%,1
+  wend
+  igray%=r%
+end function
+
+print "   N  GRAY   INV"
+for n%=0 to 31
+  g%=gray%(n%)
+  print bin$(n%);" ";bin$(g%);" ";bin$(igray%(g%))
+next

Task/Gray-code/PureBasic/gray-code.purebasic

@@ -0,0 +1,31 @@
+Procedure.i gray_encode(n)
+  ProcedureReturn n ! (n >> 1)
+EndProcedure
+
+Procedure.i gray_decode(g)
+  Protected bit = 1 << (8 * SizeOf(Integer) - 2)
+  Protected b = g & bit, p = b >> 1
+
+  While bit > 1
+    bit >> 1
+    b | (p ! (g & bit))
+    p = (b & bit) >> 1
+  Wend
+  ProcedureReturn b
+EndProcedure
+
+If OpenConsole()
+  PrintN("Number Binary Gray    Decoded")
+  Define i, n
+  For i = 0 To 31
+    g = gray_encode(i)
+    Print(RSet(Str(i), 2, "0") + Space(5))
+    Print(RSet(Bin(g, #PB_Byte), 5, "0") + Space(2))
+    n = gray_decode(g)
+    Print(RSet(Bin(n, #PB_Byte), 5, "0") + Space(3))
+    PrintN(RSet(Str(n), 2, "0"))
+  Next
+
+  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
+  CloseConsole()
+EndIf

Task/Gray-code/Ursala/gray-code.ursala

@@ -0,0 +1,12 @@
+#import std
+#import nat
+
+xor = ~&Y&& not ~&B                  # either and not both
+
+btog = xor*+ zipp0@iitBX             # map xor over the argument zipped with its shift
+
+gtob = ~&y+ =><0> ^C/xor@lrhPX ~&r   # fold xor over the next input with previous output
+
+#show+
+
+test = mat` * 2-$'01'***K7xSS pad0*K7 <.~&,btog,gtob+ btog>* iota32

Task/Gray-code/VHDL/gray-code-1.vhdl

@@ -0,0 +1,14 @@
+LIBRARY ieee;
+USE ieee.std_logic_1164.all;
+
+entity b2g is
+   port(  bin  : in  std_logic_vector (4 downto 0);
+          gray : out std_logic_vector (4 downto 0)
+        );
+end b2g ;
+
+architecture rtl of b2g is
+  constant N : integer := bin'high;
+begin
+  gray <= bin(n) & ( bin(N-1 downto 0) xor bin(N downto 1));
+end architecture rtl;

Task/Gray-code/VHDL/gray-code-2.vhdl

@@ -0,0 +1,17 @@
+LIBRARY ieee;
+USE ieee.std_logic_1164.all;
+
+entity g2b is
+   port(  gray : in     std_logic_vector (4 downto 0);
+          bin  : buffer std_logic_vector (4 downto 0)
+        );
+end g2b ;
+
+architecture rtl of g2b is
+  constant N : integer := bin'high;
+begin
+  bin(N) <= gray(N);
+  gen_xor: for i in N-1 downto 0 generate
+    bin(i) <= gray(i) xor bin(i+1);
+  end generate;
+end architecture rtl;

Task/Gray-code/XPL0/gray-code.xpl0

@@ -0,0 +1,36 @@
+include c:\cxpl\codes;          \intrinsic 'code' declarations
+
+func Gray2Bin(N);               \Convert N from Gray code to binary
+int N;
+int S;
+[S:= 1;
+repeat  N:= N>>S | N;
+        S:= S<<1;
+until   S=32;
+return N;
+]; \Gray2Bin
+
+
+func Bin2Gray(N);               \Convert N from binary to Gray code
+int N;
+return N>>1 | N;
+
+
+proc BinOut(N);                 \Output N in binary
+int N;
+int R;
+[R:= N&1;
+N:= N>>1;
+if N then BinOut(N);
+ChOut(0, R+^0);
+]; \BinOut
+
+
+int N, G;
+[for N:= 0 to 31 do
+        [BinOut(N); ChOut(0, 9\tab\);
+        G:= Bin2Gray(N);
+        BinOut(G);  ChOut(0, 9\tab\);
+        BinOut(Gray2Bin(G));  CrLf(0);
+        ];
+]