int     MinSteps,       \minimal number of steps to get to 1
        Subtractor;     \1 or 2
char    Ns(20000), Ops(20000), MinNs(20000), MinOps(20000);

proc Reduce(N, Step);   \Reduce N to 1, recording minimum steps
int  N, Step, I;
[if N = 1 then
    [if Step < MinSteps then
        [for I:= 0 to Step-1 do
            [MinOps(I):= Ops(I);
            MinNs(I):= Ns(I);
            ];
        MinSteps:= Step;
        ];
    ];
if Step >= MinSteps then return;        \don't search further
if rem(N/3) = 0 then
        [Ops(Step):= 3;  Ns(Step):= N/3;  Reduce(N/3, Step+1)];
if rem(N/2) = 0 then
        [Ops(Step):= 2;  Ns(Step):= N/2;  Reduce(N/2, Step+1)];
Ops(Step):= -Subtractor;  Ns(Step):= N-Subtractor;  Reduce(N-Subtractor, Step+1);
]; \Reduce

proc ShowSteps(N);      \Show minimal steps and how N steps to 1
int N, I;
[MinSteps:= $7FFF_FFFF;
Reduce(N, 0);
Text(0, "N = ");  IntOut(0, N);
Text(0, " takes ");  IntOut(0, MinSteps);  Text(0, " steps: N ");
for I:= 0 to MinSteps-1 do
        [Text(0, if extend(MinOps(I)) < 0 then "-" else "/");
        IntOut(0, abs(extend(MinOps(I))));
        Text(0, "=>");  IntOut(0, MinNs(I));  Text(0, " ");
        ];
CrLf(0);
]; \ShowSteps

proc ShowCount(Range);  \Show count of maximum minimal steps and their Ns
int  Range;
int  N, MaxSteps;
[MaxSteps:= 0;          \find maximum number of minimum steps
for N:= 1 to Range do
        [MinSteps:= $7FFF_FFFF;
        Reduce(N, 0);
        if MinSteps > MaxSteps then
                MaxSteps:= MinSteps;
        ];
Text(0, "Maximum steps: ");  IntOut(0, MaxSteps);  Text(0, " for N = ");
for N:= 1 to Range do   \show numbers (Ns) for Maximum steps
        [MinSteps:= $7FFF_FFFF;
        Reduce(N, 0);
        if MinSteps = MaxSteps then
                [IntOut(0, N);  Text(0, " ");
                ];
        ];
CrLf(0);
]; \ShowCount

int N;
[Subtractor:= 1;                \1.
for N:= 1 to 10 do ShowSteps(N);
ShowCount(2000);                \2.
ShowCount(20_000);              \2a.
Subtractor:= 2;                 \3.
for N:= 1 to 10 do ShowSteps(N);
ShowCount(2000);                \4.
ShowCount(20_000);              \4a.
]


var minCache;  // (val:(newVal,op,steps))
fcn buildCache(N,D,S){
   minCache=Dictionary(1,T(1,"",0));
   foreach n in ([2..N]){
      ops:=List();
      foreach d in (D){ if(n%d==0) ops.append(T(n/d,  String("/",d))) }
      foreach s in (S){ if(n>s)    ops.append(T(n - s,String("-",s))) }
      mcv:=fcn(op){ minCache[op[0]][2] };	// !ACK!, dig out steps
      v,op := ops.reduce(			// find min steps to get to op
	 'wrap(vo1,vo2){ if(mcv(vo1)<mcv(vo2)) vo1 else vo2 });
      minCache[n]=T(v, op, 1 + minCache[v][2])  // this many steps to get to n
   }
}
fcn stepsToOne(N){	// D & S are determined by minCache
   ops,steps := Sink(String).write(N), minCache[N][2];
   do(steps){ v,o,s := minCache[N]; ops.write(" ",o,"-->",N=v); }
   return(steps,ops.close())
}


;==========================================================
; create cards
cards := [], suits := ["♠","♥","♦","♣"], num := 0
for i, v in StrSplit("A,2,3,4,5,6,7,8,9,10,J,Q,K",",")
	for i, suit in suits
		cards[++num] := v suit
;==========================================================
; create gui
w := 40
Gui, font, S10
Gui, font, S10 CRed
Gui, add, text, w100 , Face Up Red
loop, 26
	Gui, add, button, % "x+0 w" w " vFR" A_Index
Gui, add, text, xs w100 , Face Down
loop, 26
	Gui, add, button, % "x+0 w" w " vHR" A_Index
Gui, font, S10 CBlack
Gui, add, text, xs w100 , Face Up Black
loop, 26
	Gui, add, button, % "x+0 w" w " vFB" A_Index
Gui, add, text, xs w100 , Face Down
loop, 26
	Gui, add, button, % "x+0 w" w " vHB" A_Index
Gui, add, button, xs gShuffle , Shuffle
Gui, add, button, x+1 Disabled vDeal gDeal , Deal
Gui, add, button, x+1 Disabled vMove gMove, Move
Gui, add, button, x+1 Disabled vShowAll gShowAll , Show All
Gui, add, button, x+1 Disabled vPeak gPeak, Peak
Gui, add, StatusBar
Gui, show
SB_SetParts(200,200)
SB_SetText("0 Face Down Red Cards", 1)
SB_SetText("0 Face Down Black Cards", 2)
return
;==========================================================
Shuffle:
list := "", shuffled := []
Loop, 52
	list .= A_Index ","
list := Trim(list, ",")
Sort, list, Random D,
loop, parse, list, `,
	shuffled[A_Index] := cards[A_LoopField]
loop, 26{
	GuiControl,, % "FR" A_Index
	GuiControl,, % "FB" A_Index
	GuiControl,, % "HR" A_Index
	GuiControl,, % "HB" A_Index
}
GuiControl, Enable, Deal
GuiControl, Disable, Move
GuiControl, Disable, ShowAll
GuiControl, Enable, Peak
return
;==========================================================
peak:
list := ""
for i, v in shuffled
	list .= i ": " v (mod(i,2)?"`t":"`n")
ToolTip , % list, 1000, 0
return
;==========================================================
Deal:
Color := "",
GuiControl, Disable, Deal
FaceRed:= [], FaceBlack := [], HiddenRed := [], HiddenBlack := [], toggle := 0
for i, card in shuffled
	if toggle:=!toggle	{
		if InStr(card, "♥") || InStr(card, "♦") {
			Color := "Red"
			faceRed.push(card)
			GuiControl,, % "FR" faceRed.Count(), % card
		}
		else if InStr(card, "♠") || InStr(card, "♣") {
			Color := "Black"
			faceBlack.push(card)
			GuiControl,, % "FB" faceBlack.Count(), % card
		}
	}
	else{
		Hidden%Color%.push(card)
		GuiControl,, % (color="red"?"HR":"HB") Hidden%Color%.Count(), % "?"
		Sleep, 50
	}
GuiControl, Enable, Move
GuiControl, Enable, ShowAll
return
;==========================================================
Move:
tempR := [], tempB := []
Random, rndcount, 1, % HiddenRed.Count() < HiddenBlack.Count() ? HiddenRed.Count() : HiddenBlack.Count()
loop, % rndcount{
	Random, rnd, 1, % HiddenRed.Count()
	Random, rnd, 1, % HiddenBlack.Count()
	tempR.push(HiddenRed.RemoveAt(rnd))
	tempB.push(HiddenBlack.RemoveAt(rnd))
}
list := ""
for i, v in tempR
	list .= v "`t" tempB[i] "`n"
MsgBox % "swapping " rndcount " cards between face down Red and face down Black`n" (ShowAll?"Red`tBlack`n" list:"")
for i, v in tempR
	HiddenBlack.Push(v)
for i, v in tempB
	HiddenRed.push(v)
if ShowAll
	gosub, ShowAll
return
;==========================================================
ShowAll:
ShowAll := true, countR := countB := 0
loop, 26{
	GuiControl,, % "HR" A_Index
	GuiControl,, % "HB" A_Index
}
for i, card in HiddenRed
	GuiControl,, % "HR" i, % (card~= "[♥♦]"?"[":"") card (card~= "[♥♦]"?"]":"")
	, countR := (card~= "[♥♦]") ? countR+1 : countR
for i, card in HiddenBlack
	GuiControl,, % "HB" i, % (card~= "[♠♣]"?"[":"") card  (card~= "[♠♣]"?"]":"")
	, countB := (card~= "[♠♣]") ? countB+1 : countB
SB_SetText(countR " Face Down Red Cards", 1)
SB_SetText(countB " Face Down Black Cards", 2)
return
;==========================================================


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

#define SIM_N           5  /* Run 5 simulations */
#define PRINT_DISCARDED 1  /* Whether or not to print the discard pile */

#define min(x,y) ((x<y)?(x):(y))

typedef uint8_t card_t;

/* Return a random number from an uniform distribution (0..n-1) */
unsigned int rand_n(unsigned int n) {
    unsigned int out, mask = 1;
    /* Find how many bits to mask off */
    while (mask < n) mask = mask<<1 | 1;
    /* Generate random number */
    do {
        out = rand() & mask;
    } while (out >= n);
    return out;
}

/* Return a random card (0..51) from an uniform distribution */
card_t rand_card() {
    return rand_n(52);
}

/* Print a card */
void print_card(card_t card) {
    static char *suits = "HCDS"; /* hearts, clubs, diamonds and spades */
    static char *cards[] = {"A","2","3","4","5","6","7","8","9","10","J","Q","K"};
    printf(" %s%c", cards[card>>2], suits[card&3]);
}

/* Shuffle a pack */
void shuffle(card_t *pack) {
    int card;
    card_t temp, randpos;
    for (card=0; card<52; card++) {
        randpos = rand_card();
        temp = pack[card];
        pack[card] = pack[randpos];
        pack[randpos] = temp;
    }
}

/* Do the card trick, return whether cards match */
int trick() {
    card_t pack[52];
    card_t blacks[52/4], reds[52/4];
    card_t top, x, card;
    int blackn=0, redn=0, blacksw=0, redsw=0, result;

    /* Create and shuffle a pack */
    for (card=0; card<52; card++) pack[card] = card;
    shuffle(pack);

    /* Deal cards */
#if PRINT_DISCARDED
    printf("Discarded:"); /* Print the discard pile */
#endif
    for (card=0; card<52; card += 2) {
        top = pack[card]; /* Take card */
        if (top & 1) { /* Add next card to black or red pile */
            blacks[blackn++] = pack[card+1];
        } else {
            reds[redn++] = pack[card+1];
        }
#if PRINT_DISCARDED
        print_card(top); /* Show which card is discarded */
#endif
    }
#if PRINT_DISCARDED
    printf("\n");
#endif

    /* Swap an amount of cards */
    x = rand_n(min(blackn, redn));
    for (card=0; card<x; card++) {
        /* Pick a random card from the black and red pile to swap */
        blacksw = rand_n(blackn);
        redsw = rand_n(redn);
        /* Swap them */
        top = blacks[blacksw];
        blacks[blacksw] = reds[redsw];
        reds[redsw] = top;
    }

    /* Verify the assertion */
    result = 0;
    for (card=0; card<blackn; card++)
        result += (blacks[card] & 1) == 1;
    for (card=0; card<redn; card++)
        result -= (reds[card] & 1) == 0;
    result = !result;

    printf("The number of black cards in the 'black' pile"
           " %s the number of red cards in the 'red' pile.\n",
           result? "equals" : "does not equal");
    return result;
}

int main() {
    unsigned int seed, i, successes = 0;
    FILE *r;

    /* Seed the RNG with bytes from from /dev/urandom */
    if ((r = fopen("/dev/urandom", "r")) == NULL) {
        fprintf(stderr, "cannot open /dev/urandom\n");
        return 255;
    }
    if (fread(&seed, sizeof(unsigned int), 1, r) != 1) {
        fprintf(stderr, "failed to read from /dev/urandom\n");
        return 255;
    }
    fclose(r);
    srand(seed);

    /* Do simulations. */
    for (i=1; i<=SIM_N; i++) {
        printf("Simulation %d\n", i);
        successes += trick();
        printf("\n");
    }

    printf("Result: %d successes out of %d simulations\n",
        successes, SIM_N);

    return 0;
}


deck = ([:black, :red] * 26 ).shuffle
black_pile, red_pile, discard = [] of Symbol, [] of Symbol, [] of Symbol

until deck.empty?
  discard << deck.pop
  discard.last == :black ? black_pile << deck.pop : red_pile << deck.pop
end

x = rand( [black_pile.size, red_pile.size].min )

red_bunch   = (0...x).map { red_pile.delete_at( rand( red_pile.size )) }
black_bunch = (0...x).map { black_pile.delete_at( rand( black_pile.size )) }

black_pile += red_bunch
red_pile   += black_bunch

puts "The magician predicts there will be #{black_pile.count( :black )} red cards in the other pile.
Drumroll...
There were #{red_pile.count( :red )}!"


//Be boggled? Nigel Galloway: September 19th., 2018
let N=System.Random()
let fN=List.unfold(function |(0,0)->None |(n,g)->let ng=N.Next (n+g) in Some (if ng>=n then ("Black",(n,g-1)) else ("Red",(n-1,g))))(26,26)
let fG n=let (n,n')::(g,g')::_=List.countBy(fun (n::g::_)->if n=g then n else g) n in sprintf "%d %s cards and %d %s cards" n' n g' g
printf "A well shuffled deck -> "; List.iter (printf "%s ") fN; printfn ""
fN |> List.chunkBySize 2 |> List.groupBy List.head |> List.iter(fun(n,n')->printfn "The %s pile contains %s" n (fG n'))


USING: accessors combinators.extras formatting fry
generalizations io kernel math math.ranges random sequences
sequences.extras ;
IN: rosetta-code.mind-boggling-card-trick

SYMBOLS: R B ;

TUPLE: piles deck red black discard ;

: initialize-deck ( -- seq )
    [ R ] [ B ] [ '[ 26 _ V{ } replicate-as ] call ] [email protected] append
    randomize ;

: <piles> ( -- piles )
    initialize-deck [ V{ } clone ] thrice piles boa ;

: deal-step ( piles -- piles' )
    dup [ deck>> pop dup ] [ discard>> push ] [ deck>> pop ] tri
    B = [ over black>> ] [ over red>> ] if push ;

: deal ( piles -- piles' ) 26 [ deal-step ] times ;

: choose-sample-size ( piles -- n )
    [ red>> ] [ black>> ] bi shorter length [0,b] random ;

! Partition a sequence into n random samples in one sequence and
! the leftovers in another.
: sample-partition ( vec n -- leftovers sample )
    [ 3 dupn ] dip sample dup
    [ [ swap remove-first! drop ] with each ] dip ;

: perform-swaps ( piles -- piles' )
    dup dup choose-sample-size dup "Swapping %d\n" printf
    [ [ red>> ] dip ] [ [ black>> ] dip ] 2bi
    [ sample-partition ] [email protected] [ append ] dip rot append
    [ >>black ] dip >>red ;

: test-assertion ( piles -- )
    [ red>> ] [ black>> ] bi
    [ [ R = ] count ] [ [ B = ] count ] bi* 2dup =
    [ "Assertion correct!" ]
    [ "Assertion incorrect!" ] if print
    "R in red: %d\nB in black: %d\n" printf ;

: main ( -- )
    <piles>                             ! step 1
    deal                                ! step 2
    dup "Post-deal state:\n%u\n" printf
    perform-swaps                       ! step 3
    dup "Post-swap state:\n%u\n" printf
    test-assertion ;                    ! step 4

MAIN: main


package main

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

func main() {
    // Create pack, half red, half black and shuffle it.
    var pack [52]byte
    for i := 0; i < 26; i++ {
        pack[i] = 'R'
        pack[26+i] = 'B'
    }
    rand.Seed(time.Now().UnixNano())
    rand.Shuffle(52, func(i, j int) {
        pack[i], pack[j] = pack[j], pack[i]
    })

    // Deal from pack into 3 stacks.
    var red, black, discard []byte
    for i := 0; i < 51; i += 2 {
        switch pack[i] {
        case 'B':
            black = append(black, pack[i+1])
        case 'R':
            red = append(red, pack[i+1])
        }
        discard = append(discard, pack[i])
    }
    lr, lb, ld := len(red), len(black), len(discard)
    fmt.Println("After dealing the cards the state of the stacks is:")
    fmt.Printf("  Red    : %2d cards -> %c\n", lr, red)
    fmt.Printf("  Black  : %2d cards -> %c\n", lb, black)
    fmt.Printf("  Discard: %2d cards -> %c\n", ld, discard)

    // Swap the same, random, number of cards between the red and black stacks.
    min := lr
    if lb < min {
        min = lb
    }
    n := 1 + rand.Intn(min)
    rp := rand.Perm(lr)[:n]
    bp := rand.Perm(lb)[:n]
    fmt.Printf("\n%d card(s) are to be swapped.\n\n", n)
    fmt.Println("The respective zero-based indices of the cards(s) to be swapped are:")
    fmt.Printf("  Red    : %2d\n", rp)
    fmt.Printf("  Black  : %2d\n", bp)
    for i := 0; i < n; i++ {
        red[rp[i]], black[bp[i]] = black[bp[i]], red[rp[i]]
    }
    fmt.Println("\nAfter swapping, the state of the red and black stacks is:")
    fmt.Printf("  Red    : %c\n", red)
    fmt.Printf("  Black  : %c\n", black)

    // Check that the number of black cards in the black stack equals
    // the number of red cards in the red stack.
    rcount, bcount := 0, 0
    for _, c := range red {
        if c == 'R' {
            rcount++
        }
    }
    for _, c := range black {
        if c == 'B' {
            bcount++
        }
    }

    fmt.Println("\nThe number of red cards in the red stack     =", rcount)
    fmt.Println("The number of black cards in the black stack =", bcount)
    if rcount == bcount {
        fmt.Println("So the asssertion is correct!")
    } else {
        fmt.Println("So the asssertion is incorrect!")
    }
}


import System.Random (randomRIO)
import Data.List (partition)
import Data.Monoid ((<>))

main :: IO [Int]
main = do

  -- DEALT
  ns <- knuthShuffle [1 .. 52]
  let (rs_, bs_, discards) = threeStacks (rb <$> ns)

  -- SWAPPED
  nSwap <- randomRIO (1, min (length rs_) (length bs_))
  let (rs, bs) = exchange nSwap rs_ bs_

  -- CHECKED
  let rrs = filter ('R' ==) rs
  let bbs = filter ('B' ==) bs
  putStrLn $
    unlines
      [ "Discarded: " <> discards
      , "Swapped: " <> show nSwap
      , "Red pile: " <> rs
      , "Black pile: " <> bs
      , rrs <> " = Red cards in the red pile"
      , bbs <> " = Black cards in the black pile"
      , show $ length rrs == length bbs
      ]
  return ns

-- RED vs BLACK ----------------------------------------
rb :: Int -> Char
rb n
  | even n = 'R'
  | otherwise = 'B'

-- THREE STACKS ----------------------------------------
threeStacks :: String -> (String, String, String)
threeStacks = go ([], [], [])
  where
    go tpl [] = tpl
    go (rs, bs, ds) [x] = (rs, bs, x : ds)
    go (rs, bs, ds) (x:y:xs)
      | 'R' == x = go (y : rs, bs, x : ds) xs
      | otherwise = go (rs, y : bs, x : ds) xs

exchange :: Int -> [a] -> [a] -> ([a], [a])
exchange n xs ys =
  let [xs_, ys_] = splitAt n <$> [xs, ys]
  in (fst ys_ <> snd xs_, fst xs_ <> snd ys_)

-- SHUFFLE -----------------------------------------------
-- (See Knuth Shuffle task)
knuthShuffle :: [a] -> IO [a]
knuthShuffle xs = (foldr swapElems xs . zip [1 ..]) <$> randoms (length xs)

randoms :: Int -> IO [Int]
randoms x = traverse (randomRIO . (,) 0) [1 .. (pred x)]

swapElems :: (Int, Int) -> [a] -> [a]
swapElems (i, j) xs
  | i == j = xs
  | otherwise = replaceAt j (xs !! i) $ replaceAt i (xs !! j) xs

replaceAt :: Int -> a -> [a] -> [a]
replaceAt i c l =
  let (a, b) = splitAt i l
  in a ++ c : drop 1 b


  NB. A failed assertion looks like this
   assert 0
|assertion failure: assert
|       assert 0


(() => {
    'use strict';

    const main = () => {
        const
        // DEALT
        [rs_, bs_, discards] = threeStacks(
                map(n =>
                    even(n) ? (
                        'R'
                    ) : 'B', knuthShuffle(
                        enumFromTo(1, 52)
                    )
                )
            ),

            // SWAPPED
            nSwap = randomRInt(1, min(rs_.length, bs_.length)),
            [rs, bs] = exchange(nSwap, rs_, bs_),

            // CHECKED
            rrs = filter(c => 'R' === c, rs).join(''),
            bbs = filter(c => 'B' === c, bs).join('');
        return unlines([
            'Discarded: ' + discards.join(''),
            'Swapped: ' + nSwap,
            'Red pile: ' + rs.join(''),
            'Black pile: ' + bs.join(''),
            rrs + ' = Red cards in the red pile',
            bbs + ' = Black cards in the black pile',
            (rrs.length === bbs.length).toString()
        ]);
    };

    // THREE STACKS ---------------------------------------

    // threeStacks :: [Chars] -> ([Chars], [Chars], [Chars])
    const threeStacks = cards => {
        const go = ([rs, bs, ds]) => xs => {
            const lng = xs.length;
            return 0 < lng ? (
                1 < lng ? (() => {
                    const [x, y] = take(2, xs),
                        ds_ = cons(x, ds);
                    return (
                        'R' === x ? (
                            go([cons(y, rs), bs, ds_])
                        ) : go([rs, cons(y, bs), ds_])
                    )(drop(2, xs));
                })() : [rs, bs, ds_]
            ) : [rs, bs, ds];
        };
        return go([
            [],
            [],
            []
        ])(cards);
    };

    // exchange :: Int -> [a] -> [a] -> ([a], [a])
    const exchange = (n, xs, ys) => {
        const [xs_, ys_] = map(splitAt(n), [xs, ys]);
        return [
            fst(ys_).concat(snd(xs_)),
            fst(xs_).concat(snd(ys_))
        ];
    };

    // SHUFFLE --------------------------------------------

    // knuthShuffle :: [a] -> [a]
    const knuthShuffle = xs =>
        enumFromTo(0, xs.length - 1)
        .reduceRight((a, i) => {
            const iRand = randomRInt(0, i);
            return i !== iRand ? (
                swapped(i, iRand, a)
            ) : a;
        }, xs);

    // swapped :: Int -> Int -> [a] -> [a]
    const swapped = (iFrom, iTo, xs) =>
        xs.map(
            (x, i) => iFrom !== i ? (
                iTo !== i ? (
                    x
                ) : xs[iFrom]
            ) : xs[iTo]
        );

    // GENERIC FUNCTIONS ----------------------------------

    // cons :: a -> [a] -> [a]
    const cons = (x, xs) =>
        Array.isArray(xs) ? (
            [x].concat(xs)
        ) : (x + xs);

    // drop :: Int -> [a] -> [a]
    // drop :: Int -> String -> String
    const drop = (n, xs) => xs.slice(n);

    // enumFromTo :: Int -> Int -> [Int]
    const enumFromTo = (m, n) =>
        m <= n ? iterateUntil(
            x => n <= x,
            x => 1 + x,
            m
        ) : [];

    // even :: Int -> Bool
    const even = n => 0 === n % 2;

    // filter :: (a -> Bool) -> [a] -> [a]
    const filter = (f, xs) => xs.filter(f);

    // fst :: (a, b) -> a
    const fst = tpl => tpl[0];

    // iterateUntil :: (a -> Bool) -> (a -> a) -> a -> [a]
    const iterateUntil = (p, f, x) => {
        const vs = [x];
        let h = x;
        while (!p(h))(h = f(h), vs.push(h));
        return vs;
    };

    // map :: (a -> b) -> [a] -> [b]
    const map = (f, xs) => xs.map(f);

    // min :: Ord a => a -> a -> a
    const min = (a, b) => b < a ? b : a;

    // randomRInt :: Int -> Int -> Int
    const randomRInt = (low, high) =>
        low + Math.floor(
            (Math.random() * ((high - low) + 1))
        );

    // snd :: (a, b) -> b
    const snd = tpl => tpl[1];

    // splitAt :: Int -> [a] -> ([a],[a])
    const splitAt = n => xs => Tuple(xs.slice(0, n), xs.slice(n));

    // take :: Int -> [a] -> [a]
    const take = (n, xs) => xs.slice(0, n);

    // Tuple (,) :: a -> b -> (a, b)
    const Tuple = (a, b) => ({
        type: 'Tuple',
        '0': a,
        '1': b,
        length: 2
    });

    // unlines :: [String] -> String
    const unlines = xs => xs.join('\n');

    // MAIN ---
    return main();
})();


const rbdeck = split(repeat('R', 26) * repeat('B', 26), "")
shuffledeck() = shuffle(rbdeck)

function deal!(deck, dpile, bpile, rpile)
    while !isempty(deck)
        if (topcard = pop!(deck)) == "R"
            push!(rpile, pop!(deck))
        else
            push!(bpile, pop!(deck))
        end
        push!(dpile, topcard)
    end
end

function swap!(rpile, bpile, nswapping)
    rpick = sort(randperm(length(rpile))[1:nswapping])
    bpick = sort(randperm(length(bpile))[1:nswapping])
    rrm = rpile[rpick]; brm = bpile[bpick]
    deleteat!(rpile, rpick); deleteat!(bpile, bpick)
    append!(rpile, brm); append!(bpile, rrm)
end

function mindbogglingcardtrick(verbose=true)
    prif(cond, txt) = (if(cond) println(txt) end)
    deck = shuffledeck()
    prif(verbose, "Shuffled deck is: $deck")

    dpile, rpile, bpile = [], [], []
    deal!(deck, dpile, bpile, rpile)

    prif(verbose, "Before swap:")
    prif(verbose, "Discard pile:    $dpile")
    prif(verbose, "Red card pile:   $rpile")
    prif(verbose, "Black card pile: $bpile")

    amount = rand(1:min(length(rpile), length(bpile)))
    prif(verbose, "Swapping a random number of cards: $amount will be swapped.")
    swap!(rpile, bpile, amount)

    prif(verbose, "Red pile after swaps:   $rpile")
    prif(verbose, "Black pile after swaps: $bpile")
    println("There are $(sum(map(x->x=="B", bpile))) black cards in the black card pile:")
    println("there are $(sum(map(x->x=="R", rpile))) red cards in the red card pile.")
    prif(verbose, "")
end

mindbogglingcardtrick()

for _ in 1:10
    mindbogglingcardtrick(false)
end


// Version 1.2.61

import java.util.Random

fun main(args: Array<String>) {
    // Create pack, half red, half black and shuffle it.
    val pack = MutableList(52) { if (it < 26) 'R' else 'B' }
    pack.shuffle()

    // Deal from pack into 3 stacks.
    val red = mutableListOf<Char>()
    val black = mutableListOf<Char>()
    val discard = mutableListOf<Char>()
    for (i in 0 until 52 step 2) {
        when (pack[i]) {
            'B' -> black.add(pack[i + 1])
            'R' -> red.add(pack[i + 1])
        }
        discard.add(pack[i])
    }
    val sr = red.size
    val sb = black.size
    val sd = discard.size
    println("After dealing the cards the state of the stacks is:")
    System.out.printf("  Red    : %2d cards -> %s\n", sr, red)
    System.out.printf("  Black  : %2d cards -> %s\n", sb, black)
    System.out.printf("  Discard: %2d cards -> %s\n", sd, discard)

    // Swap the same, random, number of cards between the red and black stacks.
    val rand = Random()
    val min = minOf(sr, sb)
    val n = 1 + rand.nextInt(min)
    var rp = MutableList(sr) { it }.shuffled().subList(0, n)
    var bp = MutableList(sb) { it }.shuffled().subList(0, n)
    println("\n$n card(s) are to be swapped\n")
    println("The respective zero-based indices of the cards(s) to be swapped are:")
    println("  Red    : $rp")
    println("  Black  : $bp")
    for (i in 0 until n) {
        val temp = red[rp[i]]
        red[rp[i]] = black[bp[i]]
        black[bp[i]] = temp
    }
    println("\nAfter swapping, the state of the red and black stacks is:")
    println("  Red    : $red")
    println("  Black  : $black")

    // Check that the number of black cards in the black stack equals
    // the number of red cards in the red stack.
    var rcount = 0
    var bcount = 0
    for (c in red) if (c == 'R') rcount++
    for (c in black) if (c == 'B') bcount++
    println("\nThe number of red cards in the red stack     = $rcount")
    println("The number of black cards in the black stack = $bcount")
    if (rcount == bcount) {
        println("So the asssertion is correct!")
    }
    else {
        println("So the asssertion is incorrect!")
    }
}


s = [email protected][{Table[0, 26], Table[1, 26]}]
g = Take[s, {1, -1, 2}]
d = Take[s, {2, -1, 2}]
a = b = {};
Table[If[g[[i]] == 1, AppendTo[a, d[[i]]], AppendTo[b, d[[i]]]], {i,
   [email protected]}];
a
b
dice = RandomInteger[{1, 6}]
ra = [email protected][[email protected]@a, dice]
a = {Delete[a, List /@ ra], a[[ra]]}
rb = [email protected][[email protected]@b, dice]
b = {Delete[b, List /@ rb], b[[rb]]}
finala = Join[a[[1]], b[[2]]]
finalb = Join[b[[1]], a[[2]]]
Count[finala, 1] == Count[finalb, 0]


import random, sequtils, strformat, strutils

type Color {.pure.} = enum Red = "R", Black = "B"

proc `$`(s: seq[Color]): string = s.join(" ")

# Create pack, half red, half black and shuffle it.
var pack = newSeq[Color](52)
for i in 0..51: pack[i] = Color(i < 26)
pack.shuffle()

# Deal from pack into 3 stacks.
var red, black, others: seq[Color]
for i in countup(0, 51, 2):
  case pack[i]
    of Red: red.add pack[i + 1]
    of Black: black.add pack[i + 1]
  others.add pack[i]
echo "After dealing the cards the state of the stacks is:"
echo &"  Red:     {red.len:>2} cards -> {red}"
echo &"  Black:   {black.len:>2} cards -> {black}"
echo &"  Discard: {others.len:>2} cards -> {others}"

# Swap the same, random, number of cards between the red and black stacks.
let m = min(red.len, black.len)
let n = rand(1..m)
var rp = toSeq(0..red.high)
rp.shuffle()
rp.setLen(n)
var bp = toSeq(0..black.high)
bp.shuffle()
bp.setLen(n)
echo &"\n{n} card(s) are to be swapped.\n"
echo "The respective zero-based indices of the cards(s) to be swapped are:"
echo "  Red    : ", rp.join(" ")
echo "  Black  : ", bp.join(" ")
for i in 0..<n:
  swap red[rp[i]], black[bp[i]]
echo "\nAfter swapping, the state of the red and black stacks is:"
echo "  Red    : ", red
echo "  Black  : ", black

# Check that the number of black cards in the black stack equals
# the number of red cards in the red stack.
let rcount = red.count(Red)
let bcount = black.count(Black)
echo ""
echo "The number of red cards in the red stack is ", rcount
echo "The number of black cards in the black stack is ", bcount
if rcount == bcount:
  echo "So the asssertion is correct."
else:
  echo "So the asssertion is incorrect."


sub trick {
    my(@deck) = @_;
    my $result .= sprintf "%-28s @deck\n", 'Starting deck:';

    my(@discard, @red, @black);
    deal(\@deck, \@discard, \@red, \@black);

    $result .= sprintf "%-28s @red\n", 'Red     pile:';
    $result .= sprintf "%-28s @black\n", 'Black   pile:';

    my $n = int rand(+@red < +@black ? +@red : +@black);
    swap(\@red, \@black, $n);

    $result .= sprintf "Red pile   after %2d swapped: @red\n", $n;
    $result .= sprintf "Black pile after %2d swapped: @black\n", $n;

    $result .= sprintf "Red in Red, Black in Black:  %d = %d\n", (scalar grep {/R/} @red), scalar grep {/B/} @black;
    return "$result\n";
}

sub deal {
    my($c, $d, $r, $b) = @_;
    while (@$c) {
        my $top = shift @$c;
        if ($top eq 'R') { push @$r, shift @$c }
        else             { push @$b, shift @$c }
        push @$d, $top;
    }
}

sub swap {
    my($r, $b, $n) = @_;
    push @$r, splice @$b, 0, $n;
    push @$b, splice @$r, 0, $n;
}

@deck = split '', 'RB' x 26;               # alternating red and black
print trick(@deck);
@deck = split '', 'RRBB' x 13;             # alternating pairs of reds and blacks
print trick(@deck);
@deck = sort @deck;                        # all blacks precede reds
print trick(@deck);
@deck = sort { -1 + 2*int(rand 2) } @deck; # poor man's shuffle
print trick(@deck);


with javascript_semantics
constant n = 52,
         pack = shuffle(repeat('r',n/2)&repeat('b',n/2))

string black = "", red = "", discard = ""
for i=1 to length(pack) by 2 do
    integer top = pack[i],
            next = pack[i+1]
    if top=='b' then
        black &= next
    else
        red &= next
    end if
    discard &= top
end for
black = shuffle(black); red = shuffle(red) -- (optional)
--printf(1,"Discards : %s\n",{discard})

printf(1,"Reds   : %s\nBlacks : %s\n\n",{red,black})

integer lb = length(black), lr = length(red),
        ns = rand(min(lb,lr))
printf(1,"Swap %d cards:\n\n", ns)
string b1ns = black[1..ns],
       r1ns = red[1..ns]
black[1..ns] = r1ns
red[1..ns] = b1ns

printf(1,"Reds   : %s\nBlacks : %s\n\n",{red,black})

integer nb = sum(sq_eq(black,'b')),
        nr = sum(sq_eq(red,'r'))
string correct = iff(nr==nb?"correct":"**INCORRECT**")
printf(1,"%d r in red, %d b in black - assertion %s\n",{nr,nb,correct})


import random

## 1. Cards
n = 52
Black, Red = 'Black', 'Red'
blacks = [Black] * (n // 2)
reds = [Red] * (n // 2)
pack = blacks + reds
# Give the pack a good shuffle.
random.shuffle(pack)

## 2. Deal from the randomised pack into three stacks
black_stack, red_stack, discard = [], [], []
while pack:
    top = pack.pop()
    if top == Black:
        black_stack.append(pack.pop())
    else:
        red_stack.append(pack.pop())
    discard.append(top)
print('(Discards:', ' '.join(d[0] for d in discard), ')\n')

## 3. Swap the same, random, number of cards between the two stacks.
# We can't swap more than the number of cards in a stack.
max_swaps = min(len(black_stack), len(red_stack))
# Randomly choose the number of cards to swap.
swap_count = random.randint(0, max_swaps)
print('Swapping', swap_count)
# Randomly choose that number of cards out of each stack to swap.
def random_partition(stack, count):
    "Partition the stack into 'count' randomly selected members and the rest"
    sample = random.sample(stack, count)
    rest = stack[::]
    for card in sample:
        rest.remove(card)
    return rest, sample

black_stack, black_swap = random_partition(black_stack, swap_count)
red_stack, red_swap = random_partition(red_stack, swap_count)

# Perform the swap.
black_stack += red_swap
red_stack += black_swap

## 4. Order from randomness?
if black_stack.count(Black) == red_stack.count(Red):
    print('Yeha! The mathematicians assertion is correct.')
else:
    print('Whoops - The mathematicians (or my card manipulations) are flakey')


  [ stack ]                         is discards   (     --> s )
  [ stack ]                         is red-card   (     --> s )
  [ stack ]                         is black-card (     --> s )

  [ dup take rot join swap put ]    is to-pile    ( n s -->   )

  [ $ "" discards put
    $ "" red-card put
    $ "" black-card put
    char R 26 of
    char B 26 of join shuffle
    26 times
     [ behead tuck discards to-pile
       behead rot char R =
       iff red-card else black-card
      to-pile ]
    drop
    discards take witheach
      [ emit sp ] cr
    red-card take shuffle
    black-card take shuffle
    over size over size min random
    say "Swapping " dup echo
    say " cards." cr
    dup dip [ split rot ] split
    dip join rot join
    0 swap witheach
      [ char R = + ]
    0 rot witheach
      [ char B = + ]
    say "The assertion is "
    = iff [ say "true." ]
    else [ say "false." ] cr cr ]   is task       (     -->   )

   5 times task


magictrick<-function(){
  deck=c(rep("B",26),rep("R",26))
  deck=sample(deck,52)
  blackpile=character(0)
  redpile=character(0)
  discardpile=character(0)
  while(length(deck)>0){
    if(deck[1]=="B"){
      blackpile=c(blackpile,deck[2])
      deck=deck[-2]
    }else{
      redpile=c(redpile,deck[2])
      deck=deck[-2]
    }
    discardpile=c(discardpile,deck[1])
    deck=deck[-1]
  }
  cat("After the deal the state of the piles is:","\n",
      "Black pile:",blackpile,"\n","Red pile:",redpile,"\n",
      "Discard pile:",discardpile,"\n","\n")
  X=sample(1:min(length(redpile),length(blackpile)),1)
  if(X==1){s=" is"}else{s="s are"}
  cat(X," card",s," being swapped.","\n","\n",sep="")
  redindex=sample(1:length(redpile),X)
  blackindex=sample(1:length(blackpile),X)
  redbunch=redpile[redindex]
  redpile=redpile[-redindex]
  blackbunch=blackpile[blackindex]
  blackpile=blackpile[-blackindex]
  redpile=c(redpile,blackbunch)
  blackpile=c(blackpile,redbunch)
  cat("After the swap the state of the piles is:","\n",
      "Black pile:",blackpile,"\n","Red pile:",redpile,"\n","\n")
  cat("There are ", length(which(blackpile=="B")), " black cards in the black pile.","\n",
      "There are ", length(which(redpile=="R")), " red cards in the red pile.","\n",sep="")
  if(length(which(blackpile=="B"))==length(which(redpile=="R"))){
    cat("The assertion is true!")
  }
}


# Generate a shuffled deck
my @deck = shuffle;
put 'Shuffled deck:          ', @deck;

my (@discard, @red, @black);
# Deal cards following task description
deal(@deck, @discard, @red, @black);

put 'Discard pile:           ', @discard;
put '"Red"   pile:           ', @red;
put '"Black" pile:           ', @black;

# swap the same random number of random
# cards between the red and black piles
my $amount = ^(+@red min +@black) .roll;
put 'Number of cards to swap: ', $amount;
swap(@red, @black, $amount);

put 'Red pile after swaps:   ', @red;
put 'Black pile after swaps: ', @black;

say 'Number of Red   cards in the Red   pile: ', +@red.grep('R');
say 'Number of Black cards in the Black pile: ', +@black.grep('B');

sub shuffle { (flat 'R' xx 26, 'B' xx 26).pick: * }

sub deal (@deck, @d, @r, @b) {
    while @deck.elems {
        my $top = @deck.shift;
        if $top eq 'R' {
            @r.push: @deck.shift;
        }
        else {
            @b.push: @deck.shift;
        }
        @d.push: $top;
    }
}

sub swap (@r, @b, $a) {
    my @ri  = ^@r .pick($a);
    my @bi  = ^@b .pick($a);
    my @rs  = @r[@ri];
    my @bs  = @b[@bi];
    @r[@ri] = @bs;
    @b[@bi] = @rs;
}


/*REXX pgm mimics a boggling card trick; separates cards into 3 piles based on color ···*/
parse arg trials # shuffs seed .                 /*obtain optional arguments from the CL*/
if trials=='' | trials==","  then trials= 1000   /*Not specified?  Then use the default.*/
if      #=='' |      #==","  then      #=   52   /* "      "         "   "   "     "    */
if shuffs=='' | shuffs==","  then shuffs=  #%4   /* "      "         "   "   "     "    */
if datatype(seed, 'W')   then call random ,,seed /*if integer, use this as a RANDOM seed*/
ok=0                                             /*the number of "expected" good trials.*/
                         do trials               /*perform a number of trials to be safe*/
                         call create             /*odd numbers≡RED,  even numbers≡BLACK.*/
                         call shuffle            /*shuffle the deck a number of times.  */
                         call deal               /*put cards into three piles of cards. */
                         call swap               /*swap rand # of cards in  R & B  piles*/
                         call count              /*count #blacks in B, #reds in R  piles*/
                         end   /*trials*/        /*#: is the number of cards in the deck*/
pc= (100*ok/trials)'%'                           /*calculate the  %  asserted correctly.*/
say "Correctness of the mathematician's assertion:"    pc   '  (out of'    commas(trials),
    "trial"s(trials)')  using a deck of '     commas(#)                                  ,
    " card"s(#)',  and doing '                commas(shuffs)         ' shuffle's(shuffs).
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
?:       return random(1, word( arg(1) #, 1) )   /*gen a random number from  1 ──► arg. */
commas:  parse arg _;  do j=length(_)-3  to 1  by -3; _=insert(',', _, j); end;   return _
create:  @.=; k=0; do j=1  by 4  for #; k=k+1; @.k= j; if k//13==0 then j=j+1; end; return
isRed:   return    arg(1) // 2                   /*if  arg(1)  is odd,  the card is RED.*/
s:       if arg(1)==1  then return arg(3);  return word( arg(2) 's', 1)    /*pluralizer.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
count:   Rn=0;  Bn=0;              do j=1  for words(R);  Rn=Rn+   isRed(word(R,j)) ;  end
                                   do k=1  for words(B);  Bn=Bn+ (\isRed(word(B,k)));  end
         if Rn==Bn  then ok= ok+1;        return /*Was it a good trial?  Bump OK counter*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
deal:    R=;  B=;  D=;             do j=1  for #%2  by 2        /*deal all the cards.   */
                                   next= j+1;   card= @.next    /*obtain the next card. */
                                   if isRed(@.j)  then R=R card /*add to the  RED  pile?*/
                                                  else B=B card /* "   "  "  BLACK   "  */
                                   D= D @.j                     /* "   "  " discard  "  */
                                   end   /*j*/
         return                                                 /*discard pile not used.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
shuffle:   do j=1  for shuffs;  x=?();    do until y\==x | #==1;   y=?();   end  /*until*/
         parse value   @.x  @.y     with     @.y  @.x;  end  /*j*/;                 return
/*──────────────────────────────────────────────────────────────────────────────────────*/
swap:    $= min( words(R), words(B) );          Rc=;   Bc= /*ensure we can swap $ cards.*/
         if $==0  then return                              /*A pile has no cards? return*/
                                   do ?($)                 /*$:  is the number of swaps.*/
                                   R?= ?( words(R) )       /*a random card in  RED pile.*/
                                   B?= ?( words(B) )       /*"    "     "   " BLACK  "  */
    /* "reds"  to be swapped.*/    Rc= Rc word(R, R?);  R= delword(R, R?, 1)  /*del card*/
    /*"blacks"  "  "    "    */    Bc= Bc word(B, B?);  B= delword(B, B?, 1)  /* "    " */
                                   end   /*?($)*/
         R=R Bc;  B=B Rc;   return                         /*add swapped cards to piles.*/


deck = ([:black, :red] * 26 ).shuffle
black_pile, red_pile, discard = [], [], []

until deck.empty? do
  discard << deck.pop
  discard.last == :black ? black_pile << deck.pop : red_pile << deck.pop
end

x = rand( [black_pile.size, red_pile.size].min )

red_bunch   = x.times.map{ red_pile.delete_at( rand( red_pile.size )) }
black_bunch = x.times.map{ black_pile.delete_at( rand( black_pile.size )) }

black_pile += red_bunch
red_pile   += black_bunch

puts "The magician predicts there will be #{black_pile.count( :black )} red cards in the other pile.
Drumroll...
There were #{red_pile.count( :red )}!"


extern crate rand; // 0.5.5
use rand::Rng;
use std::iter::repeat;

#[derive(Debug, Eq, PartialEq, Clone)]
enum Colour {
    Black,
    Red,
}
use Colour::*;

fn main() {
    let mut rng = rand::thread_rng();

    //Create our deck.
    let mut deck: Vec<_> = repeat(Black).take(26)
        .chain(repeat(Red).take(26))
        .collect();

    rng.shuffle(&mut deck);

    let mut black_stack = vec![];
    let mut red_stack = vec![];
    let mut discarded = vec![];

    //Deal our cards.
    print!("Discarding:");
    while let (Some(card), Some(next)) = (deck.pop(), deck.pop()) {
        print!(" {}", if card == Black { "B" } else { "R" });
        match card {
            Red => red_stack.push(next),
            Black => black_stack.push(next),
        }
        discarded.push(card);
    }
    println!();

    // Choose how many to swap.
    let max = red_stack.len().min(black_stack.len());
    let num = rng.gen_range(1, max);
    println!("Exchanging {} cards", num);

    // Actually swap our cards.
    for _ in 0..num {
        let red = rng.choose_mut(&mut red_stack).unwrap();
        let black = rng.choose_mut(&mut black_stack).unwrap();
        std::mem::swap(red, black);
    }

    //Count how many are red and black.
    let num_black = black_stack.iter()
        .filter(|&c| c == &Black)
        .count();
    let num_red = red_stack.iter()
        .filter(|&c| c == &Red)
        .count();

    println!("Number of black cards in black stack: {}", num_black);
    println!("Number of red cards in red stack: {}", num_red);
}


import "random" for Random
import "/fmt" for Fmt

var R = 82 // ASCII 'R'
var B = 66 // ASCII 'B'

// Create pack, half red, half black and shuffle it.
var pack = [0] * 52
for (i in 0..25) {
    pack[i] = R
    pack[26+i] = B
}
var rand = Random.new()
rand.shuffle(pack)

// Deal from pack into 3 stacks.
var red = []
var black = []
var discard = []
var i = 0
while (i < 51) {
    if (pack[i] == B) {
        black.add(pack[i+1])
    } else {
        red.add(pack[i+1])
    }
    discard.add(pack[i])
    i = i + 2
}
var lr = red.count
var lb = black.count
var ld = discard.count
System.print("After dealing the cards the state of the stacks is:")
Fmt.print("  Red    : $2d cards -> $c", lr, red)
Fmt.print("  Black  : $2d cards -> $c", lb, black)
Fmt.print("  Discard: $2d cards -> $c", ld, discard)

// Swap the same, random, number of cards between the red and black stacks.
var min = (lr < lb) ? lr : lb
var n = rand.int(1, min + 1)
var rp = [0] * lr
var bp = [0] * lb
for (i in 0...lr) rp[i] = i
for (i in 0...lb) bp[i] = i
rand.shuffle(rp)
rand.shuffle(bp)
rp = rp[0...n]
bp = bp[0...n]
System.print("\n%(n) card(s) are to be swapped.\n")
System.print("The respective zero-based indices of the cards(s) to be swapped are:")
Fmt.print("  Red    : $2d", rp)
Fmt.print("  Black  : $2d", bp)
for (i in 0...n) {
    var t = red[rp[i]]
    red[rp[i]] = black[bp[i]]
    black[bp[i]] = t
}
System.print("\nAfter swapping, the state of the red and black stacks is:")
Fmt.print("  Red    : $c", red)
Fmt.print("  Black  : $c", black)

// Check that the number of black cards in the black stack equals
// the number of red cards in the red stack.
var rcount = red.count   { |c| c == R }
var bcount = black.count { |c| c == B }
System.print("\nThe number of red cards in the red stack     = %(rcount)")
System.print("The number of black cards in the black stack = %(bcount)")
if (rcount == bcount) {
    System.print("So the asssertion is correct!")
} else {
    System.print("So the asssertion is incorrect!")
}


cards:=[1..52].pump(List,"isEven","toInt").shuffle(); // red==1
stacks:=T(List(),List());   // black stack [0], red stack [1]
blkStk,redStk := stacks;
foreach card in (cards){ stacks[card].append(__cardWalker.next()) }
println("Stacks:\n  Black stack: ",redBlack(blkStk),"\n  Red stack:   ",redBlack(redStk));

numSwaps:=(1).random(1000);    // do lots of swaps
do(numSwaps){ blkStk.append(redStk.pop(0)); redStk.append(blkStk.pop(0)); }
println("Post %d swaps:\n  Black stack: %s\n  Red stack:   %s"
   .fmt(numSwaps,redBlack(blkStk),redBlack(redStk)));

numBlack,numRed := blkStk.filter('==(0)).len(), redStk.sum(0);
if(numBlack==numRed)
   println("Agreed, black stack has same number of black cards\n  "
           "as red stack has number of red cards: ",numRed);
else println("Boo, different stack lenghts");

fcn redBlack(cards){ cards.pump(String,fcn(c){ c and "R " or "B " }) }


F modp(m, n)
   V result = m % n
   I result < 0
      result += n
   R result

F getA004290(n)
   I n == 1
      R BigInt(1)
   V arr = [[0] * n] * n
   arr[0][0] = 1
   arr[0][1] = 1
   V m = 0
   V ten = BigInt(10)
   V nBi = BigInt(n)
   L
      m++
      I arr[m - 1][Int(modp(-pow(ten, m), nBi))] == 1
         L.break
      arr[m][0] = 1
      L(k) 1 .< n
         arr[m][k] = max(arr[m - 1][k], arr[m - 1][Int(modp(BigInt(k) - pow(ten, m), nBi))])

   V r = pow(ten, m)
   V k = Int(modp(-r, nBi))
   L(j) (m - 1 .< 0).step(-1)
      I arr[j - 1][k] == 0
         r += pow(ten, j)
         k = Int(modp(BigInt(k) - pow(ten, j), nBi))
   I k == 1
      r++
   R r

L(n) Array(1..10) [+] Array(95..105) [+] [297, 576, 594, 891, 909, 999, 1998, 2079, 2251, 2277, 2439, 2997, 4878]
   V result = getA004290(n)
   print(‘A004290(’n‘) = ’result‘ = ’n‘ * ’(result I/ n))


BEGIN
    # returns B10 for the specified n or -1 if it cannot be found  #
    # based on Rick Heylen's C program linked from the OEIS site   #
    PROC find b10 = ( INT n )LONG INT:
         IF n < 1   THEN -1
         ELIF n = 1 THEN  1
         ELSE
            [ 0 : n ]LONG INT pow, val;
            INT      x, ten;
            LONG INT count;
            INT num = n;
            FOR i FROM 0 TO n - 1 DO pow[ i ] := val[ i ] := 0 OD;
            count := 0;
            ten   := 1;
            x     := 1;
            WHILE x < n
              AND BEGIN val[ x ] := ten;
                        FOR j FROM 0 TO n- 1 DO
                            IF pow[ j ] /= 0 THEN
                                IF INT j plus ten mod num = ( j + ten ) MOD num;
                                    pow[ j plus ten mod num ] = 0
                                THEN
                                    IF pow[ j ] /= x THEN pow[ j plus ten mod num ] := x FI
                                FI
                            FI
                        OD;
                        IF pow[ ten ] = 0 THEN pow[ ten ] := x FI;
                        ten *:= 10 MODAB num;
                        pow[ 0 ] = 0
                  END
            DO
                x +:= 1
            OD;
            x := num;
            IF pow[ 0 ] = 0 THEN - 1 # couldn't find B10 #
            ELSE
                LONG INT result := 0;
                WHILE x /= 0 DO
                    WHILE ( count -:= 1 ) > pow[ x MOD num ] - 1 DO result *:= 10 OD;
                    count := pow [ x MOD num ] -1;
                    result *:= 10 +:= 1;
                    x := SHORTEN ( num + x - val[ SHORTEN pow[ x MOD num ] ] ) MOD num
                OD;
                WHILE count > 0 DO result *:= 10 ; count -:= 1 OD;
                result
            FI
         FI # find B10 # ;
    # outputs B10 for the specified n #
    PROC show b10 = ( INT n )VOID:
         IF LONG INT b10 = find b10( n );
            b10 < 1
         THEN print( ( "Cannot find B10 for: ", whole( n, 0 ), newline ) )
         ELSE
             # found B10(n) #
             print( ( whole( n, -6 ), ": ", whole( b10, -32 ), " = ", whole( n, -6 ), " * ", whole( b10 OVER n, 0 ), newline ) )
         FI;
    # task test cases #
    FOR n FROM  1 TO  10 DO show b10( n ) OD;
    FOR n FROM 95 TO 105 DO show b10( n ) OD;
    []INT tests = ( 297, 576, 594, 891, 909, 999
                  , 1998, 2079, 2251, 2277
                  , 2439, 2997, 4878
                  );
    FOR n FROM LWB tests TO UPB tests DO show b10( tests[ n ] ) OD
END


on b10(n)
    if (n < 1) then error
    -- Each factor of n that's either 10, 2, or 5 will contribute just a zero each to the end of the B10.
    -- Count and lose any such factors here to leave a potentially much smaller n (nx) to process.
    -- The relevant number of zeros will be appended to the shorter result afterwards.
    set nx to n
    set endZeroCount to 0
    repeat with factor in {10, 5, 2}
        repeat while (nx mod factor = 0)
            set endZeroCount to endZeroCount + 1
            set nx to nx div factor
        end repeat
    end repeat

    script o
        -- 'val' and 'pow' are uninformative and misleading labels for these lists, but I've
        -- kept them for code comparison purposes and because I can't think of anything better.
        property val : {} -- Will be successive powers of 10, mod nx.
        property pow : {} -- Initially nx placeholders, some or all of which will be replaced with indices to slots in val.
        property digits : {} -- Digits for output.
    end script

    if (nx = 1) then
        set end of o's digits to 1 -- Clever stuff not needed.
    else
        set placeholder to missing value
        repeat nx times
            set end of o's pow to placeholder
        end repeat

        -- Calculate successive powers of 10, mod nx, (hereafter "powers"), storing them in val and
        -- finding all the sums-mod-nx ("sums") that can be made from them and sums already obtained.
        -- The range of possible sums (0 to nx - 1) is represented by positions in pow (index = sum + 1
        -- with AppleScript's 1-based indices). Assign the index in val of the first power to produce
        -- each sum to pow's slot for that sum. Stop when the index of the current power turns up in
        -- pow's first slot, indicating that a subset of the powers obtained sums to nx (sum mod nx = 0)
        -- and thus that the sum of the corresponding /un/modded powers of 10 is a multiple of nx.

        -- The first power of 10 is always 1, its index in val is always 1, and its only possible sum is itself.
        set p10 to 1 -- 10 ^ 0 mod nx.
        set end of o's val to p10
        set valIndex to 1
        set item (p10 + 1) of o's pow to valIndex
        -- Subsequent settings depend on the value of nx.
        repeat until (beginning of o's pow = valIndex)
            -- Get the next power of 10, mod nx.
            set p10 to p10 * 10 mod nx
            set end of o's val to p10
            set valIndex to valIndex + 1
            -- "Add" it to any existing sums by inserting its val index into the pow slot p10 places after (mod nx)
            -- each slot already set for a lower-order p10, provided the target slot itself isn't already set.
            repeat with powIndex from 1 to nx
                set this to item powIndex of o's pow
                if (this is placeholder) then
                else if (this < valIndex) then
                    set targetIndex to (powIndex + p10 - 1) mod nx + 1
                    if (item targetIndex of o's pow is placeholder) then set item targetIndex of o's pow to valIndex
                end if
            end repeat
            -- Ensure that it's also treated as a sum in its own right.
            set targetIndex to p10 + 1
            if (item targetIndex of o's pow is placeholder) then set item targetIndex of o's pow to valIndex
        end repeat

        -- To identify the powers-mod-nx which summed to nx, use pow unnecessarily to look up the index
        -- of the power still in p10 which allowed the sum, subtract that power from the sum, use pow again
        -- to find the lower-order power that allowed what's left, and so on until the sum's reduced to 0.
        -- Append a 1 to the digit list for each power identified and a 0 each for any intervening ones.
        set sum to nx
        set previousIndex to 0
        repeat until (sum = 0)
            set valIndex to (item (sum mod nx + 1) of o's pow)
            repeat (previousIndex - valIndex - 1) times
                set end of o's digits to 0
            end repeat
            set end of o's digits to 1
            set previousIndex to valIndex
            set sum to (sum - (item valIndex of o's val) + nx) mod nx
        end repeat
    end if

    -- Append any trailing zeros due from factors removed at the beginning.
    repeat endZeroCount times
        set end of o's digits to 0
    end repeat

    -- Coerce the list of 1s and 0s to text.
    set bTen to join(o's digits, "")
    -- Replace the list's contents with the results of dividing by the original n.
    set digitCount to (count o's digits)
    set remainder to 0
    repeat with i from 1 to digitCount
        set dividend to remainder * 10 + (item i of o's digits)
        set item i of o's digits to dividend div n
        set remainder to dividend mod n
    end repeat
    -- Zap any leading zeros in the result and coerce what's left to text.
    repeat with i from 1 to digitCount
        if (item i of o's digits > 0) then exit repeat
        set item i of o's digits to ""
    end repeat
    set multiplier to join(o's digits, "")

    return {n:n, b10:bTen, multiplier:multiplier}
end b10

on join(lst, delim)
    set astid to AppleScript's text item delimiters
    set AppleScript's text item delimiters to delim
    set txt to lst as text
    set AppleScript's text item delimiters to astid
    return txt
end join

local output, n, bTen, multiplier
set output to {}
repeat with n in {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, ¬
    297, 576, 594, 891, 909, 999, 1998, 2079, 2251, 2277, 2439, 2997, 4878}
    set {b10:bTen, multiplier:multiplier} to b10(n's contents)
    set end of output to (n as text) & " * " & multiplier & ("  =  " & bTen)
end repeat
return join(output, linefeed)


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

__int128 imax(__int128 a, __int128 b) {
    if (a > b) {
        return a;
    }
    return b;
}

__int128 ipow(__int128 b, __int128 n) {
    __int128 res;
    if (n == 0) {
        return 1;
    }
    if (n == 1) {
        return b;
    }
    res = b;
    while (n > 1) {
        res *= b;
        n--;
    }
    return res;
}

__int128 imod(__int128 m, __int128 n) {
    __int128 result = m % n;
    if (result < 0) {
        result += n;
    }
    return result;
}

bool valid(__int128 n) {
    if (n < 0) {
        return false;
    }
    while (n > 0) {
        int r = n % 10;
        if (r > 1) {
            return false;
        }
        n /= 10;
    }
    return true;
}

__int128 mpm(const __int128 n) {
    __int128 *L;
    __int128 m, k, r, j;

    if (n == 1) {
        return 1;
    }

    L = calloc(n * n, sizeof(__int128));
    L[0] = 1;
    L[1] = 1;
    m = 0;
    while (true) {
        m++;
        if (L[(m - 1) * n + imod(-ipow(10, m), n)] == 1) {
            break;
        }
        L[m * n + 0] = 1;
        for (k = 1; k < n; k++) {
            L[m * n + k] = imax(L[(m - 1) * n + k], L[(m - 1) * n + imod(k - ipow(10, m), n)]);
        }
    }

    r = ipow(10, m);
    k = imod(-r, n);

    for (j = m - 1; j >= 1; j--) {
        if (L[(j - 1) * n + k] == 0) {
            r = r + ipow(10, j);
            k = imod(k - ipow(10, j), n);
        }
    }

    if (k == 1) {
        r++;
    }
    return r / n;
}

void print128(__int128 n) {
    char buffer[64]; // more then is needed, but is nice and round;
    int pos = (sizeof(buffer) / sizeof(char)) - 1;
    bool negative = false;

    if (n < 0) {
        negative = true;
        n = -n;
    }

    buffer[pos] = 0;
    while (n > 0) {
        int rem = n % 10;
        buffer[--pos] = rem + '0';
        n /= 10;
    }
    if (negative) {
        buffer[--pos] = '-';
    }
    printf(&buffer[pos]);
}

void test(__int128 n) {
    __int128 mult = mpm(n);
    if (mult > 0) {
        print128(n);
        printf(" * ");
        print128(mult);
        printf(" = ");
        print128(n * mult);
        printf("\n");
    } else {
        print128(n);
        printf("(no solution)\n");
    }
}

int main() {
    int i;

    // 1-10 (inclusive)
    for (i = 1; i <= 10; i++) {
        test(i);
    }
    // 95-105 (inclusive)
    for (i = 95; i <= 105; i++) {
        test(i);
    }
    test(297);
    test(576);
    test(594); // needs a larger number type (64 bits signed)
    test(891);
    test(909);
    test(999); // needs a larger number type (87 bits signed)

    // optional
    test(1998);
    test(2079);
    test(2251);
    test(2277);

    // stretch
    test(2439);
    test(2997);
    test(4878);

    return 0;
}


using System;
using System.Collections.Generic;
using static System.Console;

class Program {

  static string B10(int n) {
    int[] pow = new int[n + 1], val = new int[29];
    for (int count = 0, ten = 1, x = 1; x <= n; x++) {
      val[x] = ten;
      for (int j = 0, t; j <= n; j++)
        if (pow[j] != 0 && pow[j] != x && pow[t = (j + ten) % n] == 0)
          pow[t] = x;
      if (pow[ten] == 0) pow[ten] = x;
      ten = (10 * ten) % n;
      if (pow[0] != 0) {
        x = n;
        string s = "";
        while (x != 0) {
          int p = pow[x % n];
          if (count > p) s += new string('0', count - p);
          count = p - 1;
          s += "1";
          x = (n + x - val[p]) % n;
        }
        if (count > 0) s += new string('0', count);
        return s;
      }
    }
    return "1";
  }

  static void Main(string[] args) {
    string fmt = "{0,4} * {1,24} = {2,-28}\n";
    int[] m = new int[] { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,
      95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105,
      297, 576, 594, 891, 909, 999, 1998, 2079, 2251, 2277, 2439, 2997, 4878 };
    string[] r = new string[m.Length];
    WriteLine(fmt + new string('-', 62), "n", "multiplier", "B10");
    var sw = System.Diagnostics.Stopwatch.StartNew();
    for (int i = 0; i < m.Length; i++) r[i] = B10(m[i]);
    sw.Stop();
    for (int i = 0; i < m.Length; i++) Write(fmt, m[i], decimal.Parse(r[i]) / m[i], r[i]);
    Write("\nTook {0}ms", sw.Elapsed.TotalMilliseconds);
  }
}


#include <iostream>
#include <vector>

__int128 imax(__int128 a, __int128 b) {
    if (a > b) {
        return a;
    }
    return b;
}

__int128 ipow(__int128 b, __int128 n) {
    if (n == 0) {
        return 1;
    }
    if (n == 1) {
        return b;
    }

    __int128 res = b;
    while (n > 1) {
        res *= b;
        n--;
    }
    return res;
}

__int128 imod(__int128 m, __int128 n) {
    __int128 result = m % n;
    if (result < 0) {
        result += n;
    }
    return result;
}

bool valid(__int128 n) {
    if (n < 0) {
        return false;
    }
    while (n > 0) {
        int r = n % 10;
        if (r > 1) {
            return false;
        }
        n /= 10;
    }
    return true;
}

__int128 mpm(const __int128 n) {
    if (n == 1) {
        return 1;
    }

    std::vector<__int128> L(n * n, 0);
    L[0] = 1;
    L[1] = 1;

    __int128 m, k, r, j;
    m = 0;
    while (true) {
        m++;
        if (L[(m - 1) * n + imod(-ipow(10, m), n)] == 1) {
            break;
        }
        L[m * n + 0] = 1;
        for (k = 1; k < n; k++) {
            L[m * n + k] = imax(L[(m - 1) * n + k], L[(m - 1) * n + imod(k - ipow(10, m), n)]);
        }
    }

    r = ipow(10, m);
    k = imod(-r, n);

    for (j = m - 1; j >= 1; j--) {
        if (L[(j - 1) * n + k] == 0) {
            r = r + ipow(10, j);
            k = imod(k - ipow(10, j), n);
        }
    }

    if (k == 1) {
        r++;
    }
    return r / n;
}

std::ostream& operator<<(std::ostream& os, __int128 n) {
    char buffer[64]; // more then is needed, but is nice and round;
    int pos = (sizeof(buffer) / sizeof(char)) - 1;
    bool negative = false;

    if (n < 0) {
        negative = true;
        n = -n;
    }

    buffer[pos] = 0;
    while (n > 0) {
        int rem = n % 10;
        buffer[--pos] = rem + '0';
        n /= 10;
    }
    if (negative) {
        buffer[--pos] = '-';
    }
    return os << &buffer[pos];
}

void test(__int128 n) {
    __int128 mult = mpm(n);
    if (mult > 0) {
        std::cout << n << " * " << mult << " = " << (n * mult) << '\n';
    } else {
        std::cout << n << "(no solution)\n";
    }
}

int main() {
    int i;

    // 1-10 (inclusive)
    for (i = 1; i <= 10; i++) {
        test(i);
    }
    // 95-105 (inclusive)
    for (i = 95; i <= 105; i++) {
        test(i);
    }
    test(297);
    test(576);
    test(594); // needs a larger number type (64 bits signed)
    test(891);
    test(909);
    test(999); // needs a larger number type (87 bits signed)

    // optional
    test(1998);
    test(2079);
    test(2251);
    test(2277);

    // stretch
    test(2439);
    test(2997);
    test(4878);

    return 0;
}


import std.algorithm;
import std.array;
import std.bigint;
import std.range;
import std.stdio;

void main() {
    foreach (n; chain(iota(1, 11), iota(95, 106), only(297, 576, 594, 891, 909, 999, 1998, 2079, 2251, 2277, 2439, 2997, 4878))) {
        auto result = getA004290(n);
        writefln("A004290(%d) = %s = %s * %s", n, result, n, result / n);
    }
}

BigInt getA004290(int n) {
    if (n == 1) {
        return BigInt(1);
    }
    auto L = uninitializedArray!(int[][])(n, n);
    foreach (i; 2..n) {
        L[0][i] = 0;
    }
    L[0][0] = 1;
    L[0][1] = 1;
    int m = 0;
    BigInt ten = 10;
    BigInt nBi = n;
    while (true) {
        m++;
        if (L[m - 1][mod(-(ten ^^ m), nBi).toInt] == 1) {
            break;
        }
        L[m][0] = 1;
        foreach (k; 1..n) {
            L[m][k] = max(L[m - 1][k], L[m - 1][mod(BigInt(k) - (ten ^^ m), nBi).toInt]);
        }
    }
    auto r = ten ^^ m;
    auto k = mod(-r, nBi);
    foreach_reverse (j; 1 .. m) {
        assert(j != m);
        if (L[j - 1][k.toInt] == 0) {
            r += ten ^^ j;
            k = mod(k - (ten ^^ j), nBi);
        }
    }
    if (k == 1) {
        r++;
    }
    return r;
}

BigInt mod(BigInt m, BigInt n) {
    auto result = m % n;
    if (result < 0) {
        result += n;
    }
    return result;
}


// Minimum positive multiple in base 10 using only 0 and 1. Nigel Galloway: March 9th., 2020
let rec fN Σ n i g e l=if l=1||n=1 then Σ+1I else
                       match (10*i)%l with
                        g when n=g->Σ+10I**e
                       |i->match Set.map(fun n->(n+i)%l) g with
                            ф when ф.Contains n->fN (Σ+10I**e) ((l+n-i)%l) 1 (set[1]) 1 l
                           |ф->fN Σ n i (Set.unionMany [set[i];g;ф]) (e+1) l

let B10=fN 0I 0 1 (set[1]) 1
List.concat[[1..10];[95..105];[297;576;594;891;909;999;1998;2079;2251;2277;2439;2997;4878]]
|>List.iter(fun n->let g=B10 n in printfn "%d * %A = %A" n (g/bigint(n)) g)


: is-1-or-0 ( char -- ? ) dup CHAR: 0 = [ drop t ] [ CHAR: 1 = ] if ;
: int-is-B10 ( n -- ? ) unparse [ is-1-or-0 ] all? ;
: B10-step ( x x -- x x ? ) dup int-is-B10 [ f ] [ over + t ] if ;
: find-B10 ( x -- x ) dup [ B10-step ] loop nip ;


#define limit1 900
#define limit2 18703890759446315

Dim As Ulongint nplus, lenplus, prod
Dim As Boolean plusflag = false, flag
Dim As String pstr
Dim As Integer plus(6) = {297,576,594,891,909,999}

Print !"Minimum positive multiple in base 10 using only 0 and 1:\n"
Print "  N *       multiplier = B10"
For n As Ulongint = 1 To limit1
    If n = 106 Then
        plusflag = true
        nplus = 0
    End If
    lenplus = Ubound(plus)
    If plusflag = true Then
        nplus += 1
        If nplus < lenplus+1 Then
            n = plus(nplus)
        Else
            Exit For
        End If
    End If
    For m As Ulongint = 1 To limit2
        flag = true
        prod = n*m
        pstr = Str(prod)
        For p As Ulongint = 1 To Len(pstr)
            If Not(Mid(pstr,p,1) = "0" Or Mid(pstr,p,1) = "1") Then
                flag = false
                Exit For
            End If
        Next p
        If flag = true Then
            Print Using "### * ################ = &"; n; m; pstr
            Exit For
        End If
    Next m
    If n = 10 Then n = 94 : End If
Next n
Sleep


package main

import (
    "fmt"
    "github.com/shabbyrobe/go-num"
    "strings"
    "time"
)

func b10(n int64) {
    if n == 1 {
        fmt.Printf("%4d: %28s  %-24d\n", 1, "1", 1)
        return
    }
    n1 := n + 1
    pow := make([]int64, n1)
    val := make([]int64, n1)
    var count, ten, x int64 = 0, 1, 1
    for ; x < n1; x++ {
        val[x] = ten
        for j := int64(0); j < n1; j++ {
            if pow[j] != 0 && pow[(j+ten)%n] == 0 && pow[j] != x {
                pow[(j+ten)%n] = x
            }
        }
        if pow[ten] == 0 {
            pow[ten] = x
        }
        ten = (10 * ten) % n
        if pow[0] != 0 {
            break
        }
    }
    x = n
    if pow[0] != 0 {
        s := ""
        for x != 0 {
            p := pow[x%n]
            if count > p {
                s += strings.Repeat("0", int(count-p))
            }
            count = p - 1
            s += "1"
            x = (n + x - val[p]) % n
        }
        if count > 0 {
            s += strings.Repeat("0", int(count))
        }
        mpm := num.MustI128FromString(s)
        mul := mpm.Quo64(n)
        fmt.Printf("%4d: %28s  %-24d\n", n, s, mul)
    } else {
        fmt.Println("Can't do it!")
    }
}

func main() {
    start := time.Now()
    tests := [][]int64{{1, 10}, {95, 105}, {297}, {576}, {594}, {891}, {909}, {999},
        {1998}, {2079}, {2251}, {2277}, {2439}, {2997}, {4878}}
    fmt.Println("   n                           B10  multiplier")
    fmt.Println("----------------------------------------------")
    for _, test := range tests {
        from := test[0]
        to := from
        if len(test) == 2 {
            to = test[1]
        }
        for n := from; n <= to; n++ {
            b10(n)
        }
    }
    fmt.Printf("\nTook %s\n", time.Since(start))
}


import Data.Bifunctor (bimap)
import Data.List (find)
import Data.Maybe (isJust)

-- MINIMUM POSITIVE MULTIPLE IN BASE 10 USING ONLY 0 AND 1

b10 :: Integral a => a -> Integer
b10 n = read (digitMatch rems sums) :: Integer
  where
    (_, rems, _, Just (_, sums)) =
      until
        (\(_, _, _, mb) -> isJust mb)
        ( \(e, rems, ms, _) ->
            let m = rem (10 ^ e) n
                newSums =
                  (m, [m]) :
                  fmap (bimap (m +) (m :)) ms
             in ( succ e,
                  m : rems,
                  ms <> newSums,
                  find
                    ( (0 ==) . flip rem n . fst
                    )
                    newSums
                )
        )
        (0, [], [], Nothing)

digitMatch :: Eq a => [a] -> [a] -> String
digitMatch [] _ = []
digitMatch xs [] = '0' <$ xs
digitMatch (x : xs) yys@(y : ys)
  | x /= y = '0' : digitMatch xs yys
  | otherwise = '1' : digitMatch xs ys

--------------------------- TEST -------------------------
main :: IO ()
main =
  mapM_
    ( putStrLn
        . ( \x ->
              let b = b10 x
               in justifyRight 5 ' ' (show x)
                    <> " * "
                    <> justifyLeft 25 ' ' (show $ div b x)
                    <> " -> "
                    <> show b
          )
    )
    ( [1 .. 10]
        <> [95 .. 105]
        <> [297, 576, 594, 891, 909, 999]
    )

justifyLeft, justifyRight :: Int -> a -> [a] -> [a]
justifyLeft n c s = take n (s <> replicate n c)
justifyRight n c = (drop . length) <*> (replicate n c <>)


import java.math.BigInteger;
import java.util.ArrayList;
import java.util.List;

//  Title:  Minimum positive multiple in base 10 using only 0 and 1

public class MinimumNumberOnlyZeroAndOne {

    public static void main(String[] args) {
        for ( int n : getTestCases() ) {
            BigInteger result = getA004290(n);
            System.out.printf("A004290(%d) = %s = %s * %s%n", n, result, n, result.divide(BigInteger.valueOf(n)));
        }
    }

    private static List<Integer> getTestCases() {
        List<Integer> testCases = new ArrayList<>();
        for ( int i = 1 ; i <= 10 ; i++ ) {
            testCases.add(i);
        }
        for ( int i = 95 ; i <= 105 ; i++ ) {
            testCases.add(i);
        }
        for (int i : new int[] {297, 576, 594, 891, 909, 999, 1998, 2079, 2251, 2277, 2439, 2997, 4878} ) {
            testCases.add(i);
        }
        return testCases;
    }

    private static BigInteger getA004290(int n) {
        if ( n == 1 ) {
            return BigInteger.valueOf(1);
        }
        int[][] L = new int[n][n];
        for ( int i = 2 ; i < n ; i++ ) {
            L[0][i] = 0;
        }
        L[0][0] = 1;
        L[0][1] = 1;
        int m = 0;
        BigInteger ten = BigInteger.valueOf(10);
        BigInteger nBi = BigInteger.valueOf(n);
        while ( true ) {
            m++;
            //  if L[m-1, (-10^m) mod n] = 1 then break
            if ( L[m-1][mod(ten.pow(m).negate(), nBi).intValue()] == 1 ) {
                break;
            }
            L[m][0] = 1;
            for ( int k = 1 ; k < n ; k++ ) {
                //L[m][k] = Math.max(L[m-1][k], L[m-1][mod(k-pow(10,m), n)]);
                L[m][k] = Math.max(L[m-1][k], L[m-1][mod(BigInteger.valueOf(k).subtract(ten.pow(m)), nBi).intValue()]);
            }

        }
        //int r = pow(10,m);
        //int k = mod(-pow(10,m), n);
        BigInteger r = ten.pow(m);
        BigInteger k = mod(r.negate(), nBi);
        for ( int j = m-1 ; j >= 1 ; j-- ) {
            if ( L[j-1][k.intValue()] == 0 ) {
                //r = r + pow(10, j);
                //k = mod(k-pow(10, j), n);
                r = r.add(ten.pow(j));
                k = mod(k.subtract(ten.pow(j)), nBi);
            }
        }
        if ( k.compareTo(BigInteger.ONE) == 0 ) {
            r = r.add(BigInteger.ONE);
        }
        return r;
    }

    private static BigInteger mod(BigInteger m, BigInteger n) {
        BigInteger result = m.mod(n);
        if ( result.compareTo(BigInteger.ZERO) < 0 ) {
            result = result.add(n);
        }
        return result;
    }

    @SuppressWarnings("unused")
    private static int mod(int m, int n) {
        int result = m % n;
        if ( result < 0 ) {
            result += n;
        }
        return result;
    }

    @SuppressWarnings("unused")
    private static int pow(int base, int exp) {
        return (int) Math.pow(base, exp);
    }
}


import java.math.BigInteger

fun main() {
    for (n in testCases) {
        val result = getA004290(n)
        println("A004290($n) = $result = $n * ${result / n.toBigInteger()}")
    }
}

private val testCases: List<Int>
    get() {
        val testCases: MutableList<Int> = ArrayList()
        for (i in 1..10) {
            testCases.add(i)
        }
        for (i in 95..105) {
            testCases.add(i)
        }
        for (i in intArrayOf(297, 576, 594, 891, 909, 999, 1998, 2079, 2251, 2277, 2439, 2997, 4878)) {
            testCases.add(i)
        }
        return testCases
    }

private fun getA004290(n: Int): BigInteger {
    if (n == 1) {
        return BigInteger.ONE
    }
    val arr = Array(n) { IntArray(n) }
    for (i in 2 until n) {
        arr[0][i] = 0
    }
    arr[0][0] = 1
    arr[0][1] = 1
    var m = 0
    val ten = BigInteger.TEN
    val nBi = n.toBigInteger()
    while (true) {
        m++
        if (arr[m - 1][mod(-ten.pow(m), nBi).toInt()] == 1) {
            break
        }
        arr[m][0] = 1
        for (k in 1 until n) {
            arr[m][k] = arr[m - 1][k].coerceAtLeast(arr[m - 1][mod(k.toBigInteger() - ten.pow(m), nBi).toInt()])
        }
    }
    var r = ten.pow(m)
    var k = mod(-r, nBi)
    for (j in m - 1 downTo 1) {
        if (arr[j - 1][k.toInt()] == 0) {
            r += ten.pow(j)
            k = mod(k - ten.pow(j), nBi)
        }
    }
    if (k.compareTo(BigInteger.ONE) == 0) {
        r += BigInteger.ONE
    }
    return r
}

private fun mod(m: BigInteger, n: BigInteger): BigInteger {
    var result = m.mod(n)
    if (result < BigInteger.ZERO) {
        result += n
    }
    return result
}


function array1D(n, v)
    local tbl = {}
    for i=1,n do
        table.insert(tbl, v)
    end
    return tbl
end

function array2D(h, w, v)
    local tbl = {}
    for i=1,h do
        table.insert(tbl, array1D(w, v))
    end
    return tbl
end

function mod(m, n)
    m = math.floor(m)
    local result = m % n
    if result < 0 then
        result = result + n
    end
    return result
end

function getA004290(n)
    if n == 1 then
        return 1
    end
    local arr = array2D(n, n, 0)
    arr[1][1] = 1
    arr[1][2] = 1
    local m = 0
    while true do
        m = m + 1
        if arr[m][mod(-10 ^ m, n) + 1] == 1 then
            break
        end
        arr[m + 1][1] = 1
        for k = 1, n - 1 do
            arr[m + 1][k + 1] = math.max(arr[m][k + 1], arr[m][mod(k - 10 ^ m, n) + 1])
        end
    end
    local r = 10 ^ m
    local k = mod(-r, n)
    for j = m - 1, 1, -1 do
        if arr[j][k + 1] == 0 then
            r = r + 10 ^ j
            k = mod(k - 10 ^ j, n)
        end
    end
    if k == 1 then
        r = r + 1
    end
    return r
end

function test(cases)
    for _,n in ipairs(cases) do
        local result = getA004290(n)
        print(string.format("A004290(%d) = %s = %d * %d", n, math.floor(result), n, math.floor(result / n)))
    end
end

test({1, 2, 3, 4, 5, 6, 7, 8, 9})
test({95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105})
test({297, 576, 594, 891, 909, 999})
--test({1998, 2079, 2251, 2277})
--test({2439, 2997, 4878})


DEFINITION MODULE B10AsBin;

(* Returns a number representing the B10 of the passed-in number N.
   The result has the same binary digits as B10 has decimal digits,
   e.g. N = 7 returns 9 = 1001 binary, representing 1001 decimal.
   Returns 0 if the procedure fails.
   In TopSpeed Modula-2, CARDINAL is unsigned 16-bit, LONGCARD is unsigned 32-bit.
*)
PROCEDURE CalcB10AsBinary( N : CARDINAL) : LONGCARD;

END B10AsBin.


import sequtils, strformat, strutils, times
import bignum

func b10(n: int64): string =
  doAssert n > 0, "Argument must be positive."

  if n == 1: return "1"
  var pow, val = newSeq[int64](n + 1)
  var ten = 1i64

  for x in 1i64..val.high:
    val[x] = ten
    for i in 0..n:
      if pow[i] != 0 and pow[i] != x:
        let k = (ten + i) mod n
        if pow[k] == 0: pow[k] = x
    if pow[ten] == 0: pow[ten] = x
    ten = 10 * ten mod n
    if pow[0] != 0: break

  if pow[0] == 0:
    raise newException(ValueError, "Can’t do it!")

  # Build result string.
  var x = n
  var count = 0'i64
  while x != 0:
    let pm = pow[x mod n]
    if count > pm:
      result.add repeat('0', count - pm)
    count = pm - 1
    result.add '1'
    x = (n + x - val[pm]) mod n
  result.add repeat('0', count)

const Data = toSeq(1..10) & toSeq(95..105) &
             @[297, 576, 594, 891, 909, 999, 1998, 2079, 2251, 2277, 2439, 2997, 4878]

let t0 = cpuTime()
for val in Data:
  let res = b10(val)
  let m = newInt(res)
  if m mod val != 0: echo &"Wrong result for {val}."
  else: echo &"{val:4} × {m div val:<24} = {res}"
echo &"Time: {cpuTime() - t0:.3f} s"


program B10_num;
//numbers having only digits 0 and 1 in their decimal representation
//see https://oeis.org/A004290
//Limit of n= 2^19

{$IFDEF FPC} //fpc 3.0.4
  {$MODE DELPHI}  {$OPTIMIZATION ON,ALL} {$codealign proc=16}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}
uses
  sysutils,gmp; //Format
const
  Limit  = 256*256*8;//8+8+3 Bits aka 19 digits
  B10_4  = 10*10*10*10;
  B10_5  = 10*B10_4;
  B10_9  = B10_5*B10_4;
  HexB10 : array[0..15] of NativeUint = (0000,0001,0010,0011,0100,0101,0110,0111,
                                         1000,1001,1010,1011,1100,1101,1110,1111);
var
  ModToIdx  : array[0..Limit] of Int32;
  B10ModN : array[0..limit-1] of Uint32;
  B10 : array of Uint64;

procedure OutOfRange(n:NativeUint);
Begin
  Writeln(n:7,' -- out of range --');
end;

function ConvB10(n: Uint32):Uint64;
//Convert n from binary as if it is Base 10
//limited for Uint64 to 2^20-1= 1048575 ala 19 digits
var
  fac_B10 : Uint64;
Begin
  fac_B10 := 1;
  result := 0;
  repeat
    result += fac_B10*HexB10[n AND 15];
    n := n DIV 16;
    fac_B10 *=B10_4;
  until n = 0;
end;

procedure InitB10;
var
  i : NativeUint;
Begin
  setlength(B10,Limit);
  For i := 0 to Limit do
    b10[i]:= ConvB10(i);
end;

procedure Out_Big(n,h,l:NativeUint);
var
  num,rest : MPInteger;
Begin
  //For Windows gmp ui is Uint32 :-(
  z_init_set_ui(num,Hi(B10[h]));
  z_mul_2exp(num,num,32);
  z_add_ui(num,num,Lo(B10[h]));
  z_mul_ui(num,num,B10_5);z_mul_ui(num,num,B10_5);
  z_mul_ui(num,num,B10_5);z_mul_ui(num,num,B10_4);

  z_init_set_ui(rest,Hi(B10[l]));
  z_mul_2exp(rest,rest,32);
  z_add_ui(rest,rest,Lo(B10[l]));
  z_add(num,num,rest);
  write(Format('%7d %19u%.19u ',[n,B10[h],B10[l]]));
  IF z_divisible_ui_p(num,n) then
  Begin
    z_cdiv_q_ui(num, num,n);
    write(z_get_str(10,num));
  end;
  writeln;
  z_clear(rest);
  z_clear(num);
end;

procedure Out_Small(i,n: NativeUint);
var
  value,Mul : Uint64;
Begin
  value := B10[i];
  mul := value div n;
  IF mul = 1 then
    mul := n;
  writeln(n:7,value:39,' ',mul);
end;

procedure CheckBig_B10(n:NativeUint);
var
  h,BigMod,h_mod:NativeUint;
  l : NativeInt;
Begin
  BigMod :=(sqr(B10_9)*10) MOD n;
  For h := Low(B10ModN)+1 to High(B10ModN) do
  Begin
    //h_mod+l_mod == n =>  n- h_mod = l_mod
    h_mod := n-(BigMod*B10ModN[h])MOD n;
    l := ModToIdx[h_mod];
    if l>= 0 then
    Begin
      Out_Big(n,h,l);
      EXIT;
    end;
  end;
  OutOfRange(n);
end;

procedure Check_B10(n:NativeUint);
var
  pB10 : pUint64;
  i,value : NativeUint;
begin
  B10ModN[0] := 0;
  //set all modulus n  => 0..N-1 to -1
  fillchar(ModToIdx,n*SizeOf(ModToIdx[0]),#255);
  ModToIdx[0] := 0;
  pB10 := @B10[0];
  i := 1;
  repeat
    value := Uint64(pB10[i]) MOD n;
    If value = 0 then
      Break;
    B10ModN[i] := value;
    //memorize the first occurrence
    if ModToIdx[value] < 0 then
      ModToIdx[value]:= i;
    inc(i);
  until i > High(B10ModN);
  IF i < High(B10ModN) then
    Out_Small(i,n)
  else
    CheckBig_B10(n);
end;

var
  n : Uint32;
Begin
  InitB10;
  writeln('Number':7,'B10':39,' Multiplier');
  For n := 1 to 10 do
    Check_B10(n);
  For n := 95 to 105 do
    Check_B10(n);

  Check_B10(297);  Check_B10(576);  Check_B10(891);  Check_B10(909);
  Check_B10( 999);  Check_B10(1998);  Check_B10(2079);  Check_B10(2251);
  Check_B10(2277);  Check_B10(2439);  Check_B10(2997);  Check_B10(4878);
  check_B10(9999);
  check_B10(2*9999); //real 0m0,077s :-)
end.


use strict;
use warnings;
use Math::AnyNum qw(:overload as_bin digits2num);

for my $x (1..10, 95..105, 297, 576, 594, 891, 909, 999) {
    my $y;
    if ($x =~ /^9+$/) { $y = digits2num([(1) x (9 * length $x)],2)  } # all 9's implies all 1's
    else              { while (1) { last unless as_bin(++$y) % $x } }
    printf "%4d: %28s  %s\n", $x, as_bin($y), as_bin($y)/$x;
}


with javascript_semantics
function b10(integer n)
    if n=1 then return "1" end if
    integer NUM = n+1, count = 0, ten = 1, x
    sequence val = repeat(0,NUM),
             pow = repeat(0,NUM)
    --
    -- Calculate each 10^k mod n, along with all possible sums that can be
    -- made from it and the things we've seen before, until we get a 0, eg:
    --
    --  ten/val[]      (for n==7)        See pow[], for k
    --  10^0   = 1 mod 7 = 1.          Possible sums: 1
    --  10^1   = 10 mod 7 = 3.         Possible sums: 1 3 4
    --  10^2   = 10*3 = 30 mod 7 = 2.  Possible sums: 1 2 3 4 5 6
    --  10^3   = 10*2 = 20 mod 7 = 6.  STOP (6+1 = 7 mod 7 = 0)
    --
    -- ie since 10^3 mod 7 + 10^0 mod 7 == (6+1) mod 7 == 0, we know that
    -- 1001 mod 7 == 0, and we have found that w/o checking every interim
    -- value from 11 to 1000 (aside: use binary if counting that range).
    --
    -- Another example is 10^k mod 9 is 1 for all k. Hence we need to find
    -- 9 different ways to generate a 1, before we get a sum (mod 9) of 0,
    -- and hence b10(9) is 111111111, ie 10^8+10^7+..+10^0, and obviously
    -- 9 iterations is somewhat less than all interims 11..111111110.
    --
    for x=1 to n do
        val[x+1] = ten
        for j=1 to NUM do
            if pow[j] and pow[j]!=x then  -- (j seen, in a prior iteration)
                integer k = mod(j-1+ten,n)+1
                if not pow[k] then
                    pow[k] = x            -- (k was seen in this iteration)
                end if
            end if
        end for
        if not pow[ten+1] then pow[ten+1] = x end if
        ten = mod(10*ten,n)
        if pow[1] then exit end if
    end for
    if pow[1]=0 then crash("Can't do it!") end if
    --
    -- Fairly obviously (for b10(7)) we need the 10^3, then we will need
    -- a sum of 1, which first appeared for 10^0, after which we are done.
    -- The required answer is therefore 1001, ie 10^3 + 10^0.
    --
    string res = ""
    x = n
    while x do
        integer pm = pow[mod(x,n)+1]
        if count>pm then res &= repeat('0',count-pm) end if
        count = pm-1;
        res &= '1'
        x = mod(n+x-val[pm+1],n)
    end while
    res &= repeat('0',count)
    return res
end function

constant tests = tagset(10)&tagset(105,95)&{297, 576, 891, 909,
                 999, 1998, 2079, 2251, 2277, 2439, 2997, 4878}
include mpfr.e
mpz m10 = mpz_init()
atom t0 = time()
for i=1 to length(tests) do
    integer ti = tests[i]
    string r10 = b10(ti)
    mpz_set_str(m10,r10,10)
    if mpz_fdiv_q_ui(m10,m10,ti)!=0 then r10 &= " ??" end if
    printf(1,"%4d * %-24s = %s\n",{ti,mpz_get_str(m10),r10})
end for
?elapsed(time()-t0)


/*REXX pgm finds minimum pos. integer that's a product of N that only has the digs 0 & 1*/
numeric digits 30;  w= length( commas( copies(1, digits())))   /*for formatting numbers.*/
parse arg list
if list==''  then list= 1..10  95..105 297
say center(' N ', 9, "─")      center(' B10 ', w, "─")      center(' multiplier ', w, "─")

       do i=1  for words(list)
       z= word(list, i);                      LO= z;    HI= z
       if pos(.., z)\==0  then parse var  z   LO  '..'  HI

          do n=LO  to HI;                             m= B10(n)
          say right(commas(n), 9)      right(commas(n*m), w)         left(commas(m), w)
          end   /*n*/
       end      /*i*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: parse arg _;  do c=length(_)-3  to 1  by -3; _= insert(',', _, c); end;   return _
/*──────────────────────────────────────────────────────────────────────────────────────*/
B10: parse arg #;  inc= 1;                         start= 1;               L= length(#)
                            select
                            when verify(#, 10)==0  then return 1
                            when verify(#,  9)==0  then do;                start=
                                                            do k= 1  for 8
                                                            start= start || copies(k, L)
                                                            end   /*k*/
                                                        end
                            when #//2==0           then do;  start=5;  inc=  5;  end
                            when right(z, 1)==7    then do;  start=3;  inc= 10;  end
                            otherwise nop
                            end   /*select*/
     q= length(start)
     if q>digits()  then numeric digits q
                            do m=start  by  inc  until verify(p, 10)==0;   p= # * m
                            end   /*m*/
     return m


see "working..." + nl
see "Minimum positive multiple in base 10 using only 0 and 1:" + nl

limit1 = 1000
limit2 = 111222333444555666777889
plusflag = 0
plus = [297,576,594,891,909,999]

for n = 1 to limit1
    if n = 106
       plusflag = 1
       nplus = 0
    ok
    lenplus = len(plus)
    if plusflag = 1
       nplus = nplus + 1
       if nplus < lenplus+1
          n = plus[nplus]
       else
          exit
       ok
    ok
    for m = 1 to limit2
        flag = 1
        prod = n*m
        pstr = string(prod)
        for p = 1 to len(pstr)
            if not(pstr[p] = "0" or pstr[p] = "1")
               flag = 0
               exit
            ok
        next
        if flag = 1
           see "" + n + " * " + m + " = " + pstr + nl
           exit
        ok
    next
    if n = 10
       n = 94
    ok
next

see "done..." + nl


def mod(m, n)
    result = m % n
    if result < 0 then
        result = result + n
    end
    return result
end

def getA004290(n)
    if n == 1 then
        return 1
    end
    arr = Array.new(n) { Array.new(n, 0) }
    arr[0][0] = 1
    arr[0][1] = 1
    m = 0
    while true
        m = m + 1
        if arr[m - 1][mod(-10 ** m, n)] == 1 then
            break
        end
        arr[m][0] = 1
        for k in 1 .. n - 1
            arr[m][k] = [arr[m - 1][k], arr[m - 1][mod(k - 10 ** m, n)]].max
        end
    end
    r = 10 ** m
    k = mod(-r, n)
    (m - 1).downto(1) { |j|
        if arr[j - 1][k] == 0 then
            r = r + 10 ** j
            k = mod(k - 10 ** j, n)
        end
    }
    if k == 1 then
        r = r + 1
    end
    return r
end

testCases = Array(1 .. 10)
testCases.concat(Array(95 .. 105))
testCases.concat([297, 576, 594, 891, 909, 999, 1998, 2079, 2251, 2277, 2439, 2997, 4878])
for n in testCases
    result = getA004290(n)
    print "A004290(%d) = %d = %d * %d\n" % [n, result, n, result / n]
end


import scala.collection.mutable.ListBuffer

object MinimumNumberOnlyZeroAndOne {
  def main(args: Array[String]): Unit = {
    for (n <- getTestCases) {
      val result = getA004290(n)
      println(s"A004290($n) = $result = $n * ${result / n}")
    }
  }

  def getTestCases: List[Int] = {
    val testCases = ListBuffer.empty[Int]
    for (i <- 1 to 10) {
      testCases += i
    }
    for (i <- 95 to 105) {
      testCases += i
    }
    for (i <- Array(297, 576, 594, 891, 909, 999, 1998, 2079, 2251, 2277, 2439, 2997, 4878)) {
      testCases += i
    }
    testCases.toList
  }

  def getA004290(n: Int): BigInt = {
    if (n == 1) {
      return 1
    }
    val L = Array.ofDim[Int](n, n)
    for (i <- 2 until n) {
      L(0)(i) = 0
    }
    L(0)(0) = 1
    L(0)(1) = 1
    var m = 0
    val ten = BigInt(10)
    val nBi = BigInt(n)
    var loop = true
    while (loop) {
      m = m + 1
      if (L(m - 1)(mod(-ten.pow(m), nBi).intValue()) == 1) {
        loop = false
      } else {
        L(m)(0) = 1
        for (k <- 1 until n) {
          L(m)(k) = math.max(L(m - 1)(k), L(m - 1)(mod(BigInt(k) - ten.pow(m), nBi).toInt))
        }
      }
    }
    var r = ten.pow(m)
    var k = mod(-r, nBi)
    for (j <- m - 1 to 1 by -1) {
      if (L(j - 1)(k.toInt) == 0) {
        r = r + ten.pow(j)
        k = mod(k - ten.pow(j), nBi)
      }
    }
    if (k == 1) {
      r = r + 1
    }
    r
  }

  def mod(m: BigInt, n: BigInt): BigInt = {
    var result = m % n
    if (result < 0) {
      result = result + n
    }
    result
  }
}


package require Tcl 8.5

## power of ten, modulo --> (10**expo % modval)  suited for large expo
proc potmod {expo modval} {
    if {$expo   < 0} { return 0 }
    if {$modval < 2} { return 0 }               ;# x mod 1 = 0
    set r 1
    set p [expr {10 % $modval}]
    while {$expo} {
        set half [expr {$expo / 2}]
        set odd  [expr {$expo % 2}]
        if {$expo % 2} {
            set r [expr {($r * $p) % $modval}]          ;# r *= p
            if {$r == 0} break
        }
        set expo [expr {$expo / 2}]
        if {$expo} {
            set p [expr {($p * $p) % $modval}]          ;# p *= p
            if {$p == 1} break
        }
    }
    return $r
}

proc sho_sol {n r} {
    puts "B10([format %4s $n]) = [format %28s $r] = n * [expr {$r / $n}]"
}

proc do_1 {n} {
    if {$n < 2} {
        sho_sol $n 1
        return
    }
    set k 0                     ;# running exponent for powers of 10
    set potmn 1                 ;# (k-th) power of ten mod n
    set mvbyk($potmn) $k        ;# highest k for sum with mod value
    set canmv [list $potmn]     ;# which indices are in mvbyk(.)
    set solK -1                 ;# highest exponent of first solution

    for {incr k} {$k <= $n} {incr k} {
        ## By now we know what can be achieved below 10**k.
        ## Combine that with the new 10**k ...
        set potmn [expr {(10 * $potmn) % $n}]           ;# new power of 10
        if {$potmn == 0} {                              ;# found a solution
            set solK $k ; break
        }
        foreach mv $canmv {
            ## the mod value $mv can be constructed below $k
            set newmv [expr {($potmn + $mv) % $n}]
            ## ... and now we can also do $newmv.  Solution?
            if {$newmv == 0} {
                set solK $k ; break
            }
            if { ! [info exists mvbyk($newmv)] } {      ;# is new
                set mvbyk($newmv) $k    ;# remember highest expo
                lappend canmv $newmv
            }
        }
        if {$solK >= 0} { break }

        set newmv $potmn
        if { ! [info exists mvbyk($newmv)] } {
            set mvbyk($newmv) $k
            lappend canmv $newmv
        }
    }
    ## Reconstruct solution ...
    set k $solK
    set mv 0            ;# mod value of $k and below (it is the solution)
    set r "1"           ;# top result, including $k
    while 1 {
        ## 10**k is the current largest power of ten in the solution
        ## $r includes it, already, but $mv is not yet updated
        set mv [expr {($mv - [potmod $k $n]) % $n}]
        if {$mv == 0} {
            append r [string repeat "0" $k]
            break
        }
        set subk $mvbyk($mv)
        append r [string repeat "0" [expr {$k - $subk - 1}]] "1"
        set k $subk
    }
    sho_sol $n $r
}

proc do_range {lo hi} {
    for {set n $lo} {$n <= $hi} {incr n} {
        do_1 $n
    }
}

do_range  1  10
do_range 95 105
foreach n {297 576 594 891 909 999  1998 2079 2251 2277  2439 2997 4878} {
    do_1 $n
}


Imports System, System.Linq, System.Collections.Generic, System.Console

Module Module1

    Dim fmt As String = "{0,4} * {1,31:n0} = {2,-28}" & vbLf

    Sub B10(ByVal n As Integer)
        If n <= 1 Then Return
        Dim pow As Integer() = New Integer(n) {},
            val As Integer() = New Integer(n) {},
            count As Integer = 0, ten As Integer = 1, x As Integer = 1
        While x <= n : val(x) = ten : For j As Integer = 0 To n
                If pow(j) <> 0 AndAlso pow((j + ten) Mod n) = 0 AndAlso _
                   pow(j) <> x Then pow((j + ten) Mod n) = x
            Next : If pow(ten) = 0 Then pow(ten) = x
            ten = (10 * ten) Mod n : If pow(0) <> 0 Then
                x = n : Dim s As String = "" : While x <> 0
                    Dim p As Integer = pow(x Mod n)
                    If count > p Then s += New String("0"c, count - p)
                    count = p - 1 : s += "1"
                    x = (n + x - val(p)) Mod n : End While
                If count > 0 Then s += New String("0"c, count)
                Write(fmt, n, Decimal.Parse(s) / n, s) : Return
            End If : x += 1 : End While : Write("Can't do it!")
    End Sub

    Sub Main(ByVal args As String())
        Dim st As DateTime = DateTime.Now
        Dim m As List(Of Integer) = New List(Of Integer) From _
            {297,576,594,891,909,999,1998,2079,2251,2277,2439,2997,4878}
        Write(fmt, "n", "multiplier", "B10")
        WriteLine(New String("-"c, 69)) : Write(fmt, 1, 1, 1)
        For n As Integer = 1 To m.Last()
            If n <= 10 OrElse n >= 95 AndAlso n <= 105 OrElse m.Contains(n) Then B10(n)
        Next : WriteLine(vbLf & "Took {0}ms", (DateTime.Now - st).TotalMilliseconds)
    End Sub
End Module


import "/fmt" for Fmt
import "/big" for BigInt

var b10 = Fn.new { |n|
    if (n == 1) {
        Fmt.print("$4d: $28s  $-24d", 1, "1", 1)
        return
    }
    var n1 = n + 1
    var pow = List.filled(n1, 0)
    var val = List.filled(n1, 0)
    var count = 0
    var ten = 1
    var x = 1
    while (x < n1) {
        val[x] = ten
        for (j in 0...n1) {
            if (pow[j] != 0 && pow[(j+ten)%n] == 0 && pow[j] != x) pow[(j+ten)%n] = x
        }
        if (pow[ten] == 0) pow[ten] = x
        ten = (10*ten) % n
        if (pow[0] != 0) break
        x = x + 1
    }
    x = n
    if (pow[0] != 0) {
        var s = ""
        while (x != 0) {
            var p = pow[x%n]
            if (count > p) s = s + ("0" * (count-p))
            count = p - 1
            s = s + "1"
            x = (n + x - val[p]) % n
        }
        if (count > 0) s = s + ("0" * count)
        var mpm = BigInt.new(s)
        var mul = mpm/n
        Fmt.print("$4d: $28s  $-24i", n, s, mul)
    } else {
        System.print("Can't do it!")
    }
}

var start = System.clock
var tests = [
    [1, 10], [95, 105], [297], [576], [594], [891], [909], [999],
    [1998], [2079], [2251], [2277], [2439], [2997], [4878]
]
System.print("   n                           B10  multiplier")
System.print("----------------------------------------------")
for (test in tests) {
    var from = test[0]
    var to = from
    if (test.count == 2) to = test[1]
    for (n in from..to) b10.call(n)
}
System.print("\nTook %(System.clock-start) seconds.")


F contains(sums, s, ss)
   L(i) 0 .< ss
      I sums[i] == s
         R 1B
   R 0B

F mian_chowla()
   V n = 100
   V mc = [0] * n
   mc[0] = 1
   V sums = [0] * ((n * (n + 1)) >> 1)
   sums[0] = 2
   V ss = 1
   L(i) 1 .< n
      V le = ss
      V j = mc[i - 1] + 1
      L
         mc[i] = j
         V nxtJ = 0B
         L(k) 0 .. i
            V sum = mc[k] + j
            I contains(sums, sum, ss)
               ss = le
               nxtJ = 1B
               L.break
            sums[ss] = sum
            ss++
         I !nxtJ
            L.break
         j++
   R mc

print(‘The first 30 terms of the Mian-Chowla sequence are:’)
V mc = mian_chowla()
print_elements(mc[0.<30])
print()
print(‘Terms 91 to 100 of the Mian-Chowla sequence are:’)
print_elements(mc[90..])


with Ada.Text_IO;
with Ada.Containers.Hashed_Sets;

procedure Mian_Chowla_Sequence
is
   type Natural_Array is array(Positive range <>) of Natural;

   function Hash(P : in Positive) return Ada.Containers.Hash_Type is
   begin
      return Ada.Containers.Hash_Type(P);
   end Hash;

   package Positive_Sets is new Ada.Containers.Hashed_Sets(Positive, Hash, "=");

   function Mian_Chowla(N : in Positive) return Natural_Array
   is
      return_array : Natural_Array(1 .. N) := (others => 0);
      nth : Positive := 1;
      candidate : Positive := 1;
      seen : Positive_Sets.Set;
   begin
      while nth <= N loop
         declare
            sums : Positive_Sets.Set;
            terms : constant Natural_Array := return_array(1 .. nth-1) & candidate;
            found : Boolean := False;
         begin
            for term of terms loop
               if seen.Contains(term + candidate) then
                  found := True;
                  exit;
               else
                  sums.Insert(term + candidate);
               end if;
            end loop;

            if not found then
               return_array(nth) := candidate;
               seen.Union(sums);
               nth := nth + 1;
            end if;
            candidate := candidate + 1;
         end;
      end loop;
      return return_array;
   end Mian_Chowla;

   length : constant Positive := 100;
   sequence : constant Natural_Array(1 .. length) := Mian_Chowla(length);
begin
   Ada.Text_IO.Put_Line("Mian Chowla sequence first 30 terms :");
   for term of sequence(1 .. 30) loop
      Ada.Text_IO.Put(term'Img);
   end loop;
   Ada.Text_IO.New_Line;
   Ada.Text_IO.Put_Line("Mian Chowla sequence terms 91 to 100 :");
   for term of sequence(91 .. 100) loop
      Ada.Text_IO.Put(term'Img);
   end loop;
end Mian_Chowla_Sequence;


# Find Mian-Chowla numbers: an
                     where: ai = 1,
                       and: an = smallest integer such that ai + aj is unique
                                             for all i, j in 1 .. n && i <= j
#
BEGIN
    INT max mc           = 100;
    [ max mc ]INT mc;
    INT curr size       :=      0; # initial size of the array     #
    INT size increment   = 10 000; # size to increase the array by #
    REF[]BOOL is sum    := HEAP[ 1 : 0 ]BOOL;
    INT mc count        := 1;
    FOR i WHILE mc count <= max mc DO
        # assume i will be part of the sequence                    #
        mc[ mc count ]  := i;
        # check the sums                                           #
        IF  ( 2 * i ) > curr size THEN
            # the is sum array is too small - make a larger one    #
            REF[]BOOL new sum = HEAP[ curr size + size increment ]BOOL;
            new sum[ 1 : curr size ] := is sum;
            FOR n TO size increment DO new sum[ curr size + n ] := FALSE OD;
            curr size  +:= size increment;
            is sum      := new sum
        FI;
        BOOL is unique  := TRUE;
        FOR mc pos TO mc count WHILE is unique := NOT is sum[ i + mc[ mc pos ] ] DO SKIP OD;
        IF is unique THEN
            # i is a sequence element - store the sums             #
            FOR k TO mc count DO is sum[ i + mc[ k ] ] := TRUE OD;
            mc count +:= 1
        FI
    OD;

    # print parts of the sequence                                  #
    print( ( "Mian Chowla sequence elements 1..30:", newline ) );
    FOR i TO 30 DO print( ( " ", whole( mc[ i ], 0 ) ) ) OD;
    print( ( newline ) );
    print( ( "Mian Chowla sequence elements 91..100:", newline ) );
    FOR i FROM 91 TO 100 DO print( ( " ", whole( mc[ i ], 0 ) ) ) OD

END


mianChowla: function [n][
    result: new [1]
    sums: new [2]
    candidate: 1

    while [n > size result][
        fit: false
        'result ++ 0
        while [not? fit][
            candidate: candidate + 1
            fit: true
            result\[dec size result]: candidate
            loop result 'val [
                if contains? sums val + candidate [
                    fit: false
                    break
                ]
            ]
        ]

        loop result 'val [
            'sums ++ val + candidate
            unique 'sums
        ]
    ]
    return result
]

seq100: mianChowla 100

print "The first 30 terms of the Mian-Chowla sequence are:"
print slice seq100 0 29
print ""

print "Terms 91 to 100 of the sequence are:"
print slice seq100 90 99


# Find Mian-Chowla numbers: an
#                    where: ai = 1,
#                      and: an = smallest integer such that ai + aj is unique
#                                            for all i, j in 1 .. n && i <= j
#
BEGIN \
{

    FALSE      = 0;
    TRUE       = 1;

    mcCount    = 1;

    for( i = 1; mcCount <= 100; i ++ )
    {
        # assume i will be part of the sequence
        mc[ mcCount ] = i;
        # check the sums
        isUnique = TRUE;
        for( mcPos = 1; mcPos <= mcCount && isUnique; mcPos ++ )
        {
            isUnique = ! ( ( i + mc[ mcPos ] ) in isSum );
        } # for j
        if( isUnique )
        {
            # i is a sequence element - store the sums
            for( k = 1; k <= mcCount; k ++ )
            {
                isSum[ i + mc[ k ] ] = TRUE;
            } # for k
            mcCount ++;
        } # if isUnique
    } # for i
    # print the sequence
    printf( "Mian Chowla sequence elements 1..30:\n" );
    for( i = 1; i <= 30; i ++ )
    {
        printf( " %d", mc[ i ] );
    } # for i
    printf( "\n" );
    printf( "Mian Chowla sequence elements 91..100:\n" );
    for( i = 91; i <= 100; i ++ )
    {
        printf( " %d", mc[ i ] );
    } # for i
    printf( "\n" );

} # BEGIN