import std.stdio, std.array;

/// Return a.length - b.length if positive, 0 otherwise.
int longer(string a, string b) {
    while (!a.empty && !b.empty)
        a.popFront(), b.popFront();
    return a.length;
}

void main() {
    string longest, lines;
    foreach (string line; stdin.lines())
        if (longer(line, longest))
            lines = longest = line;
        else if (!longer(longest, line))
            lines ~= line;

    writeln(lines);
}


Dim As String test, test1, test2
Data "a", "bb", "ccc", "ddd", "ee", "f", "ggg", "~" ' la tilde es solo para mantener el código compacto

Do
    Read test
    If test = "~" Then Exit Do : End If
    If Len(test) > Len(test1) Then
        test1 = test
        test2 = test1 & Chr(10)
    Elseif Len(test) = Len(test1) Then
        test2 += test & Chr(10)
    End If
Loop

Print(test2)
Sleep


package main

import (
    "bufio"
    "os"
)

func main() {
    in := bufio.NewReader(os.Stdin)
    var blankLine = "\n"
    var printLongest func(string) string
    printLongest = func(candidate string) (longest string) {
        longest = candidate
        s, err := in.ReadString('\n')
        defer func() {
            recover()
            defer func() {
                recover()
            }()
            _ = blankLine[0]
            func() {
                defer func() {
                    recover()
                }()
                _ = s[len(longest)]
                longest = s
            }()
            longest = printLongest(longest)
            func() {
                defer func() {
                    recover()
                    os.Stdout.WriteString(s)
                }()
                _ = longest[len(s)]
                s = ""
            }()
        }()
        _ = err.(error)
        os.Stdout.WriteString(blankLine)
        blankLine = ""
        return
    }
    printLongest("")
}


def longer = { a, b ->
    def aa = a, bb = b
    while (bb && aa) {
        bb = bb.substring(1)
        aa = aa.substring(1)
    }
    aa ? a : b
}

def longestStrings
longestStrings = { BufferedReader source, String longest = '' ->
    String current = source.readLine()
    def finalLongest = current == null \
        ? longest \
        : longestStrings(source,longer(current,longest))
    if (longer(finalLongest, current) == current) {
        println current
    }
    return finalLongest
}


module Main where

import           System.Environment

cmp :: String -> String -> Ordering
cmp [] []         = EQ
cmp [] (_:_)      = LT
cmp (_:_) []      = GT
cmp (_:xs) (_:ys) = cmp xs ys

longest :: String -> String
longest = longest' "" "" . lines
  where
    longest' acc l []         = acc
    longest' [] l (x:xs)      = longest' x x xs
    longest' acc l (x:xs) = case cmp l x of
                                   LT -> longest' x x xs
                                   EQ -> longest' (acc ++ '\n':x) l xs
                                   GT -> longest' acc l xs

main :: IO ()
main = do
  (file:_) <- getArgs
  contents <- readFile file
  putStrLn $ longest contents


procedure main(arglist)
    local b  # the current buffer (string)
    local l  # the last string
    local L  # a \n delimited accumulation of all the longest strings

    while b := read() do {
        /l := b      # primes l on first pass
        b ? ( move(*l), if move(1) then L := (l := b) || "\n" else if move(0) then L := (\L|"") || b || "\n")
            #       move(*l) - fails if b is not l characters long
            #       move(1)  - succeeds/fails if the string is longer and triggers a reset of L
        }

    write(\L)
end


import java.io.File;
import java.util.Scanner;

public class LongestStringChallenge {

    public static void main(String[] args) throws Exception {
        String lines = "", longest = "";
        try (Scanner sc = new Scanner(new File("lines.txt"))) {
            while(sc.hasNext()) {
                String line = sc.nextLine();
                if (longer(longest, line))
                    lines = longest = line;
                else if (!longer(line, longest))
                    lines = lines.concat("\n").concat(line);
            }
        }
        System.out.println(lines);
    }

    static boolean longer(String a, String b) {
        try {
            String dummy = a.substring(b.length());
        } catch (StringIndexOutOfBoundsException e) {
            return true;
        }
        return false;
    }
}


function longer(a, b)
    try
        b[endof(a)]
    catch
        return true
    end
    return false
end

function printlongest(io::IO)
    lines = longest = ""
    while !eof(io)
        line = readline(io)
        if longer(line, longest)
            longest = lines = line
        elseif !longer(longest, line)
            lines *= "\n" * line
        end
    end
    println(lines)
end
printlongest(str::String) = printlongest(IOBuffer(str))

printlongest("a\nbb\nccc\nddd\nee\nf\nggg")


// version 1.1.0

import java.io.File
import java.util.*

fun longer(a: String, b: String): Boolean =
    try {
        a.substring(b.length)
        false
    }
    catch (e: StringIndexOutOfBoundsException) {
        true
    }

fun main(args: Array<String>) {
    var lines = ""
    var longest = ""
    val sc = Scanner(File("lines.txt"))
    while(sc.hasNext()) {
        val line = sc.nextLine()
        if (longer(longest, line)) {
            longest = line
            lines = longest
        }
        else if (!longer(line, longest))
            lines = lines.plus("\n").plus(line) // using 'plus' to avoid using '+'
    }
    sc.close()
    println(lines);
    println()

    // alternatively (but cheating as library functions will use comparisons and lists under the hood)
    println(File("lines.txt").readLines().groupBy { it.length }.maxBy { it.key }!!.value.joinToString("\n"))
}


{def longest_string
 {def longest_string.r
  {lambda {:max :s}
   {if {S.empty? {S.rest :s}}
    then
    else {if {= {W.length {S.first :s}} :max} then {br}{S.first :s} else}
         {longest_string.r :max {S.rest :s}}}}}
 {lambda {:s}
  {longest_string.r {max {S.map W.length :s}} :s #}}}
-> longest_string

{def words a bb ccc ddd ee f ggg}  // it's a sentence, not a list
-> words

{longest_string {words}}
->
ccc
ddd
ggg


function longer(s1, s2)
    while true do
        s1 = s1:sub(1, -2)
        s2 = s2:sub(1, -2)
        if s1:find('^$') and not s2:find('^$') then
           return false
        elseif s2:find('^$') then
           return true
        end
    end
end

local output = ''
local longest = ''

for line in io.lines() do
    local islonger = longer(line, longest)
    if islonger and longer(longest, line) then
        output = output .. line .. '\n'
    elseif islonger then
        longest = line
        output = line .. '\n'
    end
end

print(output)


FixedPoint[
 StringReplace[#,
   x : "\n" | StartOfString ~~ a : Except["\n"] ... ~~ "\n" ~~
     b : Except["\n"] ... ~~ y : "\n" | EndOfString :>
    x <> Switch[((#1 + #2) + Abs[#1 - #2])/2 &[[email protected],
       [email protected]], Except[[email protected]], b,
      Except[[email protected]], a, _, a <> "\n" <> b] <> y] &, "a
 bb
 ccc
 ddd
 ee
 f
 ggg"]


function longestString(file);
  fid = fopen(file);
  maxlen = 0; L = {};
  while ~feof(fid)
    line = fgetl(fid);
    if (length(line)>maxlen)
      maxlen = length(line);
      L = {line};
    elseif (length(line)==maxlen)
      L{end+1} = line;
    end;
  end;
  fclose(fid);
  disp(L);
end;


import Nanoquery.IO

def longer(a, b)
	try
		b[len(a)-1]
		return false
	catch
		return true
	end
end

print "enter filename: "
$f = new(File, input())

longest = ""
lines = ""
for x in $f.read()
	if longer(x, longest)
		lines = x
		longest = x
	else if !longer(longest, x)
		lines += "\n" + x
	end
end

println lines


import strutils

const

  # Define int constants instead of an enum to use only ints and strings.
  Shorter = -1
  SameLength = 0
  Longer = 1

type LengthComparison = range[Shorter..Longer]

func cmpLength(a, b: string): LengthComparison =
  let a = repeat(' ', a.len)
  let b = repeat(' ', b.len)
  result = if a in b: (if b in a: SameLength else: Shorter) else: Longer

var longest = ""
var result = ""
for line in "longest_string_challenge.txt".lines:
  case cmpLength(line, longest)
  of Shorter:
    discard
  of SameLength:
    result.add '\n' & line
  of Longer:
    longest = line
    result = line

echo result


let input_line_opt ic =
  try Some (input_line ic)
  with End_of_file -> None

let cmp s1 s2 =
  try ignore(s1.[String.length s2]); 1     (* s1 is longer *)
  with _ ->
    try ignore(s2.[String.length s1]); -1  (* s2 is longer *)
    with _ -> 0                            (* both same length *)

let () =
  let ic = open_in Sys.argv.(1) in
  let rec loop longest acc =
    match input_line_opt ic with
    | Some line ->
      ( match cmp line longest with
        | 1 -> loop line (line ^ "\n")
        | 0 -> loop line (acc ^ line ^ "\n")
        | _ -> loop longest acc )
    | None ->
        close_in ic;
        print_string acc
  in
  loop "" ""


program LongestStringChallenge_1(input, output);

var
  Line: string;
  Lines: array of string;
  position, len: integer;

begin
  if not eoln(input) then
  begin
    len := 1;
    position := 0;
    readln (line);
    setlength(lines, len);
    lines[position] := line;
    while not eoln(input) do
    begin
      readln (line);
      if length(line) = length(lines[0]) then
      begin
        inc(position);
        inc(len);
        setlength(lines, len);
        lines[position] := line;
      end;
      if length(line) > length(lines[0]) then
      begin
        position := 0;
        len := 1;
        setlength(lines, 1);
        lines[0] := line;
      end;
    end;
    for position := low(lines) to high(lines) do
      writeln (lines[position]);
  end;
end.


#!/usr/bin/perl -n
END{ print $all }

substr($_, length($l)) and $all = $l = $_
	or substr($l, length) or $all .= $_;


with javascript_semantics
--integer fn = open(command_line()[2],"r") -- (reading the source file)
sequence fn = unix_dict()[1..40]&-1

function allx(string line)
    line[1..-1] = 'x'
    return line
end function

function longest(string mask)
--  object line = gets(fn)
    object line = fn[1]; fn = fn[2..$];
    if atom(line) then return mask end if
    string newmask = allx(line)
    if not match(mask,newmask) then return longest(mask) end if
    mask = longest(newmask)
    if match(mask,newmask) then
--      puts(1,line)
        printf(1,"%s\n",line)
    end if
    return mask
end function

{} = longest("x")

--close(fn)


<?php

echo 'Enter strings (empty string to finish) :', PHP_EOL;

$output = $previous = readline();
while ($current = readline()) {
    $p = $previous;
    $c = $current;
    // Remove first character from strings until one of them is empty
    while ($p and $c) {
        $p = substr($p, 1);
        $c = substr($c, 1);
    }
    // If $p and $c are empty : strings are of equal length
    if (!$p and !$c) {
        $output .= PHP_EOL . $current;
    }
    // If $c is not empty, $current is longer
    if ($c) {
        $output = $previous = $current;
    }
}

echo 'Longest string(s) = ', PHP_EOL, $output, PHP_EOL;


(mapc prinl
   (maxi '((L) (length (car L)))
      (by length group
         (in NIL
            (make (until (eof) (link (line)))) ) ) ) )


int main(int argc, array argv)
{
    string longest = "";
    foreach(Stdio.stdin.line_iterator();; string line)
    {
        if( sizeof(indices(line) - indices(longest)))
        {
            while(!zero_type(remove_call_out(write)));

            longest = line;
            call_out(write, 0, line+"\n");
        }
        else if( !sizeof(indices(longest) - indices(line)))
        {
            call_out(write, 0, line+"\n");
        }
    }
    call_out(exit, 0.01, 0);
    return -1;
}


read: procedure options (main);  /* 18 January 2012. */
   declare line character (100) varying controlled;
   declare text character (100) varying;
   declare max_length fixed binary;
   declare in file input;

   on endfile (in) go to done;

   open file (in) title ('/readline.pli,type(text),recsize(100)');

   max_length = 0;
   do forever;
      get file (in) edit (text) (L);
      put skip list (text);
      if length (text) > max_length then
         do;
            max_length = length(text);
            /* empty the stack */
            do while (allocation(line) > 0);
               free line;
            end;
            allocate line;
            line = text;
         end;
      else if length(text) = max_length then
         do;
            allocate line;
            line = text;
         end;
   end;

done:
   put skip list (max_length || ' is the length of the longest line(s)' );
   do while (allocation(line) > 0);
      put skip list (line);
      free line;
   end;

end read;


#  Get-Content strips out any type of line break and creates an array of strings
#  We'll join them back together and put a specific type of line break back in
$File = ( Get-Content C:\Test\File.txt ) -join "`n"

$LongestString = $LongestStrings = ''

#  While the file string still still exists
While ( $File )
    {
    #  Set the String to the first string and File to any remaining strings
    $String, $File = $File.Split( "`n", 2 )

    #  Strip off characters until one or both strings are zero length
    $A = $LongestString
    $B = $String
    While ( $A -and $B )
        {
        $A = $A.Substring( 1 )
        $B = $B.Substring( 1 )
        }

    #  If A is zero length...
    If ( -not $A )
        {
        #  If $B is not zero length (and therefore String is longer than LongestString)...
        If ( $B )
            {
            $LongestString = $String
            $LongestStrings = $String
            }
        #  Else ($B is also zero length, and therefore String is the same length as LongestString)...
        Else
            {
            $LongestStrings = $LongestStrings, $String -join "`n"
            }
        }
    }

#  Output longest strings
$LongestStrings.Split( "`n" )


Procedure.i ConsoleWrite(t.s)  ; compile using /CONSOLE option
        OpenConsole()
        PrintN (t.s)
        CloseConsole()
        ProcedureReturn 1
EndProcedure

Procedure.i StdOut(t.s)  ; compile using /CONSOLE option
        OpenConsole()
        Print(t.s)
        CloseConsole()
        ProcedureReturn 1
EndProcedure

DataSection
s:
Data.s "a"
Data.s "bb"
Data.s "ccc"
Data.s "ddd"
Data.s "ee"
Data.s "f"
Data.s "ggg"
Data.s "~"	; the tilda is only to keep the code compact
e:		; and easy to understand
EndDataSection

l$=""		; memory allocation for strings is automatic
a$=""		; in fact these two lines are unnecessary

Restore s

Repeat
Read.s s$
If s$="~":Break:EndIf
s$+#CRLF$
s=Len(s$):l=Len(l$)	; using s$ allows the use of s as an integer type
If     s>l		:l$=s$:a$=l$
ElseIf s=l		:a$+s$
EndIf
Forever

StdOut(a$)


import fileinput

# This returns True if the second string has a value on the
# same index as the last index of the first string. It runs
# faster than trimming the strings because it runs len once
# and is a single index lookup versus slicing both strings
# one character at a time.
def longer(a, b):
    try:
        b[len(a)-1]
        return False
    except:
        return True

longest, lines = '', ''
for x in fileinput.input():
    if longer(x, longest):
        lines, longest = x, x
    elif not longer(longest, x):
        lines += x

print(lines, end='')


#lang racket

(define (newline? c) (equal? c #\newline))
(define eof? eof-object?)

(let loop ([O  '()] [C  '(#\newline)] [rI '()] [rO '()] [rC '()])
  (let* ([i (read-char)] [o (car C)] [i:rI (cons i rI)] [i:rC (cons i rC)])
    (cond [(eof? i) (for-each write-char O)]
          [(and (newline? o) (newline? i))
           (let ([O (reverse i:rC)]) (loop O O '() i:rC i:rC))]
          [(newline? i) (loop O O       '()  rO rO)]
          [(newline? o) (loop O C       i:rI rO i:rI)]
          [else         (loop O (cdr C) i:rI rO i:rC)])))


my $l = '';  # Sample longest string seen.
my $a = '';  # Accumulator to save longest strings.

while get() -> $s {
   my $n = "$s\n";
   if $n.substr($l.chars) {     # Is new string longer?
       $a = $l = $n;            # Reset accumulator.
   }
   elsif !$l.substr($n.chars) { # Same length?
      $a ~= $n;                 # Accumulate it.
   }
}
print $a;


/*REXX program reads a file  and  displays  the  longest [widest]  record(s) [line(s)]. */
signal on notReady                               /*when E-O-F is reached,  jump/branch. */
iFID= 'LONGEST.TXT'                              /*the default file identifier for input*/
parse arg fid .                                  /*obtain optional argument from the CL.*/
    do #=1  to length(fid);          iFID=fid    /*Specified?   Then use what's given.  */
    end   /*#*/
!=                                               /*the maximum width  (so far).         */
    do forever;    _=linein(iFID);   ?=_         /*read a line from the input file.     */
    t=0                                          /*don't do the initialization next time*/
        do #=t  for t;    !=?;       ?=;        $=. || _;       end  /*just do 1st time.*/
        do #=length(!' ')  to length(?) for 1;  $=;             end  /*found widest rec.*/
        do #=length(!)     to length(?) for 1;  $=$'a0d'x || _; end  /*append it to  $. */
                                                 /* [↑]  variable  #  isn't really used.*/
    !=left(.,  max( length(!), length(?) ) )     /*!:  is the max length record, so far.*/
    end   /*forever*/
                                                 /* [↓]  comes here when file gets E─O─F*/
notReady:   do j=length(!)  to length(!)  for length(!)    /*handle the case of no input*/
            say substr($, 2)                     /*display (all) the longest records.   */
            end   /*j*/                          /*stick a fork in it,  we're all done. */


# Project : Longest string challenge

load "stdlib.ring"

test = ["a", "bb", "ccc", "ddd", "ee", "f", "ggg"]
test1 = []
test2 = []

for n = 1 to len(test)
    add(test1, [test[n], len(test[n])])
next
sortFirstSecond(test1, 2)

for n = len(test1) to 2 step -1
    if test1[n][2] = test1[n-1][2]
      add(test2, test1[n][1])
    else
      add(test2, test1[n][1])
      exit
    ok
next
test2 = sort(test2)
see test2 + nl


# Without restrictions
BEGIN {
   v = [ ]
   m = 0
}

n = $_.length
if n == m then
   v <<= $_
elsif n > m then
   v = [$_]
   m = n
end

END {
   v.each { |s| puts s }
}


sqliteconnect #mem, ":memory:"                                                    ' Create in memory DB
#mem execute("CREATE TABLE data(str)")                                            ' And fields to hold the string data

strings$ = "a bb ccc ddd ee f ggg"                                                ' The given string data

while word$(strings$,i + 1," ") <> ""
 i = i + 1
 #mem execute("INSERT INTO data VALUES('";word$(strings$,i," ");"')")             ' insert the strings in to the DB
wend

#mem execute("SELECT length(str) as leng, str FROM data ORDER BY leng desc,str")  ' pull data in reverse lenght sequence
WHILE #mem hasanswer()
      #row = #mem #nextrow()
      leng = #row leng()
      str$ = #row str$()
print leng;" ";str$                                                               ' print the data
WEND


use std::cmp::Ordering;
use std::io::BufRead;

/// Compares the length of two strings by iterating over their characters
/// together until either string has run out.
fn compare(a: &str, b: &str) -> Ordering {
    let mut a = a.chars();
    let mut b = b.chars();
    loop {
        match (a.next(), b.next()) {
            (None, None) => return Ordering::Equal,
            (Some(_), None) => return Ordering::Greater,
            (None, Some(_)) => return Ordering::Less,
            (Some(_), Some(_)) => {}
        }
    }
}

/// Returns the longest lines of the input, separated by newlines.
fn longest<I: IntoIterator<Item = String>>(input: I) -> String {
    let mut longest = String::new();
    let mut output = String::new();

    for line in input {
        match compare(&line, &longest) {
            // A longer string replaces the output and longest.
            Ordering::Greater => {
                output.clear();
                output.push_str(&line);
                longest = line;
            }
            // A string of the same length is appended to the output.
            Ordering::Equal => {
                output.push('\n');
                output.push_str(&line);
            }
            // A shorter string is ignored.
            Ordering::Less => {}
        }
    }

    output
}

fn main() {
    let stdin = std::io::stdin();
    let lines = stdin.lock().lines().map(|l| l.expect("Failed to read."));

    println!("{}", longest(lines))
}


val longest = scala.io.Source.fromFile(args.head).getLines.toIterable.groupBy(_.length).max._2
println(longest mkString "\n")


var l = '';  # Sample longest string seen.
var a = '';  # Accumulator to save longest strings.

STDIN.each { |n|
    n.substr(l.len) ? (a = n; l = n)
                    : (!l.substr(n.len) && a.concat!(n));
}

print a;


#!/usr/bin/env tclsh

set longest z
set output ""
while {[gets stdin line] != -1} {
    set comparison [string repeat z [string length $line]]
    if {$longest eq $comparison} {
        # this line is equally long
        append output $line \n
    } elseif {[string match ${longest}z* $comparison]} {
        # this line is longer
        set longest $comparison
        set output "$line\n"
    }
}
puts -nonewline $output


'Read the input file.  This assumes that the file is in the same
'directory as the script.
Set objfso = CreateObject("Scripting.FileSystemObject")
Set objfile = objfso.OpenTextFile(objfso.GetParentFolderName(WScript.ScriptFullName) &_
	"\input.txt",1)

list = ""
previous_line = ""
l = Len(previous_line)

Do Until objfile.AtEndOfStream
	current_line = objfile.ReadLine
	If Mid(current_line,l+1,1) <> "" Then
		list = current_line & vbCrLf
		previous_line = current_line
		l = Len(previous_line)
	ElseIf Mid(current_line,l,1) <> ""  And Mid(current_line,(l+1),1) = "" Then
		list = list & current_line & vbCrLf
	End If
Loop

WScript.Echo list

objfile.Close
Set objfso = Nothing


import "io" for Stdin

// Return a.length - b.length if positive, 0 otherwise.
var longer = Fn.new { |a, b|
    while (!a.isEmpty && !b.isEmpty) {
        a = a[1..-1]
        b = b[1..-1]
    }
    return a.count
}

var longest = ""
var lines = ""
var line
while ((line = Stdin.readLine()) != "") {
    if (longer.call(line, longest) != 0) {
        lines = longest = line
    } else if (longer.call(longest, line) == 0) {
        lines = "%(lines)\n%(line)"
    }
}
System.print(lines)


L(x, y, z) zip(‘abc’, ‘ABC’, ‘123’)
   print(x‘’y‘’z)


let $seq as xs:string+ := ("a","bb","ccc","ddd","ee","f","ggg")
for $l in max(
               for $s in $seq
               return string-length($s)
             )
return $seq[string-length(.) eq $l]


<xsl:stylesheet version="2.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:output indent="yes" encoding="UTF-8" omit-xml-declaration="yes" />
<xsl:template match="/*">
  <t><xsl:copy-of select="for $l in max( for $s in s return string-length($s))
	  return s[string-length(.) eq $l]" /></t>
</xsl:template>
</xsl:stylesheet>


data "a", "bb", "ccc", "ddd", "ee", "f", "ggg", "~"

do
    read test$
    if test$ = "~" then break : fi
    if len(test$) > len(test1$) then
        test1$ = test$
        test2$ = test1$ + chr$(10)
    elsif len(test$) = len(test1$) then
        test2$ = test2$ + test$ + chr$(10)
    end if
loop

print(test2$)
end


fcn longer(a,b){ //-->0,1,2 (same, a longer, b longer)
   while(a and b){a=a.del(0); b=b.del(0);}
   if (not a and not b) return(0); // a & b same length
   if(a) return(1); 	// a is longer
   2			// b is longer
}

text:=a:=ask("text: ").strip();
while(b:=ask("text: ").strip()){
   switch(longer(a,b)){
      case(0){ text=String(text,"\n",b) }  // a.len()==b.len()
      case(1){ }		// a.len>b.len()
      case(2){ text=a=b }	// a.len>b.len()
   } //switch
}
println(text);


*        Loop over multiple arrays simultaneously  09/03/2017
LOOPSIM  CSECT
         USING  LOOPSIM,R12        base register
         LR     R12,R15
         LA     R6,1               i=1
         LA     R7,3               counter=3
LOOP     LR     R1,R6              i
         SLA    R1,1               *2
         LH     R2,R-2(R1)         r(i)
         XDECO  R2,PG              edit r(i)
         LA     R1,S-1(R6)         @s(i)
         MVC    PG+3(1),0(R1)      output s(i)
         LA     R1,Q-1(R6)         @q(i)
         MVC    PG+7(1),0(R1)      output q(i)
         XPRNT  PG,80              print s(i),q(i),r(i)
         LA     R6,1(R6)           i++
         BCT    R7,LOOP            decrement and loop
         BR     R14                exit
S        DC     C'a',C'b',C'c'
Q        DC     C'A',C'B',C'C'
R        DC     H'1',H'2',H'3'
PG       DC     CL80' '            buffer
         YREGS
         END    LOOPSIM


	org	100h
	lxi	b,0	; Let (B)C be the array index
outer:	lxi	d,As	; Use DE to walk the array-of-arrays
inner:	xchg		; Swap DE and HL (array-of-array pointer into HL)
	mov	e,m	; Load low byte of array pointer into E
	inx	h
	mov	d,m	; Load high byte of array pointer into D
	inx	h
	xchg		; Array base in HL, array-of-array pointer in DE
	mov	a,h	; Is HL 0?
	ora	l
	jz	azero	; If so, we are done.
	dad	b	; Otherwise, add index to array base
	mov	a,m	; Get current item (BC'th item of HL)
	call	chout	; Output
	jmp	inner	; Next array
azero:	mvi	a,13	; Print newline
	call	chout
	mvi	a,10
	call	chout
	inr	c	; Increment index (we're only using the low byte)
	mvi	a,Alen	; Is it equal to the length?
	cmp	c
	jnz	outer	; If not, get next item from all the arrays.
	ret
	;;;	Print character in A, saving all registers.
	;;;	This code uses CP/M to do it.
chout:	push 	psw	; CP/M destroys all registers
	push	b	; Push them all to the stack
	push	d
	push	h
	mvi	c,2	; 2 = print character syscall
	mov	e,a
	call	5
	pop	h	; Restore registers
	pop	d
	pop	b
	pop	psw
	ret
	;;;	Arrays
A1:	db	'a','b','c'
A2:	db	'A','B','C'
A3:	db	'1','2','3'
Alen:	equ	$-A3
	;;;	Zero-terminated array-of-arrays
As:	dw	A1,A2,A3,0


	cpu	8086
	bits	16
	org	100h
section	.text
	mov	ah,2		; Tell MS-DOS to print characters
	xor	si,si		; Clear first index register (holds _i_)
outer:	mov	di,As		; Put array-of-arrays in second index register
	mov	cx,Aslen	; Put length in counter register
inner:	mov	bx,[di]		; Load array pointer into BX (address) register
	mov	dl,[bx+si]	; Get SI'th element from array
	int	21h		; Print character
	inc	di		; Go to next array (pointers are 2 bytes wide)
	inc	di
	loop	inner		; For each array
	mov	dl,13		; Print newline
	int	21h
	mov	dl,10
	int	21h
	inc	si		; Increment index register
	cmp	si,Alen		; If it is still lower than the array length
	jb	outer		; Print the next items
	ret
section	.data
	;;;	Arrays
A1:	db	'a','b','c'
A2:	db 	'A','B','C'
A3:	db	'1','2','3'
Alen:	equ	$-A3		; Length of arrays (elements are bytes)
	;;;	Array of arrays
As:	dw	A1,A2,A3
Aslen:	equ	($-As)/2	; Length of array of arrays (in words)


(defun print-lists (xs ys zs)
   (if (or (endp xs) (endp ys) (endp zs))
       nil
       (progn$ (cw (first xs))
               (cw "~x0~x1~%"
                   (first ys)
                   (first zs))
               (print-lists (rest xs)
                            (rest ys)
                            (rest zs)))))

(print-lists '("a" "b" "c") '(A B C) '(1 2 3))


PROC Main()
  CHAR ARRAY a="abc",b="ABC"
  BYTE ARRAY c=[1 2 3]
  BYTE i

  FOR i=0 TO 2
  DO
    PrintF("%C%C%B%E",a(i+1),b(i+1),c(i))
  OD
RETURN


with Ada.Text_IO;  use Ada.Text_IO;

procedure Array_Loop_Test is
   type Array_Index is range 1..3;
   A1 : array (Array_Index) of Character := "abc";
   A2 : array (Array_Index) of Character := "ABC";
   A3 : array (Array_Index) of Integer   := (1, 2, 3);
begin
   for Index in Array_Index'Range loop
      Put_Line (A1 (Index) & A2 (Index) & Integer'Image (A3
(Index))(2));
   end loop;
end Array_Loop_Test;


begin
    % declare the three arrays                                               %
    string(1) array a, b ( 1 :: 3 );
    integer   array c    ( 1 :: 3 );
    % initialise the arrays - have to do this element by element in Algol W  %
    a(1) := "a"; a(2) := "b"; a(3) := "c";
    b(1) := "A"; b(2) := "B"; b(3) := "C";
    c(1) :=  1;  c(2) :=  2;  c(3) :=  3;
    % loop over the arrays                                                   %
    for i := 1 until 3 do write( i_w := 1, s_w := 0, a(i), b(i), c(i) );
end.


-- ZIP LISTS WITH FUNCTION ---------------------------------------------------

-- zipListsWith :: ([a] -> b) -> [[a]] -> [[b]]
on zipListsWith(f, xss)
    set n to length of xss

    script
        on |λ|(_, i)
            script
                on |λ|(xs)
                    item i of xs
                end |λ|
            end script

            if i ≤ n then
                apply(f, (map(result, xss)))
            else
                {}
            end if
        end |λ|
    end script

    if n > 0 then
        map(result, item 1 of xss)
    else
        []
    end if
end zipListsWith

-- TEST  ( zip lists with concat ) -------------------------------------------
on run

    intercalate(linefeed, ¬
        zipListsWith(concat, ¬
            [["a", "b", "c"], ["A", "B", "C"], [1, 2, 3]]))

end run

-- GENERIC FUNCTIONS ---------------------------------------------------------

-- apply (a -> b) -> a -> b
on apply(f, a)
    mReturn(f)'s |λ|(a)
end apply

-- concat :: [[a]] -> [a] | [String] -> String
on concat(xs)
    if length of xs > 0 and class of (item 1 of xs) is string then
        set acc to ""
    else
        set acc to {}
    end if
    repeat with i from 1 to length of xs
        set acc to acc & item i of xs
    end repeat
    acc
end concat

-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
    set {dlm, my text item delimiters} to {my text item delimiters, strText}
    set strJoined to lstText as text
    set my text item delimiters to dlm
    return strJoined
end intercalate

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

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


List1 = a,b,c
List2 = A,B,C
List3 = 1,2,3
MsgBox, % LoopMultiArrays()

List1 = a,b,c,d,e
List2 = A,B,C,D
List3 = 1,2,3
MsgBox, % LoopMultiArrays()

;---------------------------------------------------------------------------
LoopMultiArrays()

 { ; print the ith element of each
;---------------------------------------------------------------------------

    local Result
    StringSplit, List1_, List1, `,
    StringSplit, List2_, List2, `,
    StringSplit, List3_, List3, `,
    Loop, % List1_0
        Result .= List1_%A_Index% List2_%A_Index% List3_%A_Index% "`n"
    Return, Result
}


'a'→{L₁}
'b'→{L₁+1}
'c'→{L₁+2}
'A'→{L₂}
'B'→{L₂+1}
'C'→{L₂+2}
1→{L₃}
2→{L₃+1}
3→{L₃+2}
For(I,0,2)
Disp {L₁+I}►Char,{L₂+I}►Char,{L₃+I}►Dec,i
End


DECLARE a1$[] = {"a", "b", "c"} TYPE STRING
DECLARE a2$[] = {"A", "B", "C"} TYPE STRING
DECLARE a3[] = {1, 2, 3} TYPE int

	WHILE (a3[i] <= 3)
		PRINT  a1$[i], a2$[i], a3[i]
		INCR i
	WEND


      DIM array1$(2), array2$(2), array3%(2)
      array1$() = "a", "b", "c"
      array2$() = "A", "B", "C"
      array3%() = 1, 2, 3

      FOR index% = 0 TO 2
        PRINT array1$(index%) ; array2$(index%) ; array3%(index%)
      NEXT


beads 1 program 'Loop over multiple arrays simultaneously'
calc main_init
	const
		x = ['a', 'b', 'c']
		y = ['A', 'B', 'C']
		z = [1, 2, 3]
	const largest = max(tree_hi(x), tree_hi(y), tree_hi(z))
	loop reps:largest count:i    //where u_cc defines what to use for undefined characters
		log to_str(x[i], u_cc:' ') & to_str(y[i], u_cc:' ') & to_str(z[i], u_cc:' ')


class Program
{
    static void Main(string[] args)
    {
        char[] a = { 'a', 'b', 'c' };
        char[] b = { 'A', 'B', 'C' };
        int[] c = { 1, 2, 3 };
        int min = Math.Min(a.Length, b.Length);
        min = Math.Min(min, c.Length);
        for (int i = 0; i < min; i++)
            Console.WriteLine("{0}{1}{2}", a[i], b[i], c[i]);
    }
}


#include <iostream>
#include <vector>

int main(int argc, char* argv[])
{
   std::vector<char> ls(3); ls[0] = 'a'; ls[1] = 'b'; ls[2] = 'c';
   std::vector<char> us(3); us[0] = 'A'; us[1] = 'B'; us[2] = 'C';
   std::vector<int> ns(3);  ns[0] = 1;   ns[1] = 2;   ns[2] = 3;

   std::vector<char>::const_iterator lIt = ls.begin();
   std::vector<char>::const_iterator uIt = us.begin();
   std::vector<int>::const_iterator nIt = ns.begin();
   for(; lIt != ls.end() && uIt != us.end() && nIt !=
ns.end();
       ++lIt, ++uIt, ++nIt)
   {
      std::cout << *lIt << *uIt << *nIt << "\n";
   }
}


(doseq [s (map #(str %1 %2 %3) "abc" "ABC" "123")]
  (println s))


       IDENTIFICATION DIVISION.
       PROGRAM-ID. Loop-Over-Multiple-Tables.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  A VALUE "abc".
           03  A-Vals PIC X OCCURS 3 TIMES.

       01  B VALUE "ABC".
           03  B-Vals PIC X OCCURS 3 TIMES.

       01  C VALUE "123".
           03  C-Vals PIC 9 OCCURS 3 TIMES.

       01  I PIC 9.

       PROCEDURE DIVISION.
           PERFORM VARYING I FROM 1 BY 1 UNTIL 3 < I
               DISPLAY A-Vals (I) B-Vals (I) C-Vals (I)
           END-PERFORM

           GOBACK
           .


(mapc (lambda (&rest args)
        (format t "~{~A~}~%" args))
      '(|a| |b| |c|)
      '(a b c)
      '(1 2 3))


import std.stdio, std.range;

void main () {
    foreach (a, b, c; zip("abc", "ABC", [1, 2, 3]))
        writeln(a, b, c);
}


program LoopOverArrays;

{$APPTYPE CONSOLE}

uses SysUtils;

const
  ARRAY1: array [1..3] of string = ('a', 'b', 'c');
  ARRAY2: array [1..3] of string = ('A', 'B', 'C');
  ARRAY3: array [1..3] of Integer = (1, 2, 3);
var
  i: Integer;
begin
  for i := 1 to 3 do
    Writeln(Format('%s%s%d', [ARRAY1[i], ARRAY2[i], ARRAY3[i]]));

  Readln;
end.


set_namespace(rosettacode);

add_mat(myMatrix)_row(a,b,c)_row(A,B,C)_row(1,2,3);
add_var(output,columnArray);

with_mat(myMatrix)_foreach()_bycol()_var(columnArray)
    with_var(output)_append()_flat([columnArray])_append(\n);
;

me_msg([output]);

reset_namespace[];


;; looping over different sequences : infinite stream, string, list and vector
;; loop stops as soon a one sequence ends.
;; the (iota 6) = ( 0 1 2 3 4 5) sequence will stop first.

(for ((i (in-naturals 1000)) (j "ABCDEFGHIJK") (k (iota 6)) (m #(o p q r s t u v w)))
    (writeln i j k m))

1000     "A"     0     o
1001     "B"     1     p
1002     "C"     2     q
1003     "D"     3     r
1004     "E"     4     s
1005     "F"     5     t


@public
run = fn () {
    lists.foreach(fn ((A, B, C)) { io.format("~s~n", [[A, B, C]]) },
lists.zip3("abc", "ABC", "123"))
}


example (a_array: READABLE_INDEXABLE [BOUNDED [ANY]]): STRING
		-- Assemble output for a 2-dim array in `a_array'
	require
		non_zero: ∀ nzitem:a_array ¦ nzitem.count > 0
	local
		min_count: INTEGER
	do
		⟳ v_item:a_array ¦
			min_count := if min_count = 0 then
							v_item.count
						else
							v_item.count.min (min_count)
						end
		⟲
		create Result.make_empty
		⟳ j:1 |..| min_count ¦
			⟳ i:a_array ¦
				if attached {READABLE_INDEXABLE [ANY]} i as al_i then
					Result.append_string_general (al_i [j].out)
				end
			⟲
			Result.append_string_general ("%N")
		⟲
	end

input_data: ARRAY [BOUNDED [ANY]]
		-- Sample `input_data' for `example' (above).
	do
		Result := <<
						"abcde",
						"ABC",
						<<1, 2, 3, 4>>
					>>
	end


open monad io list imperative

xs = zipWith3 (\x y z -> show x ++ show y ++ show z) ['a','b','c']
  ['A','B','C'] [1,2,3]

print x = do putStrLn x

print_and_calc xs = do
  xss <- return xs
  return $ each print xss

print_and_calc xs ::: IO


import system'routines;
import extensions;

public program()
{
    var a1 := new string[]{"a","b","c"};
    var a2 := new string[]{"A","B","C"};
    var a3 := new int[]{1,2,3};

    for(int i := 0, i < a1.Length, i += 1)
    {
        console.printLine(a1[i], a2[i], a3[i])
    };

    console.readChar()
}


lists:zipwith3(fun(A,B,C)->
io:format("~s~n",[[A,B,C]]) end, "abc", "ABC", "123").


"abc" "ABC" "123" [ [ write1 ] [email protected] nl ]
3each


class LoopMultiple
{
  public static Void main ()
  {
    List arr1 := ["a", "b", "c"]
    List arr2 := ["A", "B", "C"]
    List arr3 := [1, 2, 3]
    [arr1.size, arr2.size, arr3.size].min.times |Int i|
    {
      echo ("${arr1[i]}${arr2[i]}${arr3[i]}")
    }
  }
}


[a] := [('a','b','c')];
[b] := [('A','B','C')];
[c] := [(1,2,3)];
for i=1,3 do !!(a[i]:char,b[i]:char,c[i]:1) od;
;{note the :char and :1 suffixes. The former}
;{causes the element to be printed as a char}
;{instead of a numerical ASCII code, and the}
;{:1 causes the integer to take up exactly one}
;{space, ie. no leading or trailing spaces.}


create a  char a , char b , char c ,
create b  char A , char B , char C ,
create c  char 1 , char 2 , char 3 ,

: main
  3 0 do cr
    a i cells + @ emit
    b i cells + @ emit
    c i cells + @ emit
  loop
  cr
  a b c
  3 0 do cr
    3 0 do
      rot dup @ emit cell+
    loop
  loop
  drop drop drop
;


program main
 implicit none

 integer,parameter :: n_vals = 3
 character(len=*),dimension(n_vals),parameter :: ls = ['a','b','c']
 character(len=*),dimension(n_vals),parameter :: us = ['A','B','C']
 integer,dimension(n_vals),parameter          :: ns = [1,2,3]

 integer :: i  !counter

 do i=1,n_vals
      write(*,'(A1,A1,I1)') ls(i),us(i),ns(i)
 end do

end program main


' FB 1.05.0 Win64

Function min(x As Integer, y As Integer) As Integer
  Return IIf(x < y, x, y)
End Function

Dim arr1(1 To 3) As String = {"a", "b", "c"}
Dim arr2(1 To 3) As String = {"A", "B", "C"}
Dim arr3(1 To 3) As Integer = {1, 2, 3}

For i As Integer = 1 To 3
  Print arr1(i) & arr2(i) & arr3(i)
Next

Print

' For arrays of different lengths we would need to iterate up to the mimimm length of all 3 in order
' to  get a contribution from each one. For example:

Dim arr4(1 To 4) As String = {"A", "B", "C", "D"}
Dim arr5(1 To 2) As Integer = {1, 2}

Dim ub As Integer = min(UBound(arr1), min(UBound(arr4), UBound(arr5)))
For i As Integer = 1 To ub
  Print arr1(i) & arr2(i) & arr3(i)
Next

Print
Sleep


import lists.zip3

for x <- zip3( ['a', 'b', 'c'], ['A', 'B', 'C'], [1, 2, 3] )
    println( x.mkString() )


Public Sub Main()
Dim a1 As String[] = ["a", "b", "c"]
Dim a2 As String[] = ["A", "B", "C"]
Dim a3 As String[] = ["1", "2", "3"]
Dim siC As Short

For siC = 0 To a1.Max
  Print a1[siC] & a2[siC] & a3[siC]
Next

End


# The Loop function will apply some function to every tuple built by
taking
# the i-th element of each list. If one of them is exhausted before the
others,
# the loop continues at its begining. Only the longests lists will be
precessed only once.
Loop := function(a, f)
    local i, j, m, n, v;
    n := Length(a);
    v := List(a, Length);
    m := Maximum(v);
    for j in [1 .. m] do
        f(List([1 .. n], i -> a[i][1 + RemInt(j - 1, v[i])]));
    od;
end;

# Here we simply print each "row"
f := function(u)
    Perform(u, Print);
    Print("\n");
end;

Loop([["a", "b", "c"], ["A", "B", "C"], [1, 2, 3]], f);

aA1
bB2
cC3

Loop([["a", "b"], ["A", "B", "C", "D", "E"], [1, 2, 3]], f);

aA1
bB2
aC3
bD1
aE2


package main

import "fmt"

var a1 = []string{"a", "b", "c"}
var a2 = []byte{'A', 'B', 'C'}
var a3 = []int{1, 2, 3}

func main() {
	for i := range a1 {
		fmt.Printf("%v%c%v\n", a1[i], a2[i], a3[i])
	}
}


def synchedConcat = { a1, a2, a3 ->
    assert a1 && a2 && a3
    assert a1.size() == a2.size()
    assert a2.size() == a3.size()
    [a1, a2, a3].transpose().collect { "${it[0]}${it[1]}${it[2]}" }
}


PROCEDURE Main()
	LOCAL a1 := { "a", "b", "c" }, ;
	      a2 := { "A", "B", "C", "D" }, ; // the last element "D" of this array will be ignored
	      a3 := { 1, 2, 3 }
	LOCAL e1, e2, e3

	FOR EACH e1, e2, e3 IN a1, a2, a3
		Qout( e1 + e2 + hb_ntos( e3 ) )
	NEXT
	RETURN


{-# LANGUAGE ParallelListComp #-}
main = sequence [ putStrLn [x, y, z] | x <- "abd" | y <- "ABC" | z <- "123"]


using Lambda;
using Std;

class Main
{

	static function main()
	{
		var a = ['a', 'b', 'c'];
		var b = ['A', 'B', 'C'];
		var c = [1, 2, 3];

		//Find smallest array
		var len = [a, b, c]
			.map(function(a) return a.length)
			.fold(Math.min, 0x0FFFFFFF)
			.int();

		for (i in 0...len)
			Sys.println(a[i] + b[i] + c[i].string());
	}
}


CHARACTER :: A = "abc"
REAL ::  C(3)

C = $ ! 1, 2, 3

DO i = 1, 3
   WRITE() A(i), "ABC"(i), C(i)
ENDDO


procedure main()
a := create !["a","b","c"]
b := create !["A","B","C"]
c := create !["1","2","3"]
while write(@a,@b,@c)
end


String[][] list1 = {{"a","b","c"}, {"A", "B", "C"}, {"1", "2", "3"}};
        for (int i = 0; i < list1.length; i++) {
            for (String[] lista : list1) {
                System.out.print(lista[i]);
            }
            System.out.println();
        }


# zip/0 emits [] if input is [].

def zip:
  . as $in
  | [range(0; $in[0]|length) as $i | $in | map( .[$i] ) ];


/* Loop over multiple arrays, in Jsish */
var a1 = ['a', 'b', 'c'];
var a2 = ['A', 'B', 'C'];
var a3 = [1, 2, 3];

puts('Equal sizes');
var arr = [a1, a2, a3];
var m = arr[0].length;
for (var a of arr) if (a.length > m) m = a.length;
for (var i = 0; i < m; i++) printf("%q%q%q\n", a1[i], a2[i], a3[i]);

puts('\nUnequal sizes');
var a4 = [];
var a5 = [4,5,6,7];

arr = [a1, a2, a3, a4, a5];
m = arr[0].length;
for (a of arr) if (a.length > m) m = a.length;
for (i = 0; i < m; i++) printf("%q%q%q%q%q\n", a1[i], a2[i], a3[i], a4[i], a5[i]);

/*
=!EXPECTSTART!=
Equal sizes
aA1
bB2
cC3

Unequal sizes
aA1undefined4
bB2undefined5
cC3undefined6
/home/btiffin/forge/jsi/jsi-test/rosetta/loopOverMultipleArrays.jsi:19: warn: call with undefined var for argument arg 2 '...', in call to 'printf' <undefined>.    (at or near "%q%q%q%q%q
")

undefinedundefinedundefinedundefined7
=!EXPECTEND!=
*/


// version 1.0.6

fun main(args: Array<String>) {
    val a1 = charArrayOf('a', 'b', 'c')
    val a2 = charArrayOf('A', 'B', 'C')
    val a3 = intArrayOf(1, 2, 3)
    for(i in 0 .. 2) println("${a1[i]}${a2[i]}${a3[i]}")
    println()
    // For arrays of different sizes we would need to iterate up to the mimimm size of all 3 in order
    // to  get a contribution from each one.
    val a4 = intArrayOf(4, 5, 6, 7)
    val a5 = charArrayOf('d', 'e')
    val minSize = Math.min(a2.size, Math.min(a4.size, a5.size))  // minimum size of a2, a4 and a5
    for(i in 0 until minSize) println("${a2[i]}${a4[i]}${a5[i]}")
}


1) loop over 3 sentences of equal length and returning 3 sentences

{def A a b c} -> A
{def B A B C} -> B
{def C 1 2 3} -> C

{S.map {lambda {:i} {br}{S.get :i {A}}
                        {S.get :i {B}}
                        {S.get :i {C}} }
       {S.serie 0 {- {S.length {A}} 1}}}
->
a A 1
b B 2
c C 3

2) loop over 3 arrays of equal length and returning 3 arrays

{def maps
 {lambda {:a :b :c}
  {S.map {{lambda {:a :b :c :i}
                 {br}{A.new {A.get :i :a}
                            {A.get :i :b}
                            {A.get :i :c}} } :a :b :c}
         {S.serie 0 {- {A.length :a} 1}}}}}
-> maps

{def P {A.new a b c}} -> P
{def Q {A.new A B C}} -> Q
{def R {A.new 1 2 3}} -> R

{maps {P} {Q} {R}}
->
[a,A,1]
[b,B,2]
[c,C,3]

3) loop over 3 words of inegal length and returning words

{def X James} -> X
{def Y Bond} -> Y
{def Z 007} -> Z

{S.map {lambda {:i} {br}{W.get :i {X}}
                        {W.get :i {Y}}
                        {W.get :i {Z}} }
       {S.serie 0 {- {W.length {X}} 1}}}
->
J B 0
a o 0
m n 7
e d
s


(lists:zipwith3
  (lambda (i j k)
    (io:format "~s~s~p~n" `(,i ,j ,k)))
    '(a b c)
    '(A B C)
    '(1 2 3))


Section Header

+ name := ARRAY_LOOP_TEST;

Section Public

- main <- (
  + a1, a2 : ARRAY[CHARACTER];
  + a3 : ARRAY[INTEGER];

  a1 := ARRAY[CHARACTER].create 1 to 3;
  a2 := ARRAY[CHARACTER].create 1 to 3;
  a3 := ARRAY[INTEGER].create 1 to 3;

  1.to 3 do { i : INTEGER;
    a1.put ((i - 1 + 'a'.code).to_character) to i;
    a2.put ((i - 1 + 'A'.code).to_character) to i;
    a3.put i to i;
  };

  1.to 3 do { i : INTEGER;
    a1.item(i).print;
    a2.item(i).print;
    a3.item(i).print;
    '\n'.print;
  };
);


command loopArrays
    local lowA, uppA, nums, z
    put "a,b,c" into lowA
    put "A,B,C" into uppA
    put "1,2,3" into nums

    split lowA by comma
    split uppA by comma
    split nums by comma

    repeat with n = 1 to the number of elements of lowA
        put lowA[n] & uppA[n] & nums[n] & return after z
    end repeat
    put z

end loopArrays


show (map [(word ?1 ?2 ?3)] [a b c] [A B C] [1 2 3])
 ; [aA1 bB2 cC3]

(foreach [a b c] [A B C] [1 2 3] [print (word ?1 ?2 ?3)])  ; as above,
one per line


# Set up
L := [["a", "b", "c"],["A", "B", "C"], ["1", "2", "3"]];
M := Array(1..3, 1..3, L);

multi_loop := proc(M)
	local i, j;
	for i from 1 to upperbound(M, 1) do
		for j from 1 to upperbound(M, 2) do
			printf("%s", M[j, i]);
		end do;
		printf("\n");
	end do;
end proc:

multi_loop(M);


:- module multi_array_loop.
:- interface.

:- import_module io.
:- pred main(io::di, io::uo) is det.

:- implementation.
:- import_module char, list, string.

main(!IO) :-
    A = ['a', 'b', 'c'],
    B = ['A', 'B', 'C'],
    C = [1, 2, 3],
    list.foldl_corresponding3(print_elems, A, B, C, !IO).

:- pred print_elems(char::in, char::in, int::in, io::di, io::uo) is det.

print_elems(A, B, C, !IO) :-
    io.format("%c%c%i\n", [c(A), c(B), i(C)], !IO).


MODULE MultiArray EXPORTS Main;

IMPORT IO, Fmt;

TYPE ArrIdx = [1..3];

VAR
  arr1 := ARRAY ArrIdx OF CHAR {'a', 'b', 'c'};
  arr2 := ARRAY ArrIdx OF CHAR {'A', 'B', 'C'};
  arr3 := ARRAY ArrIdx OF INTEGER {1, 2, 3};

BEGIN
  FOR i := FIRST(ArrIdx) TO LAST(ArrIdx) DO
    IO.Put(Fmt.Char(arr1[i]) & Fmt.Char(arr2[i]) &
Fmt.Int(arr3[i]) & "\n");
  END;
END MultiArray.


list1 = {{"a","b","c"}, {"A","B","C"}, {"1","2","3"}}
for i in range(0, len(list1) - 1)
    for lista in list1
        print lista[i]
    end for
    println
end for


using System;
using System.Console;

module LoopMultiple
{
    Zip3[T1, T2, T3] (x : list[T1], y : list[T2], z : list[T3]) :
list[T1 * T2 * T3]
    {
        |(x::xs, y::ys, z::zs) => (x, y, z)::Zip3(xs, ys, zs)
        |([], [], [])          => []
        |(_, _, [])            => throw ArgumentNullException()
        |(_, [], _)            => throw ArgumentNullException()
        |([], _, _)            => throw ArgumentNullException()
    }

    Main() : void
    {
        def first  = ['a', 'b', 'c'];
        def second = ["A", "B", "C"];
        def third  = [1, 2, 3];

        foreach ((x, y, z) in Zip3(first, second, third))
            WriteLine($"$x$y$z");
    }
}


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

say 'Using arrays'
aa = ['a', 'b', 'c', 'd']
bb = ['A', 'B', 'C']
cc = [1, 2, 3, 4]

loop x_ = 0 for aa.length
  do
    ax = aa[x_]
  catch ArrayIndexOutOfBoundsException
    ax = ' '
  end
  do
    bx = bb[x_]
  catch ArrayIndexOutOfBoundsException
    bx = ' '
  end
  do
    cx = cc[x_]
  catch ArrayIndexOutOfBoundsException
    cx = ' '
  end

  say ax || bx || cx
  end x_

say 'Using indexed strings (associative arrays)'
ai = sampleData('a b c d')
bi = sampleData('A B C')
ci = sampleData('1 2 3 4')

loop x_ = 1 to ai[0]
  say ai[x_] || bi[x_] || ci[x_]
  end x_

method sampleData(arg) public static returns Rexx
  smp = ' '
  smp[0] = arg.words
  loop i_ = 1 to smp[0]
    smp[i_] = arg.word(i_)
    end i_

  return smp


(map println '(a b c) '(A B C) '(1 2
3))


MODULE LoopMArrays;
IMPORT
	Out;
VAR
	x,y: ARRAY 3 OF CHAR;
	z: ARRAY 3 OF INTEGER;

PROCEDURE DoLoop;
VAR
	i: INTEGER;
BEGIN
	i := 0;
	WHILE i < LEN(x) DO
		Out.Char(x[i]);Out.Char(y[i]);Out.LongInt(z[i],0);Out.Ln;
		INC(i)
	END
END DoLoop;

BEGIN
	x[0] := 'a';y[0] := 'A';z[0] := 1;
	x[1] := 'b';y[1] := 'B';z[1] := 2;
	x[2] := 'c';y[2] := 'C';z[2] := 3;
	DoLoop
END LoopMArrays.


class MultipleArrayAccess {
  function : Main(args : String[]) ~ Nil {
    a := ["a", "b", "c"];
    b := ["A", "B", "C"];
    c := [1, 2, 3];

    each(i : a) {
      a[i]->Append(b[i]);
      a[i]->Append(c[i]);
      a[i]->PrintLine();
    };
  }
}


let a1 = [| 'a'; 'b'; 'c' |]
and a2 = [| 'A'; 'B'; 'C' |]
and a3 = [| '1'; '2'; '3' |] ;;

Array.iteri (fun i c1 ->
  print_char c1;
  print_char a2.(i);
  print_char a3.(i);
  print_newline()
) a1 ;;


x = .array~of("a", "b", "c")
y = .array~of("A", "B", "C")
z = .array~of(1, 2, 3)

loop i = 1 to x~size
    say x[i]y[i]z[i]
end


for
   I in [a b c]
   J in ['A' 'B' 'C']
   K in [1 2 3]
do
   {System.showInfo I#J#K}
end


procedure print3(sequence a, b, c)
    for i=1 to min({length(a),length(b),length(c)}) do
        printf(1, "%s%s%g\n", {a[i], b[i], c[i]})
    end for
end procedure

print3("abc","ABC",{1, 2, 3})
?columnize({"abc","ABC","1234"},{},' ')


include ..\Utilitys.pmt

( "abc" "ABC" "123" )

len var dim1
1 get len var dim2 drop

dim1 for
    var i
    dim2 for
        var j
        ( j i ) sget tochar print
    endfor
    nl
endfor


$a = array('a', 'b', 'c');
$b = array('A', 'B', 'C');
$c = array('1', '2', '3'); //These don't *have* to be strings, but it
saves PHP from casting them later

if ((sizeOf($a) !== sizeOf($b)) || (sizeOf($b) !== sizeOf($c))){
  throw new Exception('All three arrays must be the same length');
}
foreach ($a as $key => $value){
  echo "{$a[$key]}{$b[$key]}{$c[$key]}\n";
}


import util.

go =>

  L1 = ["a","b","c"],
  L2 = ["A","B","C"],
  L3 = ["1","2","3"],

  println("foreach loop:"),
  foreach({A,B,C} in zip(L1,L2,L3))
    println([A,B,C].join(''))
  end,
  nl,

  println("list comprehension/n:"),
  println( [[A,B,C].join('') : {A,B,C} in zip(L1,L2,L3)].join("\n")),
  nl,

  % With uneven lengths the last elements in the longer lists are skipped.
  println("Uneven lengths:"),
  L4 = ["P","Q","R","S"], % longer than the other
  foreach({A,B,C,D} in zip(L1,L2,L3,L4))
    println([A,B,C,D].join(''))
  end,
  nl.


(mapc prinl
   '(a b c)
   '(A B C)
   (1 2 3) )


    array a1 = ({ "a", "b", "c" });
    array a2 = ({ "A", "B", "C" });
    array a3 = ({ "1", "2", "3" });

    foreach(a1; int index; string char_dummy)
        write("%s%s%s\n", a1[index], a2[index], a3[index]);


declare P(3) character (1) initial ('a', 'b', 'c'),
        Q(3) character (1) initial ('A', 'B', 'C'),
        R(3) fixed decimal (1) initial (1, 2, 3);

do i = lbound(P,1) to hbound(P,1);
   put skip edit (P(i), Q(i), R(i)) (2 A, F(1));
end;


% transpose is defined in initlib like this.
/transpose {
    [ exch {
        { {empty? exch pop} map all?} {pop exit} ift
        [ exch {} {uncons {exch cons} dip exch} fold counttomark 1 roll]
 uncons
    } loop ] {reverse} map
}.

% using it.
[[/a /b /c] [/A /B /C] [1 2 3]] transpose


FUNCTION PBMAIN () AS LONG
    DIM x(2), y(2) AS STRING * 1
    DIM z(2) AS LONG

    'data
    ARRAY ASSIGN x() = ("a", "b", "c")
    ARRAY ASSIGN y() = ("A", "B", "C")
    ARRAY ASSIGN z() = (1, 2, 3)

    'set upper bound
    C& = UBOUND(x)
    IF UBOUND(y) > C& THEN C& = UBOUND(y)
    IF UBOUND(z) > C& THEN C& = UBOUND(z)

    OPEN "output.txt" FOR OUTPUT AS 1
    FOR L& = 0 TO C&
        IF L& <= UBOUND(x) THEN PRINT #1, x(L&);
        IF L& <= UBOUND(y) THEN PRINT #1, y(L&);
        IF L& <= UBOUND(z) THEN PRINT #1, TRIM$(STR$(z(L&)));
        PRINT #1,
    NEXT
    CLOSE
END FUNCTION


multiple_arrays(L1, L2, L3) :-
	maplist(display, L1, L2, L3).

display(A,B,C) :-
	writef('%s%s%s\n', [[A],[B],[C]]).


OpenConsole()
; Fill arrays
Dim a.s(2)
Dim b.s(2)
Dim c(2)
For Arrayposition = 0 To ArraySize(a())
  a(Arrayposition) = Chr(Asc("a") + Arrayposition)
  b(Arrayposition) = Chr(Asc("A") + Arrayposition)
  c(Arrayposition) = Arrayposition + 1
Next
; loop over them
For Arrayposition = 0 To ArraySize(a())
  PrintN(a(Arrayposition) + b(Arrayposition) + Str(c(Arrayposition)))
Next
Input() ;wait for Enter before ending


>>> print ( '\n'.join(''.join(x) for x in
zip('abc', 'ABC', '123')) )
aA1
bB2
cC3
>>>


  [ rot witheach
      [ emit
        over i^ peek emit
        dup  i^ peek emit
        cr ]
    2drop ]               is task ( $ $ $ --> )

  $ "abc"  $ "ABC"  $ "123"  task


multiloop <- function(...)
{
   # Retrieve inputs and convert to a list of character strings
   arguments <- lapply(list(...), as.character)

   # Get length of each input
   lengths <- sapply(arguments, length)

   # Loop over elements
   for(i in seq_len(max(lengths)))
   {
      # Loop over inputs
      for(j in seq_len(nargs()))
      {
         # print a value or a space (if that input has finished)
         cat(ifelse(i <= lengths[j], arguments[[j]][i], " "))
      }
      cat("\n")
   }
}
multiloop(letters[1:3], LETTERS[1:3], 1:3)


#lang racket

(for ([x '(a b c)] ; list
      [y #(A B C)] ; vector
      [z "123"]
      [i (in-naturals 1)]) ; 1, 2, ... infinitely
  (printf "~s: ~s ~s ~s\n" i x y z))


/*REXX program shows how to  simultaneously  loop over  multiple arrays.*/
x. = ' ';      x.1 =  "a";      x.2 = 'b';      x.3 = "c"
y. = ' ';      y.1 =  "A";      y.2 = 'B';      y.3 = "C"
z. = ' ';      z.1 =  "1";      z.2 = '2';      z.3 = "3"

           do j=1  until output=''
           output = x.j || y.j || z.j
           say output
           end    /*j*/                /*stick a fork in it, we're done.*/


array1 = ["a", "b", "c"]
array2 = ["A", "B", "C"]
array3 = [1, 2, 3]

for n = 1 to 3
    see array1[n] + array2[n] + array3[n] + nl
next


for i = 1 to 3
 a$(i) = chr$(i+96)
 b$(i) = chr$(i+64)
 c(i)  = i
next i

for i = 1 to 3
    print a$(i);b$(i);c(i)
next


// First, we'll define a general-purpose zip() to zip
 any
// number of lists together.
function zip(...)
  {
    variable result;
    variable list_num := 0;
    iterate(arg; arguments)
      {
        variable elem_num := 0;
        iterate (x; arg)
          {
            result[elem_num][list_num] := x;
            ++elem_num;
          };
        ++list_num;
      };
    return result;
  };

immutable a := ["a", "b", "c"],
          b := ["A", "B", "C"],
          c := [1, 2, 3];
iterate (x; zip(a, b, c))
    print(x[0], x[1], x[2], "\n");;


class MAIN is
  main is
    a :ARRAY{STR} := |"a", "b", "c"|;
    b :ARRAY{STR} := |"A", "B", "C"|;
    c :ARRAY{STR} := |"1", "2", "3"|;
    loop
      #OUT + a.elt! + b.elt! + c.elt! + "\n";
    end;
  end;
end;


("abc", "ABC", "123").zipped foreach { (x, y, z) =>
  println(x.toString + y + z)
}


(let ((a '("a" "b" "c"))
      (b '("A" "B" "C"))
      (c '(1 2 3)))
  (for-each
    (lambda (i1 i2 i3)
      (display i1)
      (display i2)
      (display i3)
      (newline))
    a b c))


|a b c|
a := OrderedCollection new addAll: #('a' 'b' 'c').
b := OrderedCollection new addAll: #('A' 'B' 'C').
c := OrderedCollection new addAll: #(1 2 3).

1 to: (a size) do: [ :i |
  (a at: i) display.
  (b at: i) display.
  (c at: i) displayNl.
].


(*
 * val combine_lists : string list list -> string list
 *)
fun combine_lists nil = nil
|   combine_lists (l1::ls) = List.foldl (ListPair.map (fn (x,y) => y ^
 x)) l1 ls;

(* ["a1Ax","b2By","c3Cz"] *)
combine_lists[["a","b","c"],["1","2","3"],["A","B","C"],["x","y","z"]];


local u a b c
local v A B C
matrix w=1,2,3
forv i=1/3 {
	di "`: word `i' of `u''`: word `i' of `v''`=el("w",1,`i')'"
}


set list1 {a b c}
set list2 {A B C}
set list3 {1 2 3}
foreach i $list1 j $list2 k $list3 {
    puts "$i$j$k"
}


$$ MODE TUSCRIPT
arr1="a'b'c"
arr2="a'b'C"
arr3="1'2'3"
LOOP a=arr1,b=arr2,c=arr3
PRINT a,b,c
ENDLOOP


$ txr -c '@(bind a ("a" "b" "c"))
@(bind b ("A" "B" "C"))
@(bind c ("1" "2" "3"))
@(output)
@  (repeat)
@[email protected]@c
@  (end)
@(end)'
aA1
bB2
cC3


// Loop over multiple arrays simultaneously
var arr1: string[] = ['a', 'b', 'c'];
var arr2: string[] = ['A', 'B', 'C'];
var arr3: number[] = [1, 2, 3];
for (var i = 0; i <= 2; i++)
  console.log(`${arr1[i]}${arr2[i]}${arr3[i]}`);


a=a:b:c
b=A:B:C
c=1:2:3

oldifs=$IFS
IFS=:
i=0
for wa in $a; do
	set -- $b; shift $i; wb=$1
	set -- $c; shift $i; wc=$1

	printf '%s%s%s\n' $wa $wb $wc

	i=`expr $i + 1`
done
IFS=$oldifs


> decl string<> a b c
> append (split "abc" "") a
> append (split "ABC" "") b
> append (split "123" "") c
> for (decl int i) (< i (size a)) (inc i)
..	out a<i> b<i> c<i> endl console
..end
aA1
bB2
cC3
> _


' Loop over multiple arrays simultaneously - VBA - 08/02/2021

Sub Main()
	a = Array("a","b","c")
	b = Array("A","B","C")
	c = Array(1,2,3)
	For i = LBound(a) To UBound(a)
		buf = buf & vbCrLf & a(i) & b(i) & c(i)
	Next
	Debug.Print Mid(buf,3)
End Sub


' Loop over multiple arrays simultaneously - VBScript - 08/02/2021

a = Array("a","b","c")
b = Array("A","B","C")
c = Array(1,2,3)
For i = LBound(a) To UBound(a)
    buf = buf & vbCrLf & a(i) & b(i) & c(i)
Next
WScript.Echo Mid(buf,3)


Module Program
    Sub Main()
        Dim a As Char() = {"a"c, "b"c, "c"c}
        Dim b As Char() = {"A"c, "B"c, "C"c}
        Dim c As Integer() = {1, 2, 3}

        Dim minLength = {a.Length, b.Length, c.Length}.Min()
        For i = 0 To minLength - 1
            Console.WriteLine(a(i) & b(i) & c(i))
        Next

        Console.WriteLine()

        For Each el As (a As Char, b As Char, c As Integer) In a.Zip(b, Function(l, r) (l, r)).Zip(c, Function(x, r) (x.l, x.r, r))
            Console.WriteLine(el.a & el.b & el.c)
        Next
    End Sub
End Module


LOCAL i As Integer, n As Integer, c As String
LOCAL ARRAY a1[3], a2[3], a3[4], a[3]
*!* Populate the arrays and store the array lengths in a
a1[1] = "a"
a1[2] = "b"
a1[3] = "c"
a[1] = ALEN(a1)
a2[1] = "A"
a2[2] = "B"
a2[3] = "C"
a[2] = ALEN(a2)
a3[1] = "1"
a3[2] = "2"
a3[3] = "3"
a3[4] = "4"
a[3] = ALEN(a3)
*!* Find the maximum length of the arrays
*!* In this case, 4
n = MAX(a[1], a[2], a[3])
? "Simple Loop"
FOR i = 1 TO n
    c = ""
    c = c + IIF(i <= a[1], a1[i], "#")
    c = c + IIF(i <= a[2], a2[i], "#")
    c = c + IIF(i <= a[3], a3[i], "#")
   ? c
ENDFOR
*!* Solution using a cursor
CREATE CURSOR tmp (c1 C(1), c2 C(1), c3 C(1), c4 C(3))
INSERT INTO tmp (c1, c2, c3) VALUES ("a", "A", "1")
INSERT INTO tmp (c1, c2, c3) VALUES ("b", "B", "2")
INSERT INTO tmp (c1, c2, c3) VALUES ("c", "C", "3")
INSERT INTO tmp (c1, c2, c3) VALUES ("#", "#", "4")
REPLACE c4 WITH c1 + c2 + c3 ALL
? "Solution using a cursor"
LIST OFF FIELDS c4


each (x X n) (zip '(a b c) '(A B C) '(1 2 3))
  prn x X n


extern _printf

section .data
    arr1 dd 3,"a","b","c" ;first dword saves the length
    arr2 dd 3,"A","B","C"
    arr3 dd 3,"1","2","3"

section .bss
    arrLocation resd 4
    tempOutput resd 2

section .text
global _main
_main:
    mov [arrLocation], dword arr1
    mov [arrLocation+4], dword arr2
    mov [arrLocation+8], dword arr3
    mov [arrLocation+12], dword 0 ;signales end
    mov [tempOutput+4], dword 0 ;dword 0 signales end of string

    mov ecx, 1 ;not 0 as in 0 the length is saved
    looping:
        mov ebx, 0 ;0 as arrLocation doesn't save length
        inloop:
            mov eax, [arrLocation+ebx*4] ;get ebxth arr address
            cmp eax, 0 ;if we don't get an address incresse index
            je incecx
            cmp ecx, [eax] ;when ecx is greater then the length of the current array we end
            jg end
            mov edx, [eax + ecx*4] ;get char at index ecx from arr
            mov [tempOutput], edx ;setup for _printf
            push ecx ;save ecx
            push tempOutput ;parameter for _printf
            call _printf
            add esp, 4 ;garbage collecting
            pop ecx ;restore ecx
            inc ebx ;get next arr
            jmp inloop
    incecx:
        mov [tempOutput], dword 0x0a ;after we print every element at the nth index we print a \n
        push ecx
        push tempOutput
        call _printf
        add esp, 4
        pop ecx
        inc ecx ;increase index
        jmp looping

    end:
        xor eax, eax
        ret


' Loop over multiple arrays simultaneously
PROGRAM "loopoverarrays"

DECLARE FUNCTION Entry()

FUNCTION Entry()
  DIM arr1$[2], arr2$[2], arr3%[2]
  arr1$[0] = "a": arr1$[1] = "b": arr1$[2] = "c"
  arr2$[0] = "A": arr2$[1] = "B": arr2$[2] = "C"
  arr3%[0] = 1:   arr3%[1] = 2:   arr3%[2] = 3
  FOR i% = 0 TO 2
    PRINT arr1$[i%]; arr2$[i%]; FORMAT$("#", arr3%[i%])
  NEXT i%
END FUNCTION
END PROGRAM


string 0;               \use zero terminated strings
include c:\cxpl\codes;  \intrinsic 'code' declarations
char A1, A2;
int A3, I;
[A1:= "abc";
 A2:= "ABC";
 A3:= [1,2,3];
 for I:= 0 to 2 do
        [ChOut(0, A1(I));
         ChOut(0, A2(I));
        IntOut(0, A3(I));
        CrLf(0);
        ];
]


org &1000

ld b,3
ld ix,array1
loop:
ld a,(ix)
call &bb5a   ;prints character to screen
ld a,(ix+3)
call &bb5a
ld a,(ix+6)
call &bb5a
ld a,13
call &bb5a
ld a,10
call &bb5a
inc ix
djnz loop

ret
array1:
  db "abc"
array2:
  db "ABC"
array3:
  db "123"


10 LET sza = 3: REM size of a
20 LET szb = 3: REM size of b
30 LET szc = 3: REM size of c
40 DIM a$(sza): DIM b$(szb): DIM c$(szc)
50 LET max = sza: REM assume a is the biggest
60 IF szb > max THEN LET max = szb: REM now try b
70 IF szc > max THEN LET max = szc: REM or c
80 REM populate our arrays, and as a bonus we already have our demo loop
90 REM we might as well print as we populate showing the arrays in
columns
100 FOR l = 1 TO max
110 IF l <= sza THEN READ a$(l): PRINT a$(l);
120 IF l <= szb THEN READ b$(l): PRINT b$(l);
130 IF l <= szc THEN READ c$(l): PRINT c$(l);
140 PRINT: REM newline
150 NEXT l
150 PRINT "The arrays are shown in columns."
160 PRINT "A$ runs down the left hand side,"
170 PRINT "and C$ runs down the right."
180 STOP
200 DATA "a","b","c","A","B","C","1","2","3"


F lookandsay(=number)
   V result = ‘’
   V repeat = number[0]
   number = number[1..]‘ ’
   V times = 1

   L(actual) number
      I actual != repeat
         result ‘’= String(times)‘’repeat
         times = 1
         repeat = actual
      E
         times++
   R result

V num = ‘1’

L 10
   print(num)
   num = lookandsay(num)


bdos:		equ	5	; CP/M calls
puts:		equ	9

nmemb:		equ	15	; Change this to print more or fewer members

		org	100h

		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Generate and output members of the sequence
		mvi	b,nmemb	; Counter

outloop:	push	b	; Preserve counter across calls

		mvi	c,puts	; Output current member
		lxi	d,memb
		call	bdos	; And newline
		mvi	c,puts
		lxi	d,newline
		call	bdos

		lxi	h,memb	; Generate next member
		call	looksay

		pop	b	; Restore counter
		dcr	b	; Done yet?
		jnz	outloop
		rst	0

		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Given a $-terminated string under HL, representing
		;; a member of the look and say sequence, generate
		;; the next one in place (ish). The memory after the
		;; string is assumed to be free.
looksay:	push	h	; Save start of string on stack
		mov	d,h	; And in DE
		mov	e,l
		mvi	a,'$'	; Find end of string
findend:	cmp	m
		inx	h
		jnz	findend
		xchg		; HL=string, DE=destination
		push	d	; Save start of new string on stack

lookchar:	mvi	b,0	; Zero counter
lookloop:	mov	a,m	; Get current character
		inr	b	; Compare next character
		inx	h
		cmp	m	; While it is the same, keep going
		jz	lookloop

		mov	c,a	; Keep character
		mvi	a,'0'	; There are B amount of these characters
		add	b
		stax	d	; Store the amount
		inx	d	; And in the next location
		mov	a,c 	; Store the character
		stax	d
		inx	d

		mvi	a,'$'	; Are we done?
		cmp	m
		jnz	lookchar	; If not, do next character
		stax	d	; If yes, terminate new string

		;; Free up memory by copying the new string to where the old
		;; string began.
		pop	d	; Start of new string
		pop	h	; Start of old string
copyloop:	ldax	d	; Get char from new string
		mov	m,a	; Store char where old string was
		cpi	'$'	; are we done yet?
		inx	d
		inx	h
		jnz	copyloop
		ret

		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
newline:	db	13,10,'$'
		;; This is where the string will be stored.
memb:		db	'1$'	; First item
		; Due to how CP/M loads programs, the memory after here
		; is free until we hit the stack.


		bits	16
		cpu	8086
puts:		equ	9h	; MS/DOS system call to print a string
nmemb:		equ	15	; Change this to print more or fewer members
section		.text
		org	100h
		mov	cx,nmemb	; CX = how many members to print
outloop:	mov	dx,memb		; Print current member
		mov	ah,puts
		int	21h
		mov	dx,newline	; Print newline
		int	21h
		mov	di,memb		; Generate next member
		call	looksay
		loop	outloop		; Decrease CX, and loop until zero.
		ret			; Go back to DOS.
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;;; Given a look and say string in ES:DI, generate the next
		;;; one in place. Assumption: DS = ES.
looksay:	push	cx		; Keep the counter register
		mov	si,di		; Store pointer to string begin in SI
		mov	bx,di		; And another in BX
		mov	al,'$'		; Find the end of the string
		xor	cx,cx		; Max. 65535 tries
		dec	cx
		repne	scasb		; The 8086 has dedicated string search
		mov	dx,di		; Store copy of start of new str in DX
		;;; Process one character
.procchar:	mov	al,'0'		; Set counter to ASCII 0
		mov	ah,[bx]		; Get current character of string
		cmp	ah,'$'		; Done?
		je	.done
.samechar:	inc	bx 		; Increment pointer
		inc	al		; Increment counter
		cmp	ah,[bx]		; Still the same character?
		je	.samechar	; If yes, test next character
		mov	[di],ax		; Store counter and character
		inc	di		; Move ahead two characters
		inc	di
		jmp	.procchar	; Do next character
		;;; Copy new string into old location
.done:		mov	byte [di],'$'	; Terminate the string
		mov	cx,di		; Calculate how many bytes to copy
		sub	cx,dx		; end + 1 - start, so one too few here
		shr 	cx,1		; Divide by 2 = words
		inc	cx		; Compensate for the missing +1
		mov	di,dx		; Pointer to begin of new string
		xchg	si,di		; Set SI = new string and DI = old
		rep	movsw		; Copy 16 bits at a time
		pop	cx		; Restore counter register
		ret
section		.data
newline:	db	13,10,'$'	; Newline to print in between members
memb:		db	'1$'	; This is where the current member is stored


BYTE FUNC GetLength(CHAR ARRAY s BYTE pos)
  CHAR c
  BYTE len

  c=s(pos)
  len=1
  DO
    pos==+1
    IF pos<=s(0) AND s(pos)=c THEN
      len==+1
    ELSE
      EXIT
    FI
  OD
RETURN (len)

PROC Append(CHAR ARRAY text,suffix)
  BYTE POINTER srcPtr,dstPtr
  BYTE len

  len=suffix(0)
  IF text(0)+len>255 THEN
    len=255-text(0)
  FI
  IF len THEN
    srcPtr=suffix+1
    dstPtr=text+text(0)+1
    MoveBlock(dstPtr,srcPtr,len)
    text(0)==+suffix(0)
  FI
RETURN

PROC LookAndSay(CHAR ARRAY in,out)
  BYTE pos,len
  CHAR ARRAY tmp(5)

  pos=1 len=0 out(0)=0
  WHILE pos<=in(0)
  DO
    len=GetLength(in,pos)
    StrB(len,tmp)
    Append(out,tmp)
    out(0)==+1
    out(out(0))=in(pos)
    pos==+len
  OD
RETURN

PROC Main()
  CHAR ARRAY s1(256),s2(256)
  BYTE i

  SCopy(s1,"1")
  PrintE(s1)
  FOR i=1 TO 11
  DO
    IF (i&1)=0 THEN
      LookAndSay(s2,s1)
      PrintE(s1)
    ELSE
      LookAndSay(s1,s2)
      PrintE(s2)
    FI
  OD
RETURN


with Ada.Text_IO, Ada.Strings.Fixed;
use  Ada.Text_IO, Ada.Strings, Ada.Strings.Fixed;

function "+" (S : String) return String is
   Item : constant Character := S (S'First);
begin
   for Index in S'First + 1..S'Last loop
      if Item /= S (Index) then
         return Trim (Integer'Image (Index - S'First), Both) & Item & (+(S (Index..S'Last)));
      end if;
   end loop;
   return Trim (Integer'Image (S'Length), Both) & Item;
end "+";


OP + = (STRING s)STRING:
BEGIN
   CHAR item = s[LWB s];
   STRING out;
   FOR index FROM LWB s + 1 TO UPB s DO
      IF item /= s [index] THEN
         out := whole(index - LWB s, 0) + item + (+(s [index:UPB s]));
         GO TO return out
      FI
   OD;
   out := whole (UPB s, 0) + item;
   return out: out
END  # + #;

OP + = (CHAR s)STRING:
  + STRING(s);

print ((+"1", new line));
print ((+(+"1"), new line));
print ((+(+(+"1")), new line));
print ((+(+(+(+"1"))), new line));
print ((+(+(+(+(+"1")))), new line));
print ((+(+(+(+(+(+"1"))))), new line));
print ((+(+(+(+(+(+(+"1")))))), new line));
print ((+(+(+(+(+(+(+(+"1"))))))), new line));
print ((+(+(+(+(+(+(+(+(+"1")))))))), new line));
print ((+(+(+(+(+(+(+(+(+(+"1"))))))))), new line))


begin
    string(1) function digit(n);
    integer n;
    case n of begin
        digit := "0";   digit := "1";   digit := "2";
        digit := "3";   digit := "4";   digit := "5";
        digit := "6";   digit := "7";   digit := "8";
        digit := "9";
    end;

    string(1) array cur[1:128];
    string(1) array next[1:128];
    integer curlen, i, cnt, j, n;

    cur[1] := "1";
    curlen := 1;

    for n := 1 step 1 until 15 do begin
        write("");
        for i := 1 step 1 until curlen do
            writeon(cur[i]);

        i := j := 1;
        while i <= curlen do begin
            cnt := 1;
            while cur[i + cnt] = cur[i] do
                cnt := cnt + 1;
            next[j] := digit(cnt);
            next[j + 1] := cur[i];
            j := j + 2;
            i := i + cnt;
        end;

        for i := 1 step 1 until j-1 do
            cur[i] := next[i];

        curlen := j - 1;
    end;
end


on lookAndSay(startNumber, howMany)
    if (howMany < 1) then return {}

    -- The numbers are handled as lists of digit-value integers for efficiency and output as a list of strings.
    script o
        property previousNumber : {}
        property newNumber : {}
        property output : {}
    end script

    -- "Digitise" the start number.
    repeat
        set beginning of o's newNumber to startNumber mod 10 as integer
        set startNumber to startNumber div 10
        if (startNumber is 0) then exit repeat
    end repeat
    -- Add it to the output as text and successively derive the remaining numbers.
    set astid to AppleScript's text item delimiters
    set AppleScript's text item delimiters to ""
    set end of o's output to o's newNumber as text
    repeat (howMany - 1) times
        set o's previousNumber to o's newNumber
        set o's newNumber to {}
        set i to 1
        set previousLength to (o's previousNumber's length)
        set currentDigit to beginning of o's previousNumber
        repeat with j from 2 to previousLength
            set thisDigit to item j of o's previousNumber
            if (thisDigit is not currentDigit) then
                set end of o's newNumber to j - i
                set end of o's newNumber to currentDigit
                set i to j
                set currentDigit to thisDigit
            end if
        end repeat
        set end of o's newNumber to previousLength - i + 1
        set end of o's newNumber to currentDigit

        set end of o's output to o's newNumber as text
    end repeat
    set AppleScript's text item delimiters to astid

    return o's output
end lookAndSay

-- Test code:
return lookAndSay(1, 10)


lookAndSay: function [n][
    if n=0 -> return "1"
    previous: lookAndSay n-1

    result: new ""
    currentCounter: 0
    currentCh: first previous
    loop previous 'ch [
        if? currentCh <> ch [
            if not? zero? currentCounter ->
                'result ++ (to :string currentCounter) ++ currentCh
            currentCounter: 1
            currentCh: ch
        ]
        else ->
            currentCounter: currentCounter + 1
    ]
    'result ++ (to :string currentCounter) ++ currentCh
    return result
]

loop 0..10 'x [
    print [x "->" lookAndSay x]
]


AutoExecute:
    Gui, -MinimizeBox
    Gui, Add, Edit, w500 r20 vInput, 1
    Gui, Add, Button, x155 w100 Default, &Calculate
    Gui, Add, Button, xp+110 yp wp, E&xit
    Gui, Show,, Look-and-Say sequence
Return

ButtonCalculate:
    Gui, Submit, NoHide
    GuiControl,, Input, % LookAndSay(Input)
Return

GuiClose:
ButtonExit:
    ExitApp
Return

;---------------------------------------------------------------------------
LookAndSay(Input) {
;---------------------------------------------------------------------------
    ; credit for this function goes to AutoHotkey forum member Laslo
    ; http://www.autohotkey.com/forum/topic44657-161.html
    ;-----------------------------------------------------------------------
    Loop, Parse, Input          ; look at every digit
        If (A_LoopField = d)    ; I've got another one! (of the same value)
            c += 1                  ; Let's count them ...
        Else {                  ; No, this one is different!
            r .= c d                ; remember what we've got so far
            c := 1                  ; It is the first one in a row
            d := A_LoopField        ; Which one is it?
        }
    Return, r c d
}


function lookandsay(a)
{
  s = ""
  c = 1
  p = substr(a, 1, 1)
  for(i=2; i <= length(a); i++) {
    if ( p == substr(a, i, 1) ) {
      c++
    } else {
      s = s sprintf("%d%s", c, p)
      p = substr(a, i, 1)
      c = 1
    }
  }
  s = s sprintf("%d%s", c, p)
  return s
}

BEGIN {
  b = "1"
  print b
  for(k=1; k <= 10; k++) {
    b = lookandsay(b)
    print b
  }
}


# look and say

dim a$(2)

i = 0  # input string index

a$[i] = "1"

print a$[i]

for n=1 to 10
  j = 1 - i  # output string index
  a$[j] = ""
  k = 1
  while (k <= length(a$[i]))
    k0 = k + 1
    while ((k0 <= length(a$[i])) and (mid(a$[i], k, 1) = mid(a$[i], k0, 1)))
      k0 = k0 + 1
    end while
    a$[j] += string(k0 - k) + mid(a$[i], k, 1)
    k = k0
  end while
  i = j
  print a$[j]
next n


      number$ = "1"
      FOR i% = 1 TO 10
        number$ = FNlooksay(number$)
        PRINT number$
      NEXT
      END

      DEF FNlooksay(n$)
      LOCAL i%, j%, c$, o$
      i% = 1
      REPEAT
        c$ = MID$(n$,i%,1)
        j% = i% + 1
        WHILE MID$(n$,j%,1) = c$
          j% += 1
        ENDWHILE
        o$ += STR$(j%-i%) + c$
        i% = j%
      UNTIL i% > LEN(n$)
      = o$


get "libhdr"

manifest $(
    amount = 15
    bufsize = 128
$)

let move(dest,src) be
$(  until !src = 0 do
    $(  !dest := !src
        dest := dest + 1
        src := src + 1
    $)
    !dest := 0
$)

let count(v) = valof
$(  let i=1
    while v!i = !v do i := i + 1
    resultis i
$)

let looksay(in,out) be
$(  until !in = 0 do
    $(  let n = count(in)
        out!0 := n
        out!1 := !in
        out := out + 2
        in := in + n
    $)
    !out := 0
$)

let show(v) be
$(  until !v = 0 do
    $(  writen(!v)
        v := v + 1
    $)
    wrch('*N')
$)

let start() be
$(  let buf1 = vec bufsize and buf2 = vec bufsize
    buf1!0 := 1
    buf1!1 := 0
    for n = 1 to amount do
    $(  show(buf1)
        looksay(buf1,buf2)
        move(buf1,buf2)
    $)
$)


LookSay ← ∾´((⊑∾˜ ≠+'0'˙)¨1↓((+`»≠⊢)⊸⊔))

>((⌈´≠¨)↑¨⊢) LookSay⍟(↕15)"1"


( 1:?number
& 0:?lines
&   whl
  ' ( 1+!lines:~>10:?lines
    & :?say                           { This will accumulate all that has to be said after one iteration. }
    & 0:?begin
    & ( @( !number                    { Pattern matching. The '@' indicates we're looking in a string rather than a tree structure. }
         :   ?
             (   [!begin
                 %@?digit
                 ?
                 [?end
                 ( (|(%@:~!digit) ?)  { The %@ guarantees we're testing one character - not less (%) and not more (@). The ? takes the rest. }
                 & !say !end+-1*!begin !digit:?say
                 & !end:?begin        { When backtracking, 'begin' advances to the begin of the next sequence, or to the end of the string. }
                 )
             & ~                      { fail! This forces backtracking. Backtracking stops when all begin positions have been tried. }
             )
         )
      | out$(str$!say:?number)        { After backtracking, output string and set number to string for next iteration. }
      )
    )
);


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

int main()
{
	char *a = malloc(2), *b = 0, *x, c;
	int cnt, len = 1;

	for (sprintf(a, "1"); (b = realloc(b, len * 2 + 1)); a = b, b = x) {
		puts(x = a);
		for (len = 0, cnt = 1; (c = *a); ) {
			if (c == *++a)
				cnt++;
			else if (c) {
				len += sprintf(b + len, "%d%c", cnt, c);
				cnt = 1;
			}
		}
	}

	return 0;
}


using System;
using System.Text;
using System.Linq;

class Program
{
    static string lookandsay(string number)
    {
        StringBuilder result = new StringBuilder();

        char repeat = number[0];
        number = number.Substring(1, number.Length-1)+" ";
        int times = 1;

        foreach (char actual in number)
        {
            if (actual != repeat)
            {
                result.Append(Convert.ToString(times)+repeat);
                times = 1;
                repeat = actual;
            }
            else
            {
                times += 1;
            }
        }
        return result.ToString();
    }

    static void Main(string[] args)
    {
        string num = "1";

        foreach (int i in Enumerable.Range(1, 10)) {
             Console.WriteLine(num);
             num = lookandsay(num);
        }
    }
}


#include <iostream>
#include <sstream>
#include <string>

std::string lookandsay(const std::string& s)
{
    std::ostringstream r;

    for (std::size_t i = 0; i != s.length();) {
        auto new_i = s.find_first_not_of(s[i], i + 1);

        if (new_i == std::string::npos)
            new_i = s.length();

        r << new_i - i << s[i];
        i = new_i;
    }
    return r.str();
}

int main()
{
    std::string laf = "1";

    std::cout << laf << '\n';
    for (int i = 0; i < 10; ++i) {
        laf = lookandsay(laf);
        std::cout << laf << '\n';
    }
}


shared void run() {

    function lookAndSay(Integer|String input) {

        variable value digits = if (is Integer input) then input.string else input;
        value builder = StringBuilder();

        while (exists currentChar = digits.first) {
            if (exists index = digits.firstIndexWhere((char) => char != currentChar)) {
                digits = digits[index...];
                builder.append("``index````currentChar``");
            }
            else {
                builder.append("``digits.size````currentChar``");
                break;
            }
        }

        return builder.string;
    }

    variable String|Integer result = 1;
    print(result);
    for (i in 1..14) {
        result = lookAndSay(result);
        print(result);
    }
}


(defn digits-seq
  "Returns a seq of the digits of a number (L->R)."
  [n]
  (loop [digits (), number n]
    (if (zero? number) (seq digits)
        (recur (cons (mod number 10) digits)
               (quot number 10)))))

(defn join-digits
  "Converts a digits-seq back in to a number."
  [ds]
  (reduce (fn [n d] (+ (* 10 n) d)) ds))

(defn look-and-say [n]
  (->> n digits-seq (partition-by identity)
       (mapcat (juxt count first)) join-digits))


look_and_say = proc (s: string) returns (string)
    out: array[char] := array[char]$[]
    count: int := 0
    last: char := '\000'

    for c: char in string$chars(s) do
        if c ~= last then
            if count ~= 0 then
                array[char]$addh(out, char$i2c(count + 48))
                array[char]$addh(out, last)
            end
            last := c
            count := 1
        else
            count := count + 1
        end
    end

    array[char]$addh(out, char$i2c(count + 48))
    array[char]$addh(out, last)
    return (string$ac2s(out))
end look_and_say

start_up = proc ()
    lines = 15

    po: stream := stream$primary_output()
    cur: string := "1"

    for i: int in int$from_to(1, lines) do
        stream$putl(po, cur)
        cur := look_and_say(cur)
    end
end start_up


        IDENTIFICATION DIVISION.
        PROGRAM-ID. LOOK-AND-SAY-SEQ.

        DATA DIVISION.
        WORKING-STORAGE SECTION.
        01 SEQUENCES.
           02 CUR-SEQ       PIC X(80) VALUE "1".
           02 CUR-CHARS     REDEFINES CUR-SEQ
                            PIC X OCCURS 80 TIMES INDEXED BY CI.
           02 CUR-LENGTH    PIC 99 COMP VALUE 1.
           02 NEXT-SEQ      PIC X(80).
           02 NEXT-CHARS    REDEFINES NEXT-SEQ
                            PIC X OCCURS 80 TIMES INDEXED BY NI.
        01 ALG-STATE.
           02 STEP-AMOUNT   PIC 99 VALUE 14.
           02 ITEM-COUNT    PIC 9.

        PROCEDURE DIVISION.
        LOOK-AND-SAY.
            DISPLAY CUR-SEQ.
            SET CI TO 1.
            SET NI TO 1.
        MAKE-NEXT-ENTRY.
            MOVE 0 TO ITEM-COUNT.
            IF CI IS GREATER THAN CUR-LENGTH GO TO STEP-DONE.
        TALLY-ITEM.
            ADD 1 TO ITEM-COUNT.
            SET CI UP BY 1.
            IF CI IS NOT GREATER THAN CUR-LENGTH
               AND CUR-CHARS(CI) IS EQUAL TO CUR-CHARS(CI - 1)
                GO TO TALLY-ITEM.
        INSERT-ENTRY.
            MOVE ITEM-COUNT TO NEXT-CHARS(NI).
            MOVE CUR-CHARS(CI - 1) TO NEXT-CHARS(NI + 1).
            SET NI UP BY 2.
            GO TO MAKE-NEXT-ENTRY.
        STEP-DONE.
            MOVE NEXT-SEQ TO CUR-SEQ.
            SET NI DOWN BY 1.
            SET CUR-LENGTH TO NI.
            SUBTRACT 1 FROM STEP-AMOUNT.
            IF STEP-AMOUNT IS NOT EQUAL TO ZERO GO TO LOOK-AND-SAY.
            STOP RUN.


(defun compress (array &key (test 'eql) &aux (l (length array)))
  "Compresses array by returning a list of conses each of whose car is
a number of occurrences and whose cdr is the element occurring.  For
instance, (compress \"abb\") produces ((1 . #\a) (2 . #\b))."
  (if (zerop l) nil
    (do* ((i 1 (1+ i))
          (segments (acons 1 (aref array 0) '())))
         ((eql i l) (nreverse segments))
      (if (funcall test (aref array i) (cdar segments))
        (incf (caar segments))
        (setf segments (acons 1 (aref array i) segments))))))

(defun next-look-and-say (number)
  (reduce #'(lambda (n pair)
              (+ (* 100 n)
                 (* 10 (car pair))
                 (parse-integer (string (cdr pair)))))
          (compress (princ-to-string number))
          :initial-value 0))


include "cowgol.coh";
include "strings.coh";

# Given a string with a member of the look-and-say sequence,
# generate the next member of the sequence.
sub LookSay(cur: [uint8], next: [uint8]) is
    while [cur] != 0 loop
        var count: uint8 := 1;
        var curch: uint8 := [cur];

        # count how many of this character we have
        loop
            cur := @next cur;
            if [cur] != curch then break; end if;
            count := count + 1;
        end loop;

        # add it and its count to the next sequence
        [next] := '0' + count;
        next := @next next;
        [next] := curch;
        next := @next next;
    end loop;
    [next] := 0;
end sub;

# amount of members to print
# (don't forget to enlarge the buffers if you make this bigger)
var members: uint8 := 15;

# define two buffers
var curbuf: uint8[255];
var nextbuf: uint8[255];

# start with "1"
CopyString("1", &curbuf as [uint8]);

# generate and print successive members
while members > 0 loop
    print(&curbuf as [uint8]);
    print_nl();
    LookSay(&curbuf as [uint8], &nextbuf as [uint8]);
    CopyString(&nextbuf as [uint8], &curbuf as [uint8]);
    members := members - 1;
end loop;


class String
  def lookandsay
    gsub(/(.)\1*/){ |s| s.size.to_s + s[0] }
  end
end

ss = '1'
12.times { puts ss; ss = ss.to_s.lookandsay }


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

enum say = (in string s) pure => s.group.map!q{ text(a[1],a[0]) }.join;

void main() {
    "1".recurrence!((t, n) => t[n - 1].say).take(8).writeln;
}


\util.g

proc nonrec look_and_say(*char inp, outp) void:
    char cur;
    byte count;
    channel output text outch;
    open(outch, outp);
    while cur := inp*; cur ~= '\e' do
        count := 1;
        while
            inp := inp + 1;
            inp* = cur
        do
            count := count + 1
        od;
        write(outch; count, cur)
    od;
    close(outch)
corp

proc nonrec main() void:
    [256] char buf1, buf2;
    byte i;
    byte LINES = 14;

    CharsCopy(&buf1[0], "1");
    for i from 1 upto LINES do
        writeln(&buf1[0]);
        look_and_say(&buf1[0], &buf2[0]);
        CharsCopy(&buf1[0], &buf2[0])
    od
corp


def lookAndSayNext(number :int) {
  var seen := null
  var count := 0
  var result := ""
  def put() {
    if (seen != null) {
      result += count.toString(10) + E.toString(seen)
    }
  }
  for ch in number.toString(10) {
    if (ch != seen) {
      put()
      seen := ch
      count := 0
    }
    count += 1
  }
  put()
  return __makeInt(result, 10)
}

var number := 1
for _ in 1..20 {
  println(number)
  number := lookAndSayNext(number)
}


(lib 'math) ;; for (number->list) = explode function
(lib 'list) ;; (group)

(define (next L)
	(for/fold (acc null) ((g (group L)))
		(append acc (list (length g) (first g)))))

(define (task n starter)
(for/fold (L (number->list starter)) ((i n))
	(writeln (list->string L))
	(next L)))


defmodule LookAndSay do
  def next(n) do
    Enum.chunk_by(to_char_list(n), &(&1))
    |> Enum.map(fn cl=[h|_] -> Enum.concat(to_char_list(length cl), [h]) end)
    |> Enum.concat
    |> List.to_integer
  end

  def sequence_from(n) do
    Stream.iterate n, &(next/1)
  end

  def main([start_str|_]) do
    {start_val,_} = Integer.parse(start_str)
    IO.inspect sequence_from(start_val) |> Enum.take 9
  end

  def main([]) do
    main(["1"])
  end
end

LookAndSay.main(System.argv)


-module(str).
-export([look_and_say/1, look_and_say/2]).

%% converts a single number
look_and_say([H|T]) -> lists:reverse(look_and_say(T,H,1,"")).

%% converts and accumulates as a loop
look_and_say(_, 0) -> [];
look_and_say(Start, Times) when Times > 0 ->
    [Start | look_and_say(look_and_say(Start), Times-1)].

%% does the actual conversion for a number
look_and_say([], Current, N, Acc) ->
    [Current, $0+N | Acc];
look_and_say([H|T], H, N, Acc) ->
    look_and_say(T, H, N+1, Acc);
look_and_say([H|T], Current, N, Acc) ->
    look_and_say(T, H, 1, [Current, $0+N | Acc]).


PROGRAM LOOK

PROCEDURE LOOK_AND_SAY(N$->N$)
      LOCAL I%,J%,C$,O$
      I%=1
      REPEAT
        C$=MID$(N$,I%,1)
        J%=I%+1
        WHILE MID$(N$,J%,1)=C$ DO
          J%+=1
        END WHILE
        O$+=MID$(STR$(J%-I%),2)+C$
        I%=J%
      UNTIL I%>LEN(N$)
      N$=O$
END PROCEDURE

BEGIN
      NUMBER$="1"
      FOR I%=1 TO 10 DO
        LOOK_AND_SAY(NUMBER$->NUMBER$)
        PRINT(NUMBER$)
      END FOR
END PROGRAM


let rec brk p lst =
  match lst with
  | [] -> (lst, lst)
  | x::xs ->
    if p x
    then ([], lst)
    else
      let (ys, zs) = brk p xs
      (x::ys, zs)

let span p lst = brk (not << p) lst

let rec groupBy eq lst =
  match lst with
  | [] ->  []
  | x::xs ->
    let (ys,zs) = span (eq x) xs
	(x::ys)::groupBy eq zs

let group lst : list<list<'a>> when 'a : equality = groupBy (=) lst


F longest_increasing_subsequence(x)
   V n = x.len
   V P = [0] * n
   V M = [0] * (n + 1)
   V l = 0
   L(i) 0 .< n
      V lo = 1
      V hi = l
      L lo <= hi
         V mid = (lo + hi) I/ 2
         I (x[M[mid]] < x[i])
            lo = mid + 1
         E
            hi = mid - 1
      V newl = lo
      P[i] = M[newl - 1]
      M[newl] = i

      I (newl > l)
         l = newl

   [Int] s
   V k = M[l]
   L(i) (l - 1 .. 0).step(-1)
      s.append(x[k])
      k = P[k]
   R reversed(s)

L(d) [[3, 2, 6, 4, 5, 1], [0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15]]
   print(‘a L.I.S. of #. is #.’.format(d, longest_increasing_subsequence(d)))


: (look-and-say) ( str -- )
    unclip-slice swap [ 1 ] 2dip [
        2dup = [ drop [ 1 + ] dip ] [
            [ [ number>string % ] dip , 1 ] dip
        ] if
    ] each [ number>string % ] [ , ] bi* ;

: look-and-say ( str -- str' ) [ (look-and-say) ] "" make ;

"1" 10 [ dup print look-and-say ] times print


(fn look-and-say [t]
  (let [lst t
        ret []]
    (while (> (length lst) 0)
      (var (num cnt) (values (table.remove lst 1) 1))
      (while (= num (. lst 1))
        (set cnt (+ cnt 1))
        (when (> (length lst) 0)
          (set num (table.remove lst 1))))
      (tset ret (+ (length ret) 1) cnt)
      (tset ret (+ (length ret) 1) num))
    ret))

(var lst [1])
(for [i 1 10]
  (print (table.concat lst))
  (set lst (look-and-say lst)))


*        Longest increasing subsequence    04/03/2017
LNGINSQ  CSECT
         USING  LNGINSQ,R13        base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R6,1             i=1
       DO WHILE=(CH,R6,LE,=H'2') do i=1 to 2
       IF CH,R6,EQ,=H'1' THEN      if i=1 then
         MVC    N,=AL2((A2-A1)/2)    n=hbound(a1)
         MVC    AA(64),A1            a=a1
       ELSE     ,                  else
         MVC    N,=AL2((AA-A2)/2)    n=hbound(a2)
         MVC    AA(64),A2            a=a2
       ENDIF    ,                  endif
         MVC    PG,=CL80': '       init buffer
         LA     R2,AA-2            @a
         LH     R3,N               n
         BAL    R14,PRINT          print a
         MVC    LL,=H'0'           l=0
         SR     R7,R7              j=0
       DO WHILE=(CH,R7,LE,N)       do j=0 to n
         MVC    LO,=H'1'             lo=1
         MVC    HI,LL                hi=l
         LH     R4,LO                lo
       DO WHILE=(CH,R4,LE,HI)        do while lo<=hi
         LH     R1,LO                  lo
         AH     R1,HI                  lo+hi
         SRA    R1,1                   /2
         STH    R1,MIDDLE              middle=(lo+hi)/2
         SLA    R1,1                   *2
         LH     R1,MM(R1)              m(middle+1)
         SLA    R1,1                   *2
         LH     R3,AA(R1)              r3=a(m(middle+1)+1)
         LR     R1,R7                  j
         SLA    R1,1                   *2
         LH     R4,AA(R1)              r4=a(j+1)
         LH     R2,MIDDLE              middle
       IF CR,R3,LT,R4 THEN             if a(m(middle+1)+1)<a(j+1) then
         LA     R2,1(R2)                 middle+1
         STH    R2,LO                    lo=middle+1
       ELSE     ,                      else
         BCTR   R2,0                     middle-1
         STH    R2,HI                    hi=middle-1
       ENDIF    ,                      endif
         LH     R4,LO                  lo
       ENDDO    ,                    end /*while*/
         LH     R10,LO               newl=lo
         LR     R1,R10               newl
         SLA    R1,1                 *2
         LH     R3,MM-2(R1)          m(newl)
         LR     R1,R7                j
         SLA    R1,1                 *2
         STH    R3,PP(R1)            p(j+1)=m(newl)
         LR     R1,R10               newl
         SLA    R1,1                 *2
         STH    R7,MM(R1)            m(newl+1)=j
       IF CH,R10,GT,LL               if newl>l then
         STH    R10,LL                 l=newl
       ENDIF    ,                    endif
         LA     R7,1(R7)             j++
       ENDDO    ,                  enddo j
         LH     R1,LL              l
         SLA    R1,1               *2
         LH     R10,MM(R1)         k=m(l+1)
         LH     R7,LL              j=l
       DO WHILE=(CH,R7,GE,=H'1')   do j=l to 1 by -1
         LR     R1,R10               k
         SLA    R1,1                 *2
         LH     R2,AA(R1)            a(k+1)
         LR     R1,R7                j
         SLA    R1,1                 *2
         STH    R2,SS-2(R1)          s(j)=a(k+1)
         LR     R1,R10               k
         SLA    R1,1                 *2
         LH     R10,PP(R1)           k=p(k+1)
         BCTR   R7,0                 j--
       ENDDO    ,                  enddo j
         MVC    PG,=CL80'> '       init buffer
         LA     R2,SS-2            @s
         LH     R3,LL              l
         BAL    R14,PRINT          print a
         LA     R6,1(R6)           i++
       ENDDO    ,                enddo i
         L      R13,4(0,R13)       restore previous savearea pointer
         LM     R14,R12,12(R13)    restore previous context
         XR     R15,R15            rc=0
         BR     R14                exit
PRINT    LA     R10,PG        ---- print subroutine
         LA     R10,2(R10)         pgi=2
         LA     R7,1               j=1
       DO WHILE=(CR,R7,LE,R3)      do j=1 to nx
         LR     R1,R7                j
         SLA    R1,1                 *2
         LH     R1,0(R2,R1)          x(j)
         XDECO  R1,XDEC              edit x(j)
         MVC    0(3,R10),XDEC+9      output x(j)
         LA     R10,3(R10)           pgi+=3
         LA     R7,1(R7)             j++
       ENDDO    ,                  enddo j
         XPRNT  PG,L'PG            print buffer
         BR     R14           ---- return
A1       DC     H'3',H'2',H'6',H'4',H'5',H'1'
A2       DC     H'0',H'8',H'4',H'12',H'2',H'10',H'6',H'14'
         DC     H'1',H'9',H'5',H'13',H'3',H'11',H'7',H'15'
AA       DS     32H                a(32)
PP       DS     32H                p(32)
MM       DS     32H                m(32)
SS       DS     32H                s(32)
N        DS     H                  n
LL       DS     H                  l
LO       DS     H                  lo
HI       DS     H                  hi
MIDDLE   DS     H                  middle
PG       DS     CL80               buffer
XDEC     DS     CL12               temp for xdeco
         YREGS
         END    LNGINSQ


on longestIncreasingSubsequences(aList)
    script o
        property inputList : aList
        property m : {} -- End indices of identified subsequences.
        property p : {} -- 'Predecessor' indices for each point in each subsequence.
        property subsequence : {} -- Reconstructed longest sequence.
    end script
    -- Set m and p to lists of the same length as the input. Their initial contents don't matter!
    copy aList to o's m
    copy aList to o's p

    set bestLength to 0
    repeat with i from 1 to (count o's inputList)
        -- Comments adapted from those in the Wikipedia article — as far as they can be understood!
        -- Binary search for the largest possible 'lo' ≤ bestLength such that inputList[m[lo]] ≤ inputList[i].
        set lo to 1
        set hi to bestLength
        repeat until (lo > hi)
            set mid to (lo + hi + 1) div 2
            if (item (item mid of o's m) of o's inputList < item i of o's inputList) then
                set lo to mid + 1
            else
                set hi to mid - 1
            end if
        end repeat
        -- After searching, lo is 1 greater than the length of the longest prefix of inputList[i].
        -- The predecessor of inputList[i] is the last index of the subsequence of length lo - 1.
        if (lo > 1) then set item i of o's p to item (lo - 1) of o's m
        set item lo of o's m to i
        -- If we found a subsequence longer than or the same length as any we've found yet,
        -- update bestLength and store the end index associated with it.
        if (lo > bestLength) then
            set bestLength to lo
            set bestEndIndices to {item bestLength of o's m}
        else if (lo = bestLength) then
            set end of bestEndIndices to item bestLength of o's m
        end if
    end repeat
    -- Reconstruct the longest increasing subsequence(s).
    set output to {}
    if (bestLength > 0) then
        repeat with k in bestEndIndices
            set o's subsequence to {}
            repeat bestLength times
                set beginning of o's subsequence to item k of o's inputList
                set k to item k of o's p
            end repeat
            set end of output to o's subsequence
        end repeat
    end if

    return output
end longestIncreasingSubsequences

-- Task code and other tests:
local tests, output, input
set tests to {{3, 2, 6, 4, 5, 1}, {0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15}, ¬
    {9, 10, 11, 3, 8, 9, 6, 7, 4, 5}, {4, 5, 5, 6}, {5, 5}}
set output to {}
repeat with input in tests
    set end of output to {finds:longestIncreasingSubsequences(input's contents)}
end repeat
return output


create buf1 256 allot
create buf2 256 allot
buf1 value src
buf2 value dest

s" 1" src place

: append-run ( digit run -- )
  dest count +
  tuck c!  1+ c!
  dest [email protected] 2 + dest c! ;

: next-look-and-say
  0 dest c!
  src 1+ [email protected]  [char] 0  ( digit run )
  src count bounds do
    over i [email protected] =
    if   1+
    else append-run  i [email protected] [char] 1
    then
  loop
  append-run
  src dest to src to dest ;

: look-and-say ( n -- )
  0 do next-look-and-say  cr src count type loop ;

10 look-and-say


lis: function [d][
    l: new [[]]
    loop d 'num [
        x: []
        loop l 'seq [
            if positive? size seq [
                if and? num > last seq
                        (size seq) > size x ->
                    x: seq
            ]
        ]
        'l ++ @[x ++ @[num]]
    ]
    result: []
    loop l 'x [
        if (size x) > size result ->
            result: x
    ]
    return result
]

loop [
    [3 2 6 4 5 1]
    [0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15]
] 'seq [
    print ["LIS of" seq "=>" lis seq]
]


Lists := [[3,2,6,4,5,1], [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]]

for k, v in Lists {
	D := LIS(v)
	MsgBox, % D[D.I].seq
}

LIS(L) {
	D := []
	for i, v in L {
		D[i, "Length"] := 1, D[i, "Seq"] := v, D[i, "Val"] := v
		Loop, % i - 1 {
			if(D[A_Index].Val < v && D[A_Index].Length + 1 > D[i].Length) {
				D[i].Length := D[A_Index].Length + 1
				D[i].Seq := D[A_Index].Seq ", " v
				if (D[i].Length > MaxLength)
					MaxLength := D[i].Length, D.I := i
			}
		}
	}
	return, D
}


module LookAndSay
  implicit none

contains

  subroutine look_and_say(in, out)
    character(len=*), intent(in) :: in
    character(len=*), intent(out) :: out

    integer :: i, c
    character(len=1) :: x
    character(len=2) :: d

    out = ""
    c = 1
    x = in(1:1)
    do i = 2, len(trim(in))
       if ( x == in(i:i) ) then
          c = c + 1
       else
          write(d, "(I2)") c
          out = trim(out) // trim(adjustl(d)) // trim(x)
          c = 1
          x = in(i:i)
       end if
    end do
    write(d, "(I2)") c
    out = trim(out) // trim(adjustl(d)) // trim(x)
  end subroutine look_and_say

end module LookAndSay


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

struct node {
	int val, len;
	struct node *next;
};

void lis(int *v, int len)
{
	int i;
	struct node *p, *n = calloc(len, sizeof *n);
	for (i = 0; i < len; i++)
		n[i].val = v[i];

	for (i = len; i--; ) {
		// find longest chain that can follow n[i]
		for (p = n + i; p++ < n + len; ) {
			if (p->val > n[i].val && p->len >= n[i].len) {
				n[i].next = p;
				n[i].len = p->len + 1;
			}
		}
	}

	// find longest chain
	for (i = 0, p = n; i < len; i++)
		if (n[i].len > p->len) p = n + i;

	do printf(" %d", p->val); while ((p = p->next));
	putchar('\n');

	free(n);
}

int main(void)
{
	int x[] = { 3, 2, 6, 4, 5, 1 };
	int y[] = { 0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15 };

	lis(x, sizeof(x) / sizeof(int));
	lis(y, sizeof(y) / sizeof(int));
	return 0;
}