#define _CRT_SECURE_NO_WARNINGS    // turn off panic warnings
#define _CRT_NONSTDC_NO_DEPRECATE   // enable old-gold POSIX names in MSVS

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

char* bin2str(unsigned value, char* buffer)
{
    // This algorithm is not the fastest one, but is relativelly simple.
    //
    // A faster algorithm would be conversion octets to strings by a lookup table.
    // There is only 2**8 == 256 octets, therefore we would need only 2048 bytes
    // for the lookup table. Conversion of a 64-bit integers would need 8 lookups
    // instead 64 and/or/shifts of bits etc. Even more... lookups may be implemented
    // with XLAT or similar CPU instruction... and AVX/SSE gives chance for SIMD.

    const unsigned N_DIGITS = sizeof(unsigned) * 8;
    unsigned mask = 1 << (N_DIGITS - 1);
    char* ptr = buffer;

    for (int i = 0; i < N_DIGITS; i++)
    {
        *ptr++ = '0' + !!(value & mask);
        mask >>= 1;
    }
    *ptr = '\0';

    // Remove leading zeros.
    //
    for (ptr = buffer; *ptr == '0'; ptr++)
        ;

    return ptr;
}

char* bin2strNaive(unsigned value, char* buffer)
{
    // This variation of the solution doesn't use bits shifting etc.

    unsigned n, m, p;

    n = 0;
    p = 1;  // p = 2 ** n
    while (p <= value / 2)
    {
        n = n + 1;
        p = p * 2;
    }

    m = 0;
    while (n > 0)
    {
        buffer[m] = '0' + value / p;
        value = value % p;
        m = m + 1;
        n = n - 1;
        p = p / 2;
    }

    buffer[m + 1] = '\0';
    return buffer;
}

int main(int argc, char* argv[])
{
    const unsigned NUMBERS[] = { 5, 50, 9000 };

    const int RADIX = 2;
    char buffer[(sizeof(unsigned)*8 + 1)];

    // Function itoa is an POSIX function, but it is not in C standard library.
    // There is no big surprise that Microsoft deprecate itoa because POSIX is
    // "Portable Operating System Interface for UNIX". Thus it is not a good
    // idea to use _itoa instead itoa: we lost compatibility with POSIX;
    // we gain nothing in MS Windows (itoa-without-underscore is not better
    // than _itoa-with-underscore). The same holds for kbhit() and _kbhit() etc.
    //
    for (int i = 0; i < sizeof(NUMBERS) / sizeof(unsigned); i++)
    {
        unsigned value = NUMBERS[i];
        itoa(value, buffer, RADIX);
        printf("itoa:          %u decimal = %s binary\n", value, buffer);
    }

    // Yeep, we can use a homemade bin2str function. Notice that C is very very
    // efficient (as "hi level assembler") when bit manipulation is needed.
    //
    for (int i = 0; i < sizeof(NUMBERS) / sizeof(unsigned); i++)
    {
        unsigned value = NUMBERS[i];
        printf("bin2str:       %u decimal = %s binary\n", value, bin2str(value, buffer));
    }

    // Another implementation - see above.
    //
    for (int i = 0; i < sizeof(NUMBERS) / sizeof(unsigned); i++)
    {
        unsigned value = NUMBERS[i];
        printf("bin2strNaive:  %u decimal = %s binary\n", value, bin2strNaive(value, buffer));
    }

    return EXIT_SUCCESS;
}


fibdata = Array[[email protected]@[email protected]# &, 1000];
Table[{d, [email protected][fibdata, d]/[email protected], Log10[1. + 1/d]}, {d, 1,
    9}] // Grid


/* NetRexx */
options replace format comments java crossref symbols nobinary

runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method brenfordDeveation(nlist = Rexx[]) public static
  observed = 0
  loop n_ over nlist
    d1 = n_.left(1)
    if d1 = 0 then iterate n_
    observed[d1] = observed[d1] + 1
    end n_
  say ' '.right(4) 'Observed'.right(11) 'Expected'.right(11) 'Deviation'.right(11)
  loop n_ = 1 to 9
    actual = (observed[n_] / (nlist.length - 1))
    expect = Rexx(Math.log10(1 + 1 / n_))
    deviat = expect - actual
    say n_.right(3)':' (actual * 100).format(3, 6)'%' (expect * 100).format(3, 6)'%' (deviat * 100).abs().format(3, 6)'%'
    end n_
  return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method fibonacciList(size = 1000) public static returns Rexx[]
  fibs = Rexx[size + 1]
  fibs[0] = 0
  fibs[1] = 1
  loop n_ = 2 to size
    fibs[n_] = fibs[n_ - 1] + fibs[n_ - 2]
    end n_
  return fibs

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) private static
  parse arg n_ .
  if n_ = '' then n_ = 1000
  fibList = fibonacciList(n_)
  say 'Fibonacci sequence to' n_
  brenfordDeveation(fibList)
  return


?- Encoded = 'VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=',
base64(Plain, Encoded).

Plain = 'To err is human, but to really foul things up you need a computer.\n    -- Paul R. Ehrlich'.


b64cd$ = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVw" +
         "IHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g="

*p_buf = AllocateMemory(1024)
Base64Decoder(b64cd$, *p_buf, 1024)
OpenConsole("") : PrintN(PeekS(*p_buf, -1, #PB_UTF8))
Input()


import base64
data = 'VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g='
print(base64.b64decode(data).decode('utf-8'))


Option _Explicit

Dim As String udata, decoded
udata = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLVBhdWwgUi5FaHJsaWNo"

decoded = decode(udata)

Print udata
Print decoded

Function findIndex& (value As _Unsigned _Byte)
    If Asc("A") <= value And value <= Asc("Z") Then
        findIndex = value - Asc("A")
        Exit Function
    End If
    If Asc("a") <= value And value <= Asc("z") Then
        findIndex = value - Asc("a") + 26
        Exit Function
    End If
    If Asc("0") <= value And value <= Asc("9") Then
        findIndex = value - Asc("0") + 52
        Exit Function
    End If
    If value = Asc("+") Then
        findIndex = 62
        Exit Function
    End If
    If value = Asc("/") Then
        findIndex = 63
        Exit Function
    End If
    findIndex = -1
End Function

Function encode$ (source As String)
    Dim As String Base64: Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    Dim As _Unsigned _Integer64 length: length = Len(source)
    Dim As _Unsigned _Integer64 it, strend
    Dim As Long acc
    Dim As String sink
    strend = length
    While it <> strend
        Dim As _Unsigned _Byte b1, b2, b3, b4
        it = it + 1
        b1 = Asc(Mid$(source, it, 1))
        sink = sink + Mid$(Base64, _SHR(b1, 2), 1)
        acc = _SHL(b1 And &H3, 4)
        If it <> strend Then
            it = it + 1
            b2 = Asc(Mid$(source, it, 1))
            acc = acc Or _SHR(b2, 4)
            sink = sink + Mid$(Base64, acc, 1)
            acc = _SHL(b2 And &HF, 2)
            If it <> strend Then
                it = it + 1
                b3 = Asc(Mid$(source, it, 1))
                acc = acc Or _SHR(b3, 6)
                sink = sink + Mid$(Base64, acc, 1)
                sink = sink + Mid$(Base64, b3 And &H3F, 1)
            Else
                sink = sink + Mid$(Base64, acc, 1)
                sink = sink + "="
            End If
        Else
            sink = sink + Mid$(Base64, acc, 1)
            sink = sink + "="
            sink = sink + "="
        End If
    Wend
    encode = sink
End Function

Function decode$ (source As String)
    Dim As _Unsigned _Integer64 length: length = Len(source)
    Dim As _Unsigned _Integer64 it, strend
    Dim As Long acc
    Dim As String sink
    strend = length
    While it <> strend
        Dim As _Unsigned _Byte b1, b2, b3, b4
        it = it + 1
        b1 = Asc(Mid$(source, it, 1))
        it = it + 1
        b2 = Asc(Mid$(source, it, 1))
        it = it + 1
        b3 = Asc(Mid$(source, it, 1))
        it = it + 1
        b4 = Asc(Mid$(source, it, 1))
        Dim As Long i1, i2
        i1 = findIndex(b1)
        i2 = findIndex(b2)
        acc = _SHL(i1, 2)
        acc = acc Or _SHR(i2, 4)
        sink = sink + Chr$(acc)
        If b3 <> Asc("=") Then
            Dim As Long i3
            i3 = findIndex(b3)
            acc = _SHL(i2 And &HF, 4)
            acc = acc Or _SHR(i3, 2)
            sink = sink + Chr$(acc)
            If b4 <> Asc("=") Then
                Dim As Long i4
                i4 = findIndex(b4)
                acc = _SHL(i3 And &H3, 6)
                acc = acc Or i4
                sink = sink + Chr$(acc)
            End If
        End If
    Wend
    decode = sink
End Function


import system'routines;
import extensions;
import extensions'text;

extension op
{
    get Shuffled()
    {
        var original := self.toArray();
        var shuffled := self.toArray();

        for (int i := 0, i < original.Length, i += 1) {
            for (int j := 0, j < original.Length, j += 1) {
                if (i != j && original[i] != shuffled[j] && original[j] != shuffled[i])
                {
                    shuffled.exchange(i,j)
                }
            }
        };

        ^ shuffled.summarize(new StringWriter()).toString()
    }

    score(originalText)
    {
        var shuffled := self.toArray();
        var original := originalText.toArray();
        int score := 0;

        for (int i := 0, i < original.Length, i += 1) {
            if (original[i] == shuffled[i]) { score += 1 }
        };

        ^ score
    }
}

public program()
{
    new string[]{"abracadabra", "seesaw", "grrrrrr", "pop", "up", "a"}.forEach:(s)
    {
        var shuffled_s := s.Shuffled;

        console.printLine("The best shuffle of ",s," is ",shuffled_s,"(",shuffled_s.score(s),")")
    };

    console.readChar()
}


-module( best_shuffle ).

-export( [sameness/2, string/1, task/0] ).

sameness( String1, String2 ) -> lists:sum( [1 || {X, X} <- lists:zip(String1, String2)] ).

string( String ) ->
	{"", String, Acc} = lists:foldl( fun different/2, {lists:reverse(String), String, []}, String ),
	lists:reverse( Acc ).

task() ->
	Strings = ["abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"],
	Shuffleds = [string(X) || X <- Strings],
	[io:fwrite("~p ~p ~p~n", [X, Y, sameness(X,Y)]) || {X, Y} <- lists:zip(Strings, Shuffleds)].

different( Character, {[Character], Original, Acc} ) ->
	try_to_save_last( Character, Original, Acc );
different( Character, {[Character | T]=Not_useds, Original, Acc} ) ->
	Different_or_same = different_or_same( [X || X <- T, X =/= Character], Character ),
	{lists:delete(Different_or_same, Not_useds), Original, [Different_or_same | Acc]};
different( _Character1, {[Character2 | T], Original, Acc} ) ->
	{T, Original, [Character2 | Acc]}.

different_or_same( [Different | _T], _Character ) -> Different;
different_or_same( [], Character ) -> Character.

try_to_save_last( Character, Original_string, Acc ) ->
	Fun = fun ({X, Y}) -> (X =:= Y) orelse (X =:= Character) end,
	New_acc = try_to_save_last( lists:splitwith(Fun, lists:zip(lists:reverse(Original_string), [Character | Acc])), [Character | Acc] ),
	{"", Original_string, New_acc}.

try_to_save_last( {_Not_split, []}, Acc ) -> Acc;
try_to_save_last( {Last_reversed_zip, First_reversed_zip}, _Acc ) ->
	{_Last_reversed_original, [Last_character_acc | Last_part_acc]} = lists:unzip( Last_reversed_zip ),
	{_First_reversed_original, [Character_acc | First_part_acc]} = lists:unzip( First_reversed_zip ),
	[Character_acc | Last_part_acc] ++ [Last_character_acc | First_part_acc].


using System;

class Program
{
    static void Main()
    {
        foreach (var number in new[] { 5, 50, 9000 })
        {
            Console.WriteLine(Convert.ToString(number, 2));
        }
    }
}


#include <bitset>
#include <iostream>
#include <limits>
#include <string>

void print_bin(unsigned int n) {
  std::string str = "0";

  if (n > 0) {
    str = std::bitset<std::numeric_limits<unsigned int>::digits>(n).to_string();
    str = str.substr(str.find('1')); // remove leading zeros
  }

  std::cout << str << '\n';
}

int main() {
  print_bin(0);
  print_bin(5);
  print_bin(50);
  print_bin(9000);
}


import math
import strformat

type

  # Non zero digit range.
  Digit = range[1..9]

  # Count array used to compute a distribution.
  Count = array[Digit, Natural]

  # Array to store frequencies.
  Distribution = array[Digit, float]

####################################################################################################
# Fibonacci numbers generation.

import bignum

proc fib(count: int): seq[Int] =
  ## Build a sequence of "count auccessive Finonacci numbers.
  result.setLen(count)
  result[0..1] = @[newInt(1), newInt(1)]
  for i in 2..<count:
    result[i] = result[i-1] + result[i-2]

####################################################################################################
# Benford distribution.

proc benfordDistrib(): Distribution =
  ## Compute Benford distribution.

  for d in 1..9:
    result[d] = log10(1 + 1 / d)

const BenfordDist = benfordDistrib()

#---------------------------------------------------------------------------------------------------

template firstDigit(n: Int): Digit =
  # Return the first (non null) digit of "n".
  ord(($n)[0]) - ord('0')

#---------------------------------------------------------------------------------------------------

proc actualDistrib(s: openArray[Int]): Distribution =
  ## Compute actual distribution of first digit.
  ## Null values are ignored.

  var counts: Count
  for val in s:
    if not val.isZero():
      inc counts[val.firstDigit()]

  let total = sum(counts)
  for d in 1..9:
    result[d] = counts[d] / total

#---------------------------------------------------------------------------------------------------

proc display(distrib: Distribution) =
  ## Display an actual distribution versus the Benford reference distribution.

  echo "d   actual   expected"
  echo "---------------------"
  for d in 1..9:
    echo fmt"{d}   {distrib[d]:6.4f}    {BenfordDist[d]:6.4f}"

#———————————————————————————————————————————————————————————————————————————————————————————————————

let fibSeq = fib(1000)
let distrib = actualDistrib(fibSeq)
echo "Fibonacci numbers first digit distribution:\n"
distrib.display()


MODULE BenfordLaw;
IMPORT
  LRealStr,
  LRealMath,
  Out := NPCT:Console;

VAR
  r: ARRAY 1000 OF LONGREAL;
  d: ARRAY 10 OF LONGINT;
  a: LONGREAL;
  i: LONGINT;

PROCEDURE Fibb(VAR r: ARRAY OF LONGREAL);
VAR
  i: LONGINT;
BEGIN
  r[0] := 1.0;r[1] := 1.0;
  FOR i := 2 TO LEN(r) - 1 DO
    r[i] := r[i - 2] + r[i - 1]
  END
END Fibb;

PROCEDURE Dist(r [NO_COPY]: ARRAY OF LONGREAL; VAR d: ARRAY OF LONGINT);
VAR
  i: LONGINT;
  str: ARRAY 256 OF CHAR;
BEGIN
  FOR i := 0 TO LEN(r) - 1 DO
    LRealStr.RealToStr(r[i],str);
    INC(d[ORD(str[0]) - ORD('0')])
  END
END Dist;

BEGIN
  Fibb(r);
  Dist(r,d);
  Out.String("First 1000 fibonacci numbers: ");Out.Ln;
  Out.String(" digit ");Out.String(" observed ");Out.String(" predicted ");Out.Ln;
  FOR i := 1 TO LEN(d) - 1 DO
    a := LRealMath.ln(1.0 + 1.0 / i ) / LRealMath.ln(10);
    Out.Int(i,5);Out.LongRealFix(d[i] / 1000.0,9,3);Out.LongRealFix(a,10,3);Out.Ln
  END
END BenfordLaw.


my $e64 = '
VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY2
9tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=
';

my @base64map = flat 'A' .. 'Z', 'a' .. 'z', ^10, '+', '/';
my %base64 is default(0) = @base64map.pairs.invert;

sub base64-decode-slow ($enc) {
    my $buf = Buf.new;
    for $enc.subst(/\s/, '', :g).comb(4) -> $chunck {
        $buf.append: |(sprintf "%06d%06d%06d%06d", |$chunck.comb.map:
            {%base64{$_}.base(2)}).comb(8).map: {:2($_)};
    }
    $buf
}

say 'Slow:';
say base64-decode-slow($e64).decode('utf8');

# Of course, the above routine is slow and is only for demonstration purposes.
# For real code you should use a module, which is MUCH faster and heavily tested.
say "\nFast:";
use Base64::Native;
say base64-decode($e64).decode('utf8');


Red [Source: https://github.com/vazub/rosetta-red]

print to-string debase "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLVBhdWwgUi5FaHJsaWNo"


#======================================#
#  Sample: Base64 decode data
#  Author: Gal Zsolt, Mansour Ayouni
#======================================#

load "guilib.ring"

oQByteArray = new QByteArray()
oQByteArray.append("Rosetta Code Base64 decode data task")
oba = oQByteArray.toBase64().data()
see oba + nl

oQByteArray = new QByteArray()
oQByteArray.append(oba)
see oQByteArray.fromBase64(oQByteArray).data()


require 'base64'

raku_example ='
VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY2
9tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=
'
puts Base64.decode64 raku_example


use std::str;

const INPUT: &str = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLVBhdWwgUi5FaHJsaWNo";
const UPPERCASE_OFFSET: i8 = -65;
const LOWERCASE_OFFSET: i8 = 26 - 97;
const NUM_OFFSET: i8 = 52 - 48;

fn main() {
    println!("Input: {}", INPUT);

    let result = INPUT.chars()
        .filter(|&ch| ch != '=')                                //Filter '=' chars
        .map(|ch| {                                             //Map char values using Base64 Characters Table
            let ascii = ch as i8;
            let convert = match ch {
                '0' ... '9' => ascii + NUM_OFFSET,
                'a' ... 'z' => ascii + LOWERCASE_OFFSET,
                'A' ... 'Z' => ascii + UPPERCASE_OFFSET,
                '+' => 62,
                '/' => 63,
                _ => panic!("Not a valid base64 encoded string")
            };
            format!("{:#08b}", convert)[2..].to_string()        //convert indices to binary format and remove the two first digits
        })
        .collect::<String>()                                    //concatenate the resulting binary values
        .chars()
        .collect::<Vec<char>>()
        .chunks(8)                                              //split into 8 character chunks
        .map(|chunk| {
            let num_str = chunk.iter().collect::<String>();
            usize::from_str_radix(&num_str, 2).unwrap() as u8   //convert the binary string into its u8 value
        })
        .collect::<Vec<_>>();

    let result = str::from_utf8(&result).unwrap();              //convert into UTF-8 string

    println!("Output: {}", result);
}


Dim As String*11 lista(6) => {"abracadabra","seesaw","pop","grrrrrr","up","a"}

Function bestShuffle(s1 As String) As String
    Dim As String s2 = s1
    Dim As Integer i, j, i1, j1
    For i = 1 To Len(s2)
        For j =  1 To Len(s2)
            If (i <> j) And (Mid(s2,i,1) <> Mid(s1,j,1)) And (Mid(s2,j,1) <> Mid(s1,i,1)) Then
                If j < i Then i1 = j : j1 = i Else i1 = i : j1 = j
                s2 = Left(s2,i1-1) + Mid(s2,j1,1) + Mid(s2,i1+1,(j1-i1)-1) + Mid(s2,i1,1) + Mid(s2,j1+1)
            End If
        Next j
    Next i
    bestShuffle = s2
End Function

Dim As String palabra, bs
Dim As Integer puntos
For b As Integer = 0 To Ubound(lista)-1
    palabra  = lista(b)
    bs = bestShuffle(palabra)
    puntos = 0
    For i As Integer = 1 To Len(palabra)
        If Mid(palabra,i,1) = Mid(bs,i,1) Then puntos += 1
    Next i
    Print palabra; " ==> "; bs; "  (puntuaci¢n:"; puntos; ")"
Next b
Sleep


    shared void run() {

        void printBinary(Integer integer) =>
            print(Integer.format(integer, 2));

        printBinary(5);
        printBinary(50);
        printBinary(9k);
    }


(Integer/toBinaryString 5)
(Integer/toBinaryString 50)
(Integer/toBinaryString 9000)


open Num

let fib =
  let rec fib_aux f0 f1 = function
    | 0 -> f0
    | 1 -> f1
    | n -> fib_aux f1 (f1 +/ f0) (n - 1)
  in
  fib_aux (num_of_int 0) (num_of_int 1) ;;

let create_fibo_string = function n -> string_of_num (fib n) ;;
let rec range i j = if i > j then [] else i :: (range (i + 1) j)

let n_max = 1000 ;;

let numbers = range 1 n_max in
  let get_first_digit = function s -> Char.escaped (String.get s 0) in
    let first_digits = List.map get_first_digit (List.map create_fibo_string numbers) in
  let data = Array.create 9 0 in
    let fill_data vec = function n -> vec.(n - 1) <- vec.(n - 1) + 1 in
    List.iter (fill_data data) (List.map int_of_string first_digits) ;
    Printf.printf "\nFrequency of the first digits in the Fibonacci sequence:\n" ;
    Array.iter (Printf.printf "%f ")
      (Array.map (fun x -> (float x) /. float (n_max)) data) ;

let xvalues = range 1 9 in
  let benfords_law = function x -> log10 (1.0 +. 1.0 /. float (x)) in
    Printf.printf "\nPrediction of Benford's law:\n " ;
    List.iter (Printf.printf "%f ") (List.map benfords_law xvalues) ;
    Printf.printf "\n" ;;


distribution(v)={
	my(t=vector(9,n,sum(i=1,#v,v[i]==n)));
	print("Digit\tActual\tExpected");
	for(i=1,9,print(i, "\t", t[i], "\t", round(#v*(log(i+1)-log(i))/log(10))))
};
dist(f)=distribution(vector(1000,n,digits(f(n))[1]));
lucas(n)=fibonacci(n-1)+fibonacci(n+1);
dist(fibonacci)
dist(lucas)


import java.util.Base64

object Base64Decode extends App {

  def text2BinaryDecoding(encoded: String): String = {
    val decoded = Base64.getDecoder.decode(encoded)
    new String(decoded, "UTF-8")
  }

  def data =
    "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g="

  println(text2BinaryDecoding(data))
}


$ include "seed7_05.s7i";
  include "gethttp.s7i";
  include "encoding.s7i";

const proc: main is func
  local
    var string: original is "";
    var string: encoded is "";
  begin
    original := getHttp("rosettacode.org/favicon.ico");
    encoded := toBase64(original);
    writeln("Is the Rosetta Code icon the same (byte for byte) encoded then decoded: " <&
            fromBase64(encoded) = original);
  end func;


var data = <<'EOT'
VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY2
9tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=
EOT

say data.decode_base64


data := '
VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY2
9tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=
'.

data base64Decoded asString printCR.


val debase64 = fn input =>
let

 infix 2 Worb
 infix 2 Wandb
 fun (p Worb q )  =  Word.orb  (p,q);
 fun (p Wandb q ) =  Word.andb (p,q);

fun decode #"/" =  0wx3F
  | decode #"+" =  0wx3E
  | decode c    =  if Char.isDigit c then Word.fromInt (ord c) +  0wx04
              else if Char.isLower c then Word.fromInt (ord c) - 0wx047
              else if Char.isUpper c then Word.fromInt (ord c) - 0wx041
              else 0wx00 ;

fun convert (a::b::c::d::_) =
         let
            val w = Word.<< (a,0wx12) Worb Word.<< (b,0wx0c) Worb Word.<< (c,0wx06) Worb d
         in
            [Word.>> (w,0wx10), Word.>> ((w Wandb 0wx00ff00),0wx08) , w Wandb 0wx0000ff ]
         end
  | convert _ = [] ;

fun decodeLst []    = []
  | decodeLst ilist = ( convert o  map decode )( List.take (ilist,4) ) @  decodeLst (List.drop (ilist,4))

in

  String.implode ( List.map (chr o Word.toInt) ( decodeLst (String.explode input ))  )

end                                                                 handle Subscript  => "Invalid code\n" ;


package require tcl 8.6
set data VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g=

puts [binary decode base64 $data]


Program BestShuffle;

Const
  arr : array[1..6] Of string = ('abracadabra','seesaw','elk','grrrrrr','up','a');

Function Shuffle(inp: String): STRING;

Var x,ReplacementDigit : longint;
  ch : char;
Begin
  If length(inp) > 1 Then
    Begin
      Randomize;
      For x := 1 To length(inp) Do
        Begin
          Repeat
            ReplacementDigit := random(length(inp))+1;
          Until (ReplacementDigit <> x);
          ch := inp[x];
          inp[x] := inp[ReplacementDigit];
          inp[ReplacementDigit] := ch;
        End;
    End;
  shuffle := inp;
End;

Function score(OrgString,ShuString : String) : integer;

Var i : integer;
Begin
  score := 0;
  For i := 1 To length(OrgString) Do
    If OrgString[i] = ShuString[i] Then inc(score);
End;

Var i : integer;
  shuffled : string;
Begin
  For i := low(arr) To high(arr) Do
    Begin
      shuffled := shuffle(arr[i]);
      writeln(arr[i],' , ',shuffled,' , (',score(arr[i],shuffled),')');
    End;
End.


binary = proc (n: int) returns (string)
    bin: string := ""
    while n > 0 do
        bin := string$c2s(char$i2c(48 + n // 2)) || bin
        n := n / 2
    end
    return(bin)
end binary

start_up = proc ()
    po: stream := stream$primary_output()
    tests: array[int] := array[int]$[5, 50, 9000]

    for test: int in array[int]$elements(tests) do
        stream$putl(po, int$unparse(test) || " -> " || binary(test))
    end
end start_up


       IDENTIFICATION DIVISION.
       PROGRAM-ID. SAMPLE.

       DATA DIVISION.
       WORKING-STORAGE SECTION.

         01 binary_number   pic X(21).
         01 str             pic X(21).
         01 binary_digit    pic X.
         01 digit           pic 9.
         01 n               pic 9(7).
         01 nstr            pic X(7).

       PROCEDURE DIVISION.
         accept nstr
         move nstr to n
         perform until n equal 0
           divide n by 2 giving n remainder digit
           move digit to binary_digit
           string binary_digit  DELIMITED BY SIZE
                  binary_number DELIMITED BY SPACE
                  into str
           move str to binary_number
         end-perform.
         display binary_number
         stop run.


program fibFirstdigit;
{$IFDEF FPC}{$MODE Delphi}{$ELSE}{$APPTYPE CONSOLE}{$ENDIF}
uses
  sysutils;
type
  tDigitCount = array[0..9] of LongInt;
var
  s: Ansistring;
  dgtCnt,
  expectedCnt : tDigitCount;

procedure GetFirstDigitFibonacci(var dgtCnt:tDigitCount;n:LongInt=1000);
//summing up only the first 9 digits
//n = 1000 -> difference to first 9 digits complete fib < 100 == 2 digits
var
  a,b,c : LongWord;//about 9.6 decimals
Begin
  for a in dgtCnt do dgtCnt[a] := 0;
  a := 0;b := 1;
  while n > 0 do
  Begin
    c := a+b;
    //overflow? round and divide by base 10
    IF c < a then
      Begin a := (a+5) div 10;b := (b+5) div 10;c := a+b;end;
    a := b;b := c;
    s := IntToStr(a);inc(dgtCnt[Ord(s[1])-Ord('0')]);
    dec(n);
  end;
end;

procedure InitExpected(var dgtCnt:tDigitCount;n:LongInt=1000);
var
  i: integer;
begin
  for i := 1 to 9  do
    dgtCnt[i] := trunc(n*ln(1 + 1 / i)/ln(10));
end;

var
  reldiff: double;
  i,cnt: integer;
begin
  cnt := 1000;
  InitExpected(expectedCnt,cnt);
  GetFirstDigitFibonacci(dgtCnt,cnt);
  writeln('Digit  count  expected  rel diff');
  For i := 1 to 9 do
  Begin
    reldiff := 100*(expectedCnt[i]-dgtCnt[i])/expectedCnt[i];
    writeln(i:5,dgtCnt[i]:7,expectedCnt[i]:10,reldiff:10:5,' %');
  end;
end.


Module Module1

    Sub Main()
        Dim data = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g="
        Console.WriteLine(data)
        Console.WriteLine()

        Dim decoded = Text.Encoding.ASCII.GetString(Convert.FromBase64String(data))
        Console.WriteLine(decoded)
    End Sub

End Module


import encoding.base64

fn main() {
    msg := "Rosetta Code Base64 decode data task"
    println("Original : $msg")
    encoded := base64.encode_str(msg)
    println("\nEncoded  : $encoded")
    decoded := base64.decode_str(encoded)
    println("\nDecoded  : $decoded")
}


import "io" for Stdout
import "/fmt" for Conv, Fmt
import "/str" for Str

var alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

var decode = Fn.new { |s|
   if (s == "") return s
   var d = ""
   for (b in s) {
       var ix = alpha.indexOf(b)
       if (ix >= 0) d = d + Fmt.swrite("$06b", ix)
   }
   if (s.endsWith("==")) {
        d = d[0..-5]
   } else if (s.endsWith("=")){
        d = d[0..-3]
   }
   var i = 0
   while (i < d.count) {
        var ch = String.fromByte(Conv.atoi(d[i..i+7], 2))
        System.write(ch)
        i = i + 8
   }
   Stdout.flush()
}

var s = "VG8gZXJyIGlzIGh1bWFuLCBidXQgdG8gcmVhbGx5IGZvdWwgdGhpbmdzIHVwIHlvdSBuZWVkIGEgY29tcHV0ZXIuCiAgICAtLSBQYXVsIFIuIEVocmxpY2g="
for (chunk in Str.chunks(s, 4)) decode.call(chunk)
System.print()


var [const] MsgHash=Import("zklMsgHash"), Curl=Import("zklCurl");

icon:=Curl().get("http://rosettacode.org/favicon.ico"); //-->(Data(4,331),693,0)
icon=icon[0][icon[1],*];	// remove header
iconEncoded:=MsgHash.base64encode(icon);
iconDecoded:=MsgHash.base64decode(iconEncoded);
File("rosettaCodeIcon.ico","wb").write(iconDecoded); # eyeball checking says good
println("Is the Rosetta Code icon the same (byte for byte) encoded then decoded: ",
   icon==iconDecoded);


include "Tlbx GameplayKit.incl"
include "NSLog.incl"

local fn ShuffleString( string as CFStringRef ) as CFStringRef
NSInteger i

CFMutableArrayRef mutArr = fn MutableArrayWithCapacity( 0 )
for i = 0 to fn StringLength( string ) - 1
MutableArrayAddObject( mutArr, fn StringSubstringWithRange( string, fn CFRangeMake( i, 1 ) ) )
next
CFArrayRef shuffledArr = fn GKRandomSourceArrayByShufflingObjectsInArray( fn GKRandomSourceInit, mutArr )
end fn = fn ArrayComponentsJoinedByString( shuffledArr, @"" )

local fn StringDifferences( string1 as CFStringRef, string2 as CFStringRef ) as NSInteger
NSInteger i, unchangedPosition = 0

if fn StringLength( string1 ) != fn StringLength( string2 ) then NSLog( @"Strings must be of equal length." ) : exit fn

for i = 0 to fn StringLength( string1 ) -1
CFStringRef tempStr1 = fn StringSubstringWithRange( string1, fn CFRangeMake( i, 1 ) )
CFStringRef tempStr2 = fn StringSubstringWithRange( string2, fn CFRangeMake( i, 1 ) )
if fn StringIsEqual( tempStr1, tempStr2 ) == YES then unchangedPosition++
next
end fn = unchangedPosition

NSInteger   i, j, count
CFArrayRef  stringArr
CFStringRef originalStr, shuffledStr

stringArr = @[@"abracadabra", @"seesaw", @"elk", @"grrrrrr", @"up", @"a"]
count = fn ArrayCount( stringArr )

for i = 0 to 3
for j = 0 to count - 1
originalStr = stringArr[j]
shuffledStr = fn ShuffleString( stringArr[j] )
NSLog( @"%@, %@, (%ld)", originalStr, shuffledStr, fn StringDifferences( originalStr, shuffledStr ) )
next
NSLog( @"\n" )
next

HandleEvents


package main

import (
    "fmt"
    "math/rand"
    "time"
)

var ts = []string{"abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"}

func main() {
    rand.Seed(time.Now().UnixNano())
    for _, s := range ts {
        // create shuffled byte array of original string
        t := make([]byte, len(s))
        for i, r := range rand.Perm(len(s)) {
            t[i] = s[r]
        }
        // algorithm of Icon solution
        for i := range t {
            for j := range t {
                if i != j && t[i] != s[j] && t[j] != s[i] {
                    t[i], t[j] = t[j], t[i]
                    break
                }
            }
        }
        // count unchanged and output
        var count int
        for i, ic := range t {
            if ic == s[i] {
                count++
            }
        }
        fmt.Printf("%s -> %s (%d)\n", s, string(t), count)
    }
}


binary = (n) ->
  new Number(n).toString(2)

console.log binary n for n in [5, 50, 9000]


(format t "~b" 5)

; or

(write 5 :base 2)


#!/usr/bin/perl
use strict ;
use warnings ;
use POSIX qw( log10 ) ;

my @fibonacci = ( 0 , 1  ) ;
while ( @fibonacci != 1000 ) {
   push @fibonacci , $fibonacci[ -1 ] + $fibonacci[ -2 ] ;
}
my @actuals ;
my @expected ;
for my $i( 1..9 ) {
   my $sum = 0 ;
   map { $sum++ if $_ =~ /\A$i/ } @fibonacci ;
   push @actuals , $sum / 1000  ;
   push @expected , log10( 1 + 1/$i ) ;
}
print "         Observed         Expected\n" ;
for my $i( 1..9 ) {
   print "$i : " ;
   my $result = sprintf ( "%.2f" , 100 * $actuals[ $i - 1 ] ) ;
   printf "%11s %%" , $result ;
   $result = sprintf ( "%.2f" , 100 * $expected[ $i - 1 ] ) ;
   printf "%15s %%\n" , $result ;
}


with javascript_semantics
function benford(sequence s, string title)
    sequence f = repeat(0,9)
    for i=1 to length(s) do
        integer fdx = sprint(s[i])[1]-'0'
        f[fdx] += 1
    end for
    sequence res = {title,"Digit  Observed%  Predicted%"}
    for i=1 to length(f) do
        atom o = f[i]/length(s)*100,
             e = log10(1+1/i)*100
        res = append(res,sprintf("  %d  %9.3f  %8.3f", {i, o, e}))
    end for
    return res
end function

function fib(integer lim)
    atom a=0, b=1
    sequence res = repeat(0,lim)
    for i=1 to lim do
        {res[i], a, b} = {b, b, b+a}
    end for
    return res
end function

sequence res = {benford(fib(1000),"First 1000 Fibonacci numbers"),
                benford(get_primes(-10000),"First 10000 Prime numbers"),
                benford(sq_power(3,tagset(500)),"First 500 powers of three")}
papply(true,printf,{1,{"%-40s%-40s%-40s\n"},columnize(res)})


def shuffle(text) {
    def shuffled = (text as List)
    for (sourceIndex in 0..<text.size()) {
        for (destinationIndex in 0..<text.size()) {
                if (shuffled[sourceIndex] != shuffled[destinationIndex] && shuffled[sourceIndex] != text[destinationIndex] && shuffled[destinationIndex] != text[sourceIndex]) {
                    char tmp = shuffled[sourceIndex];
                    shuffled[sourceIndex] = shuffled[destinationIndex];
                    shuffled[destinationIndex] = tmp;
                    break;
                }
        }
    }
    [original: text, shuffled: shuffled.join(""), score: score(text, shuffled)]
}

def score(original, shuffled) {
    int score = 0
    original.eachWithIndex { character, index ->
        if (character == shuffled[index]) {
            score++
        }
    }
    score
}

["abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"].each { text ->
    def result = shuffle(text)
    println "${result.original}, ${result.shuffled}, (${result.score})"
}


MODULE BinaryDigits;
IMPORT StdLog,Strings;

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


include "cowgol.coh";

sub print_binary(n: uint32) is
    var buffer: uint8[33];
    var p := &buffer[32];
    [p] := 0;

    while n != 0 loop
        p := @prev p;
        [p] := ((n as uint8) & 1) + '0';
        n := n >> 1;
    end loop;

    print(p);
    print_nl();
end sub;

print_binary(5);
print_binary(50);
print_binary(9000);


go =>

  N = 1000,
  Fib = [fib(I) : I in 1..N],
  check_benford(Fib),
  nl.

% Check a list of numbers for Benford's law
check_benford(L) =>
  Len = L.len,
  println(len=Len),
  Count = [F[1].to_integer() : Num in L, F=Num.to_string()].occurrences(),
  P = new_map([I=D/Len : I=D in Count]),
  println("Benford (percent):"),
  foreach(D in 1..9)
    B = benford(D)*100,
    PI = P.get(D,0)*100,
    Diff = abs(PI - B),
    printf("%d: count=%5d observed: %0.2f%% Benford: %0.2f%% diff=%0.3f\n", D,Count.get(D,0),PI,B,Diff)
  end,
  nl.

benford(D) = log10(1+1/D).

% create an occurrences map of a list
occurrences(List) = Map =>
  Map = new_map(),
  foreach(E in List)
     Map.put(E, cond(Map.has_key(E),Map.get(E)+1,1))
  end.


(scl 4)
(load "@lib/misc.l")
(load "@lib/math.l")

(setq LOG10E 0.4343)

(de fibo (N)
   (let (A 0  B 1  C NIL)
      (make
         (link B)
         (do (dec N)
            (setq  C (+ A B)  A B  B C)
            (link B)))))

(setq Actual
   (let (
      Digits (sort (mapcar '((N) (format (car (chop N)))) (fibo 1000)))
      Count  0
   )
   (make
      (for (Ds Digits  Ds  (cdr Ds))
         (inc 'Count)
         (when (n== (car Ds) (cadr Ds))
            (link Count)
            (setq Count 0))))))

(setq Expected
   (mapcar
      '((D) (*/ (log (+ 1. (/ 1. D))) LOG10E 1.))
      (range 1 9)))

(prinl "Digit\tActual\tExpected")
(let (As Actual  Bs Expected)
   (for D 9
      (prinl D "\t" (format (pop 'As) 3) "\t" (round (pop 'Bs) 3))))

(bye)


(fofl, size, subrg):
Benford: procedure options(main);                /* 20 October 2013 */
   declare sc(1000) char(1), f(1000) float (16);
   declare d fixed (1);

   call Fibonacci(f);
   call digits(sc, f);

   put skip list ('digit  expected     obtained');
   do d= 1 upthru 9;
      put skip edit (d, log10(1 + 1/d), tally(sc, trim(d))/1000)
         (f(3), 2 f(13,8) );
   end;

Fibonacci: procedure (f);
   declare f(*) float (16);
   declare i fixed binary;

   f(1), f(2) = 1;
   do i = 3 to 1000;
      f(i) = f(i-1) + f(i-2);
   end;
end Fibonacci;

digits: procedure (sc, f);
   declare sc(*) char(1), f(*) float (16);
   sc = substr(trim(f), 1, 1);
end digits;

tally: procedure (sc, d) returns (fixed binary);
   declare sc(*) char(1), d char(1);
   declare (i, t) fixed binary;
   t = 0;
   do i = 1 to 1000;
      if sc(i) = d then t = t + 1;
   end;
   return (t);
end tally;
end Benford;


WITH recursive
constant(val) AS
(
SELECT 1000.
)
,
fib(a,b) AS
(
SELECT CAST(0 AS NUMERIC), CAST(1 AS NUMERIC)
UNION ALL
SELECT b,a+b
FROM fib
)
,
benford(first_digit, probability_real, probability_theoretical) AS
(
SELECT *,
	CAST(log(1. + 1./CAST(first_digit AS INT)) AS NUMERIC(5,4)) probability_theoretical
FROM (
	SELECT  first_digit, CAST(COUNT(1)/(SELECT val FROM constant) AS NUMERIC(5,4)) probability_real FROM
	(
		SELECT SUBSTRING(CAST(a AS VARCHAR(100)),1,1) first_digit
		FROM fib
		WHERE SUBSTRING(CAST(a AS VARCHAR(100)),1,1) <> '0'
		LIMIT (SELECT val FROM constant)
	) t
	GROUP BY first_digit
) f
ORDER BY first_digit ASC
)
SELECT *
FROM benford CROSS JOIN
     (SELECT CAST(corr(probability_theoretical,probability_real) AS NUMERIC(5,4)) correlation
      FROM benford) c


shufflingQuality l1 l2 = length $ filter id $ zipWith (==) l1 l2

printTest prog = mapM_ test texts
  where
    test s = do
      x <- prog s
      putStrLn $ unwords $ [ show s
                           , show x
                           , show $ shufflingQuality s x]
    texts = [ "abba", "abracadabra", "seesaw", "elk" , "grrrrrr"
            , "up", "a", "aaaaa.....bbbbb"
            , "Rosetta Code is a programming chrestomathy site." ]


# every !t :=: ?t    # Uncomment to get a random best shuffling


void main() {
    import std.stdio;

    foreach (immutable i; 0 .. 16)
        writefln("%b", i);
}


$url  = "https://oeis.org/A000045/b000045.txt"
$file = "$env:TEMP\FibonacciNumbers.txt"
(New-Object System.Net.WebClient).DownloadFile($url, $file)

$benford = Get-Content -Path $file |
         Select-Object -Skip 1 -First 1000 |
         ForEach-Object {(($_ -split " ")[1].ToString().ToCharArray())[0]} |
         Group-Object |
         Select-Object -Property @{Name="Digit"   ; Expression={[int]($_.Name)}},
                                 Count,
                                 @{Name="Actual"  ; Expression={$_.Count/1000}},
                                 @{Name="Expected"; Expression={[double]("{0:f5}" -f [Math]::Log10(1 + 1 / $_.Name))}}

$benford | Sort-Object -Property Digit | Format-Table -AutoSize

Remove-Item -Path $file -Force -ErrorAction SilentlyContinue


%_________________________________________________________________
% Does the Fibonacci sequence follow Benford's law?
%~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
% Fibonacci sequence generator
fib(C, [P,S], C, N)  :- N is P + S.
fib(C, [P,S], Cv, V) :- succ(C, Cn), N is P + S, !, fib(Cn, [S,N], Cv, V).

fib(0, 0).
fib(1, 1).
fib(C, N) :- fib(2, [0,1], C, N). % Generate from 3rd sequence on

% The benford law calculated
benford(D, Val) :- Val is log10(1+1/D).

% Retrieves the first characters of the first 1000 fibonacci numbers
%        (excluding zero)
firstchar(V) :-
	fib(C,N), N =\= 0, atom_chars(N, [Ch|_]), number_chars(V, [Ch]),
	(C>999-> !; true).

% Increment the n'th list item (1 based), result -> third argument.
incNth(1, [Dh|Dt], [Ch|Dt]) :- !, succ(Dh, Ch).
incNth(H, [Dh|Dt], [Dh|Ct]) :- succ(Hn, H), !, incNth(Hn, Dt, Ct).

% Calculate the frequency of the all the list items
freq([], D, D).
freq([H|T], D, C) :- incNth(H, D, L), !, freq(T, L, C).

freq([H|T], Freq) :-
	length([H|T], Len), min_list([H|T], Min), max_list([H|T], Max),
	findall(0, between(Min,Max,_), In),
	freq([H|T], In, F),	  % Frequency stored in F
	findall(N, (member(V, F), N is V/Len), Freq). % Normalise F->Freq

% Output the results
writeHdr :-
	format('~t~w~15| - ~t~w\n', ['Benford', 'Measured']).
writeData(Benford, Freq) :-
	format('~t~2f%~15| - ~t~2f%\n', [Benford*100, Freq*100]).

go :- % main goal
	findall(B, (between(1,9,N), benford(N,B)), Benford),
	findall(C, firstchar(C), Fc), freq(Fc, Freq),
	writeHdr, maplist(writeData, Benford, Freq).


bestShuf =: verb define
  yy=. <@({~ [email protected]#)@[email protected]= y
  y C.~ (;yy) </.~ (i.#y) |~ >./#@> yy
)

fmtBest=:3 :0
  b=. bestShuf y
  y,', ',b,' (',')',~":+/b=y
)


import java.util.Random;

public class BestShuffle {
    private final static Random rand = new Random();

    public static void main(String[] args) {
        String[] words = {"abracadabra", "seesaw", "grrrrrr", "pop", "up", "a"};
        for (String w : words)
            System.out.println(bestShuffle(w));
    }

    public static String bestShuffle(final String s1) {
        char[] s2 = s1.toCharArray();
        shuffle(s2);
        for (int i = 0; i < s2.length; i++) {
            if (s2[i] != s1.charAt(i))
                continue;
            for (int j = 0; j < s2.length; j++) {
                if (s2[i] != s2[j] && s2[i] != s1.charAt(j) && s2[j] != s1.charAt(i)) {
                    char tmp = s2[i];
                    s2[i] = s2[j];
                    s2[j] = tmp;
                    break;
                }
            }
        }
        return s1 + " " + new String(s2) + " (" + count(s1, s2) + ")";
    }

    public static void shuffle(char[] text) {
        for (int i = text.length - 1; i > 0; i--) {
            int r = rand.nextInt(i + 1);
            char tmp = text[i];
            text[i] = text[r];
            text[r] = tmp;
        }
    }

    private static int count(final String s1, final char[] s2) {
        int count = 0;
        for (int i = 0; i < s2.length; i++)
            if (s1.charAt(i) == s2[i])
                count++;
        return count;
    }
}


String binary(int n) {
  if(n<0)
    throw new IllegalArgumentException("negative numbers require 2s complement");
  if(n==0) return "0";
  String res="";
  while(n>0) {
    res=(n%2).toString()+res;
    n=(n/2).toInt();
  }
  return res;
}

main() {
  print(binary(0));
  print(binary(1));
  print(binary(5));
  print(binary(10));
  print(binary(50));
  print(binary(9000));
  print(binary(65535));
  print(binary(0xaa5511ff));
  print(binary(0x123456789abcde));
  // fails due to precision limit
  print(binary(0x123456789abcdef));
}


#MAX_N=1000
NewMap d1.i()
Dim fi.s(#MAX_N)
fi(0)="0" : fi(1)="1"
Declare.s Sigma(sx.s,sy.s)

For I=2 To #MAX_N
  fi(I)=Sigma(fi(I-2),fi(I-1))
Next

For I=1 To #MAX_N
  d1(Left(fi(I),1))+1
Next

Procedure.s Sigma(sx.s, sy.s)
  Define i.i, v1.i, v2.i, r.i
  Define s.s, sa.s
  sy=ReverseString(sy) : s=ReverseString(sx)
  For i=1 To Len(s)*Bool(Len(s)>Len(sy))+Len(sy)*Bool(Len(sy)>=Len(s))
    v1=Val(Mid(s,i,1))
    v2=Val(Mid(sy,i,1))
    r+v1+v2
    sa+Str(r%10)
    r/10
  Next i
  If r : sa+Str(r%10) : EndIf
  ProcedureReturn ReverseString(sa)
EndProcedure

OpenConsole("Benford's law: Fibonacci sequence 1.."+Str(#MAX_N))

Print(~"Dig.\t\tCnt."+~"\t\tExp.\t\tDif.\n\n")
ForEach d1()
  Print(RSet(MapKey(d1()),4," ")+~"\t:\t"+RSet(Str(d1()),3," ")+~"\t\t")
  ex=Int(#MAX_N*Log(1+1/Val(MapKey(d1())))/Log(10))
  PrintN(RSet(Str(ex),3," ")+~"\t\t"+RSet(StrF((ex-d1())*100/ex,5),8," ")+" %")
Next

PrintN(~"\nPress Enter...")
Input()


function raze(a) { // like .join('') except producing an array instead of a string
    var r= [];
    for (var j= 0; j<a.length; j++)
        for (var k= 0; k<a[j].length; k++)  r.push(a[j][k]);
    return r;
}
function shuffle(y) {
    var len= y.length;
    for (var j= 0; j < len; j++) {
        var i= Math.floor(Math.random()*len);
        var t= y[i];
        y[i]= y[j];
        y[j]= t;
    }
    return y;
}
function bestShuf(txt) {
    var chs= txt.split('');
    var gr= {};
    var mx= 0;
    for (var j= 0; j<chs.length; j++) {
        var ch= chs[j];
        if (null == gr[ch])  gr[ch]= [];
        gr[ch].push(j);
        if (mx < gr[ch].length)  mx++;
    }
    var inds= [];
    for (var ch in gr)  inds.push(shuffle(gr[ch]));
    var ndx= raze(inds);
    var cycles= [];
    for (var k= 0; k < mx; k++)  cycles[k]= [];
    for (var j= 0; j<chs.length; j++)  cycles[j%mx].push(ndx[j]);
    var ref= raze(cycles);
    for (var k= 0; k < mx; k++)  cycles[k].push(cycles[k].shift());
    var prm= raze(cycles);
    var shf= [];
    for (var j= 0; j<chs.length; j++)  shf[ref[j]]= chs[prm[j]];
    return shf.join('');
}

function disp(ex) {
    var r= bestShuf(ex);
    var n= 0;
    for (var j= 0; j<ex.length; j++)
        n+= ex.substr(j, 1) == r.substr(j,1) ?1 :0;
    return ex+', '+r+', ('+n+')';
}


program BinaryDigit;
{$APPTYPE CONSOLE}
uses
  sysutils;

function IntToBinStr(AInt : LongWord) : string;
begin
  Result := '';
  repeat
    Result := Chr(Ord('0')+(AInt and 1))+Result;
    AInt := AInt div 2;
  until (AInt = 0);
end;

Begin
  writeln('   5: ',IntToBinStr(5));
  writeln('  50: ',IntToBinStr(50));
  writeln('9000: '+IntToBinStr(9000));
end.


from __future__ import division
from itertools import islice, count
from collections import Counter
from math import log10
from random import randint

expected = [log10(1+1/d) for d in range(1,10)]

def fib():
    a,b = 1,1
    while True:
        yield a
        a,b = b,a+b

# powers of 3 as a test sequence
def power_of_threes():
    return (3**k for k in count(0))

def heads(s):
    for a in s: yield int(str(a)[0])

def show_dist(title, s):
    c = Counter(s)
    size = sum(c.values())
    res = [c[d]/size for d in range(1,10)]

    print("\n%s Benfords deviation" % title)
    for r, e in zip(res, expected):
        print("%5.1f%% %5.1f%%  %5.1f%%" % (r*100., e*100., abs(r - e)*100.))

def rand1000():
    while True: yield randint(1,9999)

if __name__ == '__main__':
    show_dist("fibbed", islice(heads(fib()), 1000))
    show_dist("threes", islice(heads(power_of_threes()), 1000))

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


pbenford <- function(d){
  return(log10(1+(1/d)))
}

get_lead_digit <- function(number){
  return(as.numeric(substr(number,1,1)))
}

fib_iter <- function(n){
  first <- 1
  second <- 0
  for(i in 1:n){
    sum <- first + second
    first <- second
    second <- sum
  }
  return(sum)
}

fib_sequence <- mapply(fib_iter,c(1:1000))
lead_digits <- mapply(get_lead_digit,fib_sequence)

observed_frequencies <- table(lead_digits)/1000
expected_frequencies <- mapply(pbenford,c(1:9))

data <- data.frame(observed_frequencies,expected_frequencies)
colnames(data) <- c("digit","obs.frequency","exp.frequency")
dev_percentage <- abs((data$obs.frequency-data$exp.frequency)*100)
data <- data.frame(data,dev_percentage)

print(data)


def count(s): reduce s as $i (0;.+1);

def swap($i;$j):
  .[$i] as $x | .[$i] = .[$j] | .[$j] = $x;

# Input: an array
# Output: a best shuffle
def bestShuffleArray:
  . as $s
  | reduce range(0; length) as $i (.;
      . as $t
      | (first(range(0; length)
               | select( $i != . and
                         $t[$i] != $s[.] and
                         $s[$i] != $t[.] and
                         $t[$i] != $t[.])) as $j
         | swap($i;$j))
	 // $t  # fallback
    );

# Award 1 for every spot which changed:
def score($base):
  . as $in
  | count( range(0;length)
           | select($base[.] != $in[.]) );

# Input: a string
# Output: INPUT, BESTSHUFFLE, (NUMBER)
def bestShuffle:
  . as $in
  | explode
  | . as $s
  | bestShuffleArray
  | "\($in), \(implode), (\( length - score($s) ))" ;


# v0.6

function bestshuffle(str::String)::Tuple{String,Int}
    s = Vector{Char}(str)

    # Count the supply of characters.
    cnt = Dict{Char,Int}(c => 0 for c in s)
    for c in s; cnt[c] += 1 end

    # Allocate the result
    r = similar(s)
    for (i, x) in enumerate(s)
        # Find the best character to replace x.
        best = x
        rankb = -2
        for (c, rankc) in cnt
            # Prefer characters with more supply.
            # (Save characters with less supply.)
            # Avoid identical characters.
            if c == x; rankc = -1 end
            if rankc > rankb
                best = c
                rankb = rankc
            end
        end

        # Add character to list. Remove it from supply.
        r[i] = best
        cnt[best] -= 1
        if cnt[best] == 0; delete!(cnt, best) end
    end

    # If the final letter became stuck (as "ababcd" became "bacabd",
    # and the final "d" became stuck), then fix it.
    i = length(s)
    if r[i] == s[i]
        for j in 1:i
            if r[i] != s[j] && r[j] != s[i]
                r[i], r[j] = r[j], r[i]
                break
            end
        end
    end

    score = sum(x == y for (x, y) in zip(r, s))
    return r, score
end

for word in ("abracadabra", "seesaw", "elk", "grrrrrr", "up", "a")
    shuffled, score = bestshuffle(word)
    println("$word: $shuffled ($score)")
end


func to2 n . r$ .
  if n > 0
    call to2 n div 2 r$
    if n mod 2 = 0
      r$ &= "0"
    else
      r$ &= "1"
    .
  else
    r$ = ""
  .
.
func pr2 n . .
  call to2 n r$
  if r$ = ""
    print "0"
  else
    print r$
  .
.
call pr2 5
call pr2 50
call pr2 9000


;; primitive : (number->string number [base]) - default base = 10

(number->string 2 2)
→ 10

(for-each (compose writeln (rcurry number->string 2)) '( 5 50 9000)) →
101
110010
10001100101000


import system'routines;
import extensions;

public program()
{
    new int[]{5,50,9000}.forEach:(n)
    {
        console.printLine(n.toString(2))
    }
}


#lang racket

(define (log10 n) (/ (log n) (log 10)))

(define (first-digit n)
  (quotient n (expt 10 (inexact->exact (floor (log10 n))))))

(define N 10000)

(define fibs
  (let loop ([n N] [a 0] [b 1])
    (if (zero? n) '() (cons b (loop (sub1 n) b (+ a b))))))

(define v (make-vector 10 0))
(for ([n fibs])
  (define f (first-digit n))
  (vector-set! v f (add1 (vector-ref v f))))

(printf "N   OBS   EXP\n")
(define (pct n) (~r (* n 100.0) #:precision 1 #:min-width 4))
(for ([i (in-range 1 10)])
  (printf "~a: ~a% ~a%\n" i
          (pct (/ (vector-ref v i) N))
          (pct (log10 (+ 1 (/ i))))))

;; Output:
;; N   OBS   EXP
;; 1: 30.1% 30.1%
;; 2: 17.6% 17.6%
;; 3: 12.5% 12.5%
;; 4:  9.7%  9.7%
;; 5:  7.9%  7.9%
;; 6:  6.7%  6.7%
;; 7:  5.8%  5.8%
;; 8:  5.1%  5.1%
;; 9:  4.6%  4.6%


sub benford(@a) { bag +« @a».substr(0,1) }

sub show(%distribution) {
    printf "%9s %9s  %s\n", <Actual Expected Deviation>;
    for 1 .. 9 -> $digit {
        my $actual = %distribution{$digit} * 100 / [+] %distribution.values;
        my $expected = (1 + 1 / $digit).log(10) * 100;
        printf "%d: %5.2f%% | %5.2f%% | %.2f%%\n",
          $digit, $actual, $expected, abs($expected - $actual);
    }
}

multi MAIN($file) { show benford $file.IO.lines }
multi MAIN() { show benford ( 1, 1, 2, *+* ... * )[^1000] }


/*REXX pgm demonstrates Benford's law applied to 2 common functions (30 dec. digs used).*/
numeric digits length( e() )  -  length(.)       /*width of (e)  for LN & LOG precision.*/
parse arg N .;  if N=='' | N==","  then N= 1000  /*allow sample size to be specified.   */
pad= "   "                                       /*W1, W2: # digs past the decimal point*/
w1= max(2 + length('observed'), length(N-2) )    /*for aligning output for a number.    */
w2= max(2 + length('expected'), length(N  ) )    /* "      "    frequency distributions.*/
LN10= ln(10)                                     /*calculate the  ln(10)   {used by LOG}*/
call coef                                        /*generate nine frequency coefficients.*/
call fib                                         /*generate   N   Fibonacci numbers.    */
call show "Benford's law applied to"      N      'Fibonacci numbers'
call fact                                        /*generate   N   factorials.           */
call show "Benford's law applied to"      N      'factorial products'
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
coef:       do j=1  for 9; #.j=pad center(format(log(1+1/j),,length(N)+2),w2); end; return
fact: @.=1; do j=2  for N-1;       a= j-1;                   @.j= @.a * j;     end; return
fib:  @.=1; do j=3  for N-2;       a= j-1;       b= a-1;     @.j= @.a + @.b;   end; return
e:    return 2.71828182845904523536028747135266249775724709369995957496696762772407663035
log:  return   ln( arg(1) )    /   LN10
/*──────────────────────────────────────────────────────────────────────────────────────*/
ln: procedure; parse arg x; e= e();  _= e;  ig= (x>1.5);  is= 1 - 2 * (ig\=1); i= 0;  s= x
      do while ig&s>1.5  |  \ig&s<.5             /*nitty─gritty part of  LN  calculation*/
        do k=-1; iz=s*_**-is; if k>=0&(ig&iz<1|\ig&iz>.5)  then leave; _=_*_; izz=iz;  end
      s=izz;  i= i + is* 2**k; end  /*while*/;    x= x * e** - i - 1;  z= 0;  _= -1;  p= z
        do k=1;  _= -_ * x; z= z + _/k; if z=p  then leave;  p= z;  end /*k*/;  return z+i
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: say;  say pad   ' digit '    pad   center("observed",w1)  pad  center('expected',w2)
      say pad  '───────'   pad   center("", w1, '─')  pad  center("",w2,'─')   pad  arg(1)
      !.=0;     do j=1  for N;   _= left(@.j, 1);     !._= !._ + 1  /*get the 1st digit.*/
                end   /*j*/
        do f=1  for 9;  say pad center(f,7) pad center(format(!.f/N,,length(N-2)),w1)  #.f
        end   /*k*/
      return


import java.util.Random

object BestShuffle {
    operator fun invoke(s1: String) : String {
        val s2 = s1.toCharArray()
        s2.shuffle()
        for (i in s2.indices)
            if (s2[i] == s1[i])
                for (j in s2.indices)
                    if (s2[i] != s2[j] && s2[i] != s1[j] && s2[j] != s1[i]) {
                        val tmp = s2[i]
                        s2[i] = s2[j]
                        s2[j] = tmp
                        break
                    }
        return s1 + ' ' + String(s2) + " (" + s2.count(s1) + ')'
    }

    private fun CharArray.shuffle() {
        val rand = Random()
        for (i in size - 1 downTo 1) {
            val r = rand.nextInt(i + 1)
            val tmp = this[i]
            this[i] = this[r]
            this[r] = tmp
        }
    }

    private fun CharArray.count(s1: String) : Int {
        var count = 0
        for (i in indices)
            if (s1[i] == this[i]) count++
        return count
    }
}

fun main(words: Array<String>) = words.forEach { println(BestShuffle(it)) }


fn bin(a,b:true)
	var c:""
	while a>0 do
		c,a:tostring(a%2)+c,bit.rshift(a,1)
	cls
	if b then
		c:string.repeat("0",16-#c)+c
	cls
	return c
cls

var List: [5,50,9000]

iter Value of List do
	log(Value+": "+bin(Value,false))
cls


# Project : Benford's law

decimals(3)
n= 1000
actual = list(n)
for x = 1 to len(actual)
     actual[x] = 0
next

for nr = 1 to n
     n1 = string(fibonacci(nr))
     j = number(left(n1,1))
     actual[j] = actual[j] + 1
next

see "Digit   " + "Actual   " + "Expected" + nl
for m = 1 to 9
     fr = frequency(m)*100
     see "" + m + "   " + (actual[m]/10) + "   " + fr + nl
next

func frequency(n)
      freq = log10(n+1) - log10(n)
      return freq

func log10(n)
      log1 = log(n) / log(10)
      return log1

func fibonacci(y)
       if y = 0 return 0 ok
       if y = 1 return 1 ok
       if y > 1 return fibonacci(y-1) + fibonacci(y-2) ok


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

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

# powers of 3 as a test sequence
def power_of_threes(n)
  n.times.map{|k| 3**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}
  size = s.size.to_f
  res = (1..9).map{|d| c[d]/size}
  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)
  n.times.map{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))


'see Run BASIC solution
list$ = "abracadabra seesaw pop grrrrrr up a"

while word$(list$,ii + 1," ") <> ""
 ii    = ii + 1
 w$    = word$(list$,ii," ")
 bs$   = bestShuffle$(w$)
 count = 0
 for i = 1 to len(w$)
  if mid$(w$,i,1) = mid$(bs$,i,1) then count = count + 1
 next i
 print  w$;" ";bs$;" ";count
wend

function bestShuffle$(s1$)
   s2$   = s1$
   for i = 1 to len(s2$)
        for j =  1 to len(s2$)
            if (i <> j) and (mid$(s2$,i,1) <> mid$(s1$,j,1)) and (mid$(s2$,j,1) <> mid$(s1$,i,1)) then
            if j < i then i1 = j:j1 = i else i1 = i:j1 = j
            s2$ = left$(s2$,i1-1) + mid$(s2$,j1,1) + mid$(s2$,i1+1,(j1-i1)-1) + mid$(s2$,i1,1) + mid$(s2$,j1+1)
            end if
        next j
   next i
bestShuffle$ = s2$
end function


function toBinary(integer i)
    sequence s
    s = {}
    while i do
        s = prepend(s, '0'+and_bits(i,1))
        i = floor(i/2)
    end while
    return s
end function

puts(1, toBinary(5) & '\n')
puts(1, toBinary(50) & '\n')
puts(1, toBinary(9000) & '\n')


open System
for i in [5; 50; 9000] do printfn "%s" <| Convert.ToString (i, 2)


N	= 1000
for i = 0 to N - 1
    n$	= str$(fibonacci(i))
    j	= val(left$(n$,1))
    actual(j) = actual(j) +1
next
print
html "

DigitActualExpected
"
for i = 1 to 9
   html "
";i;"	";using("##.###",actual(i)/10);"	";using("##.###", frequency(i)*100);"
"
next
html "
"
end

function frequency(n)
    frequency = log10(n+1) - log10(n)
end function

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

function fibonacci(n)
    b = 1
    for i = 1 to n
        temp		= fibonacci + b
        fibonacci	= b
        b		= temp
    next i
end function


extern crate num_traits;
extern crate num;

use num::bigint::{BigInt, ToBigInt};
use num_traits::{Zero, One};
use std::collections::HashMap;

// Return a vector of all fibonacci results from fib(1) to fib(n)
fn fib(n: usize) -> Vec<BigInt> {
    let mut result = Vec::with_capacity(n);
    let mut a = BigInt::zero();
    let mut b = BigInt::one();

    result.push(b.clone());

    for i in 1..n {
        let t = b.clone();
        b = a+b;
        a = t;
        result.push(b.clone());
    }

    result
}

// Return the first digit of a `BigInt`
fn first_digit(x: &BigInt) -> u8 {
    let zero = BigInt::zero();
    assert!(x > &zero);

    let s = x.to_str_radix(10);

    // parse the first digit of the stringified integer
    *&s[..1].parse::<u8>().unwrap()
}

fn main() {
    const N: usize = 1000;
    let mut counter: HashMap<u8, u32> = HashMap::new();
    for x in fib(N) {
        let d = first_digit(&x);
        *counter.entry(d).or_insert(0) += 1;
    }

    println!("{:>13}    {:>10}", "real", "predicted");
    for y in 1..10 {
        println!("{}: {:10.3} v. {:10.3}", y, *counter.get(&y).unwrap_or(&0) as f32 / N as f32,
        (1.0 + 1.0 / (y as f32)).log10());
    }

}


// Fibonacci Sequence (begining with 1,1): 1 1 2 3 5 8 13 21 34 55 ...
val fibs : Stream[BigInt] = { def series(i:BigInt,j:BigInt):Stream[BigInt] = i #:: series(j, i+j); series(1,0).tail.tail }

/**
 * Given a numeric sequence, return the distribution of the most-signicant-digit
 * as expected by Benford's Law and then by actual distribution.
 */
def benford[N:Numeric]( data:Seq[N] ) : Map[Int,(Double,Double)] = {

  import scala.math._

  val maxSize = 10000000  // An arbitrary size to avoid problems with endless streams

  val size = (data.take(maxSize)).size.toDouble

  val distribution = data.take(maxSize).groupBy(_.toString.head.toString.toInt).map{ case (d,l) => (d -> l.size) }

  (for( i <- (1 to 9) ) yield { (i -> (log10(1D + 1D / i), (distribution(i) / size))) }).toMap
}

{
  println( "Fibonacci Sequence (size=1000): 1 1 2 3 5 8 13 21 34 55 ...\n" )
  println( "%9s %9s %9s".format( "Actual", "Expected", "Deviation" ) )

  benford( fibs.take(1000) ).toList.sorted foreach {
    case (k, v) => println( "%d: %5.2f%% | %5.2f%% | %5.4f%%".format(k,v._2*100,v._1*100,math.abs(v._2-v._1)*100) )
  }
}


math.randomseed(os.time())

local function shuffle(t)
  for i = #t, 2, -1 do
    local j = math.random(i)
    t[i], t[j] = t[j], t[i]
  end
end

local function bestshuffle(s, r)
  local order, shufl, count = {}, {}, 0
  for ch in s:gmatch(".") do order[#order+1], shufl[#shufl+1] = ch, ch end
  if r then shuffle(shufl) end
  for i = 1, #shufl do
    for j = 1, #shufl do
      if i ~= j and shufl[i] ~= order[j] and shufl[j] ~= order[i] then
        shufl[i], shufl[j] = shufl[j], shufl[i]
      end
    end
  end
  for i = 1, #shufl do
    if shufl[i] == order[i] then
      count = count + 1
    end
  end
  return table.concat(shufl), count
end

local words = { "abracadabra", "seesaw", "elk", "grrrrrr", "up", "a" }

local function test(r)
  print(r and "RANDOM:" or "DETERMINISTIC:")
  for _, word in ipairs(words) do
    local shufl, count = bestshuffle(word, r)
    print(string.format("%s, %s, (%d)", word, shufl, count))
  end
  print()
end

test(true)
test(false)


USING: io kernel math math.parser ;

5 >bin print
50 >bin print
9000 >bin print


#AppType Console
function Bin(byval n as integer, byval s as string = "") as string
	if n > 0 then return Bin(n \ 2, (n mod 2) & s)
	if s = "" then return "0"
	return s
end function

print Bin(5)
print Bin(50)
print Bin(9000)

pause


; Compute the probability of leading digit d (an integer [1,9]) according to Benford's law.

(define benford-probability
  (lambda (d)
    (- (log (1+ d) 10) (log d 10))))

; Determine the distribution of the leading digit of the sequence provided by the given
; generator.  Return as a vector of 10 elements -- the 0th element will always be 0.

(define leading-digit-distribution
  (lambda (seqgen count)
    (let ((digcounts (make-vector 10 0)))
      (do ((index 0 (1+ index)))
          ((>= index count))
        (let* ((value (seqgen))
               (string (format "~a" value))
               (leadchr (string-ref string 0))
               (leaddig (- (char->integer leadchr) (char->integer #\0))))
          (vector-set! digcounts leaddig (1+ (vector-ref digcounts leaddig)))))
      (vector-map (lambda (digcnt) (/ digcnt count)) digcounts))))

; Create a Fibonacci sequence generator.

(define make-fibgen
  (lambda ()
    (let ((fn-2 0) (fn-1 1))
      (lambda ()
        (let ((fn fn-1))
          (set! fn-1 (+ fn-2 fn-1))
          (set! fn-2 fn)
          fn)))))

; Create a sequence generator that returns elements of the given vector.

(define make-vecgen
  (lambda (vector)
    (let ((index 0))
      (lambda ()
        (set! index (1+ index))
        (vector-ref vector (1- index))))))

; Read all the values in the given file into a list.

(define list-read-file
  (lambda (filenm)
    (call-with-input-file filenm
      (lambda (ip)
        (let accrue ((value (read ip)))
          (if (eof-object? value)
            '()
            (cons value (accrue (read ip)))))))))

; Display a table of digit, Benford's law, sequence distribution, and difference.

(define display-table
  (lambda (seqnam seqgen count)
    (printf "~%[email protected] [email protected] [email protected] [email protected]~%" "dig" "Benford's" seqnam "difference")
    (let ((dist (leading-digit-distribution seqgen count)))
      (do ((digit 1 (1+ digit)))
          ((> digit 9))
        (let* ((fraction (vector-ref dist digit))
               (benford (benford-probability digit))
               (diff (- fraction benford)))
          (printf "~3d ~11,5f ~11,5f ~11,5f~%" digit benford fraction diff))))))

; Emit tables of various sequence distributions.

(display-table "Fib/1000" (make-fibgen) 1000)
(display-table "Rnd/1T/1M" (lambda () (1+ (random 1000000000000))) 1000000)
(let ((craters (list->vector (list-read-file "moon_craters.lst"))))
  (display-table "Craters/D" (make-vecgen craters) (vector-length craters)))


BestShuffle[data_] :=
 Flatten[{data,First[SortBy[
     List[#, StringLength[data]-HammingDistance[#,data]] & /@ StringJoin /@ Permutations[StringSplit[data, ""]], Last]]}]

Print[#[[1]], "," #[[2]], ",(", #[[3]], ")"] & /@  BestShuffle /@ {"abracadabra","seesaw","elk","grrrrrr","up","a"}


import times
import sequtils
import strutils
import random

proc count(s1, s2: string): int =
    for i, c in s1:
        if c == s2[i]:
            result.inc

proc shuffle(str: string): string =
    var r = initRand(getTime().toUnix())
    var chrs = toSeq(str.items)
    for i in 0 ..< chrs.len:
        let chosen = r.rand(chrs.len-1)
        swap(chrs[i], chrs[chosen])
    return chrs.join("")

proc bestShuffle(str: string): string =
    var chrs = toSeq(shuffle(str).items)
    for i in chrs.low .. chrs.high:
        if chrs[i] != str[i]:
            continue
        for j in chrs.low .. chrs.high:
            if chrs[i] != chrs[j] and chrs[i] != str[j] and chrs[j] != str[i]:
                swap(chrs[i], chrs[j])
                break
    return chrs.join("")

when isMainModule:
    let words = @["abracadabra", "seesaw", "grrrrrr", "pop", "up", "a", "antidisestablishmentarianism"];
    for w in words:
        let shuffled = bestShuffle(w)
        echo "$1 $2 $3" % [w, shuffled, $count(w, shuffled)]


\ Forth uses a system variable 'BASE' for number conversion

\ HEX is a standard word to change the value of base to 16
\ DECIMAL is a standard word to change the value of base to 10

\ we can easily compile a word into the system to set 'BASE' to 2

  : binary  2 base ! ;

\ interactive console test with conversion and binary masking example

hex 0FF binary . cr
decimal 679 binary . cr

binary  11111111111  00000110000  and . cr

decimal


!-*- mode: compilation; default-directory: "/tmp/" -*-
!Compilation started at Sun May 19 23:14:14
!
!a=./F && make $a && $a < unixdict.txt
!f95 -Wall -ffree-form F.F -o F
!101
!110010
!10001100101000
!
!Compilation finished at Sun May 19 23:14:14
!
!
!   tobin=: -.&' '@":@#:
!   tobin 5
!101
!   tobin 50
!110010
!   tobin 9000
!10001100101000

program bits
  implicit none
  integer, dimension(3) :: a
  integer :: i
  data a/5,50,9000/
  do i = 1, 3
    call s(a(i))
  enddo

contains

  subroutine s(a)
    integer, intent(in) :: a
    integer :: i
    if (a .eq. 0) then
      write(6,'(a)')'0'
      return
    endif
    do i = 31, 0, -1
      if (btest(a, i)) exit
    enddo
    do while (0 .lt. i)
      if (btest(a, i)) then
        write(6,'(a)',advance='no')'1'
      else
        write(6,'(a)',advance='no')'0'
      endif
      i = i-1
    enddo
    if (btest(a, i)) then
      write(6,'(a)')'1'
    else
      write(6,'(a)')'0'
    endif
  end subroutine s

end program bits


var (actuals, expected) = ([], [])
var fibonacci = 1000.of {|i| fib(i).digit(0) }

for i (1..9) {
    var num = fibonacci.count_by {|j| j == i }
    actuals.append(num / 1000)
    expected.append(1 + (1/i) -> log10)
}

"%17s%17s\n".printf("Observed","Expected")
for i (1..9) {
    "%d : %11s %%%15s %%\n".printf(
            i, "%.2f".sprintf(100 *  actuals[i - 1]),
               "%.2f".sprintf(100 * expected[i - 1]),
    )
}


-- Create table
CREATE TABLE benford (num INTEGER);

-- Seed table
INSERT INTO benford (num) VALUES (1);
INSERT INTO benford (num) VALUES (1);
INSERT INTO benford (num) VALUES (2);

-- Populate table
INSERT INTO benford (num)
  SELECT
    ult + penult
  FROM
    (SELECT MAX(num) AS ult FROM benford),
    (SELECT MAX(num) AS penult FROM benford WHERE num NOT IN (SELECT MAX(num) FROM benford))

-- Repeat as many times as desired
--    in Oracle SQL*Plus, press "Slash, Enter" a lot of times
--    or wrap this in a loop, but that will require something db-specific...

-- Do sums
SELECT
  digit,
  COUNT(digit) / numbers AS actual,
  log(10, 1 + 1 / digit) AS expected
FROM
  (
    SELECT
      FLOOR(num/POWER(10,LENGTH(num)-1)) AS digit
    FROM
      benford
  ),
  (
    SELECT
      COUNT(*) AS numbers
    FROM
      benford
  )
GROUP BY digit, numbers
ORDER BY digit;

-- Tidy up
DROP TABLE benford;


let best_shuffle s =
  let len = String.length s in
  let r = String.copy s in
  for i = 0 to pred len do
    for j = 0 to pred len do
      if i <> j && s.[i] <> r.[j] && s.[j] <> r.[i] then
        begin
          let tmp = r.[i] in
          r.[i] <- r.[j];
          r.[j] <- tmp;
        end
    done;
  done;
  (r)

let count_same s1 s2 =
  let len1 = String.length s1
  and len2 = String.length s2 in
  let n = ref 0 in
  for i = 0 to pred (min len1 len2) do
    if s1.[i] = s2.[i] then incr n
  done;
  !n

let () =
  let test s =
    let s2 = best_shuffle s in
    Printf.printf " '%s', '%s' -> %d\n" s s2 (count_same s s2);
  in
  test "tree";
  test "abracadabra";
  test "seesaw";
  test "elk";
  test "grrrrrr";
  test "up";
  test "a";
;;


program binaryDigits(input, output, stdErr);
{$mode ISO}

function binaryNumber(const value: nativeUInt): shortString;
const
	one = '1';
var
	representation: shortString;
begin
	representation := binStr(value, bitSizeOf(value));
	// strip leading zeroes, if any; NB: mod has to be ISO compliant
	delete(representation, 1, (pos(one, representation)-1) mod bitSizeOf(value));
	// traditional Pascal fashion:
	// assign result to the (implicitely existent) variable
	// that is named like the function’s name
	binaryNumber := representation;
end;

begin
	writeLn(binaryNumber(5));
	writeLn(binaryNumber(50));
	writeLn(binaryNumber(9000));
end.


' FreeBASIC v1.05.0 win64
Dim As String fmt = "#### -> &"
Print Using fmt; 5; Bin(5)
Print Using fmt; 50; Bin(50)
Print Using fmt; 9000; Bin(9000)
Print
Print "Press any key to exit the program"
Sleep
End


import Foundation

/* Reads from a file and returns the content as a String */
func readFromFile(fileName file:String) -> String{

    var ret:String = ""

    let path = Foundation.URL(string: "file://"+file)

    do {
        ret = try String(contentsOf: path!, encoding: String.Encoding.utf8)
    }
    catch {
        print("Could not read from file!")
        exit(-1)
    }

    return ret
}

/* Calculates the probability following Benford's law */
func benford(digit z:Int) -> Double {

    if z<=0 || z>9 {
        perror("Argument must be between 1 and 9.")
        return 0
    }

    return log10(Double(1)+Double(1)/Double(z))
}

// get CLI input
if CommandLine.arguments.count < 2 {
    print("Usage: Benford [FILE]")
    exit(-1)
}

let pathToFile = CommandLine.arguments[1]

// Read from given file and parse into lines
let content = readFromFile(fileName: pathToFile)
let lines = content.components(separatedBy: "\n")

var digitCount:UInt64 = 0
var countDigit:[UInt64] = [0,0,0,0,0,0,0,0,0]

// check digits line by line
for line in lines {
    if line == "" {
        continue
    }
    let charLine = Array(line.characters)
        switch(charLine[0]){
            case "1":
                countDigit[0] += 1
                digitCount += 1
                break
            case "2":
                countDigit[1] += 1
                digitCount += 1
                break
            case "3":
                countDigit[2] += 1
                digitCount += 1
                break
            case "4":
                countDigit[3] += 1
                digitCount += 1
                break
            case "5":
                countDigit[4] += 1
                digitCount += 1
                break
            case "6":
                countDigit[5] += 1
                digitCount += 1
                break
            case "7":
                countDigit[6] += 1
                digitCount += 1
                break
            case "8":
                countDigit[7] += 1
                digitCount += 1
                break
            case "9":
                countDigit[8] += 1
                digitCount += 1
                break
            default:
                break
        }

}

// print result
print("Digit\tBenford [%]\tObserved [%]\tDeviation")
print("~~~~~\t~~~~~~~~~~~~\t~~~~~~~~~~~~\t~~~~~~~~~")
for i in 0..<9 {
    let temp:Double = Double(countDigit[i])/Double(digitCount)
    let ben = benford(digit: i+1)
    print(String(format: "%d\t%.2f\t\t%.2f\t\t%.4f", i+1,ben*100,temp*100,ben-temp))
}


proc benfordTest {numbers} {
    # Count the leading digits (RE matches first digit in each number,
    # even if negative)
    set accum {1 0 2 0 3 0 4 0 5 0 6 0 7 0 8 0 9 0}
    foreach n $numbers {
	if {[regexp {[1-9]} $n digit]} {
	    dict incr accum $digit
	}
    }

    # Print the report
    puts " digit | measured | theory"
    puts "-------+----------+--------"
    dict for {digit count} $accum {
	puts [format "%6d | %7.2f%% | %5.2f%%" $digit \
		  [expr {$count * 100.0 / [llength $numbers]}] \
		  [expr {log(1+1./$digit)/log(10)*100.0}]]
    }
}


program BestShuffleDemo(output);

function BestShuffle(s: string): string;

  var
    tmp: char;
    i, j: integer;
    t: string;
  begin
    t := s;
    for i := 1 to length(t) do
      for j := 1 to length(t) do
        if (i <> j) and (s[i] <> t[j]) and (s[j] <> t[i]) then
        begin
          tmp  := t[i];
          t[i] := t[j];
          t[j] := tmp;
        end;
    BestShuffle := t;
  end;

const
  original: array[1..6] of string =
    ('abracadabra', 'seesaw', 'elk', 'grrrrrr', 'up', 'a');

var
  shuffle: string;
  i, j, score: integer;

begin
 for i := low(original) to high(original) do
 begin
   shuffle := BestShuffle(original[i]);
   score := 0;
   for j := 1 to length(shuffle) do
     if original[i][j] = shuffle[j] then
       inc(score);
    writeln(original[i], ', ', shuffle, ', (', score, ')');
  end;
end.


fun main(x: i32): i64 =
  loop (out = 0i64) = for i < 32 do
    let digit = (x >> (31-i)) & 1
    let out = (out * 10i64) + i64(digit)
    in out
  in out


Sub BenfordLaw()

Dim BenResult(1 To 9) As Long

BENref = "30,1%|17,6%|12,5%|9,7%|7,9%|6,7%|5,8%|5,1%|4,6%"

For Each c In Selection.Cells
  If InStr(1, "-0123456789", Left(c, 1)) > 0 Then
    For i = 1 To 9
      If CInt(Left(Abs(c), 1)) = i Then BenResult(i) = BenResult(i) + 1: Exit For
    Next
  End If
Next
Total= Application.Sum(BenResult)
biggest= Len(CStr(BenResult(1)))

txt = "#   |   Values    |     Real     |  Expected   " & vbCrLf
For i = 1 To 9
  If BenResult(i) > 0 Then
    txt = txt & "#" & i & " | " & vbTab
    txt = txt & String((biggest - Len(CStr(BenResult(i)))) * 2, " ") & Format(BenResult(i), "0") & " | " & vbTab
    txt = txt & String((Len(CStr(Format(BenResult(1) / Total, "##0.0%"))) - Len(CStr(Format(BenResult(i) / Total, "##0.0%")))) * 2, " ") & Format(BenResult(i) / Total, "##0.0%") & " | " & vbTab
    txt = txt & Format(Split(BENref, "|")(i - 1), "     ##0.0%") & vbCrLf
  End If
Next

MsgBox txt, vbOKOnly, "Finish"

End Sub

}


#DEFINE CTAB CHR(9)
#DEFINE COMMA ","
#DEFINE CRLF CHR(13) + CHR(10)
LOCAL i As Integer, n As Integer, n1 As Integer, rho As Double, c As String
n = 1000
LOCAL ARRAY a[n,2], res[1]
CLOSE DATABASES ALL
CREATE CURSOR fibo(dig C(1))
INDEX ON dig TAG dig COLLATE "Machine"
SET ORDER TO 0
*!* Populate the cursor with the leading digit of the first 1000 Fibonacci numbers
a[1,1] = "1"
a[1,2] = 1
a[2,1] = "1"
a[2,2] = 1
FOR i = 3 TO n
    a[i,2] = a[i-2,2] + a[i-1,2]
    a[i,1] = LEFT(TRANSFORM(a[i,2]), 1)
ENDFOR
APPEND FROM ARRAY a FIELDS dig
CREATE CURSOR results (digit I, count I, prob B(6), expected B(6))
INSERT INTO results ;
SELECT dig, COUNT(1), COUNT(1)/n, Pr(VAL(dig)) FROM fibo GROUP BY dig ORDER BY dig
n1 = RECCOUNT()
*!* Correlation coefficient
SELECT (n1*SUM(prob*expected) - SUM(prob)*SUM(expected))/;
(SQRT(n1*SUM(prob*prob) - SUM(prob)*SUM(prob))*SQRT(n1*SUM(expected*expected) - SUM(expected)*SUM(expected))) ;
FROM results INTO ARRAY res
rho = CAST(res[1] As B(6))
SET SAFETY OFF
COPY TO benford.txt TYPE CSV
c = FILETOSTR("benford.txt")
*!* Replace commas with tabs
c = STRTRAN(c, COMMA, CTAB) + CRLF + "Correlation Coefficient: " + TRANSFORM(rho)
STRTOFILE(c, "benford.txt", 0)
SET SAFETY ON

FUNCTION Pr(d As Integer) As Double
RETURN LOG10(1 + 1/d)
ENDFUNC


import math

fn fib1000() []f64 {
    mut a, mut b, mut r := 0.0, 1.0, []f64{len:1000}
    for i in 0..r.len {
        r[i], a, b = b, b, b+a
    }
    return r
}

fn main() {
    show(fib1000(), "First 1000 Fibonacci numbers")
}

fn show(c []f64, title string) {
    mut f := [9]int{}
    for v in c {
        f["$v"[0]-'1'[0]]++
    }
    println(title)
    println("Digit  Observed  Predicted")
    for i, n in f {
        println("  ${i+1}  ${f64(n)/f64(c.len):9.3f}  ${math.log10(1+1/f64(i+1)):8.3f}")
    }
}


import "/fmt" for Fmt

var fib1000 = Fn.new {
    var a = 0
    var b = 1
    var r = List.filled(1000, 0)
    for (i in 0...r.count) {
        var oa = a
        var ob = b
        r[i] = ob
        a = ob
        b = ob + oa
    }
    return r
}

var LN10 = 2.3025850929940457

var log10 = Fn.new { |x| x.log / LN10 }

var show = Fn.new { |c, title|
    var f = List.filled(9, 0)
    for (v in c) {
        var t = "%(v)".bytes[0] - 49
        f[t] = f[t] + 1
    }
    System.print(title)
    System.print("Digit  Observed  Predicted")
    for (i in 0...f.count) {
        var n = f[i]
        var obs = Fmt.f(9, n/c.count, 3)
        var t = log10.call(1/(i + 1) + 1)
        var pred = Fmt.f(8, t, 3)
        System.print("  %(i+1) %(obs)  %(pred)")
    }
}

show.call(fib1000.call(), "First 1000 Fibonacci numbers:")


use strict;
use warnings;
use List::Util qw(shuffle);
use Algorithm::Permute;

best_shuffle($_) for qw(abracadabra seesaw elk grrrrrr up a);

sub best_shuffle {
	my ($original_word) = @_;
	my $best_word = $original_word;
	my $best_score = length $best_word;

	my @shuffled = shuffle split //, $original_word;
	my $iterator = Algorithm::Permute->new(\@shuffled);

	while( my @array = $iterator->next ) {
		my $word = join '', @array;
		# For each letter which is the same in the two words,
		# there will be a \x00 in the "^" of the two words.
		# The tr operator is then used to count the "\x00"s.
		my $score = ($original_word ^ $word) =~ tr/\x00//;
		next if $score >= $best_score;
		($best_word, $best_score) = ($word, $score);
		last if $score == 0;
	}

	print "$original_word, $best_word, $best_score\n";
}


Public Sub Main()
Dim siBin As Short[] = [5, 50, 9000]
Dim siCount As Short

For siCount = 0 To siBin.Max
  Print Bin(siBin[siCount])
Next

End


package main

import (
	"fmt"
)

func main() {
	for i := 0; i < 16; i++ {
		fmt.Printf("%b\n", i)
	}
}


show(  // use list (fib(1)...fib(1000)) --> (1..4.34666e+208)
   (0).pump(1000,List,fcn(ab){ab.append(ab.sum(0.0)).pop(0)}.fp(L(1,1))),
   "First 1000 Fibonacci numbers");

fcn show(data,title){
   f:=(0).pump(9,List,Ref.fp(0)); // (Ref(0),Ref(0)...
   foreach v in (data){ // eg  1.49707e+207 ("g" format) --> "1" (first digit)
      f[v.toString()[0].toInt()-1].inc(); }
   println(title);
   println("Digit  Observed  Predicted");
   foreach i,n in ([1..].zip(f)){ // -->(1,Ref)...(9,Ref)
      println("  %d  %9.3f  %8.3f".fmt(i,n.value.toFloat()/data.len(),
            (1.0+1.0/i).log10()))
   }
}


10 RANDOMIZE
20 DIM b(9)
30 LET n=100
40 FOR i=1 TO n
50 GO SUB 1000
60 LET n$=STR$ fiboI
70 LET d=VAL n$(1)
80 LET b(d)=b(d)+1
90 NEXT i
100 PRINT "Digit";TAB 6;"Actual freq";TAB 18;"Expected freq"
110 FOR i=1 TO 9
120 LET pdi=(LN (i+1)/LN 10)-(LN i/LN 10)
130 PRINT i;TAB 6;b(i)/n;TAB 18;pdi
140 NEXT i
150 STOP
1000 REM Fibonacci
1010 LET fiboI=0: LET b=1
1020 FOR j=1 TO i
1030 LET temp=fiboI+b
1040 LET fiboI=b
1050 LET b=temp
1060 NEXT j
1070 RETURN


with javascript_semantics
constant tests = {"abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"}
for test=1 to length(tests) do
    string s = tests[test],
           t = shuffle(s)
    for i=1 to length(t) do
        for j=1 to length(t) do
            integer {ti,tj} = {t[i],t[j]}
            if i!=j and ti!=s[j] and tj!=s[i] then
                t[i] = tj
                t[j] = ti
                exit
            end if
        end for
    end for
    printf(1,"%s -> %s (%d)\n",{s,t,sum(sq_eq(t,s))})
end for


import Data.List
import Numeric
import Text.Printf

-- Use the built-in function showIntAtBase.
toBin n = showIntAtBase 2 ("01" !!) n ""

-- Implement our own version.
toBin1 0 = []
toBin1 x =  (toBin1 $ x `div` 2) ++ (show $ x `mod` 2)

-- Or even more efficient (due to fusion) and universal implementation
toBin2 = foldMap show . reverse . toBase 2

toBase base = unfoldr modDiv
  where modDiv 0 = Nothing
        modDiv n = let (q, r) = (n `divMod` base) in Just (r, q)

printToBin n = putStrLn $ printf "%4d  %14s  %14s" n (toBin n) (toBin1 n)

main = do
  putStrLn $ printf "%4s  %14s  %14s" "N" "toBin" "toBin1"
  mapM_ printToBin [5, 50, 9000]


foreach (split(' ', 'abracadabra seesaw pop grrrrrr up a') as $w)
    echo bestShuffle($w) . '<br>';

function bestShuffle($s1) {
    $s2 = str_shuffle($s1);
    for ($i = 0; $i < strlen($s2); $i++) {
        if ($s2[$i] != $s1[$i]) continue;
        for ($j = 0; $j < strlen($s2); $j++)
            if ($i != $j && $s2[$i] != $s1[$j] && $s2[$j] != $s1[$i]) {
                $t = $s2[$i];
                $s2[$i] = $s2[$j];
                $s2[$j] = $t;
                break;
            }
    }
    return "$s1 $s2 " . countSame($s1, $s2);
}

function countSame($s1, $s2) {
    $cnt = 0;
    for ($i = 0; $i < strlen($s2); $i++)
        if ($s1[$i] == $s2[$i])
            $cnt++;
    return "($cnt)";
}


procedure main()
every i := 5 | 50 | 255 | 1285 | 9000 do
  write(i," = ",binary(i))
end

procedure binary(n)                      #: return bitstring for integer n
static CT, cm, cb
initial {
   CT := table()                         # cache table for results
   cm := 2 ^ (cb := 4)                   # (tunable) cache modulus & pad bits
   }

b := ""                                  # build reversed bit string
while n > 0 do {                         # use cached result ...
   if not (b ||:= \CT[1(i := n % cm, n /:= cm) ]) then {
      CT[j := i] := ""                   # ...or start new cache entry
      while j > 0 do
         CT[i] ||:=  "01"[ 1(1+j % 2, j /:= 2 )]
      b ||:= CT[i] := left(CT[i],cb,"0") # finish cache with padding
      }
   }
return reverse(trim(b,"0"))              # nothing extraneous
end


module Main

binaryDigit : Integer -> Char
binaryDigit n = if (mod n 2) == 1 then '1' else '0'

binaryString : Integer -> String
binaryString 0 = "0"
binaryString n = pack (loop n [])
  where loop : Integer -> List Char -> List Char
        loop 0 acc = acc
        loop n acc = loop (div n 2) (binaryDigit n :: acc)

main : IO ()
main = do
  putStrLn (binaryString 0)
  putStrLn (binaryString 5)
  putStrLn (binaryString 50)
  putStrLn (binaryString 9000)


import cp.

go =>
  Words = ["abracadabra",
           "seesaw",
           "elk",
           "grrrrrr",
           "up",
           "a",
           "shuffle",
           "aaaaaaa"
           ],
  foreach(Word in Words)
     best_shuffle(Word,Best,_Score),
     printf("%s, %s, (%d)\n", Word,Best,diff_word(Word, Best))
  end,
  nl.

best_shuffle(Word,Best,Score) =>
  WordAlpha = Word.map(ord), % convert to integers
  WordAlphaNoDups = WordAlpha.remove_dups(),
  % occurrences of each character in the word
  Occurrences = occurrences(WordAlpha),

  Len = Word.length,

  % Decision variables
  WordC = new_list(Len),
  WordC :: WordAlphaNoDups,

  %
  % The constraints
  %

  % Ensure that the shuffled word has the same
  % occurrences for each character
  foreach(V in WordAlphaNoDups)
     count(V, WordC,#=, Occurrences.get(V))
  end,

  % The score is the number of characters
  % in the same position as the origin word
  % (to be minimized).
  Score #= sum([WordC[I] #= WordAlpha[I] : I in 1..Len]),

  if var(Score) then
    % We don't have a score yet: minimize Score
    solve([$min(Score),split], WordC)
  else
    % Get a solution for the given Score
    solve([split], WordC)
  end,
  % convert back to alpha
  Best = WordC.map(chr).

diff_word(W1,W2) = Diff =>
  Diff = sum([1 : I in 1..W1.length, W1[I]==W2[I]]).

occurrences(L) = Occ =>
  Occ = new_map(),
  foreach(E in L)
    Occ.put(E, Occ.get(E,0) + 1)
  end.


(de bestShuffle (Str)
   (let Lst NIL
      (for C (setq Str (chop Str))
         (if (assoc C Lst)
            (con @ (cons C (cdr @)))
            (push 'Lst (cons C)) ) )
      (setq Lst (apply conc (flip (by length sort Lst))))
      (let Res
         (mapcar
            '((C)
               (prog1 (or (find <> Lst (circ C)) C)
                  (setq Lst (delete @ Lst)) ) )
            Str )
         (prinl Str " " Res " (" (cnt = Str Res) ")") ) ) )


public class Main {
    public static void main(String[] args) {
        System.out.println(Integer.toBinaryString(5));
        System.out.println(Integer.toBinaryString(50));
        System.out.println(Integer.toBinaryString(9000));
    }
}


shuffle: procedure options (main);                  /* 14/1/2011 */
   declare (s, saves) character (20) varying, c character (1);
   declare t(length(s)) bit (1);
   declare (i, k, moves initial (0)) fixed binary;

   get edit (s) (L);
   put skip list (s);
   saves = s;
   t = '0'b;
   do i = 1 to length (s);
      if t(i) then iterate; /* This character has already been moved. */
      c = substr(s, i, 1);
      k = search (s, c, i+1);
      if k > 0 then
         do;
            substr(s, i, 1) = substr(s, k, 1);
            substr(s, k, 1) = c;
            t(k), t(i) = '1'b;
         end;
   end;

   do k = length(s) to 2 by -1;
      if ^t(k) then /* this character wasn't moved. */
all:     do;
            c = substr(s, k, 1);
            do i = k-1 to 1 by -1;
               if c ^= substr(s, i, 1) then
                  if substr(saves, i, 1) ^= c then
                     do;
                        substr(s, k, 1) = substr(s, i, 1);
                        substr(s, i, 1) = c;
                        t(k) = '1'b;
                        leave all;
                     end;
            end;
         end;
   end;
   moves = length(s) - sum(t);
   put skip edit (s, trim(moves))(a, x(1));

search: procedure (s, c, k) returns (fixed binary);
   declare s character (*) varying;
   declare c character (1);
   declare k fixed binary;
   declare i fixed binary;

   do i = k to length(s);
      if ^t(i) then if c ^= substr(s, i, 1) then return (i);
   end;
   return (0); /* No eligible character. */
end search;

end shuffle;


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


HIDE
_ == [null] [pop] [2 div swap] [48 + putch] linrec
IN
int2bin == [null] [48 + putch] [_] ifte '\n putch
END


def binary_digits:
  [ recurse( ./2 | floor; . > 0) % 2 ] | reverse | join("") ;

# The task:
(5, 50, 9000) | binary_digits


#  Calculate best possible shuffle score for a given string
#  (Split out into separate function so we can use it separately in our output)
function Get-BestScore ( [string]$String )
    {
    #  Convert to array of characters, group identical characters,
    #  sort by frequecy, get size of first group
    $MostRepeats = $String.ToCharArray() |
                    Group |
                    Sort Count -Descending |
                    Select -First 1 -ExpandProperty Count

    #  Return count of most repeated character minus all other characters (math simplified)
    return [math]::Max( 0, 2 * $MostRepeats - $String.Length )
    }

function Get-BestShuffle ( [string]$String )
    {
    #  Convert to arrays of characters, one for comparison, one for manipulation
    $S1 = $String.ToCharArray()
    $S2 = $String.ToCharArray()

    #  Calculate best possible score as our goal
    $BestScore = Get-BestScore $String

    #  Unshuffled string has score equal to number of characters
    $Length = $String.Length
    $Score = $Length

    #  While still striving for perfection...
    While ( $Score -gt $BestScore )
        {
        #  For each character
        ForEach ( $i in 0..($Length-1) )
            {
            #  If the shuffled character still matches the original character...
            If ( $S1[$i] -eq $S2[$i] )
                {
                #  Swap it with a random character
                #  (Random character $j may be the same as or may even be
                #   character $i. The minor impact on speed was traded for
                #   a simple solution to guarantee randomness.)
                $j = Get-Random -Maximum $Length
                $S2[$i], $S2[$j] = $S2[$j], $S2[$i]
                }
            }
        #  Count the number of indexes where the two arrays match
        $Score = ( 0..($Length-1) ).Where({ $S1[$_] -eq $S2[$_] }).Count
        }
    #  Put it back into a string
    $Shuffle = ( [string[]]$S2 -join '' )
    return $Shuffle
    }


using Printf

for n in (0, 5, 50, 9000)
    @printf("%6i → %s\n", n, string(n, base=2))
end

# with pad
println("\nwith pad")
for n in (0, 5, 50, 9000)
    @printf("%6i → %s\n", n, string(n, base=2, pad=20))
end


// version 1.0.5-2

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


:- dynamic score/2.

best_shuffle :-
	maplist(best_shuffle, ["abracadabra", "eesaw", "elk", "grrrrrr",
			       	"up", "a"]).

best_shuffle(Str) :-
	retractall(score(_,_)),
	length(Str, Len),
	assert(score(Str, Len)),
	calcule_min(Str, Len, Min),
	repeat,
	   shuffle(Str, Shuffled),
	   maplist(comp, Str, Shuffled, Result),
	   sumlist(Result, V),
	   retract(score(Cur, VCur)),
	   (  V < VCur -> assert(score(Shuffled, V)); assert(score(Cur, VCur))),
	   V = Min,
	retract(score(Cur, VCur)),
	writef('%s : %s (%d)\n', [Str, Cur, VCur]).

comp(C, C1, S):-
	(   C = C1 -> S = 1; S = 0).

% this code was written by P.Caboche and can be found here :
% http://pcaboche.developpez.com/article/prolog/listes/?page=page_3#Lshuffle
shuffle(List, Shuffled) :-
  length(List, Len),
  shuffle(Len, List, Shuffled).

shuffle(0, [], []) :- !.

shuffle(Len, List, [Elem|Tail]) :-
  RandInd is random(Len),
  nth0(RandInd, List, Elem),
  select(Elem, List, Rest),
  NewLen is Len - 1,
  shuffle(NewLen, Rest, Tail).

% letters are sorted out then packed
% If a letter is more numerous than the rest
% the min is the difference between the quantity of this letter and
% the sum of the quantity of the other letters
calcule_min(Str, Len, Min) :-
	msort(Str, SS),
	packList(SS, Lst),
	sort(Lst, Lst1),
	last(Lst1, [N, _]),
	(   N * 2 > Len -> Min is 2 * N - Len; Min = 0).

% almost the same code as in "run_length" page
packList([],[]).

packList([X],[[1,X]]) :- !.

packList([X|Rest],[XRun|Packed]):-
    run(X,Rest, XRun,RRest),
    packList(RRest,Packed).

run(Var,[],[1,Var],[]).

run(Var,[Var|LRest],[N1, Var],RRest):-
    run(Var,LRest,[N, Var],RRest),
    N > 0,
    N1 is N + 1.

run(Var,[Other|RRest], [1,Var],[Other|RRest]):-
     dif(Var,Other).


'%b '__number_format set
[5 50 9000] [3 1] reshape .


Structure charInfo
  Char.s
  List Position.i()
  count.i          ;number of occurrences of Char
EndStructure

Structure cycleInfo
  Char.s
  Position.i
EndStructure

Structure cycle
  List cycle.cycleInfo()
EndStructure

Procedure.s shuffleWordLetters(word.s)
  Protected i
  Dim originalLetters.s(len(word) - 1)
  For i = 1 To Len(word)
    originalLetters(i - 1) = Mid(word, i, 1)
  Next

  Dim shuffledLetters.s(0)
  CopyArray(originalLetters(), shuffledLetters())

  ;record original letters and their positions
  Protected curChar.s
  NewList letters.charInfo()
  NewMap *wordInfo.charInfo()
  For i = 0 To ArraySize(originalLetters())
    curChar = originalLetters(i)
    If FindMapElement(*wordInfo(), curChar)
      AddElement(*wordInfo()\position())
      *wordInfo()\position() = i
    Else
      *wordInfo(curChar) = AddElement(letters())
      If *wordInfo()
        *wordInfo()\Char = curChar
        AddElement(*wordInfo()\position())
        *wordInfo()\position() = i
      EndIf
    EndIf
  Next

  ForEach letters()
    letters()\count = ListSize(letters()\Position())
  Next

  SortStructuredList(letters(), #PB_Sort_Ascending, OffsetOf(charInfo\Char), #PB_Sort_String) ;extra sort step, not strictly necessary
  SortStructuredList(letters(), #PB_Sort_Descending, OffsetOf(charInfo\count), #PB_Sort_integer)

  ;construct letter cycles
  FirstElement(letters())
  Protected maxLetterCount = letters()\count
  Dim letterCycles.cycle(maxLetterCount - 1)

  Protected curCycleIndex
  ForEach letters()
    ForEach letters()\Position()
      With letterCycles(curCycleIndex)
        AddElement(\cycle())
        \cycle()\Char = letters()\Char
        \cycle()\Position = letters()\position()
      EndWith
      curCycleIndex = (curCycleIndex + 1) % maxLetterCount
    Next
  Next

  ;rotate letters in each cycle
  Protected isFirst, prevChar.s, pos_1
  For i = 0 To maxLetterCount - 1
    With letterCycles(i)
      isFirst = #True
      ForEach \cycle()
        If Not isFirst
          shuffledLetters(\cycle()\Position) = prevChar
        Else
          pos_1 = \cycle()\Position
          isFirst = #False
        EndIf
        prevChar = \cycle()\Char
      Next
      shuffledLetters(pos_1) = prevChar
    EndWith
  Next

  ;score and display shuffle
  Protected shuffledWord.s, ignored
  For i = 0 To ArraySize(shuffledLetters())
    shuffledWord + shuffledLetters(i)
    If shuffledLetters(i) = originalLetters(i)
      ignored + 1
    EndIf
  Next

  PrintN(word + ", " + shuffledWord + ", (" + Str(ignored) + ")")
  ProcedureReturn shuffledWord
EndProcedure

If OpenConsole()
  shuffleWordLetters("abracadabra")
  shuffleWordLetters("seesaw")
  shuffleWordLetters("elk")
  shuffleWordLetters("grrrrrr")
  shuffleWordLetters("up")
  shuffleWordLetters("a")

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf


for a = 0 to 16
print a;"=";dec2bin$(a)
next
a=50:print a;"=";dec2bin$(a)
a=254:print a;"=";dec2bin$(a)
a=9000:print a;"=";dec2bin$(a)
wait

function dec2bin$(num)
   if num=0 then dec2bin$="0":exit function
    while num>0
        dec2bin$=str$(num mod 2)+dec2bin$
        num=int(num/2)
    wend
end function


import random

def count(w1,wnew):
    return sum(c1==c2 for c1,c2 in zip(w1, wnew))

def best_shuffle(w):
    wnew = list(w)
    n = len(w)
    rangelists = (list(range(n)), list(range(n)))
    for r in rangelists:
        random.shuffle(r)
    rangei, rangej = rangelists
    for i in rangei:
        for j in rangej:
            if i != j and wnew[j] != wnew[i] and w[i] != wnew[j] and w[j] != wnew[i]:
                wnew[j], wnew[i] = wnew[i], wnew[j]
                break
    wnew = ''.join(wnew)
    return wnew, count(w, wnew)

if __name__ == '__main__':
    test_words = ('tree abracadabra seesaw elk grrrrrr up a '
                  + 'antidisestablishmentarianism hounddogs').split()
    test_words += ['aardvarks are ant eaters', 'immediately', 'abba']
    for w in test_words:
        wnew, c = best_shuffle(w)
        print("%29s, %-29s ,(%i)" % (w, wnew, c))


// Little Man Computer, for Rosetta Code.
// Read numbers from user and display them in binary.
// Exit when input = 0.
input    INP
         BRZ zero
         STA N
// Write number followed by '->'
         OUT
         LDA asc_hy
         OTC
         LDA asc_gt
         OTC
// Find greatest power of 2 not exceeding N,
//  and count how many digits will be output
         LDA c1
         STA pwr2
loop     STA nrDigits
         LDA N
         SUB pwr2
         SUB pwr2
         BRP double
         BRA part2    // jump out if next power of 2 would exceed N
double   LDA pwr2
         ADD pwr2
         STA pwr2
         LDA nrDigits
         ADD c1
         BRA loop
// Write the binary digits
part2    LDA N
         SUB pwr2
set_diff STA diff
         LDA asc_1     // first digit is always 1
wr_digit OTC           // write digit
         LDA nrDigits  // count down the number of digits
         SUB c1
         BRZ input     // if all digits done, loop for next number
         STA nrDigits
// We now want to compare diff with pwr2/2.
// Since division is awkward in LMC, we compare 2*diff with pwr2.
         LDA diff      // diff := diff * 2
         ADD diff
         STA diff
         SUB pwr2      // is diff >= pwr2 ?
         BRP set_diff  // yes, update diff and write '1'
         LDA asc_0     // no, write '0'
         BRA wr_digit
zero     HLT           // stop if input = 0
// Constants
c1       DAT 1
asc_hy   DAT 45
asc_gt   DAT 62
asc_0    DAT 48
asc_1    DAT 49
// Variables
N        DAT
pwr2     DAT
nrDigits DAT
diff     DAT