with Ada.Text_IO, Ada.Numerics.Generic_Elementary_Functions;

procedure Benford is

   subtype Nonzero_Digit is Natural range 1 .. 9;
   function First_Digit(S: String) return Nonzero_Digit is
      (if S(S'First) in '1' .. '9'
         then Nonzero_Digit'Value(S(S'First .. S'First))
         else First_Digit(S(S'First+1 .. S'Last)));

   package N_IO is new Ada.Text_IO.Integer_IO(Natural);

   procedure Print(D: Nonzero_Digit; Counted, Sum: Natural) is
      package Math is new Ada.Numerics.Generic_Elementary_Functions(Float);
      package F_IO is new Ada.Text_IO.Float_IO(Float);
      Actual: constant Float := Float(Counted) / Float(Sum);
      Expected: constant Float := Math.Log(1.0 + 1.0 / Float(D), Base => 10.0);
      Deviation: constant Float := abs(Expected-Actual);
   begin
      N_IO.Put(D, 5);
      N_IO.Put(Counted, 14);
      F_IO.Put(Float(Sum)*Expected, Fore => 16, Aft => 1, Exp => 0);
      F_IO.Put(100.0*Actual, Fore => 9, Aft => 2, Exp => 0);
      F_IO.Put(100.0*Expected, Fore => 11, Aft => 2, Exp => 0);
      F_IO.Put(100.0*Deviation, Fore => 13, Aft => 2, Exp => 0);
   end Print;

   Cnt: array(Nonzero_Digit) of Natural := (1 .. 9 => 0);
   D: Nonzero_Digit;
   Sum: Natural := 0;
   Counter: Positive;

begin
   while not Ada.Text_IO.End_Of_File loop
      -- each line in the input file holds Counter, followed by Fib(Counter)
      N_IO.Get(Counter);
        -- Counter and skip it, we just don't need it
      D := First_Digit(Ada.Text_IO.Get_Line);
        -- read the rest of the line and extract the first digit
      Cnt(D) := Cnt(D)+1;
      Sum := Sum + 1;
   end loop;
   Ada.Text_IO.Put_Line(" Digit  Found[total]   Expected[total]    Found[%]"
                                          & "   Expected[%]   Difference[%]");
   for I in Nonzero_Digit loop
      Print(I, Cnt(I), Sum);
      Ada.Text_IO.New_Line;
   end loop;
end Benford;


}:r:|~    Read numbers in a loop.
  }:b:    Treat the queue as a stack and
    <:2:= accumulate the binary digits
    /=>&~ of the given number.
  ^:b:
  <:0:->  Enqueue negative 1 as a sentinel.
  {       Dequeue the first binary digit.
  }:p:
    ~%={+ Rotate each binary digit into place and print it.
  ^:p:
  <:a:~$  Output a newline.
^:r:


BEGIN
    # set the number of digits for LONG LONG INT values #
    PR precision 256 PR
    # returns the probability of the first digit of each non-zero number in s #
    PROC digit probability = ( []LONG LONG INT s )[]REAL:
         BEGIN
            [ 1 : 9 ]REAL result;
            # count the number of times each digit is the first #
            [ 1 : 9 ]INT  count := ( 0, 0, 0, 0, 0, 0, 0, 0, 0 );
            FOR i FROM LWB s TO UPB s DO
                LONG LONG INT v := ABS s[ i ];
                IF v /= 0 THEN
                    WHILE v > 9 DO v OVERAB 10 OD;
                    count[ SHORTEN SHORTEN v ] +:= 1
                FI
            OD;
            # calculate the probability of each digit #
            INT number of elements = ( UPB s + 1 ) - LWB s;
            FOR i TO 9 DO
                result[ i ] := IF number of elements = 0 THEN 0 ELSE count[ i ] / number of elements FI
            OD;
            result
         END # digit probability # ;
    # outputs the digit probabilities of some numbers and those expected by Benford's law #
    PROC compare to benford = ( []REAL actual )VOID:
         FOR i TO 9 DO
            print( ( "Benford: ", fixed( log( 1 + ( 1 / i ) ), -7, 3 ), " actual: ", fixed( actual[ i ], -7, 3 ), newline ) )
         OD # compare to benford # ;
    # generate 1000 fibonacci numbers #
    [ 0 : 1000 ]LONG LONG INT fn;
    fn[ 0 ] := 0;
    fn[ 1 ] := 1;
    FOR i FROM 2 TO UPB fn DO fn[ i ] := fn[ i - 1 ] + fn[ i - 2 ] OD;
    # get the probabilities of each first digit of the fibonacci numbers and #
    # compare to the probabilities expected by Benford's law #
    compare to benford( digit probability( fn ) )
END


*        Binary digits             27/08/2015
BINARY   CSECT
         USING  BINARY,R12
         LR     R12,R15            set base register
BEGIN    LA     R10,4
         LA     R9,N
LOOPN    MVC    W,0(R9)
         MVI    FLAG,X'00'
         LA     R8,32
         LA     R2,CBIN
LOOP     TM     W,B'10000000'      test fist bit
         BZ     ZERO               zero
         MVI    FLAG,X'01'         one written
         MVI    0(R2),C'1'         write 1
         B      CONT
ZERO     CLI    FLAG,X'01'         is one written ?
         BNE    BLANK
         MVI    0(R2),C'0'         write 0
         B      CONT
BLANK    BCTR   R2,0               backspace
CONT     L      R3,W
         SLL    R3,1               shilf left
         ST     R3,W
         LA     R2,1(R2)           next bit
         BCT    R8,LOOP            loop on bits
PRINT    CLI    FLAG,X'00'         is '0'
         BNE    NOTZERO
         MVI    0(R2),C'0'         then write 0
NOTZERO  L      R1,0(R9)
         XDECO  R1,CDEC
         XPRNT  CDEC,45
         LA     R9,4(R9)
         BCT    R10,LOOPN          loop on numbers
RETURN   XR     R15,R15            set return code
         BR     R14                return to caller
N        DC     F'0',F'5',F'50',F'9000'
W        DS     F                  work
FLAG     DS     X                  flag for trailing blanks
CDEC     DS     CL12               decimal value
         DC     C' '
CBIN     DC     CL32' '            binary value
         YREGS
         END    BINARY


SetBatchLines, -1
fib := NStepSequence(1, 1, 2, 1000)
Out := "Digit`tExpected`tObserved`tDeviation`n"
n := []
for k, v in fib
	d := SubStr(v, 1, 1)
	, n[d] := n[d] ? n[d] + 1 : 1
for k, v in n
	Exppected := 100 * Log(1+ (1 / k))
	, Observed := (v / fib.MaxIndex()) * 100
	, Out .= k "`t" Exppected "`t" Observed "`t" Abs(Exppected - Observed) "`n"
MsgBox, % Out

NStepSequence(v1, v2, n, k) {
	a := [v1, v2]
	Loop, % k - 2 {
		a[j := A_Index + 2] := 0
		Loop, % j < n + 2 ? j - 1 : n
			a[j] := BigAdd(a[j - A_Index], a[j])
	}
	return, a
}

BigAdd(a, b) {
	if (StrLen(b) > StrLen(a))
		t := a, a := b, b := t
	LenA := StrLen(a) + 1, LenB := StrLen(B) + 1, Carry := 0
	Loop, % LenB - 1
		Sum := SubStr(a, LenA - A_Index, 1) + SubStr(B, LenB - A_Index, 1) + Carry
		, Carry := Sum // 10
		, Result := Mod(Sum, 10) . Result
	Loop, % I := LenA - LenB {
		if (!Carry) {
			Result := SubStr(a, 1, I) . Result
			break
		}
		Sum := SubStr(a, I, 1) + Carry
		, Carry := Sum // 10
		, Result := Mod(Sum, 10) . Result
		, I--
	}
	return, (Carry ? Carry : "") . Result
}


bdos:	equ	5h		; CP/M system call
puts:	equ	9h		; Print string
	org	100h
	lxi	h,5		; Print value for 5
	call	prbin
	lxi	h,50		; Print value for 50
	call	prbin
	lxi	h,9000		; Print value for 9000
prbin:	call	bindgt		; Make binary representation of HL
	mvi	c,puts		; Print it
	jmp	bdos
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;;;	Return the binary representation of the 16-bit number in HL
	;;;	as a string starting at [DE].
bindgt:	lxi	d,binend	; End of binary string
	ana	a		; Clear carry flag
binlp:	dcx	d		; Previous digit
	mov	a,h		; Shift HL left, LSB into carry flag
	rar
	mov	h,a
	mov	a,l
	rar
	mov	l,a
	mvi	a,'0'		; Digit '0' or '1' depending on
	aci	0		; status of carry flag.
	stax	d
	mov	a,h		; Is HL 0 now?
	ora	l
	rz			; Then stop
	jmp	binlp		; Otherwise, do next bit
binstr:	db	'0000000000000000'	; Placeholder for string
binend:	db	13,10,'$'		; end with \r\n


# syntax: GAWK -f BENFORDS_LAW.AWK
BEGIN {
    n = 1000
    for (i=1; i<=n; i++) {
      arr[substr(fibonacci(i),1,1)]++
    }
    print("digit expected observed deviation")
    for (i=1; i<=9; i++) {
      expected  = log10(i+1) - log10(i)
      actual    = arr[i] / n
      deviation = expected - actual
      printf("%5d %8.4f %8.4f %9.4f\n",i,expected*100,actual*100,abs(deviation*100))
    }
    exit(0)
}
function fibonacci(n,  a,b,c,i) {
    a = 0
    b = 1
    for (i=1; i<=n; i++) {
      c = a + b
      a = b
      b = c
    }
    return(c)
}
function abs(x) { if (x >= 0) { return x } else { return -x } }
function log10(x) { return log(x)/log(10) }


GET "libhdr"

MANIFEST {
    fib_sz = 1_000_000_000 // keep 9 significant digits for computing F(n)
}

LET msd(n) = VALOF {
    UNTIL n < 10 DO
        n /:= 10
    RESULTIS n
}

LET fibonacci(n, tally) BE {
    LET a, b, c, e = 0, 1, ?, 0
    FOR i = 1 TO n {
        TEST e = 0
        THEN tally[msd(b)] +:= 1
        ELSE tally[b / (fib_sz / 10)] +:= 1
        c := a + b
        IF c > fib_sz {
            a := a / 10 - (a MOD 10 >= 5) // subtract, since condition evalutes to
            b := b / 10 - (b MOD 10 >= 5) // eithr 0 or -1.
            c := a + b
            e +:= 1 // keep track of exponent, just 'cuz
        }
        a, b := b, c
    }
}

LET start() = VALOF {
    // expected value of benford: log10(d + 1/d)
    LET expected = TABLE 0, 301, 176, 125, 97, 79, 67, 58, 51, 46
    LET actual = VEC 9
    FOR i = 0 TO 9 DO actual!i := 0
    fibonacci(1000, actual)
    writes("*nLeading digital distribution of the first 1,000 Fibonacci numbers*n")
    writes("Digit*tActual*tExpected*n")
    FOR i = 1 TO 9
        writef("%i *t%0.3d *t%0.3d *n", i, actual!i, expected!i)
    RESULTIS 0
}


        .model small
        .stack 1024
        .data

TestData0 byte 5,255			;255 is the terminator
TestData1 byte 5,0,255
TestData2 byte 9,0,0,0,255

	.code

start:

	mov ax,@data
	mov ds,ax

	cld				;String functions are set to auto-increment

	mov ax,2			;clear screen by setting video mode to 0
	int 10h				;select text mode - We're already in it, so this clears the screen

	mov si,offset TestData0
	call PrintBinary_NoLeadingZeroes

	mov si,offset TestData1
	call PrintBinary_NoLeadingZeroes

	mov si,offset TestData2
	call PrintBinary_NoLeadingZeroes

ExitDOS:
	mov ax,4C00h		;return to dos
	int 21h

PrintBinary_NoLeadingZeroes proc
;input: DS:SI = seg:offset of a 255-terminated sequence of unpacked BCD digits, stored big-endian
	;setup
	mov bx,8000h
	;bl will be our "can we print zeroes yet" flag.
	;bh is the "revolving bit mask" - we'll compare each bit to it, then rotate it right once.
        ;     It's very handy because it's a self-resetting loop counter as well!

NextDigit:
	lodsb
	cmp al,255
	je Terminated
NextBit:
	test al,bh		;is the bit we're testing right now set?
	jz PrintZero
	;else, print one
	push ax
		mov dl,'1'	;31h
		mov ah,2
		int 21h		;prints the ascii code in DL
	pop ax
	or bl,1			;set "we've printed a one" flag
	jmp predicate

PrintZero:
	test bl,bl
	jz predicate
	push ax
		mov dl,'0'	;30h
		mov ah,2
		int 21h
	pop ax

predicate:
	ror bh,1
	jnc NextBit
	;if the carry is set, we've rotated BH back to 10000000b,
	;	so move on to the next digit in that case.
	jmp NextDigit

Terminated:
	push ax
		mov ah,2
		mov dl,13		;carriage return
		int 21h
		mov dl,10		;linefeed
		int 21h
	pop ax
	ret
PrintBinary_NoLeadingZeroes endp


#include <stdio.h>
#include <stdlib.h>
#include <math.h>

float *benford_distribution(void)
{
    static float prob[9];
    for (int i = 1; i < 10; i++)
        prob[i - 1] = log10f(1 + 1.0 / i);

    return prob;
}

float *get_actual_distribution(char *fn)
{
    FILE *input = fopen(fn, "r");
    if (!input)
    {
        perror("Can't open file");
        exit(EXIT_FAILURE);
    }

    int tally[9] = { 0 };
    char c;
    int total = 0;
    while ((c = getc(input)) != EOF)
    {
        /* get the first nonzero digit on the current line */
        while (c < '1' || c > '9')
            c = getc(input);

        tally[c - '1']++;
        total++;

        /* discard rest of line */
        while ((c = getc(input)) != '\n' && c != EOF)
            ;
    }
    fclose(input);

    static float freq[9];
    for (int i = 0; i < 9; i++)
        freq[i] = tally[i] / (float) total;

    return freq;
}

int main(int argc, char **argv)
{
    if (argc != 2)
    {
        printf("Usage: benford <file>\n");
        return EXIT_FAILURE;
    }

    float *actual = get_actual_distribution(argv[1]);
    float *expected = benford_distribution();

    puts("digit\tactual\texpected");
    for (int i = 0; i < 9; i++)
        printf("%d\t%.3f\t%.3f\n", i + 1, actual[i], expected[i]);

    return EXIT_SUCCESS;
}


F count(w1, wnew)
   R sum(zip(w1, wnew).map((c1, c2) -> Int(c1 == c2)))

F best_shuffle(w)
   V wnew = Array(w)
   V n = w.len
   V rangei = Array(0 .< n)
   V rangej = Array(0 .< n)
   random:shuffle(&rangei)
   random:shuffle(&rangej)
   L(i) rangei
      L(j) rangej
         I i != j & wnew[j] != wnew[i] & w[i] != wnew[j] & w[j] != wnew[i]
            swap(&wnew[j], &wnew[i])
            L.break
   V wnew_s = wnew.join(‘’)
   R (wnew_s, count(w, wnew_s))

V test_words = [‘tree’, ‘abracadabra’, ‘seesaw’, ‘elk’, ‘grrrrrr’, ‘up’, ‘a’,
                ‘antidisestablishmentarianism’, ‘hounddogs’,
                ‘aardvarks are ant eaters’, ‘immediately’, ‘abba’]
L(w) test_words
   V (wnew, c) = best_shuffle(w)
   print(‘#29, #<29 ,(#.)’.format(w, wnew, c))


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program binarydigit.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

/*******************************************/
/* Initialized data                        */
/*******************************************/
.data
sMessAffBindeb:  .asciz "The decimal value  "
sMessAffBin:     .asciz " should produce an output of "
szRetourLigne:   .asciz "\n"

/*******************************************/
/* Uninitialized data                       */
/*******************************************/
.bss
sZoneConv:                   .skip 100
sZoneBin:                    .skip 100
/*******************************************/
/*  code section                           */
/*******************************************/
.text
.global main
main:                /* entry of program  */
    mov x5,5
    mov x0,x5
    ldr x1,qAdrsZoneConv
    bl conversion10S
    mov x0,x5
    ldr x1,qAdrsZoneBin
    bl conversion2      // binary conversion and display résult
    ldr x0,qAdrsZoneBin
    ldr x0,qAdrsMessAffBindeb
    bl affichageMess
    ldr x0,qAdrsZoneConv
    bl affichageMess
    ldr x0,qAdrsMessAffBin
    bl affichageMess
    ldr x0,qAdrsZoneBin
    bl affichageMess
    ldr x0,qAdrszRetourLigne
    bl affichageMess
    /* other number */
    mov x5,50
    mov x0,x5
    ldr x1,qAdrsZoneConv
    bl conversion10S
    mov x0,x5
    ldr x1,qAdrsZoneBin
    bl conversion2      // binary conversion and display résult
    ldr x0,qAdrsZoneBin
    ldr x0,qAdrsMessAffBindeb
    bl affichageMess
    ldr x0,qAdrsZoneConv
    bl affichageMess
    ldr x0,qAdrsMessAffBin
    bl affichageMess
    ldr x0,qAdrsZoneBin
    bl affichageMess
    ldr x0,qAdrszRetourLigne
    bl affichageMess
    /* other number */
    mov x5,-1
    mov x0,x5
    ldr x1,qAdrsZoneConv
    bl conversion10S
    mov x0,x5
    ldr x1,qAdrsZoneBin
    bl conversion2      // binary conversion and display résult
    ldr x0,qAdrsZoneBin
    ldr x0,qAdrsMessAffBindeb
    bl affichageMess
    ldr x0,qAdrsZoneConv
    bl affichageMess
    ldr x0,qAdrsMessAffBin
    bl affichageMess
    ldr x0,qAdrsZoneBin
    bl affichageMess
    ldr x0,qAdrszRetourLigne
    bl affichageMess
    /* other number */
    mov x5,1
    mov x0,x5
    ldr x1,qAdrsZoneConv
    bl conversion10S
    mov x0,x5
    ldr x1,qAdrsZoneBin
    bl conversion2      // binary conversion and display résult
    ldr x0,qAdrsZoneBin
    ldr x0,qAdrsMessAffBindeb
    bl affichageMess
    ldr x0,qAdrsZoneConv
    bl affichageMess
    ldr x0,qAdrsMessAffBin
    bl affichageMess
    ldr x0,qAdrsZoneBin
    bl affichageMess
    ldr x0,qAdrszRetourLigne
    bl affichageMess

100:                            // standard end of the program */
    mov x0, #0                  // return code
    mov x8, #EXIT               // request to exit program
    svc 0                       // perform the system call
qAdrsZoneConv:         .quad sZoneConv
qAdrsZoneBin:           .quad sZoneBin
qAdrsMessAffBin:       .quad sMessAffBin
qAdrsMessAffBindeb:    .quad sMessAffBindeb
qAdrszRetourLigne:     .quad szRetourLigne
/******************************************************************/
/*     register conversion in binary                              */
/******************************************************************/
/* x0 contains the register */
/* x1 contains the address of receipt area */
conversion2:
    stp x2,lr,[sp,-16]!        // save  registers
    stp x3,x4,[sp,-16]!        // save  registers
    clz x2,x0                  // number of left zeros bits
    mov x3,64
    sub x2,x3,x2               // number of significant bits
    strb wzr,[x1,x2]           // store 0 final
    sub x3,x2,1                // position counter of the written character
2:                             // loop
    tst x0,1                   // test first bit
    lsr x0,x0,#1               // shift right one bit
    bne 3f
    mov x4,#48                 // bit = 0 => character '0'
    b 4f
3:
    mov x4,#49                 //   bit = 1   => character '1'
4:
    strb w4,[x1,x3]            // character in reception area at position counter
    sub x3,x3,#1
    subs x2,x2,#1              //  0 bits ?
    bgt 2b                     // no!  loop

100:
    ldp x3,x4,[sp],16          // restaur  2 registres
    ldp x2,lr,[sp],16          // restaur  2 registres
    ret                        // retour adresse lr x30
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


//to cope with the big numbers , I used the Class Library for Numbers( CLN )
//if used prepackaged you can compile writing "g++ -std=c++11 -lcln yourprogram.cpp -o yourprogram"
#include <cln/integer.h>
#include <cln/integer_io.h>
#include <iostream>
#include <algorithm>
#include <vector>
#include <iomanip>
#include <sstream>
#include <string>
#include <cstdlib>
#include <cmath>
#include <map>
using namespace cln ;

class NextNum {
public :
   NextNum ( cl_I & a , cl_I & b ) : first( a ) , second ( b ) { }
   cl_I operator( )( ) {
      cl_I result = first + second ;
      first = second ;
      second = result ;
      return result ;
   }
private :
   cl_I first ;
   cl_I second ;
} ;

void findFrequencies( const std::vector<cl_I> & fibos , std::map<int , int> &numberfrequencies  ) {
   for ( cl_I bignumber : fibos ) {
      std::ostringstream os ;
      fprintdecimal ( os , bignumber ) ;//from header file cln/integer_io.h
      int firstdigit = std::atoi( os.str( ).substr( 0 , 1 ).c_str( )) ;
      auto result = numberfrequencies.insert( std::make_pair( firstdigit , 1 ) ) ;
      if ( ! result.second )
	 numberfrequencies[ firstdigit ]++ ;
   }
}

int main( ) {
   std::vector<cl_I> fibonaccis( 1000 ) ;
   fibonaccis[ 0 ] = 0 ;
   fibonaccis[ 1 ] = 1 ;
   cl_I a = 0 ;
   cl_I b = 1 ;
   //since a and b are passed as references to the generator's constructor
   //they are constantly changed !
   std::generate_n( fibonaccis.begin( ) + 2 , 998 , NextNum( a , b ) ) ;
   std::cout << std::endl ;
   std::map<int , int> frequencies ;
   findFrequencies( fibonaccis , frequencies ) ;
   std::cout << "                found                    expected\n" ;
   for ( int i = 1 ; i < 10 ; i++ ) {
      double found = static_cast<double>( frequencies[ i ] ) / 1000 ;
      double expected = std::log10( 1 + 1 / static_cast<double>( i )) ;
      std::cout << i << " :" << std::setw( 16 ) << std::right << found * 100 << " %" ;
      std::cout.precision( 3 ) ;
      std::cout << std::setw( 26 ) << std::right << expected * 100 << " %\n" ;
   }
   return 0 ;
}


PROC BestShuffle(CHAR ARRAY orig,res)
  BYTE i,j,len
  CHAR tmp

  len=orig(0)
  SCopy(res,orig)
  FOR i=1 TO len
  DO
    FOR j=1 TO len
    DO
      IF i#j AND orig(i)#res(j) AND orig(j)#res(i) THEN
        tmp=res(i) res(i)=res(j) res(j)=tmp
      FI
    OD
  OD
RETURN

PROC Test(CHAR ARRAY orig)
  CHAR ARRAY res(100)
  BYTE i,score

  BestShuffle(orig,res)
  score=0
  FOR i=1 TO orig(0)
  DO
    IF orig(i)=res(i) THEN
      score==+1
    FI
  OD
  PrintF("%S, %S, (%B)%E",orig,res,score)
RETURN

PROC Main()
  Test("abracadabra")
  Test("seesaw")
  Test("elk")
  Test("grrrrrr")
  Test("up")
  Test("a")
RETURN


with Ada.Text_IO;
with Ada.Strings.Unbounded;

procedure Best_Shuffle is

   function Best_Shuffle (S : String) return String;

   function Best_Shuffle (S : String) return String is
      T : String (S'Range) := S;
      Tmp : Character;
   begin
      for I in S'Range loop
         for J in S'Range loop
            if I /= J and S (I) /= T (J) and S (J) /= T (I) then
               Tmp  := T (I);
               T (I) := T (J);
               T (J) := Tmp;
            end if;
         end loop;
      end loop;
      return T;
   end Best_Shuffle;

   Test_Cases : constant array (1 .. 6)
     of Ada.Strings.Unbounded.Unbounded_String :=
                  (Ada.Strings.Unbounded.To_Unbounded_String ("abracadabra"),
                   Ada.Strings.Unbounded.To_Unbounded_String ("seesaw"),
                   Ada.Strings.Unbounded.To_Unbounded_String ("elk"),
                   Ada.Strings.Unbounded.To_Unbounded_String ("grrrrrr"),
                   Ada.Strings.Unbounded.To_Unbounded_String ("up"),
                   Ada.Strings.Unbounded.To_Unbounded_String ("a"));

begin -- main procedure
   for Test_Case in Test_Cases'Range loop
      declare
         Original : constant String := Ada.Strings.Unbounded.To_String
           (Test_Cases (Test_Case));
         Shuffle  : constant String := Best_Shuffle (Original);
         Score : Natural := 0;
      begin
         for I in Original'Range loop
            if Original (I) = Shuffle (I) then
               Score := Score + 1;
            end if;
         end loop;
         Ada.Text_IO.Put_Line (Original & ", " & Shuffle & ", (" &
                                Natural'Image (Score) & " )");
      end;
   end loop;
end Best_Shuffle;


(include-book "arithmetic-3/top" :dir :system)

(defun bin-string-r (x)
   (if (zp x)
       ""
       (string-append
        (bin-string-r (floor x 2))
        (if (= 1 (mod x 2))
            "1"
            "0"))))

(defun bin-string (x)
   (if (zp x)
       "0"
       (bin-string-r x)))


PROC PrintBinary(CARD v)
  CHAR ARRAY a(16)
  BYTE i=[0]

  DO
    a(i)=(v&1)+'0
    i==+1
    v=v RSH 1
  UNTIL v=0
  OD

  DO
    i==-1
    Put(a(i))
  UNTIL i=0
  OD
RETURN

PROC Main()
  CARD ARRAY data=[0 5 50 9000]
  BYTE i
  CARD v

  FOR i=0 TO 3
  DO
    v=data(i)
    PrintF("Output for %I is ",v)
    PrintBinary(v)
    PutE()
  OD
RETURN


(ns example
  (:gen-class))

(defn abs [x]
  (if (> x 0)
    x
    (- x)))

(defn calc-benford-stats [digits]
  " Frequencies of digits in data "
  (let [y (frequencies digits)
         tot (reduce + (vals y))]
    [y tot]))

(defn show-benford-stats [v]
  " Prints in percent the actual, Benford expected, and difference"
  (let [fd (map (comp first str) v)]        ; first digit of each record
    (doseq [q (range 1 10)
            :let [[y tot] (calc-benford-stats fd)
                  d (first (str q))         ; reference digit
                  f (/ (get y d 0) tot 0.01)  ; percent of occurence of digit
                  p (* (Math/log10 (/ (inc q) q)) 100)  ; Benford expected percent
                  e (abs (- f p))]]                     ; error (difference)
      (println (format "%3d %10.2f %10.2f %10.2f"
                       q
                       f
                       p
                       e)))))

; Generate fibonacci results
(def fib (lazy-cat [0N 1N] (map + fib (rest fib))))

;(def fib-digits (map (comp first str) (take 10000 fib)))
(def fib-digits (take 10000 fib))
(def header "         found-%    expected-%  diff")

(println "Fibonacci Results")
(println header)
(show-benford-stats fib-digits)
;
; Universal Constants from Physics (using first column of data)
(println "Universal Constants from Physics")
(println header)
(let [
      data-parser (fn [s]
                  (let [x (re-find #"\s{10}-?[0|/\.]*([1-9])" s)]
                    (if (not (nil? x))    ; Skips records without number
                      (second x)
                      x)))

      input (slurp "http://physics.nist.gov/cuu/Constants/Table/allascii.txt")

      y (for [line (line-seq (java.io.BufferedReader.
                               (java.io.StringReader. input)))]
          (data-parser line))
      z (filter identity y)]
  (show-benford-stats z))

; Sunspots
(println "Sunspots average count per month since 1749")
(println header)
(let [
      data-parser (fn [s]
                  (nth (re-find #"(.+?\s){3}([1-9])" s) 2))

      ; Sunspot data loaded from file (saved from ;https://solarscience.msfc.nasa.gov/greenwch/SN_m_tot_V2.0.txt")
      ; (note: attempting to load directly from url causes https Trust issues, so saved to file after loading to Browser)
      input (slurp "SN_m_tot_V2.0.txt")
      y (for [line (line-seq (java.io.BufferedReader.
                               (java.io.StringReader. input)))]
          (data-parser line))]

  (show-benford-stats y))


BYTE FUNC FindIndex(BYTE b)
  IF b>='A AND b<='Z THEN
    RETURN (b-'A)
  ELSEIF b>='a AND b<='z THEN
    RETURN (b-'a+26)
  ELSEIF b>='0 AND b<='9 THEN
    RETURN (b-'0+52)
  ELSEIF b='+ THEN
    RETURN (62)
  ELSEIF b='/ THEN
    RETURN (63)
  FI
RETURN (-1)

PROC PrintChar(CHAR c)
  IF c=10 THEN
    PutE()
  ELSE
    Put(c)
  FI
RETURN

PROC Decode(CHAR ARRAY s)
  BYTE i,b1,b2,b3,b4,i1,i2,i3,i4
  CHAR c

  IF s(0) MOD 4#0 THEN
    PrintE("Invalid length of string!!!")
    Break()
  FI

  i=1
  WHILE i<=s(0)
  DO
    b1=s(i) i==+1
    b2=s(i) i==+1
    b3=s(i) i==+1
    b4=s(i) i==+1

    i1=FindIndex(b1)
    i2=FindIndex(b2)

    c=i1 LSH 2
    c==%i2 RSH 4
    PrintChar(c)

    IF b3#'= THEN
      i3=FindIndex(b3)
      c=(i2&$0F) LSH 4
      c==%i3 RSH 2
      PrintChar(c)

      IF b4#'= THEN
        i4=FindIndex(b4)
        c=(i3&$03) LSH 6
        c==%i4
        PrintChar(c)
      FI
    FI
  OD
RETURN

PROC Test(CHAR ARRAY s)
  PrintE("Encoded:")
  PrintE(s)
  PutE()
  PrintE("Decoded:")
  Decode(s)
  PutE()
RETURN

PROC Main()
  Test("VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLVBhdWwgUi5FaHJsaWNo")
RETURN


BEGIN # shuffle a string so as many as possible characters are moved #
    PROC best shuffle = ( STRING orig )STRING:
    BEGIN
        STRING res := orig;
        FOR i FROM LWB orig TO UPB orig DO
            FOR j FROM LWB orig TO UPB orig DO
                IF i /= j AND orig[ i ] /= res[ j ] AND orig[ j ] /= res[ i ] THEN
                    CHAR tmp = res[ i ]; res[ i ] := res[ j ]; res[ j ] := tmp
                FI
            OD
        OD;
        res
    END # best shuffle # ;
    PROC test = ( STRING orig )VOID:
    BEGIN
        STRING res   := best shuffle( orig );
        INT    score := 0;
        FOR i FROM LWB orig TO UPB orig DO
            IF orig[ i ] = res[ i ] THEN
                score +:= 1
            FI
        OD;
        print( ( orig, ", ", res, ", (", whole( score, 0 ), ")", newline ) )
    END # test # ;

    test( "abracadabra" );
    test( "seesaw"      );
    test( "elk"         );
    test( "grrrrrr"     );
    test( "up"          );
    test( "a"           )
END


with ada.text_io; use ada.text_io;
procedure binary is
  bit : array (0..1) of character := ('0','1');

  function bin_image (n : Natural) return string is
  (if n < 2 then (1 => bit (n)) else bin_image (n / 2) & bit (n mod 2));

  test_values : array (1..3) of Natural := (5,50,9000);
begin
  for test of test_values loop
	put_line ("Output for" & test'img & " is " & bin_image (test));
  end loop;
end binary;


fibgen = () ->
    a = 1; b = 0
    return () ->
        ([a, b] = [b, a+b])[1]

leading = (x) -> x.toString().charCodeAt(0) - 0x30

f = fibgen()

benford = (0 for i in [1..9])
benford[leading(f()) - 1] += 1 for i in [1..1000]

log10 = (x) -> Math.log(x) * Math.LOG10E

actual = benford.map (x) -> x * 0.001
expected = (log10(1 + 1/x) for x in [1..9])

console.log "Leading digital distribution of the first 1,000 Fibonacci numbers"
console.log "Digit\tActual\tExpected"
for i in [1..9]
    console.log i + "\t" + actual[i - 1].toFixed(3) + '\t' + expected[i - 1].toFixed(3)


(defun calculate-distribution (numbers)
  "Return the frequency distribution of the most significant nonzero
   digits in the given list of numbers. The first element of the list
   is the frequency for digit 1, the second for digit 2, and so on."

  (defun nonzero-digit-p (c)
    "Check whether the character is a nonzero digit"
    (and (digit-char-p c) (char/= c #\0)))

  (defun first-digit (n)
    "Return the most significant nonzero digit of the number or NIL if
     there is none."
    (let* ((s (write-to-string n))
           (c (find-if #'nonzero-digit-p s)))
      (when c
        (digit-char-p c))))

  (let ((tally (make-array 9 :element-type 'integer :initial-element 0)))
    (loop for n in numbers
          for digit = (first-digit n)
          when digit
          do (incf (aref tally (1- digit))))
    (loop with total = (length numbers)
          for digit-count across tally
          collect (/ digit-count total))))

(defun calculate-benford-distribution ()
  "Return the frequency distribution according to Benford's law.
   The first element of the list is the probability for digit 1, the second
   element the probability for digit 2, and so on."
  (loop for i from 1 to 9
        collect (log (1+ (/ i)) 10)))

(defun benford (numbers)
  "Print a table of the actual and expected distributions for the given
   list of numbers."
  (let ((actual-distribution (calculate-distribution numbers))
        (expected-distribution (calculate-benford-distribution)))
    (write-line "digit actual expected")
    (format T "~:{~3D~9,3F~8,3F~%~}"
            (map 'list #'list '(1 2 3 4 5 6 7 8 9)
                              actual-distribution
                              expected-distribution))))


with Ada.Text_IO;

with AWS.Translator;

procedure Decode_AWS is
   Input  : constant String :=
     "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVw" &
     "IHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=";
   Result : constant String := AWS.Translator.Base64_Decode (Input);
begin
   Ada.Text_IO.Put_Line (Input);
   Ada.Text_IO.New_Line;
   Ada.Text_IO.Put_Line (Result);
end Decode_AWS;


text: "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g="

print decode text


data$ = "AAABAAIAEBAAAAAAAABoBQAAJgAAACAgAAAAAAAAqAgAAI4FAAAoAAAAE.......QAAAAEAAAABAAAAAQAAAAEAAAABAAAAAQAAAAEAAAABAAAAAQAAAAE="
ico$ = B64DEC$(data$)
BSAVE ico$ TO "favicon.ico" SIZE LEN(ico$)


count: function [s1 s2][
    res: 0
    loop.with:'i s1 'c [
        if c = s2\[i] -> res: res + 1
    ]
    return res
]

shuff: function [str]->
    join shuffle split str

bestShuffle: function [s][
    shuffled: shuff s
    loop 0..dec size shuffled 'i [
        if shuffled\[i] <> s\[i] -> continue
        loop 0..dec size shuffled 'j [
            if all? @[
                shuffled\[i] <> shuffled\[j]
                shuffled\[i] <> s\[j]
                shuffled\[j] <> s\[i]
            ] [
                tmp: shuffled\[i]
                shuffled\[i]: shuffled\[j]
                shuffled\[j]: tmp
                break
            ]
        ]
    ]
    return shuffled
]

words: ["abracadabra" "seesaw" "grrrrrr" "pop"
        "up" "a" "antidisestablishmentarianism"]

loop words 'w [
    sf: bestShuffle w
    print [w "->" sf "| count:" count w sf]
]


#!/usr/local/bin/a68g --script #

printf((
  $g" => "2r3d l$, 5, BIN 5,
  $g" => "2r6d l$, 50, BIN 50,
  $g" => "2r14d l$, 9000, BIN 9000
));

# or coerce to an array of BOOL #
print((
  5, " => ", []BOOL(BIN 5)[bits width-3+1:], new line,
  50, " => ", []BOOL(BIN 50)[bits width-6+1:], new line,
  9000, " => ", []BOOL(BIN 9000)[bits width-14+1:], new line
))


begin
    procedure writebin(n);
    integer n;
    begin
        procedure inner(x);
        integer x;
        begin
            if x>1 then inner(x/2);
            writeon(if x-x/2*2=0 then "0" else "1");
        end;
        write(""); % start new line %
        inner(n);
    end;

    writebin(5);
    writebin(50);
    writebin(9000);
end


require "big"

EXPECTED = (1..9).map{ |d| Math.log10(1 + 1.0 / d) }

def fib(n)
  a, b = 0.to_big_i, 1.to_big_i
  (0...n).map { ret, a, b = a, b, a + b; ret }
end

# powers of 3 as a test sequence
def power_of_threes(n)
  (0...n).map { |k| 3.to_big_i ** k }
end

def heads(s)
  s.map { |a| a.to_s[0].to_i }
end

def show_dist(title, s)
  s = heads(s)
  c = Array.new(10, 0)
  s.each{ |x| c[x] += 1 }
  siz = s.size
  res = (1..9).map{ |d| c[d] / siz }
  puts "\n    %s Benfords deviation" % title
  res.zip(EXPECTED).each_with_index(1) do |(r, e), i|
    puts "%2d: %5.1f%%  %5.1f%%  %5.1f%%" % [i, r*100, e*100, (r - e).abs*100]
  end
end

def random(n)
  (0...n).map { |i| rand(1..n) }
end

show_dist("fibbed", fib(1000))
show_dist("threes", power_of_threes(1000))

# just to show that not all kind-of-random sets behave like that
show_dist("random", random(10000))


import std.stdio, std.range, std.math, std.conv, std.bigint;

double[2][9] benford(R)(R seq) if (isForwardRange!R && !isInfinite!R) {
    typeof(return) freqs = 0;
    uint seqLen = 0;
    foreach (d; seq)
        if (d != 0) {
            freqs[d.text[0] - '1'][1]++;
            seqLen++;
        }

    foreach (immutable i, ref p; freqs)
        p = [log10(1.0 + 1.0 / (i + 1)), p[1] / seqLen];
    return freqs;
}

void main() {
    auto fibs = recurrence!q{a[n - 1] + a[n - 2]}(1.BigInt, 1.BigInt);

    writefln("%9s %9s %9s", "Actual", "Expected", "Deviation");
    foreach (immutable i, immutable p; fibs.take(1000).benford)
        writefln("%d: %5.2f%% | %5.2f%% | %5.4f%%",
                 i+1, p[1] * 100, p[0] * 100, abs(p[1] - p[0]) * 100);
}


#include <stdio.h>
#include <stdlib.h>

typedef unsigned char ubyte;
const ubyte BASE64[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";

int findIndex(const ubyte val) {
    if ('A' <= val && val <= 'Z') {
        return val - 'A';
    }
    if ('a' <= val && val <= 'z') {
        return val - 'a' + 26;
    }
    if ('0' <= val && val <= '9') {
        return val - '0' + 52;
    }
    if (val == '+') {
        return 62;
    }
    if (val == '/') {
        return 63;
    }
    return -1;
}

int decode(const ubyte source[], ubyte sink[]) {
    const size_t length = strlen(source);
    const ubyte *it = source;
    const ubyte *end = source + length;
    int acc;

    if (length % 4 != 0) {
        return 1;
    }

    while (it != end) {
        const ubyte b1 = *it++;
        const ubyte b2 = *it++;
        const ubyte b3 = *it++;         // might be the first padding byte
        const ubyte b4 = *it++;         // might be the first or second padding byte

        const int i1 = findIndex(b1);
        const int i2 = findIndex(b2);

        acc = i1 << 2;                  // six bits came from the first byte
        acc |= i2 >> 4;                 // two bits came from the first byte
        *sink++ = acc;                  // output the first byte

        if (b3 != '=') {
            const int i3 = findIndex(b3);

            acc = (i2 & 0xF) << 4;      // four bits came from the second byte
            acc += i3 >> 2;             // four bits came from the second byte
            *sink++ = acc;              // output the second byte

            if (b4 != '=') {
                const int i4 = findIndex(b4);

                acc = (i3 & 0x3) << 6;  // two bits came from the third byte
                acc |= i4;              // six bits came from the third byte
                *sink++ = acc;          // output the third byte
            }
        }
    }

    *sink = '\0';   // add the sigil for end of string
    return 0;
}

int main() {
    ubyte data[] = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLVBhdWwgUi5FaHJsaWNo";
    ubyte decoded[1024];

    printf("%s\n\n", data);
    decode(data, decoded);
    printf("%s\n\n", decoded);

    return 0;
}


words := "abracadabra,seesaw,elk,grrrrrr,up,a"
Loop Parse, Words,`,
   out .= Score(A_LoopField, Shuffle(A_LoopField))
MsgBox % clipboard := out

Shuffle(String)
{
 Cord := String
 Length := StrLen(String)
 CharType := A_IsUnicode ? "UShort" : "UChar"

 Loop, Parse, String  ; For each old character in String...
 {
  Char1 := SubStr(Cord, A_Index, 1)
  If (Char1 <> A_LoopField)  ; If new character already differs,
   Continue                  ;  do nothing.

  Index1 := A_Index
  OldChar1 := A_LoopField
  Random, Index2, 1, Length  ; Starting at some random index,
  Loop, %Length%             ;  for each index...
  {
   If (Index1 <> Index2)     ; Swap requires two different indexes.
   {
    Char2 := SubStr(Cord, Index2, 1)
    OldChar2 := SubStr(String, Index2, 1)

    ; If after the swap, the two new characters would differ from
    ; the two old characters, then do the swap.
    If (Char1 <> OldChar2) and (Char2 <> OldChar1)
    {
     ; Swap Char1 and Char2 inside Cord.
     NumPut(Asc(Char1), Cord, (Index2 - 1) << !!A_IsUnicode, CharType)
     NumPut(Asc(Char2), Cord, (Index1 - 1) << !!A_IsUnicode, CharType)
     Break
   }
   }
   Index2 += 1           ; Get next index.
   If (Index2 > Length)  ; If after last index,
    Index2 := 1          ;  use first index.
  }
 }
 Return Cord
}
Score(a, b){
	r := 0
	Loop Parse, a
		If (A_LoopField = SubStr(b, A_Index, 1))
			r++
	return a ", " b ", (" r ")`n"
}


begin
    % prints an integer in binary - the number must be greater than zero     %
    procedure printBinaryDigits( integer value n ) ;
    begin
        if n not = 0 then begin
            printBinaryDigits( n div 2 );
            writeon( if n rem 2 = 1 then "1" else "0" )
        end
    end binaryDigits ;

    % prints an integer in binary - the number must not be negative          %
    procedure printBinary( integer value n ) ;
    begin
        if n = 0 then writeon( "0" )
                 else printBinaryDigits( n )
    end printBinary ;

    % test the printBinaryDigits procedure                                   %
    for i := 5, 50, 9000 do begin
        write();
        printBinary( i );
    end

end.


---------------------- BINARY STRING -----------------------

-- 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

--------------------------- 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 ---------------------

-- 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

-------------------- GENERICS 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


defmodule Benfords_law do
  def distribution(n), do: :math.log10( 1 + (1 / n) )

  def task(total \\ 1000) do
    IO.puts "Digit	Actual	Benfords expected"
    fib(total)
    |> Enum.group_by(fn i -> hd(to_char_list(i)) end)
    |> Enum.map(fn {key,list} -> {key - ?0, length(list)} end)
    |> Enum.sort
    |> Enum.each(fn {x,len} -> IO.puts "#{x}	#{len / total}	#{distribution(x)}" end)
  end

  defp fib(n) do                        # suppresses zero
    Stream.unfold({1,1}, fn {a,b} -> {a,{b,a+b}} end) |> Enum.take(n)
  end
end

Benfords_law.task


-module( benfords_law ).
-export( [actual_distribution/1, distribution/1, task/0] ).

actual_distribution( Ns ) -> lists:foldl( fun first_digit_count/2, dict:new(), Ns ).

distribution( N ) -> math:log10( 1 + (1 / N) ).

task() ->
	Total = 1000,
	Fibonaccis = fib( Total ),
	Actual_dict = actual_distribution( Fibonaccis ),
	Keys = lists:sort( dict:fetch_keys( Actual_dict) ),
	io:fwrite( "Digit	Actual	Benfords expected~n" ),
	[io:fwrite("~p	~p	~p~n", [X, dict:fetch(X, Actual_dict) / Total, distribution(X)]) || X <- Keys].

fib( N ) -> fib( N, 0, 1, [] ).
fib( 0, Current, _, Acc ) -> lists:reverse( [Current | Acc] );
fib( N, Current, Next, Acc ) -> fib( N-1, Next, Current+Next, [Current | Acc] ).

first_digit_count( 0, Dict ) -> Dict;
first_digit_count( N, Dict ) ->
	[Key | _] = erlang:integer_to_list( N ),
	dict:update_counter( Key - 48, 1, Dict ).


using System;
using System.Text;

namespace Base64DecodeData {
    class Program {
        static void Main(string[] args) {
            var data = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=";
            Console.WriteLine(data);
            Console.WriteLine();

            var decoded = Encoding.ASCII.GetString(Convert.FromBase64String(data));
            Console.WriteLine(decoded);
        }
    }
}


#include <algorithm>
#include <iostream>
#include <string>
#include <vector>

typedef unsigned char ubyte;
const auto BASE64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";

std::vector<ubyte> encode(const std::vector<ubyte>& source) {
    auto it = source.cbegin();
    auto end = source.cend();

    std::vector<ubyte> sink;
    while (it != end) {
        auto b1 = *it++;
        int acc;

        sink.push_back(BASE64[b1 >> 2]);            // first output (first six bits from b1)

        acc = (b1 & 0x3) << 4;                      // last two bits from b1
        if (it != end) {
            auto b2 = *it++;
            acc |= (b2 >> 4);                       // first four bits from b2

            sink.push_back(BASE64[acc]);            // second output

            acc = (b2 & 0xF) << 2;                  // last four bits from b2
            if (it != end) {
                auto b3 = *it++;
                acc |= (b3 >> 6);                   // first two bits from b3

                sink.push_back(BASE64[acc]);        // third output
                sink.push_back(BASE64[b3 & 0x3F]);  // fouth output (final six bits from b3)
            } else {
                sink.push_back(BASE64[acc]);        // third output
                sink.push_back('=');                // fourth output (1 byte padding)
            }
        } else {
            sink.push_back(BASE64[acc]);            // second output
            sink.push_back('=');                    // third output (first padding byte)
            sink.push_back('=');                    // fourth output (second padding byte)
        }
    }
    return sink;
}

int findIndex(ubyte val) {
    if ('A' <= val && val <= 'Z') {
        return val - 'A';
    }
    if ('a' <= val && val <= 'z') {
        return val - 'a' + 26;
    }
    if ('0' <= val && val <= '9') {
        return val - '0' + 52;
    }
    if ('+' == val) {
        return 62;
    }
    if ('/' == val) {
        return 63;
    }
    return -1;
}

std::vector<ubyte> decode(const std::vector<ubyte>& source) {
    if (source.size() % 4 != 0) {
        throw new std::runtime_error("Error in size to the decode method");
    }

    auto it = source.cbegin();
    auto end = source.cend();

    std::vector<ubyte> sink;
    while (it != end) {
        auto b1 = *it++;
        auto b2 = *it++;
        auto b3 = *it++; // might be first padding byte
        auto b4 = *it++; // might be first or second padding byte

        auto i1 = findIndex(b1);
        auto i2 = findIndex(b2);
        auto acc = i1 << 2;     // six bits came from the first byte
        acc |= i2 >> 4;         // two bits came from the first byte

        sink.push_back(acc);    // output the first byte

        if (b3 != '=') {
            auto i3 = findIndex(b3);

            acc = (i2 & 0xF) << 4;  // four bits came from the second byte
            acc |= i3 >> 2;         // four bits came from the second byte

            sink.push_back(acc);    // output the second byte

            if (b4 != '=') {
                auto i4 = findIndex(b4);

                acc = (i3 & 0x3) << 6;  // two bits came from the third byte
                acc |= i4;              // six bits came from the third byte

                sink.push_back(acc);    // output the third byte
            }
        }
    }
    return sink;
}

int main() {
    using namespace std;

    string data = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLVBhdWwgUi5FaHJsaWNo";
    vector<ubyte> datav{ begin(data), end(data) };
    cout << data << "\n\n" << decode(datav).data() << endl;

    return 0;
}


{
	scram = best_shuffle($0)
	print $0 " -> " scram " (" unchanged($0, scram) ")"
}

function best_shuffle(s,    c, i, j, len, r, t) {
	len = split(s, t, "")

	# Swap elements of t[] to get a best shuffle.
	for (i = 1; i <= len; i++) {
		for (j = 1; j <= len; j++) {
			# Swap t[i] and t[j] if they will not match
			# the original characters from s.
			if (i != j &&
			    t[i] != substr(s, j, 1) &&
			    substr(s, i, 1) != t[j]) {
				c = t[i]
				t[i] = t[j]
				t[j] = c
				break
			}
		}
	}

	# Join t[] into one string.
	r = ""
	for (i = 1; i <= len; i++)
		r = r t[i]
	return r
}

function unchanged(s1, s2,    count, len) {
	count = 0
	len = length(s1)
	for (i = 1; i <= len; i++) {
		if (substr(s1, i, 1) == substr(s2, i, 1))
			count++
	}
	return count
}


/* ARM assembly Raspberry PI  */
/*  program binarydigit.s   */

/* Constantes    */
.equ STDOUT, 1
.equ WRITE,  4
.equ EXIT,   1
/* Initialized data */
.data

sMessAffBin: .ascii "The decimal value  "
sZoneDec: .space 12,' '
             .ascii " should produce an output of "
sZoneBin: .space 36,' '
              .asciz "\n"

/*  code section */
.text
.global main
main:                /* entry of program  */
    push {fp,lr}    /* save des  2 registres */
    mov r0,#5
    ldr r1,iAdrsZoneDec
    bl conversion10S    @ decimal conversion
    bl conversion2      @ binary conversion and display résult
    mov r0,#50
    ldr r1,iAdrsZoneDec
    bl conversion10S
    bl conversion2
    mov r0,#-1
    ldr r1,iAdrsZoneDec
    bl conversion10S
    bl conversion2
    mov r0,#1
    ldr r1,iAdrsZoneDec
    bl conversion10S
    bl conversion2

100:   /* standard end of the program */
    mov r0, #0                  @ return code
    pop {fp,lr}                 @restaur 2 registers
    mov r7, #EXIT              @ request to exit program
    swi 0                       @ perform the system call
iAdrsZoneDec: .int sZoneDec
/******************************************************************/
/*     register conversion in binary                              */
/******************************************************************/
/* r0 contains the register */
conversion2:
    push {r0,lr}     /* save  registers */
    push {r1-r5} /* save others registers */
    ldr r1,iAdrsZoneBin   @ address reception area
    clz r2,r0    @ number of left zeros bits
    rsb r2,#32   @ number of significant bits
    mov r4,#' '  @ space
    add r3,r2,#1 @ position counter in reception area
1:
    strb r4,[r1,r3]   @ space in other location of reception area
    add r3,#1
    cmp r3,#32         @ end of area ?
    ble 1b            @ no! loop
    mov r3,r2    @ position counter of the written character
2:               @ loop
    lsrs r0,#1    @ shift right one bit with flags
    movcc r4,#48  @ carry clear  => character 0
    movcs r4,#49  @ carry set   => character 1
    strb r4,[r1,r3]  @ character in reception area at position counter
    sub r3,r3,#1     @
    subs r2,r2,#1   @  0 bits ?
    bgt 2b          @ no!  loop

    ldr r0,iAdrsZoneMessBin
    bl affichageMess

100:
    pop {r1-r5}  /* restaur others registers */
    pop {r0,lr}
    bx lr
iAdrsZoneBin: .int sZoneBin
iAdrsZoneMessBin: .int sMessAffBin

/******************************************************************/
/*     display text with size calculation                         */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
    push {fp,lr}    			/* save  registres */
    push {r0,r1,r2,r7}    		/* save others registres */
    mov r2,#0   				/* counter length */
1:      	/* loop length calculation */
    ldrb r1,[r0,r2]  			/* read octet start position + index */
    cmp r1,#0       			/* if 0 its over */
    addne r2,r2,#1   			/* else add 1 in the length */
    bne 1b          			/* and loop */
                                /* so here r2 contains the length of the message */
    mov r1,r0        			/* address message in r1 */
    mov r0,#STDOUT      		/* code to write to the standard output Linux */
    mov r7, #WRITE             /* code call system "write" */
    swi #0                      /* call systeme */
    pop {r0,r1,r2,r7}     		/* restaur others registres */
    pop {fp,lr}    				/* restaur des  2 registres */
    bx lr	        			/* return  */
/***************************************************/
/*   conversion registre en décimal   signé  */
/***************************************************/
/* r0 contient le registre   */
/* r1 contient l adresse de la zone de conversion */
conversion10S:
    push {fp,lr}    /* save des  2 registres frame et retour */
    push {r0-r5}   /* save autres registres  */
    mov r2,r1       /* debut zone stockage */
    mov r5,#'+'     /* par defaut le signe est + */
    cmp r0,#0       /* nombre négatif ? */
    movlt r5,#'-'     /* oui le signe est - */
    mvnlt r0,r0       /* et inversion en valeur positive */
    addlt r0,#1
    mov r4,#10   /* longueur de la zone */
1: /* debut de boucle de conversion */
    bl divisionpar10 /* division  */
    add r1,#48        /* ajout de 48 au reste pour conversion ascii */
    strb r1,[r2,r4]  /* stockage du byte en début de zone r5 + la position r4 */
    sub r4,r4,#1      /* position précedente */
    cmp r0,#0
    bne 1b	       /* boucle si quotient different de zéro */
    strb r5,[r2,r4]  /* stockage du signe à la position courante */
    subs r4,r4,#1   /* position précedente */
    blt  100f         /* si r4 < 0  fin  */
    /* sinon il faut completer le debut de la zone avec des blancs */
    mov r3,#' '   /* caractere espace */
2:
    strb r3,[r2,r4]  /* stockage du byte  */
    subs r4,r4,#1   /* position précedente */
    bge 2b        /* boucle si r4 plus grand ou egal a zero */
100:  /* fin standard de la fonction  */
    pop {r0-r5}   /*restaur des autres registres */
    pop {fp,lr}   /* restaur des  2 registres frame et retour  */
    bx lr

/***************************************************/
/*   division par 10   signé                       */
/* Thanks to http://thinkingeek.com/arm-assembler-raspberry-pi/*
/* and   http://www.hackersdelight.org/            */
/***************************************************/
/* r0 contient le dividende   */
/* r0 retourne le quotient */
/* r1 retourne le reste  */
divisionpar10:
  /* r0 contains the argument to be divided by 10 */
    push {r2-r4}   /* save others registers  */
    mov r4,r0
    ldr r3, .Ls_magic_number_10 /* r1 <- magic_number */
    smull r1, r2, r3, r0   /* r1 <- Lower32Bits(r1*r0). r2 <- Upper32Bits(r1*r0) */
    mov r2, r2, ASR #2     /* r2 <- r2 >> 2 */
    mov r1, r0, LSR #31    /* r1 <- r0 >> 31 */
    add r0, r2, r1         /* r0 <- r2 + r1 */
    add r2,r0,r0, lsl #2   /* r2 <- r0 * 5 */
    sub r1,r4,r2, lsl #1   /* r1 <- r4 - (r2 * 2)  = r4 - (r0 * 10) */
    pop {r2-r4}
    bx lr                  /* leave function */
    .align 4
.Ls_magic_number_10: .word 0x66666667


open System

let fibonacci = Seq.unfold (fun (x, y) -> Some(x, (y, x + y))) (0I,1I)
let fibFirstNumbers nth =
    fibonacci |> Seq.take nth |> Seq.map (fun n -> n.ToString().[0] |> string |> Int32.Parse)

let fibFirstNumbersFrequency nth =
    let firstNumbers = fibFirstNumbers nth |> Seq.toList
    let counts = firstNumbers |> List.countBy id |> List.sort |> List.filter (fun (k, _) -> k <> 0)
    let total = firstNumbers |> List.length |> float
    counts |> List.map (fun (_, v) -> float v/total)

let benfordLaw d = log10(1.0 + (1.0/float d))
let benfordLawFigures = [1..9] |> List.map benfordLaw

let run () =
    printfn "Frequency of the first digit (1 through 9) in the Fibonacci sequence:"
    fibFirstNumbersFrequency 1000 |> List.iter (fun f -> printf $"{f:N5} ")
    printfn "\nBenford's law for 1 through 9:"
    benfordLawFigures |> List.iter (fun f -> printf $"{f:N5} ")


USING: assocs compiler.tree.propagation.call-effect formatting
kernel math math.functions math.statistics math.text.utils
sequences ;
IN: rosetta-code.benfords-law

: expected ( n -- x ) recip 1 + log10 ;

: next-fib ( vec -- vec' )
    [ last2 ] keep [ + ] dip [ push ] keep ;

: data ( -- seq ) V{ 1 1 } clone 998 [ next-fib ] times ;

: 1st-digit ( n -- m ) 1 digit-groups last ;

: leading ( -- seq ) data [ 1st-digit ] map ;

: .header ( -- )
    "Digit" "Expected" "Actual" "%-10s%-10s%-10s\n" printf ;

: digit-report ( digit digit-count -- digit expected actual )
    dupd [ expected ] dip 1000 /f ;

: .digit-report ( digit digit-count -- )
    digit-report "%-10d%-10.4f%-10.4f\n" printf ;

: main ( -- )
    .header leading histogram [ .digit-report ] assoc-each ;

MAIN: main


USER>Write $System.Encryption.Base64Decode("VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=")
To err is human, but to really foul things up you need a computer.
                                                                      -- Paul R. Ehrlich


(defn decode [str]
  (String. (.decode (java.util.Base64/getDecoder) str)))

(decode "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=")


DECLARE case$[] = { "tree", "abracadabra", "seesaw", "elk", "grrrrrr", "up", "a" }

FOR z = 0 TO UBOUND(case$)-1

    result$ = EXPLODE$(case$[z], 1)
    FOR y = 1 TO AMOUNT(result$)
        FOR x = 1 TO LEN(case$[z])
            IF TOKEN$(result$, y) <> MID$(case$[z], x, 1) AND TOKEN$(result$, x) = MID$(case$[z], x, 1) THEN result$ = EXCHANGE$(result$, x, y)
        NEXT
    NEXT

    total = 0
    FOR x = 1 TO AMOUNT(result$)
        INCR total, IIF(MID$(case$[z], x, 1) = TOKEN$(result$, x), 1, 0)
    NEXT

    PRINT MERGE$(result$), ":", total
NEXT


      a$ = "abracadabra" : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
      a$ = "seesaw"      : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
      a$ = "elk"         : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
      a$ = "grrrrrr"     : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
      a$ = "up"          : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
      a$ = "a"           : b$ = FNshuffle(a$) : PRINT a$ " -> " b$ FNsame(a$,b$)
      END

      DEF FNshuffle(s$)
      LOCAL i%, j%, l%, s%, t%, t$
      t$ = s$ : s% = !^s$ : t% = !^t$ : l% = LEN(t$)
      FOR i% = 0 TO l%-1 : SWAP t%?i%,t%?(RND(l%)-1) : NEXT
      FOR i% = 0 TO l%-1
        FOR j% = 0 TO l%-1
          IF i%<>j% THEN
            IF t%?i%<>s%?j% IF s%?i%<>t%?j% THEN
              SWAP t%?i%,t%?j%
              EXIT FOR
            ENDIF
          ENDIF
        NEXT
      NEXT i%
      = t$

      DEF FNsame(s$, t$)
      LOCAL i%, n%
      FOR i% = 1 TO LEN(s$)
        IF MID$(s$,i%,1)=MID$(t$,i%,1) n% += 1
      NEXT
      = " (" + STR$(n%) + ")"


print as.binary 5
print as.binary 50
print as.binary 9000


MsgBox % NumberToBinary(5) ;101
MsgBox % NumberToBinary(50) ;110010
MsgBox % NumberToBinary(9000) ;10001100101000

NumberToBinary(InputNumber)
{
 While, InputNumber
  Result := (InputNumber & 1) . Result, InputNumber >>= 1
 Return, Result
}


: 3drop   drop 2drop ;
: f2drop  fdrop fdrop ;

: int-array  create cells allot  does> swap cells + ;

: 1st-fib   0e 1e ;
: next-fib  ftuck f+ ;

: 1st-digit ( fp -- n )
    pad 6 represent 3drop pad [email protected] [char] 0 - ;

10 int-array counts

: tally
    0 counts 10 cells erase
    1st-fib
    1000 0 DO
        1 fdup 1st-digit counts +!
        next-fib
    LOOP f2drop ;

: benford ( d -- fp )
    s>f 1/f 1e f+ flog ;

: tab  9 emit ;

: heading  ( -- )
    cr ." Leading digital distribution of the first 1,000 Fibonacci numbers:"
    cr ." Digit" tab ." Actual" tab ." Expected" ;

: .fixed ( n -- ) \ print count as decimal fraction
    s>d <# # # # [char] . hold #s #> type space ;

: report ( -- )
    precision  3 set-precision
    heading
    10 1 DO
        cr i 3 .r
        tab i counts @ .fixed
        tab i benford f.
    LOOP
    set-precision ;

: compute-benford  tally report ;


' version 27-10-2016
' compile with: fbc -s console

#Define max 1000    ' total number of Fibonacci numbers
#Define max_sieve  15485863  ' should give 1,000,000

#Include Once "gmp.bi"   ' uses the GMP libary

Dim As ZString Ptr z_str
Dim As ULong n, d
ReDim As ULong digit(1 To 9)
Dim As Double expect, found

Dim As mpz_ptr fib1, fib2
fib1 = Allocate(Len(__mpz_struct)) : Mpz_init_set_ui(fib1, 0)
fib2 = Allocate(Len(__mpz_struct)) : Mpz_init_set_ui(fib2, 1)

digit(1) = 1  ' fib2
For n = 2 To max
    Swap fib1, fib2                   ' fib1 = 1, fib2 = 0
    mpz_add(fib2, fib1, fib2)         ' fib1 = 1, fib2 = 1 (fib1 + fib2)
    z_str = mpz_get_str(0, 10, fib2)
    d = Val(Left(*z_str, 1))          ' strip the 1 digit on the left off
    digit(d) = digit(d) +1
Next

mpz_clear(fib1) : DeAllocate(fib1)
mpz_clear(fib2) : DeAllocate(fib2)

Print
Print "First 1000 Fibonacci numbers"
Print "nr:  total     found   expected  difference"

For d = 1 To 9
    n = digit(d)
    found = n / 10
    expect = (Log(1 + 1 / d) / Log(10)) * 100
    Print Using " ##  #####  ###.## %   ###.## %    ##.### %"; _
                            d; n ; found; expect; expect - found
Next

ReDim digit(1 To 9)
ReDim As UByte sieve(max_sieve)

'For d = 4 To max_sieve Step 2
'    sieve(d) = 1
'Next
Print : Print "start sieve"
For d = 3 To sqr(max_sieve)
    If sieve(d) = 0 Then
        For n = d * d To max_sieve Step d * 2
            sieve(n) = 1
        Next
    End If
Next

digit(2) = 1 ' 2

Print "start collecting first digits"
For n = 3 To max_sieve Step 2
    If sieve(n) = 0 Then
        d = Val(Left(Trim(Str(n)), 1))
        digit(d) = digit(d) +1
    End If
Next

Dim As ulong total
For n = 1 To 9
    total = total + digit(n)
Next

Print
Print "First";total; " primes"
Print "nr:     total     found   expected   difference"

For d = 1 To 9
    n = digit(d)
    found = n / total * 100
    expect = (Log(1 + 1 / d) / Log(10)) * 100
    Print Using " ##  ########  ###.## %   ###.## %    ###.### %"; _
                                d; n ; found; expect; expect - found
Next

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


require "base64"

encoded_string = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g="

decoded_string = Base64.decode_string(encoded_string)
puts decoded_string


import std.base64;
import std.stdio;

void main() {
    auto data = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=";
    writeln(data);
    writeln;

    auto decoded = cast(char[])Base64.decode(data);
    writeln(decoded);
}


import 'dart:convert';

void main() {
  var encoded = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=";
  var decoded = utf8.decode(base64.decode(encoded));
  print(decoded);
}


program Base64Decoder;

{$APPTYPE CONSOLE}

uses
  System.SysUtils, System.NetEncoding;

const
  Src = 'VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=';

begin
  WriteLn(Format('Source string: ' + sLineBreak + '"%s"', [Src]));
  WriteLn(Format('Decoded string: ' + sLineBreak + '"%s"', [TNetEncoding.Base64.Decode(Src)]));

end.


    ( shuffle
    =   m car cdr todo a z count string
      .     !arg:(@(?:%?car ?cdr).?todo)
          & !Count:?count
          & (   @( !todo
                 :   ?a
                     (%@:~!car:?m)
                     ( ?z
                     &   shuffle$(!cdr.str$(!a !z))
                       : (<!count:?count.?string)
                     & ~
                     )
                 )
              | !count:<!Count
              |   @(!todo:%?m ?z)
                & shuffle$(!cdr.!z):(?count.?string)
                & !count+1
            . !m !string
            )
        | (0.)
    )
  & abracadabra seesaw elk grrrrrr up a:?words
  &   whl
    ' ( !words:%?word ?words
      & @(!word:? [?Count)
      & out$(!word shuffle$(!word.!word))
      )
  & Done


#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <assert.h>
#include <limits.h>

#define DEBUG

void best_shuffle(const char* txt, char* result) {
    const size_t len = strlen(txt);
    if (len == 0)
        return;

#ifdef DEBUG
    // txt and result must have the same length
    assert(len == strlen(result));
#endif

    // how many of each character?
    size_t counts[UCHAR_MAX];
    memset(counts, '\0', UCHAR_MAX * sizeof(int));
    size_t fmax = 0;
    for (size_t i = 0; i < len; i++) {
        counts[(unsigned char)txt[i]]++;
        const size_t fnew = counts[(unsigned char)txt[i]];
        if (fmax < fnew)
             fmax = fnew;
    }
    assert(fmax > 0 && fmax <= len);

    // all character positions, grouped by character
    size_t *ndx1 = malloc(len * sizeof(size_t));
    if (ndx1 == NULL)
        exit(EXIT_FAILURE);
    for (size_t ch = 0, i = 0; ch < UCHAR_MAX; ch++)
       if (counts[ch])
            for (size_t j = 0; j < len; j++)
                if (ch == (unsigned char)txt[j]) {
                    ndx1[i] = j;
                    i++;
                }

    // regroup them for cycles
    size_t *ndx2 = malloc(len * sizeof(size_t));
    if (ndx2 == NULL)
        exit(EXIT_FAILURE);
    for (size_t i = 0, n = 0, m = 0; i < len; i++) {
        ndx2[i] = ndx1[n];
        n += fmax;
        if (n >= len) {
            m++;
            n = m;
        }
    }

    // how long can our cyclic groups be?
    const size_t grp = 1 + (len - 1) / fmax;
    assert(grp > 0 && grp <= len);

    // how many of them are full length?
    const size_t lng = 1 + (len - 1) % fmax;
    assert(lng > 0 && lng <= len);

    // rotate each group
    for (size_t i = 0, j = 0; i < fmax; i++) {
        const size_t first = ndx2[j];
        const size_t glen = grp - (i < lng ? 0 : 1);
        for (size_t k = 1; k < glen; k++)
            ndx1[j + k - 1] = ndx2[j + k];
        ndx1[j + glen - 1] = first;
        j += glen;
    }

    // result is original permuted according to our cyclic groups
    result[len] = '\0';
    for (size_t i = 0; i < len; i++)
        result[ndx2[i]] = txt[ndx1[i]];

    free(ndx1);
    free(ndx2);
}

void display(const char* txt1, const char* txt2) {
    const size_t len = strlen(txt1);
    assert(len == strlen(txt2));
    int score = 0;
    for (size_t i = 0; i < len; i++)
        if (txt1[i] == txt2[i])
            score++;
    (void)printf("%s, %s, (%u)\n", txt1, txt2, score);
}

int main() {
    const char* data[] = {"abracadabra", "seesaw", "elk", "grrrrrr",
                          "up", "a", "aabbbbaa", "", "xxxxx"};
    const size_t data_len = sizeof(data) / sizeof(data[0]);
    for (size_t i = 0; i < data_len; i++) {
        const size_t shuf_len = strlen(data[i]) + 1;
        char shuf[shuf_len];

#ifdef DEBUG
        memset(shuf, 0xFF, sizeof shuf);
        shuf[shuf_len - 1] = '\0';
#endif

        best_shuffle(data[i], shuf);
        display(data[i], shuf);
    }

    return EXIT_SUCCESS;
}


ConsoleWrite(IntToBin(50) & @CRLF)

Func IntToBin($iInt)
	$Stack = ObjCreate("System.Collections.Stack")
	Local $b = -1, $r = ""
	While $iInt <> 0
		$b = Mod($iInt, 2)
		$iInt = INT($iInt/2)
		$Stack.Push ($b)
	WEnd
	For $i = 1 TO $Stack.Count
		$r &= $Stack.Pop
	Next
	Return $r
EndFunc   ;==>IntToBin


BEGIN {
  print tobinary(5)
  print tobinary(50)
  print tobinary(9000)
}

function tobinary(num) {
  outstr = ""
  l = num
  while ( l ) {
    if ( l%2 == 0 ) {
      outstr = "0" outstr
    } else {
      outstr = "1" outstr
    }
    l = int(l/2)
  }
  # Make sure we output a zero for a value of zero
  if ( outstr == "" ) {
    outstr = "0"
  }
  return outstr
}


package main

import (
    "fmt"
    "math"
)

func Fib1000() []float64 {
    a, b, r := 0., 1., [1000]float64{}
    for i := range r {
        r[i], a, b = b, b, b+a
    }
    return r[:]
}

func main() {
    show(Fib1000(), "First 1000 Fibonacci numbers")
}

func show(c []float64, title string) {
    var f [9]int
    for _, v := range c {
        f[fmt.Sprintf("%g", v)[0]-'1']++
    }
    fmt.Println(title)
    fmt.Println("Digit  Observed  Predicted")
    for i, n := range f {
        fmt.Printf("  %d  %9.3f  %8.3f\n", i+1, float64(n)/float64(len(c)),
            math.Log10(1+1/float64(i+1)))
    }
}


USING: base64 io strings ;

"VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLVBhdWwgUi5FaHJsaWNo"
base64> >string print


variable bitsbuff

: char>6bits ( c -- u )
   dup 43 =          if drop 62   exit then    ( + case )
   dup 47 =          if drop 63   exit then    ( / case )
   dup 48 58 within  if 48 - 52 + exit then    ( 0-9 case )
   dup 65 91 within  if 65 -      exit then    ( A-Z case )
   dup 97 123 within if 97 - 26 + exit then    ( a-z case )
   drop 0                                      ( padding )
;
: 6bitsin ( v -- ) bitsbuff @ 6 lshift + bitsbuff ! ;
: 4charsin ( addr -- addr+4 )
   $0 bitsbuff !
   dup 4 + dup rot
   do I [email protected] char>6bits 6bitsin loop ;
: 3bytes, ( -- )
   bitsbuff @ 16 rshift $ff and c,
   bitsbuff @  8 rshift $ff and c,
   bitsbuff @           $ff and c, ;

: b64dec ( addr1 n1 -- addr2 n2 )
   here rot rot ( addr2 addr1 n1 )
   4 /          ( addr2 addr1 n1/4 )
   0 do
      4charsin 3bytes,
   loop                                   ( addr2 addr1+4x )
   ( get back for padding )
   1 - dup [email protected] 61 = if 1 else 0 then swap  ( addr2 0|1 addr1+4x-1 )
   1 -     [email protected] 61 = if 1 else 0 then +     ( addr2 0|1|2 )
   swap            ( 0|1|2 addr2 )
   dup here swap - ( 0|1|2 addr2 n' )
   rot -           ( addr2 n2 )
;


Dim Shared As String B64
B64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & _
"abcdefghijklmnopqrstuvwxyz" & _
"0123456789+/"

Function MIMEDecode(s As String ) As Integer
    If Len(s) Then
        MIMEdecode = Instr(B64,s) - 1
    Else
        MIMEdecode = -1
    End If
End Function

Function Decode64(s As String) As String
    Dim As Integer w1, w2, w3, w4
    Dim As String  mD
    For n As Integer = 1 To Len(s) Step 4
        w1 = MIMEdecode(Mid(s,n+0,1))
        w2 = MIMEdecode(Mid(s,n+1,1))
        w3 = MIMEdecode(Mid(s,n+2,1))
        w4 = MIMEdecode(Mid(s,n+3,1))
        If w2 >-1 Then mD+= Chr(((w1* 4 + Int(w2/16)) And 255))
        If w3 >-1 Then mD+= Chr(((w2*16 + Int(w3/ 4)) And 255))
        If w4 >-1 Then mD+= Chr(((w3*64 + w4        ) And 255))
    Next n
    Return mD
End Function

Dim As String msg64 = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVw" & _
"IHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g="
Print msg64
Print: Print(Decode64(msg64))
Sleep


package main

import (
    "encoding/base64"
    "fmt"
)

func main() {
    msg := "Rosetta Code Base64 decode data task"
    fmt.Println("Original :", msg)
    encoded := base64.StdEncoding.EncodeToString([]byte(msg))
    fmt.Println("\nEncoded  :", encoded)
    decoded, err := base64.StdEncoding.DecodeString(encoded)
    if err != nil {
        fmt.Println(err)
        return
    }
    fmt.Println("\nDecoded  :", string(decoded))
}


ShuffledString[] array = {"cat", "dog", "mouse"};


#include <iostream>
#include <sstream>
#include <algorithm>

using namespace std;

template <class S>
class BestShuffle {
public:
    BestShuffle() : rd(), g(rd()) {}

    S operator()(const S& s1) {
        S s2 = s1;
        shuffle(s2.begin(), s2.end(), g);
        for (unsigned i = 0; i < s2.length(); i++)
            if (s2[i] == s1[i])
                for (unsigned j = 0; j < s2.length(); j++)
                    if (s2[i] != s2[j] && s2[i] != s1[j] && s2[j] != s1[i]) {
                        swap(s2[i], s2[j]);
                        break;
                    }
        ostringstream os;
        os << s1 << endl << s2 << " [" << count(s2, s1) << ']';
        return os.str();
    }

private:
    static int count(const S& s1, const S& s2) {
        auto count = 0;
        for (unsigned i = 0; i < s1.length(); i++)
            if (s1[i] == s2[i])
                count++;
        return count;
    }

    random_device rd;
    mt19937 g;
};

int main(int argc, char* arguments[]) {
    BestShuffle<basic_string<char>> bs;
    for (auto i = 1; i < argc; i++)
        cout << bs(basic_string<char>(arguments[i])) << endl;
    return 0;
}


Lbl BIN
.Axe supports 16-bit integers, so 16 digits are enough
L₁+16→P
0→{P}
While r₁
 P--
 {(r₁ and 1)▶Hex+3}→P
 r₁/2→r₁
End
Disp P,i
Return


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


def tallyFirstDigits = { size, generator ->
    def population = (0..<size).collect { generator(it) }
    def firstDigits = [0]*10
    population.each { number ->
        firstDigits[(number as String)[0] as int] ++
    }
    firstDigits
}


import qualified Data.Map as M
import Data.Char (digitToInt)

fstdigit :: Integer -> Int
fstdigit = digitToInt . head . show

n = 1000 :: Int

fibs = 1 : 1 : zipWith (+) fibs (tail fibs)

fibdata = map fstdigit $ take n fibs

freqs = M.fromListWith (+) $ zip fibdata (repeat 1)

tab :: [(Int, Double, Double)]
tab =
  [ ( d
    , fromIntegral (M.findWithDefault 0 d freqs) / fromIntegral n
    , logBase 10.0 $ 1 + 1 / fromIntegral d)
  | d <- [1 .. 9] ]

main = print tab


import java.nio.charset.StandardCharsets

class Decode {
    static void main(String[] args) {
        String data = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g="
        Base64.Decoder decoder = Base64.getDecoder()
        byte[] decoded = decoder.decode(data)
        String decodedStr = new String(decoded, StandardCharsets.UTF_8)
        System.out.println(decodedStr)
    }
}


--Decodes Base64 to ASCII
import qualified Data.Map.Strict as Map (Map, lookup, fromList)
import Data.Maybe (fromJust, listToMaybe, mapMaybe)
import Numeric (readInt, showIntAtBase)
import Data.Char (chr, digitToInt)
import Data.List.Split (chunksOf)

byteToASCII :: String -> String
byteToASCII = map chr . decoder

--generates list of bytes (represented by Int)
decoder :: String -> [Int]
decoder =
  map readBin .
  takeWhile (\x -> length x == 8) .
  chunksOf 8 . concatMap toBin . mapMaybe (`Map.lookup` table) . filter (/= '=')

--turns decimal into a list of char that represents a binary number
toBin :: Int -> String
toBin n = leftPad $ showIntAtBase 2 ("01" !!) n ""

--this adds all the zeros to the left that showIntAtBase omitted
leftPad :: String -> String
leftPad a = replicate (6 - length a) '0' ++ a

--turns list of '0' and '1' into list of 0 and 1
readBin :: String -> Int
readBin = fromJust . fmap fst . listToMaybe . readInt 2 (`elem` "01") digitToInt

--lookup list for the sextets
table :: Map.Map Char Int
table =
  Map.fromList $
  zip "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" [0 ..]

main :: IO ()
main =
  putStrLn $
  byteToASCII
    "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCi0tIFBhdWwgUi4gRWhybGljaA=="


class Main {
  static function main() {
    var data = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVw" +
               "IHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=";
    Sys.println('$data\n');
    var decoded = haxe.crypto.Base64.decode(data);
    Sys.println(decoded);
  }
}


(defn score [before after]
   (->> (map = before after)
	(filter true? ,)
	count))

(defn merge-vecs [init vecs]
  (reduce (fn [counts [index x]]
		 (assoc counts x (conj (get counts x []) index)))
	  init vecs))

(defn frequency
  "Returns a collection of indecies of distinct items"
  [coll]
  (->> (map-indexed vector coll)
       (merge-vecs {} ,)))

(defn group-indecies [s]
  (->> (frequency s)
       vals
       (sort-by count ,)
       reverse))

(defn cycles [coll]
  (let [n (count (first coll))
	cycle (cycle (range n))
	coll (apply concat coll)]
    (->> (map vector coll cycle)
	 (merge-vecs [] ,))))

(defn rotate [n coll]
  (let [c (count coll)
	n (rem (+ c n) c)]
    (concat (drop n coll) (take n coll))))

(defn best-shuffle [s]
  (let [ref (cycles (group-indecies s))
	prm (apply concat (map (partial rotate 1) ref))
	ref (apply concat ref)]
    (->> (map vector ref prm)
	 (sort-by first ,)
	 (map second ,)
	 (map (partial get s) ,)
	 (apply str ,)
	 (#(vector s % (score s %))))))

user> (->> ["abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"]
	   (map best-shuffle ,)
	   vec)
[["abracadabra" "bdabararaac" 0]
 ["seesaw" "eawess" 0]
 ["elk" "lke" 0]
 ["grrrrrr" "rgrrrrr" 5]
 ["up" "pu" 0]
 ["a" "a" 1]]


 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


function to_binary () {
    if [ $1 -ge 0 ]
    then
        val=$1
        binary_digits=()

        while [ $val -gt 0 ]; do
            bit=$((val % 2))
            quotient=$((val / 2))
            binary_digits+=("${bit}")
            val=$quotient
        done
        echo "${binary_digits[*]}" | rev
    else
        echo ERROR : "negative number"
        exit 1
    fi
}

array=(5 50 9000)
for number in "${array[@]}"; do
    echo $number " :> " $(to_binary $number)
done


global counts, total

procedure main()

   counts := table(0)
   total := 0.0
   every benlaw(fib(1 to 1000))

   every i := 1 to 9 do
      write(i,": ",right(100*counts[string(i)]/total,9)," ",100*P(i))

end

procedure benlaw(n)
   if counts[n ? (tab(upto('123456789')),move(1))] +:= 1 then total +:= 1
end

procedure P(d)
   return log(1+1.0/d, 10)
end

procedure fib(n)        # From Fibonacci Sequence task
    return fibMat(n)[1]
end

procedure fibMat(n)
    if n <= 0 then return [0,0]
    if n  = 1 then return [1,0]
    fp := fibMat(n/2)
    c := fp[1]*fp[1] + fp[2]*fp[2]
    d := fp[1]*(fp[1]+2*fp[2])
    if n%2 = 1 then return [c+d, d]
    else return [d, c]
end


log10 =: 10&^.
benford =: [email protected]:(1+%)
assert '0.30 0.18 0.12 0.10 0.08 0.07 0.06 0.05 0.05' -: 5j2 ": benford >: i. 9

append_next_fib =: , +/@:(_2&{.)
assert 5 8 13 -: append_next_fib 5 8

leading_digits =: {[email protected]":&>
assert '581' -: leading_digits 5 8 13x

count =: #/.~ /: ~.
assert 2 1 3 4 -: count 'XCXBAXACXC'  NB. 2 A's, 1 B, 3 C's, and some X's.

normalize =: % +/
assert 1r3 2r3 -: normalize 1 2x

FIB =: append_next_fib ^: (1000-#) 1 1
LDF =: leading_digits FIB

TALLY_BY_KEY =: count LDF
assert 9 -: # TALLY_BY_KEY   NB. If all of [1-9] are present then we know what the digits are.

mean =: +/ % #
center=: - mean
mp =: $:~ :(+/ .*)
num =: mp&:center
den =: %:@:(*&:(+/@:(*:@:center)))
r =: num % den   NB. r is the LibreOffice correl function
assert '_0.982' -: 6j3 ": 1 2 3 r 6 5 3  NB. confirmed using LibreOffice correl function

assert '0.9999' -: 6j4 ": (normalize TALLY_BY_KEY) r benford >: i.9

assert '0.9999' -: 6j4 ": TALLY_BY_KEY r benford >: i.9  NB. Of course we don't need normalization


   require'convert/misc/base64'
   frombase64 'VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g='
To err is human, but to really foul things up you need a computer.
    -- Paul R. Ehrlich


import java.nio.charset.StandardCharsets;
import java.util.Base64;

public class Decode {
    public static void main(String[] args) {
        String data = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=";
        Base64.Decoder decoder = Base64.getDecoder();
        byte[] decoded = decoder.decode(data);
        String decodedStr = new String(decoded, StandardCharsets.UTF_8);
        System.out.println(decodedStr);
    }
}


// define base64 data; in this case the data is the string: "Hello, world!"
const base64 = 'SGVsbG8sIHdvcmxkIQ==';
// atob is a built-in function.
console.log(atob(base64));


/* Base64 decode, in Jsish */
var data = exec('jsish base64.jsi', {retAll:true}).data;  // or use File.read('stdin');
var icon = Util.base64(data, true);
File.write('rosetta-favicon.ico', icon);


(defun count-equal-chars (string1 string2)
  (loop for c1 across string1 and c2 across string2
        count (char= c1 c2)))

(defun shuffle (string)
  (let ((length (length string))
        (result (copy-seq string)))
    (dotimes (i length result)
      (dotimes (j length)
        (when (and (/= i j)
                   (char/= (aref string i) (aref result j))
                   (char/= (aref string j) (aref result i)))
          (rotatef (aref result i) (aref result j)))))))

(defun best-shuffle (list)
  (dolist (string list)
    (let ((shuffled (shuffle string)))
      (format t "~%~a ~a (~a)"
              string
              shuffled
              (count-equal-chars string shuffled)))))

(best-shuffle '("abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"))


@echo off
:num2bin    IntVal [RtnVar]
  setlocal enableDelayedExpansion
  set /a n=%~1
  set rtn=
  for /l %%b in (0,1,31) do (
    set /a "d=n&1, n>>=1"
    set rtn=!d!!rtn!
  )
  for /f "tokens=* delims=0" %%a in ("!rtn!") do set rtn=%%a
  (endlocal & rem -- return values
    if "%~2" neq "" (set %~2=%rtn%) else echo %rtn%
  )
exit /b


import java.math.BigInteger;
import java.util.Locale;

public class BenfordsLaw {

    private static BigInteger[] generateFibonacci(int n) {
        BigInteger[] fib = new BigInteger[n];
        fib[0] = BigInteger.ONE;
        fib[1] = BigInteger.ONE;
        for (int i = 2; i < fib.length; i++) {
            fib[i] = fib[i - 2].add(fib[i - 1]);
        }
        return fib;
    }

    public static void main(String[] args) {
        BigInteger[] numbers = generateFibonacci(1000);

        int[] firstDigits = new int[10];
        for (BigInteger number : numbers) {
            firstDigits[Integer.valueOf(number.toString().substring(0, 1))]++;
        }

        for (int i = 1; i < firstDigits.length; i++) {
            System.out.printf(Locale.ROOT, "%d %10.6f %10.6f%n",
                    i, (double) firstDigits[i] / numbers.length, Math.log10(1.0 + 1.0 / i));
        }
    }
}


const fibseries = n => [...Array(n)]
    .reduce(
        (fib, _, i) => i < 2 ? (
            fib
        ) : fib.concat(fib[i - 1] + fib[i - 2]),
        [1, 1]
    );

const benford = array => [1, 2, 3, 4, 5, 6, 7, 8, 9]
    .map(val => [val, array
        .reduce(
            (sum, item) => sum + (
                `${item}` [0] === `${val}`
            ),
            0
        ) / array.length, Math.log10(1 + 1 / val)
    ]);

console.log(benford(fibseries(1000)))


using Base64

io = IOBuffer()

iob64_decode = Base64DecodePipe(io)

write(io, "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLVBhdWwgUi5FaHJsaWNo")

seekstart(io)

println(String(read(iob64_decode)))


import java.util.Base64

fun main() {
    val data =
        "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g="
    val decoder = Base64.getDecoder()
    val decoded = decoder.decode(data)
    val decodedStr = String(decoded, Charsets.UTF_8)
    println(decodedStr)
}


-- Start taken from https://stackoverflow.com/a/35303321
local b='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/' -- You will need this for encoding/decoding

-- decoding
function dec(data)
    data = string.gsub(data, '[^'..b..'=]', '')
    return (data:gsub('.', function(x)
        if (x == '=') then return '' end
        local r,f='',(b:find(x)-1)
        for i=6,1,-1 do r=r..(f%2^i-f%2^(i-1)>0 and '1' or '0') end
        return r;
    end):gsub('%d%d%d?%d?%d?%d?%d?%d?', function(x)
        if (#x ~= 8) then return '' end
        local c=0
        for i=1,8 do c=c+(x:sub(i,i)=='1' and 2^(8-i) or 0) end
            return string.char(c)
    end))
end
-- end of copy

local data = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLVBhdWwgUi5FaHJsaWNo"
print(data)
print()

local decoded = dec(data)
print(decoded)


ImportString[
   "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLVBhdWwgUi5FaHJsaWNo",
   "Base64"
]


def best_shuffle(s)
  # Fill _pos_ with positions in the order
  # that we want to fill them.
  pos = [] of Int32
  # g["a"] = [2, 4] implies that s[2] == s[4] == "a"
  g = s.size.times.group_by { |i| s[i] }

  # k sorts letters from low to high count
  # k = g.sort_by { |k, v| v.length }.map { |k, v| k }        # in Ruby
  # k = g.to_a.sort_by { |(k, v)| v.size }.map { |(k, v)| k } # Crystal direct
  k = g.to_a.sort_by { |h| h[1].size }.map { |h| h[0] }       # Crystal shorter

  until g.empty?
    k.each do |letter|
      g.has_key?(letter) || next          # next unless g.has_key? letter
      pos << g[letter].pop
      g[letter].empty? && g.delete letter # g.delete(letter) if g[letter].empty?
    end
  end

  # Now fill in _new_ with _letters_ according to each position
  # in _pos_, but skip ahead in _letters_ if we can avoid
  # matching characters that way.
  letters = s.dup
  new = "?" * s.size

  until letters.empty?
    i, p = 0, pos.pop
    while letters[i] == s[p] && i < (letters.size - 1); i += 1 end
    # new[p] = letters.slice! i                            # in Ruby
    new = new.sub(p, letters[i]); letters = letters.sub(i, "")
  end
  score = new.chars.zip(s.chars).count { |c, d| c == d }
  {new, score}
end

%w(abracadabra seesaw elk grrrrrr up a).each do |word|
  # puts "%s, %s, (%d)" % [word, *best_shuffle(word)]      # in Ruby
  new, score = best_shuffle(word)
  puts "%s, %s, (%d)" % [word, new, score]
end


get "libhdr"

let writebin(x) be
$(  let f(x) be
    $(  if x>1 then f(x>>1)
        wrch((x & 1) + '0')
    $)
    f(x)
    wrch('*N')
$)

let start() be
$(  writebin(5)
    writebin(50)
    writebin(9000)
$)


beads 1 program 'Binary Digits'
calc main_init
	loop across:[5, 50, 9000] val:v
		log to_str(v, base:2)


# Generate the first n Fibonacci numbers: 1, 1, ...
# Numerical accuracy is insufficient beyond about 1450.
def fibonacci(n):
  # input: [f(i-2), f(i-1), countdown]
  def fib: (.[0] + .[1]) as $sum
           | if .[2] <= 0 then empty
             elif .[2] == 1 then $sum
             else $sum, ([ .[1], $sum, .[2] - 1 ] | fib)
             end;
  [1, 0, n] | fib ;

# is_prime is tailored to work with jq 1.4
def is_prime:
  if . == 2 then true
  else 2 < . and . % 2 == 1 and
       . as $in
       | (($in + 1) | sqrt) as $m
       | (((($m - 1) / 2) | floor) + 1) as $max
       | reduce range(1; $max) as $i
           (true; if . then ($in % ((2 * $i) + 1)) > 0 else false end)
  end ;

# primes in [m,n)
def primes(m;n):
  range(m;n) | select(is_prime);

def runs:
  reduce .[] as $item
    ( [];
      if . == [] then [ [ $item, 1] ]
      else  .[length-1] as $last
            | if $last[0] == $item
              then (.[0:length-1] + [ [$item, $last[1] + 1] ] )
              else . + [[$item, 1]]
              end
      end ) ;

# Inefficient but brief:
def histogram: sort | runs;

def benford_probability:
  tonumber
  | if . > 0 then ((1 + (1 /.)) | log) / (10|log)
    else 0
    end ;

# benford takes a stream and produces an array of [ "d", observed, expected ]
def benford(stream):
  [stream | tostring | .[0:1] ] | histogram as $histogram
  | reduce ($histogram | .[] | .[0]) as $digit
      ([]; . + [$digit, ($digit|benford_probability)] )
  | map(select(type == "number")) as $probabilities
  | ([ $histogram | .[] | .[1] ] | add) as $total
  | reduce range(0; $histogram|length) as $i
      ([]; . + ([$histogram[$i] + [$total * $probabilities[$i]] ] ) ) ;

# given an array of [value, observed, expected] values,
# produce the χ² statistic
def chiSquared:
  reduce .[] as $triple
    (0;
     if $triple[2] == 0 then .
     else . + ($triple[1] as $o | $triple[2] as $e | ($o - $e) | (.*.)/$e)
     end) ;

# truncate n places after the decimal point;
# return a string since it can readily be converted back to a number
def precision(n):
  tostring as $s | $s | index(".")
  | if . then $s[0:.+n+1] else $s end ;

# Right-justify but do not truncate
def rjustify(n):
  length as $length | if n <= $length then . else " " * (n-$length) + . end;

# Attempt to align decimals so integer part is in a field of width n
def align(n):
  index(".") as $ix
  | if n < $ix then .
    elif $ix then (.[0:$ix]|rjustify(n)) +.[$ix:]
    else rjustify(n)
    end ;

# given an array of [value, observed, expected] values,
# produce rows of the form: value observed expected
def print_rows(prec):
  .[] | map( precision(prec)|align(5) + "  ") | add ;

def report(heading; stream):
    benford(stream) as $array
    | heading,
      " Digit Observed Expected",
      ( $array | print_rows(2) ),
      "",
      " χ² = \( $array | chiSquared | precision(4))",
      ""
;

def task:
  report("First 100 fibonacci numbers:"; fibonacci( 100) ),
  report("First 1000 fibonacci numbers:"; fibonacci(1000) ),
  report("Primes less than 1000:"; primes(2;1000)),
  report("Primes between 1000 and 10000:"; primes(1000;10000)),
  report("Primes less than 100000:"; primes(2;100000))
;

task


import java.math.BigInteger

interface NumberGenerator {
    val numbers: Array<BigInteger>
}

class Benford(ng: NumberGenerator) {
    override fun toString() = str

    private val firstDigits = IntArray(9)
    private val count = ng.numbers.size.toDouble()
    private val str: String

    init {
        for (n in ng.numbers) {
            firstDigits[n.toString().substring(0, 1).toInt() - 1]++
        }

        str = with(StringBuilder()) {
            for (i in firstDigits.indices) {
                append(i + 1).append('\t').append(firstDigits[i] / count)
                append('\t').append(Math.log10(1 + 1.0 / (i + 1))).append('\n')
            }

            toString()
        }
    }
}

object FibonacciGenerator : NumberGenerator {
    override val numbers: Array<BigInteger> by lazy {
        val fib = Array<BigInteger>(1000, { BigInteger.ONE })
        for (i in 2 until fib.size)
            fib[i] = fib[i - 2].add(fib[i - 1])
        fib
    }
}

fun main(a: Array<String>) = println(Benford(FibonacciGenerator))


import base64

const Source = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g="

echo Source.decode()


(define base64-codes "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
(define kernel (alist->ff (map cons (string->bytes base64-codes) (iota (string-length base64-codes)))))

; returns n bits from input binary stream
(define (bits n hold)
   (let loop ((hold hold))
      (vector-apply hold (lambda (v i l)
         (cond
            ((null? l)
               (values (>> v (- i n)) #false))
            ((pair? l)
               (if (not (less? i n))
                  (values (>> v (- i n)) (vector (band v (- (<< 1 (- i n)) 1)) (- i n) l))
                  (loop (vector
                     (bor (<< v 6) (kernel (car l) 0))
                     (+ i 6)
                     (unless (eq? (car l) "=") (cdr l))))))
            (else
               (loop (vector v i (l)))))))))

; decoder.
(define (decode str)
   (print "decoding string '" str "':")
   (let loop ((hold [0 0 (str-iter str)]))
      (let*((bit hold (bits 8 hold)))
         (unless (zero? bit) (display (string bit)))
         (when hold
            (loop hold))))
   (print)(print))

; TESTING
(decode "SGVsbG8sIExpc3Ah")

(decode "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=")

(decode "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlzIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2YgdGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGludWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRoZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=")


import std.stdio, std.random, std.algorithm, std.conv, std.range,
       std.traits, std.typecons;

auto bestShuffle(S)(in S orig) @safe if (isSomeString!S) {
    static if (isNarrowString!S)
        immutable o = orig.dtext;
    else
        alias o = orig;

    auto s = o.dup;
    s.randomShuffle;

    foreach (immutable i, ref ci; s) {
        if (ci != o[i])
            continue;
        foreach (immutable j, ref cj; s)
            if (ci != cj && ci != o[j] && cj != o[i]) {
                swap(ci, cj);
                break;
            }
    }

    return tuple(s, s.zip(o).count!q{ a[0] == a[1] });
} unittest {
    assert("abracadabra".bestShuffle[1] == 0);
    assert("immediately".bestShuffle[1] == 0);
    assert("grrrrrr".bestShuffle[1] == 5);
    assert("seesaw".bestShuffle[1] == 0);
    assert("pop".bestShuffle[1] == 1);
    assert("up".bestShuffle[1] == 0);
    assert("a".bestShuffle[1] == 1);
    assert("".bestShuffle[1] == 0);
}

void main(in string[] args) @safe {
    if (args.length > 1) {
        immutable entry = args.dropOne.join(' ');
        const res = entry.bestShuffle;
        writefln("%s : %s (%d)", entry, res[]);
    }
}


Bin ← 2{⌽𝕗|⌊∘÷⟜𝕗⍟(↕1+·⌊𝕗⋆⁼1⌈⊢)}

Bin¨5‿50‿9000


  ( dec2bin
  =   bit bits
    .   :?bits
      &   whl
        ' ( !arg:>0
          & mod$(!arg,2):?bit
          & div$(!arg,2):?arg
          & !bit !bits:?bits
          )
      & (str$!bits:~|0)
  )
& 0 5 50 9000 423785674235000123456789:?numbers
&   whl
  ' ( !numbers:%?dec ?numbers
    & put$(str$(!dec ":\n" dec2bin$!dec \n\n))
    )
;


+[            Start with n=1 to kick off the loop
[>>++<<       Set up {n 0 2} for divmod magic
[->+>-        Then
[>+>>]>       do
[+[-<+>]>+>>] the
<<<<<<]       magic
>>>+          Increment n % 2 so that 0s don't break things
>]            Move into n / 2 and divmod that unless it's 0
-<            Set up sentinel ‑1 then move into the first binary digit
[++++++++ ++++++++ ++++++++ Add 47 to get it to ASCII
 ++++++++ ++++++++ +++++++. and print it
[<]<]         Get to a 0; the cell to the left is the next binary digit
>>[<+>-]      Tape is {0 n}; make it {n 0}
>[>+]         Get to the ‑1
<[[-]<]       Zero the tape for the next iteration
++++++++++.   Print a newline
[-]<+]        Zero it then increment n and go again


dim bin(9)

N=1000
for i = 0 to N-1
    num$ = str$(fiboI(i))
    d=val(left$(num$,1))
    'print num$, d
    bin(d)=bin(d)+1
next
print

print "Digit", "Actual freq", "Expected freq"
for i = 1 to 9
    print i, bin(i)/N, using("#.###", P(i))
next

function P(d)
    P = log10(d+1)-log10(d)
end function

function log10(x)
    log10 = log(x)/log(10)
end function

function fiboI(n)
    a = 0
    b = 1
    for i = 1 to n
        temp = a + b
        a = b
        b = temp
    next i
    fiboI = a
end function


actual = {}
expected = {}
for i = 1, 9 do
    actual[i] = 0
    expected[i] = math.log10(1 + 1 / i)
end

n = 0
file = io.open("fibs1000.txt", "r")
for line in file:lines() do
    digit = string.byte(line, 1) - 48
    actual[digit] = actual[digit] + 1
    n = n + 1
end
file:close()

print("digit   actual  expected")
for i = 1, 9 do
    print(i, actual[i] / n, expected[i])
end


sub decode_base64 {
    my($d) = @_;
    $d =~ tr!A-Za-z0-9+/!!cd;
    $d =~ s/=+$//;
    $d =~ tr!A-Za-z0-9+/! -_!;
    my $r = '';
    while( $d =~ /(.{1,60})/gs ){
        my $len = chr(32 + length($1)*3/4);
        $r .= unpack("u", $len . $1 );
    }
    $r;
}

$data = <<EOD;
J1R3YXMgYnJpbGxpZywgYW5kIHRoZSBzbGl0aHkgdG92ZXMKRGlkIGd5cmUgYW5kIGdpbWJsZSBp
biB0aGUgd2FiZToKQWxsIG1pbXN5IHdlcmUgdGhlIGJvcm9nb3ZlcywKQW5kIHRoZSBtb21lIHJh
dGhzIG91dGdyYWJlLgo=
EOD

print decode_base64($data) . "\n";


with javascript_semantics
include builtins\base64.e
string s = "Rosetta Code Base64 decode data task"
string e = encode_base64(s)
?e
?decode_base64(e)


$encoded = 'VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVw' .
           'IHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=';
echo
    $encoded, PHP_EOL,
    base64_decode($encoded), PHP_EOL;


(setq *Char64
   `'(chop
         "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" ) )
(de decode64 (S)
   (let S (chop S)
      (pack
         (make
            (while S
               (let
                  (A (dec (index (++ S) *Char64))
                     B (dec (index (++ S) *Char64))
                     C (dec (index (++ S) *Char64))
                     D (dec (index (++ S) *Char64)) )
                  (link
                     (char (| (>> -2 A) (>> 4 B))) )
                  (and
                     C
                     (link
                        (char
                           (| (>> -4 (& B 15)) (>> 2 C)) ) )
                     D
                     (link
                        (char (| (>> -6 (& C 3)) D)) ) ) ) ) ) ) ) )
(prinl (decode64 "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLVBhdWwgUi5FaHJsaWNo"))


string icon = Protocols.HTTP.get_url_data("http://rosettacode.org/favicon.ico");
string encoded = MIME.encode_base64(icon);
Stdio.write_file("favicon.ico", MIME.decode_base64(encoded));


program Best_shuffle;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.Generics.Collections;

type
  TShuffledString = record
  private
    original: string;
    Shuffled: TStringBuilder;
    ignoredChars: Integer;
    procedure DetectIgnores;
    procedure Shuffle;
    procedure Swap(pos1, pos2: Integer);
    function TrySwap(pos1, pos2: Integer): Boolean;
    function GetShuffled: string;
  public
    class operator Implicit(convert: string): TShuffledString;
    constructor Create(Word: string);
    procedure Free;
    property Ignored: integer read ignoredChars;
    property ToString: string read GetShuffled;
  end;

{ TShuffledString }

procedure TShuffledString.Swap(pos1, pos2: Integer);
var
  temp: char;
begin
  temp := shuffled[pos1];
  shuffled[pos1] := shuffled[pos2];
  shuffled[pos2] := temp;
end;

function TShuffledString.TrySwap(pos1, pos2: Integer): Boolean;
begin
  if (original[pos1] = shuffled[pos2]) or (original[pos2] = shuffled[pos1]) then
    Exit(false)
  else
    Exit(true);
end;

procedure TShuffledString.Shuffle;
var
  length, swaps: Integer;
  used: TList<Integer>;
  i, j, k: Integer;
begin
  Randomize;

  length := original.Length;
  used := TList<Integer>.create();

  for i := 0 to length - 1 do
  begin
    swaps := 0;
    while used.Count <= (length - i) do
    begin
      j := i + Random(length - 1 - i);

      if (original[i] <> original[j]) and TrySwap(i, j) and (not used.Contains(j)) then
      begin
        Swap(i, j);
        Inc(swaps);
        break;
      end
      else
        used.Add(j);
    end;

    if swaps = 0 then
    begin
      for k := i downto 0 do
      begin
        if TrySwap(i, k) then
          Swap(i, k);
      end;
    end;
    used.Clear();
  end;
  used.Free;
end;

constructor TShuffledString.Create(Word: string);
begin
  original := Word;
  shuffled := TStringBuilder.create(Word);
  Shuffle();
  DetectIgnores();
end;

procedure TShuffledString.DetectIgnores;
var
  ignores, i: Integer;
begin
  ignores := 0;
  for i := 0 to original.Length - 1 do
  begin
    if original[i] = shuffled[i] then
      Inc(ignores);
  end;
  ignoredChars := ignores;
end;

procedure TShuffledString.Free;
begin
  Shuffled.Free;
end;

function TShuffledString.GetShuffled: string;
begin
  result := shuffled.ToString();
end;

class operator TShuffledString.Implicit(convert: string): TShuffledString;
begin
  result := TShuffledString.Create(convert);
end;

var
  words: array of string;
  Word: TShuffledString;
  w: string;

begin
  words := ['abracadabra', 'seesaw', 'elk', 'grrrrrr', 'up', 'a'];
  for w in words do
  begin
    Word := w;
    writeln(format('%s, %s, (%d)', [Word.Original, Word.ToString, Word.Ignored]));
    Word.Free;
  end;
  Readln;
end.