aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

16
Task/Binary-digits/00DESCRIPTION
View file

@ -1,7 +1,13 @@
The task is to output the sequence of binary digits for a given [[wp:Natural number|non-negative integer]].
;Task:
Create and display the sequence of binary digits for a given   [[wp:Natural number|non-negative integer]].
The decimal value <tt>5</tt>, should produce an output of <tt>101</tt>
The decimal value <tt>50</tt> should produce an output of <tt>110010</tt>
The decimal value <tt>9000</tt> should produce an output of <tt>10001100101000</tt>
The decimal value &nbsp; '''5''' &nbsp; should produce an output of &nbsp; '''101'''
The decimal value &nbsp; '''50''' &nbsp; should produce an output of &nbsp; '''110010'''
The decimal value &nbsp; '''9000''' &nbsp; should produce an output of &nbsp; '''10001100101000'''
The results can be achieved using builtin radix functions within the language, if these are available, or alternatively a user defined function can be used. The output produced should consist just of the binary digits of each number followed by a newline. There should be no other whitespace, radix or sign markers in the produced output, and [[wp:Leading zero|leading zeros]] should not appear in the results.
The results can be achieved using built-in radix functions within the language &nbsp; (if these are available), &nbsp; or alternatively a user defined function can be used.
The output produced should consist just of the binary digits of each number followed by a &nbsp; ''newline''.
There should be no other whitespace, radix or sign markers in the produced output, and [[wp:Leading zero|leading zeros]] should not appear in the results.
<br><br>

80
Task/Binary-digits/AppleScript/binary-digits.applescript Normal file
View file

@ -0,0 +1,80 @@
-- 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

10
Task/Binary-digits/Applesoft-BASIC/binary-digits.applesoft Normal file
View file

@ -0,0 +1,10 @@
0 N = 5: GOSUB 1:N = 50: GOSUB 1:N = 9000: GOSUB 1: END
1 LET N2 = ABS ( INT (N))
2 LET B$ = ""
3 FOR N1 = N2 TO 0 STEP 0
4 LET N2 = INT (N1 / 2)
5 LET B$ = STR$ (N1 - N2 * 2) + B$
6 LET N1 = N2
7 NEXT N1
8 PRINT B$
9 RETURN

27
Task/Binary-digits/C/binary-digits.c Normal file
View file

@ -0,0 +1,27 @@
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>
char *bin(uint32_t x);
int main(void)
{
for (size_t i = 0; i < 20; i++) {
char *binstr = bin(i);
printf("%s\n", binstr);
free(binstr);
}
}
char *bin(uint32_t x)
{
size_t bits = (x == 0) ? 1 : log10((double) x)/log10(2) + 1;
char *ret = malloc((bits + 1) * sizeof (char));
for (size_t i = 0; i < bits ; i++) {
ret[bits - i - 1] = (x & 1) ? '1' : '0';
x >>= 1;
}
ret[bits] = '\0';
return ret;
}

4
Task/Binary-digits/Common-Lisp/binary-digits.lisp
View file

@ -1 +1,5 @@
(format t "~b" 5)
; or
(write 5 :base 2)

6
Task/Binary-digits/Component-Pascal/binary-digits.component
View file

@ -5,11 +5,11 @@ PROCEDURE Do*;
VAR
str : ARRAY 33 OF CHAR;
BEGIN
Strings.IntToStringForm(5,2,32,'0',FALSE,str);
Strings.IntToStringForm(5,2, 1,'0',FALSE,str);
StdLog.Int(5);StdLog.String(":> " + str);StdLog.Ln;
Strings.IntToStringForm(50,2,32,'0',FALSE,str);
Strings.IntToStringForm(50,2, 1,'0',FALSE,str);
StdLog.Int(50);StdLog.String(":> " + str);StdLog.Ln;
Strings.IntToStringForm(9000,2,32,'0',FALSE,str);
Strings.IntToStringForm(9000,2, 1,'0',FALSE,str);
StdLog.Int(9000);StdLog.String(":> " + str);StdLog.Ln;
END Do;
END BinaryDigits.

58
Task/Binary-digits/Delphi/binary-digits.delphi
View file

@ -1,35 +1,7 @@
{$IFDEF FPC}
{$MODE DELPHI}
{$OPTIMIZATION ON,Regvar,ASMCSE,CSE,PEEPHOLE}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
program BinaryDigit;
{$APPTYPE CONSOLE}
uses
sysutils; //only for timing
function IntToBinStrNew(AInt : LongWord):string;
const
IO : array[0..1] of char = ('.','X');
var
idx,m : LongWord;
pC : pChar;
begin
IF AInt = 0 then Begin
result := IO[0];EXIT;end;
// search for the first set bit
idx:= 32;m := 1 shl (idx-1);
While ORD((AInt AND m) = 0)+ORD(m>0) = 2 do begin
dec(idx);m := m shr 1;end;
//set right length and insert one by one
setlength(result,idx);
pC := @result[1];
repeat
pC^ := IO[ORD((AInt and m) <> 0)];
m := m shr 1;
inc(pC);
until m=0;
end;
sysutils;
function IntToBinStr(AInt : LongWord) : string;
begin
@ -40,26 +12,8 @@ begin
until (AInt = 0);
end;
procedure Binary_Digits;
begin
writeln(' 5: ',IntToBinStr(5));
writeln(' 5: ',IntToBinStrNew(5));
writeln(' 50: ',IntToBinStr(50));
writeln(' 50: ',IntToBinStrNew(50));
writeln('9000: '+IntToBinStr(9000));
writeln('9000: '+IntToBinStrNew(9000));
end;
var
i: LongInt;
t :TDateTime;
Begin
Binary_Digits;
//speed test
t := time;
For i := 1 to 10*1000*1000 do
IntToBinStrNew(i);t := time-t; Writeln(' New ',t*86400.0:6:3);
t := time;
For i := 1 to 10*1000*1000 do
IntToBinStr(i);t := time-t; Writeln(' Old ',t*86400.0:6:3);
writeln(' 5: ',IntToBinStr(5));
writeln(' 50: ',IntToBinStr(50));
writeln('9000: '+IntToBinStr(9000));
end.

2
Task/Binary-digits/Elixir/binary-digits-3.elixir
View file

@ -1 +1 @@
[5,50,9000] |> Enum.map(fn n -> IO.puts Integer.to_string(n,2) end)
[5,50,9000] |> Enum.each(fn n -> IO.puts Integer.to_string(n,2) end)

2
Task/Binary-digits/Frink/binary-digits.frink
View file

@ -1,4 +1,4 @@
9000 -> binary
9000 -> base2
base2[9000]
base[9000. 2]
base[9000, 2]

8
Task/Binary-digits/Haskell/binary-digits.hs
View file

@ -6,11 +6,11 @@ import Text.Printf
toBin n = showIntAtBase 2 ("01" !!) n ""
-- Implement our own version.
toBin' 0 = []
toBin' x = (toBin' $ x `div` 2) ++ (show $ x `mod` 2)
toBin1 0 = []
toBin1 x = (toBin1 $ x `div` 2) ++ (show $ x `mod` 2)
printToBin n = putStrLn $ printf "%4d %14s %14s" n (toBin n) (toBin' n)
printToBin n = putStrLn $ printf "%4d %14s %14s" n (toBin n) (toBin1 n)
main = do
putStrLn $ printf "%4s %14s %14s" "N" "toBin" "toBin'"
putStrLn $ printf "%4s %14s %14s" "N" "toBin" "toBin1"
mapM_ printToBin [5, 50, 9000]

13
Task/Binary-digits/Lua/binary-digits.lua
View file

@ -1,11 +1,10 @@
function dec2bin (n)
local bin, number, bit = "", tonumber(n) -- can pass n as string
while number > 0 do
bit = number % 2
number = math.floor(number/2)
bin = bit .. bin
end
return bin
local bin = ""
while n > 0 do
bin = n % 2 .. bin
n = math.floor(n / 2)
end
return bin
end
print(dec2bin(5))

88
Task/Binary-digits/Oberon-2/binary-digits.oberon-2
View file

@ -1,85 +1,17 @@
MODULE BinaryDigits;
IMPORT
Object,
SYSTEM,
Out;
IMPORT Out;
PROCEDURE Reverse(VAR str: ARRAY OF CHAR);
VAR
s,e: LONGINT;
c: CHAR;
PROCEDURE OutBin(x: INTEGER);
BEGIN
e := LEN(str) - 1;
WHILE (e >= 0) & (str[e] = 0X) DO DEC(e) END;
s := 0;
WHILE (s < e) DO
c := str[s];
str[s] := str[e];
str[e] := c;
INC(s);DEC(e)
END
END Reverse;
IF x > 1 THEN OutBin(x DIV 2) END;
Out.Int(x MOD 2, 1);
END OutBin;
PROCEDURE IntToOct*(x: LONGINT):STRING;
VAR
i: LONGINT;
o: ARRAY 12 OF CHAR;
BEGIN
o[LEN(o) - 1] := 0X;
i := 0;
WHILE (i < LEN(o) - 1) DO
o[i] := CHR(ORD('0') + (x MOD 8));
INC(i);x := SYSTEM.LSH(x,-3)
END;
Reverse(o);
RETURN Object.NewLatin1(o)
END IntToOct;
PROCEDURE IntToHex*(x: LONGINT):STRING;
VAR
i: LONGINT;
h: ARRAY 9 OF CHAR;
hexDigit: LONGINT;
BEGIN
h[LEN(h) - 1] := 0X;
i := 0;
WHILE (i < LEN(h) - 1) DO
hexDigit := x MOD 16;
IF (hexDigit >= 0) & (hexDigit <= 9) THEN
h[i] := CHR(ORD('0') + hexDigit);
ELSE
h[i] := CHR(ORD('A') + (hexDigit - 10));
END;
INC(i);x := SYSTEM.LSH(x,-4)
END;
Reverse(h);
RETURN Object.NewLatin1(h)
END IntToHex;
PROCEDURE IntToBin*(x: LONGINT):STRING;
VAR
i: LONGINT;
b: ARRAY 33 OF CHAR;
BEGIN
b[LEN(b) - 1] := 0X;
i := 0;
WHILE (i < LEN(b) - 1) DO
b[i] := CHR(ORD('0') + (x MOD 2));
INC(i);x := SYSTEM.LSH(x,-1)
END;
Reverse(b);
RETURN Object.NewLatin1(b);
END IntToBin;
BEGIN
Out.Object("12 :> " + IntToBin(12));Out.Ln;
Out.Object("-12 :> " + IntToBin(-12));Out.Ln;
Out.Object("MAX(LONGINT) :> " + IntToBin(MAX(LONGINT)));Out.Ln;
Out.Object("MIN(LONGINT) :> " + IntToBin(MIN(LONGINT)));Out.Ln;
OutBin(0); Out.Ln;
OutBin(1); Out.Ln;
OutBin(2); Out.Ln;
OutBin(3); Out.Ln;
OutBin(42); Out.Ln;
END BinaryDigits.

29
Task/Binary-digits/Pascal/binary-digits-1.pascal Normal file
View file

@ -0,0 +1,29 @@
program IntToBinTest;
{$MODE objFPC}
uses
strutils;//IntToBin
function WholeIntToBin(n: NativeUInt):string;
var
digits: NativeInt;
begin
// BSR?Word -> index of highest set bit but 0 -> 255 ==-1 )
IF n <> 0 then
Begin
{$ifdef CPU64}
digits:= BSRQWord(NativeInt(n))+1;
{$ELSE}
digits:= BSRDWord(NativeInt(n))+1;
{$ENDIF}
WholeIntToBin := IntToBin(NativeInt(n),digits);
end
else
WholeIntToBin:='0';
end;
procedure IntBinTest(n: NativeUint);
Begin
writeln(n:12,' ',WholeIntToBin(n));
end;
BEGIN
IntBinTest(5);IntBinTest(50);IntBinTest(5000);
IntBinTest(0);IntBinTest(NativeUint(-1));
end.

106
Task/Binary-digits/Pascal/binary-digits-2.pascal Normal file
View file

@ -0,0 +1,106 @@
program IntToPcharTest;
uses
sysutils;//for timing
const
{$ifdef CPU64}
cBitcnt = 64;
{$ELSE}
cBitcnt = 32;
{$ENDIF}
procedure IntToBinPchar(AInt : NativeUInt;s:pChar);
//create the Bin-String
//!Beware of endianess ! this is for little endian
const
IO : array[0..1] of char = ('0','1');//('_','X'); as you like
IO4 : array[0..15] of LongWord = // '0000','1000' as LongWord
($30303030,$31303030,$30313030,$31313030,
$30303130,$31303130,$30313130,$31313130,
$30303031,$31303031,$30313031,$31313031,
$30303131,$31303131,$30313131,$31313131);
var
i : NativeInt;
begin
IF AInt > 0 then
Begin
// Get the index of highest set bit
{$ifdef CPU64}
i := BSRQWord(NativeInt(Aint))+1;
{$ELSE}
i := BSRDWord(NativeInt(Aint))+1;
{$ENDIF}
s[i] := #0;
//get 4 characters at once
dec(i);
while i >= 3 do
Begin
pLongInt(@s[i-3])^ := IO4[Aint AND 15];
Aint := Aint SHR 4;
dec(i,4)
end;
//the rest one by one
while i >= 0 do
Begin
s[i] := IO[Aint AND 1];
AInt := Aint shr 1;
dec(i);
end;
end
else
Begin
s[0] := IO[0];
s[1] := #0;
end;
end;
procedure Binary_Digits;
var
s: pCHar;
begin
GetMem(s,cBitcnt+4);
fillchar(s[0],cBitcnt+4,#0);
IntToBinPchar( 5,s);writeln(' 5: ',s);
IntToBinPchar( 50,s);writeln(' 50: ',s);
IntToBinPchar(9000,s);writeln('9000: ',s);
IntToBinPchar(NativeUInt(-1),s);writeln(' -1: ',s);
FreeMem(s);
end;
const
rounds = 10*1000*1000;
var
s: pChar;
t :TDateTime;
i,l,cnt: NativeInt;
Testfield : array[0..rounds-1] of NativeUint;
Begin
randomize;
cnt := 0;
For i := rounds downto 1 do
Begin
l := random(High(NativeInt));
Testfield[i] := l;
{$ifdef CPU64}
inc(cnt,BSRQWord(l));
{$ELSE}
inc(cnt,BSRQWord(l));
{$ENDIF}
end;
Binary_Digits;
GetMem(s,cBitcnt+4);
fillchar(s[0],cBitcnt+4,#0);
//warm up
For i := 0 to rounds-1 do
IntToBinPchar(Testfield[i],s);
//speed test
t := time;
For i := 1 to rounds do
IntToBinPchar(Testfield[i],s);
t := time-t;
Write(' Time ',t*86400.0:6:3,' secs, average stringlength ');
Writeln(cnt/rounds+1:6:3);
FreeMem(s);
end.

23
Task/Binary-digits/REXX/binary-digits-1.rexx
View file

@ -1,12 +1,11 @@
/*REXX program demonstrates converting decimal ───► binary. */
numeric digits 1000
x.=
x.1 = 0
x.2 = 5
x.3 = 50
x.4 = 9000
do j=1 while x.j\=='' /*compute until a NULL is found.*/
y = x2b(d2x(x.j)) + 0 /*force removal of leading zeroes*/
say right(x.j,20) 'decimal, and in binary:' y
end /*j*/
/*stick a fork in it, we're done.*/
/*REXX program to convert several decimal numbers to binary (or base 2). */
numeric digits 1000 /*ensure we can handle larger numbers. */
@.=; @.1= 0
@.2= 5
@.3= 50
@.4= 9000
do j=1 while @.j\=='' /*compute until a NULL value is found.*/
y=x2b( d2x(@.j) ) + 0 /*force removal of extra leading zeroes*/
say right(@.j,20) 'decimal, and in binary:' y /*display the number to the terminal. */
end /*j*/ /*stick a fork in it, we're all done. */

23
Task/Binary-digits/REXX/binary-digits-2.rexx
View file

@ -1,12 +1,11 @@
/*REXX program demonstrates converting decimal ───► binary. */
x.=
x.1 = 0
x.2 = 5
x.3 = 50
x.4 = 9000
do j=1 while x.j\=='' /*compute until a NULL is found.*/
y = strip( x2b( d2x( x.j )), 'L', 0)
if y=='' then y=0 /*handle special case of 0 (zero)*/
say right(x.j,20) 'decimal, and in binary:' y
end /*j*/
/*stick a fork in it, we're done.*/
/*REXX program to convert several decimal numbers to binary (or base 2). */
@.=; @.1= 0
@.2= 5
@.3= 50
@.4= 9000
do j=1 while @.j\=='' /*compute until a NULL value is found.*/
y=strip( x2b( d2x( @.j )), 'L', 0) /*force removal of all leading zeroes.*/
if y=='' then y=0 /*handle the special case of 0 (zero).*/
say right(@.j,20) 'decimal, and in binary:' y /*display the number to the terminal. */
end /*j*/ /*stick a fork in it, we're all done. */

21
Task/Binary-digits/REXX/binary-digits-3.rexx
View file

@ -1,11 +1,10 @@
/*REXX program demonstrates converting decimal ───► binary. */
x.=
x.1=0
x.2=5
x.3=50
x.4=9000
do j=1 while x.j\=='' /*compute until a NULL is found.*/
y = word( strip( x2b( d2x( x.j )), 'L', 0) 0, 1)
say right(x.j,20) 'decimal, and in binary:' y
end /*j*/
/*stick a fork in it, we're done.*/
/*REXX program to convert several decimal numbers to binary (or base 2). */
@.=; @.1= 0
@.2= 5
@.3= 50
@.4= 9000
do j=1 while @.j\=='' /*compute until a NULL value is found.*/
y=word( strip( x2b( d2x( @.j )), 'L', 0) 0, 1) /*elides all leading 0s, if null, use 0*/
say right(@.j,20) 'decimal, and in binary:' y /*display the number to the terminal. */
end /*j*/ /*stick a fork in it, we're all done. */

28
Task/Binary-digits/REXX/binary-digits-4.rexx
View file

@ -1,16 +1,14 @@
/*REXX program demonstrates converting decimal ───► binary. */
numeric digits 200
x.=
x.1=0
x.2=5
x.3=50
x.4=9000
x.5=423785674235000123456789
x.6=1e138 /*one quinquaquadragintillion. */
/*REXX program to convert several decimal numbers to binary (or base 2). */
numeric digits 200 /*ensure we can handle larger numbers. */
@.=; @.1= 0
@.2= 5
@.3= 50
@.4= 9000
@.5=423785674235000123456789
@.6= 1e138 /*one quinquaquadragintillion ugh.*/
do j=1 while x.j\=='' /*compute until a NULL is found.*/
y = strip( x2b( d2x( x.j )), 'L', 0)
if y=='' then y=0 /*handle special case of 0 (zero)*/
say y
end /*j*/
/*stick a fork in it, we're done.*/
do j=1 while @.j\=='' /*compute until a NULL value is found.*/
y=strip( x2b( d2x( @.j )), 'L', 0) /*force removal of all leading zeroes.*/
if y=='' then y=0 /*handle the special case of 0 (zero).*/
say right(@.j,20) 'decimal, and in binary:' y /*display the number to the terminal. */
end /*j*/ /*stick a fork in it, we're all done. */

5
Task/Binary-digits/RapidQ/binary-digits.rapidq Normal file
View file

@ -0,0 +1,5 @@
'Convert Integer to binary string
Print "bin 5 = ", bin$(5)
Print "bin 50 = ",bin$(50)
Print "bin 9000 = ",bin$(9000)
sleep 10

21
Task/Binary-digits/S-lang/binary-digits.slang Normal file
View file

@ -0,0 +1,21 @@
define int_to_bin(d)
{
variable m = 0x40000000, prn = 0, bs = "";
do {
if (d & m) {
bs += "1";
prn = 1;
}
else if (prn)
bs += "0";
m = m shr 1;
} while (m);
if (bs == "") bs = "0";
return bs;
}
() = printf("%s\n", int_to_bin(5));
() = printf("%s\n", int_to_bin(50));
() = printf("%s\n", int_to_bin(9000));