Sub Main()
Const TESTSTRING As String = "alphaBETA"
Debug.Print "initial   =                                      " _
   & TESTSTRING
Debug.Print "uppercase =                                      " _
   & UCase(TESTSTRING)
Debug.Print "lowercase =                                      " _
   & LCase(TESTSTRING)
Debug.Print "first letter capitalized =                       " _
   & StrConv(TESTSTRING, vbProperCase)
Debug.Print "length (in characters) =                         " _
   & CStr(Len(TESTSTRING))
Debug.Print "length (in bytes) =                              " _
   & CStr(LenB(TESTSTRING))
Debug.Print "reversed =                                       " _
   & StrReverse(TESTSTRING)
Debug.Print "first position of letter A (case-sensitive) =    " _
   & InStr(1, TESTSTRING, "A", vbBinaryCompare)
Debug.Print "first position of letter A (case-insensitive) =  " _
   & InStr(1, TESTSTRING, "A", vbTextCompare)
Debug.Print "concatenated with '123' =                        " _
   & TESTSTRING & "123"
End Sub


fn show(s string) {
    println('string: $s len: $s.len')
    println('All upper case: ${s.to_upper()}')
    println('All lower case: ${s.to_lower()}')
    println('Title words:    ${s.title()}')
    println('')
}

fn main(){
    show('alphaBETA')
    show('alpha BETA')
    show('Ǆǈǌ')
    show("o'hare O'HARE o’hare don't")
}


import "/str" for Str

var s = "alphaBETA"
System.print(Str.upper(s))
System.print(Str.lower(s))


string 0;                       \use zero-terminated string convention
include c:\cxpl\stdlib;         \ToUpper, ToLower, and 'code' declarations

proc StrToUpper(S);             \Convert string to uppercase characters
char S;
while S(0) do [S(0):= ToUpper(S(0));  S:=S+1];

proc StrToLower(S);             \Convert string to lowercase characters
char S;
while S(0) do [S(0):= ToLower(S(0));  S:=S+1];

char Str;
[Str:= "alphaBETA";
StrToUpper(Str);
Text(0, Str);  CrLf(0);
StrToLower(Str);
Text(0, Str);  CrLf(0);
]


ToUpperCase:
	;INPUT:
	;HL = BASE ADDRESS OF A NULL-TERMINATED STRING
	;OVERWRITES THE STRING YOU INPUT WITH THE UPPERCASE VERSION
	ld bc,&617A		;lower case ascii range
loop_toUpperCase:
	ld a,(hl)
	or a
	ret z
	call CompareRange_Inclusive	;is this a lower case letter?
	jr c,skipUpperCase		;if not, don't change it!
		and %11011111		;change to upper case
		ld (hl),a		;store back in string
skipUpperCase:
	inc hl
	jr loop_toUpperCase
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ToLowerCase:
	;INPUT:
	;HL = BASE ADDRESS OF A NULL-TERMINATED STRING
	;OVERWRITES THE STRING YOU INPUT WITH THE LOWERCASE VERSION
	ld bc,&415A		;upper case ascii range
loop_toLowerCase:
	ld a,(hl)
	or a
	ret z
	call CompareRange_Inclusive
	jr c,skipLowerCase
		or %00100000
		ld (hl),a
skipLowerCase:
	inc hl
	jr loop_toLowerCase
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ToggleCase:
	;INPUT:
	;HL = BASE ADDRESS OF A NULL-TERMINATED STRING
	;INVERTS THE CASE OF ALL ALPHABET CHARACTERS IN THE STRING
	ld bc,&415A
loop_toggleCase:
	ld a,(hl)
	or a
	ret z
	call CompareRange_Inclusive
	jr nc,toggle
        push bc
             ld bc,&617A
             call CompareRange_Inclusive
        pop bc
        jr c, skipToggleCase
toggle:
		xor %00100000
		ld (hl),a
skipToggleCase:
	inc hl
	jr loop_toggleCase
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
CompareRange_Inclusive:
	;returns CF CLEAR if B <= A <= C, and CF SET otherwise.
	cp b
	ret c	;if carry set, A < B thus out of range.
		push de
			ld e,a
			ld a,c
			ld c,e	;swap A with C

			cp c	;compare C to A. Signs are reversed.
			;if carry set, "A" < "C" which means original C < original A. Thus out of range.
			;if carry clear, we are in range.

			ld e,a	;now put A and C back where they belong.
			ld a,c
			ld c,e	;none of this affects the flags, so the compare is still valid.
		pop de
		ret
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


s:="alphaBETA";
s.toLower(); //--> "alphabeta"
s.toUpper(); //--> "ALPHABETA"


const std = @import("std");

pub fn main() !void {
    const stdout_wr = std.io.getStdOut().writer();
    const string = "alphaBETA";
    var lower: [string.len]u8 = undefined;
    var upper: [string.len]u8 = undefined;
    for (string) |char, i| {
        lower[i] = std.ascii.toLower(char);
        upper[i] = std.ascii.toUpper(char);
    }
    try stdout_wr.print("lower: {s}\n", .{lower});
    try stdout_wr.print("upper: {s}\n", .{upper});

    // TODO use https://github.com/jecolon/zigstr
}


program: uppercase
  input: 'FOObar'
  output: 'FOOBAR'

program: lowercase
  input: 'FOObar'
  output: 'foobar'


*        Stream Merge              07/02/2017
STRMERGE CSECT
         USING  STRMERGE,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         " <-
         ST     R15,8(R13)         " ->
         LR     R13,R15            " addressability
         OPEN   (OUTDCB,OUTPUT)    open the output file
         LA     R6,1               n=1
         LA     R9,FILE            file(n)
LOOPN    C      R6,=A(NN)          do n=1 to nn
         BH     ELOOPN
         L      R2,0(R9)           @DCB
         OPEN   ((R2),INPUT)       open input file # n
         LR     R1,R6              n
         BAL    R14,READ           call read(n)
         LA     R6,1(R6)           n=n+1
         LA     R9,4(R9)           file(n++)
         B      LOOPN              end do n
ELOOPN   BCTR   R6,0               n=n-1
LOOP     SR     R8,R8              lowest=0
         LA     R7,1               k=1
LOOPK    CR     R7,R6              do k=1 to n
         BH     ELOOPK
         LA     R2,RECDEF-1(R7)    @recdef(k)
         CLI    0(R2),X'00'        if not recdef(k)
         BNE    ERECDEF
         LR     R1,R7              k
         BAL    R14,READ           call read(k)
ERECDEF  LR     R1,R7              k
         LA     R2,EOF-1(R1)       @eof(k)
         CLI    0(R2),X'00'        if not eof(k)
         BNE    EEOF
         LTR    R8,R8              if lowest<>0
         BZ     LOWEST0
         LR     R1,R7              k
         SLA    R1,6
         LA     R2,REC-64(R1)      @rec(k)
         CLC    0(64,R2),PG        if rec(k)<y
         BNL    RECLTY
         B      LOWEST0            optimization
RECLTY   B      EEOF
LOWEST0  LR     R1,R7              k
         SLA    R1,6
         LA     R2,REC-64(R1)      @rec(k)
         MVC    PG,0(R2)           y=rec(k)
         LR     R8,R7              lowest=k
EEOF     LA     R7,1(R7)           k=k+1
         B      LOOPK              end do k
ELOOPK   LTR    R8,R8              if lowest=0
         BZ     EXIT               goto exit
         BAL    R14,WRITE          call write
         LR     R1,R8              lowest
         BAL    R14,READ           call read(lowest)
         B      LOOP
EXIT     LA     R7,1               k=1
         LA     R9,FILE            file(n)
LOOPKC   CR     R7,R6              do k=1 to n
         BH     ELOOPKC
         L      R2,0(R9)           @DCB
         CLOSE  ((R2))             close input file # k
         LA     R7,1(R7)           k=k+1
         LA     R9,4(R9)           file(n++)
         B      LOOPKC             end do k
ELOOPKC  CLOSE  (OUTDCB)           close output
         L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    " restore
         XR     R15,R15            " rc=0
         BR     R14                exit
*------- ----   ----------------------------------------
READ     LR     R4,R1              z
         LA     R2,RECDEF-1(R1)    @recdef(z)
         MVI    0(R2),X'00'        recdef(z)=false
         LA     R2,EOF-1(R1)       @eof(z)
         CLI    0(R2),X'00'        if not eof(z)
         BNE    EOFZ
         LR     R1,R4              z
         SLA    R1,6
         LA     R3,REC-64(R1)      @rec(z)
         LR     R5,R4              z
         SLA    R5,2
         LA     R9,FILE-4(R5)      @file(z)
         L      R5,0(R9)           @DCB
         GET    (R5),(R3)          read record
         LA     R2,RECDEF-1(R4)    @recdef(z)
         MVI    0(R2),X'01'        recdef(z)=true
EOFZ     BR     R14                return
INEOF    LA     R2,EOF-1(R4)       @eof(z)
         MVI    0(R2),X'01'        eof(z)=true
         B      EOFZ
*------- ----   ----------------------------------------
WRITE    LR     R1,R8              lowest
         SLA    R1,6
         LA     R2,REC-64(R1)      @rec(lowest)
         PUT    OUTDCB,(R2)        write record
         BR     R14                return
*        ----   ----------------------------------------
IN1DCB   DCB   DSORG=PS,MACRF=PM,DDNAME=IN1DD,LRECL=64,                *
               RECFM=FT,EODAD=INEOF
IN2DCB   DCB   DSORG=PS,MACRF=PM,DDNAME=IN2DD,LRECL=64,                *
               RECFM=FT,EODAD=INEOF
IN3DCB   DCB   DSORG=PS,MACRF=PM,DDNAME=IN3DD,LRECL=64,                *
               RECFM=FT,EODAD=INEOF
IN4DCB   DCB   DSORG=PS,MACRF=PM,DDNAME=IN4DD,LRECL=64,                *
               RECFM=FT,EODAD=INEOF
OUTDCB   DCB   DSORG=PS,MACRF=PM,DDNAME=OUTDD,LRECL=64,                *
               RECFM=FT
FILE     DC     A(IN1DCB,IN2DCB,IN3DCB,IN4DCB)
NN       EQU    (*-FILE)/4
EOF      DC     (NN)X'00'
RECDEF   DC     (NN)X'00'
REC      DS     (NN)CL64
PG       DS     CL64
         YREGS
         END    STRMERGE


with Ada.Text_Io;
with Ada.Command_Line;
with Ada.Containers.Indefinite_Holders;

procedure Stream_Merge is

   package String_Holders
   is new Ada.Containers.Indefinite_Holders (String);

   use Ada.Text_Io, String_Holders;

   type Stream_Type is
      record
         File  : File_Type;
         Value : Holder;
      end record;

   subtype Index_Type is Positive range 1 .. Ada.Command_Line.Argument_Count;
   Streams : array (Index_Type) of Stream_Type;

   procedure Fetch (Stream : in out Stream_Type) is
   begin
      Stream.Value := (if End_Of_File (Stream.File)
                       then Empty_Holder
                       else To_Holder (Get_Line (Stream.File)));
   end Fetch;

   function Next_Stream return Index_Type is
      Index : Index_Type := Index_Type'First;
      Value : Holder;
   begin
      for I in Streams'Range loop
         if Value.Is_Empty and not Streams (I).Value.Is_Empty then
            Value := Streams (I).Value;
            Index := I;
         elsif not Streams (I).Value.Is_Empty and then Streams (I).Value.Element < Value.Element then
            Value := Streams (I).Value;
            Index := I;
         end if;
      end loop;
      if Value.Is_Empty then
         raise Program_Error;
      end if;
      return Index;
   end Next_Stream;

   function More_Data return Boolean
   is (for some Stream of Streams => not Stream.Value.Is_Empty);

begin

   if Ada.Command_Line.Argument_Count = 0 then
      Put_Line ("Usage: prog <file1> <file2> ...");
      Put_Line ("Merge the sorted files file1, file2...");
      return;
   end if;

   for I in Streams'Range loop
      Open (Streams (I).File, In_File, Ada.Command_Line.Argument (I));
      Fetch (Streams (I));
   end loop;

   while More_Data loop
      declare
         Stream : Stream_Type renames Streams (Next_Stream);
      begin
         Put_Line (Stream.Value.Element);
         Fetch (Stream);
      end;
   end loop;

end Stream_Merge;


# merge a number of input files to an output file                             #
PROC mergenf = ( []REF FILE inf, REF FILE out )VOID:
     BEGIN
        INT        eof count := 0;
        BOOL       at eof    := FALSE;
        []REF FILE inputs     = inf[ AT 1 ];
        INT   number of files = UPB inputs;
        [ number of files ]BOOL eof;
        [ number of files ]STRING line;
        FOR f TO number of files DO
            eof[ f ] := FALSE;
            on logical file end( inf[ f ], ( REF FILE f )BOOL:
                                           BEGIN
                                               # note that we reached EOF on the latest read #
                                               # and return TRUE so processing can continue #
                                               at eof := TRUE
                                           END
                               )
        OD;
        # read a line from one of the input files                              #
        PROC read line = ( INT file number )VOID:
             BEGIN
                 at eof := FALSE;
                 get( inputs[ file number ], ( line[ file number ], newline ) );
                 eof[ file number ] := at eof;
                 IF at eof THEN
                     # reached eof on this file                                #
                     eof count +:= 1
                 FI
             END; # read line #
        # get the first line from each input file                              #
        FOR f TO number of files DO read line( f ) OD;
        # merge the files                                                      #
        WHILE eof count < number of files DO
            # find the lowest line in the current set                          #
            INT    low pos     := 0;
            STRING low line    := "";
            BOOL   first file  := TRUE;
            FOR file pos TO number of files DO
                IF eof[ file pos ] THEN
                    # file is at eof - ignore it                               #
                    SKIP
                ELIF first file THEN
                    # this is the first file not at eof                        #
                    low pos    := file pos;
                    low line   := line[ file pos ];
                    first file := FALSE
                ELIF line[ file pos ] < low line THEN
                    # this line is lower than the previous one                 #
                    low pos    := file pos;
                    low line   := line[ file pos ]
                FI
            OD;
            # write the record from the lowest file and get the next record    #
            # from it                                                          #
            put( out, ( line[ low pos ], newline ) );
            read line( low pos )
        OD
     END; # mergenf #

# merges the files named in input list, the results are written to the file     #
# named output name                                                             #
# the output file must already exist and will be overwritten                    #
PROC mergen = ( []STRING input list, STRING output name )VOID:
     BEGIN
        []STRING inputs       = input list[ AT 1 ];
        INT number of files   = UPB inputs;
        [ number of files ]REF FILE inf;
        # open the input files                                                  #
        FOR f TO number of files DO
             inf[ f ] := LOC FILE;
             IF  open( inf[ f ], inputs[ f ], stand in channel ) /= 0
             THEN
                 # failed to open the input file #
                 print( (  "Unable to open """ + input list[ f ] + """", newline ) );
                 stop
             FI
        OD;
        # open the output file (which must already exist & will be overwritten) #
        IF FILE output file;
           open( output file, output name, stand out channel ) /= 0
        THEN
            # failed to open the output file #
            print( (  "Unable to open """ + output name + """", newline ) );
            stop
        ELSE
            # files opened OK, merge them #
            mergenf( inf, output file );
            # close the files #
            close( output file );
            FOR f TO number of files DO close( inf[ f ] ) OD
        FI
     END; # mergen #

# merges the two files in1 and in2 to output file #
PROC merge2f = ( REF FILE in1, REF FILE in2, REF FILE output file )VOID: mergenf( ( in1, in2 ), output file );

# merges the two files named in1 and in2 to the file named output file #
PROC merge2 = ( STRING in1, STRING in2, STRING output file )VOID: mergen( ( in1, in2 ), output file );

# test the file merge #
merge2(   "in1.txt", "in2.txt",                         "out2.txt" );
mergen( ( "in1.txt", "in2.txt", "in3.txt", "in4.txt" ), "outn.txt" )


(* ****** ****** *)
//
// This is a memory-clean implementation:
// Every byte of allocated memory is freed
// before the program exits.
//
(* ****** ****** *)
//
#include
"share/atspre_define.hats"
#include
"share/atspre_staload.hats"
//
(*
#include
"share/HATS/atspre_staload_libats_ML.hats"
*)
//
(* ****** ****** *)

staload UN = $UNSAFE

(* ****** ****** *)

fun
streamize_fileptr_line
  (inp: FILEref) = let
//
val lines =
  streamize_fileref_line(inp)
//
val
closing =
$ldelay
(
(
fileref_close(inp);
stream_vt_nil((*void*))
)
,
fileref_close(inp)
)
//
in
//
stream_vt_append(lines, closing)
//
end // end of [streamize_fileptr_line]

(* ****** ****** *)
//
extern
fun
{a:[email protected]}
stream_merge_2
(
xs: stream_vt(a), ys: stream_vt(a)
) : stream_vt(a) // end-of-function
//
(* ****** ****** *)

implement
{a}(*tmp*)
stream_merge_2
  (xs, ys) =
  aux0(xs, ys) where
{
//
fun
aux0
(
xs: stream_vt(a)
,
ys: stream_vt(a)
) : stream_vt(a) = $ldelay
(
case+ !xs of
| ~stream_vt_nil() => !ys
| ~stream_vt_cons(x, xs) => !(aux1(x, xs, ys))
,
(~xs; ~ys)
)
//
and
aux1
(
x0: a
,
xs: stream_vt(a)
,
ys: stream_vt(a)
) : stream_vt(a) = $ldelay
(
case+ !ys of
| ~stream_vt_nil() => stream_vt_cons(x0, xs)
| ~stream_vt_cons(y, ys) => !(aux2(x0, xs, y, ys))
,
(gfree_val<a>(x0); ~xs; ~ys)
)
//
and
aux2
(
x0: a
,
xs: stream_vt(a)
,
y0: a
,
ys: stream_vt(a)
) : stream_vt(a) = $ldelay
(
let
//
var x0 = x0
and y0 = y0
//
val sgn = gcompare_ref_ref<a>(x0, y0)
//
in
//
if
(sgn <= 0)
then stream_vt_cons(x0, aux1(y0, ys, xs))
else stream_vt_cons(y0, aux1(x0, xs, ys))
//
end // end of [let]
,
(gfree_val<a>(x0); gfree_val<a>(y0); ~xs; ~ys)
)
//
} (* end of [stream_merge_2] *)

(* ****** ****** *)

implement
main0(argc, argv) =
{
//
val () = assertloc(argc >= 3)
//
val xs =
(
case+
fileref_open_opt
(
  argv[1], file_mode_r
) of // case+
| ~None_vt() => stream_vt_make_nil()
| ~Some_vt(inp) => streamize_fileptr_line(inp)
) : stream_vt(Strptr1)
//
val ys =
(
case+
fileref_open_opt
(
argv[2], file_mode_r
) of // case+
| ~None_vt() => stream_vt_make_nil()
| ~Some_vt(inp) => streamize_fileptr_line(inp)
) : stream_vt(Strptr1)
//
local
//
implement
(a:[email protected])
gfree_val<a>(z) =
strptr_free($UN.castvwtp0{Strptr1}(z))
//
implement
(a:[email protected])
gcompare_ref_ref<a>
  (x, y) =
(
compare($UN.castvwtp1{String}(x), $UN.castvwtp1{String}(y))
) (* end of [gcompare_ref_ref] *)
//
in
//
val zs = stream_merge_2<Strptr1>(xs, ys)
//
end // end of [local]
//
val ((*void*)) =
stream_vt_foreach_cloptr(zs, lam(z) => (println!(z); strptr_free(z)))
//
} (* end of [main0] *)


# syntax: GAWK -f STREAM_MERGE.AWK filename(s) >output
# handles 1 .. N files
#
# variable   purpose
# ---------- -------
# data_arr   holds last record read
# fn_arr     filenames on command line
# fnr_arr    record counts for each file
# status_arr file status: 1=more data, 0=EOF, -1=error
#
BEGIN {
    files = ARGC-1
# get filename, file status and first record
    for (i=1; i<=files; i++) {
      fn_arr[i] = ARGV[i]
      status_arr[i] = getline <fn_arr[i]
      if (status_arr[i] == 1) {
        nr++ # records read
        fnr_arr[i]++
        data_arr[i] = $0
      }
      else if (status_arr[i] < 0) {
        error(sprintf("FILENAME=%s, status=%d, file not found",fn_arr[i],status_arr[i]))
      }
    }
    while (1) { # until EOF in all files
# get file number of the first file still containing data
      fno = 0 # file number
      for (i=1; i<=files; i++) {
        if (status_arr[i] == 1) {
          fno = i
          break
        }
      }
      if (fno == 0) { # EOF in all files
        break
      }
# determine which file has the lowest record in collating sequence
      for (i=1; i<=files; i++) {
        if (status_arr[i] == 1) {
          if (data_arr[i] < data_arr[fno]) {
            fno = i
          }
        }
      }
# output record, get next record, if not EOF then check sequence
      printf("%s\n",data_arr[fno])
      status_arr[fno] = getline <fn_arr[fno] # get next record from this file
      if (status_arr[fno] == 1) {
        nr++
        fnr_arr[fno]++
        if (data_arr[fno] > $0) {
          error(sprintf("FILENAME=%s, FNR=%d, out of sequence",fn_arr[fno],fnr_arr[fno]))
        }
        data_arr[fno] = $0
      }
    }
# EOJ
    printf("input: %d files, %d records, %d errors\n",files,nr,errors) >"con"
    exit(0)
}
function error(message) {
    printf("error: %s\n",message) >"con"
    errors++
}


/*
 * Rosetta Code - stream merge in C.
 *
 * Two streams (text files) with integer numbers, C89, Visual Studio 2010.
 *
 */

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

#define GET(N) { if(fscanf(f##N,"%d",&b##N ) != 1) f##N = NULL; }
#define PUT(N) { printf("%d\n", b##N); GET(N) }

void merge(FILE* f1, FILE* f2, FILE* out)
{
    int b1;
    int b2;

    if(f1) GET(1)
    if(f2) GET(2)

    while ( f1 && f2 )
    {
        if ( b1 <= b2 ) PUT(1)
        else            PUT(2)
    }
    while (f1 ) PUT(1)
    while (f2 ) PUT(2)
}

int main(int argc, char* argv[])
{
    if ( argc < 3 || argc > 3 )
    {
        puts("streammerge filename1 filename2");
        exit(EXIT_FAILURE);
    }
    else
        merge(fopen(argv[1],"r"),fopen(argv[2],"r"),stdout);

    return EXIT_SUCCESS;
}


using System;
using System.Collections.Generic;
using System.Linq;

namespace RosettaCode
{
    static class StreamMerge
    {
        static IEnumerable<T> Merge2<T>(IEnumerable<T> source1, IEnumerable<T> source2) where T : IComparable
        {
            var q1 = new Queue<T>(source1);
            var q2 = new Queue<T>(source2);
            while (q1.Any() && q2.Any())
            {
                var c = q1.Peek().CompareTo(q2.Peek());
                if (c <= 0) yield return q1.Dequeue(); else yield return q2.Dequeue();
            }
            while (q1.Any()) yield return q1.Dequeue();
            while (q2.Any()) yield return q2.Dequeue();
        }

        static IEnumerable<T> MergeN<T>(params IEnumerable<T>[] sources) where T : IComparable
        {
            var queues = sources.Select(e => new Queue<T>(e)).Where(q => q.Any()).ToList();
            var headComparer = Comparer<Queue<T>>.Create((x, y) => x.Peek().CompareTo(y.Peek()));
            queues.Sort(headComparer);

            while (queues.Any())
            {
                var q = queues.First();
                queues.RemoveAt(0);
                yield return q.Dequeue();
                if (q.Any())
                {
                    var index = queues.BinarySearch(q, headComparer);
                    queues.Insert(index < 0 ? ~index : index, q);
                }
            }
        }

        static void Main()
        {
            var a = new[] { 1, 4, 7, 10 };
            var b = new[] { 2, 5, 8, 11 };
            var c = new[] { 3, 6, 9, 12 };

            foreach (var i in Merge2(a, b)) Console.Write($"{i} ");
            Console.WriteLine();

            foreach (var i in MergeN(a, b, c)) Console.Write($"{i} ");
            Console.WriteLine();
        }
    }
}


//#include <functional>
#include <iostream>
#include <vector>

template <typename C, typename A>
void merge2(const C& c1, const C& c2, const A& action) {
    auto i1 = std::cbegin(c1);
    auto i2 = std::cbegin(c2);

    while (i1 != std::cend(c1) && i2 != std::cend(c2)) {
        if (*i1 <= *i2) {
            action(*i1);
            i1 = std::next(i1);
        } else {
            action(*i2);
            i2 = std::next(i2);
        }
    }
    while (i1 != std::cend(c1)) {
        action(*i1);
        i1 = std::next(i1);
    }
    while (i2 != std::cend(c2)) {
        action(*i2);
        i2 = std::next(i2);
    }
}

template <typename A, typename C>
void mergeN(const A& action, std::initializer_list<C> all) {
    using I = typename C::const_iterator;
    using R = std::pair<I, I>;

    std::vector<R> vit;
    for (auto& c : all) {
        auto p = std::make_pair(std::cbegin(c), std::cend(c));
        vit.push_back(p);
    }

    bool done;
    R* least;
    do {
        done = true;

        auto it = vit.begin();
        auto end = vit.end();
        least = nullptr;

        // search for the first non-empty range to use for comparison
        while (it != end && it->first == it->second) {
            it++;
        }
        if (it != end) {
            least = &(*it);
        }
        while (it != end) {
            // search for the next non-empty range to use for comaprison
            while (it != end && it->first == it->second) {
                it++;
            }
            if (least != nullptr && it != end
                && it->first != it->second
                && *(it->first) < *(least->first)) {
                // found a smaller value
                least = &(*it);
            }
            if (it != end) {
                it++;
            }
        }
        if (least != nullptr && least->first != least->second) {
            done = false;
            action(*(least->first));
            least->first = std::next(least->first);
        }
    } while (!done);
}

void display(int num) {
    std::cout << num << ' ';
}

int main() {
    std::vector<int> v1{ 0, 3, 6 };
    std::vector<int> v2{ 1, 4, 7 };
    std::vector<int> v3{ 2, 5, 8 };

    merge2(v2, v1, display);
    std::cout << '\n';

    mergeN(display, { v1 });
    std::cout << '\n';

    mergeN(display, { v3, v2, v1 });
    std::cout << '\n';
}


import std.range.primitives;
import std.stdio;

// An output range for writing the elements of the example ranges
struct OutputWriter {
    void put(E)(E e) if (!isInputRange!E) {
        stdout.write(e);
    }
}

void main() {
    import std.range : only;
    merge2(OutputWriter(), only(1,3,5,7), only(2,4,6,8));
    writeln("\n---------------");
    mergeN(OutputWriter(), only(1,4,7), only(2,5,8), only(3,6,9));
    writeln("\n---------------");
    mergeN(OutputWriter(), only(1,2,3));
}

/+ Write the smallest element from r1 and r2 until both ranges are empty +/
void merge2(IN,OUT)(OUT sink, IN r1, IN r2)
if (isInputRange!IN && isOutputRange!(OUT, ElementType!IN)) {
    import std.algorithm : copy;

    while (!r1.empty && !r2.empty) {
        auto a = r1.front;
        auto b = r2.front;
        if (a<b) {
            sink.put(a);
            r1.popFront;
        } else {
            sink.put(b);
            r2.popFront;
        }
    }
    copy(r1, sink);
    copy(r2, sink);
}

/+ Write the smallest element from the sources until all ranges are empty +/
void mergeN(OUT,IN)(OUT sink, IN[] source ...)
if (isInputRange!IN && isOutputRange!(OUT, ElementType!IN)) {
    ElementType!IN value;
    bool done, hasValue;
    int idx;

    do {
        hasValue = false;
        done = true;
        idx = -1;

        foreach(i,r; source) {
            if (!r.empty) {
                if (hasValue) {
                    if (r.front < value) {
                        value = r.front;
                        idx = i;
                    }
                } else {
                    hasValue = true;
                    value = r.front;
                    idx = i;
                }
            }
        }

        if (idx > -1) {
            sink.put(source[idx].front);
            source[idx].popFront;
            done = false;
        }
    } while (!done);
}


defmodule StreamMerge do
  def merge2(file1, file2), do: mergeN([file1, file2])

  def mergeN(files) do
    Enum.map(files, fn fname -> File.open!(fname) end)
    |> Enum.map(fn fd -> {fd, IO.read(fd, :line)} end)
    |> merge_loop
  end

  defp merge_loop([]), do: :ok
  defp merge_loop(fdata) do
    {fd, min} = Enum.min_by(fdata, fn {_,head} -> head end)
    IO.write min
    case IO.read(fd, :line) do
      :eof -> File.close(fd)
              List.delete(fdata, {fd, min}) |> merge_loop
      head -> List.keyreplace(fdata, fd, 0, {fd, head}) |> merge_loop
    end
  end
end

filenames = ~w[temp1.dat temp2.dat temp3.dat]
Enum.each(filenames, fn fname ->
  IO.puts "#{fname}: " <> File.read!(fname) |> String.replace("\n", " ")
end)
IO.puts "\n2-stream merge:"
StreamMerge.merge2("temp1.dat", "temp2.dat")
IO.puts "\nN-stream merge:"
StreamMerge.mergeN(filenames)


      SUBROUTINE FILEMERGE(N,INF,OUTF)	!Merge multiple inputs into one output.
       INTEGER N	!The number of input files.
       INTEGER INF(*)	!Their unit numbers.
       INTEGER OUTF	!The output file.
       INTEGER L(N)	!The length of each current record.
       INTEGER LIST(0:N)!In sorted order.
       LOGICAL LIVE(N)	!Until end-of-file.
       INTEGER ENUFF		!As ever, how long is a piece of string?
       PARAMETER (ENUFF = 666)	!Perhaps this will suffice.
       CHARACTER*(ENUFF) AREC(N)!One for each input file.
       INTEGER I,IT	!Assistants.
        LIST = 0	!LIST(0) fingers the leader.
        LIVE = .TRUE.	!All files are presumed live.
Charge the battery.
        DO I = 1,N	!Taste each.
          CALL GRAB(I)		!By obtaining the first record.
        END DO		!Also, preparing the LIST.
Chug away.
        DO WHILE(LIST(0).GT.0)	!Have we a leader?
          IT = LIST(0)		!Yes. Which is it?
          WRITE (OUTF,"(A)") AREC(IT)(1:L(IT))	!Send it forth.
          LIST(0) = LIST(IT)	!Head to the leader's follower.
          CALL GRAB(IT)		!Get the next candidate.
        END DO			!Try again.

       CONTAINS	!An assistant, called in two places.
        SUBROUTINE GRAB(IN)	!Get another record.
         INTEGER IN		!From this input file.
         INTEGER IT,P		!Linked-list stepping.
          IF (.NOT.LIVE(IN)) RETURN	!No more grist?
          READ (INF(IN),1,END = 10) L(IN),AREC(IN)(1:MIN(ENUFF,L(IN)))	!Burp.
    1     FORMAT (Q,A)		!Q = "length remaining", obviously.
Consider the place of AREC(IN) in the LIST. Entry LIST(IN) is to be linked back in.
          P = 0		!Finger the head of the LIST.
    2     IT = LIST(P)		!Which supplier is fingered?
          IF (IT.GT.0) THEN	!If we're not at the end,
            IF (AREC(IN)(1:L(IN)).GT.AREC(IT)(1:L(IT))) THEN	!Compare.
              P = IT			!The incomer follows this node.
              GO TO 2			!So, move to IT and check afresh.
            END IF		!So much for the comparison.
          END IF	!The record from supplier IN is to precede that from IT, fingered by LIST(P).
          LIST(IN) = IT		!So, IN's follower is IT.
          LIST(P) = IN		!And P's follower is now IN.
          RETURN	!Done.
   10     LIVE(IN) = .FALSE.	!No further input.
          LIST(IN) = -666	!This will cause trouble if accessed.
        END SUBROUTINE GRAB	!Grab input, and jostle for position.
      END SUBROUTINE FILEMERGE	!Simple...

      PROGRAM MASH
      INTEGER MANY
      PARAMETER (MANY = 4)	!Sufficient?
      INTEGER FI(MANY)
      CHARACTER*(28) FNAME(MANY)
      DATA FNAME/"FileAppend.for","FileChop.for",
     1 "FileExt.for","FileHack.for"/
      INTEGER I,F

      F = 10	!Safely past pre-defined unit numbers.
      OPEN (F,FILE="Merged.txt",STATUS="REPLACE",ACTION="WRITE")	!File for output.
      DO I = 1,MANY	!Go for the input files.
        FI(I) = F + I		!Choose another unit number.
        OPEN (FI(I),FILE=FNAME(I),STATUS="OLD",ACTION="READ")	!Hope.
      END DO		!On to the next.

      CALL FILEMERGE(MANY,FI,F)	!E pluribus unum.

      END	!That was easy.


package main

import (
    "container/heap"
    "fmt"
    "io"
    "log"
    "os"
    "strings"
)

var s1 = "3 14 15"
var s2 = "2 17 18"
var s3 = ""
var s4 = "2 3 5 7"

func main() {
    fmt.Print("merge2: ")
    merge2(
        os.Stdout,
        strings.NewReader(s1),
        strings.NewReader(s2))
    fmt.Println()

    fmt.Print("mergeN: ")
    mergeN(
        os.Stdout,
        strings.NewReader(s1),
        strings.NewReader(s2),
        strings.NewReader(s3),
        strings.NewReader(s4))
    fmt.Println()
}

func r1(r io.Reader) (v int, ok bool) {
    switch _, err := fmt.Fscan(r, &v); {
    case err == nil:
        return v, true
    case err != io.EOF:
        log.Fatal(err)
    }
    return
}

func merge2(m io.Writer, s1, s2 io.Reader) {
    v1, d1 := r1(s1)
    v2, d2 := r1(s2)
    var v int
    for d1 || d2 {
        if !d2 || d1 && v1 < v2 {
            v = v1
            v1, d1 = r1(s1)
        } else {
            v = v2
            v2, d2 = r1(s2)
        }
        fmt.Fprint(m, v, " ")
    }
}

type sv struct {
    s io.Reader
    v int
}

type sh []sv

func (s sh) Len() int            { return len(s) }
func (s sh) Less(i, j int) bool  { return s[i].v < s[j].v }
func (s sh) Swap(i, j int)       { s[i], s[j] = s[j], s[i] }
func (p *sh) Push(x interface{}) { *p = append(*p, x.(sv)) }
func (p *sh) Pop() interface{} {
    s := *p
    last := len(s) - 1
    v := s[last]
    *p = s[:last]
    return v
}

func mergeN(m io.Writer, s ...io.Reader) {
    var h sh
    for _, s := range s {
        if v, d := r1(s); d {
            h = append(h, sv{s, v})
        }
    }
    heap.Init(&h)
    for len(h) > 0 {
        p := heap.Pop(&h).(sv)
        fmt.Fprint(m, p.v, " ")
        if v, d := r1(p.s); d {
            heap.Push(&h, sv{p.s, v})
        }
    }
}


-- stack runhaskell --package=conduit-extra --package=conduit-merge

import           Control.Monad.Trans.Resource (runResourceT)
import qualified Data.ByteString.Char8        as BS
import           Data.Conduit                 (($$), (=$=))
import           Data.Conduit.Binary          (sinkHandle, sourceFile)
import qualified Data.Conduit.Binary          as Conduit
import qualified Data.Conduit.List            as Conduit
import           Data.Conduit.Merge           (mergeSources)
import           System.Environment           (getArgs)
import           System.IO                    (stdout)

main :: IO ()
main = do
    inputFileNames <- getArgs
    let inputs = [sourceFile file =$= Conduit.lines | file <- inputFileNames]
    runResourceT $ mergeSources inputs $$ sinkStdoutLn
  where
    sinkStdoutLn = Conduit.map (`BS.snoc` '\n') =$= sinkHandle stdout


import java.util.Iterator;
import java.util.List;
import java.util.Objects;

public class StreamMerge {
    private static <T extends Comparable<T>> void merge2(Iterator<T> i1, Iterator<T> i2) {
        T a = null, b = null;

        while (i1.hasNext() || i2.hasNext()) {
            if (null == a && i1.hasNext()) {
                a = i1.next();
            }
            if (null == b && i2.hasNext()) {
                b = i2.next();
            }

            if (null != a) {
                if (null != b) {
                    if (a.compareTo(b) < 0) {
                        System.out.print(a);
                        a = null;
                    } else {
                        System.out.print(b);
                        b = null;
                    }
                } else {
                    System.out.print(a);
                    a = null;
                }
            } else if (null != b) {
                System.out.print(b);
                b = null;
            }
        }

        if (null != a) {
            System.out.print(a);
        }
        if (null != b) {
            System.out.print(b);
        }
    }

    @SuppressWarnings("unchecked")
    @SafeVarargs
    private static <T extends Comparable<T>> void mergeN(Iterator<T>... iter) {
        Objects.requireNonNull(iter);
        if (iter.length == 0) {
            throw new IllegalArgumentException("Must have at least one iterator");
        }

        Object[] pa = new Object[iter.length];
        boolean done;

        do {
            done = true;

            for (int i = 0; i < iter.length; i++) {
                Iterator<T> t = iter[i];
                if (null == pa[i] && t.hasNext()) {
                    pa[i] = t.next();
                }
            }

            T min = null;
            int idx = -1;
            for (int i = 0; i < pa.length; ++i) {
                T t = (T) pa[i];
                if (null != t) {
                    if (null == min) {
                        min = t;
                        idx = i;
                        done = false;
                    } else if (t.compareTo(min) < 0) {
                        min = t;
                        idx = i;
                        done = false;
                    }
                }
            }
            if (idx != -1) {
                System.out.print(min);
                pa[idx] = null;
            }
        } while (!done);
    }

    public static void main(String[] args) {
        List<Integer> l1 = List.of(1, 4, 7, 10);
        List<Integer> l2 = List.of(2, 5, 8, 11);
        List<Integer> l3 = List.of(3, 6, 9, 12);

        merge2(l1.iterator(), l2.iterator());
        System.out.println();

        mergeN(l1.iterator(), l2.iterator(), l3.iterator());
        System.out.println();
        System.out.flush();
    }
}


function merge(stream1, stream2, T=Char)
    if !eof(stream1) && !eof(stream2)
        b1 = read(stream1, T)
        b2 = read(stream2, T)
        while !eof(stream1) && !eof(stream2)
            if b1 <= b2
                print(b1)
                if !eof(stream1)
                    b1 = read(stream1, T)
                end
            else
                print(b2)
                if !eof(stream2)
                    b2 = read(stream2, T)
                end
            end
        end
        while !eof(stream1)
            print(b1)
            b1 = read(stream1, T)
        end
        print(b1)
        while !eof(stream2)
            print(b2)
            b2 = read(stream2, T)
        end
        print(b2)
    end
end

const halpha1 = "acegikmoqsuwy"
const halpha2 = "bdfhjlnprtvxz"
const buf1 = IOBuffer(halpha1)
const buf2 = IOBuffer(halpha2)

merge(buf1, buf2, Char)
println("\nDone.")


// version 1.2.21

import java.io.File

fun merge2(inputFile1: String, inputFile2: String, outputFile: String) {
    val file1 = File(inputFile1)
    val file2 = File(inputFile2)
    require(file1.exists() && file2.exists()) { "Both input files must exist" }
    val reader1 = file1.bufferedReader()
    val reader2 = file2.bufferedReader()
    val writer  = File(outputFile).printWriter()
    var line1 = reader1.readLine()
    var line2 = reader2.readLine()
    while (line1 != null && line2 != null) {
        if (line1 <= line2) {
            writer.println(line1)
            line1 = reader1.readLine()
        }
        else {
            writer.println(line2)
            line2 = reader2.readLine()
        }
    }
    while (line1 != null) {
        writer.println(line1)
        line1 = reader1.readLine()
    }
    while (line2 != null) {
        writer.println(line2)
        line2 = reader2.readLine()
    }
    reader1.close()
    reader2.close()
    writer.close()
}

fun mergeN(inputFiles: List<String>, outputFile: String) {
    val files = inputFiles.map { File(it) }
    require(files.all { it.exists() }) { "All input files must exist" }
    val readers = files.map { it.bufferedReader() }
    val writer  = File(outputFile).printWriter()
    var lines = readers.map { it.readLine() }.toMutableList()
    while (lines.any { it != null }) {
        val line = lines.filterNotNull().min()
        val index = lines.indexOf(line)
        writer.println(line)
        lines[index] = readers[index].readLine()
    }
    readers.forEach { it.close() }
    writer.close()
}

fun main(args:Array<String>) {
    val files = listOf("merge1.txt", "merge2.txt", "merge3.txt", "merge4.txt")
    merge2(files[0], files[1], "merged2.txt")
    mergeN(files, "mergedN.txt")
    // check it worked
    println(File("merged2.txt").readText())
    println(File("mergedN.txt").readText())
}


import streams,strutils
let
  stream1 = newFileStream("file1")
  stream2 = newFileStream("file2")
while not stream1.atEnd and not stream2.atEnd:
  echo (if stream1.peekLine.parseInt > stream2.peekLine.parseInt: stream2.readLine else: stream1.readLine)

for line in stream1.lines:
  echo line
for line in stream2.lines:
  echo line


use strict;
use warnings;
use English;
use String::Tokenizer;
use Heap::Simple;

my $stream1 = <<"END_STREAM_1";
Integer vel neque ligula. Etiam a ipsum a leo eleifend viverra sit amet ac
arcu. Suspendisse odio libero, ullamcorper eu sem vitae, gravida dignissim
ipsum. Aenean tincidunt commodo feugiat. Nunc viverra dolor a tincidunt porta.
Ut malesuada quis mauris eget vestibulum. Fusce sit amet libero id augue mattis
auctor et sit amet ligula.
END_STREAM_1

my $stream2 = <<"END_STREAM_2";
In luctus odio nulla, ut finibus elit aliquet in. In auctor vitae purus quis
tristique. Mauris sed erat pulvinar, venenatis lectus auctor, malesuada neque.
Integer a hendrerit tortor. Suspendisse aliquet pellentesque lorem, nec tincidunt
arcu aliquet non. Phasellus eu diam massa. Integer vitae volutpat augue. Nulla
condimentum consectetur ante, ut consequat lectus suscipit eget.
END_STREAM_2

my $stream3 = <<"END_STREAM_3";
In hendrerit eleifend mi nec ultricies. Vestibulum euismod, tellus sit amet
eleifend ultrices, velit nisi dignissim lectus, non vestibulum sem nisi sed mi.
Nulla scelerisque ut purus sed ultricies. Donec pulvinar eleifend malesuada. In
viverra faucibus enim a luctus. Vivamus tellus erat, congue quis quam in, lobortis
varius mi. Nulla ante orci, porttitor id dui ac, iaculis consequat ligula.
END_STREAM_3

my $stream4 = <<"END_STREAM_4";
Suspendisse elementum nunc ex, ac pulvinar mauris finibus sed. Ut non ex sed tortor
ultricies feugiat non at eros. Donec et scelerisque est. In vestibulum fringilla
metus eget varius. Aenean fringilla pellentesque massa, non ullamcorper mi commodo
non. Sed aliquam molestie congue. Nunc lobortis turpis at nunc lacinia, id laoreet
ipsum bibendum.
END_STREAM_4

my $stream5 = <<"END_STREAM_5";
Donec sit amet urna nulla. Duis nec consectetur lacus, et viverra ex. Aliquam
lobortis tristique hendrerit. Suspendisse viverra vehicula lorem id gravida.
Pellentesque at ligula lorem. Cras gravida accumsan lacus sit amet tincidunt.
Curabitur quam nisi, viverra vel nulla vel, rhoncus facilisis massa. Aliquam
erat volutpat.
END_STREAM_5

my $stream6 = <<"END_STREAM_6";
Curabitur nec enim eu nisi maximus suscipit rutrum non sem. Donec lobortis nulla
et rutrum bibendum. Duis varius, tellus in commodo gravida, lorem neque finibus
quam, sagittis elementum leo mauris sit amet justo. Sed vestibulum velit eget
sapien bibendum, sit amet porta lorem fringilla. Morbi bibendum in turpis ac
blandit. Mauris semper nibh nec dignissim dapibus. Proin sagittis lacus est.
END_STREAM_6

merge_two_streams(map {String::Tokenizer->new($ARG)->iterator()}
                      ($stream1, $stream2));
merge_N_streams(6, map {String::Tokenizer->new($ARG)->iterator()}
                       ($stream1, $stream2, $stream3,
                        $stream4, $stream5, $stream6));
exit 0;

sub merge_two_streams {
    my ($iter1, $iter2) = @ARG;
    print "Merge of 2 streams:\n";
    while (1) {
        if (!$iter1->hasNextToken() && !$iter2->hasNextToken()) {
            print "\n\n";
            last;
        }
        elsif (!$iter1->hasNextToken()) {
            print $iter2->nextToken(), q{ };
        }
        elsif (!$iter2->hasNextToken()) {
            print $iter1->nextToken(), q{ };
        }
        elsif ($iter1->lookAheadToken() lt $iter2->lookAheadToken()) {
            print $iter1->nextToken(), q{ };
        }
        else {
            print $iter2->nextToken(), q{ };
        }
    }
    return;
}

sub merge_N_streams {
    my $N = shift;
    print "Merge of $N streams:\n";
    my @iters = @ARG;
    my $heap = Heap::Simple->new(order => 'lt', elements => 'Array');
    for (my $i=0; $i<$N; $i++) {
        my $iter = $iters[$i];
        $iter->hasNextToken() or die "Each stream must have >= 1 element";
        $heap->insert([$iter->nextToken() . q{ }, $i]);
    }
    $heap->count == $N or die "Problem with initial population of heap";
    while (1) {
        my ($token, $iter_idx) = @{ $heap->extract_top };
        print $token;
        # Attempt to read the next element from the same iterator where we
        # obtained the element we just extracted.
        my $to_insert = _fetch_next_element($iter_idx, $N, @iters);
        if (! $to_insert) {
            print join('', map {$ARG->[0]} $heap->extract_all);
            last;
        }
        $heap->insert($to_insert);
    }
    return;
}

sub _fetch_next_element {
    my $starting_idx = shift; my $N = shift; my @iters = @ARG;
    # Go round robin through every iterator exactly once, returning the first
    # element on offer.
    my @round_robin_idxs =
        map {$ARG % $N} ($starting_idx .. $starting_idx + $N - 1);
    foreach my $iter_idx (@round_robin_idxs) {
        my $iter = $iters[$iter_idx];
        if ($iter->hasNextToken()) {
            return [$iter->nextToken() . q{ }, $iter_idx];
        }
    }
    # At this point every iterator has been exhausted.
    return;
}


without js -- file i/o
include builtins/pqueue.e

procedure add(integer fn, pq)
    object line = gets(fn)
    if line=-1 then
        close(fn)
    else
        pq_add({fn,line}, pq)
    end if
end procedure

-- setup (optional/remove if files already exist)
constant data = {"Line 001\nLine 008\nLine 017\n",
                 "Line 019\nLine 033\nLine 044\nLine 055\n",
                 "Line 019\nLine 029\nLine 039\n",
                 "Line 023\nLine 030\n"},
         filenames = {"file1.txt","file2.txt","file3.txt","file4.txt"}
                    -- (or command_line()[3..$] if you prefer)

for i=1 to length(filenames) do
    integer fn = open(filenames[i], "w")
    if fn<0 then crash("cannot open file") end if
    puts(fn, data[i])
    close(fn)
end for

-- initilisation
integer pq = pq_new()
for i=1 to length(filenames) do
    integer fn = open(filenames[i], "r")
    if fn<0 then crash("cannot open file") end if
    add(fn,pq)
end for

-- main loop
while not pq_empty(pq) do
    {integer fn, string line} = pq_pop(pq)
    puts(1,line)
    add(fn, pq)
end while
pq_destroy(pq)

-- cleanup (optional/remove if files already exist)
for i=1 to length(filenames) do
    {} = delete_file(filenames[i])
end for


(de streamMerge @
   (let Heap
      (make
         (while (args)
            (let? Fd (next)
               (if (in Fd (read))
                  (link (cons @ Fd))
                  (close Fd) ) ) ) )
      (make
         (while Heap
            (link (caar (setq Heap (sort Heap))))
            (if (in (cdar Heap) (read))
               (set (car Heap) @)
               (close (cdr (pop 'Heap))) ) ) ) ) )


import heapq
import sys

sources = sys.argv[1:]
for item in heapq.merge(open(source) for source in sources):
    print(item)


;; This module produces a sequence that merges streams in order (by <)
#lang racket/base
(require racket/stream)

(define-values (tl-first tl-rest tl-empty?)
  (values stream-first stream-rest stream-empty?))

(define-struct merged-stream (< ss v ss′)
  #:mutable ; sadly, so we don't have to redo potentially expensive <
  #:methods gen:stream
  [(define (stream-empty? S)
     ;; andmap defined to be true when ss is null
     (andmap tl-empty? (merged-stream-ss S)))

   (define (cache-next-head S)
     (unless (box? (merged-stream-v S))
       (define < (merged-stream-< S))
       (define ss (merged-stream-ss S))
       (define-values (best-f best-i)
         (for/fold ((F #f) (I 0)) ((s (in-list ss)) (i (in-naturals)))
           (if (tl-empty? s) (values F I)
               (let ((f (tl-first s)))
                 (if (or (not F) (< f (unbox F))) (values (box f) i) (values F I))))))
       (set-merged-stream-v! S best-f)
       (define ss′ (for/list ((s ss) (i (in-naturals)) #:unless (tl-empty? s))
                     (if (= i best-i) (tl-rest s) s)))
       (set-merged-stream-ss′! S ss′))
     S)

   (define (stream-first S)
     (cache-next-head S)
     (unbox (merged-stream-v S)))

   (define (stream-rest S)
     (cache-next-head S)
     (struct-copy merged-stream S [ss (merged-stream-ss′ S)] [v #f]))])

(define ((merge-sequences <) . sqs)
  (let ((strms (map sequence->stream sqs)))
    (merged-stream < strms #f #f)))

;; ---------------------------------------------------------------------------------------------------
(module+ main
  (require racket/string)
  ;; there are file streams and all sorts of other streams -- we can even read lines from strings
  (for ((l ((merge-sequences string<?)
            (in-lines (open-input-string "aardvark
dog
fox"))
            (in-list (string-split "cat donkey elephant"))
            (in-port read (open-input-string #<<<
"boy"
"emu"
"monkey"
<
                                             )))))
    (displayln l)))

;; ---------------------------------------------------------------------------------------------------
(module+ test
  (require rackunit)
  (define merge-sequences/< (merge-sequences <))

  (check-equal?
   (for/list ((i (in-stream (merge-sequences/< (in-list '(1 3 5)))))) i)
   '(1 3 5))
  ;; in-stream (and in-list) is optional (but may increase performance)
  (check-equal? (for/list ((i (merge-sequences/<))) i) null)
  (check-equal? (for/list ((i (merge-sequences/< '(1 3 5) '(2 4 6)))) i) '(1 2 3 4 5 6))
  (check-equal? (for/list ((i (merge-sequences/< '(1 3 5) '(2 4 6 7 8 9 10)))) i)
                '(1 2 3 4 5 6 7 8 9 10))
  (check-equal? (for/list ((i (merge-sequences/< '(2 4 6 7 8 9 10) '(1 3 5)))) i)
                '(1 2 3 4 5 6 7 8 9 10)))


/* REXX ***************************************************************
* Merge 1.txt ... n.txt into all.txt
* 1.txt 2.txt 3.txt 4.txt
* 1     19    1999  2e3
* 17    33    2999  3000
* 8     500   3999              RC task STREAM MERGE
**********************************************************************/
done.=0                         /* done.i=1 indicates file exhausted */
p.=''                                  /* for test of sort error     */
Do i=1 By 1                            /* check files for existence  */
  f.i=i'.txt'
  If lines(f.i)=0 Then Leave
  Call get i                           /* and read first line of each*/
  End
n=i-1                                  /* we have n input files      */
done.0=n                               /* and all must be used       */
say n 'Input files'
oid='all.txt'
If lines(oid)>0 Then Do                /* output file exists         */
  Call lineout oid
  Do Until wordpos(answer,'Y N')>0
    Say 'file' oid 'exists. May it be replaced?'
    Pull answer
    End
  If answer='Y' Then
    'erase' oid
  Else Do
    Say 'Ok, we give up'
    Exit
    End
  End
say oid 'is the output file'           /* we'll create it now        */
Do Until done.0=0
  imin=0                               /* index of next source       */
  Do i=1 To n
    If done.i=0 Then Do                /* file i still in use        */
      If imin=0 Then Do                /* it's the first in this loop*/
        imin=i                         /* next source                */
        min=x.i                        /* element to be used         */
        End
      Else Do                          /* not the first              */
        If x.i<<min Then Do            /* avoid numerical comparison */
          imin=i                       /* next source                */
          min=x.i                      /* element to be used         */
          End
        End
      End
    End
  If imin<>0 Then Do                   /* found next source          */
    Call o x.imin                      /* use its element            */
    Call get imin                      /* get next element           */
                                       /* or set done.imin           */
    End
  Else                                 /* no more elements           */
    Call lineout oid                   /* close output file          */
  End
'type' oid
Exit

get: Procedure Expose f. x. p. done.
/*********************************************************************
* Get next element from file ii or set done.ii=1 if file is exhausted
*********************************************************************/
  Parse Arg ii
  If lines(f.ii)=0 Then Do             /* file ii is exhausted      */
    done.ii=1                          /* mark it as done           */
    done.0=done.0-1                    /* reduce number of files tbd*/
    End
  Else Do                              /* there's more in file ii   */
    x.ii=linein(f.ii)                  /* get next element (line)   */
    If x.ii<<p.ii Then Do              /* smaller than previous     */
      Say 'Input file' f.ii 'is not sorted ascendingly'
      Say p.ii 'precedes' x.ii         /* tell the user             */
      Exit                             /* and give up               */
      End
    p.ii=x.ii                          /* remember the element      */
    End
  Return

o: Return lineout(oid,arg(1))


sub merge_streams ( @streams ) {
    my @s = @streams.map({ hash( STREAM => $_, HEAD => .get ) })\
                    .grep({ .<HEAD>.defined });

    return gather while @s {
        my $h = @s.min: *.<HEAD>;
        take $h<HEAD>;
        $h<HEAD> := $h<STREAM>.get
            orelse @s .= grep( { $_ !=== $h } );
    }
}

say merge_streams([ @*ARGS».&open ]);


def stream_merge(*files)
  fio = files.map{|fname| open(fname)}
  merge(fio.map{|io| [io, io.gets]})
end

def merge(fdata)
  until fdata.empty?
    io, min = fdata.min_by{|_,data| data}
    puts min
    if (next_data = io.gets).nil?
      io.close
      fdata.delete([io, min])
    else
      i = fdata.index{|x,_| x == io}
      fdata[i] = [io, next_data]
    end
  end
end

files = %w(temp1.dat temp2.dat temp3.dat)
files.each do |fname|
  data = IO.read(fname).gsub("\n", " ")
  puts "#{fname}: #{data}"
end
stream_merge(*files)


def mergeN[A : Ordering](is: Iterator[A]*): Iterator[A] = is.reduce((a, b) => merge2(a, b))

def merge2[A : Ordering](i1: Iterator[A], i2: Iterator[A]): Iterator[A] = {
  merge2Buffered(i1.buffered, i2.buffered)
}

def merge2Buffered[A](i1: BufferedIterator[A], i2: BufferedIterator[A])(implicit ord: Ordering[A]): Iterator[A] = {
  if (!i1.hasNext) {
    i2
  } else if (!i2.hasNext) {
    i1
  } else {
    val nextHead = if (ord.lt(i1.head, i2.head)) {
      Iterator.single(i1.next)
    } else {
      Iterator.single(i2.next)
    }
    nextHead ++ merge2Buffered(i1, i2)
  }
}


func merge_streams(streams) {
    var s = streams.map { |stream|
        Pair(stream, stream.readline)
    }.grep {|p| defined(p.value) }

    gather {
        while (s) {
            var p = s.min_by { .value }
            take(p.value)
            p.value = (p.key.readline \\ s.delete_if { _ == p })
        }
    }
}

say merge_streams(ARGV.map {|f| File(f).open_r }).join("\n")


#!/usr/bin/env tclsh
proc merge {args} {
    set peeks {}
    foreach chan $args {
        if {[gets $chan peek] > 0} {
            dict set peeks $chan $peek
        }
    }
    set peeks [lsort -stride 2 -index 1 $peeks]
    while {[dict size $peeks]} {
        set peeks [lassign $peeks chan peek]
        puts $peek
        if {[gets $chan peek] > 0} {
            dict set peeks $chan $peek
            set peeks [lsort -stride 2 -index 1 $peeks]
        }
    }
}

merge {*}[lmap f $::argv {open $f r}]


sort --merge source1 source2 sourceN > sink


import "io" for File
import "/ioutil" for FileUtil
import "/str" for Str
import "/seq" for Lst

var merge2 = Fn.new { |inputFile1, inputFile2, outputFile|
    // Note that the FileUtil.readEachLine method checks the file exists and closes it
    // when there are no more lines to read.
    var reader1 = Fiber.new(FileUtil.readEachLine(inputFile1))
    var reader2 = Fiber.new(FileUtil.readEachLine(inputFile2))
    var writer = File.create(outputFile)
    var line1 = reader1.call()
    var line2 = reader2.call()
    while (line1 && line2) {
        if (Str.le(line1, line2)) {
            writer.writeBytes(line1 + "\n")
            line1 = reader1.call()
        } else {
            writer.writeBytes(line2 + "\n")
            line2 = reader2.call()
        }
    }
    while (line1) {
       writer.writeBytes(line1 + "\n")
       line1 = reader1.call()
    }
    while (line2) {
       writer.writeBytes(line2 + "\n")
       line2 = reader2.call()
    }
    writer.close()
}

var mergeN = Fn.new { |inputFiles, outputFile|
    var readers = inputFiles.map { |f| Fiber.new(FileUtil.readEachLine(f)) }.toList
    var writer = File.create(outputFile)
    var lines = readers.map { |reader| reader.call() }.toList
    while (lines.any { |line| line }) {
        var line = lines.where { |line| line }.reduce() { |acc, s| Str.lt(s, acc) ? s : acc }
        var index = Lst.indexOf(lines, line)
        writer.writeBytes(line + "\n")
        lines[index] = readers[index].call()
    }
    writer.close()
}

var files = ["merge1.txt", "merge2.txt", "merge3.txt", "merge4.txt"]
merge2.call(files[0], files[1], "merged2.txt")
mergeN.call(files, "mergedN.txt")
// check it worked
System.print(File.read("merged2.txt"))
System.print(File.read("mergedN.txt"))


fcn mergeStreams(s1,s2,etc){  //-->Walker
   streams:=vm.arglist.pump(List(),fcn(s){ // prime and prune
      if( (w:=s.walker())._next() ) return(w);
      Void.Skip		// stream is dry
   });
   Walker().tweak(fcn(streams){
      if(not streams) return(Void.Stop);  // all streams are dry
      values:=streams.apply("value");	  // head of the streams
      v:=values.reduce('wrap(min,x){ if(min<=x) min else x });
      n:=values.find(v); w:=streams[n]; w._next();  // read next value from min stream
      if(w.atEnd) streams.del(n); // prune empty streams
      v
   }.fp(streams));
}


package main

import (
    "fmt"
    "log"
    "math"
)

type Matrix [][]float64

func (m Matrix) rows() int { return len(m) }
func (m Matrix) cols() int { return len(m[0]) }

func (m Matrix) add(m2 Matrix) Matrix {
    if m.rows() != m2.rows() || m.cols() != m2.cols() {
        log.Fatal("Matrices must have the same dimensions.")
    }
    c := make(Matrix, m.rows())
    for i := 0; i < m.rows(); i++ {
        c[i] = make([]float64, m.cols())
        for j := 0; j < m.cols(); j++ {
            c[i][j] = m[i][j] + m2[i][j]
        }
    }
    return c
}

func (m Matrix) sub(m2 Matrix) Matrix {
    if m.rows() != m2.rows() || m.cols() != m2.cols() {
        log.Fatal("Matrices must have the same dimensions.")
    }
    c := make(Matrix, m.rows())
    for i := 0; i < m.rows(); i++ {
        c[i] = make([]float64, m.cols())
        for j := 0; j < m.cols(); j++ {
            c[i][j] = m[i][j] - m2[i][j]
        }
    }
    return c
}

func (m Matrix) mul(m2 Matrix) Matrix {
    if m.cols() != m2.rows() {
        log.Fatal("Cannot multiply these matrices.")
    }
    c := make(Matrix, m.rows())
    for i := 0; i < m.rows(); i++ {
        c[i] = make([]float64, m2.cols())
        for j := 0; j < m2.cols(); j++ {
            for k := 0; k < m2.rows(); k++ {
                c[i][j] += m[i][k] * m2[k][j]
            }
        }
    }
    return c
}

func (m Matrix) toString(p int) string {
    s := make([]string, m.rows())
    pow := math.Pow(10, float64(p))
    for i := 0; i < m.rows(); i++ {
        t := make([]string, m.cols())
        for j := 0; j < m.cols(); j++ {
            r := math.Round(m[i][j]*pow) / pow
            t[j] = fmt.Sprintf("%g", r)
            if t[j] == "-0" {
                t[j] = "0"
            }
        }
        s[i] = fmt.Sprintf("%v", t)
    }
    return fmt.Sprintf("%v", s)
}

func params(r, c int) [4][6]int {
    return [4][6]int{
        {0, r, 0, c, 0, 0},
        {0, r, c, 2 * c, 0, c},
        {r, 2 * r, 0, c, r, 0},
        {r, 2 * r, c, 2 * c, r, c},
    }
}

func toQuarters(m Matrix) [4]Matrix {
    r := m.rows() / 2
    c := m.cols() / 2
    p := params(r, c)
    var quarters [4]Matrix
    for k := 0; k < 4; k++ {
        q := make(Matrix, r)
        for i := p[k][0]; i < p[k][1]; i++ {
            q[i-p[k][4]] = make([]float64, c)
            for j := p[k][2]; j < p[k][3]; j++ {
                q[i-p[k][4]][j-p[k][5]] = m[i][j]
            }
        }
        quarters[k] = q
    }
    return quarters
}

func fromQuarters(q [4]Matrix) Matrix {
    r := q[0].rows()
    c := q[0].cols()
    p := params(r, c)
    r *= 2
    c *= 2
    m := make(Matrix, r)
    for i := 0; i < c; i++ {
        m[i] = make([]float64, c)
    }
    for k := 0; k < 4; k++ {
        for i := p[k][0]; i < p[k][1]; i++ {
            for j := p[k][2]; j < p[k][3]; j++ {
                m[i][j] = q[k][i-p[k][4]][j-p[k][5]]
            }
        }
    }
    return m
}

func strassen(a, b Matrix) Matrix {
    if a.rows() != a.cols() || b.rows() != b.cols() || a.rows() != b.rows() {
        log.Fatal("Matrices must be square and of equal size.")
    }
    if a.rows() == 0 || (a.rows()&(a.rows()-1)) != 0 {
        log.Fatal("Size of matrices must be a power of two.")
    }
    if a.rows() == 1 {
        return a.mul(b)
    }
    qa := toQuarters(a)
    qb := toQuarters(b)
    p1 := strassen(qa[1].sub(qa[3]), qb[2].add(qb[3]))
    p2 := strassen(qa[0].add(qa[3]), qb[0].add(qb[3]))
    p3 := strassen(qa[0].sub(qa[2]), qb[0].add(qb[1]))
    p4 := strassen(qa[0].add(qa[1]), qb[3])
    p5 := strassen(qa[0], qb[1].sub(qb[3]))
    p6 := strassen(qa[3], qb[2].sub(qb[0]))
    p7 := strassen(qa[2].add(qa[3]), qb[0])
    var q [4]Matrix
    q[0] = p1.add(p2).sub(p4).add(p6)
    q[1] = p4.add(p5)
    q[2] = p6.add(p7)
    q[3] = p2.sub(p3).add(p5).sub(p7)
    return fromQuarters(q)
}

func main() {
    a := Matrix{{1, 2}, {3, 4}}
    b := Matrix{{5, 6}, {7, 8}}
    c := Matrix{{1, 1, 1, 1}, {2, 4, 8, 16}, {3, 9, 27, 81}, {4, 16, 64, 256}}
    d := Matrix{{4, -3, 4.0 / 3, -1.0 / 4}, {-13.0 / 3, 19.0 / 4, -7.0 / 3, 11.0 / 24},
        {3.0 / 2, -2, 7.0 / 6, -1.0 / 4}, {-1.0 / 6, 1.0 / 4, -1.0 / 6, 1.0 / 24}}
    e := Matrix{{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}, {13, 14, 15, 16}}
    f := Matrix{{1, 0, 0, 0}, {0, 1, 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}}
    fmt.Println("Using 'normal' matrix multiplication:")
    fmt.Printf("  a * b = %v\n", a.mul(b))
    fmt.Printf("  c * d = %v\n", c.mul(d).toString(6))
    fmt.Printf("  e * f = %v\n", e.mul(f))
    fmt.Println("\nUsing 'Strassen' matrix multiplication:")
    fmt.Printf("  a * b = %v\n", strassen(a, b))
    fmt.Printf("  c * d = %v\n", strassen(c, d).toString(6))
    fmt.Printf("  e * f = %v\n", strassen(e, f))
}


"""
Strassen's matrix multiplication algorithm.
Use dynamic padding in order to reduce required auxiliary memory.
"""
function strassen(x::Matrix, y::Matrix)
    # Check that the sizes of these matrices match.
    (r1, c1) = size(x)
    (r2, c2) = size(y)
    if c1 != r2
        error("Multiplying $r1 x $c1 and $r2 x $c2 matrix: dimensions do not match.")
    end

    # Put a matrix into the top left of a matrix of zeros.
    # `rows` and `cols` are the dimensions of the output matrix.
    function embed(mat, rows, cols)
        # If the matrix is already of the right dimensions, don't allocate new memory.
        (r, c) = size(mat)
        if (r, c) == (rows, cols)
            return mat
        end

        # Pad the matrix with zeros to be the right size.
        out = zeros(Int, rows, cols)
        out[1:r, 1:c] = mat
        out
    end

    # Make sure both matrices are the same size.
    # This is exclusively for simplicity:
    # this algorithm can be implemented with matrices of different sizes.
    r = max(r1, r2); c = max(c1, c2)
    x = embed(x, r, c)
    y = embed(y, r, c)

    # Our recursive multiplication function.
    function block_mult(a, b, rows, cols)
        # For small matrices, resort to naive multiplication.
#       if rows <= 128 || cols <= 128
        if rows == 1 && cols == 1
#       if rows == 2 && cols == 2
            return a * b
        end

        # Apply dynamic padding.
        if rows % 2 == 1 && cols % 2 == 1
            a = embed(a, rows + 1, cols + 1)
            b = embed(b, rows + 1, cols + 1)
        elseif rows % 2 == 1
            a = embed(a, rows + 1, cols)
            b = embed(b, rows + 1, cols)
        elseif cols % 2 == 1
            a = embed(a, rows, cols + 1)
            b = embed(b, rows, cols + 1)
        end

        half_rows = Int(size(a, 1) / 2)
        half_cols = Int(size(a, 2) / 2)

        # Subdivide input matrices.
        a11 = a[1:half_rows, 1:half_cols]
        b11 = b[1:half_rows, 1:half_cols]

        a12 = a[1:half_rows, half_cols+1:size(a, 2)]
        b12 = b[1:half_rows, half_cols+1:size(a, 2)]

        a21 = a[half_rows+1:size(a, 1), 1:half_cols]
        b21 = b[half_rows+1:size(a, 1), 1:half_cols]

        a22 = a[half_rows+1:size(a, 1), half_cols+1:size(a, 2)]
        b22 = b[half_rows+1:size(a, 1), half_cols+1:size(a, 2)]

        # Compute intermediate values.
        multip(x, y) = block_mult(x, y, half_rows, half_cols)
        m1 = multip(a11 + a22, b11 + b22)
        m2 = multip(a21 + a22, b11)
        m3 = multip(a11, b12 - b22)
        m4 = multip(a22, b21 - b11)
        m5 = multip(a11 + a12, b22)
        m6 = multip(a21 - a11, b11 + b12)
        m7 = multip(a12 - a22, b21 + b22)

        # Combine intermediate values into the output.
        c11 = m1 + m4 - m5 + m7
        c12 = m3 + m5
        c21 = m2 + m4
        c22 = m1 - m2 + m3 + m6

        # Crop output to the desired size (undo dynamic padding).
        out = [c11 c12; c21 c22]
        out[1:rows, 1:cols]
    end

    block_mult(x, y, r, c)
end

const A = [[1, 2] [3, 4]]
const B = [[5, 6] [7, 8]]
const C = [[1, 1, 1, 1] [2, 4, 8, 16] [3, 9, 27, 81] [4, 16, 64, 256]]
const D = [[4, -3, 4/3, -1/4] [-13/3, 19/4, -7/3, 11/24] [3/2, -2, 7/6, -1/4] [-1/6, 1/4, -1/6, 1/24]]
const E = [[1, 2, 3, 4] [5, 6, 7, 8] [9, 10, 11, 12] [13, 14, 15, 16]]
const F = [[1, 0, 0, 0] [0, 1, 0, 0] [0, 0, 1, 0] [0, 0, 0, 1]]

""" For pretty printing: change matrix to integer if it is within 0.00000001 of an integer """
intprint(s, mat) = println(s, map(x -> Int(round(x, digits=8)), mat)')

intprint("Regular multiply: ", A' * B')
intprint("Strassen multiply: ", strassen(Matrix(A'), Matrix(B')))
intprint("Regular multiply: ", C * D)
intprint("Strassen multiply: ", strassen(C, D))
intprint("Regular multiply: ", E * F)
intprint("Strassen multiply: ", strassen(E, F))

const r = sqrt(2)/2
const R = [[r, r] [-r, r]]

intprint("Regular multiply: ", R * R)
intprint("Strassen multiply: ", strassen(R,R))


import math, sequtils, strutils

type Matrix = seq[seq[float]]

template rows(m: Matrix): Positive = m.len
template cols(m: Matrix): Positive = m[0].len

func `+`(m1, m2: Matrix): Matrix =
  doAssert m1.rows == m2.rows and m1.cols == m2.cols, "Matrices must have the same dimensions."
  result = newSeqWith(m1.rows, newSeq[float](m1.cols))
  for i in 0..<m1.rows:
    for j in 0..<m1.cols:
      result[i][j] = m1[i][j] + m2[i][j]

func `-`(m1, m2: Matrix): Matrix =
  doAssert m1.rows == m2.rows and m1.cols == m2.cols, "Matrices must have the same dimensions."
  result = newSeqWith(m1.rows, newSeq[float](m1.cols))
  for i in 0..<m1.rows:
    for j in 0..<m1.cols:
      result[i][j] = m1[i][j] - m2[i][j]

func `*`(m1, m2: Matrix): Matrix =
  doAssert m1.cols == m2.rows, "Cannot multiply these matrices."
  result = newSeqWith(m1.rows, newSeq[float](m2.cols))
  for i in 0..<m1.rows:
    for j in 0..<m2.cols:
      for k in 0..<m2.rows:
        result[i][j] += m1[i][k] * m2[k][j]

func toString(m: Matrix; p: Natural): string =
  ## Round all elements to 'p' places.
  var res: seq[string]
  let pow = 10.0^p
  for row in m:
    var line: seq[string]
    for val in row:
      let r = round(val * pow) / pow
      var s = r.formatFloat(precision = -1)
      if s == "-0": s = "0"
      line.add s
    res.add '[' & line.join(" ") & ']'
  result = '[' & res.join(" ") & ']'

func params(r, c: int): array[4, array[6, int]] =
  [[0, r, 0, c, 0, 0],
   [0, r, c, 2 * c, 0, c],
   [r, 2 * r, 0, c, r, 0],
   [r, 2 * r, c, 2 * c, r, c]]

func toQuarters(m: Matrix): array[4, Matrix] =
  let
    r = m.rows() div 2
    c = m.cols() div 2
    p = params(r, c)
  for k in 0..3:
    var q = newSeqWith(r, newSeq[float](c))
    for i in p[k][0]..<p[k][1]:
      for j in p[k][2]..<p[k][3]:
        q[i-p[k][4]][j-p[k][5]] = m[i][j]
    result[k] = move(q)

func fromQuarters(q: array[4, Matrix]): Matrix =
  var
    r = q[0].rows
    c = q[0].cols
  let p = params(r, c)
  r *= 2
  c *= 2
  result = newSeqWith(r, newSeq[float](c))
  for k in 0..3:
    for i in p[k][0]..<p[k][1]:
      for j in p[k][2]..<p[k][3]:
        result[i][j] = q[k][i-p[k][4]][j-p[k][5]]

func strassen(a, b: Matrix): Matrix =
  doAssert a.rows == a.cols() and b.rows == b.cols and a.rows == b.rows,
           "Matrices must be square and of equal size."
  doAssert a.rows != 0 and (a.rows and (a.rows-1)) == 0,
           "Size of matrices must be a power of two."
  if a.rows == 1: return a * b

  let
    qa = a.toQuarters()
    qb = b.toQuarters()
    p1 = strassen(qa[1] - qa[3], qb[2] + qb[3])
    p2 = strassen(qa[0] + qa[3], qb[0] + qb[3])
    p3 = strassen(qa[0] - qa[2], qb[0] + qb[1])
    p4 = strassen(qa[0] + qa[1], qb[3])
    p5 = strassen(qa[0], qb[1] - qb[3])
    p6 = strassen(qa[3], qb[2] - qb[0])
    p7 = strassen(qa[2] + qa[3], qb[0])

  var q: array[4, Matrix]
  q[0] = p1 + p2 - p4 + p6
  q[1] = p4 + p5
  q[2] = p6 + p7
  q[3] = p2 - p3 + p5 - p7
  result = fromQuarters(q)

when isMainModule:
  let
    a = @[@[float 1, 2],
          @[float 3, 4]]
    b = @[@[float 5, 6],
          @[float 7, 8]]
    c = @[@[float 1, 1, 1, 1],
          @[float 2, 4, 8, 16],
          @[float 3, 9, 27, 81],
          @[float 4, 16, 64, 256]]
    d = @[@[4.0, -3, 4/3, -1/4],
          @[-13/3, 19/4, -7/3, 11/24],
          @[3/2, -2, 7/6, -1/4],
          @[-1/6, 1/4, -1/6, 1/24]]
    e = @[@[float 1, 2, 3, 4],
          @[float 5, 6, 7, 8],
          @[float 9, 10, 11, 12],
          @[float 13, 14, 15, 16]]
    f = @[@[float 1, 0, 0, 0],
          @[float 0, 1, 0, 0],
          @[float 0, 0, 1, 0],
          @[float 0, 0, 0, 1]]

  echo "Using 'normal' matrix multiplication:"
  echo "  a * b = ", (a * b).toString(10)
  echo "  c * d = ", (c * d).toString(6)
  echo "  e * f = ", (e * f).toString(10)

  echo "\nUsing 'Strassen' matrix multiplication:"
  echo "  a * b = ", strassen(a, b).toString(10)
  echo "  c * d = ", strassen(c, d).toString(6)
  echo "  e * f = ", strassen(e, f).toString(10)


with javascript_semantics
function strassen(sequence a, b)
    integer l = length(a)
    if length(a[1])!=l
    or length(b)!=l
    or length(b[1])!=l then
        crash("two equal square matrices only")
    end if
    if l=1 then return sq_mul(a,b) end if
    if remainder(l,1) then
        crash("2^n matrices only")
    end if
    integer h = l/2
    sequence {a11,a12,a21,a22,b11,b12,b21,b22} = repeat(repeat(repeat(0,h),h),8)
    for i=1 to h do
        for j=1 to h do
            a11[i][j] = a[i][j]
            a12[i][j] = a[i][j+h]
            a21[i][j] = a[i+h][j]
            a22[i][j] = a[i+h][j+h]
            b11[i][j] = b[i][j]
            b12[i][j] = b[i][j+h]
            b21[i][j] = b[i+h][j]
            b22[i][j] = b[i+h][j+h]
        end for
    end for
    sequence p1 = strassen(sq_sub(a12,a22), sq_add(b21,b22)),
             p2 = strassen(sq_add(a11,a22), sq_add(b11,b22)),
             p3 = strassen(sq_sub(a11,a21), sq_add(b11,b12)),
             p4 = strassen(sq_add(a11,a12), b22),
             p5 = strassen(a11, sq_sub(b12,b22)),
             p6 = strassen(a22, sq_sub(b21,b11)),
             p7 = strassen(sq_add(a21,a22), b11),

             c11 = sq_add(sq_sub(sq_add(p1,p2),p4),p6),
             c12 = sq_add(p4,p5),
             c21 = sq_add(p6,p7),
             c22 = sq_sub(sq_add(sq_sub(p2,p3),p5),p7),
             c = repeat(repeat(0,l),l)
    for i=1 to h do
        for j=1 to h do
            c[i][j] = c11[i][j]
            c[i][j+h] = c12[i][j]
            c[i+h][j] = c21[i][j]
            c[i+h][j+h] = c22[i][j]
        end for
    end for
    return c
end function

ppOpt({pp_Nest,1,pp_IntFmt,"%3d",pp_FltFmt,"%3.0f",pp_IntCh,false})

constant A = {{1,2},
              {3,4}},
         B = {{5,6},
              {7,8}}
pp(strassen(A,B))

constant C = { { 1,  1,  1,   1 },
               { 2,  4,  8,  16 },
               { 3,  9, 27,  81 },
               { 4, 16, 64, 256 }},
         D = { {    4,   -3,  4/3, -1/ 4 },
               {-13/3, 19/4, -7/3, 11/24 },
               {  3/2,   -2,  7/6, -1/ 4 },
               { -1/6,  1/4, -1/6,  1/24 }}
pp(strassen(C,D))

constant F = {{ 1, 2, 3, 4},
              { 5, 6, 7, 8},
              { 9,10,11,12},
              {13,14,15,16}},
         G = {{1, 0, 0, 0},
              {0, 1, 0, 0},
              {0, 0, 1, 0},
              {0, 0, 0, 1}}
pp(strassen(F,G))

constant r = sqrt(2)/2,
         R = {{ r,r},
              {-r,r}}
pp(strassen(R,R))


"""Matrix multiplication using Strassen's algorithm. Requires Python >= 3.7."""

from __future__ import annotations
from itertools import chain
from typing import List
from typing import NamedTuple
from typing import Optional

class Shape(NamedTuple):
    rows: int
    cols: int

class Matrix(List):
    """A matrix implemented as a two-dimensional list."""

    @classmethod
    def block(cls, blocks) -> Matrix:
        """Return a new Matrix assembled from nested blocks."""
        m = Matrix()
        for hblock in blocks:
            for row in zip(*hblock):
                m.append(list(chain.from_iterable(row)))

        return m

    def dot(self, b: Matrix) -> Matrix:
        """Return a new Matrix that is the product of this matrix and matrix `b`.
        Uses 'simple' or 'naive' matrix multiplication."""
        assert self.shape.cols == b.shape.rows
        m = Matrix()
        for row in self:
            new_row = []
            for c in range(len(b[0])):
                col = [b[r][c] for r in range(len(b))]
                new_row.append(sum(x * y for x, y in zip(row, col)))
            m.append(new_row)
        return m

    def __matmul__(self, b: Matrix) -> Matrix:
        return self.dot(b)

    def __add__(self, b: Matrix) -> Matrix:
        """Matrix addition."""
        assert self.shape == b.shape
        rows, cols = self.shape
        return Matrix(
            [[self[i][j] + b[i][j] for j in range(cols)] for i in range(rows)]
        )

    def __sub__(self, b: Matrix) -> Matrix:
        """Matrix subtraction."""
        assert self.shape == b.shape
        rows, cols = self.shape
        return Matrix(
            [[self[i][j] - b[i][j] for j in range(cols)] for i in range(rows)]
        )

    def strassen(self, b: Matrix) -> Matrix:
        """Return a new Matrix that is the product of this matrix and matrix `b`.
        Uses strassen algorithm."""
        rows, cols = self.shape

        assert rows == cols, "matrices must be square"
        assert self.shape == b.shape, "matrices must be the same shape"
        assert rows and (rows & rows - 1) == 0, "shape must be a power of 2"

        if rows == 1:
            return self.dot(b)

        p = rows // 2  # partition

        a11 = Matrix([n[:p] for n in self[:p]])
        a12 = Matrix([n[p:] for n in self[:p]])
        a21 = Matrix([n[:p] for n in self[p:]])
        a22 = Matrix([n[p:] for n in self[p:]])

        b11 = Matrix([n[:p] for n in b[:p]])
        b12 = Matrix([n[p:] for n in b[:p]])
        b21 = Matrix([n[:p] for n in b[p:]])
        b22 = Matrix([n[p:] for n in b[p:]])

        m1 = (a11 + a22).strassen(b11 + b22)
        m2 = (a21 + a22).strassen(b11)
        m3 = a11.strassen(b12 - b22)
        m4 = a22.strassen(b21 - b11)
        m5 = (a11 + a12).strassen(b22)
        m6 = (a21 - a11).strassen(b11 + b12)
        m7 = (a12 - a22).strassen(b21 + b22)

        c11 = m1 + m4 - m5 + m7
        c12 = m3 + m5
        c21 = m2 + m4
        c22 = m1 - m2 + m3 + m6

        return Matrix.block([[c11, c12], [c21, c22]])

    def round(self, ndigits: Optional[int] = None) -> Matrix:
        return Matrix([[round(i, ndigits) for i in row] for row in self])

    @property
    def shape(self) -> Shape:
        cols = len(self[0]) if self else 0
        return Shape(len(self), cols)

def examples():
    a = Matrix(
        [
            [1, 2],
            [3, 4],
        ]
    )
    b = Matrix(
        [
            [5, 6],
            [7, 8],
        ]
    )
    c = Matrix(
        [
            [1, 1, 1, 1],
            [2, 4, 8, 16],
            [3, 9, 27, 81],
            [4, 16, 64, 256],
        ]
    )
    d = Matrix(
        [
            [4, -3, 4 / 3, -1 / 4],
            [-13 / 3, 19 / 4, -7 / 3, 11 / 24],
            [3 / 2, -2, 7 / 6, -1 / 4],
            [-1 / 6, 1 / 4, -1 / 6, 1 / 24],
        ]
    )
    e = Matrix(
        [
            [1, 2, 3, 4],
            [5, 6, 7, 8],
            [9, 10, 11, 12],
            [13, 14, 15, 16],
        ]
    )
    f = Matrix(
        [
            [1, 0, 0, 0],
            [0, 1, 0, 0],
            [0, 0, 1, 0],
            [0, 0, 0, 1],
        ]
    )

    print("Naive matrix multiplication:")
    print(f"  a * b = {a @ b}")
    print(f"  c * d = {(c @ d).round()}")
    print(f"  e * f = {e @ f}")

    print("Strassen's matrix multiplication:")
    print(f"  a * b = {a.strassen(b)}")
    print(f"  c * d = {c.strassen(d).round()}")
    print(f"  e * f = {e.strassen(f)}")

if __name__ == "__main__":
    examples()


# 20210126 Raku programming solution

use Math::Libgsl::Constants;
use Math::Libgsl::Matrix;
use Math::Libgsl::BLAS;

my @M;

sub SQM (\in) { # create custom sq matrix from CSV
   die "Not a ■" if (my \L = in.split(/\,/)).sqrt != (my \size = L.sqrt.Int);
   my Math::Libgsl::Matrix \M .= new: size, size;
   for ^size Z L.rotor(size) -> ($i, @row) { M.set-row: $i, @row }
   M
}

sub infix:<⊗>(\x,\y) { # custom multiplication
   my Math::Libgsl::Matrix \z .= new: x.size1, x.size2;
   dgemm(CblasNoTrans, CblasNoTrans, 1, x, y, 1, z);
   z
}

sub infix:<⊕>(\x,\y) { # custom addition
   my Math::Libgsl::Matrix \z .= new: x.size1, x.size2;
   z.copy(x).add(y)
}

sub infix:<⊖>(\x,\y) { # custom subtraction
   my Math::Libgsl::Matrix \z .= new: x.size1, x.size2;
   z.copy(x).sub(y)
}

sub Strassen($A, $B) {

   { return $A ⊗ $B } if (my \n = $A.size1) == 1;

   my Math::Libgsl::Matrix        ($A11,$A12,$A21,$A22,$B11,$B12,$B21,$B22);
   my Math::Libgsl::Matrix        ($P1,$P2,$P3,$P4,$P5,$P6,$P7);
   my Math::Libgsl::Matrix::View  ($mv1,$mv2,$mv3,$mv4,$mv5,$mv6,$mv7,$mv8);
   ($mv1,$mv2,$mv3,$mv4,$mv5,$mv6,$mv7,$mv8)».=new ;

   my \half = n div 2; # dimension of quarter submatrices

   $A11 = $mv1.submatrix($A, 0,0,       half,half); #
   $A12 = $mv2.submatrix($A, 0,half,    half,half); #  create quarter views
   $A21 = $mv3.submatrix($A, half,0,    half,half); #  of operand matrices
   $A22 = $mv4.submatrix($A, half,half, half,half); #
   $B11 = $mv5.submatrix($B, 0,0,       half,half); #       11    12
   $B12 = $mv6.submatrix($B, 0,half,    half,half); #
   $B21 = $mv7.submatrix($B, half,0,    half,half); #       21    22
   $B22 = $mv8.submatrix($B, half,half, half,half); #

   $P1 = Strassen($A12 ⊖ $A22, $B21 ⊕ $B22);
   $P2 = Strassen($A11 ⊕ $A22, $B11 ⊕ $B22);
   $P3 = Strassen($A11 ⊖ $A21, $B11 ⊕ $B12);
   $P4 = Strassen($A11 ⊕ $A12, $B22        );
   $P5 = Strassen($A11,         $B12 ⊖ $B22);
   $P6 = Strassen($A22,         $B21 ⊖ $B11);
   $P7 = Strassen($A21 ⊕ $A22, $B11        );

   my Math::Libgsl::Matrix        $C .= new: n, n;               # Build C from
   my Math::Libgsl::Matrix::View  ($mvC11,$mvC12,$mvC21,$mvC22); #    C11 C12
   ($mvC11,$mvC12,$mvC21,$mvC22)».=new ;                         #    C21 C22

   given $mvC11.submatrix($C, 0,0,       half,half) { .add: (($P1 ⊕ $P2) ⊖ $P4) ⊕ $P6 };
   given $mvC12.submatrix($C, 0,half,    half,half) { .add:   $P4 ⊕ $P5 };
   given $mvC21.submatrix($C, half,0,    half,half) { .add:   $P6 ⊕ $P7 };
   given $mvC22.submatrix($C, half,half, half,half) { .add: (($P2 ⊖ $P3) ⊕ $P5) ⊖ $P7 };

   $C
}

for $=pod[0].contents { next if /^\n$/ ; @M.append: SQM $_ }

for @M.rotor(2) {
   my $product = @_[0] ⊗ @_[1];
#   $product.get-row($_)».round(1).fmt('%2d').put for ^$product.size1;

   say "Regular multiply:";
   $product.get-row($_)».fmt('%.10g').put for ^$product.size1;

   $product = Strassen @_[0], @_[1];

   say "Strassen multiply:";
   $product.get-row($_)».fmt('%.10g').put for ^$product.size1;
}

=begin code
1,2,3,4
5,6,7,8
1,1,1,1,2,4,8,16,3,9,27,81,4,16,64,256
4,-3,4/3,-1/4,-13/3,19/4,-7/3,11/24,3/2,-2,7/6,-1/4,-1/6,1/4,-1/6,1/24
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16
1,0,0,0,0,1,0,0,0,0,1,0,0,0,0,1
=end code


T Sudoku
   solved = 0B
   grid = [0] * 81

   F (rows)
      assert(rows.len == 9 & all(rows.map(row -> row.len == 9)), ‘Grid must be 9 x 9’)
      L(i) 9
         L(j) 9
            .grid[9 * i + j] = Int(rows[i][j])

   F solve()
      print("Starting grid:\n\n"(.))
      .placeNumber(0)
      print(I .solved {"Solution:\n\n"(.)} E ‘Unsolvable!’)

   F placeNumber(pos)
      I .solved
         R
      I pos == 81
         .solved = 1B
         R

      I .grid[pos] > 0
         .placeNumber(pos + 1)
         R

      L(n) 1..9
         I .checkValidity(n, pos % 9, pos I/ 9)
            .grid[pos] = n
            .placeNumber(pos + 1)
            I .solved
               R
            .grid[pos] = 0

   F checkValidity(v, x, y)
      L(i) 9
         I .grid[y * 9 + i] == v |
           .grid[i * 9 + x] == v
            R 0B

      V startX = (x I/ 3) * 3
      V startY = (y I/ 3) * 3
      L(i) startY .< startY + 3
         L(j) startX .< startX + 3
            I .grid[i * 9 + j] == v
               R 0B

      R 1B

   F String()
      V s = ‘’
      L(i) 9
         L(j) 9
            s ‘’= .grid[i * 9 + j]‘ ’
            I j C (2, 5)
               s ‘’= ‘| ’
         s ‘’= "\n"
         I i C (2, 5)
            s ‘’= "------+-------+------\n"
      R s

V rows = [‘850002400’,
          ‘720000009’,
          ‘004000000’,
          ‘000107002’,
          ‘305000900’,
          ‘040000000’,
          ‘000080070’,
          ‘017000000’,
          ‘000036040’]

Sudoku(rows).solve()


// Matrix Strassen Multiplication
func strassenMultiply(matrix1: Matrix, matrix2: Matrix) -> Matrix {
    precondition(matrix1.columns == matrix2.columns,
             "Two matrices can only be matrix multiplied if one has dimensions mxn & the other has dimensions nxp where m, n, p are in R")

    // Transform to square matrix
    let maxColumns = Swift.max(matrix1.rows, matrix1.columns, matrix2.rows, matrix2.columns)
    let pwr2 = nextPowerOfTwo(num: maxColumns)
    var sqrMatrix1 = Matrix(rows: pwr2, columns: pwr2)
    var sqrMatrix2 = Matrix(rows: pwr2, columns: pwr2)

    // fill square matrix 1 with values
    for i in 0..<matrix1.rows {
        for j in 0..<matrix1.columns{
            sqrMatrix1[i, j] = matrix1[i, j]
        }
    }
    // fill square matrix 2 with values
    for i in 0..<matrix2.rows {
        for j in 0..<matrix2.columns{
            sqrMatrix2[i, j] = matrix2[i, j]
        }
    }

    // Get strassen result and transfer to array with proper size
    let formulaResult = strassenFormula(matrix1: sqrMatrix1, matrix2: sqrMatrix2)
    var finalResult = Matrix(rows: matrix1.rows, columns: matrix2.columns)
    for i in 0..<finalResult.rows{
        for j in 0..<finalResult.columns {
            finalResult[i, j] = formulaResult[i, j]
        }
    }
    return finalResult
}

// Calculate next power of 2
func nextPowerOfTwo(num: Int) -> Int {
               // formula for next power of 2
    return Int(pow(2,(ceil(log2(Double(num))))))
}

// Multiply Matrices Using Strassen Formula
func strassenFormula(matrix1: Matrix, matrix2: Matrix) -> Matrix {
    precondition(matrix1.rows == matrix1.columns && matrix2.rows == matrix2.columns, "Matrices need to be square")
    guard matrix1.rows > 1 && matrix2.rows > 1 else { return matrix1 * matrix2 }

    let rowHalf = matrix1.rows / 2
    // Strassen Formula https://www.geeksforgeeks.org/easy-way-remember-strassens-matrix-equation/
    // p1 = a(f-h)        p2 = (a+b)h
    // p2 = (c+d)e        p4 = d(g-e)
    // p5 = (a+d)(e+h)    p6 = (b-d)(g+h)
    // p7 = (a-c)(e+f)
    |a b|  x  |e f|  =  |(p5+p4-p2+p6) (p1+p2)|
    |c d|     |g h|     |(p3+p4) (p1+p5-p3-p7)|
   Matrix 1  Matrix 2          Result

    // create empty matrices for a, b, c, d, e, f, g, h
    var a = Matrix(rows: rowHalf, columns: rowHalf)
    var b = Matrix(rows: rowHalf, columns: rowHalf)
    var c = Matrix(rows: rowHalf, columns: rowHalf)
    var d = Matrix(rows: rowHalf, columns: rowHalf)
    var e = Matrix(rows: rowHalf, columns: rowHalf)
    var f = Matrix(rows: rowHalf, columns: rowHalf)
    var g = Matrix(rows: rowHalf, columns: rowHalf)
    var h = Matrix(rows: rowHalf, columns: rowHalf)

    // fill the matrices with values
    for i in 0..<rowHalf {
      for j in 0..<rowHalf {
        a[i, j] = matrix1[i, j]
        b[i, j] = matrix1[i, j+rowHalf]
        c[i, j] = matrix1[i+rowHalf, j]
        d[i, j] = matrix1[i+rowHalf, j+rowHalf]
        e[i, j] = matrix2[i, j]
        f[i, j] = matrix2[i, j+rowHalf]
        g[i, j] = matrix2[i+rowHalf, j]
        h[i, j] = matrix2[i+rowHalf, j+rowHalf]
      }
    }

     // a * (f - h)
    let p1 = strassenFormula(matrix1: a, matrix2: (f - h))
    // (a + b) * h
    let p2 = strassenFormula(matrix1: (a + b), matrix2: h)
    // (c + d) * e
    let p3 = strassenFormula(matrix1: (c + d), matrix2: e)
    // d * (g - e)
    let p4 = strassenFormula(matrix1: d, matrix2: (g - e))
    // (a + d) * (e + h)
    let p5 = strassenFormula(matrix1: (a + d), matrix2: (e + h))
    // (b - d) * (g + h)
    let p6 = strassenFormula(matrix1: (b - d), matrix2: (g + h))
    // (a - c) * (e + f)
    let p7 = strassenFormula(matrix1: (a - c), matrix2: (e + f))

    // p5 + p4 - p2 + p6
    let result11 = p5 + p4 - p2 + p6
    // p1 + p2
    let result12 = p1 + p2
    // p3 + p4
    let result21 = p3 + p4
    // p1 + p5 - p3 - p7
    let result22 = p1 + p5 - p3 - p7

    // create an empty matrix for result and fill with values
    var result = Matrix(rows: matrix1.rows, columns: matrix1.rows)
    for i in 0..<rowHalf {
      for j in 0..<rowHalf {
        result[i, j]           = result11[i, j]
        result[i, j+rowHalf]      = result12[i, j]
        result[i+rowHalf, j]      = result21[i, j]
        result[i+rowHalf, j+rowHalf] = result22[i, j]
      }
    }

    return result
}

func main(){
    // Matrix Class https://github.com/hollance/Matrix/blob/master/Matrix.swift
    var a = Matrix(rows: 2, columns: 2)
    a[row: 0] = [1, 2]
    a[row: 1] = [3, 4]

    var b = Matrix(rows: 2, columns: 2)
    b[row: 0] = [5, 6]
    b[row: 1] = [7, 8]

    var c = Matrix(rows: 4, columns: 4)
    c[row: 0] = [1, 1, 1,1]
    c[row: 1] = [2, 4, 8, 16]
    c[row: 2] = [3, 9, 27, 81]
    c[row: 3] = [4, 16, 64, 256]

    var d = Matrix(rows: 4, columns: 4)
    d[row: 0] = [4, -3, Double(4/3), Double(-1/4)]
    d[row: 1] = [Double(-13/3), Double(19/4), Double(-7/3), Double(11/24)]
    d[row: 2] = [Double(3/2), Double(-2), Double(7/6), Double(-1/4)]
    d[row: 3] = [Double(-1/6), Double(1/4), Double(-1/6), Double(1/24)]

    var e = Matrix(rows: 4, columns: 4)
    e[row: 0] = [1, 2, 3, 4]
    e[row: 1] = [5, 6, 7, 8]
    e[row: 2] = [9, 10, 11, 12]
    e[row: 3] = [13, 14, 15, 16]

    var f = Matrix(rows: 4, columns: 4)
    f[row: 0] = [1, 0, 0, 0]
    f[row: 1] = [0, 1, 0 ,0]
    f[row: 2] = [0 ,0 ,1, 0]
    f[row: 3] = [0, 0 ,0 ,1]

    let result1 = strassenMultiply(matrix1: a, matrix2: b)
    print("AxB")
    print(result1.description)
    let result2 = strassenMultiply(matrix1: c, matrix2: d)
    print("CxD")
    print(result2.description)
    let result3 = strassenMultiply(matrix1: e, matrix2: f)
    print("ExF")
    print(result3.description)
}
main()


class Matrix {
    construct new(a) {
         if (a.type != List || a.count == 0 || a[0].type != List || a[0].count == 0 || a[0][0].type != Num) {
            Fiber.abort("Argument must be a non-empty two dimensional list of numbers.")
         }
         _a  = a
    }

    rows { _a.count }
    cols { _a[0].count }

    +(b) {
        if (b.type != Matrix) Fiber.abort("Argument must be a matrix.")
        if ((this.rows != b.rows) || (this.cols != b.cols)) {
            Fiber.abort("Matrices must have the same dimensions.")
        }
        var c = List.filled(rows, null)
        for (i in 0...rows) {
            c[i] = List.filled(cols, 0)
            for (j in 0...cols) c[i][j] = _a[i][j] + b[i, j]
        }
        return Matrix.new(c)
    }

    - { this * -1 }

    -(b) { this + (-b) }

    *(b) {
        var c = List.filled(rows, null)
        if (b is Num) {
            for (i in 0...rows) {
                c[i] = List.filled(cols, 0)
                for (j in 0...cols) c[i][j] = _a[i][j] * b
            }
        } else if (b is Matrix) {
            if (this.cols != b.rows) Fiber.abort("Cannot multiply these matrices.")
            for (i in 0...rows) {
                c[i] = List.filled(b.cols, 0)
                for (j in 0...b.cols) {
                    for (k in 0...b.rows) c[i][j] = c[i][j] + _a[i][k] * b[k, j]
                }
            }
        } else {
            Fiber.abort("Argument must be a matrix or a number.")
        }
        return Matrix.new(c)
    }

    [i] { _a[i].toList }

    [i, j] { _a[i][j] }

    toString { _a.toString }

    // rounds all elements to 'p' places
    toString(p) {
        var s = List.filled(rows, "")
        var pow = 10.pow(p)
        for (i in 0...rows) {
            var t = List.filled(cols, "")
            for (j in 0...cols) {
                var r = (_a[i][j]*pow).round / pow
                t[j] = r.toString
                if (t[j] == "-0") t[j] = "0"
            }
            s[i] = t.toString
        }
        return s
    }
}

var params = Fn.new { |r, c|
    return [
        [0...r, 0...c, 0, 0],
        [0...r, c...2*c, 0, c],
        [r...2*r, 0...c, r, 0],
        [r...2*r, c...2*c, r, c]
    ]
}

var toQuarters = Fn.new { |m|
    var r = (m.rows/2).floor
    var c = (m.cols/2).floor
    var p = params.call(r, c)
    var quarters = []
    for (k in 0..3) {
        var q = List.filled(r, null)
        for (i in p[k][0]) {
            q[i - p[k][2]] = List.filled(c, 0)
            for (j in p[k][1]) q[i - p[k][2]][j - p[k][3]] = m[i, j]
        }
        quarters.add(Matrix.new(q))
    }
    return quarters
}

var fromQuarters = Fn.new { |q|
    var r = q[0].rows
    var c = q[0].cols
    var p = params.call(r, c)
    r = r * 2
    c = c * 2
    var m = List.filled(r, null)
    for (i in 0...c) m[i] = List.filled(c, 0)
    for (k in 0..3) {
        for (i in p[k][0]) {
            for (j in p[k][1]) m[i][j] = q[k][i - p[k][2], j - p[k][3]]
        }
    }
    return Matrix.new(m)
}

var strassen // recursive
strassen = Fn.new { |a, b|
    if (a.rows != a.cols || b.rows != b.cols || a.rows != b.rows) {
        Fiber.abort("Matrices must be square and of equal size.")
    }
    if (a.rows == 0 || (a.rows & (a.rows - 1)) != 0) {
        Fiber.abort("Size of matrices must be a power of two.")
    }
    if (a.rows == 1) return a * b
    var qa = toQuarters.call(a)
    var qb = toQuarters.call(b)
    var p1 = strassen.call(qa[1] - qa[3], qb[2] + qb[3])
    var p2 = strassen.call(qa[0] + qa[3], qb[0] + qb[3])
    var p3 = strassen.call(qa[0] - qa[2], qb[0] + qb[1])
    var p4 = strassen.call(qa[0] + qa[1], qb[3])
    var p5 = strassen.call(qa[0], qb[1] - qb[3])
    var p6 = strassen.call(qa[3], qb[2] - qb[0])
    var p7 = strassen.call(qa[2] + qa[3], qb[0])
    var q = List.filled(4, null)
    q[0] = p1 + p2 - p4 + p6
    q[1] = p4 + p5
    q[2] = p6 + p7
    q[3] = p2 - p3 + p5 - p7
    return fromQuarters.call(q)
}

var a = Matrix.new([ [1,2], [3, 4] ])
var b = Matrix.new([ [5,6], [7, 8] ])
var c = Matrix.new([ [1, 1, 1, 1], [2, 4, 8, 16], [3, 9, 27, 81], [4, 16, 64, 256] ])
var d = Matrix.new([ [4, -3, 4/3, -1/4], [-13/3, 19/4, -7/3, 11/24],
                     [3/2, -2, 7/6, -1/4], [-1/6, 1/4, -1/6, 1/24] ])
var e = Matrix.new([ [1, 2, 3, 4], [5, 6, 7, 8], [9,10,11,12], [13,14,15,16] ])
var f = Matrix.new([ [1, 0, 0, 0], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1] ])
System.print("Using 'normal' matrix multiplication:")
System.print("  a * b = %(a * b)")
System.print("  c * d = %((c * d).toString(6))")
System.print("  e * f = %(e * f)")
System.print("\nUsing 'Strassen' matrix multiplication:")
System.print("  a * b = %(strassen.call(a, b))")
System.print("  c * d = %(strassen.call(c, d).toString(6))")
System.print("  e * f = %(strassen.call(e, f))")


\
\  Simple iterative backtracking Sudoku solver for 8th
\
needs array/each-slice

[  00, 00, 00, 03, 03, 03, 06, 06, 06,
   00, 00, 00, 03, 03, 03, 06, 06, 06,
   00, 00, 00, 03, 03, 03, 06, 06, 06,
   27, 27, 27, 30, 30, 30, 33, 33, 33,
   27, 27, 27, 30, 30, 30, 33, 33, 33,
   27, 27, 27, 30, 30, 30, 33, 33, 33,
   54, 54, 54, 57, 57, 57, 60, 60, 60,
   54, 54, 54, 57, 57, 57, 60, 60, 60,
   54, 54, 54, 57, 57, 57, 60, 60, 60 ] constant top-left-cell

\ Bit number presentations
a:new 2 b:new b:clear a:push ( 2 b:new b:clear swap 1 b:bit! a:push ) 0 8 loop constant posbit

: posbit?  \ n -- s
  posbit swap a:@ nip ;

: search  \ b -- n
  null swap
  ( dup -rot b:[email protected] if rot drop break else nip then ) 0 8 loop
  swap ;

: b-or  \ b b -- b
  ' n:bor b:op ;

: b-and  \ b b -- b
  ' n:band b:op ;

: b-xor  \ b b -- b
  b:xor
  [ xff, x01 ] b:new
  b-and ;

: b-not  \ b -- b
  xff b:xor
  [ xff, x01 ] b:new
  b-and ;

: b-any  \ a -- b
  ' b-or 0 posbit? a:reduce ;

: row \ a row -- a
  9 n:* 9 a:slice ;

: col  \ a col -- a
  -1 9 a:slice+ ;

\ For testing sub boards
: sub  \ a n -- a
  top-left-cell swap a:@ nip over over 3 a:slice
  -rot 9 n:+ 2dup 3 a:slice
  -rot 9 n:+ 3 a:slice
  a:+ a:+ ;

a:new 0 args "Give Sudoku text file as param" thrownull
f:slurp "Cannot read file" thrownull >s "" s:/
' >n a:map ( posbit? a:push ) a:each! drop constant board

: display-board
  board ( search nip -1 ?: n:1+ ) a:map
  "+-----+-----+-----+\n"
  "|%d %d %d|%d %d %d|%d %d %d|\n" s:+
  "|%d %d %d|%d %d %d|%d %d %d|\n" s:+
  "|%d %d %d|%d %d %d|%d %d %d|\n" s:+
  "+-----+-----+-----+\n" s:+
  "|%d %d %d|%d %d %d|%d %d %d|\n" s:+
  "|%d %d %d|%d %d %d|%d %d %d|\n" s:+
  "|%d %d %d|%d %d %d|%d %d %d|\n" s:+
  "+-----+-----+-----+\n" s:+
  "|%d %d %d|%d %d %d|%d %d %d|\n" s:+
  "|%d %d %d|%d %d %d|%d %d %d|\n" s:+
  "|%d %d %d|%d %d %d|%d %d %d|\n" s:+
  "+-----+-----+-----+\n" s:+
  s:strfmt . ;

\ Store move history
a:new constant history

\ Possible numbers for a cell
: candidates?  \ n -- s
  dup dup 9 n:/ n:int swap 9 n:mod \ row col
  board swap col b-any
  board rot row b-any
  b-or
  board rot sub b-any
  b-or
  b-not ;

\ If found:     -- n T
\ If not found: -- T
: find-free-cell
  false
  board ( 0 posbit? b:= if nip true break else drop then ) a:each drop ;

: validate
  true
  board
  ( dup -rot a:@ swap 2 pick 0 posbit? a:! 2 pick candidates? 2 pick b:= if
      -rot a:!
    else
      2drop drop
      false swap
      break
    then ) 0 80 loop drop ;

: solve
  repeat
    find-free-cell if
      dup candidates?
      repeat
        search null? if
          drop board -rot a:! drop
          history a:len 0 n:= if
            drop false ;;
          then
          a:pop nip
          a:open
        else
          n:1+ posbit?
          dup
          board 4 pick rot a:! drop
          b-xor
          2 a:close
          history swap a:push drop
          break
        then
      again
    else
      validate
      break
    then
  again ;

: app:main
  "Sudoku puzzle:\n" .
  display-board cr
  solve if
    "Sudoku solved:\n" .
    display-board
  else
    "No solution!\n" .
  then ;


with Ada.Text_IO;

procedure Sudoku is
   type sudoku_ar_t is array ( integer range 0..80 ) of integer range 0..9;
   FINISH_EXCEPTION : exception;

   procedure prettyprint(sudoku_ar: sudoku_ar_t);
   function checkValidity( val : integer; x : integer; y : integer;  sudoku_ar: in  sudoku_ar_t) return Boolean;
   procedure placeNumber(pos: Integer; sudoku_ar: in out sudoku_ar_t);
   procedure solve(sudoku_ar: in out sudoku_ar_t);

   function checkValidity( val : integer; x : integer; y : integer;  sudoku_ar: in  sudoku_ar_t) return Boolean
   is
   begin
      for i in 0..8 loop

         if ( sudoku_ar( y * 9 + i ) = val or sudoku_ar( i * 9 + x ) = val ) then
            return False;
         end if;
      end loop;

      declare
         startX : constant integer := ( x / 3 ) * 3;
         startY : constant integer := ( y / 3 ) * 3;
      begin
         for i in startY..startY+2 loop
            for j in startX..startX+2 loop
               if ( sudoku_ar( i * 9 +j ) = val ) then
                  return False;
               end if;
            end loop;
         end loop;
         return True;
      end;
   end checkValidity;

   procedure placeNumber(pos: Integer; sudoku_ar: in out sudoku_ar_t)
   is
   begin
      if ( pos = 81 ) then
         raise FINISH_EXCEPTION;
      end if;
      if (  sudoku_ar(pos) > 0 ) then
         placeNumber(pos+1, sudoku_ar);
         return;
      end if;
      for n in 1..9 loop
         if( checkValidity( n,  pos mod 9, pos / 9 , sudoku_ar ) ) then
            sudoku_ar(pos) := n;
            placeNumber(pos + 1, sudoku_ar );
            sudoku_ar(pos) := 0;
         end if;
      end loop;
   end placeNumber;

   procedure solve(sudoku_ar: in out sudoku_ar_t)
   is
   begin
      placeNumber( 0, sudoku_ar );
      Ada.Text_IO.Put_Line("Unresolvable !");
   exception
      when FINISH_EXCEPTION =>
         Ada.Text_IO.Put_Line("Finished !");
         prettyprint(sudoku_ar);
   end solve;

   procedure prettyprint(sudoku_ar: sudoku_ar_t)
   is
      line_sep   : constant String  := "------+------+------";
   begin
      for i in sudoku_ar'Range loop
         Ada.Text_IO.Put(sudoku_ar(i)'Image);
         if (i+1) mod 3 = 0 and not((i+1) mod 9 = 0) then
            Ada.Text_IO.Put("|");
         end if;
         if (i+1) mod 9 = 0 then
            Ada.Text_IO.Put_Line("");
         end if;
         if (i+1) mod 27 = 0 then
            Ada.Text_IO.Put_Line(line_sep);
         end if;
      end loop;
   end prettyprint;

   sudoku_ar : sudoku_ar_t :=
     (
      8,5,0,0,0,2,4,0,0,
      7,2,0,0,0,0,0,0,9,
      0,0,4,0,0,0,0,0,0,
      0,0,0,1,0,7,0,0,2,
      3,0,5,0,0,0,9,0,0,
      0,4,0,0,0,0,0,0,0,
      0,0,0,0,8,0,0,7,0,
      0,1,7,0,0,0,0,0,0,
      0,0,0,0,3,6,0,4,0
     );

begin
   solve( sudoku_ar );
end Sudoku;