my $dec = "0123459";
my $hex_noprefix = "abcf123";
my $hex_withprefix = "0xabcf123";
my $oct_noprefix = "7651";
my $oct_withprefix = "07651";
my $bin_withprefix = "0b101011001";

print 0 + $dec, "\n";   # => 123459
print hex($hex_noprefix), "\n";    # => 180154659
print hex($hex_withprefix), "\n";    # => 180154659
print oct($hex_withprefix), "\n";    # => 180154659
print oct($oct_noprefix), "\n";    # => 4009
print oct($oct_withprefix), "\n";    # => 4009
print oct($bin_withprefix), "\n";    # => 345
# nothing for binary without prefix


with javascript_semantics
?to_integer("1234")             -- 1234
?to_integer("10101010",0,2)     -- 170, 0 on failure
?to_number("FFFFFFFF","?",16)   -- 4294967295.0, "?" on failure
?scanf("#FFFFFFFF","%f")        -- {{4294967295.0}}, {} on failure
?scanf("0o377","%o")            -- {{255}}
?scanf("1234","%d")             -- {{1234}}
include mpfr.e
mpz z = mpz_init()
mpz_set_str(z,"377",8)
?mpz_get_str(z)                 -- "255"
mpfr f = mpfr_init()
mpfr_set_str(f,"110.01",2)
?mpfr_get_fixed(f)              -- "6.25" (which is correct in decimal)


(de parseNumber (S Base)
   (let N 0
      (for C (chop S)
         (when (> (setq C (- (char C) `(char "0"))) 9)
            (dec 'C 39) )
         (setq N (+ C (* N Base))) )
      N ) )

(println (parseNumber "91g5dcg2h6da7260a9f3c4a" 19))


declare N fixed binary;
get edit (N) (A(7)); /* decimal input of 7 columns */
put skip list (N);

declare BS bit (32);
get edit (BS) (B(32)); /* Binary input of 32 binary digits. */
put skip edit (BS) (B);


function Select-NumberFromString
{
    [CmdletBinding(DefaultParameterSetName="Decimal")]
    [OutputType([PSCustomObject])]
    Param
    (
        [Parameter(Mandatory=$true,
                   ValueFromPipeline=$true,
                   ValueFromPipelineByPropertyName=$true,
                   Position=0)]
        [string]
        $InputObject,

        [Parameter(ParameterSetName="Decimal")]
        [Alias("d","Dec")]
        [switch]
        $Decimal,

        [Parameter(ParameterSetName="Hexadecimal")]
        [Alias("h","Hex")]
        [switch]
        $Hexadecimal,

        [Parameter(ParameterSetName="Octal")]
        [Alias("o","Oct")]
        [switch]
        $Octal,

        [Parameter(ParameterSetName="Binary")]
        [Alias("b","Bin")]
        [switch]
        $Binary
    )

    Begin
    {
        switch ($PSCmdlet.ParameterSetName)
        {
            "Decimal"     {$base = 10; $pattern = '[+-]?\b[0-9]+\b'; break}
            "Hexadecimal" {$base = 16; $pattern = '\b[0-9A-F]+\b'  ; break}
            "Octal"       {$base =  8; $pattern = '\b[0-7]+\b'     ; break}
            "Binary"      {$base =  2; $pattern = '\b[01]+\b'      ; break}
            "Default"     {$base = 10; $pattern = '[+-]?\b[0-9]+\b'; break}
        }
    }
    Process
    {
        foreach ($object in $InputObject)
        {
            if ($object -match $pattern)
            {
                $string = $Matches[0]
            }
            else
            {
                $string = $null
            }

            try
            {
                $value = [Convert]::ToInt32($string, $base)
            }
            catch
            {
                $value = $null
            }

            [PSCustomObject]@{
                Number      = $value
                String      = $string
                Base        = $base
                IsNumber    = $value -is [int]
                InputString = $object
            }

        }
    }
}


  ;Val() parses integer strings
  ; decimal numbers have no prefix, hexadecimal needs a prefix of '$', binary needs a prefix of '%'
  Val("1024102410241024")      ; => 1024102410241024
  Val("$10FFFFFFFF")           ; => 73014444031
  Val("%1000")                 ; => 8


>>> text = '100'
>>> for base in range(2,21):
    print ("String '%s' in base %i is  %i in base 10"
           % (text, base, int(text, base)))

String '100' in base 2 is  4 in base 10
String '100' in base 3 is  9 in base 10
String '100' in base 4 is  16 in base 10
String '100' in base 5 is  25 in base 10
String '100' in base 6 is  36 in base 10
String '100' in base 7 is  49 in base 10
String '100' in base 8 is  64 in base 10
String '100' in base 9 is  81 in base 10
String '100' in base 10 is  100 in base 10
String '100' in base 11 is  121 in base 10
String '100' in base 12 is  144 in base 10
String '100' in base 13 is  169 in base 10
String '100' in base 14 is  196 in base 10
String '100' in base 15 is  225 in base 10
String '100' in base 16 is  256 in base 10
String '100' in base 17 is  289 in base 10
String '100' in base 18 is  324 in base 10
String '100' in base 19 is  361 in base 10
String '100' in base 20 is  400 in base 10


# parse a string to decimal
as.numeric("20")    # 20
# parse a hex-string to decimal
as.numeric("0x20")  # 32
# parse a string to hexadecimal
as.hexmode(as.numeric("32")) # "20"
# parse a string to octal
as.octmode(as.numeric("20")) # "24"


#lang racket

;; Number literals can use #x, #o, and #b for different radices
(list 123 #x7B #o173 #b1111011)
;; -> '(123 123 123 123)

;; Explicit conversion of strings can use any radix up to 16
(list (string->number     "123")
      (string->number     "123" 10)
      (string->number      "7B" 16)
      (string->number      "83" 15)
      (string->number      "96" 13)
      (string->number     "173"  8)
      (string->number   "11120"  3)
      (string->number "1111011"  2))
;; -> '(123 123 123 123 123 123 123 123)


  ╔══════════════════════════════════════════════════════════════════════════════════╗
  ║ In REXX, there are no  numeric-type  variables  (integer, float, real, unsigned, ║
  ║ logical, binary, complex, double, etc),  only  character.   Everything is stored ║
  ║ as a character string.   Arithmetic is done almost exactly the way a schoolchild ║
  ║ would perform it.  Putting it simply,  to add,  align the two numbers up  (right ║
  ║ justified, with the decimal being the pivot)  and add the columns up, adding the ║
  ║ carries and honoring the signs.                                                  ║
  ║                                                                                ║
  ║ Multiplications and divisions are similarly performed.                           ║
  ╚══════════════════════════════════════════════════════════════════════════════════╝


fn main() {
    println!(
        "Parse from plain decimal: {}",
        "123".parse::<u32>().unwrap()
    );

    println!(
        "Parse with a given radix (2-36 supported): {}",
        u32::from_str_radix("deadbeef", 16).unwrap()
    );
}


object Main extends App {

  val (s, bases) = ("100", Seq(2, 8, 10, 16, 19, 36))
  bases.foreach(base => println(f"String $s in base $base%2d is $BigInt(s, base)%5d"))
}


$ include "seed7_05.s7i";

const proc: main is func
  begin
    writeln(integer("0123459", 10));
    writeln(integer("abcf123", 16));
    writeln(integer("7651", 8));
    writeln(integer("1010011010", 2));
    writeln(integer("tplig0", 32));
    writeln(integer("gc0uy9", 36));
  end func;


var dec            = '0123459';
var hex_noprefix   = 'abcf123';
var hex_withprefix = '0xabcf123';
var oct_noprefix   = '7651';
var oct_withprefix = '07651';
var bin_noprefix   = '101011001';
var bin_withprefix = '0b101011001';

say dec.num;                    # => 123459
say hex_noprefix.hex;           # => 180154659
say hex_withprefix.hex;         # => 180154659
say oct_noprefix.oct;           # => 4009
say oct_withprefix.oct;         # => 4009
say bin_noprefix.bin;           # => 345
say bin_withprefix.bin;         # => 345


- Int.fromString "0123459";
val it = SOME 123459 : int option
- StringCvt.scanString (Int.scan StringCvt.HEX) "0xabcf123";
val it = SOME 180154659 : int option
- StringCvt.scanString (Int.scan StringCvt.HEX) "abcf123";
val it = SOME 180154659 : int option
- StringCvt.scanString (Int.scan StringCvt.OCT) "7651";
val it = SOME 4009 : int option
- StringCvt.scanString (Int.scan StringCvt.BIN) "101011001";
val it = SOME 345 : int option


package require Tcl 8.6;  # For easy scanning of binary

# The strings to parse
set dec1 "0123459"
set hex2 "abcf123"
set oct3 "7651"
set bin4 "101011001"

# Parse the numbers
scan $dec1 "%d" v1
scan $hex2 "%x" v2
scan $oct3 "%o" v3
scan $bin4 "%b" v4; # Only 8.6-specific operation; others work in all versions

# Print out what happened
puts "$dec1->$v1 $hex2->$v2 $oct3->$v3 $bin4->$v4"


include c:\cxpl\codes;
int  N;  real R;
[Text(8, "123_456");
N:= IntIn(8);
IntOut(0, N);  CrLf(0);
Text(8, "ABcd12");
N:= HexIn(8);
HexOut(0, N);  CrLf(0);
Text(8, "-3.14159e3");
R:= RlIn(8);
RlOut(0, R);  CrLf(0);
]


fcn b2b(base){
   ns:=[20..30].pump(List,T("toString",base));
   ns.println();
   ns.pump(List,T("toInt",base)).println("\n")
}
b2b(2); b2b(10); b2b(16); b2b(19);


F gen_row(w, s)
   ‘Create all patterns of a row or col that match given runs.’
   F gen_seg([[Int]] o, Int sp) -> [[Int]]
      I o.empty
         R [[2] * sp]
      [[Int]] r
      L(x) 1 .< sp - o.len + 2
         L(tail) @gen_seg(o[1..], sp - x)
            r [+]= [2] * x [+] o[0] [+] tail
      R r

   R gen_seg(s.map(i -> [1] * i), w + 1 - sum(s)).map(x -> x[1..])

F deduce(hr, vr)
   ‘Fix inevitable value of cells, and propagate.’
   F allowable(row)
      R row.reduce((a, b) -> zip(a, b).map((x, y) -> x [|] y))

   F fits(a, b)
      R all(zip(a, b).map((x, y) -> x [&] y))

   V (w, h) = (vr.len, hr.len)
   V rows = hr.map(x -> gen_row(@w, x))
   V cols = vr.map(x -> gen_row(@h, x))
   V can_do = rows.map(allowable)

   V mod_rows = Set[Int]()
   V mod_cols = Set(0 .< w)

   F fix_col(n)
      ‘See if any value in a given column is fixed;
        if so, mark its corresponding row for future fixup.’
      V c = @can_do.map(x -> x[@n])
      @cols[n] = @cols[n].filter(x -> @@fits(x, @c))
      L(x) @allowable(@cols[n])
         V i = L.index
         I x != @can_do[i][n]
            @mod_rows.add(i)
            @can_do[i][n] [&]= x

   F fix_row(n)
      ‘Ditto, for rows.’
      V c = @can_do[n]
      @rows[n] = @rows[n].filter(x -> @@fits(x, @c))
      L(x) @allowable(@rows[n])
         V i = L.index
         I x != @can_do[n][i]
            @mod_cols.add(i)
            @can_do[n][i] [&]= x

   F show_gram(m)
      L(x) m
         print(x.map(i -> ‘x#.?’[i]).join(‘ ’))
      print()

   L !mod_cols.empty
      L(i) mod_cols
         fix_col(i)
      mod_cols.clear()
      L(i) mod_rows
         fix_row(i)
      mod_rows.clear()

   I all(multiloop((0 .< w), (0 .< h), (j, i) -> @can_do[i][j] C (1, 2)))
      print(‘Solution would be unique’)
   E
      print(‘Solution may not be unique, doing exhaustive search:’)

   V out = [[Int]()] * h

   F try_all(Int n) -> Int
      I n >= @h
         L(j) 0 .< @w
            I @out.map(x -> x[@j]) !C @cols[j]
               R 0
         @show_gram(@out)
         R 1
      V sol = 0
      L(x) @rows[n]
         @out[n] = x
         sol += @try_all(n + 1)
      R sol

   V n = try_all(0)
   I n == 0
      print(‘No solution.’)
   E I n == 1
      print(‘Unique solution.’)
   E
      print(n‘ solutions.’)
   print()

F solve(p, show_runs = 1B)
   [[[Int]]] s
   L(l) p.split("\n")
      s [+]= l.split(‘ ’).map(w -> w.map(c -> c.code - ‘A’.code + 1))
   I show_runs
      print(‘Horizontal runs: ’s[0])
      print(‘Vertical runs: ’s[1])
   deduce(s[0], s[1])

L(p) File(‘nonogram_problems.txt’).read().split("\n\n")
   solve(p)

print(‘Extra example not solvable by deduction alone:’)
solve("B B A A\nB B A A")

print(‘Extra example where there is no solution:’)
solve("B A A\nA A A")


using System;
using System.Collections.Generic;
using static System.Linq.Enumerable;

public static class NonogramSolver
{
    public static void Main2() {
        foreach (var (x, y) in new [] {
            ("C BA CB BB F AE F A B", "AB CA AE GA E C D C"),
            ("F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC",
                "D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA"),
            ("CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC",
                "BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC"),
            ("E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
                "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM")
            })
        {
            Solve(x, y);
            Console.WriteLine();
        }
    }

    static void Solve(string rowLetters, string columnLetters) {
        var r = rowLetters.Split(" ").Select(row => row.Select(s => s - 'A' + 1).ToArray()).ToArray();
        var c = columnLetters.Split(" ").Select(column => column.Select(s => s - 'A' + 1).ToArray()).ToArray();
        Solve(r, c);
    }

    static void Solve(int[][] rowRuns, int[][] columnRuns) {
        int len = columnRuns.Length;
        var rows = rowRuns.Select(row => Generate(len, row)).ToList();
        var columns = columnRuns.Select(column => Generate(rowRuns.Length, column)).ToList();
        Reduce(rows, columns);
        foreach (var list in rows) {
            if (list.Count != 1) Console.WriteLine(Repeat('?', len).Spaced());
            else Console.WriteLine(list[0].ToString().PadLeft(len, '0').Replace('1', '#').Replace('0', '.').Reverse().Spaced());
        }
    }

    static List<BitSet> Generate(int length, params int[] runs) {
        var list = new List<BitSet>();
        BitSet initial = BitSet.Empty;
        int[] sums = new int[runs.Length];
        sums[0] = 0;
        for (int i = 1; i < runs.Length; i++) sums[i] = sums[i - 1] + runs[i - 1] + 1;
        for (int r = 0; r < runs.Length; r++) initial = initial.AddRange(sums[r], runs[r]);
        Generate(list, BitSet.Empty.Add(length), runs, sums, initial, 0, 0);
        return list;
    }

    static void Generate(List<BitSet> result, BitSet max, int[] runs, int[] sums, BitSet current, int index, int shift) {
        if (index == runs.Length) {
            result.Add(current);
            return;
        }
        while (current.Value < max.Value) {
            Generate(result, max, runs, sums, current, index + 1, shift);
            current = current.ShiftLeftAt(sums[index] + shift);
            shift++;
        }
    }

    static void Reduce(List<List<BitSet>> rows, List<List<BitSet>> columns) {
        for (int count = 1; count > 0; ) {
            foreach (var (rowIndex, row) in rows.WithIndex()) {
                var allOn  = row.Aggregate((a, b) => a & b);
                var allOff = row.Aggregate((a, b) => a | b);
                foreach (var (columnIndex, column) in columns.WithIndex()) {
                    count  = column.RemoveAll(c => allOn.Contains(columnIndex) && !c.Contains(rowIndex));
                    count += column.RemoveAll(c => !allOff.Contains(columnIndex) && c.Contains(rowIndex));
                }
            }
            foreach (var (columnIndex, column) in columns.WithIndex()) {
                var allOn  = column.Aggregate((a, b) => a & b);
                var allOff = column.Aggregate((a, b) => a | b);
                foreach (var (rowIndex, row) in rows.WithIndex()) {
                    count += row.RemoveAll(r => allOn.Contains(rowIndex) && !r.Contains(columnIndex));
                    count += row.RemoveAll(r => !allOff.Contains(rowIndex) && r.Contains(columnIndex));
                }
            }
        }
    }

    static IEnumerable<(int index, T element)> WithIndex<T>(this IEnumerable<T> source) {
        int i = 0;
        foreach (T element in source) {
            yield return (i++, element);
        }
    }

    static string Reverse(this string s) {
        char[] array = s.ToCharArray();
        Array.Reverse(array);
        return new string(array);
    }

    static string Spaced(this IEnumerable<char> s) => string.Join(" ", s);

    struct BitSet //Unused functionality elided.
    {
        public static BitSet Empty => default;
        private readonly int bits;
        public int Value => bits;

        private BitSet(int bits) => this.bits = bits;

        public BitSet Add(int item) => new BitSet(bits | (1 << item));
        public BitSet AddRange(int start, int count) => new BitSet(bits | (((1 << (start + count)) - 1) - ((1 << start) - 1)));
        public bool Contains(int item) => (bits & (1 << item)) != 0;
        public BitSet ShiftLeftAt(int index)  => new BitSet((bits >> index << (index + 1)) | (bits & ((1 << index) - 1)));
        public override string ToString() => Convert.ToString(bits, 2);

        public static BitSet operator &(BitSet a, BitSet b) => new BitSet(a.bits & b.bits);
        public static BitSet operator |(BitSet a, BitSet b) => new BitSet(a.bits | b.bits);
    }

}


// A class to solve Nonogram (Hadje) Puzzles
// Nigel Galloway - January 23rd., 2017
template<uint _N, uint _G> class Nonogram {
  enum class ng_val : char {X='#',B='.',V='?'};
  template<uint _NG> struct N {
    N() {}
    N(std::vector<int> ni,const int l) : X{},B{},Tx{},Tb{},ng(ni),En{},gNG(l){}
    std::bitset<_NG> X, B, T, Tx, Tb;
    std::vector<int> ng;
    int En, gNG;
    void        fn (const int n,const int i,const int g,const int e,const int l){
      if (fe(g,l,false) and fe(g+l,e,true)){
      if ((n+1) < ng.size()) {if (fe(g+e+l,1,false)) fn(n+1,i-e-1,g+e+l+1,ng[n+1],0);}
      else {
        if (fe(g+e+l,gNG-(g+e+l),false)){Tb &= T.flip(); Tx &= T.flip(); ++En;}
      }}
      if (l<=gNG-g-i-1) fn(n,i,g,e,l+1);
    }
    void        fi (const int n,const bool g) {X.set(n,g); B.set(n, not g);}
    ng_val      fg (const int n) const{return (X.test(n))? ng_val::X : (B.test(n))? ng_val::B : ng_val::V;}
    inline bool fe (const int n,const int i, const bool g){
      for (int e = n;e<n+i;++e) if ((g and fg(e)==ng_val::B) or (!g and fg(e)==ng_val::X)) return false; else T[e] = g;
      return true;
    }
    int         fl (){
      if (En == 1) return 1;
      Tx.set(); Tb.set(); En=0;
      fn(0,std::accumulate(ng.cbegin(),ng.cend(),0)+ng.size()-1,0,ng[0],0);
      return En;
    }}; // end of N
  std::vector<N<_G>> ng;
  std::vector<N<_N>> gn;
  int En, zN, zG;
  void setCell(uint n, uint i, bool g){ng[n].fi(i,g); gn[i].fi(n,g);}
public:
  Nonogram(const std::vector<std::vector<int>>& n,const std::vector<std::vector<int>>& i,const std::vector<std::string>& g = {}) : ng{}, gn{}, En{}, zN(n.size()), zG(i.size()) {
    for (int n=0; n<zG; n++) gn.push_back(N<_N>(i[n],zN));
    for (int i=0; i<zN; i++) {
      ng.push_back(N<_G>(n[i],zG));
      if (i < g.size()) for(int e=0; e<zG or e<g[i].size(); e++) if (g[i][e]=='#') setCell(i,e,true);
    }}
  bool solve(){
    int i{}, g{};
    for (int l = 0; l<zN; l++) {
      if ((g = ng[l].fl()) == 0) return false; else i+=g;
      for (int i = 0; i<zG; i++) if (ng[l].Tx[i] != ng[l].Tb[i]) setCell (l,i,ng[l].Tx[i]);
    }
    for (int l = 0; l<zG; l++) {
      if ((g = gn[l].fl()) == 0) return false; else i+=g;
      for (int i = 0; i<zN; i++) if (gn[l].Tx[i] != gn[l].Tb[i]) setCell (i,l,gn[l].Tx[i]);
    }
    if (i == En)    return false; else En = i;
    if (i == zN+zG) return true;  else return solve();
  }
  const std::string toStr() const {
    std::ostringstream n;
    for (int i = 0; i<zN; i++){for (int g = 0; g<zG; g++){n << static_cast<char>(ng[i].fg(g));}n<<std::endl;}
    return n.str();
  }};


(defpackage :ac3
  (:use :cl)
  (:export :var
           :domain
           :satisfies-p
           :constraint-possible-p
           :ac3)
  (:documentation "Implements the AC3 algorithm. Extend VAR with the variable
types for your particular problem and implement SATISFIES-P and
CONSTRAINT-POSSIBLE-P for your variables. Initialize the DOMAIN of your variables
with unary constraints already satisfied and then pass them to AC3 in a list."))

(in-package :ac3)

(defclass var ()
  ((domain :initarg :domain :accessor domain))
  (:documentation "The base variable type from which all other
variables should extend."))

(defgeneric satisfies-p (a b va vb)
  (:documentation "Determine if constrainted variables A and B are
satisfied by the instantiation of their respective values VA and VB."))

(defgeneric constraint-possible-p (a b)
  (:documentation "Determine if variables A and B can even be
checked for a binary constraint."))

(defun arc-reduce (a b)
  "Assuming A and B truly form a constraint, prune all values
from A that do not satisfy any value in B. Return T if the domain
of A changed by any amount, NIL otherwise."
  (let (change)
    (setf (domain a)
          (loop for va in (domain a)
             when (loop for vb in (domain b)
                     do (when (satisfies-p a b va vb)
                          (return t))
                     finally (setf change t) (return nil))
             collect va))
    change))

(defun binary-constraint-p (a b)
  "Check if variables A and B could form a constraint, then return T
if any of their values form a contradiction, NIL otherwise."
  (when (constraint-possible-p a b)
    (block found
      (loop for va in (domain a)
         do (loop for vb in (domain b)
               do (unless (satisfies-p a b va vb)
                    (return-from found t)))))))

(defun ac3 (vars)
  "Run the Arc Consistency 3 algorithm on the given set of variables.
Assumes unary constraints have already been satisfied."
  ;; Form a worklist of the constraints of every variable to every other variable.
  (let ((worklist (loop for x in vars
                     append (loop for y in vars
                               when (and (not (eq x y))
                                         (binary-constraint-p x y))
                               collect (cons x y)))))
    ;; Prune the worklist of satisfied arcs until it is empty.
    (loop while worklist
       do (destructuring-bind (x . y) (pop worklist)
            (when (arc-reduce x y)
              (if (domain x)
                  ;; If the current arc's domain was reduced, then append any arcs it
                  ;; is still constrained with to the end of the worklist, as they
                  ;; need to be rechecked.
                  (setf worklist (nconc worklist (loop for z in vars
                                                    when (and (not (eq x z))
                                                              (not (eq y z))
                                                              (binary-constraint-p x z))
                                                    collect (cons z x))))
                  (error "No values left in ~a" x))))
       finally (return vars))))

(defpackage :nonogram
  (:use :cl :ac3)
  (:documentation "Utilize the AC3 package to solve nonograms."))

(in-package :nonogram)

(defclass line (var)
  ((depth :initarg :depth :accessor depth))
  (:documentation "A LINE is a variable that represents either a
column or row of cells and all of the permutations of values those
cells can assume"))

(defmethod print-object ((o line) s)
  (print-unreadable-object (o s :type t)
    (with-slots (depth domain) o
      (format s ":depth ~a :domain ~a" depth domain))))

(defclass row (line) ())

(defclass col (line) ())

(defmethod satisfies-p ((a line) (b line) va vb)
  (eq (aref va (depth b))
      (aref vb (depth a))))

(defmethod constraint-possible-p ((a line) (b line))
  (not (eq (type-of a) (type-of b))))

(defun make-line-domain (runs length &optional (start 0) acc)
  "Enumerate all valid permutations of a line's values."
  (if runs
      (loop for i from start
         to (- length
               (reduce #'+ (cdr runs))
               (length (cdr runs))
               (car runs))
         append (make-line-domain (cdr runs) length (+ 1 i (car runs)) (cons i acc)))
      (list (reverse acc))))

(defun make-line (type runs depth length)
  "Create and initialize a ROW or COL instance."
  (make-instance
   type :depth depth :domain
   (loop for value in (make-line-domain runs length)
      collect (let ((arr (make-array length :initial-element nil)))
                (loop for pos in value
                   for run in runs
                   do (loop for i from pos below (+ pos run)
                         do (setf (aref arr i) t)))
                arr))))

(defun make-lines (type run-set length)
  "Initialize a set of lines."
  (loop for runs across run-set
     for depth from 0
     collect (make-line type runs depth length)))

(defun nonogram (problem)
  "Given a nonogram problem description, solve it and print the result."
  (let* ((nrows (length (aref problem 0)))
         (ncols (length (aref problem 1)))
         (vars (ac3 (append (make-lines 'row (aref problem 0) ncols)
                            (make-lines 'col (aref problem 1) nrows)))))
    (loop for var in vars
       while (eq 'row (type-of var))
       do (terpri)
         (loop for cell across (car (domain var))
            do (format t "~a " (if cell #\# #\.))))))

(defparameter *test-set*
  '("C BA CB BB F AE F A B"
    "AB CA AE GA E C D C"))

;; Helper functions to read and parse problems from a file.

(defun parse-word (word)
  (map 'list (lambda (c) (- (digit-char-p c 36) 9)) word))

(defun parse-line (line)
  (map 'vector #'parse-word (uiop:split-string (string-upcase line))))

(defun parse-nonogram (rows columns)
  (vector (parse-line rows)
          (parse-line columns)))

(defun read-until-line (stream)
  (loop (let ((line (read-line stream)))
          (when (> (length (string-trim '(#\space) line)) 0)
            (print line)
            (return line)))))

(defun solve-from-file (file)
  (handler-case
      (with-open-file (s file)
        (loop
           (terpri)
           (nonogram (parse-nonogram (read-until-line s)
                                     (read-until-line s)))))
    (end-of-file ())))


V tokens = 12

F getTokens(curTokens) -> N
   print(‘How many tokens would you like to take? ’, end' ‘’)
   V take = Int(input())

   I (take < 1 | take > 3)
      print("Number must be between 1 and 3.\n")
      getTokens(curTokens)
      R

   :tokens = curTokens - take
   print(‘You take #. tokens.’.format(take))
   print("#. tokens remaining.\n".format(:tokens))

F compTurn(curTokens)
   V take = curTokens % 4
   :tokens = curTokens - take
   print(‘Computer takes #. tokens.’.format(take))
   print("#. tokens remaining.\n".format(:tokens))

L tokens > 0
   getTokens(tokens)
   compTurn(tokens)

print(‘Computer wins!’)


import std.stdio, std.range, std.file, std.algorithm, std.string;

/// Create all patterns of a row or col that match given runs.
auto genRow(in int w, in int[] s) pure nothrow @safe {
    static int[][] genSeg(in int[][] o, in int sp) pure nothrow @safe {
        if (o.empty)
            return [[2].replicate(sp)];

        typeof(return) result;
        foreach (immutable x; 1 .. sp - o.length + 2)
            foreach (const tail; genSeg(o[1 .. $], sp - x))
                result ~= [2].replicate(x) ~ o[0] ~ tail;
        return result;
    }

    const ones = s.map!(i => [1].replicate(i)).array;
    return genSeg(ones, w + 1 - s.sum).map!dropOne;
}

/// Fix inevitable value of cells, and propagate.
void deduce(in int[][] hr, in int[][] vr) {
    static int[] allowable(in int[][] row) pure nothrow @safe {
        //return row.dropOne.fold!q{ a[] |= b[] }(row[0].dup);
        return reduce!q{ a[] |= b[] }(row[0].dup, row.dropOne);
    }

    static bool fits(in int[] a, in int[] b)
    pure /*nothrow*/ @safe /*@nogc*/ {
        return zip(a, b).all!(xy => xy[0] & xy[1]);
    }

    immutable int w = vr.length,
                  h = hr.length;
    auto rows = hr.map!(x => genRow(w, x).array).array;
    auto cols = vr.map!(x => genRow(h, x).array).array;
    auto canDo = rows.map!allowable.array;

    // Initially mark all columns for update.
    bool[uint] modRows, modCols;
    modCols = true.repeat.enumerate!uint.take(w).assocArray;

    /// See if any value a given column is fixed; if so,
    /// mark its corresponding row for future fixup.
    void fixCol(in int n) /*nothrow*/ @safe {
        const c = canDo.map!(x => x[n]).array;
        cols[n] = cols[n].remove!(x => !fits(x, c)); // Throws.
        foreach (immutable i, immutable x; allowable(cols[n]))
            if (x != canDo[i][n]) {
                modRows[i] = true;
                canDo[i][n] &= x;
            }
    }

    /// Ditto, for rows.
    void fixRow(in int n) /*nothrow*/ @safe {
        const c = canDo[n];
        rows[n] = rows[n].remove!(x => !fits(x, c)); // Throws.
        foreach (immutable i, immutable x; allowable(rows[n]))
            if (x != canDo[n][i]) {
                modCols[i] = true;
                canDo[n][i] &= x;
            }
    }

    void showGram(in int[][] m) {
        // If there's 'x', something is wrong.
        // If there's '?', needs more work.
        m.each!(x => writefln("%-(%c %)", x.map!(i => "x#.?"[i])));
        writeln;
    }

    while (modCols.length > 0) {
        modCols.byKey.each!fixCol;
        modCols = null;
        modRows.byKey.each!fixRow;
        modRows = null;
    }

    if (cartesianProduct(h.iota, w.iota)
        .all!(ij => canDo[ij[0]][ij[1]] == 1 || canDo[ij[0]][ij[1]] == 2))
        "Solution would be unique".writeln;
    else
        "Solution may not be unique, doing exhaustive search:".writeln;

    // We actually do exhaustive search anyway. Unique
    // solution takes no time in this phase anyway.
    auto out_ = new const(int)[][](h);

    uint tryAll(in int n = 0) {
        if (n >= h) {
            foreach (immutable j; 0 .. w)
                if (!cols[j].canFind(out_.map!(x => x[j]).array))
                    return 0;
            showGram(out_);
            return 1;
        }
        typeof(return) sol = 0;
        foreach (const x; rows[n]) {
            out_[n] = x;
            sol += tryAll(n + 1);
        }
        return sol;
    }

    immutable n = tryAll;
    switch (n) {
        case 0:  "No solution.".writeln;     break;
        case 1:  "Unique solution.".writeln; break;
        default: writeln(n, " solutions."); break;
    }
    writeln;
}

void solve(in string p, in bool showRuns=true) {
    immutable s = p.splitLines.map!(l => l.split.map!(w =>
                    w.map!(c => int(c - 'A' + 1)).array).array).array;
                    //w.map!(c => c - 'A' + 1))).to!(int[][][]);

    if (showRuns) {
        writeln("Horizontal runs: ", s[0]);
        writeln("Vertical runs: ", s[1]);
    }
    deduce(s[0], s[1]);
}

void main() {
    // Read problems from file.
    immutable fn = "nonogram_problems.txt";
    fn.readText.split("\n\n").filter!(p => !p.strip.empty).each!(p => p.strip.solve);

    "Extra example not solvable by deduction alone:".writeln;
    "B B A A\nB B A A".solve;

    "Extra example where there is no solution:".writeln;
    "B A A\nA A A".solve;
}


bdos:		equ	5		; CP/M syscalls
puts:		equ	9
putch:		equ	2
getch:		equ	1

maxtokens:	equ	12		; you can change this for more tokens

		org	100h
		lxi	d,nim
		call	outs
		mvi	b,maxtokens	; 12 tokens
gameloop:	lxi	d,tokens	; Show tokens
		call	outs
		mov	c,b
showtokens:	dcr	c
		jm	tokensdone
		mvi	a,'|'
		call	outa
		jmp	showtokens
tokensdone:	lxi	d,nl
		call	outs
		lxi	d,prompt	; Show prompt
		call	outs
readinput:	call	ina		; Read input
		sui	'1'		; Subtract '1' (lowest acceptable
		jc	wrong		; input)
		cpi	3		; range of values is [0..2]
		jnc	wrong
		cmp	b		; can't take more than there are either
		jnc	wrong
		cma			; negate; -a = ~(a-1)
		mov	c,a		; keep value
		add	b		; subtract from tokens
		mov	b,a
		mvi	a,4		; computer take 4-X tokens
		add	c
		mov	c,a
		lxi	d,response	; print how many I take
		call	outs
		mvi	a,'0'
		add	c
		call	outa
		mov	a,b		; subtract the ones I take
		sub	c
		jz	done		; if I took the last one, I won
		mov	b,a
		lxi	d,nl
		call	outs
		call	outs
		jmp	gameloop
done:		lxi	d,lose		; there's no win condition
		jmp	outs
		;; Invalid input
wrong:		lxi	d,wronginp
		call	outs
		jmp 	readinput
		;; Read character into A and keep registers
ina:		push	b
		push	d
		push	h
		mvi	c,getch
		call	bdos
		jmp	restore
		;; Print A and keep registers
outa:		push	b
		push	d
		push	h
		mvi	c,putch
		mov	e,a
		call	bdos
		jmp	restore
		;; Print string and keep registers
outs:		push	b
		push	d
		push	h
		mvi	c,puts
		call	bdos
		;; Restore registers
restore:	pop	h
		pop 	d
		pop	b
		ret
nim:		db	'Nim',13,10,13,10,'$'
prompt:		db	'How many will you take (1-3)? $'
response:	db	13,10,'I take $'
tokens:		db	'Tokens: $'
lose:		db	13,10,'You lose!$'
nl:		db	13,10,'$'
wronginp:	db	8,7,32,8,'$'		; beep and erase choice


		;; MS-DOS Nim; assembles with nasm.
		bits	16
		cpu	8086
getch:		equ	1
putch:		equ	2
puts:		equ	9 		; INT 21h calls
maxtokens:	equ	12		; Amount of tokens there are
section		.text
		org	100h
		mov	dx,nim		; Print sign-on
		call	outs
		mov	ch,maxtokens	; CH = amount of tokens we have
loop:		mov	dx,tokens	; Tokens: |||...
		call	outs
		mov	ah,putch	; Print a | for each token
		mov	dl,'|'
		mov	dh,ch
puttoks:	int	21h
		dec	dh
		jnz	puttoks
		mov	dx,prompt	; Ask the user how many to take
		call	outs
ask:		mov	ah,getch	; Read keypress
		int	21h
		sub	al,'1'		; Make number (minus one)
		jc	bad		; Carry, it was <1 (bad)
		inc	al		; Add 1 (because we subtracted '1')
		cmp	al,3
		ja	bad		; If it was >3, it is bad
		cmp	al,ch
		ja	bad		; If it was > amount left, it is bad
		sub	ch,al		; Remove your tokens from pile
		mov	cl,4		; I take 4-N, which is 3-N-1
		sub	cl,al
		sub	ch,cl		; Remove my tokens from pile
		mov	dx,response	; Tell the user how many I took.
		call	outs
		mov	dl,'0'
		add	dl,cl
		mov	ah,putch
		int	21h
		cmp	ch,0		; Are there any tokens left?
		jne	loop		; If not, prompt again
		mov	dx,lose		; But otherwise, you've lost
		; Fall through into print string routine and then stop.
		;; Print string in DX. (This saves a byte each CALL)
outs:		mov	ah,puts
		int	21h
		ret
		;; Input is bad; beep, erase, ask again
bad:		mov	dx,wronginp
		call	outs
		jmp	ask
section		.data
nim:		db	'Nim$'
prompt:		db	13,10,'How many will you take (1-3)? $'
response:	db	13,10,'I take $'
tokens:		db	13,10,13,10,'Tokens: $'
lose:		db	13,10,'You lose!$'
wronginp:       db      8,7,32,8,'$'


(*
I define a discriminated union to provide Nonogram Solver functionality.
Nigel Galloway May 28th., 2016
*)
type N =
  |X |B |V
  static member fn n i =
    let     fn n i = [for g = 0 to i-n do yield Array.init (n+g) (fun e -> if e >= g then X else B)]
    let rec fi n i = [
      match n with
      | h::t -> match t with
                | [] -> for g in fn h i do yield Array.append g (Array.init (i-g.Length) (fun _ -> B))
                | _  -> for g in fn h ((i-List.sum t)+t.Length) do for a in fi t (i-g.Length-1) do yield Array.concat[g;[|B|];a]
      | []   -> yield Array.init i (fun _ -> B)
    ]
    fi n i
  static member fi n i = Array.map2 (fun n g -> match (n,g) with |X,X->X |B,B->B |_->V) n i
  static member fg (n: N[]) (i: N[][]) g = n |> Seq.mapi (fun e n -> i.[e].[g] = n || i.[e].[g] = V) |> Seq.forall (fun n -> n)
  static member fe (n: N[][]) = n|> Array.forall (fun n -> Array.forall (fun n -> n <> V) n)
  static member fl n = n |> Array.Parallel.map (fun n -> Seq.reduce (fun n g -> N.fi n g) n)
  static member fa (nga: list<N []>[]) ngb = Array.Parallel.mapi (fun i n -> List.filter (fun n -> N.fg n ngb i) n) nga
  static member fo n i g e =
    let na = N.fa n e
    let ia = N.fl na
    let ga = N.fa g ia
    (na, ia, ga, (N.fl ga))
  static member toStr n = match n with |X->"X"|B->"."|V->"?"
  static member presolve ((na: list<N []>[]), (ga: list<N []>[])) =
    let nb = N.fl na
    let x = N.fa ga nb
    let rec fn n i g e l =
      let na,ia,ga,ea = N.fo n i g e
      let el = ((Array.map (fun n -> List.length n) na), (Array.map (fun n -> List.length n) ga))
      if ((fst el) = (fst l)) && ((snd el) = (snd l)) then (n,i,g,e,(Array.forall (fun n -> n = 1) (fst l))) else fn na ia ga ea el
    fn na nb x (N.fl x) ((Array.map (fun n -> List.length n) na), (Array.map (fun n -> List.length n) ga))


BYTE FUNC PlayerTurn(BYTE tokens)
  BYTE t,max

  IF tokens<3 THEN
    max=tokens
  ELSE
    max=3
  FI

  DO
    PrintF("How many tokens would you like to take (1-%B)? ",max)
    t=InputB()
  UNTIL t>=1 AND t<=max
  OD
  PrintF("Player takes %B tokens.%E",t)
  t=tokens-t
  IF t=0 THEN
    PrintE("Player wins.")
  FI
RETURN (t)

BYTE FUNC ComputerTurn(BYTE tokens)
  BYTE t

  t=tokens MOD 4
  PrintF("Computer takes %B tokens.%E",t)
  t=tokens-t
  IF t=0 THEN
    PrintE("Computer wins.")
  FI
RETURN (t)

PROC Main()
  BYTE tokens=[12],t
  BYTE player=[1]

  WHILE tokens>0
  DO
    PrintF("Available tokens: %B%E",tokens)
    IF player THEN
      tokens=PlayerTurn(tokens)
    ELSE
      tokens=ComputerTurn(tokens)
    FI
    player=1-player
  OD
RETURN


with Ada.Text_IO;

procedure Nim is
   subtype Token_Range is Positive range 1 .. 3;

   package TIO renames Ada.Text_IO;
   package Token_IO is new TIO.Integer_IO(Token_Range);

   procedure Get_Tokens(remaining : in Natural; how_many : out Token_Range) is
   begin
      loop
         TIO.Put("How many tokens would you like to take? ");
         begin
            Token_IO.Get(TIO.Standard_Input, how_many);
            exit when how_many < remaining;
            raise Constraint_Error;
         exception
            when TIO.Data_Error | Constraint_Error =>
               if not TIO.End_Of_Line(TIO.Standard_Input) then
                  TIO.Skip_Line(TIO.Standard_Input);
               end if;
               TIO.Put_Line("Invalid input.");
         end;
      end loop;
   end;

    tokens : Natural := 12;
    how_many : Token_Range;
begin
   loop
      TIO.Put_Line(tokens'Img & " tokens remain.");
      -- no exit condition here: human cannot win.
      Get_Tokens(tokens, how_many);
      TIO.Put_Line("Human takes" & how_many'Img & " tokens.");
      tokens := tokens - how_many;
      -- computer's turn: take the remaining N tokens to amount to 4.
      how_many := tokens mod 4;
      TIO.Put_Line("Computer takes" & how_many'Img & " tokens.");
      tokens := tokens - how_many;
      Ada.Text_IO.New_Line;
      exit when tokens = 0;
   end loop;

   TIO.Put_Line("Computer won!");
end Nim;


BEGIN # play Nim #
    # gets a single character answer from standin and returns it #
    PROC answer = ( STRING prompt )CHAR:
         BEGIN
             STRING s;
             INT left := 0;
             WHILE print( ( prompt, "> " ) );
                   read( ( s, newline ) );
                   left      := LWB s;
                   INT right := UPB s;
                   WHILE IF left  > right THEN FALSE ELSE s[ left  ] = " " FI DO left  +:= 1 OD;
                   WHILE IF right < left  THEN FALSE ELSE s[ right ] = " " FI DO right -:= 1 OD;
                   left /= right
             DO
                 print( ( "Please reply with a single character", newline ) )
             OD;
             s[ left ]
         END # answer # ;
    # play one game #
    INT    tokens := 12;
    STRING suffix := "";
    WHILE
        CHAR  user;
        WHILE user := answer( "There are "
                            + whole( tokens, 0 )
                            + " tokens"
                            + suffix
                            + ", how many do you want to take (1, 2 or 3)"
                            );
              user /= "1" AND user /= "2" AND user /= "3"
        DO
            print( ( "please answer 1, 2 or 3", newline ) )
        OD;
        INT move = ABS user - ABS "0";
        print( ( "I take ", whole( 4 - move, 0 ), newline ) );
        suffix  := " left";
        tokens -:= 4;
        tokens > 0
    DO SKIP OD;
    print( ( "I win!", newline ) )
END


package main

import (
    "fmt"
    "strings"
)

type BitSet []bool

func (bs BitSet) and(other BitSet) {
    for i := range bs {
        if bs[i] && other[i] {
            bs[i] = true
        } else {
            bs[i] = false
        }
    }
}

func (bs BitSet) or(other BitSet) {
    for i := range bs {
        if bs[i] || other[i] {
            bs[i] = true
        } else {
            bs[i] = false
        }
    }
}

func iff(cond bool, s1, s2 string) string {
    if cond {
        return s1
    }
    return s2
}

func newPuzzle(data [2]string) {
    rowData := strings.Fields(data[0])
    colData := strings.Fields(data[1])
    rows := getCandidates(rowData, len(colData))
    cols := getCandidates(colData, len(rowData))

    for {
        numChanged := reduceMutual(cols, rows)
        if numChanged == -1 {
            fmt.Println("No solution")
            return
        }
        if numChanged == 0 {
            break
        }
    }

    for _, row := range rows {
        for i := 0; i < len(cols); i++ {
            fmt.Printf(iff(row[0][i], "# ", ". "))
        }
        fmt.Println()
    }
    fmt.Println()
}

// collect all possible solutions for the given clues
func getCandidates(data []string, le int) [][]BitSet {
    var result [][]BitSet
    for _, s := range data {
        var lst []BitSet
        a := []byte(s)
        sumBytes := 0
        for _, b := range a {
            sumBytes += int(b - 'A' + 1)
        }
        prep := make([]string, len(a))
        for i, b := range a {
            prep[i] = strings.Repeat("1", int(b-'A'+1))
        }
        for _, r := range genSequence(prep, le-sumBytes+1) {
            bits := []byte(r[1:])
            bitset := make(BitSet, len(bits))
            for i, b := range bits {
                bitset[i] = b == '1'
            }
            lst = append(lst, bitset)
        }
        result = append(result, lst)
    }
    return result
}

func genSequence(ones []string, numZeros int) []string {
    le := len(ones)
    if le == 0 {
        return []string{strings.Repeat("0", numZeros)}
    }
    var result []string
    for x := 1; x < numZeros-le+2; x++ {
        skipOne := ones[1:]
        for _, tail := range genSequence(skipOne, numZeros-x) {
            result = append(result, strings.Repeat("0", x)+ones[0]+tail)
        }
    }
    return result
}

/* If all the candidates for a row have a value in common for a certain cell,
   then it's the only possible outcome, and all the candidates from the
   corresponding column need to have that value for that cell too. The ones
   that don't, are removed. The same for all columns. It goes back and forth,
   until no more candidates can be removed or a list is empty (failure).
*/

func reduceMutual(cols, rows [][]BitSet) int {
    countRemoved1 := reduce(cols, rows)
    if countRemoved1 == -1 {
        return -1
    }
    countRemoved2 := reduce(rows, cols)
    if countRemoved2 == -1 {
        return -1
    }
    return countRemoved1 + countRemoved2
}

func reduce(a, b [][]BitSet) int {
    countRemoved := 0
    for i := 0; i < len(a); i++ {
        commonOn := make(BitSet, len(b))
        for j := 0; j < len(b); j++ {
            commonOn[j] = true
        }
        commonOff := make(BitSet, len(b))

        // determine which values all candidates of a[i] have in common
        for _, candidate := range a[i] {
            commonOn.and(candidate)
            commonOff.or(candidate)
        }

        // remove from b[j] all candidates that don't share the forced values
        for j := 0; j < len(b); j++ {
            fi, fj := i, j
            for k := len(b[j]) - 1; k >= 0; k-- {
                cnd := b[j][k]
                if (commonOn[fj] && !cnd[fi]) || (!commonOff[fj] && cnd[fi]) {
                    lb := len(b[j])
                    copy(b[j][k:], b[j][k+1:])
                    b[j][lb-1] = nil
                    b[j] = b[j][:lb-1]
                    countRemoved++
                }
            }
            if len(b[j]) == 0 {
                return -1
            }
        }
    }
    return countRemoved
}

func main() {
    p1 := [2]string{"C BA CB BB F AE F A B", "AB CA AE GA E C D C"}

    p2 := [2]string{
        "F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC",
        "D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA",
    }

    p3 := [2]string{
        "CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH " +
            "BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC",
        "BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF " +
            "AAAAD BDG CEF CBDB BBB FC",
    }

    p4 := [2]string{
        "E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
        "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ " +
            "ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM",
    }

    for _, puzzleData := range [][2]string{p1, p2, p3, p4} {
        newPuzzle(puzzleData)
    }
}


BEGIN

PROCEDURE WELCOME;
BEGIN
  WRITE("THE GAME OF NIM");
  WRITE("");
  WRITE("WE BEGIN WITH 12 TOKENS. ON EACH TURN, A");
  WRITE("PLAYER MAY TAKE BETWEEN 1 AND 3 TOKENS.");
  WRITE("THE PLAYER WHO TAKES THE LAST TOKEN WINS.");
  WRITE("");
END;

PROCEDURE SHOW(N);
INTEGER N;
BEGIN
  WRITE("REMAINING TOKENS:",N);
END;

INTEGER FUNCTION GETNUM(LOWLIM, TOPLIM);
INTEGER LOWLIM, TOPLIM;
BEGIN
  INTEGER OK, N;
  OK := 0;
  WHILE OK = 0 DO
    BEGIN
      WRITE("YOU TAKE:");
      READ(N);
      IF N < LOWLIM OR N > TOPLIM THEN
        BEGIN
          WRITE("MUST TAKE BETWEEN",LOWLIM," AND",TOPLIM,".");
          WRITE("TRY AGAIN.");
        END
      ELSE
          OK := 1;
    END;
  GETNUM := N;
END;

INTEGER FUNCTION PLAY(PLAYER, TOKENS, TAKEN);
INTEGER PLAYER, TOKENS, TAKEN;
BEGIN
  IF PLAYER = 1 THEN      % HUMAN PLAYER'S MOVE %
    TAKEN := GETNUM(1,3)
  ELSE                    % MACHINE'S MOVE %
    TAKEN := 4 - TAKEN;
  PLAY := TAKEN;
END;

PROCEDURE REPORT(WINNER);
INTEGER WINNER; % MACHINE = 0, HUMAN = 1 %
BEGIN
  IF WINNER = 0 THEN
    WRITE("I TOOK THE LAST ONE, SO I WIN. SORRY ABOUT THAT.")
  ELSE
    WRITE("YOU TOOK THE LAST ONE. YOU WIN. CONGRATULATIONS!");
END;

% MAIN CODE BEGINS HERE %

INTEGER PLAYER, TOKENS, TAKEN, HUMAN, MACHINE;

MACHINE := 0;
HUMAN := 1;
TOKENS := 12;
TAKEN := 0;
PLAYER := HUMAN;
WELCOME;
WRITE("YOU GO FIRST.");
WHILE TOKENS > 0 DO
  BEGIN
    SHOW(TOKENS);
    TAKEN := PLAY(PLAYER, TOKENS, TAKEN);
    TOKENS := TOKENS - TAKEN;
    IF PLAYER = MACHINE THEN WRITE("I TOOK:",TAKEN);
    IF TOKENS > 0 THEN PLAYER := 1 - PLAYER;
  END;
REPORT(PLAYER);
WRITE("THANKS FOR PLAYING!");

END


0ST$(0)="YOU MUST TAKE 1, 2, OR 3 TOKENS.":FORHEAP=12TO1STEP-4:PRINT"THERE ARE "HEAP" TOKENS REMAINING.":FORI=0TO1:INPUT"HOW MANY WOULD YOU LIKE TO TAKE?";T%:I=T%>0ANDT%<4:PRINTST$(I):NEXTI:PRINT"ON MY TURN I WILL TAKE "4-T%" TOKENS.":NEXTHEAP


total: 12
while ø [
    tk: 0
    print "YOUR turn:"
    while [not? contains? 1..3 tk: <= to :integer input "How many tokens will you take? (1-3) "][]
    total: total-tk
    print [total "tokens remaining\n"]

    print ["COMPUTER's turn:"]
    print ["taking:" 4-tk]
    total: total-(4-tk)
    print [total "tokens remaining\n"]
    if total=0 [
        print "COMPUTER won. :)"
        break
    ]
]


import java.util.*;
import static java.util.Arrays.*;
import static java.util.stream.Collectors.toList;

public class NonogramSolver {

    static String[] p1 = {"C BA CB BB F AE F A B", "AB CA AE GA E C D C"};

    static String[] p2 = {"F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC", "D D AE "
        + "CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA"};

    static String[] p3 = {"CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH "
        + "BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC",
        "BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF "
        + "AAAAD BDG CEF CBDB BBB FC"};

    static String[] p4 = {"E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q "
        + "R AN AAN EI H G", "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ "
        + "ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM"};

    public static void main(String[] args) {
        for (String[] puzzleData : new String[][]{p1, p2, p3, p4})
            newPuzzle(puzzleData);
    }

    static void newPuzzle(String[] data) {
        String[] rowData = data[0].split("\\s");
        String[] colData = data[1].split("\\s");

        List<List<BitSet>> cols, rows;
        rows = getCandidates(rowData, colData.length);
        cols = getCandidates(colData, rowData.length);

        int numChanged;
        do {
            numChanged = reduceMutual(cols, rows);
            if (numChanged == -1) {
                System.out.println("No solution");
                return;
            }
        } while (numChanged > 0);

        for (List<BitSet> row : rows) {
            for (int i = 0; i < cols.size(); i++)
                System.out.print(row.get(0).get(i) ? "# " : ". ");
            System.out.println();
        }
        System.out.println();
    }

    // collect all possible solutions for the given clues
    static List<List<BitSet>> getCandidates(String[] data, int len) {
        List<List<BitSet>> result = new ArrayList<>();

        for (String s : data) {
            List<BitSet> lst = new LinkedList<>();

            int sumChars = s.chars().map(c -> c - 'A' + 1).sum();
            List<String> prep = stream(s.split(""))
                    .map(x -> repeat(x.charAt(0) - 'A' + 1, "1")).collect(toList());

            for (String r : genSequence(prep, len - sumChars + 1)) {
                char[] bits = r.substring(1).toCharArray();
                BitSet bitset = new BitSet(bits.length);
                for (int i = 0; i < bits.length; i++)
                    bitset.set(i, bits[i] == '1');
                lst.add(bitset);
            }
            result.add(lst);
        }
        return result;
    }

    // permutation generator, translated from Python via D
    static List<String> genSequence(List<String> ones, int numZeros) {
        if (ones.isEmpty())
            return asList(repeat(numZeros, "0"));

        List<String> result = new ArrayList<>();
        for (int x = 1; x < numZeros - ones.size() + 2; x++) {
            List<String> skipOne = ones.stream().skip(1).collect(toList());
            for (String tail : genSequence(skipOne, numZeros - x))
                result.add(repeat(x, "0") + ones.get(0) + tail);
        }
        return result;
    }

    static String repeat(int n, String s) {
        StringBuilder sb = new StringBuilder();
        for (int i = 0; i < n; i++)
            sb.append(s);
        return sb.toString();
    }

    /* If all the candidates for a row have a value in common for a certain cell,
    then it's the only possible outcome, and all the candidates from the
    corresponding column need to have that value for that cell too. The ones
    that don't, are removed. The same for all columns. It goes back and forth,
    until no more candidates can be removed or a list is empty (failure). */

    static int reduceMutual(List<List<BitSet>> cols, List<List<BitSet>> rows) {
        int countRemoved1 = reduce(cols, rows);
        if (countRemoved1 == -1)
            return -1;

        int countRemoved2 = reduce(rows, cols);
        if (countRemoved2 == -1)
            return -1;

        return countRemoved1 + countRemoved2;
    }

    static int reduce(List<List<BitSet>> a, List<List<BitSet>> b) {
        int countRemoved = 0;

        for (int i = 0; i < a.size(); i++) {

            BitSet commonOn = new BitSet();
            commonOn.set(0, b.size());
            BitSet commonOff = new BitSet();

            // determine which values all candidates of ai have in common
            for (BitSet candidate : a.get(i)) {
                commonOn.and(candidate);
                commonOff.or(candidate);
            }

            // remove from bj all candidates that don't share the forced values
            for (int j = 0; j < b.size(); j++) {
                final int fi = i, fj = j;

                if (b.get(j).removeIf(cnd -> (commonOn.get(fj) && !cnd.get(fi))
                        || (!commonOff.get(fj) && cnd.get(fi))))
                    countRemoved++;

                if (b.get(j).isEmpty())
                    return -1;
            }
        }
        return countRemoved;
    }
}


Play:
tokens := 12
while tokens {
	while !(D>0 && D<4)
		InputBox, D, Nim Game, % "Tokens Remaining = " tokens
		. "`nHow many tokens would you like to take?"
		. "`nChoose 1, 2 or 3"
	tokens -= D
	MsgBox % "Computer Takes " 4-D
	tokens -= 4-d, d:=0
}
MsgBox, 262212,,Computer Always Wins!`nWould you like to play again?
IfMsgBox, Yes
	gosub Play
else
	ExitApp
return


# syntax: GAWK -f NIM_GAME.AWK
BEGIN {
    tokens = 12
    printf("Nim game - using %d tokens\n",tokens)
    while (tokens > 0) {
      for (;;) {
        printf("how many tokens 1-3? ")
        getline ans
        if (ans ~ /^[123]$/) {
          tokens -= ans
          prn("player")
          break
        }
        print("invalid input, try again")
      }
      tokens -= ans = tokens % 4
      prn("computer")
    }
    print("computer wins")
    exit(0)
}
function prn(who) {
    printf("%s takes %d token%s; there are %d remaining\n",who,ans,(ans==1)?"":"s",tokens)
}


using Base.Iterators

struct NonogramPuzzle
    nrows::Int
    ncols::Int
    xhints::Vector{Vector{Int}}
    yhints::Vector{Vector{Int}}
    solutions:: Vector{Any}
    NonogramPuzzle(xh, yh) = new(length(xh), length(yh), xh, yh, Vector{NTuple{4,Array{Int64,1}}}())
end

ycols2xrows(ycols) = [[ycols[i][j] for i in eachindex(ycols)] for j in eachindex(ycols[1])]

function hintsfromcol(rowvec, col, nrows)
    hints = Vector{Int}()
    hintrun = 0
    for row in rowvec
        if row[col] != 0
            hintrun += 1
            if col == nrows
                push!(hints, hintrun)
            end
        elseif hintrun > 0
            push!(hints, hintrun)
            hintrun = 0
        end
    end
    hints
end

function nonoblocks(hints, len)
    minsized(arr) = vcat(map(x -> vcat(fill(1, x), [0]), arr)...)[1:end-1]
    minlen(arr) = sum(arr) + length(arr) - 1
    if isempty(hints)
        return fill(0, len)
    elseif minlen(hints) == len
        return minsized(hints)
    end
    possibilities = Vector{Vector{Int}}()
    allbuthead = hints[2:end]
    for leftspace in 0:(len - minlen(hints))
        header = vcat(fill(0, leftspace), fill(1, hints[1]), [0])
        rightspace = len - length(header)
        if isempty(allbuthead)
            push!(possibilities, rightspace <= 0 ? header[1:len] : vcat(header, fill(0, rightspace)))
        elseif minlen(allbuthead) == rightspace
            push!(possibilities, vcat(header, minsized(allbuthead)))
        else
            foreach(x -> push!(possibilities, vcat(header, x)), nonoblocks(allbuthead, rightspace))
        end
    end
    possibilities
end

function exclude!(xchoices, ychoices)
    andvec(a) = findall(x -> x == 1, foldl((x, y) -> [x[i] & y[i] for i in 1:length(x)], a))
    orvec(a)  = findall(x -> x == 0, foldl((x, y) -> [x[i] | y[i] for i in 1:length(x)], a))
    filterbyval!(arr, val, pos) =  if !isempty(arr) filter!(x -> x[pos] == val, arr); end
    ensurevecvec(arr::Vector{Vector{Int}}) = arr
    ensurevecvec(arr::Vector{Int}) = [arr]
    function excl!(choices, otherchoices)
        for i in 1:length(choices)
            if length(choices[i]) > 0
                all1 = andvec(choices[i])
                all0 = orvec(choices[i])
                foreach(n -> filterbyval!(otherchoices[n], 1, i), all1)
                foreach(n -> filterbyval!(otherchoices[n], 0, i), all0)
            end
        end
    end
    xclude!(x, y) = (excl!(x, y); x = map(ensurevecvec, x); y = map(ensurevecvec, y); (x, y))
    xlen, ylen = sum(map(length, xchoices)), sum(map(length, ychoices))
    while true
        ychoices, xchoices = xclude!(ychoices, xchoices)
        if any(isempty, xchoices)
            return
        end
        xchoices, ychoices = xclude!(xchoices, ychoices)
        if any(isempty, ychoices)
            return
        end
        newxlen, newylen = sum(map(length, xchoices)), sum(map(length, ychoices))
        if newxlen == xlen && newylen == ylen
            return
        end
        xlen, ylen = newxlen, newylen
    end
end

function trygrids(nonogram)
    xchoices = [nonoblocks(nonogram.xhints[i], nonogram.ncols) for i in 1:nonogram.nrows]
    ychoices = [nonoblocks(nonogram.yhints[i], nonogram.nrows) for i in 1:nonogram.ncols]
    exclude!(xchoices, ychoices)
    if all(x -> length(x) == 1, xchoices)
        println("Unique solution.")
        push!(nonogram.solutions, [x[1] for x in xchoices])
    elseif all(x -> length(x) == 1, ychoices)
        println("Unique solution.")
        ycols = [y[1] for y in ychoices]
        push!(nonogram.solutions, ycols2xrows(ycols))
    else
        println("Brute force: $(prod(map(length, xchoices))) possibilities.")
        for stack in product(xchoices...)
            arr::Vector{Vector{Int}} = [i isa Vector ? i : [i] for i in stack]
            if all(x -> length(x) == nonogram.ncols, arr) &&
               all(y -> hintsfromcol(arr, y, nonogram.nrows) == nonogram.yhints[y], 1:nonogram.ncols)
                push!(nonogram.solutions, arr)
            end
        end
        nsoln = length(nonogram.solutions)
        println(nsoln == 0 ? "No" : nsoln, " solutions.")
    end
end

# The first puzzle below requires brute force, and the second has no solutions.
const testnonograms = """
B B A A
B B A A

B A A
A A A

C BA CB BB F AE F A B
AB CA AE GA E C D C

F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC
D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA

CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC
BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC

E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G
E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM
"""

function processtestpuzzles(txt)
    solutiontxt(a) = (s = ""; for r in a for c in r; s *= (c == 0 ? "." : "#") end; s *= "\n" end; s)
    txtline2ints(s) = [[UInt8(ch - 'A' + 1) for ch in r] for r in split(s, r"\s+")]
    linepairs = uppercase.(string.(split(txt, "\n\n")))
    pcount = 0
    for xyhints in linepairs
        xh, yh = map(x -> txtline2ints(strip(x)), split(xyhints, "\n"))
        nonogram = NonogramPuzzle(xh, yh)
        println("\nPuzzle $(pcount += 1):")
        trygrids(nonogram)
        foreach(x -> println(solutiontxt(x), "\n"), nonogram.solutions)
    end
end

processtestpuzzles(testnonograms)


// version 1.2.0

import java.util.BitSet

typealias BitSets = List<MutableList<BitSet>>

val rx = Regex("""\s""")

fun newPuzzle(data: List<String>) {
    val rowData = data[0].split(rx)
    val colData = data[1].split(rx)
    val rows = getCandidates(rowData, colData.size)
    val cols = getCandidates(colData, rowData.size)

    do {
        val numChanged = reduceMutual(cols, rows)
        if (numChanged == -1) {
            println("No solution")
            return
        }
    }
    while (numChanged > 0)

    for (row in rows) {
        for (i in 0 until cols.size) {
            print(if (row[0][i]) "# " else ". ")
        }
        println()
    }
    println()
}

// collect all possible solutions for the given clues
fun getCandidates(data: List<String>, len: Int): BitSets {
    val result = mutableListOf<MutableList<BitSet>>()
    for (s in data) {
        val lst = mutableListOf<BitSet>()
        val a = s.toCharArray()
        val sumChars = a.sumBy { it - 'A' + 1 }
        val prep = a.map { "1".repeat(it - 'A' + 1) }

        for (r in genSequence(prep, len - sumChars + 1)) {
            val bits = r.substring(1).toCharArray()
            val bitset = BitSet(bits.size)
            for (i in 0 until bits.size) bitset[i] = bits[i] == '1'
            lst.add(bitset)
        }
        result.add(lst)
    }
    return result
}

fun genSequence(ones: List<String>, numZeros: Int): List<String> {
    if (ones.isEmpty()) return listOf("0".repeat(numZeros))
    val result = mutableListOf<String>()
    for (x in 1 until numZeros - ones.size + 2) {
        val skipOne = ones.drop(1)
        for (tail in genSequence(skipOne, numZeros - x)) {
            result.add("0".repeat(x) + ones[0] + tail)
        }
    }
    return result
}

/* If all the candidates for a row have a value in common for a certain cell,
    then it's the only possible outcome, and all the candidates from the
    corresponding column need to have that value for that cell too. The ones
    that don't, are removed. The same for all columns. It goes back and forth,
    until no more candidates can be removed or a list is empty (failure).
*/

fun reduceMutual(cols: BitSets, rows: BitSets): Int {
    val countRemoved1 = reduce(cols, rows)
    if (countRemoved1 == -1) return -1
    val countRemoved2 = reduce(rows, cols)
    if (countRemoved2 == -1) return -1
    return countRemoved1 + countRemoved2
}

fun reduce(a: BitSets, b: BitSets): Int {
    var countRemoved = 0
    for (i in 0 until a.size) {
        val commonOn = BitSet()
        commonOn[0] = b.size
        val commonOff = BitSet()

        // determine which values all candidates of a[i] have in common
        for (candidate in a[i]) {
            commonOn.and(candidate)
            commonOff.or(candidate)
        }

        // remove from b[j] all candidates that don't share the forced values
        for (j in 0 until b.size) {
            val fi = i
            val fj = j
            if (b[j].removeIf { cnd ->
                (commonOn[fj] && !cnd[fi]) ||
                (!commonOff[fj] && cnd[fi]) }) countRemoved++
            if (b[j].isEmpty()) return -1
        }
    }
    return countRemoved
}

val p1 = listOf("C BA CB BB F AE F A B", "AB CA AE GA E C D C")

val p2 = listOf(
    "F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC",
    "D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA"
)

val p3 = listOf(
    "CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH " +
    "BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC",
    "BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF " +
    "AAAAD BDG CEF CBDB BBB FC"
)

val p4 = listOf(
    "E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
    "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ " +
    "ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM"
)

fun main(args: Array<String>) {
    for (puzzleData in listOf(p1, p2, p3, p4)) {
        newPuzzle(puzzleData)
    }
}


DEFINE PROCEDURE ''DIVIDE'' [A,B]:
BLOCK 0: BEGIN
  IF A < B, THEN:
    QUIT BLOCK 0;
  CELL(0) <= 1;
  OUTPUT <= 1;
  LOOP AT MOST A TIMES:
  BLOCK 2: BEGIN
    IF OUTPUT * B = A, THEN:
    QUIT BLOCK 0;
    OUTPUT <= OUTPUT + 1;
    IF OUTPUT * B > A, THEN:
    BLOCK 3: BEGIN
      OUTPUT <= CELL(0);
      QUIT BLOCK 0;
    BLOCK 3: END;
    CELL(0) <= OUTPUT;
  BLOCK 2: END;
BLOCK 0: END.

DEFINE PROCEDURE ''MINUS'' [A,B]:
BLOCK 0: BEGIN
  IF A < B, THEN:
    QUIT BLOCK 0;
  LOOP AT MOST A TIMES:
  BLOCK 1: BEGIN
    IF OUTPUT + B = A, THEN:
      QUIT BLOCK 0;
    OUTPUT <= OUTPUT + 1;
  BLOCK 1: END;
BLOCK 0: END.

DEFINE PROCEDURE ''MODULUS'' [A,B]:
BLOCK 0: BEGIN
  CELL(0) <= DIVIDE[A,B];
  OUTPUT <= MINUS[A,CELL(0) * B];
BLOCK 0: END.

DEFINE PROCEDURE ''PLAYER_TURN'' [TOKENS_LEFT, TAKE]:
BLOCK 0: BEGIN
  CELL(0) <= TAKE;

  IF TAKE > 3, THEN:
  BLOCK 1: BEGIN
    CELL(0) <= MODULUS [TAKE, 3] + 1;
    PRINT ['take must be between 1 and 3. setting take to ', CELL(0), '.'];
  BLOCK 1: END;

  IF TAKE < 1, THEN:
  BLOCK 2: BEGIN
    CELL(0) <= 1;
    PRINT ['take must be between 1 and 3. setting take to 1.'];
  BLOCK 2: END;

  OUTPUT <= MINUS [TOKENS_LEFT, CELL(0)];

  PRINT ['player takes ', CELL(0), ' tokens.'];
  PRINT ['tokens remaining: ', OUTPUT];
  PRINT [''];
BLOCK 0: END.

DEFINE PROCEDURE ''COMPUTER_TURN'' [TOKENS_LEFT]:
BLOCK 0: BEGIN
  CELL(0) <= MODULUS [TOKENS_LEFT, 4];
  OUTPUT <= MINUS [TOKENS_LEFT, CELL(0)];

  PRINT ['computer takes ', CELL(0), ' tokens.'];
  PRINT ['tokens remaining: ', OUTPUT];
  PRINT [''];
BLOCK 0: END.

DEFINE PROCEDURE ''PLAY_GAME'' [FST, SEC, THD]:
BLOCK 0: BEGIN
  CELL(0) <= FST;
  CELL(1) <= SEC;
  CELL(2) <= THD;
  OUTPUT <= 12;

  LOOP 3 TIMES:
  BLOCK 1: BEGIN
    OUTPUT <= PLAYER_TURN [OUTPUT, CELL(0)];
    CELL(0) <= CELL(1);
    CELL(1) <= CELL(2);

    OUTPUT <= COMPUTER_TURN [OUTPUT];
  BLOCK 1: END;

  PRINT ['computer wins!'];
BLOCK 0: END.

PLAY_GAME [1,4,3];


#include  <stdio.h>

int playerTurn(int numTokens, int take);
int computerTurn(int numTokens);

int main(void)
{
	printf("Nim Game\n\n");

	int Tokens = 12;

	while(Tokens > 0)
	{
		printf("How many tokens would you like to take?: ");

		int uin;
		scanf("%i", &uin);

		int nextTokens = playerTurn(Tokens, uin);

		if (nextTokens == Tokens)
		{
			continue;
		}

		Tokens = nextTokens;

		Tokens = computerTurn(Tokens);
	}
	printf("Computer wins.");

	return 0;
}

int playerTurn(int numTokens, int take)
{
	if (take < 1 || take > 3)
	{
		printf("\nTake must be between 1 and 3.\n\n");
		return numTokens;
	}
	int remainingTokens = numTokens - take;

	printf("\nPlayer takes %i tokens.\n", take);
	printf("%i tokens remaining.\n\n", remainingTokens);

	return remainingTokens;
}

int computerTurn(int numTokens)
{
	int take = numTokens % 4;
	int remainingTokens = numTokens - take;

	printf("Computer takes %u tokens.\n", take);
	printf("%i tokens remaining.\n\n", remainingTokens);

	return remainingTokens;
}


ClearAll[VisualizeGrid, Possibilities, TryRow, TryColumn]
VisualizeGrid[candgrid_List] := StringRiffle[StringJoin/@Replace[candgrid,{{0}->" ",{1}->"#",{0,1}|{1,0}->"."},{2}],"\n"]
Possibilities[clues_List, len_Integer] := Module[{spaces, numclue, spacecands, cands},
  numclue = Length[clues];
  spaces = len - Total[clues];
  spacecands = IntegerPartitions[spaces, {numclue - 1}];
  spacecands = DeleteDuplicates[Catenate[Permutations /@ spacecands]];
  cands = Catenate[Riffle[ConstantArray[1, #] & /@ clues, ConstantArray[0, #] & /@ #]] & /@ spacecands;
  spacecands = IntegerPartitions[spaces, {numclue}];
  spacecands = DeleteDuplicates[Catenate[Permutations /@ spacecands]];
  cands = Join[cands, Catenate[Riffle[ConstantArray[1, #] & /@ clues, ConstantArray[0, #] & /@ #]] & /@ spacecands];
  cands = Join[cands, Catenate[Riffle[ConstantArray[0, #] & /@ #, ConstantArray[1, #] & /@ clues]] & /@ spacecands];

  spacecands = IntegerPartitions[spaces, {numclue + 1}];
  spacecands = DeleteDuplicates[Catenate[Permutations /@ spacecands]];
  cands = Join[cands, Catenate[Riffle[ConstantArray[0, #] & /@ #, ConstantArray[1, #] & /@ clues]] & /@ spacecands];

  cands
 ]
TryRow[candgrid_List, i_Integer, hclues_List] := Module[{row, clue, len, poss, newgrid},
  row = candgrid[[i]];
  clue = hclues[[i]];
  len = Length[row];
  poss = Possibilities[clue, len];
  poss //= Select[MatchQ[Alternatives @@@ row]];
  poss //= Transpose;
  poss //= Map[Union];
  newgrid = candgrid;
  newgrid[[i]] = poss;
  newgrid
 ]
TryColumn[candgrid_List, i_Integer, hclues_List] := Transpose[TryRow[Transpose[candgrid], i, hclues]]
puzzles = "C BA CB BB F AE F A B
AB CA AE GA E C D C

F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC
D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA

CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC
BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC

E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G
E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM";
puzzles = StringSplit[puzzles, "\n\n"];
puzzles = StringSplit[#, "\n"] & /@ puzzles;
puzzles = Map[StringSplit[#, " "] &, puzzles, {2}];
puzzles = Map[Characters, puzzles, {3}];
puzzles = puzzles /. Thread[CharacterRange["A", "Z"] -> (ToString /@ Range[26])];
puzzles = Map[ToExpression, puzzles, {4}];

Do[
 hclues = puzzles[[n, 1]];
 vclues = puzzles[[n, 2]];
 {hsize, vsize} = {vclues // Length, hclues // Length};
 cand = ConstantArray[{0, 1}, {vsize, hsize}];
 oldcand = {};
 While[oldcand =!= cand,
  oldcand = cand;
  Do[cand = TryRow[cand, i, hclues], {i, Length[hclues]}];
  Do[cand = TryColumn[cand, i, vclues], {i, Length[vclues]}];
  ];
 [email protected][cand]
 ,
 {n, 4}
 ]


import bitops, math, sequtils, strutils

type

  # Lengths of distinct runs of occupied cells.
  Lengths = seq[int]

  # Possibility, i.e. sequence of bits managed as an integer.
  Possibility = int

  # Possibilities described by tow masks and a list of integer values.
  Possibilities = object
    mask0: int        # Mask indicating the positions of free cells.
    mask1: int        # Mask indicating the positions of occupied cells.
    list: seq[int]    # List of possibilities.

proc genSequence(ones: seq[int]; numZeroes: Natural): seq[Possibility] =
  ## Generate a sequence of possibilities.
  if ones.len == 0: return @[0]
  for x in 1..(numZeroes - ones.len + 1):
    for tail in genSequence(ones[1..^1], numZeroes - x):
      result.add (tail shl countSetBits(ones[0]) or ones[0]) shl x

proc initPossibilities(lengthsList: openArray[Lengths]; length: Positive): seq[Possibilities] =
  ## Initialize the list of possibilities from a list of lengths.

  let initMask0 = 1 shl length - 1
  for lengths in lengthsList:
    let sumLengths = sum(lengths)
    let prep = lengths.mapIt(1 shl it - 1)
    let possList = genSequence(prep, length - sumLengths + 1).mapIt(it shr 1)
    result.add Possibilities(mask0: initMask0, mask1: 0, list: possList)

func updateUnset(possList: var seq[Possibilities]; mask, rank: int) =
  ## Update the lists of possibilities keeping only those
  ## compatible with the mask (for bits not set only).
  var mask = mask
  for poss in possList.mitems:
    if (mask and 1) == 0:
      for i in countdown(poss.list.high, 0):
        if poss.list[i].testBit(rank):
          # Bit is set, so the value is not compatible: remove it.
          poss.list.delete(i)
    mask = mask shr 1

func updateSet(possList: var seq[Possibilities]; mask, rank: int) =
  ## Update the lists of possibilities keeping only those
  ## compatible with the mask (for bits set only).
  var mask = mask
  for poss in possList.mitems:
    if (mask and 1) != 0:
      for i in countdown(poss.list.high, 0):
        if not poss.list[i].testBit(rank):
          # Bit is not set, so the value is not compatible: remove it.
          poss.list.delete(i)
    mask = mask shr 1

proc process(poss1, poss2: var seq[Possibilities]): bool =
  ## Look at possibilities in list "poss1", compute the masks for
  ## bits unset and bits set and update "poss2" accordingly.

  var num = 0
  for poss in poss1.mitems:

    # Check bits unset.
    var mask = 0
    for value in poss.list:
      mask = mask or value
    if mask != poss.mask0:
      # Mask has changed: update.
      result = true
      poss2.updateUnset(mask, num)
      poss.mask0 = mask

    # Check bits set.
    mask = 1 shl poss2.len - 1
    for value in poss.list:
      mask = mask and value
    if mask != poss.mask1:
      # Mask has changed: update.
      result = true
      poss2.updateSet(mask, num)
      poss.mask1 = mask

    inc num

proc solve(rowLengths, colLengths: openArray[Lengths]) =
  ## Solve nonogram defined by "rowLengths" and "colLengths".

  var
    rowPoss = initPossibilities(rowLengths, colLengths.len)
    colPoss = initPossibilities(colLengths, rowLengths.len)

    # Solve nonogram.
  var hasChanged = true
  while hasChanged:
    hasChanged = process(rowPoss, colPoss) or process(colPoss, rowPoss)

  # Check if solved.
  for poss in rowPoss:
    if poss.list.len != 1:
      echo "Unable to solve the nonogram."
      return

  # Display the solution.
  for poss in rowPoss:
    var line = ""
    var val = poss.list[0]
    for i in 0..colPoss.high:
      line.add if val.testBit(i): "# " else: "  "
    echo line

func expand(s: string): seq[Lengths] =
  ## Expand a compact description into a sequence of lengths.
  for elem in s.splitWhitespace():
    result.add elem.mapIt(ord(it) - ord('A') + 1)

proc solve(rows, cols: string) =
  ## Solve using compact description parameters.
  solve(rows.expand(), cols.expand())

when isMainModule:

  const

    Data1 = ("C BA CB BB F AE F A B", "AB CA AE GA E C D C")

    Data2 = ("F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC",
             "D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA")

    Data3 = ("CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC",
             "BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC")

    Data4 = ("E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
             "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM")

  for (rows, cols) in [Data1, Data2, Data3, Data4]:
    echo rows
    echo cols
    echo ""
    solve(rows, cols)
    echo ""


(import (owl parse))

; notation parser
(define (subA x) (- x #\A -1))

(define line
   (let-parse* (
         (words (greedy+ (let-parse* (
               (* (greedy* (imm #\space)))
               (word (greedy+ (byte-if (lambda (x) (<= #\A x #\Z))))))
            (map subA word))))
         (* (maybe (imm #\newline) #f)))
      words))

(define nonogram-parser
   (let-parse* (
         (rows line)
         (cols line))
      (cons rows cols)))

; nonogram printer
(define (print-nonogram ng solve)
   (for-each (lambda (row y)
         (for-each (lambda (x)
               (if (list-ref (list-ref (car solve) y) x)
                  (display "X ")
                  (display ". ")))
            (iota (length (cdr ng))))
         (for-each (lambda (i)
               (display " ")
               (display i))
            row)
         (print))
      (car ng)
      (iota (length (car ng))))
   (for-each (lambda (i)
         (for-each (lambda (col)
               (let ((n (lref col i)))
                  (if n (display n) (display " ")))
               (display " "))
            (cdr ng))
         (print))
      (iota (fold (lambda (f col) (max f (length col))) 0 (cdr ng)) 0)))

; possible permutation generator
(define (permutate blacks len)
   ; empty cells distibutions (with minimal count)
   (define whites (append '(0) (repeat 1 (- (length blacks) 1)) '(0)))
   (define total (- len (apply + blacks))) ; total summ of empty cells

   (define (combine whites blacks)
      ; size of whites is always equal to size of blacks+1
      (let loop ((line #null) (v #f) (w (reverse whites)) (b (reverse blacks)))
         (if (null? w)
            line
         else
            (loop (append (repeat v (car w)) line)
                  (not v)
                  b
                  (cdr w)))))

   (map (lambda (whites) (combine whites blacks))
      (let loop ((ll whites) (max total))
         (if (null? (cdr ll))
            (list (list max))
         else
            (define sum (apply + ll))
            (define left (- max sum))
            (if (eq? left 0)
               (list ll)
               else
                  (define head (car ll))
                  (fold (lambda (f i)
                           (define sublist (loop (cdr ll) (- max head i)))
                           (fold (lambda (f x)
                                    (cons (cons (+ head i) x) f))
                              f
                              sublist))
                     #null
                     (iota (+ left 1))))))))

; siever of impossible combinations
(define (sieve rows cols) ; -> new cols
   (fold (lambda (cols i)
         ; for every cell define a "definitely black" and "definitely white" cells
         (define blacks (fold (lambda (f x)
               (map (lambda (a b) (and a b)) f x))
               (repeat #t (length cols))
               (list-ref rows i)))
         (define whites (fold (lambda (f x)
               (map (lambda (a b) (or a b)) f x))
               (repeat #f (length cols))
               (list-ref rows i)))
         ; now filter the second list
         (map (lambda (cols j)
               (filter (lambda (col)
                     (not (or
                        (and (list-ref blacks j) (not (list-ref col i)))
                        (and (not (list-ref whites j)) (list-ref col i)))))
                  cols))
            cols
            (iota (length cols))))
      cols
      (iota (length rows))))

; main solver cycle
(define (solve rows-permuted cols-permuted)
   (let loop ((rows rows-permuted) (cols cols-permuted) (flip #f))
      (define new-cols (sieve rows cols))

      (define fail (fold (lambda (f l) (or f (null? l))) #f new-cols))
      (define done (fold (lambda (f l) (and f (null? (cdr l)))) #t new-cols))

      (cond
         (fail
            #false)
         (done
            (if flip
               (cons (map car new-cols) (map car rows))
               (cons (map car rows) (map car new-cols))))
         (else
            (loop new-cols rows (not flip))))))

; -=( main )=----------------------------------
(define first "C BA CB BB F AE F A B
AB CA AE GA E C D C")

(define second "F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC
D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA")

(define third "CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC
BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC")

(define fourth "E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G
E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM")

(for-each (lambda (str)
      (print "nonogram:")
      (print str) (print)
      ; decode nonogram notation
      (define nonogram (parse nonogram-parser (str-iter str) #f #f #f))

      ; prepare arrays of all possible line b/w permutations
      (define rows (car nonogram))
      (define cols (cdr nonogram))

      (define row-length (length cols))
      (define col-length (length rows))

      (define rows-permuted (map (lambda (x) (permutate x row-length)) rows))
      (define cols-permuted (map (lambda (x) (permutate x col-length)) cols))

      ; solve nonogram
      (define answer (solve rows-permuted cols-permuted))

      ; show the output
      (if answer
         (print-nonogram nonogram answer)
         (print "Sorry, no aorrect answer found."))
      (print))
   (list first second third fourth))


#include <iostream>
#include <limits>

using namespace std;

void showTokens(int tokens) {
    cout << "Tokens remaining " << tokens << endl << endl;
}

int main() {
    int tokens = 12;
    while (true) {
        showTokens(tokens);
        cout << "  How many tokens 1, 2 or 3? ";
        int t;
        cin >> t;
        if (cin.fail()) {
            cin.clear();
            cin.ignore(numeric_limits<streamsize>::max(), '\n');
            cout << endl << "Invalid input, try again." << endl << endl;
        } else if (t < 1 || t > 3) {
            cout << endl << "Must be a number between 1 and 3, try again." << endl << endl;
        } else {
            int ct = 4 - t;
            string s  = (ct > 1) ? "s" : "";
            cout << "  Computer takes " << ct << " token" << s << endl << endl;
            tokens -= 4;
        }
        if (tokens == 0) {
            showTokens(0);
            cout << "  Computer wins!" << endl;
            return 0;
        }
    }
}


using System;

namespace nimGame
{
    class Program
    {
        static void Main(string[] args)
        {
            Console.WriteLine("There are twelve tokens.\n" +
                    "You can take 1, 2, or 3 on your turn.\n" +
                    "Whoever takes the last token wins.\n");

            int tokens = 12;

            while (tokens > 0)
            {
                Console.WriteLine("There are " + tokens + " remaining.");
                Console.WriteLine("How many do you take?");
                int playertake = Convert.ToInt32(Console.ReadLine());

                if (playertake < 1 | playertake > 3)
                {
                    Console.WriteLine("1, 2, or 3 only.");
                }
                else
                {
                    tokens -= playertake;
                    Console.WriteLine("I take " + (4 - playertake) + ".");
                    tokens -= (4 - playertake);
                }
            }
            Console.WriteLine("I win again.");
            Console.ReadLine();
        }

    }
}


use strict;
use warnings;

my $file = 'nonogram_problems.txt';
open my $fd, '<', $file or die "$! opening $file";

while(my $row = <$fd> )
  {
  $row =~ /\S/ or next;
  my $column = <$fd>;
  my @rpats = makepatterns($row);
  my @cpats = makepatterns($column);
  my @rows = ( '.' x @cpats ) x @rpats;
  for( my $prev = ''; $prev ne "@rows"; )
    {
    $prev = "@rows";
    try(\@rows, \@rpats);
    my @cols = map { join '', map { s/.//; $& } @rows } 0..$#cpats;
    try(\@cols, \@cpats);
    @rows = map { join '', map { s/.//; $& } @cols } 0..$#rpats;
    }
  print "\n", "@rows" =~ /\./ ? "Failed\n" : map { tr/01/.#/r, "\n" } @rows;
  }

sub try
  {
  my ($lines, $patterns) = @_;
  for my $i ( 0 .. $#$lines )
    {
    while( $lines->[$i] =~ /\./g )
      {
      for my $try ( 0, 1 )
        {
        $lines->[$i] =~ s/.\G/$try/r =~ $patterns->[$i] or
          $lines->[$i] =~ s// 1 - $try /e;
        }
      }
    }
  }

sub makepatterns {                         #    numbered to show the 'logical' order of operations
    map { qr/^$_$/                          # 7  convert strings to regex
        } map {  '[0.]*'                    # 6a prepend static pattern
               . join('[0.]+',              # 5  interleave with static pattern
                       map { "[1.]{$_}"     # 4  require to match exactly 'n' times
                           } map { -64+ord  # 3  convert letter value to repetition count 'n'
                                 } split // # 2  for each letter in group
                     )
               . '[0.]*'                    # 6b append static pattern
              } split ' ', shift;           # 1  for each letter grouping
}


(defun pturn (curTokens)
	(write-string "How many tokens would you like to take?: ")
	(setq ans (read))
	(setq tokensRemaining (- curTokens ans))
	(format t "You take ~D tokens~%" ans)
	(printRemaining tokensRemaining)
	tokensRemaining)

(defun cturn (curTokens)
	(setq take (mod curTokens 4))
	(setq tokensRemaining (- curTokens take))
	(format t "Computer takes ~D tokens~%" take)
	(printRemaining tokensRemaining)
	tokensRemaining)

(defun printRemaining (remaining)
	(format t "~D tokens remaining~%~%" remaining))

(format t "LISP Nim~%~%")
(setq tok 12)
(loop
	(setq tok (pturn tok))
	(setq tok (cturn tok))
	(if (<= tok 0)
		(return)))
(write-string "Computer wins!")


tokens = 12

until tokens <= 0
    puts "There are #{tokens} tokens remaining.\nHow many tokens do you take?"
    until (input = (gets || "").to_i?) && (1..3).includes? input
        puts "Enter an integer between 1 and 3."
    end
    puts "Player takes #{input} tokens.\nComputer takes #{4-input} tokens."
    tokens -= 4
end

puts "Computer wins."


print("There are twelve tokens.")
print("You can take 1, 2, or 3 on your turn.")
print("Whoever takes the last token wins.\n")

var tokens = 12
while tokens > 0 {
    print("There are \(tokens) remaining.")
    print("How many do you take?")
    var playertake = Integer(readLine())

    if playertake < 1 || playertake > 3 {
        print("1, 2, or 3 only.")
    } else {
        tokens -= playertake
        print("I take \(4 - playertake).")
        tokens -= (4 - playertake)
    }
}

print("I win again.")


USING: interpolate io kernel math math.parser sequences ;
IN: rosetta-code.nim-game

: get-input ( -- n )
    "Number of tokens to take (1, 2, or 3): " write readln
    string>number dup { 1 2 3 } member?
    [ drop "Invalid move." print get-input ] unless ;

: .remaining ( n -- )
    nl [I -~~==[ ${} tokens remaining ]==~~-I] nl nl ;

: .choice ( str n -- )
    dup 1 = "" "s" ? [I ${} took ${} token${}I] nl ;

: (round) ( -- )
    "You" get-input "Computer" 4 pick - [ .choice ] [email protected] ;

: round ( n -- n-4 )
    dup dup .remaining [ drop (round) 4 - round ] unless-zero ;

: nim-game ( -- ) 12 round drop "Computer wins!" print ;

MAIN: nim-game


with javascript_semantics
sequence x, y, grid
integer unsolved

function count_grid()
integer res = length(x)*length(y)
    for i=1 to length(x) do
        for j=1 to length(y) do
            res -= grid[i][j]!='?'
        end for
    end for
    return res
end function

function match_mask(string neat, string mask, integer ms, integer me)
    for i=ms to me do
        if mask[i]!='?' then
            if mask[i]!=neat[i] then return 0 end if
        end if
    end for
    return 1
end function

function innr(string mask, sequence blocks, integer mi=1, string res="", string neat=mask)
    if length(blocks)=0 then
        for i=mi to length(neat) do
            neat[i] = ' '
        end for
        if match_mask(neat,mask,mi,length(mask)) then
            if length(res)=0 then
                res = neat
            else
                for i=1 to length(neat) do
                    if neat[i]!=res[i] then
                        res[i] = '?'
                    end if
                end for
            end if
        end if
    else
        integer b = blocks[1]
        blocks = blocks[2..$]
        integer l = (sum(blocks)+length(blocks)-1),
                e = length(neat)-l-b
        for i=mi to e do
            for j=i to i+b-1 do
                neat[j] = '#'
            end for
            if i+b<=length(neat) then
                neat[i+b] = ' '
            end if
            if match_mask(neat,mask,mi,min(i+b,length(mask))) then
                res = innr(mask,blocks,i+b+1,res,neat)
            end if
            neat[i] = ' '
        end for
    end if
    return res
end function

function inner(string mask, sequence blocks)
    string res = innr(mask,blocks)
    return iff(length(res)?res:mask)
end function

global function vmask(sequence source, integer column)
string res = repeat(' ',length(source))
    for i=1 to length(source) do
        res[i] = source[i][column]
    end for
    return res
end function

function logic()
integer wasunsolved = unsolved
    for i=1 to length(x) do
        grid[i] = inner(grid[i],x[i])
    end for
    for j=1 to length(y) do
        string tmp = inner(vmask(grid,j),y[j])
        for i=1 to length(tmp) do
            grid[i][j] = tmp[i]
        end for
    end for
    unsolved = count_grid()
    return wasunsolved!=unsolved
end function

sequence tests=split("""
C BA CB BB F AE F A B
AB CA AE GA E C D C

F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC
D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA

CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC
BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC

E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G
E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM""",'\n')
--Alternatively:
--integer fn = open("nonogram_problems.txt","r")
--tests = get_text(fn,GT_LF_STRIPPED)
--close(fn)

function unpack(string s)
sequence res = split(s)
    for i=1 to length(res) do
        string ri = res[i]
        sequence r = {}
        for j=1 to length(ri) do
            r &= ri[j]-'A'+1
        end for
        res[i] = r
    end for
    return res
end function

for i=1 to length(tests) by 3 do
    x = unpack(tests[i])
    y = unpack(tests[i+1])
    grid = repeat(repeat('?',length(y)),length(x))
    unsolved = length(x)*length(y)

    while unsolved do
        if not logic() then
            ?"partial"
            exit
        end if
    end while

    puts(1,join(grid,"\n")&"\n")
end for


heap:=12;
while heap>0 do
    !!('There are ',heap,' tokens left. How many do you want to take?');
    ?take;
    while take<1 or take>3 or take>heap do
        !!('You cannot take that number. Choose again.');
        ?take;
    od;
    !!('On my turn I will take ',4-take,' tokens.');
    heap:-(4);
od;

!!('I got the last token. Better luck next time!');


dim as ubyte heap=12, take

while heap > 0
    print using "There are ## tokens remaining. How many would you like to take?"; heap
    input take
    while take=0 orelse take>3
        print "You must take 1, 2, or 3 tokens. How many would you like to take?"
        input take
    wend

    print using "On my turn I will take ## tokens."; 4-take
    heap = heap - 4
wend

print "I got the last token. I win! Better luck next time."


package main

import (
    "bufio"
    "fmt"
    "os"
    "strconv"
)

func showTokens(tokens int) {
    fmt.Println("Tokens remaining", tokens, "\n")
}

func main() {
    tokens := 12
    scanner := bufio.NewScanner(os.Stdin)
    for {
        showTokens(tokens)
        fmt.Print("  How many tokens 1, 2 or 3? ")
        scanner.Scan()
        if scerr := scanner.Err(); scerr != nil {
            fmt.Println("Error reading standard input:", scerr)
            return
        }
        t, err := strconv.Atoi(scanner.Text())
        if err != nil || t < 1 || t > 3 {
            fmt.Println("\nMust be a number between 1 and 3, try again.\n")
        } else {
            ct := 4 - t
            s := "s"
            if ct == 1 {
                s = ""
            }
            fmt.Print("  Computer takes ", ct, " token", s, "\n\n")
            tokens -= 4
        }
        if tokens == 0 {
            showTokens(0)
            fmt.Println("  Computer wins!")
            return
        }
    }
}


import util, sat.

main =>
    Hr = "E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
    Hc = "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM",
    Lr = [token_to_hints(Token) : Token in split(Hr)],
    Lc = [token_to_hints(Token) : Token in split(Hc)],
    MaxR = len(Lr),
    MaxC = len(Lc),
    foreach (Hints in Lr)
        constrain_starts(Hints,MaxC)
    end,
    foreach (Hints in Lc)
        constrain_starts(Hints,MaxR)
    end,
    M = new_array(MaxR,MaxC),
    M :: 0..1,
    foreach ({R,Hints} in zip(1..MaxR, Lr))
        sum([M[R,C] : C in 1..MaxC]) #= sum([Num : (Num,_) in Hints])
    end,
    foreach ({R,Hints} in zip(1..MaxR, Lr), (Num,Start) in Hints, C in 1..MaxC-Num+1)
        Start #= C #=> sum([M[R,C+I] : I in 0..Num-1]) #= Num
    end,
    %
    foreach ({C,Hints} in zip(1..MaxC, Lc))
        sum([M[R,C] : R in 1..MaxR]) #= sum([Num : (Num,_) in Hints])
    end,
    foreach ({C,Hints} in zip(1..MaxC, Lc), (Num,Start) in Hints, R in 1..MaxR-Num+1)
        Start #= R #=> sum([M[R+I,C] : I in 0..Num-1]) #= Num
    end,
    solve((Lr,Lc,M)),
    foreach (R in 1..MaxR)
        foreach (C in 1..MaxC)
            printf("%2c", cond(M[R,C] == 1, '#', '.'))
        end,
        nl
    end.

% convert "BCB" to [(2,_),(3,_),(2,_)]
% a hint is a pair (Num,Start), where Num is the length of the 1 segment and Start is the starting row number or column number
token_to_hints([]) = [].
token_to_hints([C|Cs]) = [(ord(C)-ord('A')+1, _)|token_to_hints(Cs)].

% there must be a gap between two neighboring segments
constrain_starts([(Num,Start)],Max) =>
    Start :: 1..Max,
    Start+Num-1 #<= Max.
constrain_starts([(Num1,Start1),(Num2,Start2)|L],Max) =>
    Start1 :: 1..Max,
    Start1+Num1 #< Start2,
    constrain_starts([(Num2,Start2)|L],Max).


/*
* Nonogram/paint-by-numbers solver in SWI-Prolog. Uses CLP(FD),
* in particular the automaton/3 (finite-state/RE) constraint.
* Copyright (c) 2011 Lars Buitinck.
* Do with this code as you like, but don't remove the copyright notice.
*/

:- use_module(library(clpfd)).

nono(RowSpec, ColSpec, Grid) :-
	rows(RowSpec, Grid),
	transpose(Grid, GridT),
	rows(ColSpec, GridT).

rows([], []).
rows([C|Cs], [R|Rs]) :-
	row(C, R),
	rows(Cs, Rs).

row(Ks, Row) :-
	sum(Ks, #=, Ones),
	sum(Row, #=, Ones),
	arcs(Ks, Arcs, start, Final),
	append(Row, [0], RowZ),
	automaton(RowZ, [source(start), sink(Final)], [arc(start,0,start) | Arcs]).

% Make list of transition arcs for finite-state constraint.
arcs([], [], Final, Final).
arcs([K|Ks], Arcs, CurState, Final) :-
	gensym(state, NextState),
	(   K == 0
	->  Arcs = [arc(CurState,0,CurState), arc(CurState,0,NextState) | Rest],
	    arcs(Ks, Rest, NextState, Final)
	;   Arcs = [arc(CurState,1,NextState) | Rest],
	    K1 #= K-1,
	    arcs([K1|Ks], Rest, NextState, Final)).

make_grid(Grid, X, Y, Vars) :-
	length(Grid,X),
	make_rows(Grid, Y, Vars).

make_rows([], _, []).
make_rows([R|Rs], Len, Vars) :-
	length(R, Len),
	make_rows(Rs, Len, Vars0),
	append(R, Vars0, Vars).

print([]).
print([R|Rs]) :-
	print_row(R),
	print(Rs).

print_row([]) :- nl.
print_row([X|R]) :-
	(   X == 0
	->  write(' ')
	;   write('x')),
	print_row(R).

nonogram(Rows, Cols) :-
	length(Rows, X),
	length(Cols, Y),
	make_grid(Grid, X, Y, Vars),
	nono(Rows, Cols, Grid),
	label(Vars),
	print(Grid).


10 HEAP = 12
20 WHILE HEAP>0
30 TAKE = 0
40 PRINT "There are ";HEAP;" tokens left."
50 WHILE TAKE < 1 OR TAKE > 3 OR TAKE > HEAP
60 INPUT "How many would you like to take? ", TAKE
70 IF TAKE = HEAP THEN GOTO 140
80 WEND
90 PRINT "I will take ";4-TAKE;" tokens."
100 HEAP = HEAP - 4
110 WEND
120 PRINT "I got the last token. Better luck next time."
130 END
140 PRINT "You got the last token. Congratulations!"
150 END


import Data.Char (isDigit, digitToInt)
import System.IO

prompt :: String
prompt = "How many do you take? 1, 2 or 3? "

getPlayerSelection :: IO Int
getPlayerSelection = do
  hSetBuffering stdin NoBuffering
  c <- getChar
  putChar '\n'
  if isDigit c && digitToInt c <= 3 then
    pure (digitToInt c)
  else do
    putStrLn "Invalid input"
    putStr prompt
    getPlayerSelection

play :: Int -> IO ()
play n = do
  putStrLn $ show n ++ token n ++ " remain."
  if n == 0 then putStrLn "Computer Wins!"
  else do
    putStr prompt
    playerSelection <- getPlayerSelection
    let computerSelection
          | playerSelection > 4 = playerSelection - 4
          | otherwise = 4 - playerSelection
    putStrLn $ "Computer takes " ++ show computerSelection ++ token computerSelection ++ ".\n"
    play (n - computerSelection - playerSelection)
  where token 1 = " token"
        token _ = " tokens"

main :: IO ()
main = play 12


100 PROGRAM "Nim.bas"
110 RANDOMIZE
120 CLEAR SCREEN
130 LET TOKENS=12
140 PRINT "Starting with";TOKENS;"tokens.":PRINT
150 DO
160   PRINT "How many tokens will you take? (1-3) ";
170   DO
180     LET K=VAL(INKEY$)
190   LOOP UNTIL K>0 AND K<4
200   LET TOKENS=MAX(TOKENS-K,0):LET G=0
210   PRINT K:PRINT TAB(19);TOKENS;"remainig.":PRINT
220   IF TOKENS>0 THEN
230     LET L=MOD(TOKENS,4)
240     IF L=0 THEN LET L=MIN(RND(3)+1,TOKENS)
250     LET TOKENS=TOKENS-L:LET G=-1
260     PRINT "Computer takes";L;"tokens.";TOKENS;"remaining.":PRINT
270   END IF
280 LOOP WHILE TOKENS>0
290 IF G THEN
300   PRINT "Computer wins!"
310 ELSE
320   PRINT "You win!"
330 END IF


from itertools import izip

def gen_row(w, s):
    """Create all patterns of a row or col that match given runs."""
    def gen_seg(o, sp):
        if not o:
            return [[2] * sp]
        return [[2] * x + o[0] + tail
                for x in xrange(1, sp - len(o) + 2)
                for tail in gen_seg(o[1:], sp - x)]

    return [x[1:] for x in gen_seg([[1] * i for i in s], w + 1 - sum(s))]

def deduce(hr, vr):
    """Fix inevitable value of cells, and propagate."""
    def allowable(row):
        return reduce(lambda a, b: [x | y for x, y in izip(a, b)], row)

    def fits(a, b):
        return all(x & y for x, y in izip(a, b))

    def fix_col(n):
        """See if any value in a given column is fixed;
        if so, mark its corresponding row for future fixup."""
        c = [x[n] for x in can_do]
        cols[n] = [x for x in cols[n] if fits(x, c)]
        for i, x in enumerate(allowable(cols[n])):
            if x != can_do[i][n]:
                mod_rows.add(i)
                can_do[i][n] &= x

    def fix_row(n):
        """Ditto, for rows."""
        c = can_do[n]
        rows[n] = [x for x in rows[n] if fits(x, c)]
        for i, x in enumerate(allowable(rows[n])):
            if x != can_do[n][i]:
                mod_cols.add(i)
                can_do[n][i] &= x

    def show_gram(m):
        # If there's 'x', something is wrong.
        # If there's '?', needs more work.
        for x in m:
            print " ".join("x#.?"[i] for i in x)
        print

    w, h = len(vr), len(hr)
    rows = [gen_row(w, x) for x in hr]
    cols = [gen_row(h, x) for x in vr]
    can_do = map(allowable, rows)

    # Initially mark all columns for update.
    mod_rows, mod_cols = set(), set(xrange(w))

    while mod_cols:
        for i in mod_cols:
            fix_col(i)
        mod_cols = set()
        for i in mod_rows:
            fix_row(i)
        mod_rows = set()

    if all(can_do[i][j] in (1, 2) for j in xrange(w) for i in xrange(h)):
        print "Solution would be unique" # but could be incorrect!
    else:
        print "Solution may not be unique, doing exhaustive search:"

    # We actually do exhaustive search anyway. Unique solution takes
    # no time in this phase anyway, but just in case there's no
    # solution (could happen?).
    out = [0] * h

    def try_all(n = 0):
        if n >= h:
            for j in xrange(w):
                if [x[j] for x in out] not in cols[j]:
                    return 0
            show_gram(out)
            return 1
        sol = 0
        for x in rows[n]:
            out[n] = x
            sol += try_all(n + 1)
        return sol

    n = try_all()
    if not n:
        print "No solution."
    elif n == 1:
        print "Unique solution."
    else:
        print n, "solutions."
    print

def solve(p, show_runs=True):
    s = [[[ord(c) - ord('A') + 1 for c in w] for w in l.split()]
         for l in p.splitlines()]
    if show_runs:
        print "Horizontal runs:", s[0]
        print "Vertical runs:", s[1]
    deduce(s[0], s[1])

def main():
    # Read problems from file.
    fn = "nonogram_problems.txt"
    for p in (x for x in open(fn).read().split("\n\n") if x):
        solve(p)

    print "Extra example not solvable by deduction alone:"
    solve("B B A A\nB B A A")

    print "Extra example where there is no solution:"
    solve("B A A\nA A A")

main()


nim=: {{
  prompt tokens=: 12
}}

prompt=: {{
  echo 'tokens: ',":tokens
  if. 1>tokens do.
    echo 'game over'
  else.
    echo 'take 1, 2 or 3 tokens'
  end.
}}

take=: {{
  assert. y e.1 2 3
  assert. 0=#$y
  echo 'tokens: ',":tokens=:tokens-y
  echo 'I take ',(":t=. 4-y),' tokens'
  prompt tokens=:tokens-t
}}