import "/fmt" for Fmt
import "/ioutil" for FileUtil, Stdin

var rows = 0     // extent of input configuration
var cols = 0     // """
var rx   = 0     // grid extent (includes border)
var cx   = 0     // """
var mn   = []    // offsets of Moore neighborhood

var print = Fn.new { |grid|
    System.print("__" * cols)
    System.print()
    for (r in 1..rows) {
        for (c in 1..cols) Fmt.write(" $s", grid[r*cx+c])
        System.print()
    }
}

var step = Fn.new { |dst, src|
    for (r in 1..rows) {
        for (c in 1..cols) {
            var x = r*cx + c
            dst[x] = src[x]
            if (dst[x] == "H") {
                dst[x] = "t"
            } else if (dst[x] == "t") {
                dst[x] = "."
            } else if (dst[x] == ".") {
                var nn = 0
                for (n in mn) {
                    if (src[x+n] == "H") nn = nn + 1
                }
                if (nn == 1 || nn == 2) dst[x] = "H"
            }
        }
    }
}

var srcRows = FileUtil.readLines("ww.config")
rows = srcRows.count
for (r in srcRows) {
    if (r.count > cols) cols = r.count
}
rx = rows + 2
cx = cols + 2
mn = [-cx-1, -cx, -cx+1, -1, 1, cx-1, cx, cx+1]

// allocate two grids and copy input into first grid
var odd  = List.filled(rx*cx, " ")
var even = List.filled(rx*cx, " ")

var ri = 0
for (r in srcRows) {
    for (i in 0...r.count) {
        odd[(ri+1)*cx+1+i] = r[i]
    }
    ri = ri + 1
}

// run
while (true) {
    print.call(odd)
    step.call(even, odd)
    Stdin.readLine() // wait for enter to be pressed

    print.call(even)
    step.call(odd, even)
    Stdin.readLine() // ditto
}


include c:\cxpl\codes;          \intrinsic 'code' declarations
char New(53,40), Old(53,40);

proc Block(X0, Y0, C);          \Display a colored block
int  X0, Y0, C;                 \big (6x5) coordinates, char
int  X, Y;
[case C of                      \convert char to color
  ^H:   C:= $9;                 \blue
  ^t:   C:= $C;                 \red
  ^.:   C:= $E                  \yellow
other   C:= 0;                  \black
for Y:= Y0*5 to Y0*5+4 do       \make square blocks by correcting aspect ratio
    for X:= X0*6 to X0*6+5 do   \ (6x5 = square)
        Point(X,Y,C);
];

int X, Y, C;
[SetVid($13);                   \set 320x200 graphics display
for Y:= 0 to 40-1 do            \initialize New with space (empty) characters
    for X:= 0 to 53-1 do
        New(X, Y):= ^ ;
X:= 1;  Y:= 1;                  \read file from command line, skipping borders
loop    [C:= ChIn(1);
        case C of
          $0D:  X:= 1;          \carriage return
          $0A:  Y:= Y+1;        \line feed
          $1A:  quit            \end of file
        other   [New(X,Y):= C;  X:= X+1];
        ];
repeat  C:= Old;  Old:= New;  New:= C;  \swap arrays, by swapping their pointers
        for Y:= 1 to 39-1 do            \generate New array from Old
            for X:= 1 to 52-1 do        \ (skipping borders)
                [case Old(X,Y) of
                  ^ :   New(X,Y):= ^ ;  \copy empty to empty
                  ^H:   New(X,Y):= ^t;  \convert head to tail
                  ^t:   New(X,Y):= ^.   \convert tail to conductor
                other   [C:= (Old(X-1,Y-1)=^H) + (Old(X+0,Y-1)=^H) + \head count
                             (Old(X+1,Y-1)=^H) + (Old(X-1,Y+0)=^H) + \ in neigh-
                             (Old(X+1,Y+0)=^H) + (Old(X-1,Y+1)=^H) + \ boring
                             (Old(X+0,Y+1)=^H) + (Old(X+1,Y+1)=^H);  \ cells
                        New(X,Y):= if C=-1 or C=-2 then ^H else ^.;  \ (true=-1)
                        ];
                Block(X, Y, New(X,Y));  \display result
                ];
        Sound(0, 6, 1);                 \delay about 1/3 second
until   KeyHit;                         \keystroke terminates program
SetVid(3);                              \restore normal text mode
]


open window 230,130
backcolor 0,0,0
clear window

label circuit
	DATA "             "
	DATA " tH......... "
	DATA " .   .       "
	DATA "    ...      "
	DATA " .   .       "
	DATA " Ht.. ...... "
	DATA "             "
	DATA ""

do
	read a$
	if a$ = "" break
	n = n + 1
	redim t$(n)
	t$(n) = a$+a$
loop

size = len(t$(1))/2
E2 = size
first = true
Orig = 0
Dest = E2

do
  for y = 2 to n-1
    for x = 2 to E2-1
      switch mid$(t$(y),x+Orig,1)
        case " ": color 32,32,32 : mid$(t$(y),x+Dest,1) = " " : break
        case "H": color 0,0,255 : mid$(t$(y),x+Dest,1) = "t" : break
        case "t": color 255,0,0 : mid$(t$(y),x+Dest,1) = "." : break
        case ".":
          color 255,200,0
          t = 0
          for y1 = y-1 to y+1
          	for x1 = x-1 to x+1
          		t = t + ("H" = mid$(t$(y1),x1+Orig,1))
          	next x1
          next y1
          if t=1 or t=2 then
          	mid$(t$(y),x+Dest,1) = "H"
          else
          	mid$(t$(y),x+Dest,1) = "."
          end if
      end switch
      fill circle x*16, y*16, 8
    next x
    print t$(y),"="
  next y
  first = not first
  if first then
  	Orig = 0 : Dest = E2
  else
  	Orig = E2 : Dest = 0
  end if
  wait .5
loop


F divisors(n)
   V divs = [1]
   [Int] divs2
   V i = 2
   L i * i <= n
      I n % i == 0
         V j = n I/ i
         divs [+]= i
         I i != j
            divs2 [+]= j
      i++
   R divs2 [+] reversed(divs)

F abundant(n, divs)
   R sum(divs) > n

F semiperfect(n, divs) -> Bool
   I !divs.empty
      V h = divs[0]
      V t = divs[1..]
      I n < h
         R semiperfect(n, t)
      E
         R n == h | semiperfect(n - h, t) | semiperfect(n, t)
   E
      R 0B

F sieve(limit)
   V w = [0B] * limit
   L(i) (2 .< limit).step(2)
      I w[i]
         L.continue
      V divs = divisors(i)
      I !abundant(i, divs)
         w[i] = 1B
      E I semiperfect(i, divs)
         L(j) (i .< limit).step(i)
            w[j] = 1B
   R w

V w = sieve(17'000)
V count = 0
print(‘The first 25 weird numbers:’)
L(n) (2..).step(2)
   I !w[n]
      print(n, end' ‘ ’)
      count++
      I count == 25
         L.break


BEGIN # find wierd numbers - abundant but not semiperfect numbers - translation of Go #
    # returns the divisors of n in descending order #
    PROC divisors = ( INT n )[]INT:
         BEGIN
            INT max divs = 2 * ENTIER sqrt( n );
            [ 1 : max divs ]INT divs;
            [ 1 : max divs ]INT divs2;
            INT d pos := 0, d2 pos := 0;
            divs[ d pos +:= 1 ] := 1;
            FOR i FROM 2 WHILE i * i <= n DO
                IF n MOD i = 0 THEN
                    INT j = n OVER i;
                    divs[ d pos +:= 1 ] := i;
                    IF i /= j THEN divs2[ d2 pos +:= 1 ] := j FI
                FI
            OD;
            FOR i FROM d pos BY -1 WHILE i > 0 DO
                divs2[ d2 pos +:= 1 ] := divs[ i ]
            OD;
            divs2[ 1 : d2 pos ]
         END # divisors # ;
    # returns TRUE if n with divisors divs, is abundant, FALSE otherwise #
    PROC abundant = ( INT n, []INT divs )BOOL:
         BEGIN
            INT sum := 0;
            FOR i FROM LWB divs TO UPB divs DO sum +:= divs[ i ] OD;
            sum > n
         END # abundant # ;
    # returns TRUE if n with divisors divs, is semiperfect, FALSE otherwise #
    PROC semiperfect = ( INT n, []INT divs, INT lb, ub )BOOL:
         IF   ub < lb
         THEN FALSE
         ELIF INT h = divs[ lb ];
              n < h
         THEN semiperfect( n,     divs, lb + 1, ub )
         ELIF n = h
         THEN TRUE
         ELIF semiperfect( n - h, divs, lb + 1, ub )
         THEN TRUE
         ELSE semiperfect( n,     divs, lb + 1, ub )
         FI # semiperfect # ;
    # returns a sieve where FALSE = abundant and not semiperfect #
    PROC sieve = ( INT limit )[]BOOL:
         BEGIN # Only interested in even numbers >= 2 #
            [ 1 : limit ]BOOL w; FOR i FROM 1 TO limit DO w[ i ] := FALSE OD;
            FOR i FROM 2 BY 2 TO limit DO
                IF NOT w[ i ] THEN
                    []INT divs = divisors( i );
                    IF NOT abundant( i, divs ) THEN
                        w[ i ] := TRUE
                    ELIF semiperfect( i, divs, LWB divs, UPB divs ) THEN
                        FOR j FROM i BY i TO limit DO w[ j ] := TRUE OD
                    FI
                FI
            OD;
            w
         END # sieve # ;
    BEGIN # task #
        []BOOL w = sieve( 17 000 );
        INT count := 0;
        INT max = 25;
        print( ( "The first 25 weird numbers are:", newline ) );
        FOR n FROM 2 BY 2 WHILE count < max DO
            IF NOT w[ n ] THEN
                print( ( whole( n, 0 ), " " ) );
                count +:= 1
            FI
        OD;
        print( ( newline ) )
    END
END


on run
    take(25, weirds())
    -- Gets there, but takes about 6 seconds on this system,
    -- (logging intermediates through the Messages channel, for the impatient :-)
end run

-- weirds :: Gen [Int]
on weirds()
    script
        property x : 1
        property v : 0
        on |λ|()
            repeat until isWeird(x)
                set x to 1 + x
            end repeat
            set v to x
            log v
            set x to 1 + x
            return v
        end |λ|
    end script
end weirds

-- isWeird :: Int -> Bool
on isWeird(n)
    set ds to descProperDivisors(n)
    set d to sum(ds) - n
    0 < d and not hasSum(d, ds)
end isWeird

-- hasSum :: Int -> [Int] -> Bool
on hasSum(n, xs)
    if {} ≠ xs then
        set h to item 1 of xs
        set t to rest of xs
        if n < h then
            hasSum(n, t)
        else
            n = h or hasSum(n - h, t) or hasSum(n, t)
        end if
    else
        false
    end if
end hasSum

-- GENERIC ------------------------------------------------

-- descProperDivisors :: Int -> [Int]
on descProperDivisors(n)
    if n = 1 then
        {1}
    else
        set realRoot to n ^ (1 / 2)
        set intRoot to realRoot as integer
        set blnPerfect to intRoot = realRoot

        -- isFactor :: Int -> Bool
        script isFactor
            on |λ|(x)
                n mod x = 0
            end |λ|
        end script

        -- Factors up to square root of n,
        set lows to filter(isFactor, enumFromTo(1, intRoot))

        -- and cofactors of these beyond the square root,

        -- integerQuotient :: Int -> Int
        script integerQuotient
            on |λ|(x)
                (n / x) as integer
            end |λ|
        end script

        set t to rest of lows
        if blnPerfect then
            set xs to t
        else
            set xs to lows
        end if
        map(integerQuotient, t) & (reverse of xs)
    end if
end descProperDivisors

-- enumFromTo :: (Int, Int) -> [Int]
on enumFromTo(m, n)
    if m ≤ n then
        set lst to {}
        repeat with i from m to n
            set end of lst to i
        end repeat
        return lst
    else
        return {}
    end if
end enumFromTo

-- filter :: (a -> Bool) -> [a] -> [a]
on filter(f, xs)
    tell mReturn(f)
        set lst to {}
        set lng to length of xs
        repeat with i from 1 to lng
            set v to item i of xs
            if |λ|(v, i, xs) then set end of lst to v
        end repeat
        return lst
    end tell
end filter

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- sum :: [Num] -> Num
on sum(xs)
    script add
        on |λ|(a, b)
            a + b
        end |λ|
    end script

    foldl(add, 0, xs)
end sum

-- take :: Int -> Gen [a] -> [a]
on take(n, xs)
    set ys to {}
    repeat with i from 1 to n
        set v to xs's |λ|()
        if missing value is v then
            return ys
        else
            set end of ys to v
        end if
    end repeat
    return ys
end take

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    if script is class of f then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn


#include "stdio.h"
#include "stdlib.h"
#include "stdbool.h"
#include "string.h"

struct int_a {
    int *ptr;
    size_t size;
};

struct int_a divisors(int n) {
    int *divs, *divs2, *out;
    int i, j, c1 = 0, c2 = 0;
    struct int_a array;

    divs = malloc(n * sizeof(int) / 2);
    divs2 = malloc(n * sizeof(int) / 2);
    divs[c1++] = 1;

    for (i = 2; i * i <= n; i++) {
        if (n % i == 0) {
            j = n / i;
            divs[c1++] = i;
            if (i != j) {
                divs2[c2++] = j;
            }
        }
    }

    out = malloc((c1 + c2) * sizeof(int));
    for (int i = 0; i < c2; i++) {
        out[i] = divs2[i];
    }
    for (int i = 0; i < c1; i++) {
        out[c2 + i] = divs[c1 - i - 1];
    }
    array.ptr = out;
    array.size = c1 + c2;

    free(divs);
    free(divs2);
    return array;
}

bool abundant(int n, struct int_a divs) {
    int sum = 0;
    int i;
    for (i = 0; i < divs.size; i++) {
        sum += divs.ptr[i];
    }
    return sum > n;
}

bool semiperfect(int n, struct int_a divs) {
    if (divs.size > 0) {
        int h = *divs.ptr;
        int *t = divs.ptr + 1;

        struct int_a ta;
        ta.ptr = t;
        ta.size = divs.size - 1;

        if (n < h) {
            return semiperfect(n, ta);
        } else {
            return n == h
                || semiperfect(n - h, ta)
                || semiperfect(n, ta);
        }
    } else {
        return false;
    }
}

bool *sieve(int limit) {
    bool *w = calloc(limit, sizeof(bool));
    struct int_a divs;
    int i, j;

    for (i = 2; i < limit; i += 2) {
        if (w[i]) continue;
        divs = divisors(i);
        if (!abundant(i, divs)) {
            w[i] = true;
        } else if (semiperfect(i, divs)) {
            for (j = i; j < limit; j += i) {
                w[j] = true;
            }
        }
    }

    free(divs.ptr);
    return w;
}

int main() {
    bool *w = sieve(17000);
    int count = 0;
    int max = 25;
    int n;

    printf("The first 25 weird numbers:\n");
    for (n = 2; count < max; n += 2) {
        if (!w[n]) {
            printf("%d ", n);
            count++;
        }
    }
    printf("\n");

    free(w);
    return 0;
}


using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using System.Threading.Tasks;

namespace WeirdNumbers {
    class Program {
        static List<int> Divisors(int n) {
            List<int> divs = new List<int> { 1 };
            List<int> divs2 = new List<int>();

            for (int i = 2; i * i <= n; i++) {
                if (n % i == 0) {
                    int j = n / i;
                    divs.Add(i);
                    if (i != j) {
                        divs2.Add(j);
                    }
                }
            }

            divs.Reverse();
            divs2.AddRange(divs);
            return divs2;
        }

        static bool Abundant(int n, List<int> divs) {
            return divs.Sum() > n;
        }

        static bool Semiperfect(int n, List<int> divs) {
            if (divs.Count > 0) {
                var h = divs[0];
                var t = divs.Skip(1).ToList();
                if (n < h) {
                    return Semiperfect(n, t);
                } else {
                    return n == h
                        || Semiperfect(n - h, t)
                        || Semiperfect(n, t);
                }
            } else {
                return false;
            }
        }

        static List<bool> Sieve(int limit) {
            // false denotes abundant and not semi-perfect.
            // Only interested in even numbers >= 2
            bool[] w = new bool[limit];
            for (int i = 2; i < limit; i += 2) {
                if (w[i]) continue;
                var divs = Divisors(i);
                if (!Abundant(i, divs)) {
                    w[i] = true;
                } else if (Semiperfect(i, divs)) {
                    for (int j = i; j < limit; j += i) {
                        w[j] = true;
                    }
                }
            }
            return w.ToList();
        }

        static void Main() {
            var w = Sieve(17_000);
            int count = 0;
            int max = 25;
            Console.WriteLine("The first 25 weird numbers:");
            for (int n = 2; count < max; n += 2) {
                if (!w[n]) {
                    Console.Write("{0} ", n);
                    count++;
                }
            }
            Console.WriteLine();
        }
    }
}


#include <algorithm>
#include <iostream>
#include <numeric>
#include <vector>

std::vector<int> divisors(int n) {
    std::vector<int> divs = { 1 };
    std::vector<int> divs2;

    for (int i = 2; i * i <= n; i++) {
        if (n % i == 0) {
            int j = n / i;
            divs.push_back(i);
            if (i != j) {
                divs2.push_back(j);
            }
        }
    }

    std::copy(divs.cbegin(), divs.cend(), std::back_inserter(divs2));
    return divs2;
}

bool abundant(int n, const std::vector<int> &divs) {
    return std::accumulate(divs.cbegin(), divs.cend(), 0) > n;
}

template<typename IT>
bool semiperfect(int n, const IT &it, const IT &end) {
    if (it != end) {
        auto h = *it;
        auto t = std::next(it);
        if (n < h) {
            return semiperfect(n, t, end);
        } else {
            return n == h
                || semiperfect(n - h, t, end)
                || semiperfect(n, t, end);
        }
    } else {
        return false;
    }
}

template<typename C>
bool semiperfect(int n, const C &c) {
    return semiperfect(n, std::cbegin(c), std::cend(c));
}

std::vector<bool> sieve(int limit) {
    // false denotes abundant and not semi-perfect.
    // Only interested in even numbers >= 2
    std::vector<bool> w(limit);
    for (int i = 2; i < limit; i += 2) {
        if (w[i]) continue;
        auto divs = divisors(i);
        if (!abundant(i, divs)) {
            w[i] = true;
        } else if (semiperfect(i, divs)) {
            for (int j = i; j < limit; j += i) {
                w[j] = true;
            }
        }
    }
    return w;
}

int main() {
    auto w = sieve(17000);
    int count = 0;
    int max = 25;
    std::cout << "The first 25 weird numbers:";
    for (int n = 2; count < max; n += 2) {
        if (!w[n]) {
            std::cout << n << ' ';
            count++;
        }
    }
    std::cout << '\n';
    return 0;
}


def divisors(n : Int32) : Array(Int32)
  divs = [1]
  divs2 = [] of Int32

  i = 2
  while i * i < n
    if n % i == 0
      j = n // i
      divs << i
      divs2 << j if i != j
    end

    i += 1
  end

  i = divs.size - 1

  # TODO: Use reverse
  while i >= 0
    divs2 << divs[i]
    i -= 1
  end

  divs2
end

def abundant(n : Int32, divs : Array(Int32)) : Bool
  divs.sum > n
end

def semiperfect(n : Int32, divs : Array(Int32)) : Bool
  if divs.size > 0
    h = divs[0]
    t = divs[1..]

    return n < h ? semiperfect(n, t) : n == h || semiperfect(n - h, t) || semiperfect(n, t)
  end

  return false
end

def sieve(limit : Int32) : Array(Bool)
  # false denotes abundant and not semi-perfect.
  # Only interested in even numbers >= 2

  w = Array(Bool).new(limit, false) # An array filled with 'false'

  i = 2
  while i < limit
    if !w[i]
      divs = divisors i

      if !abundant(i, divs)
        w[i] = true
      elsif semiperfect(i, divs)
        j = i
        while j < limit
          w[j] = true
          j += i
        end
      end
    end

    i += 2
  end

  w
end

def main
  w = sieve 17000
  count = 0
  max = 25

  print "The first 25 weird numbers are: "

  n = 2
  while count < max
    if !w[n]
      print "#{n} "
      count += 1
    end

    n += 2
  end

  puts "\n"
end

require "benchmark"
puts Benchmark.measure { main }


import std.algorithm;
import std.array;
import std.stdio;

int[] divisors(int n) {
    int[] divs = [1];
    int[] divs2;
    for (int i = 2; i * i <= n; i++) {
        if (n % i == 0) {
            int j = n / i;
            divs ~= i;
            if (i != j) {
                divs2 ~= j;
            }
        }
    }
    divs2 ~= divs.reverse;
    return divs2;
}

bool abundant(int n, int[] divs) {
    return divs.sum() > n;
}

bool semiperfect(int n, int[] divs) {
    // This algorithm is O(2^N) for N == divs.length when number is not semiperfect.
    // Comparing with (divs.sum < n) instead (divs.length==0) removes unnecessary
    // recursive binary tree branches.
    auto s = divs.sum;
    if(s == n)
      return true;
    else if ( s<n )
      return false;
    else {
        auto h = divs[0];
        auto t = divs[1..$];
        if (n < h) {
            return semiperfect(n, t);
        } else {
            return n == h
                // Supossin h is part of the sum
                || semiperfect(n - h, t)
                // Supossin h is not part of the sum
                || semiperfect(n, t);
        }
    }
}

bool[] sieve(int limit) {
    // false denotes abundant and not semi-perfect.
    // Only interested in even numbers >= 2
    auto w = uninitializedArray!(bool[])(limit);
    w[] = false;
    for (int i = 2; i < limit; i += 2) {
        if (w[i]) continue;
        auto divs = divisors(i);
        if (!abundant(i, divs)) {
            w[i] = true;
        } else if (semiperfect(i, divs)) {
            for (int j = i; j < limit; j += i) {
                w[j] = true;
            }
        }
    }
    return w;
}

void main() {
    auto w = sieve(17_000);
    int count = 0;
    int max = 25;
    writeln("The first 25 weird numbers:");
    for (int n = 2; count < max; n += 2) {
        if (!w[n]) {
            write(n, ' ');
            count++;
        }
    }
    writeln;
}


let divisors n = [1..n/2] |> List.filter (fun x->n % x = 0)

let abundant (n:int) divs = Seq.sum(divs) > n

let rec semiperfect (n:int) (divs:List<int>) =
    if divs.Length > 0 then
        let h = divs.Head
        let t = divs.Tail
        if n < h then
            semiperfect n t
        else
            n = h || (semiperfect (n - h) t) || (semiperfect n t)
    else false

let weird n =
    let d = divisors n
    if abundant n d then
        not(semiperfect n d)
    else
        false

[<EntryPoint>]
let main _ =
    let mutable i = 1
    let mutable count = 0
    while (count < 25) do
        if (weird i) then
            count <- count + 1
            printf "%d -> %d\n" count i
        i <- i + 1

    0 // return an integer exit code


USING: combinators.short-circuit io kernel lists lists.lazy
locals math math.primes.factors prettyprint sequences ;
IN: rosetta-code.weird-numbers

:: has-sum? ( n seq -- ? )
    seq [ f ] [
        unclip-slice :> ( xs x )
        n x < [ n xs has-sum? ] [
            {
                [ n x = ]
                [ n x - xs has-sum? ]
                [ n xs has-sum? ]
            } 0||
        ] if
    ] if-empty ;

: weird? ( n -- ? )
    dup divisors but-last reverse
    { [ sum < ] [ has-sum? not ] } 2&& ;

: weirds ( -- list ) 1 lfrom [ weird? ] lfilter ;

: weird-numbers-demo ( -- )
    "First 25 weird numbers:" print
    25 weirds ltake list>array . ;

MAIN: weird-numbers-demo


Function GetFactors(n As Long,r() As Long) As Long
      Redim r(0)
      r(0)=1
      Dim As Long count,acc
      For z As Long=2 To n\2
            If n Mod z=0 Then
                  count+=1:redim preserve r(0 to count)
                  r(count)=z
                  acc+=z
            End If
      Next z
      Return 1+acc
End Function

sub sumcombinations(arr() As Long,n As Long,r As Long,index As Long,_data() As Long,i As Long,Byref ans As Long,ref As Long)
      Dim As Long acc
      If index=r Then
            For j As Long=0 To r-1
                  acc+=_data(j)
                  If acc=ref Then ans=1:Return
                  If acc>ref then return
            Next j
            Return
      End If
      If i>=n Or ans<>0 Then Return
      _data(index) = arr(i)
      sumcombinations(arr(),n,r,index + 1,_data(),i+1,ans,ref)
      sumcombinations(arr(),n,r,index,_data(),i+1,ans,ref)
End sub

Function IsWeird(u() As Long,num As Long) As Long
      Redim As Long d()
      Dim As Long ans
      For r As Long=2 To Ubound(u)
            Redim d(r)
            ans=0
            sumcombinations(u(),Ubound(u)+1,r,0,d(),0,ans,num)
            If ans =1 Then  Return 0
      Next r
      Return 1
End Function

Redim As Long u()
Dim As Long SumFactors,number=2,count
Do
      number+=2
      SumFactors=GetFactors(number,u())
      If SumFactors>number Then
            If IsWeird(u(),number) Then Print number;" ";:count+=1
      End If
Loop Until count=25
Print
Print "first 25 done"
Sleep


package main

import "fmt"

func divisors(n int) []int {
    divs := []int{1}
    divs2 := []int{}
    for i := 2; i*i <= n; i++ {
        if n%i == 0 {
            j := n / i
            divs = append(divs, i)
            if i != j {
                divs2 = append(divs2, j)
            }
        }
    }
    for i := len(divs) - 1; i >= 0; i-- {
        divs2 = append(divs2, divs[i])
    }
    return divs2
}

func abundant(n int, divs []int) bool {
    sum := 0
    for _, div := range divs {
        sum += div
    }
    return sum > n
}

func semiperfect(n int, divs []int) bool {
    le := len(divs)
    if le > 0 {
        h := divs[0]
        t := divs[1:]
        if n < h {
            return semiperfect(n, t)
        } else {
            return n == h || semiperfect(n-h, t) || semiperfect(n, t)
        }
    } else {
        return false
    }
}

func sieve(limit int) []bool {
    // false denotes abundant and not semi-perfect.
    // Only interested in even numbers >= 2
    w := make([]bool, limit)
    for i := 2; i < limit; i += 2 {
        if w[i] {
            continue
        }
        divs := divisors(i)
        if !abundant(i, divs) {
            w[i] = true
        } else if semiperfect(i, divs) {
            for j := i; j < limit; j += i {
                w[j] = true
            }
        }
    }
    return w
}

func main() {
    w := sieve(17000)
    count := 0
    const max = 25
    fmt.Println("The first 25 weird numbers are:")
    for n := 2; count < max; n += 2 {
        if !w[n] {
            fmt.Printf("%d ", n)
            count++
        }
    }
    fmt.Println()
}


weirds :: [Int]
weirds = filter abundantNotSemiperfect [1 ..]

abundantNotSemiperfect :: Int -> Bool
abundantNotSemiperfect n =
  let ds = descProperDivisors n
      d = sum ds - n
  in 0 < d && not (hasSum d ds)

hasSum :: Int -> [Int] -> Bool
hasSum _ [] = False
hasSum n (x:xs)
  | n < x = hasSum n xs
  | otherwise = (n == x) || hasSum (n - x) xs || hasSum n xs

descProperDivisors
  :: Integral a
  => a -> [a]
descProperDivisors n =
  let root = (floor . sqrt) (fromIntegral n :: Double)
      lows = filter ((0 ==) . rem n) [root,root - 1 .. 1]
      factors
        | n == root ^ 2 = tail lows
        | otherwise = lows
  in tail $ reverse (quot n <$> lows) ++ factors

main :: IO ()
main =
  (putStrLn . unlines) $
  zipWith (\i x -> show i ++ (" -> " ++ show x)) [1 ..] (take 25 weirds)


factor=: [: }: [: , [: */&> [: { [: <@(^ [email protected]>:)/"1 [: |: __&q:

classify=: 3 : 0
 weird =: perfect =: deficient =: abundant =: i. 0
 a=: (i. -. 0 , deficient =: 1 , i.&.:(p:inv)) y NB. a are potential semi-perfect numbers
 for_n. a do.
  if. n e. a do.
   factors=. factor n
   sf =. +/ factors
   if. sf < n do.
    deficient =: deficient , n
   else.
    if. n < sf do.
     abundant=: abundant , n
    else.
     perfect =: perfect , n
     a =: a -. (2+i.)@<.&.(%&n) y  NB. remove multiples of perfect numbers
     continue.
    end.
    NB. compute sums of subsets to detect semiperfection
    NB. the following algorithm correctly finds weird numbers less than 20000
    NB. remove large terms necessary for the sum to reduce the Catalan tally of sets
    factors =. /:~ factors  NB. ascending sort
    NB. if the sum of the length one outfixes is less n then the factor is required in the semiperfect set.
    i_required =. n (1 i.~ (>(1+/\.]))) factors
    target =. n - +/ i_required }. factors
    t =. i_required {. factors
    NB. work in chunks of 2^16 to reduce memory requirement
    sp =. target e. ; (,:~2^16) <@([: +/"1 t #~ (_ ,(#t)) {. #:);.3 i. 2 ^ # t
    if. sp do.
     a =: a -. (2+i.)@<.&.(%&n) y  NB. remove multiples of semi perfect numbers
    else.
     weird =: weird , n
     a =: a -. n
    end.
   end.
  end.
 end.
 a =: a -. deficient
 weird
)


import java.util.ArrayList;
import java.util.List;

public class WeirdNumbers {

    public static void main(String[] args) {
        int n = 2;
        //  n += 2 : No odd weird numbers < 10^21
        for ( int count = 1 ; count <= 25 ; n += 2 ) {
            if ( isWeird(n) ) {
                System.out.printf("w(%d) = %d%n", count, n);
                count++;
            }
        }
    }

    private static boolean isWeird(int n) {
        List<Integer> properDivisors = getProperDivisors(n);
        return isAbundant(properDivisors, n) && ! isSemiPerfect(properDivisors, n);
    }

    private static boolean isAbundant(List<Integer> divisors, int n) {
        int divisorSum = divisors.stream().mapToInt(i -> i.intValue()).sum();
        return divisorSum > n;
    }

    //  Use Dynamic Programming
    private static boolean isSemiPerfect(List<Integer> divisors, int sum) {
        int size = divisors.size();

        //  The value of subset[i][j] will be true if there is a subset of divisors[0..j-1] with sum equal to i
        boolean subset[][] = new boolean[sum+1][size+1];

        // If sum is 0, then answer is true
        for (int i = 0; i <= size; i++) {
            subset[0][i] = true;
        }

        //  If sum is not 0 and set is empty, then answer is false
        for (int i = 1; i <= sum; i++) {
            subset[i][0] = false;
        }

        // Fill the subset table in bottom up manner
        for ( int i = 1 ; i <= sum ; i++ ) {
            for ( int j = 1 ; j <= size ; j++ ) {
                subset[i][j] = subset[i][j-1];
                int test = divisors.get(j-1);
                if ( i >= test ) {
                    subset[i][j] = subset[i][j] || subset[i - test][j-1];
                }
            }
        }

        return subset[sum][size];
    }

    private static final List<Integer> getProperDivisors(int number) {
        List<Integer> divisors = new ArrayList<Integer>();
        long sqrt = (long) Math.sqrt(number);
        for ( int i = 1 ; i <= sqrt ; i++ ) {
            if ( number % i == 0 ) {
                divisors.add(i);
                int div = number / i;
                if ( div != i && div != number ) {
                    divisors.add(div);
                }
            }
        }
        return divisors;
    }

}


(() => {
    'use strict';

    // main :: IO ()
    const main = () =>
        take(25, weirds());

    // weirds :: Gen [Int]
    function* weirds() {
        let
            x = 1,
            i = 1;
        while (true) {
            x = until(isWeird, succ, x)
            console.log(i.toString() + ' -> ' + x)
            yield x;
            x = 1 + x;
            i = 1 + i;
        }
    }

    // isWeird :: Int -> Bool
    const isWeird = n => {
        const
            ds = descProperDivisors(n),
            d = sum(ds) - n;
        return 0 < d && !hasSum(d, ds)
    };

    // hasSum :: Int -> [Int] -> Bool
    const hasSum = (n, xs) => {
        const go = (n, xs) =>
            0 < xs.length ? (() => {
                const
                    h = xs[0],
                    t = xs.slice(1);
                return n < h ? (
                    go(n, t)
                ) : (
                    n == h || hasSum(n - h, t) || hasSum(n, t)
                );
            })() : false;
        return go(n, xs);
    };

    // descProperDivisors :: Int -> [Int]
    const descProperDivisors = n => {
        const
            rRoot = Math.sqrt(n),
            intRoot = Math.floor(rRoot),
            blnPerfect = rRoot === intRoot,
            lows = enumFromThenTo(intRoot, intRoot - 1, 1)
            .filter(x => (n % x) === 0);
        return (
            reverse(lows)
            .slice(1)
            .map(x => n / x)
        ).concat((blnPerfect ? tail : id)(lows))
    };

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

    // enumFromThenTo :: Int -> Int -> Int -> [Int]
    const enumFromThenTo = (x1, x2, y) => {
        const d = x2 - x1;
        return Array.from({
            length: Math.floor(y - x2) / d + 2
        }, (_, i) => x1 + (d * i));
    };

    // id :: a -> a
    const id = x => x;

    // reverse :: [a] -> [a]
    const reverse = xs =>
        'string' !== typeof xs ? (
            xs.slice(0).reverse()
        ) : xs.split('').reverse().join('');

    // succ :: Enum a => a -> a
    const succ = x => 1 + x;

    // sum :: [Num] -> Num
    const sum = xs => xs.reduce((a, x) => a + x, 0);

    // tail :: [a] -> [a]
    const tail = xs => 0 < xs.length ? xs.slice(1) : [];

    // take :: Int -> [a] -> [a]
    // take :: Int -> String -> String
    const take = (n, xs) =>
        'GeneratorFunction' !== xs.constructor.constructor.name ? (
            xs.slice(0, n)
        ) : [].concat.apply([], Array.from({
            length: n
        }, () => {
            const x = xs.next();
            return x.done ? [] : [x.value];
        }));

    // until :: (a -> Bool) -> (a -> a) -> a -> a
    const until = (p, f, x) => {
        let v = x;
        while (!p(v)) v = f(v);
        return v;
    };

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


using Primes

function nosuchsum(revsorted, num)
    if sum(revsorted) < num
        return true
    end
    for (i, n) in enumerate(revsorted)
        if n > num
            continue
        elseif n == num
            return false
        elseif !nosuchsum(revsorted[i+1:end], num - n)
            return false
        end
    end
    true
end

function isweird(n)
    if n < 70 || isodd(n)
        return false
    else
        f = [one(n)]
        for (p, x) in factor(n)
            f = reduce(vcat, [f*p^i for i in 1:x], init=f)
        end
        pop!(f)
        return sum(f) > n && nosuchsum(sort(f, rev=true), n)
    end
end

function testweird(N)
    println("The first $N weird numbers are: ")
    count, n = 0, 69
    while count < N
        if isweird(n)
            count += 1
            print("$n ")
        end
        n += 1
    end
end

testweird(25)


// Version 1.3.21

fun divisors(n: Int): List<Int> {
    val divs = mutableListOf(1)
    val divs2 = mutableListOf<Int>()
    var i = 2
    while (i * i <= n) {
        if (n % i == 0) {
            val j = n / i
            divs.add(i)
            if (i != j) divs2.add(j)
        }
        i++
    }
    divs2.addAll(divs.asReversed())
    return divs2
}

fun abundant(n: Int, divs: List<Int>) = divs.sum() > n

fun semiperfect(n: Int, divs: List<Int>): Boolean {
    if (divs.size > 0) {
        val h = divs[0]
        val t = divs.subList(1, divs.size)
        if (n < h) {
            return semiperfect(n, t)
        } else {
            return n == h || semiperfect(n-h, t) || semiperfect(n, t)
        }
    } else {
        return false
    }
}

fun sieve(limit: Int): BooleanArray {
    // false denotes abundant and not semi-perfect.
    // Only interested in even numbers >= 2
    val w = BooleanArray(limit)
    for (i in 2 until limit step 2) {
        if (w[i]) continue
        val divs = divisors(i)
        if (!abundant(i, divs)) {
            w[i] = true
        } else if (semiperfect(i, divs)) {
            for (j in i until limit step i) w[j] = true
        }
    }
    return w
}

fun main() {
    val w = sieve(17000)
    var count = 0
    val max = 25
    println("The first 25 weird numbers are:")
    var n = 2
    while (count < max) {
        if (!w[n]) {
            print("$n ")
            count++
        }
        n += 2
    }
    println()
}


function make(n, d)
    local a = {}
    for i=1,n do
        table.insert(a, d)
    end
    return a
end

function reverse(t)
    local n = #t
    local i = 1
    while i < n do
        t[i],t[n] = t[n],t[i]
        i = i + 1
        n = n - 1
    end
end

function tail(list)
    return { select(2, unpack(list)) }
end

function divisors(n)
    local divs = {}
    table.insert(divs, 1)

    local divs2 = {}

    local i = 2
    while i * i <= n do
        if n % i == 0 then
            local j = n / i
            table.insert(divs, i)
            if i ~= j then
                table.insert(divs2, j)
            end
        end
        i = i + 1
    end

    reverse(divs)
    for i,v in pairs(divs) do
        table.insert(divs2, v)
    end
    return divs2
end

function abundant(n, divs)
    local sum = 0
    for i,v in pairs(divs) do
        sum = sum + v
    end
    return sum > n
end

function semiPerfect(n, divs)
    if #divs > 0 then
        local h = divs[1]
        local t = tail(divs)
        if n < h then
            return semiPerfect(n, t)
        else
            return n == h
                or semiPerfect(n - h, t)
                or semiPerfect(n, t)
        end
    else
        return false
    end
end

function sieve(limit)
    -- false denotes abundant and not semi-perfect.
    -- Only interested in even numbers >= 2
    local w = make(limit, false)
    local i = 2
    while i < limit do
        if not w[i] then
            local divs = divisors(i)
            if not abundant(i, divs) then
                w[i] = true
            elseif semiPerfect(i, divs) then
                local j = i
                while j < limit do
                    w[j] = true
                    j = j + i
                end
            end
        end
        i = i + 1
    end
    return w
end

function main()
    local w = sieve(17000)
    local count = 0
    local max = 25
    print("The first 25 weird numbers:")
    local n = 2
    while count < max do
        if not w[n] then
            io.write(n, ' ')
            count = count + 1
        end
        n = n + 2
    end
    print()
end

main()


ClearAll[WeirdNumberQ, HasSumQ]
HasSumQ[n_Integer, xs_List] := HasSumHelperQ[n, ReverseSort[xs]]
HasSumHelperQ[n_Integer, xs_List] := Module[{h, t},
  If[Length[xs] > 0,
   h = First[xs];
   t = Drop[xs, 1];
   If[n < h,
    HasSumHelperQ[n, t]
    ,
    n == h \[Or] HasSumHelperQ[n - h, t] \[Or] HasSumHelperQ[n, t]
    ]
   ,
   False
   ]
  ]
WeirdNumberQ[n_Integer] := Module[{divs},
  divs = Most[Divisors[n]];
  If[Total[divs] > n,
   ! HasSumQ[n, divs]
   ,
   False
   ]
  ]
r = {};
n = 0;
While[
 Length[r] < 25,
 If[WeirdNumberQ[++n], AppendTo[r, n]]
 ]
Print[r]


import algorithm, math, strutils

func divisors(n: int): seq[int] =
  var smallDivs = @[1]
  for i in 2..sqrt(n.toFloat).int:
    if n mod i == 0:
      let j = n div i
      smallDivs.add i
      if i != j: result.add j
  result.add reversed(smallDivs)

func abundant(n: int; divs: seq[int]): bool {.inline.}=
  sum(divs) > n

func semiperfect(n: int; divs: seq[int]): bool =
  if divs.len > 0:
    let h = divs[0]
    let t = divs[1..^1]
    result = if n < h: semiperfect(n, t)
             else: n == h or semiperfect(n - h, t) or semiperfect(n, t)

func sieve(limit: int): seq[bool] =
  # False denotes abundant and not semi-perfect.
  # Only interested in even numbers >= 2.
  result.setLen(limit)
  for i in countup(2, limit - 1, 2):
    if result[i]: continue
    let divs = divisors(i)
    if not abundant(i, divs):
      result[i] = true
    elif semiperfect(i, divs):
      for j in countup(i, limit - 1, i):
        result[j] = true

const Max = 25
let w = sieve(17_000)
var list: seq[int]

echo "The first 25 weird numbers are:"
var n = 2
while list.len != Max:
  if not w[n]: list.add n
  inc n, 2
echo list.join(" ")


use strict;
use feature 'say';

use List::Util 'sum';
use POSIX 'floor';
use Algorithm::Combinatorics 'subsets';
use ntheory <is_prime divisors>;

sub abundant {
    my($x) = @_;
    my $s = sum( my @l = is_prime($x) ? 1 : grep { $x != $_ } divisors($x) );
    $s > $x ? ($s, sort { $b <=> $a } @l) : ();
}

my(@weird,$n);
while () {
    $n++;
    my ($sum, @div) = abundant($n);
    next unless $sum;        # Weird number must be abundant, skip it if it isn't.
    next if $sum / $n > 1.1; # There aren't any weird numbers with a sum:number ratio greater than 1.08 or so.

    if ($n >= 10430 and (! int $n%70) and is_prime(int $n/70)) {
        # It's weird. All numbers of the form 70 * (a prime 149 or larger) are weird
    } else {
        my $next;
        my $l = shift @div;
        my $iter = subsets(\@div);
        while (my $s = $iter->next) {
            ++$next and last if sum(@$s) == $n - $l;
        }
        next if $next;
    }
    push @weird, $n;
    last if @weird == 25;
}

say "The first 25 weird numbers:\n" . join ' ', @weird;


with javascript_semantics
function abundant(integer n, sequence divs)
    return sum(divs) > n
end function

function semiperfect(integer n, sequence divs)
    if length(divs)=0 then return false end if
    integer h = divs[1]; divs = divs[2..$]
    return n=h
       or (n>h and semiperfect(n-h, divs))
       or          semiperfect(n, divs)
end function

function sieve(integer limit)
-- true denotes abundant and not semi-perfect.
-- only interested in even numbers >= 2
    sequence wierd := repeat(true,limit)
    for j=6 to limit by 6 do
        -- eliminate multiples of 3
        wierd[j] = false
    end for
    for i=2 to limit by 2 do
        if wierd[i] then
            sequence divs := factors(i,-1)
            if not abundant(i,divs) then
                wierd[i] = false
            elsif semiperfect(i,divs) then
                for j=i to limit by i do wierd[j] = false end for
            end if
        end if
    end for
    return wierd
end function

--constant MAX = 25, sieve_limit = 16313
constant MAX = 50, sieve_limit = 26533

sequence wierd := sieve(sieve_limit), res = {}
for i=2 to sieve_limit by 2 do
    if wierd[i] then
        res &= i
        if length(res)=MAX then exit end if
    end if
end for
printf(1,"%s\n",{join(shorten(res,"weird numbers",5,"%d"))})


'''Weird numbers'''

from itertools import chain, count, islice, repeat
from functools import reduce
from math import sqrt
from time import time

# weirds :: Gen [Int]
def weirds():
    '''Non-finite stream of weird numbers.
       (Abundant, but not semi-perfect)
       OEIS: A006037
    '''
    def go(n):
        ds = descPropDivs(n)
        d = sum(ds) - n
        return [n] if 0 < d and not hasSum(d, ds) else []
    return concatMap(go)(count(1))

# hasSum :: Int -> [Int] -> Bool
def hasSum(n, xs):
    '''Does any subset of xs sum to n ?
       (Assuming xs to be sorted in descending
       order of magnitude)'''
    def go(n, xs):
        if xs:
            h, t = xs[0], xs[1:]
            if n < h:  # Head too big. Forget it. Tail ?
                return go(n, t)
            else:
                # The head IS the target ?
                # Or the tail contains a sum for the
                # DIFFERENCE between the head and the target ?
                # Or the tail contains some OTHER sum for the target ?
                return n == h or go(n - h, t) or go(n, t)
        else:
            return False
    return go(n, xs)

# descPropDivs :: Int -> [Int]
def descPropDivs(n):
    '''Descending positive divisors of n,
       excluding n itself.'''
    root = sqrt(n)
    intRoot = int(root)
    blnSqr = root == intRoot
    lows = [x for x in range(1, 1 + intRoot) if 0 == n % x]
    return [
        n // x for x in (
            lows[1:-1] if blnSqr else lows[1:]
        )
    ] + list(reversed(lows))

# --------------------------TEST---------------------------

# main :: IO ()
def main():
    '''Test'''

    start = time()
    n = 50
    xs = take(n)(weirds())

    print(
        (tabulated('First ' + str(n) + ' weird numbers:\n')(
            lambda i: str(1 + i)
        )(str)(5)(
            index(xs)
        )(range(0, n)))
    )
    print(
        '\nApprox computation time: ' +
        str(int(1000 * (time() - start))) + ' ms'
    )

# -------------------------GENERIC-------------------------

# chunksOf :: Int -> [a] -> [[a]]
def chunksOf(n):
    '''A series of lists of length n,
       subdividing the contents of xs.
       Where the length of xs is not evenly divible,
       the final list will be shorter than n.'''
    return lambda xs: reduce(
        lambda a, i: a + [xs[i:n + i]],
        range(0, len(xs), n), []
    ) if 0 < n else []

# compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
def compose(g):
    '''Right to left function composition.'''
    return lambda f: lambda x: g(f(x))

# concatMap :: (a -> [b]) -> [a] -> [b]
def concatMap(f):
    '''A concatenated list or string over which a function f
       has been mapped.
       The list monad can be derived by using an (a -> [b])
       function which wraps its output in a list (using an
       empty list to represent computational failure).
    '''
    return lambda xs: chain.from_iterable(map(f, xs))

# index (!!) :: [a] -> Int -> a
def index(xs):
    '''Item at given (zero-based) index.'''
    return lambda n: None if 0 > n else (
        xs[n] if (
            hasattr(xs, "__getitem__")
        ) else next(islice(xs, n, None))
    )

# paddedMatrix :: a -> [[a]] -> [[a]]
def paddedMatrix(v):
    ''''A list of rows padded to equal length
        (where needed) with instances of the value v.'''
    def go(rows):
        return paddedRows(
            len(max(rows, key=len))
        )(v)(rows)
    return lambda rows: go(rows) if rows else []

# paddedRows :: Int -> a -> [[a]] -[[a]]
def paddedRows(n):
    '''A list of rows padded (but never truncated)
       to length n with copies of value v.'''
    def go(v, xs):
        def pad(x):
            d = n - len(x)
            return (x + list(repeat(v, d))) if 0 < d else x
        return list(map(pad, xs))
    return lambda v: lambda xs: go(v, xs) if xs else []

# showColumns :: Int -> [String] -> String
def showColumns(n):
    '''A column-wrapped string
       derived from a list of rows.'''
    def go(xs):
        def fit(col):
            w = len(max(col, key=len))

            def pad(x):
                return x.ljust(4 + w, ' ')
            return ''.join(map(pad, col))

        q, r = divmod(len(xs), n)
        return unlines(map(
            fit,
            transpose(paddedMatrix('')(
                chunksOf(q + int(bool(r)))(
                    xs
                )
            ))
        ))
    return lambda xs: go(xs)

# succ :: Enum a => a -> a
def succ(x):
    '''The successor of a value. For numeric types, (1 +).'''
    return 1 + x if isinstance(x, int) else (
        chr(1 + ord(x))
    )

# tabulated :: String -> (a -> String) ->
#                        (b -> String) ->
#                        Int ->
#                        (a -> b) -> [a] -> String
def tabulated(s):
    '''Heading -> x display function -> fx display function ->
          number of columns -> f -> value list -> tabular string.'''
    def go(xShow, fxShow, intCols, f, xs):
        w = max(map(compose(len)(xShow), xs))
        return s + '\n' + showColumns(intCols)([
            xShow(x).rjust(w, ' ') + ' -> ' + fxShow(f(x)) for x in xs
        ])
    return lambda xShow: lambda fxShow: lambda nCols: (
        lambda f: lambda xs: go(
            xShow, fxShow, nCols, f, xs
        )
    )

# take :: Int -> [a] -> [a]
# take :: Int -> String -> String
def take(n):
    '''The prefix of xs of length n,
       or xs itself if n > length xs.'''
    return lambda xs: (
        xs[0:n]
        if isinstance(xs, list)
        else list(islice(xs, n))
    )

# transpose :: Matrix a -> Matrix a
def transpose(m):
    '''The rows and columns of the argument transposed.
       (The matrix containers and rows can be lists or tuples).'''
    if m:
        inner = type(m[0])
        z = zip(*m)
        return (type(m))(
            map(inner, z) if tuple != inner else z
        )
    else:
        return m

# unlines :: [String] -> String
def unlines(xs):
    '''A single string derived by the intercalation
       of a list of strings with the newline character.'''
    return '\n'.join(xs)

# until :: (a -> Bool) -> (a -> a) -> a -> a
def until(p):
    '''The result of repeatedly applying f until p holds.
       The initial seed value is x.'''
    def go(f, x):
        v = x
        while not p(v):
            v = f(v)
        return v
    return lambda f: lambda x: go(f, x)

# MAIN ----------------------------------------------------
if __name__ == '__main__':
    main()


  [ stack ]                            is target   (   --> s )
  [ stack ]                            is success  (   --> s )
  [ stack ]                            is makeable (   --> s )

  [ bit makeable take
    2dup & 0 !=
    dip [ | makeable put ] ]           is made     ( n --> b )

  [ ' [ 0 ] swap
    dup target put
    properdivisors
    0 over witheach +
    target share > not iff
      [ target release
        2drop false ] done
    true success put
    0 makeable put
    witheach
      [ over witheach
         [ over dip
           [ +
             dup target share = iff
               [ false success replace
                 drop conclude ] done
             dup target share < iff
               [ dup made not iff
                   join else drop ]
            else drop ] ]
        success share not if conclude
        drop ]
    drop
    target release
    makeable release
    success take ]                     is weird    ( n --> b )

  [] 0
  [ 1+
    dup weird if
      [ tuck join swap ]
    over size 25 = until ]
  drop
  echo


#lang racket

(require math/number-theory)

(define (abundant? n proper-divisors)
  (> (apply + proper-divisors) n))

(define (semi-perfect? n proper-divisors)
    (let recur ((ds proper-divisors) (n n))
      (or (zero? n)
          (and (positive? n)
               (pair? ds)
               (or (recur (cdr ds) n)
                   (recur (cdr ds) (- n (car ds))))))))

(define (weird? n)
  (let ((proper-divisors (drop-right (divisors n) 1))) ;; divisors includes n
    (and (abundant? n proper-divisors) (not (semi-perfect? n proper-divisors)))))

(module+ main
  (let recur ((i 0) (n 1) (acc null))
    (cond [(= i 25) (reverse acc)]
          [(weird? n) (recur (add1 i) (add1 n) (cons n acc))]
          [else (recur i (add1 n) acc)])))

(module+ test
  (require rackunit)
  (check-true (weird? 70))
  (check-false (weird? 12)))


sub abundant (\x) {
    my @l = x.is-prime ?? 1 !! flat
    1, (2 .. x.sqrt.floor).map: -> \d {
         my \y = x div d;
         next if y * d !== x;
         d !== y ?? (d, y) !! d
    };
    (my $s = @l.sum) > x ?? ($s, |@l.sort(-*)) !! ();
}

my @weird = (2, 4, {|($_ + 4, $_ + 6)} ... *).map: -> $n {
    my ($sum, @div) = $n.&abundant;
    next unless $sum;        # Weird number must be abundant, skip it if it isn't.
    next if $sum / $n > 1.1; # There aren't any weird numbers with a sum:number ratio greater than 1.08 or so.
    if $n >= 10430 and ($n %% 70) and ($n div 70).is-prime {
        # It's weird. All numbers of the form 70 * (a prime 149 or larger) are weird
    } else {
        my $next;
        my $l = @div.shift;
        ++$next and last if $_.sum == $n - $l for @div.combinations;
        next if $next;
    }
    $n
}

put "The first 25 weird numbers:\n", @weird[^25];


/*REXX program  finds and displays  N   weird numbers in a vertical format (with index).*/
parse arg n cols .                               /*obtain optional arguments from the CL*/
if    n=='' |    n==","  then    n= 25           /*Not specified?  Then use the default.*/
if cols=='' | cols==","  then cols= 10           /* "      "         "   "   "     "    */
w= 10                                            /*width of a number in any column.     */
if cols>0 then say ' index │'center(' weird numbers',   1 + cols*(w+1)     )
if cols>0 then say '───────┼'center(""              ,   1 + cols*(w+1), '─')
idx= 1;                          $=              /*index for the output list;  $: 1 line*/
weirds= 0                                        /*the count of weird numbers  (so far).*/
     do j=2  by 2  until weirds==n               /*examine even integers 'til have 'nuff*/
     if \weird(j)  then iterate                  /*Not a  weird  number?  Then skip it. */
     weirds= weirds + 1                          /*bump the count of  weird   numbers.  */
     c= commas(j)                                /*maybe add commas to the number.      */
     $= $ right(c, max(w, length(c) ) )          /*add a nice prime ──► list, allow big#*/
     if weirds//cols\==0  then iterate           /*have we populated a line of output?  */
     say center(idx, 7)'│'  substr($, 2);   $=   /*display what we have so far  (cols). */
     idx= idx + cols                             /*bump the  index  count for the output*/
     end   /*j*/

if $\==''  then say center(idx, 7)"│"  substr($, 2)  /*possible display residual output.*/
if cols>0 then say '───────┴'center(""    ,  1 + cols*(w+1), '─')
say
say 'Found '       commas(weirds)          ' weird numbers'
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: parse arg _;  do ic=length(_)-3  to 1  by -3; _=insert(',', _, ic); end;  return _
/*──────────────────────────────────────────────────────────────────────────────────────*/
DaS:  procedure; parse arg x 1 z 1,b;       a= 1 /*get X,Z,B (the 1st arg); init A list.*/
      r= 0;         q= 1                         /* [↓] ══integer square root══     ___ */
           do while q<=z; q=q*4; end             /*R:  an integer which will be    √ X  */
           do while q>1;  q=q%4;  _= z-r-q;  r=r%2;  if _>=0  then  do;  z=_;  r=r+q;  end
           end   /*while q>1*/                   /* [↑]  compute the integer sqrt of  X.*/
      sig= a                                     /*initialize the sigma so far.     ___ */
          do j=2  to r - (r*r==x)                /*divide by some integers up to   √ X  */
          if x//j==0  then do;  a=a j;  b= x%j b /*if ÷, add both divisors to  α and ß. */
                                sig= sig +j +x%j /*bump the sigma (the sum of divisors).*/
                           end
          end   /*j*/                            /* [↑]  %  is the REXX integer division*/
                                                 /* [↓]  adjust for a square.        ___*/
      if j*j==x  then  return sig+j   a j b      /*Was  X  a square?    If so, add  √ X */
                       return sig     a   b      /*return the divisors  (both lists).   */
/*──────────────────────────────────────────────────────────────────────────────────────*/
weird: procedure; parse arg x .                  /*obtain a # to be tested for weirdness*/
       if x<70 | x//3==0   then return 0         /*test if X is too low or multiple of 3*/
       parse value  DaS(x)  with  sigma divs     /*obtain sigma and the proper divisors.*/
       if sigma<=x  then  return 0               /*X  isn't abundant  (sigma too small).*/
       #= words(divs)                            /*count the number of divisors for  X. */
       if #<3   then return 0                    /*Not enough divisors?    "      "     */
       if #>15  then return 0                    /*number of divs > 15?  It's not weird.*/
       a.=                                       /*initialize the    A.   stemmed array.*/
           do i=1  for #;     _= word(divs, i)   /*obtain one of the divisors of  X.    */
           @.i= _;          a._= .               /*assign proper divs──►@ array; also id*/
           end   /*i*/
       df= sigma - x                             /*calculate difference between Σ and X.*/
       if a.df==.  then return 0                 /*Any divisor is equal to DF? Not weird*/
       c= 0                                      /*zero combo counter; calc. power of 2.*/
           do p=1  for 2**#-2;         c= c + 1  /*convert P──►binary with leading zeros*/
           yy.c= strip( x2b( d2x(p) ),  'L', 0)  /*store this particular combination.   */
           end   /*p*/
                                                 /* [↓]  decreasing partitions is faster*/
           do part=c  by -1  for c;      s= 0    /*test of a partition add to the arg X.*/
           _= yy.part;           L= length(_)    /*obtain one method of partitioning.   */
             do cp=L  by -1  for L               /*obtain a sum of  a  partition.       */
             if substr(_,cp,1)  then do;  s= s + @.cp            /*1 bit?  Then add ──►S*/
                                          if s==x  then return 0 /*Sum equal?  Not weird*/
                                          if s==df then return 0 /*Sum = DF?    "    "  */
                                          if s>x   then iterate  /*Sum too big? Try next*/
                                     end
             end   /*cp*/
           end   /*part*/;           return 1    /*no sum equal to  X,  so  X  is weird.*/


def divisors(n)
    divs = [1]
    divs2 = []

    i = 2
    while i * i <= n
        if n % i == 0 then
            j = (n / i).to_i
            divs.append(i)
            if i != j then
                divs2.append(j)
            end
        end

        i = i + 1
    end

    divs2 += divs.reverse
    return divs2
end

def abundant(n, divs)
    return divs.sum > n
end

def semiperfect(n, divs)
    if divs.length > 0 then
        h = divs[0]
        t = divs[1..-1]
        if n < h then
            return semiperfect(n, t)
        else
            return n == h || semiperfect(n - h, t) || semiperfect(n, t)
        end
    else
        return false
    end
end

def sieve(limit)
    w = Array.new(limit, false)
    i = 2
    while i < limit
        if not w[i] then
            divs = divisors(i)
            if not abundant(i, divs) then
                w[i] = true
            elsif semiperfect(i, divs) then
                j = i
                while j < limit
                    w[j] = true
                    j = j + i
                end
            end
        end
        i = i + 2
    end
    return w
end

def main
    w = sieve(17000)
    count = 0
    max = 25
    print "The first %d weird numbers:\n" % [max]
    n = 2
    while count < max
        if not w[n] then
            print n, " "
            count = count + 1
        end
        n = n + 2
    end
    print "\n"
end

main()


func is_pseudoperfect(n, d = n.divisors.slice(0, -2), s = d.sum, m = d.end) {

    return false if (m < 0)

    while (d[m] > n) {
        s -= d[m--]
    }

    return true if (n == s)
    return true if (d[m] == n)

    __FUNC__(n-d[m], d, s-d[m], m-1) || __FUNC__(n, d, s-d[m], m-1)
}

func is_weird(n) {
    (n.sigma > 2*n) && !is_pseudoperfect(n)
}

var w = (1..Inf -> lazy.grep(is_weird).first(25))
say "The first 25 weird numbers:\n#{w.join(' ')}"


Module Module1

    Dim resu As New List(Of Integer)

    Function TestAbundant(n As Integer, ByRef divs As List(Of Integer)) As Boolean
        divs = New List(Of Integer)
        Dim sum As Integer = -n : For i As Integer = Math.Sqrt(n) To 1 Step -1
            If n Mod i = 0 Then divs.Add(i) : Dim j As Integer = n / i : divs.Insert(0, j) : sum += i + j
        Next : divs(0) = sum - divs(0) : Return divs(0) > 0
    End Function

    Function subList(src As List(Of Integer), Optional first As Integer = Integer.MinValue) As List(Of Integer)
        subList = src.ToList : subList.RemoveAt(1)
    End Function

    Function semiperfect(divs As List(Of Integer)) As Boolean
        If divs.Count < 2 Then Return False
        Select Case divs.First.CompareTo(divs(1))
            Case 0 : Return True
            Case -1 : Return semiperfect(subList(divs))
            Case 1 : Dim t As List(Of Integer) = subList(divs) : t(0) -= divs(1)
                If semiperfect(t) Then Return True Else t(0) = divs.First : Return semiperfect(t)
        End Select : Return False ' execution can't get here, just for compiler warning
    End Function

    Function Since(et As TimeSpan) As String ' big ugly routine to prettify the elasped time
        If et > New TimeSpan(2000000) Then
            Dim s As String = " " & et.ToString(), p As Integer = s.IndexOf(":"), q As Integer = s.IndexOf(".")
            If q < p Then s = s.Insert(q, "Days") : s = s.Replace("Days.", "Days, ")
            p = s.IndexOf(":") : s = s.Insert(p, "h") : s = s.Replace("h:", "h ")
            p = s.IndexOf(":") : s = s.Insert(p, "m") : s = s.Replace("m:", "m ")
            s = s.Replace(" 0", " ").Replace(" 0h", " ").Replace(" 0m", " ") & "s"
            Return s.TrimStart()
        Else
            If et > New TimeSpan(1500) Then
                Return et.TotalMilliseconds.ToString() & "ms"
            Else
                If et > New TimeSpan(15) Then
                    Return (et.TotalMilliseconds * 1000.0).ToString() & "µs"
                Else
                    Return (et.TotalMilliseconds * 1000000.0).ToString() & "ns"
                End If
            End If
        End If
    End Function

    Sub Main(args As String())
        Dim sw As New Stopwatch, st As Integer = 2, stp As Integer = 1020, count As Integer = 0
        Dim max As Integer = 25, halted As Boolean = False
        If args.Length > 0 Then _
            Dim t As Integer = Integer.MaxValue : If Integer.TryParse(args(0), t) Then max = If(t > 0, t, Integer.MaxValue)
        If max = Integer.MaxValue Then
            Console.WriteLine("Calculating weird numbers, press a key to halt.")
            stp *= 10
        Else
            Console.WriteLine("The first {0} weird numbers:", max)
        End If
        If max < 25 Then stp = 140
        sw.Start()
        Do : Parallel.ForEach(Enumerable.Range(st, stp),
            Sub(n)
                Dim divs As List(Of Integer) = Nothing
                If TestAbundant(n, divs) AndAlso Not semiperfect(divs) Then
                    SyncLock resu : resu.Add(n) : End SyncLock
                End If
            End Sub)
            If resu.Count > 0 Then
                resu.Sort()
                If count + resu.Count > max Then
                    resu = resu.Take(max - count).ToList
                End If
                Console.Write(String.Join(" ", resu) & " ")
                count += resu.Count : resu.Clear()
            End If
            If Console.KeyAvailable Then Console.ReadKey() : halted = True : Exit Do
            st += stp
        Loop Until count >= max
        sw.Stop()
        If max < Integer.MaxValue Then
            Console.WriteLine(vbLf & "Computation time was {0}.", Since(sw.Elapsed))
            If halted Then Console.WriteLine("Halted at number {0}.", count)
        Else
            Console.WriteLine(vbLf & "Computation time was {0} for the first {1} weird numbers.", Since(sw.Elapsed), count)
        End If
    End Sub
End Module


fn divisors(n int) []int {
    mut divs := [1]
    mut divs2 := []int{}
    for i := 2; i*i <= n; i++ {
        if n%i == 0 {
            j := n / i
            divs << i
            if i != j {
                divs2 << j
            }
        }
    }
    for i := divs.len - 1; i >= 0; i-- {
        divs2 << divs[i]
    }
    return divs2
}

fn abundant(n int, divs []int) bool {
    mut sum := 0
    for div in divs {
        sum += div
    }
    return sum > n
}

fn semiperfect(n int, divs []int) bool {
    le := divs.len
    if le > 0 {
        h := divs[0]
        t := divs[1..]
        if n < h {
            return semiperfect(n, t)
        } else {
            return n == h || semiperfect(n-h, t) || semiperfect(n, t)
        }
    } else {
        return false
    }
}

fn sieve(limit int) []bool {
    // false denotes abundant and not semi-perfect.
    // Only interested in even numbers >= 2
    mut w := []bool{len: limit}
    for i := 2; i < limit; i += 2 {
        if w[i] {
            continue
        }
        divs := divisors(i)
        if !abundant(i, divs) {
            w[i] = true
        } else if semiperfect(i, divs) {
            for j := i; j < limit; j += i {
                w[j] = true
            }
        }
    }
    return w
}

fn main() {
    w := sieve(17000)
    mut count := 0
    max := 25
    println("The first 25 weird numbers are:")
    for n := 2; count < max; n += 2 {
        if !w[n] {
            print("$n ")
            count++
        }
    }
    println('')
}


import "/math" for Int, Nums
import "/trait" for Stepped

var semiperfect // recursive
semiperfect = Fn.new { |n, divs|
    var le = divs.count
    if (le == 0) return false
    var h = divs[0]
    if (n == h) return true
    if (le == 1) return false
    var t = divs[1..-1]
    if (n < h) return semiperfect.call(n, t)
    return semiperfect.call(n-h, t) || semiperfect.call(n, t)
}

var sieve = Fn.new { |limit|
    // 'false' denotes abundant and not semi-perfect.
    // Only interested in even numbers >= 2
    var w = List.filled(limit, false)
    for (j in Stepped.new(6...limit, 6)) w[j] = true // eliminate multiples of 3
    for (i in Stepped.new(2...limit, 2)) {
        if (!w[i]) {
            var divs = Int.properDivisors(i)
            var sum = Nums.sum(divs)
            if (sum <= i) {
                w[i] = true
            } else if (semiperfect.call(sum-i, divs)) {
                for (j in Stepped.new(i...limit, i)) w[j] = true
            }
        }
    }
    return w
}

var start = System.clock
var limit = 16313
var w = sieve.call(limit)
var count = 0
var max = 25
System.print("The first 25 weird numbers are:")
var n = 2
while (count < max) {
    if (!w[n]) {
        System.write("%(n) ")
        count = count + 1
    }
    n = n + 2
}
System.print()
System.print("\nTook %(((System.clock-start)*1000).round) milliseconds")


fcn properDivs(n){
   if(n==1) return(T);
   ( pd:=[1..(n).toFloat().sqrt()].filter('wrap(x){ n%x==0 }) )
   .pump(pd,'wrap(pd){ if(pd!=1 and (y:=n/pd)!=pd ) y else Void.Skip })
}
fcn abundant(n,divs){ divs.sum(0) > n }
fcn semiperfect(n,divs){
   if(divs){
      h,t := divs[0], divs[1,*];
      if(n<h) return(semiperfect(n,t));
      return((n==h) or semiperfect(n - h, t) or semiperfect(n, t));
   }
   False
}
fcn sieve(limit){
   // False denotes abundant and not semi-perfect.
   // Only interested in even numbers >= 2
   w:=List.createLong(limit,False);
   foreach i in ([2..limit - 1, 2]){
      if(w[i]) continue;
      divs:=properDivs(i);
      if(not abundant(i,divs)) w[i]=True;
      else if(semiperfect(i,divs))
	 { foreach j in ([i..limit - 1, i]){ w[j]=True; } }
   }
   w
}


UInt32 seed = 0
F nonrandom(n)
   :seed = (1664525 * :seed + 1013904223) [&] FFFF'FFFF
   R Int(:seed >> 16) % n

F nonrandom_shuffle(&x)
   L(i) (x.len - 1 .< 0).step(-1)
      V j = nonrandom(i + 1)
      swap(&x[i], &x[j])

V SUITS = [‘♣’, ‘♦’, ‘♥’, ‘♠’]
V FACES = [‘2’, ‘3’, ‘4’, ‘5’, ‘6’, ‘7’, ‘8’, ‘9’, ‘10’, ‘J’, ‘Q’, ‘K’, ‘A’]
V DECK = multiloop(FACES, SUITS, (f, s) -> f‘’s)
V CARD_TO_RANK = Dict((0 .< DECK.len).map(i -> (:DECK[i], (i + 3) I/ 4)))

T WarCardGame
   [String] deck1, deck2, pending

   F ()
      V deck = copy(:DECK)
      nonrandom_shuffle(&deck)
      .deck1 = deck[0.<26]
      .deck2 = deck[26..]

   F gameover()
      ‘ game over who won message ’
      I .deck2.empty
         I .deck1.empty
            print("\nGame ends as a tie.")
         E
            print("\nPlayer 1 wins the game.")
      E
         print("\nPlayer 2 wins the game.")
      R 0B

   F turn()
      ‘ one turn, may recurse on tie ’
      I .deck1.empty | .deck2.empty
         R .gameover()

      V card1 = .deck1.pop(0)
      V card2 = .deck2.pop(0)
      V (rank1, rank2) = (:CARD_TO_RANK[card1], :CARD_TO_RANK[card2])
      print(‘#<10#<10’.format(card1, card2), end' ‘’)
      I rank1 > rank2
         print(‘Player 1 takes the cards.’)
         .deck1.extend([card1, card2])
         .deck1.extend(.pending)
         .pending.clear()
      E I rank1 < rank2
         print(‘Player 2 takes the cards.’)
         .deck2.extend([card2, card1])
         .deck2.extend(.pending)
         .pending.clear()
      E
         print(‘Tie!’)
         I .deck1.empty | .deck2.empty
            R .gameover()

         V card3 = .deck1.pop(0)
         V card4 = .deck2.pop(0)
         .pending.extend([card1, card2, card3, card4])
         print(‘#<10#<10’.format(‘?’, ‘?’)‘Cards are face down.’)
         R .turn()

      R 1B

V WG = WarCardGame()
L WG.turn()
   L.continue


suits := ["♠", "♦", "♥", "♣"]
faces := [2,3,4,5,6,7,8,9,10,"J","Q","K","A"]
deck := [], p1 := [], p2 := []
for i, s in suits
	for j, v in faces
		deck.Push(v s)
deck := shuffle(deck)
deal := deal(deck, p1, p2)
p1 := deal.1, p2 := deal.2

for i, v in p2
{
	if InStr(v, "A")
		p2[i] := p1[i], p1[i] := v
	if InStr(v, "K")
		p2[i] := p1[i], p1[i] := v
	if InStr(v, "Q")
		p2[i] := p1[i], p1[i] := v
	if InStr(v, "J")
		p2[i] := p1[i], p1[i] := v
}
MsgBox % war(p1, p2)
return
war(p1, p2){
	J:=11, Q:=11, K:=11, A:=12, stack := [], cntr := 0
	output := "------------------------------------------"
			. "`nRound#  	  Deal	  		Winner	P1	P1"
			. "`n------------------------------------------"
			. "`nround0  			  				26	26"

	while (p1.Count() && p2.Count()) {
		cntr++
		stack.Push(c1:=p1.RemoveAt(1)), stack.Push(c2:=p2.RemoveAt(1))
		r1:=SubStr(c1,1,-1)	,r2:=SubStr(c2,1,-1)
		v1:=r1<11?r1:%r1%	,v2:=r2<11?r2:%r2%
		output .= "`nround# " cntr "`t" SubStr(c1 "  n", 1, 4) "vs " SubStr(c2 "  ", 1, 4)
		if (v1 > v2){
			loop % stack.Count()
				p1.Push(stack.RemoveAt(1))
			output .= "`t`tP1 wins"
		}
		else if (v1 < v2){
			loop % stack.Count()
				p2.Push(stack.RemoveAt(1))
			output .= "`t`tP2 wins"
		}
		if (v1 = v2){
			output .= "`t`t**WAR**`t" P1.Count() "`t" P2.Count()
			stack.Push(c1:=p1.RemoveAt(1)), stack.Push(c2:=p2.RemoveAt(1))
			if !(p1.Count() && p2.Count())
				break
			output .= "`nround# " ++cntr "`t(" SubStr(c1 "  ", 1, 3) ") - (" SubStr(c2 " ", 1, 3) ")"
			output .= "`tFace Dn"
		}
		output .= "`t" P1.Count() "`t" P2.Count()
		if !Mod(cntr, 20)
		{
			MsgBox % output
			output := ""
		}
	}
	output .= "`n" (P1.Count() ? "P1 Wins" : "P2 Wins")
	output := StrReplace(output, " )", ") ")
	output := StrReplace(output, "  -", " -")
	return output


package main

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

var suits = []string{"♣", "♦", "♥", "♠"}
var faces = []string{"2", "3", "4", "5", "6", "7", "8", "9", "T", "J", "Q", "K", "A"}
var cards = make([]string, 52)
var ranks = make([]int, 52)

func init() {
    for i := 0; i < 52; i++ {
        cards[i] = fmt.Sprintf("%s%s", faces[i%13], suits[i/13])
        ranks[i] = i % 13
    }
}

func war() {
    deck := make([]int, 52)
    for i := 0; i < 52; i++ {
        deck[i] = i
    }
    rand.Shuffle(52, func(i, j int) {
        deck[i], deck[j] = deck[j], deck[i]
    })
    hand1 := make([]int, 26, 52)
    hand2 := make([]int, 26, 52)
    for i := 0; i < 26; i++ {
        hand1[25-i] = deck[2*i]
        hand2[25-i] = deck[2*i+1]
    }
    for len(hand1) > 0 && len(hand2) > 0 {
        card1 := hand1[0]
        copy(hand1[0:], hand1[1:])
        hand1[len(hand1)-1] = 0
        hand1 = hand1[0 : len(hand1)-1]
        card2 := hand2[0]
        copy(hand2[0:], hand2[1:])
        hand2[len(hand2)-1] = 0
        hand2 = hand2[0 : len(hand2)-1]
        played1 := []int{card1}
        played2 := []int{card2}
        numPlayed := 2
        for {
            fmt.Printf("%s\t%s\t", cards[card1], cards[card2])
            if ranks[card1] > ranks[card2] {
                hand1 = append(hand1, played1...)
                hand1 = append(hand1, played2...)
                fmt.Printf("Player 1 takes the %d cards. Now has %d.\n", numPlayed, len(hand1))
                break
            } else if ranks[card1] < ranks[card2] {
                hand2 = append(hand2, played2...)
                hand2 = append(hand2, played1...)
                fmt.Printf("Player 2 takes the %d cards. Now has %d.\n", numPlayed, len(hand2))
                break
            } else {
                fmt.Println("War!")
                if len(hand1) < 2 {
                    fmt.Println("Player 1 has insufficient cards left.")
                    hand2 = append(hand2, played2...)
                    hand2 = append(hand2, played1...)
                    hand2 = append(hand2, hand1...)
                    hand1 = hand1[0:0]
                    break
                }
                if len(hand2) < 2 {
                    fmt.Println("Player 2 has insufficient cards left.")
                    hand1 = append(hand1, played1...)
                    hand1 = append(hand1, played2...)
                    hand1 = append(hand1, hand2...)
                    hand2 = hand2[0:0]
                    break
                }
                fdCard1 := hand1[0] // face down card
                card1 = hand1[1]    // face up card
                copy(hand1[0:], hand1[2:])
                hand1[len(hand1)-1] = 0
                hand1[len(hand1)-2] = 0
                hand1 = hand1[0 : len(hand1)-2]
                played1 = append(played1, fdCard1, card1)
                fdCard2 := hand2[0] // face down card
                card2 = hand2[1]    // face up card
                copy(hand2[0:], hand2[2:])
                hand2[len(hand2)-1] = 0
                hand2[len(hand2)-2] = 0
                hand2 = hand2[0 : len(hand2)-2]
                played2 = append(played2, fdCard2, card2)
                numPlayed += 4
                fmt.Println("? \t? \tFace down cards.")
            }
        }
    }
    if len(hand1) == 52 {
        fmt.Println("Player 1 wins the game!")
    } else {
        fmt.Println("Player 2 wins the game!")
    }
}

func main() {
    rand.Seed(time.Now().UnixNano())
    war()
}


# https://bicyclecards.com/how-to-play/war/

using Random

const SUITS = ["♣", "♦", "♥", "♠"]
const FACES = ["2", "3", "4", "5", "6", "7", "8", "9", "10", "J", "Q", "K", "A" ]
const DECK = vec([f * s for s in SUITS, f in FACES])
const rdict = Dict(DECK[i] => div(i + 3, 4) for i in eachindex(DECK))

deal2(deck) = begin d = shuffle(deck); d[1:2:51], d[2:2:52] end

function turn!(d1, d2, pending)
    (isempty(d1) || isempty(d2)) && return false
    c1, c2 = popfirst!(d1), popfirst!(d2)
    r1, r2 = rdict[c1], rdict[c2]
    print(rpad(c1, 10), rpad(c2, 10))
    if r1 > r2
        println("Player 1 takes the cards.")
        push!(d1, c1, c2, pending...)
        empty!(pending)
    elseif r1 < r2
        println("Player 2 takes the cards.")
        push!(d2, c2, c1, pending...)
        empty!(pending)
    else # r1 == r2
        println("Tie!")
        (isempty(d1) || isempty(d2)) && return false
        c3, c4 = popfirst!(d1), popfirst!(d2)
        println(rpad("?", 10), rpad("?", 10), "Cards are face down.")
        return turn!(d1, d2, push!(pending, c1, c2, c3, c4))
    end
    return true
end

function warcardgame()
    deck1, deck2 = deal2(DECK)
    while turn!(deck1, deck2, []) end
    if isempty(deck2)
        if isempty(deck1)
            println("Game ends as a tie.")
        else
            println("Player 1 wins the game.")
        end
    else
        println("Player 2 wins the game.")
    end
end

warcardgame()


-- main.lua
function newGame ()
	-- new deck
	local deck = {}
	for iSuit = 1, #CardSuits do
		for iRank = 1, #CardRanks do
			local card = {
				iSuit = iSuit,
				iRank = iRank,
				suit = CardSuits[iSuit],
				rank = iRank,
				name = CardRanks[iRank] .. CardSuits[iSuit]
			}
			local i = math.random (#deck + 1)
			table.insert (deck, i, card)
		end
	end

	-- new deal
	Players = {
		{index = 1, cards = {}},
		{index = 2, cards = {}},
	}
	for i = 1, #deck/#Players do
		for iPlayer = 1, #Players do
			table.insert (Players[iPlayer].cards, table.remove(deck))
		end
	end
	WarCards = {}
	Turn = 1
	Statistics = {}
end

function getHigherCard (cardA, cardB)
	if cardA.rank > cardB.rank then
		return cardA, 1
	elseif cardA.rank < cardB.rank then
		return cardB, 2
	else
		return nil
	end
end

function love.load()
	-- there is no card suits in the standard font
	CardSuits = {"@", "#", "$", "%"}
	CardRanks = {"2", "3", "4", "5", "6", "7", "8", "9", "10", "V", "Q", "K", "A"}

	newGame ()
end

function love.draw()
	for iPlayer = 1, #Players do
		local player = Players[iPlayer]
		love.graphics.print ('Player '..player.index, 50*(iPlayer-1), 0)
		for iCard, card in ipairs (player.cards) do
			love.graphics.print (card.name, 50*(iPlayer-1), 14*iCard)
		end
	end
	for i = 1, math.min(40, #Statistics) do
		local str = Statistics[i]
		love.graphics.print (str, 150, 20+(i-1)*14)
	end

end

function makeTurn ()
	local card1 = table.remove (Players[1].cards)
	local card2 = table.remove (Players[2].cards)
	if card1 and card2 then
		table.insert (WarCards, 1, card1)
		table.insert (WarCards, math.random (1, 2), card2)
		local winCard, index = getHigherCard (card1, card2)
		if winCard then
			table.insert (Statistics, 1, Turn .. '	Player ' .. index .. ' get ' .. #WarCards .. ' cards: ' .. card1.name .. ' vs ' .. card2.name)

			for iCard = #WarCards, 1, -1 do
				table.insert (Players[index].cards, 1, table.remove (WarCards))
			end
		elseif (#Players[1].cards > 0) and (#Players[2].cards > 0) then
		-- start war
			table.insert (Statistics, 1, Turn .. '	War: ' .. card1.name .. ' vs ' .. card2.name)
			table.insert (WarCards, table.remove (Players[1].cards))
			table.insert (WarCards, table.remove (Players[2].cards))
		else
			local index = 2
			if #Players[1].cards == 0 then index = 1 end
			table.insert (Statistics, 1, Turn .. '	Player ' .. index .. ' has no cards for this war.')
--			GameOver = true
		end
		Turn = Turn + 1
	elseif GameOver then
		GameOver = false
		newGame ()
	else
		local index = 2
		if #Players[1].cards > #Players[2].cards then index = 1 end
		table.insert (Statistics, 1, Turn .. '	Player ' .. index .. ' wins the game!')
		GameOver = true
	end
end

function love.keypressed(key, scancode, isrepeat)
	if false then
	elseif key == "space" then
		makeTurn ()
	elseif scancode == "n" then
		GameOver = false
		newGame ()
	elseif scancode == "q" then
		local lastTurn = Turn
		while not (GameOver or (Turn > lastTurn + 10000-1)) do
			makeTurn ()
		end
	elseif key == "escape" then
		love.event.quit()
	end
	if #Statistics > 40 then
		local i = #Statistics, 40, -1 do
			table.remove (Statistics, i)
		end
	end
end

function love.mousepressed( x, y, button, istouch, presses )
	if button == 1 then -- left mouse button
		makeTurn ()
	elseif button == 2 then -- right mouse button
	end
end


import strformat
import playing_cards

const
  None = -1
  Player1 = 0
  Player2 = 1

type Player = range[None..Player2]

const PlayerNames: array[Player1..Player2, string] = ["Player 1", "Player 2"]

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

proc `<`(a, b: Card): bool =
  ## Compare two cards by their rank, Ace being the greatest.
  if a.rank == Ace: false
  elif b.rank == Ace: true
  else: a.rank < b.rank

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

proc displayRound(round: int; hands: openArray[Hand]; card1, card2: string; text: string) =
  ## Display text for a round.
  stdout.write &"Round {round:<4}     "
  stdout.write &"Cards: {hands[Player1].len:>2}/{hands[Player2].len:<2}     "
  stdout.write &"{card1:>3}    {card2:>3}    "
  echo text

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

proc outOfCards(player: Player) =
  ## Display a message when a player has run out of cards.
  echo &"{PlayerNames[player]} has run out of cards."

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

proc doRound(hands: var openArray[Hand]; num: Positive) =
  ## Execute a round.

  var stack1, stack2: seq[Card]
  var winner: Player = None

  while winner == None:
    let card1 = hands[Player1].draw()
    let card2 = hands[Player2].draw()
    stack1.add card1
    stack2.add card2
    if card1.rank != card2.rank:
      winner = if card1 < card2: Player2 else: Player1
      displayRound(num, hands, $card1, $card2, &"{PlayerNames[winner]} takes the cards.")
    else:
      # There is a war.
      displayRound(num, hands, $card1, $card2, "This is a war.")
      if hands[Player1].len == 0:
        winner = Player2
      elif hands[Player2].len == 0:
        winner = Player1
      else:
        # Add a hidden card on stacks.
        stack1.add hands[Player1].draw()
        stack2.add hands[Player2].draw()
        displayRound(num, hands, "  ?", "  ?", "Cards are face down.")
        # Check if each player has enough cards to continue the war.
        if hands[Player1].len == 0:
          Player1.outOfCards()
          winner = Player2
        elif hands[Player2].len == 0:
          Player2.outOfCards()
          winner = Player1

  # Update hands.
  var stack = stack1 & stack2
  stack.shuffle()
  hands[winner] = stack & hands[winner]

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

var deck = initDeck()
deck.shuffle()

var hands = deck.deal(2, 26)
var num = 0
while true:
  inc num
  hands.doRound(num)
  if hands[Player1].len == 0:
    echo "Player 2 wins this game."
    break
  if hands[Player2].len == 0:
    echo "Player 1 wins this game."
    break


#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/War_Card_Game
use warnings;
use List::Util qw( shuffle );

my %rank;
@rank{ 2 .. 9, qw(t j q k a) } = 1 .. 13; # for winner
local $_ = join '', shuffle
  map { my $f = $_; map $f.$_, qw( S H C D ) } 2 .. 9, qw( a t j q k );
substr $_, 52, 0, "\n"; # split deck into two parts
my $war = '';
my $cnt = 0;
$cnt++ while print( /(.*)\n(.*)/ && "one: $1\ntwo: $2\n\n" ),
  s/^((.).)(.*)\n((?!\2)(.).)(.*)$/ my $win = $war; $war = ''; # capture
    $rank{$2} > $rank{$5} ? "$3$1$4$win\n$6" : "$3\n$6$4$1$win" /e
  ||
  s/^(.{4})(.*)\n(.{4})(.*)$/ print "WAR!!!\n\n"; $war .= "$1$3";
    "$2\n$4" /e; # tie means war
print "player '", /^.{10}/ ? 'one' : 'two', "' wins in $cnt moves\n";


with javascript_semantics
sequence deck = shuffle(tagset(52)),
         hand1 = deck[1..26],
         hand2 = deck[27..52],
         pending = {}

function pop1()
    integer res
    {res, hand1} = {hand1[1],hand1[2..$]}
    return res
end function

function pop2()
    integer res
    {res, hand2} = {hand2[1],hand2[2..$]}
    return res
end function

function show(integer c)
    integer r = remainder(c-1,13)+1,
            s = floor((c-1)/13)+1
    printf(1,"%s    ",{"23456789TJQKA"[r]&"SHDC"[s]})
    return r
end function

while true do
    if length(hand1)=0 then
        if length(hand2)=0 then
            printf(1,"Game ends as a tie.\n")
            exit
        end if
        printf(1,"Player 2 wins the game.\n")
        exit
    elsif length(hand2)=0 then
        printf(1,"Player 1 wins the game.\n")
        exit
    end if
    integer c1 = pop1(),
            c2 = pop2(),
            r1 = show(c1),
            r2 = show(c2)
    if r1>r2 then
        printf(1,"Player 1 takes the cards.\n")
        hand1 &= shuffle(c1&c2&pending)
        pending = {}
    elsif r1<r2 then
        printf(1,"Player 2 takes the cards.\n")
        hand2 &= shuffle(c1&c2&pending)
        pending = {}
    else -- r1==r2
        printf(1,"Tie!\n")
        if length(hand1)!=0 and length(hand2)!=0 then
            pending &= shuffle(c1&c2&pop1()&pop2())
            printf(1,"??    ??    Cards are face down.\n")
        end if
    end if
end while


""" https://bicyclecards.com/how-to-play/war/ """

from numpy.random import shuffle

SUITS = ['♣', '♦', '♥', '♠']
FACES = ['2', '3', '4', '5', '6', '7', '8', '9', '10', 'J', 'Q', 'K', 'A']
DECK = [f + s for f in FACES for s in SUITS]
CARD_TO_RANK = dict((DECK[i], (i + 3) // 4) for i in range(len(DECK)))

class WarCardGame:
    """ card game War """
    def __init__(self):
        deck = DECK.copy()
        shuffle(deck)
        self.deck1, self.deck2 = deck[:26], deck[26:]
        self.pending = []

    def turn(self):
        """ one turn, may recurse on tie """
        if len(self.deck1) == 0 or len(self.deck2) == 0:
            return self.gameover()

        card1, card2 = self.deck1.pop(0), self.deck2.pop(0)
        rank1, rank2 = CARD_TO_RANK[card1], CARD_TO_RANK[card2]
        print("{:10}{:10}".format(card1, card2), end='')
        if rank1 > rank2:
            print('Player 1 takes the cards.')
            self.deck1.extend([card1, card2])
            self.deck1.extend(self.pending)
            self.pending = []
        elif rank1 < rank2:
            print('Player 2 takes the cards.')
            self.deck2.extend([card2, card1])
            self.deck2.extend(self.pending)
            self.pending = []
        else:  #  rank1 == rank2
            print('Tie!')
            if len(self.deck1) == 0 or len(self.deck2) == 0:
                return self.gameover()

            card3, card4 = self.deck1.pop(0), self.deck2.pop(0)
            self.pending.extend([card1, card2, card3, card4])
            print("{:10}{:10}".format("?", "?"), 'Cards are face down.', sep='')
            return self.turn()

        return True

    def gameover(self):
        """ game over who won message """
        if len(self.deck2) == 0:
            if len(self.deck1) == 0:
                print('\nGame ends as a tie.')
            else:
                print('\nPlayer 1 wins the game.')
        else:
            print('\nPlayer 2 wins the game.')

        return False

if __name__ == '__main__':
    WG = WarCardGame()
    while WG.turn():
        continue


#lang racket

(define current-battle-length (make-parameter 3))

(define cards (string->list (string-append "🂢🂣🂤🂥🂦🂧🂨🂩🂪🂫🂭🂮🂡" "🂲🂳🂴🂵🂶🂷🂸🂹🂺🂻🂽🂾🂱"
                                           "🃂🃃🃄🃅🃆🃇🃈🃉🃊🃋🃍🃎🃁" "🃒🃓🃔🃕🃖🃗🃘🃙🃚🃛🃝🃞🃑")))

(define face (curry hash-ref (for/hash ((c cards) (i (in-naturals))) (values c (+ 2 (modulo i 13))))))

(define (print-draw-result turn-number d1 c1 d2 c2 → (pending null))
  (printf "#~a\t~a ~a ~a\t~a|~a|~a~%" turn-number c1 → c2 (length d1) (length pending)(length d2)))

(define (turn d1 d2 (n 1) (pending null) (battle 0))
  (match* (d1 d2)
    [('() '()) "Game ends in a tie!"]
    [(_ '()) "Player 1 wins."]
    [('() _) "Player 2 wins."]
    [((list c3 d1- ...) (list c4 d2- ...))
     #:when (positive? battle)
     (define pending+ (list* c3 c4 pending))
     (print-draw-result n d1- "🂠" d2- "🂠" "?" pending+)
     (turn d1- d2- (add1 n) pending+ (sub1 battle))]
    [((list (and c1 (app face r)) d1- ...) (list (and c2 (app face r)) d2- ...))
     (define pending+ (list* c1 c2 pending))
     (print-draw-result n d1- c1 d2- c2 #\= pending+)
     (turn d1- d2- (add1 n) pending+ (current-battle-length))]
    [((list (and c1 (app face r1)) d1- ...) (list (and c2 (app face r2)) d2- ...))
     (define spoils (shuffle (list* c1 c2 pending)))
     (define p1-win? (> r1 r2))
     (define d1+ (if p1-win? (append d1- spoils) d1-))
     (define d2+ (if p1-win? d2- (append d2- spoils)))
     (print-draw-result n d1+ c1 d2+ c2 (if p1-win? "←" "→"))
     (turn d1+ d2+ (add1 n))]))

(define (war-card-game)
  (call-with-values (λ () (split-at (shuffle cards) (quotient (length cards) 2)))
                    turn))

(displayln (war-card-game))


unit sub MAIN (:$war where 2..4 = 4, :$sleep = .1);

my %c = ( # convenience hash of ANSI colors
    red   => "\e[38;2;255;10;0m",
    blue  => "\e[38;2;05;10;200m",
    black => "\e[38;2;0;0;0m"
);

my @cards = flat (flat
     <🂢 🂣 🂤 🂥 🂦 🂧 🂨 🂩 🂪 🂫 🂭 🂮 🂡
      🃒 🃓 🃔 🃕 🃖 🃗 🃘 🃙 🃚 🃛 🃝 🃞 🃑>.map({ "{%c<black>}$_" }),
     <🂲 🂳 🂴 🂵 🂶 🂷 🂸 🂹 🂺 🂻 🂽 🂾 🂱
      🃂 🃃 🃄 🃅 🃆 🃇 🃈 🃉 🃊 🃋 🃍 🃎 🃁>.map({ "{%c<red>}$_" })
).batch(13).map({ .flat Z 2..14 })».map: { .[1] but .[0] };

my $back = "{%c<blue>}🂠";
my @won  = <👈 👉>;

sub shuffle (@cards) { @cards.pick: * }
sub deal    (@cards) { [@cards[0,*+2 … *], @cards[1,*+2 … *]] }

my ($rows, $cols) = qx/stty size/.words».Int; # get the terminal size
note "Terminal is only $cols characters wide, needs to be at least 80, 120 or more recommended."
  and exit if $cols < 80;

sub clean-up {
    reset-scroll-region;
    show-cursor;
    print-at $rows, 1, '';
    print "\e[0m";
    exit(0)
}

signal(SIGINT).tap: { clean-up() }

my @index  = ($cols div 2 - 5, $cols div 2 + 4);
my @player = (deal shuffle @cards)».Array;
my $lose   = False;

sub take (@player, Int $cards) {
    if +@player >= $cards {
        return @player.splice(0, $cards);
    }
    else {
         $lose = True;
         return @player.splice(0, +@player);
    }
}

use Terminal::ANSI;

clear-screen;
hide-cursor;
# Set background color
print "\e[H\e[J\e[48;2;245;245;245m", ' ' xx $rows * $cols + 1;

# Add header
print-at 1, $cols div 2 - 1, "{%c<red>}WAR!";
print-at 2, 1, '━' x $cols;

my $row = 3;
my $height = $rows - $row - 2;
set-scroll-region($row, $height);

# footer
print-at $height + 1, 1, '━' x $cols;

my $round = 0;
my @round;

loop {
    @round = [@player[0].&take(1)], [@player[1].&take(1)] unless [email protected]round;
    print-at $row, $cols div 2, "{%c<red>}┃";
    print-at $row, @index[0], @round[0;0] // ' ';
    print-at $row, @index[1], @round[1;0] // ' ';
    if $lose {
        if @player[0] < @player[1] {
            print-at $row, $cols div 2 + 1, @won[1] unless [email protected]round[1] == 1;
            print-at $height + 3, $cols div 2 - 10, "{%c<red>} Player 1 is out of cards "
        } else {
            print-at $row, $cols div 2 - 2, @won[0] unless [email protected]round[0] == 1;
            print-at $height + 3, $cols div 2 - 10, "{%c<red>} Player 2 is out of cards "
        }

    }
    if (@round[0].tail // 0) > (@round[1].tail // 0) {
        print-at $row, $cols div 2 - 2, @won[0];
        @player[0].append: flat (|@round[0],|@round[1]).pick: *;
        @round = ();
    }
    elsif (@round[0].tail // 0) < (@round[1].tail // 0) {
        print-at $row, $cols div 2 + 1, @won[1];
        @player[1].append: flat (|@round[0],|@round[1]).pick: *;
        @round = ();
    }
    else {
        @round[0].append: @player[0].&take($war);
        @round[1].append: @player[1].&take($war);
        print-at $row, @index[0] - $_ * 2, ($_ %% $war) ?? @round[0; $_] !! $back for ^@round[0];
        print-at $row, @index[1] + $_ * 2, ($_ %% $war) ?? @round[1; $_] !! $back for ^@round[1];
        next
    }
    last if $lose;
    print-at $height + 2, $cols div 2 - 4,  "{%c<blue>} Round {++$round} ";
    print-at $height + 2, $cols div 2 - 40, "{%c<blue>} Player 1: {[email protected][0]} cards ";
    print-at $height + 2, $cols div 2 + 21, "{%c<blue>} Player 2: {[email protected][1]} cards ";
    sleep $sleep if +$sleep;
    if $row >= $height { scroll-up } else { ++$row }
}

# game over
print-at $height + 2, $cols div 2 - 40, "{%c<blue>} Player 1: {[email protected][0] ?? '52' !! "{%c<red>}0"}{%c<blue>} cards ";
print-at $height + 2, $cols div 2 + 20, "{%c<blue>} Player 2: {[email protected][1] ?? '52' !! "{%c<red>}0"}{%c<blue>} cards ";
clean-up;


import "random" for Random
import "/queue" for Deque

var rand  = Random.new()
var suits = ["♣", "♦", "♥", "♠"]
var faces = ["2", "3", "4", "5", "6", "7", "8", "9", "T", "J", "Q", "K", "A" ]
var cards = List.filled(52, null)
for (i in 0..51) cards[i] = "%(faces[i%13])%(suits[(i/13).floor])"
var ranks = List.filled(52, 0)
for (i in 0..51) ranks[i] = i % 13

var war = Fn.new {
    var deck = List.filled(52, 0)
    for (i in 0..51) deck[i] = i
    rand.shuffle(deck)
    var hand1 = Deque.new()
    var hand2 = Deque.new()
    for (i in 0..25) {
        hand1.pushFront(deck[2*i])
        hand2.pushFront(deck[2*i+1])
    }
    while (hand1.count > 0 && hand2.count > 0) {
        var card1 = hand1.popFront()
        var card2 = hand2.popFront()
        var played1 = [card1]
        var played2 = [card2]
        var numPlayed = 2
        while (true) {
            System.write("%(cards[card1])\t%(cards[card2])\t")
            if (ranks[card1] > ranks[card2]) {
                hand1.pushAllBack(played1)
                hand1.pushAllBack(played2)
                System.print("Player 1 takes the %(numPlayed) cards. Now has %(hand1.count).")
                break
            } else if (ranks[card1] < ranks[card2]) {
                hand2.pushAllBack(played2)
                hand2.pushAllBack(played1)
                System.print("Player 2 takes the %(numPlayed) cards. Now has %(hand2.count).")
                break
            } else {
                System.print("War!")
                if (hand1.count < 2) {
                    System.print("Player 1 has insufficient cards left.")
                    hand2.pushAllBack(played2)
                    hand2.pushAllBack(played1)
                    hand2.pushAllBack(hand1)
                    hand1.clear()
                    break
                }
                if (hand2.count < 2) {
                    System.print("Player 2 has insufficient cards left.")
                    hand1.pushAllBack(played1)
                    hand1.pushAllBack(played2)
                    hand1.pushAllBack(hand2)
                    hand2.clear()
                    break
                }
                played1.add(hand1.popFront()) // face down card
                card1 = hand1.popFront()      // face up card
                played1.add(card1)
                played2.add(hand2.popFront()) // face down card
                card2 = hand2.popFront()      // face up card
                played2.add(card2)
                numPlayed = numPlayed + 4
                System.print("? \t? \tFace down cards.")
            }
        }
    }
    if (hand1.count == 52) {
        System.print("Player 1 wins the game!")
    } else {
        System.print("Player 2 wins the game!")
    }
}

war.call()


char    Deck(52),               \initial card deck (low 2 bits = suit)
        Stack(2, 52);           \each player's stack of cards (52 maximum)
int     Inx(2),                 \index to last card (+1) for each stack
        Top,                    \index to compared cards, = stack top if not war
        Card, N, I, J, P, T;
char    Suit, Rank;

proc    MoveCard(To, From);     \Move top card From Stack to bottom of To Stack
int     To, From;
int     Card, I;
[Card:= Stack(From, 0);         \take top Card from From Stack
for I:= 0 to Inx(From)-2 do     \shift remaining cards over
        Stack(From, I):= Stack(From, I+1);
if Inx(From) > 0 then           \remove From card from its Stack
        Inx(From):= Inx(From)-1;
Stack(To, Inx(To)):= Card;      \add Card to bottom of To Stack
if Inx(To) < 52 then            \remove From card from its Stack
        Inx(To):= Inx(To)+1;
];

[\\Suit:= "^C^D^E^F ";          \IBM OEM card symbols aren't displayable on RC
Suit:= "HDCS ";
Rank:= "23456789TJQKA ";        \T = 10
for Card:= 0 to 52-1 do         \make a complete deck of cards
        Deck(Card):= Card;
for N:= 0 to 10_000 do          \shuffle the deck by swapping random locations
        [I:= Ran(52);  J:= Ran(52);
        T:= Deck(I);  Deck(I):= Deck(J);  Deck(J):= T;
        ];
for N:= 0 to 52-1 do            \deal deck into two stacks
        [Card:= Deck(N);
        I:= N/2;
        P:= rem(0);
        Stack(P, I):= Card;
        ];
Inx(0):= 52/2;  Inx(1):= 52/2;  \set indexes to last card +1

loop    [for P:= 0 to 1 do      \show both stacks of cards
                [for I:= 0 to Inx(P)-1 do
                        [Card:= Stack(P, I);  ChOut(0, Rank(Card>>2))];
                CrLf(0);
                for I:= 0 to Inx(P)-1 do
                        [Card:= Stack(P, I);  ChOut(0, Suit(Card&3))];
                CrLf(0);
                ];
        if Inx(0)=0 or Inx(1)=0 then quit;      \game over

        Top:= 0;                \compare card ranks (above 2-bit suits)
        loop    [if Stack(0, Top)>>2 = Stack(1, Top)>>2 then
                        [Text(0, "War!");  CrLf(0);
                        Top:= Top+2;            \play a card down and a card up
                        ]
                else if Stack(0, Top)>>2 > Stack(1, Top)>>2 then
                        [for I:= 0 to Top do    \move cards to Stack 0
                                [MoveCard(0, 0);  MoveCard(0, 1)];
                        quit;
                        ]
                else    [for I:= 0 to Top do    \move cards to Stack 1
                                [MoveCard(1, 1);  MoveCard(1, 0)];
                        quit;
                        ];
                ];
        T:= ChIn(1);            \wait for keystroke (no key echo)
        CrLf(0);
        ];
]
]


\ Web-scrape sample: get UTC time from the US Naval Observatory:
: read-url \ -- s
 "http://tycho.usno.navy.mil/cgi-bin/timer.pl" net:get
 not if "Could not connect" throw then
 >s ;

: get-time
  read-url
  /<BR>.*?(\d{2}:\d{2}:\d{2})\sUTC/
  tuck r:match if
    1 r:@ . cr
  then ;

get-time bye


with AWS.Client, AWS.Response, AWS.Resources, AWS.Messages;
with Ada.Text_IO, Ada.Strings.Fixed;
use  Ada, AWS, AWS.Resources, AWS.Messages;

procedure Get_UTC_Time is

   Page           : Response.Data;
   File           : Resources.File_Type;
   Buffer         : String (1 .. 1024);
   Position, Last : Natural := 0;
   S              : Messages.Status_Code;
begin
   Page := Client.Get ("http://tycho.usno.navy.mil/cgi-bin/timer.pl");
   S    := Response.Status_Code (Page);
   if S not  in Success then
      Text_IO.Put_Line
        ("Unable to retrieve data => Status Code :" & Image (S) &
         " Reason :" & Reason_Phrase (S));
      return;
   end if;

   Response.Message_Body (Page, File);
   while not End_Of_File (File) loop
      Resources.Get_Line (File, Buffer, Last);
      Position :=
         Strings.Fixed.Index
           (Source  => Buffer (Buffer'First .. Last),
            Pattern => "UTC");
      if Position > 0 then
         Text_IO.Put_Line (Buffer (5 .. Position + 2));
         return;
      end if;
   end loop;
end Get_UTC_Time;


STRING
   domain="tycho.usno.navy.mil",
   page="cgi-bin/timer.pl";

STRING # search for the needle in the haystack #
   needle = "UTC",
   hay stack = "http://"+domain+"/"+page,

   re success="^HTTP/[0-9.]* 200",
   re result description="^HTTP/[0-9.]* [0-9]+ [a-zA-Z ]*",
   re doctype ="\s\s<![Dd][Oo][Cc][Tt][Yy][Pp][Ee] [^>]+>\s+";

PROC raise error = (STRING msg)VOID: ( put(stand error, (msg, new line)); stop);

PROC is html page = (REF STRING page) BOOL: (
     BOOL out=grep in string(re success, page, NIL, NIL) = 0;
     IF INT start, end;
        grep in string(re result description, page, start, end) = 0
     THEN
        page:=page[end+1:];
        IF grep in string(re doctype, page, start, end) = 0
        THEN page:=page[start+2:]
        ELSE raise error("unknown format retrieving page")
        FI
     ELSE raise error("unknown error retrieving page")
     FI;
     out
);

STRING reply;
INT rc = http content (reply, domain, haystack, 0);
IF rc = 0 AND is html page (reply)
THEN
  STRING line; FILE freply; associate(freply, reply);
  on logical file end(freply, (REF FILE freply)BOOL: (done; SKIP));
  DO
    get(freply,(line, new line));
    IF string in string(needle, NIL, line) THEN print((line, new line)) FI
  OD;
  done: SKIP
ELSE raise error (strerror (rc))
FI