import org.rosettacode.ArithmeticComplex._
import java.awt.Color

object Mandelbrot
{
   def generate(width:Int =600, height:Int =400)={
      val bm=new RgbBitmap(width, height)

      val maxIter=1000
      val xMin = -2.0
      val xMax =  1.0
      val yMin = -1.0
      val yMax =  1.0

      val cx=(xMax-xMin)/width
      val cy=(yMax-yMin)/height

      for(y <- 0 until bm.height; x <- 0 until bm.width){
         val c=Complex(xMin+x*cx, yMin+y*cy)
         val iter=itMandel(c, maxIter, 4)
         bm.setPixel(x, y, getColor(iter, maxIter))
      }
      bm
   }

   def itMandel(c:Complex, imax:Int, bailout:Int):Int={
      var z=Complex()
      for(i <- 0 until imax){
         z=z*z+c;
         if(z.abs > bailout) return i
      }
      imax;
   }

   def getColor(iter:Int, max:Int):Color={
      if (iter==max) return Color.BLACK

      var c=3*math.log(iter)/math.log(max-1.0)
      if(c<1) new Color((255*c).toInt, 0, 0)
      else if(c<2) new Color(255, (255*(c-1)).toInt, 0)
      else new Color(255, 255, (255*(c-2)).toInt)
   }
}


palindromeQ[n_Integer] :=
 Block[{digits = IntegerDigits[n]}, digits == [email protected]]

nextNumber[n_Integer] := n + FromDigits[[email protected]@n]

lychrelQ[n_Integer] := !
  [email protected]
   Catch[Nest[If[palindromeQ[#], Throw[#], nextNumber[#]] &,
     nextNumber[n], 500]]


import algorithm, sequtils, strformat, strutils, tables

type

  Digit = range[0..9]
  Number = seq[Digit]                 # Number as a sequence of digits (unit at index 0).

  # Structure used to find the candidates for Lychrel numbers.
  Candidates = object
    seeds: seq[Number]                # List of possible seeds.
    linked: Table[Number, Number]     # Maps a number to a smallest number in a sequence.

####################################################################################################
# Conversions.

func toInt(n: Number): Natural =
  ## Convert a Number to an int. No check is done for overflow.
  for i in countdown(n.high, 0):
    result = 10 * result + n[i]

func `$`(n: Number): string =
  ## Return the string representation of a Number.
  reversed(n).join()

func `$`(s: seq[Number]): string =
  ## Return the string representation of a sequence of Numbers.
  s.mapIt($it).join(" ")

####################################################################################################
# Operations on Numbers.

func addReverse(n: var Number) =
  ## Add a Number to its reverse.
  var carry = 0
  var high = n.high
  var r = reversed(n)
  for i in 0..high:
    var sum = n[i] + r[i] + carry
    if sum >= 10:
      n[i] = sum - 10
      carry = 1
    else:
      n[i] = sum
      carry = 0
  if carry != 0: n.add carry

func inc(a: var Number) =
  ## Increment a Number by one.
  for item in a.mitems:
    let sum = item + 1
    if sum >= 10:
      item = sum - 10
    else:
      item = sum
      return  # No carry: stop adding.
  a.add 1     # Add last carry.

####################################################################################################
# Operations related to Lychrel numbers.

func isPalindromic(n: Number): bool =
  ## Check if a Number is palindromic.
  for i in 0..(n.high div 2):
    if n[i] != n[n.high - i]: return false
  result = true

func isRelatedLychrel(candidates: Candidates; n: Number): bool =
  ## Check if a Number is a Lychrel related number.

  var val = candidates.linked[n]
  # Search for the first value in a list of linked values.
  while val in candidates.linked: val = candidates.linked[val]
  # If the first value is a seed, "n" is related to it.
  result = val in candidates.seeds

func relatedCount(candidates: Candidates; maxlen: Positive): int =
  ## Return the number of related Lychrel numbers with length <= maxlen.

  # Loop on values which are linked to a smallest value.
  for n in candidates.linked.keys:
    if n.len <= maxlen and candidates.isRelatedLychrel(n): inc result

func palindromicLychrel(candidates: Candidates; maxlen: Positive): seq[int] =
  ## Return the list of palindromic Lychrel numbers with length <= maxlen.

  # Search among seed Lychrel numbers.
  for n in candidates.seeds:
    if n.len <= maxlen and n.isPalindromic:
      result.add n.toInt
  # Search among related Lychrel numbers.
  for n in candidates.linked.keys:
    if n.len <= maxlen and n.isPalindromic and candidates.isRelatedLychrel(n):
      result.add n.toInt
  # Sort the whole list.
  result.sort()

proc check(candidates: var Candidates; num: Number) =
  ## Check if a Number is a possible Lychrel number.

  if num in candidates.linked: return   # Already encountered: nothing to do.
  var val = num
  for _ in 1..500:
    val.addReverse()
    if val in candidates.linked:
      # Set the linked value of "num" to that of "val".
      candidates.linked[num] = candidates.linked[val]
      return
    if val.isPalindromic(): return  # Don't store palindromic values as they may be seeds.
    candidates.linked[val] = num
  candidates.seeds.add num

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

var cand: Candidates

var num: Number = @[Digit(0)]   # The Number to test.
for n in 1..10_000:
  inc num
  cand.check(num)

echo &"Found {cand.seeds.len} candidate seed Lychrel numbers between 1 and 10000."
echo "These candidate seed Lychrel numbers are: ", cand.seeds
echo &"Found {cand.relatedCount(4)} candidate related Lychrel numbers between 1 and 10000."
echo "Palindromic candidate Lychrel numbers between 1 and 10000 are: ", cand.palindromicLychrel(4)


program p196;
{$IFDEF FPC}
  {$R-}
  {$MODE DELPHI}
  {$Optimization ON}
{$Else}
  {$APPTYPE console}
{$Endif}
{
nativeUint = LongWord;//Uint64
nativeInt = LongInt;//Int64
}

uses
  SysUtils,classes;

const
  cMAXNUM     = 100*1000*1000;//100*1000*1000;
  cMaxCycle   = 1500;
  cChkDigit   =   10;//first check lychrel found
  MaxLen      =  256;//maximal count of digits
  cMaxDigit   =  MAXLEN-1;

type
  TDigit = byte;
  tpDigit =^TDigit;
  tDigitArr = array[0..0] of tDigit;
  tpDigitArr = ^tDigitArr;
  //LSB at position 0
  TNumber = record
               nNum : array [0..cMaxDigit] of TDigit;
               nMaxPos : LongInt;
            end;
  tRelated = array[0..cMAXNUM] of byte;

procedure NumberFromString(var Number: TNumber; S: string);
var
  i,le: integer;
begin
  le := Length(s);
  IF le > cMaxDigit then
    le := cMaxDigit;
  Number.nMaxPos:= le-1;
  for i:= 0 to le-1 do
    Number.nNum[i]:= Ord(s[le- i]) - Ord('0');
end;

function NumberToString(var Number: TNumber): string;
var
  i,l: integer;
begin
  i := Number.nMaxPos;
  If i <= MAXLEN then
  begin
    SetLength(Result, i+1);
    l := i+1;
    i := 0;
    repeat
      Result[l]:= Chr(Ord('0') + Number.nNum[i]);
      inc(i);
      dec(l);
    until l <= 0;
  end
  else
  begin
    SetLength(Result, MAXLEN);
    fillchar(Result[1],MAXLEN,'.');
    For l := 1 to MAXLEN DIV 2-1 do
    Begin
      Result[l] := Chr(Ord('0') + Number.nNum[i-l+1]);
      Result[l+MAXLEN DIV 2+1] := Chr(Ord('0') + Number.nNum[24-l]);
    end;
  end;
end;

procedure CorrectCarry(var Number : TNumber);
//correct sum of digit to digit and carry
//without IF d>10 then...
var
  d,i,carry: nativeInt;
  p: tpDigitArr;
begin
  carry  := 0;
  i := Number.nMaxPos;
  p := @Number.nNum[i];
  i := -i;
  For i := i to 0 do
  Begin
   d := p^[i]+carry;
   carry := ord(d>=10);//0, 1-> (-10 AND(-carry) = 0 ,-10
   p^[i] := d+(-10 AND(-carry));
  end;
  //correct length
  IF carry >0 then
  begin
    i := Number.nMaxPos+1;
    Number.nNum[i] :=1;
    NUmber.nMaxPos := i;
  end;
end;

procedure NumberAdd(var Number : TNumber);
// first add than correct carry
var
  //pointer, for fpc is a little bit slow with dynamic array
  loIdx,hiIdx: integer;
  sum: nativeUint;
begin
  loIdx := 0;
  hiIdx := Number.nMaxPos;
  while loIdx< hiIdx  do
  Begin
    sum := Number.nNum[loIdx]+Number.nNum[hiIdx];
    Number.nNum[loIdx] := sum;
    Number.nNum[hiIdx] := sum;
    inc(loIdx);
    dec(HiIdx);
  end;

  IF loIdx = hiIdx then
    Number.nNum[loIdx] := 2*Number.nNum[loIdx];

  CorrectCarry(Number);
end;

function PalinCheck(var A: TNumber): boolean;
var
  loIdx,hiIdx: integer;
begin
  loIdx := 0;
  hiIdx := A.nMaxPos;
  repeat
    Result:= A.nNum[loIdx]=A.nNum[hiIdx];
    inc(loIdx);
    dec(hiIdx);
  until Not(Result) OR (hiIdx<loIdx);
end;

procedure ShowPalinLychrel(var Related:tRelated);
var
  i : NativeInt;
  s : string;
  slRes : TStringList;
  Work: TNumber;
Begin
  slRes := TStringList.create;

  For i := 0 to  High(Related) do
  begin
    IF Related[i] <> 0 then
    Begin
      s := IntToSTr(i);
      NumberFromString(Work,s);
      If PalinCheck(Work) then
        slRes.Add(s);
    end;
  end;

  Writeln('number of palindromatic lychrel ',slRes.count:8);
  IF slRes.Count < 10 then
  Begin
    For i := 0 to slRes.count-2 do
      write(slRes[i]:8,',');
    writeln(slRes[slRes.count-1]:8);
  end;
  slRes.free;
end;

var
  Related : tRelated;
  slSeedCache,
  slFirstChkCache : TStringList;

  Seeds : array of LongInt;
  Work: TNumber;
  num,findpos,InsPos : LongInt;
  relCount : NativeUint;
  s,f: string;

  procedure FirstCheckCache;
  //Test if Work is already in Cache
  //if not it will be inserted
  //Inspos saves the position
  var
    i : LongInt;
  Begin
    f:= NumberToString(Work);
    IF slFirstChkCache.find(f,i) then
    Begin
      IF slFirstChkCache.Objects[i]<> NIL then
      Begin
        Related[num] := 2;
        inc(RelCount);
      end;
    end
    else
    Begin
     //memorize the number as Object
      InsPos := slFirstChkCache.addObject(f,TObject(num));
    end;
  end;

begin
  fillchar(Related[1],Length(Related),#0);
  relCount := 0;

  slSeedCache := TStringList.create;
  slSeedCache.sorted := true;
  slSeedCache.duplicates := dupIgnore;

  slFirstChkCache := TStringList.create;
  slFirstChkCache.sorted := true;
  slFirstChkCache.duplicates := dupIgnore;

  setlength(Seeds,0);

  num := 1;
  repeat
    s := IntToStr(num);
    NumberFromString(Work, s);

    findPos := -1;
    InsPos  := -1;

    //early test if already in Cache
    repeat
      NumberAdd(Work);
      IF (Work.nMaxPos = cChkDigit) then
      Begin
        FirstCheckCache;
        BREAK;
      end;
    until PalinCheck(Work);

    //IF new number of cChkDigit length inserted in Cache
    IF (InsPos >= 0) AND NOT (PalinCheck(Work)) then
    Begin
      //check for lychrel
      while Work.nMaxPos < cMaxDigit do
      Begin
        NumberAdd(Work);
        if PalinCheck(Work) then
          BREAK;
      end;

      if Work.nMaxPos >= cMaxDigit then
      Begin
        f := NumberToString(Work);
        //new lychrel seed found
        IF NOT(slSeedCache.find(f,findPos)) then
        Begin
          //memorize the number by misusing of Object
          slSeedCache.addObject(f,TObject(num));
          setlength(Seeds,length(Seeds)+1);
          Seeds[High(Seeds)] := num;
          Related[num] := 1;
        end
        else
        Begin
          //a new way to known lycrel seed found, so memorize it
          Related[num] := 2;
          inc(RelCount)
        end
      end
      else
        //mark slFirstChkCache[InsPos] as not_lychrel
        slFirstChkCache.Objects[InsPos] := NIL;
    end;
    inc(num);
  until num > cMAXNUM;
  writeln ('Lychrel from 1 to ',cMAXNUM);
  writeln('number of cached ',cChkDigit,' digit ',slFirstChkCache.Count);
  writeln('number of lychrel seed          ',length(Seeds):8);
  IF length(Seeds) < 10 then
  Begin
    For InsPos:= 0 to High(Seeds)-1 do
      write(Seeds[InsPos],',');
    writeln(Seeds[High(seeds)]);
  end;
  writeln('number of lychrel related       ',RelCount:8);
  ShowPalinLychrel(Related);
  slFirstChkCache.free;
  slSeedCache.free;
  setlength(Seeds,0);
end.
{
...
Lychrel from 1 to 100000000
number of cached 10 digit 7008
number of lychrel seed              3552
number of lychrel related       28802508
number of palindromatic lychrel     5074

real  0m48.634s
user  0m48.579s
sys 0m0.012s
}


(define x-centre -0.5)
(define y-centre 0.0)
(define width 4.0)
(define i-max 800)
(define j-max 600)
(define n 100)
(define r-max 2.0)
(define file "out.pgm")
(define colour-max 255)
(define pixel-size (/ width i-max))
(define x-offset (- x-centre (* 0.5 pixel-size (+ i-max 1))))
(define y-offset (+ y-centre (* 0.5 pixel-size (+ j-max 1))))

(define (inside? z)
  (define (*inside? z-0 z n)
    (and (< (magnitude z) r-max)
         (or (= n 0)
             (*inside? z-0 (+ (* z z) z-0) (- n 1)))))
  (*inside? z 0 n))

(define (boolean->integer b)
  (if b colour-max 0))

(define (pixel i j)
  (boolean->integer
    (inside?
      (make-rectangular (+ x-offset (* pixel-size i))
                        (- y-offset (* pixel-size j))))))

(define (plot)
  (with-output-to-file file
    (lambda ()
      (begin (display "P2") (newline)
             (display i-max) (newline)
             (display j-max) (newline)
             (display colour-max) (newline)
             (do ((j 1 (+ j 1))) ((> j j-max))
                 (do ((i 1 (+ i 1))) ((> i i-max))
                     (begin (display (pixel i j)) (newline))))))))

(plot)


use strict;
use warnings;
use English;
use Const::Fast;
use Math::AnyNum qw(:overload);

const my $n_max       => 10_000;
const my $iter_cutoff => 500;
my(@seq_dump, @seed_lychrels, @related_lychrels);

for (my $n=1; $n<=$n_max; $n++) {
    my @seq = lychrel_sequence($n);
    if ($iter_cutoff == scalar @seq) {
        if (has_overlap(\@seq, \@seq_dump)) { push @related_lychrels, $n }
        else                                { push @seed_lychrels,    $n }
        @seq_dump = set_union(\@seq_dump, \@seq);
    }
}

printf "%45s %s\n", "Number of seed Lychrels <= $n_max:",        scalar @seed_lychrels;
printf "%45s %s\n", "Seed Lychrels <= $n_max:",              join ', ', @seed_lychrels;
printf "%45s %s\n", "Number of related Lychrels <= $n_max:",     scalar @related_lychrels;
printf "%45s %s\n", "Palindromes among seed and related <= $n_max:",
                    join ', ', sort {$a <=> $b} grep { is_palindrome($ARG) } @seed_lychrels, @related_lychrels;

sub lychrel_sequence {
    my $n = shift;
    my @seq;
    for (1 .. $iter_cutoff) {
        return if is_palindrome($n = next_n($n));
        push @seq, $n;
    }
    @seq;
}

sub next_n        { my $n = shift; $n  + reverse($n) }
sub is_palindrome { my $n = shift; $n eq reverse($n) }

sub has_overlap {
    my ($a, $b) = @ARG;
    my %h;
    $h{$_}++ for @{$a};
    exists $h{$_} and return 1 for @{$b};
    0;
}

sub set_union {
    my ($a, $b) = @ARG;
    my %h;
    $h{$_}++ for @{$a}, @{$b};
    keys %h;
}


$ include "seed7_05.s7i";
  include "float.s7i";
  include "complex.s7i";
  include "draw.s7i";
  include "keybd.s7i";

# Display the Mandelbrot set, that are points z[0] in the complex plane
# for which the sequence z[n+1] := z[n] ** 2 + z[0] (n >= 0) is bounded.
# Since this program is computing intensive it should be compiled with
# hi comp -O2 mandelbr

const integer: pix is 200;
const integer: max_iter is 256;

var array color: colorTable is max_iter times black;

const func integer: iterate (in complex: z0) is func
  result
    var integer: iter is 1;
  local
    var complex: z is complex.value;
  begin
    z := z0;
    while sqrAbs(z) < 4.0 and  # not diverged
        iter < max_iter do     # not converged
      z *:= z;
      z +:= z0;
      incr(iter);
    end while;
  end func;

const proc: displayMandelbrotSet (in complex: center, in float: zoom) is func
  local
    var integer: x is 0;
    var integer: y is 0;
    var complex: z0 is complex.value;
  begin
    for x range -pix to pix do
      for y range -pix to pix do
        z0 := center + complex(flt(x) * zoom, flt(y) * zoom);
        point(x + pix, y + pix, colorTable[iterate(z0)]);
      end for;
    end for;
  end func;

const proc: main is func
  local
    const integer: num_pix is 2 * pix + 1;
    var integer: col is 0;
  begin
    screen(num_pix, num_pix);
    clear(curr_win, black);
    KEYBOARD := GRAPH_KEYBOARD;
    for col range 1 to pred(max_iter) do
      colorTable[col] := color(65535 - (col * 5003) mod 65535,
                                       (col * 257)  mod 65535,
                                       (col * 2609) mod 65535);
    end for;
    displayMandelbrotSet(complex(-0.75, 0.0), 1.3 / flt(pix));
    DRAW_FLUSH;
    readln(KEYBOARD);
  end func;


with javascript_semantics
constant iterations = 500,
         limit = 10000

sequence seeds = {},
         cache = {}

sequence temp = repeat(0,iterations)
sequence palin = {}
integer related = 0

for n=1 to limit do
    string num = sprintf("%d",n),
           rev = reverse(num)
    bool palindrome = (num=rev)
    for i=1 to iterations do
        integer digit, carry = 0
        for x=length(num) to 1 by -1 do
            digit = num[x]+rev[x]+carry-'0'
            carry = digit>'9'
            num[x] = digit-carry*10
        end for
        if carry then num = "1" & num end if
        temp[i] = num
        rev = reverse(num)
        if num=rev then exit end if
    end for
    if num!=rev then
        bool no_match = true
        num = sprintf("%d",n)
        if palindrome then
            palin = append(palin, num)
        end if
        for c=1 to length(cache) do
            string seed = cache[c]
            -- check against previous found seeds
            for i=iterations to 1 by -1 do
                string ti = temp[i]
                if length(seed)>length(ti) then
                    exit
                elsif seed=ti then
                    no_match = false
                    related += 1
                    exit
                end if
            end for
            if no_match=false then exit end if
        end for
        if no_match then
            seeds = append(seeds,num)
            cache = append(cache,temp[$])
        end if
    end if
end for

printf(1,"%d lychrel seeds: %s\n",{length(seeds),join(seeds, ", ")})
printf(1,"related lychrel: %d\n",related)
printf(1,"%d lychrel palindromes: %s\n", {length(palin),join(palin, ", ")})


put 0 into oReal # Real origin
put 0 into oImag # Imaginary origin
put 0.5 into mag # Magnification

put oReal - .8 / mag into leftReal
put oImag + .5 / mag into topImag
put 1 / 200 / mag into inc

put [
	(0,255,255),	# aqua
	(0,0,255), # blue
	(255,0,255), # fuchsia
	(128,128,128), # gray
	(0,128,0), # green
	(0,255,0), # lime
	(128,0,0), # maroon
	(0,0,128), # navy
	(128,128,0), # olive
	(128,0,128), # purple
	(255,0,0), # red
	(192,192,192), # silver
	(0,128,128), # teal
	(255,255,255), # white
	(255,255,0) #	yellow
] into colors

put "mandelbrot.ppm" into myFile

open file myFile for writing
write "P3" & return to file myFile # PPM file magic number
write "320 200" & return to file myFile # Width and height
write "255" & return to file myFile # Max value in color channels

put topImag into cImag
repeat with each item in 1 .. 200
	put leftReal into cReal
	repeat with each item in 1 .. 320
		put 0 into zReal
		put 0 into zImag
		put 0 into count
		put 0 into size
		repeat at least once until size > 2 or count = 100
			put zReal squared + zImag squared * -1 into newZreal
			put zReal * zImag + zReal * zImag into newZimag
			put newZreal + cReal into zReal
			put newZimag + cImag into zImag
			put sqrt(zReal squared + zImag squared) into size
			add 1 to count
		end repeat
		if size > 2 then # Outside the set - colorize
			put item count mod 15 + 1 of colors into color
			write color joined by " " to file myFile
			write return to file myFile
		else # Inside the set - black
			write "0 0 0" & return to file myFile
		end if
		add inc to cReal
	end repeat
	subtract inc from cImag
end repeat

close file myFile


go =>
  Limit = 500,
  Lychrel = [],
  Cache = new_set(), % caching the found Lychrel numbers
  Seeds = [],
  Palindromes = [],
  foreach(N in 1..10_000)
    if lychrel(N,Cache,Limit,Seed) then
      Lychrel := Lychrel ++ [N],
      if Seed then Seeds := Seeds ++ [N] end,
      if rev(N) == N then Palindromes := Palindromes ++ [N] end
    end
  end,

  println(num_lychrel_numbers=Seeds.len),
  println(seeds=Seeds),
  println(palindromes=Palindromes),
  println(num_palindromes=Palindromes.len),
  println(num_related=(Lychrel.len-Seeds.len)),
  nl.

table
rev(N) = N.to_string().reverse().to_int().

lychrel(N,Cache,Limit,Seed) =>
  Found = false, % true if we found a non Lychrel number
  Seq = [N],
  Seed1 = false,
  OldHit = cond(Cache.has_key(N),true,false), % found a Lychrel number from cache
  I = 0,
  while (OldHit == false,Found == false,I <= Limit)
    I := I+1,
    N := N + rev(N),
    if Cache.has_key(N) then
      OldHit := true
    else
      Seq := Seq ++ [N],
      if N == rev(N) then Found := true end
    end
  end,
  if Found == false, OldHit == false then
    Seed1 := true, % this is a seed, so add all elements to the cache
    foreach(S in Seq) Cache.put(S) end
  end,
  Seed = Seed1,
  % The check: have we found a Lyncrel number
  (OldHit == true ; Found == false).


(de pali? (N)
   (let N (chop N)
      (= N (reverse N)) ) )
(de lychrel (A)
   (let
      (R NIL
         Lst
         (make
            (for X A
               (let (N X  C 500)
                  (while
                     (and
                        (inc 'N (format (flip (chop N))))
                        (gt0 (dec 'C))
                        (not (pali? N)) ) )
                  (and (=0 C) (link X) ) ) ) )
         Lst22
         (by
            '((N)
               (let (X N  C 3)
                  (prog1
                     (bool
                        (or
                           (member (+ N (format (flip (chop N)))) R)
                           (find
                              '((N) (member N R))
                              (make
                                 (do C
                                    (link (inc 'X (format (flip (chop X))))) ) ) ) ) )
                  (do C
                     (push1
                        'R
                        (inc 'N (format (flip (chop N)))) ) ) ) ) )
            group
            Lst )
         P (filter pali? Lst) )
      (prinl
         "Using n = 1..10000 and limiting each search to 500 reverse-digits-and-adds" )
      (prinl
         "  Number of Lychrel numbers: "
         (length (car Lst22)) )
      (prin "    Lychrel numbers: ")
      (println (car Lst22))
      (prinl
         "  Number of Lychrel related: "
         (length (cadr Lst22)) )
      (prinl
         "  Number of Lychrel palindroms: "
         (length P) )
      (prin "    Lychrel palindromes: ")
      (println P) ) )

(lychrel 10000)

(bye)


function Test-Palindrome ( [String]$String )
    {
    #  Default value
    $IsPalindrome = $True

    #  For each position in the string from the start to the middle
    ForEach ( $Index in ( 0..($String.Length -shr 1 ) ) )
        {
        #  Check if the character at this position matches the corresponding character at the other end
        $IsPalindrome = $IsPalindrome -and $String[$Index] -eq $String[$String.Length - $Index - 1]
        }

    return $IsPalindrome
    }

function Get-LychrelNumbers ( [int]$Upto, [int]$IterationLimit = 500 )
    {
    #  Initialize empty collections
    #  (More typically, PowerShell will use Arrays, but we are using
    #   ArrayLists here to optimize speed and memory usage.)
    $Seeds       = New-Object System.Collections.ArrayList
    $Related     = New-Object System.Collections.ArrayList
    $Palindromes = New-Object System.Collections.ArrayList

    #  For each integer in the test range...
    ForEach ( $N in [bigint]1..[bigint]$Upto )
        {
        #  If N was already identified as a related Lychrel in another
        #  Lychrel series, we don't need to test it
        If ( $N -notin $Related )
            {
            #  Default value
            $IsRelated = $False

            #  Initialize empty collection
            $NSeries = New-Object System.Collections.ArrayList

            #  Starting at N
            $S = $N

            #  Convert S to a string for testing and processing
            $SString = $S.ToString()

            #  For each iteration up to the maximum...
            #  (Generally we would not use ForEach with Break for a loop with
            #   these requirements, but this script is optimized for speed
            #   and ForEach ( $x in $y ) is the fastest loop in PowerShell.)
            ForEach ( $i in 1..$IterationLimit )
                {
                #  Add the reverse of S to S
                $S += [bigint]($SString[($SString.Length)..0] -join '' )

                #  If S appears in the series of a smaller seed Lychrel
                If ( $S -in $Related )
                    {
                    #  S is a related Lychrel; exit processing loop
                    $IsRelated = $True
                    Break
                    }

                #  Convert S to a string for testing and processing
                $SString = $S.ToString()

                If ( Test-Palindrome $SString )
                    {
                    Break
                    }

                #  Add S to the series we are testing
                #  (for possible inclusion as a related number if N turns out to be a seed)
                $NSeries.Add( $S )
                }

            #  If series did not terminate before the iteration limit...
            #  (Including if we stopped early because it join up with an earlier non-terminating series)
            If ( $IsRelated -or $i -eq $IterationLimit )
                {
                #  Add everything in the series above N to the list of related Lychrel numbers
                $Related.AddRange( $NSeries )

                #  If N is a related Lychrel number, add it to the list
                If ( $IsRelated         ) { $Related.    Add( $N ) }

                #  Otherwise add it to the list of Seed Lychrel numbers
                Else                      { $Seeds.      Add( $N ) }

                #  If N is a palindrome, add it to the list of palindrome Lychrel numbers
                If ( Test-Palindrome $N ) { $Palindromes.Add( $N ) }
                }
            }
        }

    #  Convert the various arraylists of big integers to arrays of integers and assign
    #  them as properties of a custom return object. Filter out those Related Lychrel
    #  numbers which exceed our search range.
    $LychrelNumbers = [pscustomobject]@{
            Seeds       = [int[]]$Seeds
            Related     = [int[]]$Related.Where{ $_ -le $Upto }
            Palindromes = [int[]]$Palindromes }

    return $LychrelNumbers
    }


import <Utilities/Complex.sl>;
import <Utilities/Sequence.sl>;
import <Utilities/Math.sl>;

COLOR_STRUCT ::= (R: int(0), G: int(0), B: int(0));
rgb(r(0), g(0), b(0)) := (R: r, G: g, B: b);

RESULT_STRUCT ::= (FinalValue: Complex(0), Iterations: int(0));
makeResult(val(0), iters(0)) := (FinalValue: val, Iterations: iters);

zSquaredOperation(startingNum(0), currentNum(0)) :=
    complexAdd(startingNum, complexMultiply(currentNum, currentNum));

zSquared(minX(0), maxX(0), resolutionX(0), minY(0), maxY(0), resolutionY(0), maxMagnitude(0), maxIters(0))[Y,X] :=
    let
        stepX := (maxX - minX) / resolutionX;
        stepY := (maxY - minY) / resolutionY;

        currentX := X * stepX + minX;
        currentY := Y * stepY + minY;

    in
        operateUntil(zSquaredOperation, makeComplex(currentX, currentY), makeComplex(currentX, currentY), maxMagnitude, 0, maxIters)
    foreach Y within 0 ... (resolutionY - 1),
            X within 0 ... (resolutionX - 1);

operateUntil(operation(0), startingNum(0), currentNum(0), maxMagnitude(0), currentIters(0), maxIters(0)) :=
    let
        operated := operation(startingNum, currentNum);
    in
        makeResult(currentNum, maxIters) when currentIters >= maxIters
    else
        makeResult(currentNum, currentIters) when complexMagnitude(currentNum) >= maxMagnitude
    else
        operateUntil(operation, startingNum, operated, maxMagnitude, currentIters + 1, maxIters);

//region Smooth Coloring

COLOR_COUNT := size(colorSelections);

colorRange := range(0, 255, 1);

colors :=
    let
        first[i] := rgb(0, 0, i) foreach i within colorRange;
        second[i] := rgb(i, i, 255) foreach i within colorRange;
        third[i] := rgb(255, 255, i) foreach i within reverse(colorRange);
        fourth[i] := rgb(255, i, 0) foreach i within reverse(colorRange);
        fifth[i] := rgb(i, 0, 0) foreach i within reverse(colorRange);

        red[i] :=   rgb(i, 0, 0) foreach i within colorRange;
        redR[i] :=  rgb(i, 0, 0) foreach i within reverse(colorRange);
        green[i] := rgb(0, i, 0) foreach i within colorRange;
        greenR[i] :=rgb(0, i, 0) foreach i within reverse(colorRange);
        blue[i] :=  rgb(0, 0, i) foreach i within colorRange;
        blueR[i] := rgb(0, 0, i) foreach i within reverse(colorRange);

    in
        //red ++ redR ++ green ++ greenR ++ blue ++ blueR;
        first ++ second ++ third ++ fourth ++ fifth;
        //first ++ fourth;

colorSelections := range(1, size(colors), 30);

getSmoothColorings(zSquaredResult(2), maxIters(0))[Y,X] :=
    let
        current := zSquaredResult[Y,X];

        zn := complexMagnitude(current.FinalValue);
        nu := ln(ln(zn) / ln(2)) / ln(2);

        result := abs(current.Iterations + 1 - nu);

        index := floor(result);
        rem := result - index;

        color1 := colorSelections[(index mod COLOR_COUNT) + 1];
        color2 := colorSelections[((index + 1) mod COLOR_COUNT) + 1];
    in
        rgb(0, 0, 0) when current.Iterations = maxIters
    else
        colors[color1] when color2 < color1
    else
        colors[floor(linearInterpolate(color1, color2, rem))];

linearInterpolate(v0(0), v1(0), t(0)) := (1 - t) * v0 + t * v1;

//endregion


func mandelbrot(z) {
    var c = z
    {   z = (z*z + c)
        z.abs > 2 && return true
    } * 20
    return false
}

for y range(1, -1, -0.05) {
    for x in range(-2, 0.5, 0.0315) {
        print(mandelbrot(x + y.i) ? ' ' : '#')
    }
    print "\n"
}


reverse_number(Number, Rev):-
    reverse_number(Number, 0, Rev).

reverse_number(0, Rev, Rev):-!.
reverse_number(N, R, Rev):-
    R1 is R * 10 + N mod 10,
    N1 is N // 10,
    reverse_number(N1, R1, Rev).

lychrel(N, M, _, [], [], []):-
    M > N,
    !.
lychrel(N, M, Cache, Seeds, Related, Palindromes):-
    reverse_number(M, R),
    lychrel_sequence(M, 0, M, R, Cache, Sequence, Result),
    update_cache(Cache, Sequence, Result, Cache1),
    M1 is M + 1,
    (Result == 0 ->
        S = Seeds, Rel = Related, P = Palindromes
        ;
        (R == M ->
            Palindromes = [M|P]
            ;
            Palindromes = P),
        (Result == M ->
            Seeds = [M|S], Related = Rel
            ;
            Seeds = S, Related = [M|Rel])),
    lychrel(N, M1, Cache1, S, Rel, P).

update_cache(Cache, [], _, Cache):-!.
update_cache(Cache, [S|Seq], Result, Cache2):-
    put_assoc(S, Cache, Result, Cache1),
    update_cache(Cache1, Seq, Result, Cache2).

lychrel_sequence(N, 500, _, _, _, [], N):-!.
lychrel_sequence(N, I, Sum, Rev, Cache, [Sum1|Sequence], Result):-
    I1 is I + 1,
    Sum1 is Sum + Rev,
    reverse_number(Sum1, Rev1),
    (((Rev1 == Sum1, Result = 0) ; get_assoc(Sum1, Cache, Result)) ->
        Sequence = []
        ;
        lychrel_sequence(N, I1, Sum1, Rev1, Cache, Sequence, Result)).

lychrel(N):-
    empty_assoc(Cache),
    lychrel(N, 1, Cache, Seeds, Related, Palindromes),
    length(Seeds, Num_seeds),
    length(Related, Num_related),
    writef('number of seeds: %w\n', [Num_seeds]),
    writef('seeds: %w\n', [Seeds]),
    writef('number of related: %w\n', [Num_related]),
    writef('palindromes: %w\n', [Palindromes]).

main:-
    lychrel(10000).


BEGIN
    REAL XCENTRE, YCENTRE, WIDTH, RMAX, XOFFSET, YOFFSET, PIXELSIZE;
    INTEGER N, IMAX, JMAX, COLOURMAX;
    TEXT FILENAME;

    CLASS COMPLEX(RE,IM); REAL RE,IM;;

    REF(COMPLEX) PROCEDURE ADD(A,B); REF(COMPLEX) A,B;
        ADD :- NEW COMPLEX(A.RE + B.RE, A.IM + B.IM);

    REF(COMPLEX) PROCEDURE SUB(A,B); REF(COMPLEX) A,B;
        SUB :- NEW COMPLEX(A.RE - B.RE, A.IM - B.IM);

    REF(COMPLEX) PROCEDURE MUL(A,B); REF(COMPLEX) A,B;
        MUL :- NEW COMPLEX(A.RE * B.RE - A.IM * B.IM,
                           A.RE * B.IM + A.IM * B.RE);

    REF(COMPLEX) PROCEDURE DIV(A,B); REF(COMPLEX) A,B;
    BEGIN
        REAL TMP;
        TMP := B.RE * B.RE + B.IM * B.IM;
        DIV :- NEW COMPLEX((A.RE * B.RE + A.IM * B.IM) / TMP,
                           (A.IM * B.RE - A.RE * B.IM) / TMP);
    END DIV;

    REF(COMPLEX) PROCEDURE RECTANGULAR(RE,IM); REAL RE,IM;
        RECTANGULAR :- NEW COMPLEX(RE,IM);

    REAL PROCEDURE MAGNITUDE(CX); REF(COMPLEX) CX;
        MAGNITUDE := SQRT(CX.RE**2 + CX.IM**2);

    BOOLEAN PROCEDURE INSIDEP(Z); REF(COMPLEX) Z;
    BEGIN
        BOOLEAN PROCEDURE INSIDE(Z0,Z,N); REAL N; REF(COMPLEX) Z,Z0;
            INSIDE := MAGNITUDE(Z) < RMAX
                AND THEN N = 0 OR ELSE INSIDE(Z0, ADD(Z0,MUL(Z,Z)), N-1);
        INSIDEP := INSIDE(Z, NEW COMPLEX(0,0), N);
    END INSIDEP;

    INTEGER PROCEDURE BOOL2INT(B); BOOLEAN B;
        BOOL2INT := IF B THEN COLOURMAX ELSE 0;

    INTEGER PROCEDURE PIXEL(I,J); INTEGER I,J;
        PIXEL := BOOL2INT(INSIDEP(RECTANGULAR(XOFFSET + PIXELSIZE * I,
                                              YOFFSET - PIXELSIZE * J)));
    PROCEDURE PLOT;
    BEGIN
       REF (OUTFILE) OUTF;
       INTEGER J,I;
       OUTF :- NEW OUTFILE(FILENAME);
       OUTF.OPEN(BLANKS(132));
       OUTF.OUTTEXT("P2");        OUTF.OUTIMAGE;
       OUTF.OUTINT(IMAX,0);       OUTF.OUTIMAGE;
       OUTF.OUTINT(JMAX,0);       OUTF.OUTIMAGE;
       OUTF.OUTINT(COLOURMAX,0);  OUTF.OUTIMAGE;
       FOR J := 1 STEP 1 UNTIL JMAX DO
       BEGIN
           FOR I := 1 STEP 1 UNTIL IMAX DO
           BEGIN
               OUTF.OUTINT(PIXEL(I,J),0);
               OUTF.OUTIMAGE;
           END;
       END;
       OUTF.CLOSE;
    END PLOT;

    XCENTRE := -0.5;
    YCENTRE := 0.0;
    WIDTH := 4.0;
    IMAX := 800;
    JMAX := 600;
    N := 100;
    RMAX := 2.0;
    FILENAME :- "out.pgm";
    COLOURMAX := 255;
    PIXELSIZE := WIDTH / IMAX;
    XOFFSET := XCENTRE - (0.5 * PIXELSIZE * (IMAX + 1));
    YOFFSET := YCENTRE + (0.5 * PIXELSIZE * (JMAX + 1));

    OUTTEXT("OUTPUT WILL BE WRITTEN TO ");
    OUTTEXT(FILENAME);
    OUTIMAGE;

    PLOT;
END;


from __future__ import print_function

def add_reverse(num, max_iter=1000):
    i, nums = 0, {num}
    while True:
        i, num = i+1, num + reverse_int(num)
        nums.add(num)
        if reverse_int(num) == num or i >= max_iter:
            break
    return nums

#@functools.lru_cache(maxsize=2**20)
def reverse_int(num):
    return int(str(num)[::-1])

def split_roots_from_relateds(roots_and_relateds):
    roots = roots_and_relateds[::]
    i = 1
    while i < len(roots):
        this = roots[i]
        if any(this.intersection(prev) for prev in roots[:i]):
            del roots[i]
        else:
            i += 1
    root = [min(each_set) for each_set in roots]
    related = [min(each_set) for each_set in roots_and_relateds]
    related = [n for n in related if n not in root]
    return root, related

def find_lychrel(maxn, max_reversions):
    'Lychrel number generator'
    series = [add_reverse(n, max_reversions*2) for n in range(1, maxn + 1)]
    roots_and_relateds = [s for s in series if len(s) > max_reversions]
    return split_roots_from_relateds(roots_and_relateds)

if __name__ == '__main__':
    maxn, reversion_limit = 10000, 500
    print("Calculations using n = 1..%i and limiting each search to 2*%i reverse-digits-and-adds"
          % (maxn, reversion_limit))
    lychrel, l_related = find_lychrel(maxn, reversion_limit)
    print('  Number of Lychrel numbers:', len(lychrel))
    print('    Lychrel numbers:', ', '.join(str(n) for n in lychrel))
    print('  Number of Lychrel related:', len(l_related))
    #print('    Lychrel related:', ', '.join(str(n) for n in l_related))
    pals = [x for x in lychrel + l_related  if x == reverse_int(x)]
    print('  Number of Lychrel palindromes:', len(pals))
    print('    Lychrel palindromes:', ', '.join(str(n) for n in pals))


con
  _clkmode = xtal1+pll16x
  _clkfreq = 80_000_000

  xmin=-8601    ' int(-2.1*4096)
  xmax=2867     ' int( 0.7*4096)

  ymin=-4915    ' int(-1.2*4096)
  ymax=4915     ' int( 1.2*4096)

  maxiter=25

obj
  ser : "FullDuplexSerial"

pub main | c,cx,cy,dx,dy,x,y,x2,y2,iter

  ser.start(31, 30, 0, 115200)

  dx:=(xmax-xmin)/79
  dy:=(ymax-ymin)/24

  cy:=ymin
  repeat while cy=<ymax
    cx:=xmin
    repeat while cx=<xmax
      x:=0
      y:=0
      x2:=0
      y2:=0
      iter:=0
      repeat while iter=<maxiter and x2+y2=<16384
        y:=((x*y)~>11)+cy
        x:=x2-y2+cx
        iter+=1
        x2:=(x*x)~>12
        y2:=(y*y)~>12
      cx+=dx
      ser.tx(iter+32)
    cy+=dy
    ser.str(string(13,10))

  waitcnt(_clkfreq+cnt)
  ser.stop


w,h = #.scrsize()
sfx = -2.5; sfy = -2*h/w; fs = 4/w
#.aaoff()
> y, 1...h
  > x, 1...w
    fx = sfx + x*fs; fy = sfy + y*fs
    #.drawpoint(x,y,color(fx,fy):3)
  <
<
color(x,y)=
  zr = x; zi = y; n = 0; maxn = 150
  > zr*zr+zi*zi<4 & n<maxn
    zrn = zr*zr-zi*zi+x; zin = 2*zr*zi+y
    zr = zrn; zi = zin; n += 1
  <
  ? n=maxn, <= 0,0,0
  <= #.hsv2rgb(n/maxn*360,1,1):3
.


library(gmp)
library(magrittr)

cache <- NULL

cache_reset <- function() { cache <<- new.env(TRUE, emptyenv()) }
cache_set <- function(key, value) { assign(key, value, envir = cache) }
cache_get <- function(key) { get(key, envir = cache, inherits = FALSE) }
cache_has_key <- function(key) { exists(key, envir = cache, inherits = FALSE) }

# Initialize the cache
cache_reset()

isPalindromic <- function(num) {
  paste0(unlist(strsplit(num,"")), collapse = "") ==
  paste0(rev(unlist(strsplit(num,""))),collapse = "")
}

aStep <- function(num) {
  num %>%
    strsplit("") %>%
    unlist() %>%
    rev() %>%
    paste0(collapse = "") %>%
    sub("^0+","",.) %>%
    as.bigz() %>%
    '+'(num) %>%
    as.character
}

max_search <- 10000
limit <- 500
related <- 0
lychrel <- vector("numeric")
palindrome_lychrel <- vector("numeric")

for (candidate in 1:max_search) {
  n <- as.character(candidate)
  found <- TRUE
  for (iteration in 1:limit) {
    n <- aStep(n)
    if (cache_has_key(n)) {
      related <- related + 1
      found <- FALSE
      if (isPalindromic(as.character(candidate))) palindrome_lychrel <- append(palindrome_lychrel, candidate)
      break
    }
    if (isPalindromic(n)) {
      found <- FALSE
      break
    }
  }
  if (found) {
    if (isPalindromic(as.character(candidate))) palindrome_lychrel <- append(palindrome_lychrel, candidate)
    lychrel <- append(lychrel,candidate)
    seeds <- seeds + 1
    n <- as.character(candidate)
    for (iteration in 1:limit) {
      cache_set(n,"seen")
      n <- aStep(n)
    }
  }
}
cat("Lychrel numbers in the range [1, ",max_search,"]\n", sep = "")
cat("Maximum iterations =",limit,"\n")
cat("Number of Lychrel seeds:",length(lychrel),"\n")
cat("Lychrel numbers:",lychrel,"\n")
cat("Number of related Lychrel numbers found:",related,"\n")
cat("Number of palindromic Lychrel numbers:",length(palindrome_lychrel),"\n")
cat("Palindromic Lychrel numbers:",palindrome_lychrel,"\n")


import Foundation
import Numerics
import QDBMP

public typealias Color = (red: UInt8, green: UInt8, blue: UInt8)

public class BitmapDrawer {
  public let imageHeight: Int
  public let imageWidth: Int

  var grid: [[Color?]]

  private let bmp: OpaquePointer

  public init(height: Int, width: Int) {
    self.imageHeight = height
    self.imageWidth = width
    self.grid = [[Color?]](repeating: [Color?](repeating: nil, count: height), count: width)
    self.bmp = BMP_Create(UInt(width), UInt(height), 24)

    checkError()
  }

  deinit {
    BMP_Free(bmp)
  }

  private func checkError() {
    let err = BMP_GetError()

    guard err == BMP_STATUS(0) else {
      fatalError("\(err)")
    }
  }

  public func save(to path: String = "~/Desktop/out.bmp") {
    for x in 0..<imageWidth {
      for y in 0..<imageHeight {
        guard let color = grid[x][y] else { continue }

        BMP_SetPixelRGB(bmp, UInt(x), UInt(y), color.red, color.green, color.blue)
        checkError()
      }
    }

    (path as NSString).expandingTildeInPath.withCString {s in
      BMP_WriteFile(bmp, s)
    }
  }

  public func setPixel(x: Int, y: Int, to color: Color?) {
    grid[x][y] = color
  }
}

let imageSize = 10_000
let canvas = BitmapDrawer(height: imageSize, width: imageSize)
let maxIterations = 256
let cxMin = -2.0
let cxMax = 1.0
let cyMin = -1.5
let cyMax = 1.5
let scaleX = (cxMax - cxMin) / Double(imageSize)
let scaleY = (cyMax - cyMin) / Double(imageSize)

for x in 0..<imageSize {
  for y in 0..<imageSize {
    let cx = cxMin + Double(x) * scaleX
    let cy = cyMin + Double(y) * scaleY

    let c = Complex(cx, cy)
    var z = Complex(0.0, 0.0)
    var i = 0

    for t in 0..<maxIterations {
      if z.magnitude > 2 {
        break
      }

      z = z * z + c
      i = t
    }

    canvas.setPixel(x: x, y: y, to: Color(red: UInt8(i), green: UInt8(i), blue: UInt8(i)))
  }
}

canvas.save()


#lang racket
(require racket/splicing)

(define (reverse-digits_10 N)
  (let inr ((n N) (m 0))
    (match n
      [0 m]
      [(app (curryr quotient/remainder 10) q r)
       (inr q (+ r (* 10 m)))])))

(define (palindrome?_10 n)
  (= n (reverse-digits_10 n)))

;; hash of integer? -> one of 'seed 'related #f
(splicing-let ((memo# (make-hash)))
  (define (generate-lychrel?-chain i i-rev n acc)
    (cond
      [(zero? n) ; out of steam
       (cons 'seed acc)]
      [else
       (let* ((i+ (+ i i-rev)) (i+-rev (reverse-digits_10 i+)))
         (cond
           [(= i+ i+-rev) ; palindrome breaks the chain
            (cons #f acc)]
           [(eq? 'related (hash-ref memo# i+ #f)) ; deja vu
            (cons 'related acc)]
           [else ; search some more
            (generate-lychrel?-chain i+ i+-rev (sub1 n) (cons i+ acc))]))]))

  ;; returns 'seed, 'related or #f depending of the Lychrel-ness of a number
  (define (lychrel-number? i #:n (n 500))
    (match (hash-ref memo# i 'unfound)
      ['unfound
       (match (generate-lychrel?-chain i (reverse-digits_10 i) n null)
         [(cons 'related chain) 'related]
         [(cons (and seed (or (and 'seed (app (λ (_) 'related) related?))
                              (and #f (app (λ (_) #f) related?))))
                chain)
          (for ((c (in-list chain))) (hash-set! memo# c related?))
          (hash-set! memo# i seed)
          seed])]
      [seed/related/false seed/related/false])))

(module+ main
  (define-values (seeds/r n-relateds palindromes/r)
    (for/fold ((s/r null) (r 0) (p/r null))
              ((i (in-range 1 (add1 10000))))
      (define lych? (lychrel-number? i))
      (define p/r+ (if (and lych? (palindrome?_10 i)) (cons (list i (list lych?)) p/r) p/r))
      (match lych?
        ['seed (values (cons i s/r) r p/r+)]
        ['related (values s/r (add1 r) p/r+)]
        [#f (values s/r r p/r+)])))

  (printf #<<EOS
Seed Lychrel numbers:        ~a count:~a
Related Lychrel numbers:     count:~a
Palindromic Lychrel numbers: ~a~%
EOS
          (reverse seeds/r) (length seeds/r) n-relateds (reverse palindromes/r)))


my %lychrels;
my @seeds;
my @palindromes;
my $count;
my $max = 500;
my $limit = '10_000';
my %seen;

for 1 .. $limit -> $int {
    my @test;
    my $index = 0;
    if $int.&is-lychrel {
        %lychrels.push: ($int => @test).invert;
        @palindromes.push: $int if $int == $int.flip;
        $count++;
    }

    sub is-lychrel (Int $l) {
        if  %seen{$l} or $index++ > $max {
            %seen{$_} = True for @test;
            return True;
        }
        @test.push: my $m = $l + $l.flip;
        return False if $m == $m.flip;
        $m.&is-lychrel;
    }
}

for %lychrels{*}»[0].unique.sort -> $ly {
    my $next = False;
    for %lychrels -> $l {
        for $l.value[1..*] -> $lt {
            $next = True and last if $ly == $lt;
            last if $ly < $lt;
        }
        last if $next;
    }
    next if $next;
    @seeds.push: $ly;
}

say "   Number of Lychrel seed numbers < $limit: ", +@seeds;
say "             Lychrel seed numbers < $limit: ", join ", ", @seeds;
say "Number of Lychrel related numbers < $limit: ", +$count - @seeds;
say "    Number of Lychrel palindromes < $limit: ", +@palindromes;
say "              Lychrel palindromes < $limit: ", join ", ", @palindromes;


package require Tk

proc mandelIters {cx cy} {
    set x [set y 0.0]
    for {set count 0} {hypot($x,$y) < 2 && $count < 255} {incr count} {
        set x1 [expr {$x*$x - $y*$y + $cx}]
        set y1 [expr {2*$x*$y + $cy}]
        set x $x1; set y $y1
    }
    return $count
}
proc mandelColor {iter} {
    set r [expr {16*($iter % 15)}]
    set g [expr {32*($iter % 7)}]
    set b [expr {8*($iter % 31)}]
    format "#%02x%02x%02x" $r $g $b
}
image create photo mandel -width 300 -height 300
# Build picture in strips, updating as we go so we have "progress" monitoring
# Also set the cursor to tell the user to wait while we work.
pack [label .mandel -image mandel -cursor watch]
update
for {set x 0} {$x < 300} {incr x} {
    for {set y 0} {$y < 300} {incr y} {
        set i [mandelIters [expr {($x-220)/100.}] [expr {($y-150)/90.}]]
        mandel put [mandelColor $i] -to $x $y
    }
    update
}
.mandel configure -cursor {}


/*REXX program finds and displays  Lychrel numbers,  related numbers, and  palindromes. */
parse arg high limit .                           /*obtain optional argument from the CL.*/
if  high='' |  high==","  then  high= 10000      /*Not specified?  Then use the default.*/
if limit='' | limit==","  then limit=   500      /* "      "         "   "   "     "    */
numeric digits  limit % 2                        /*ensure enough decimal digits for adds*/
T.= 0;   @.= T.;   #.[email protected].;     w= length(high)    /*W:   is used for formatting numbers. */
$=                                               /*the list of  Lychrel  numbers.       */
    do j=1  for high;         call Lychrel j     /*find the    Lychrel   numbers.       */
    end   /*j*/
p=;                           R=                 /*P: list of palindromes; R: related #s*/
    do k=1  for high
    if #.k                    then $= $ k        /*build a list of Lychrel numbers.     */
    if T.k                    then R= R k        /*  "   "   "   "    "    related nums.*/
    if T.k  &  k==reverse(k)  then p= p k        /*  "   "   "   "    "    palindromes. */
    end   /*k*/

say 'Found in the range  1  to '   high    " (limiting searches to "    limit   ' steps):'
say
say right( words($)           , w)         'Lychrel numbers:'             $
say right( words(R) - words($), w)         'Lychrel related numbers.'
say right( words(p)           , w)         'Lychrel palindromes:'         p
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
Lychrel: procedure expose limit @. #. T.; parse arg x 1 z   /*set X and Z to argument 1.*/
         rels= 0                                            /*# related numbers (so far)*/
                   do  limit;             z= z + reverse(z) /*add the reverse of Z ···  */
                   if z==reverse(z)  then return            /*is the new Z a palindrome?*/
                   rels= rels + 1;        !.rels= z         /*add to the related numbers*/
                   end   /*limit*/                          /* [↑]  only DO limit times.*/
         #.x= 1                                             /*mark number as a  Lychrel.*/
         T.x= 1;   do a=1  for rels;      _= !.a            /*process "related" numbers.*/
                   if @._  then #.x= 0                      /*unmark number as  Lychrel.*/
                           else @._= 1                      /*  mark    "    "    "     */
                   T._= 1                                   /*mark number as  "related".*/
                   end   /*a*/
         return


require 'set'

def add_reverse(num, max_iter=1000)
  (1..max_iter).each_with_object(Set.new([num])) do |_,nums|
    num += reverse_int(num)
    nums << num
    return nums if palindrome?(num)
  end
end

def palindrome?(num)
  num == reverse_int(num)
end

def reverse_int(num)
  num.to_s.reverse.to_i
end

def split_roots_from_relateds(roots_and_relateds)
  roots = roots_and_relateds.dup
  i = 1
  while i < roots.length
    this = roots[i]
    if roots[0...i].any?{|prev| this.intersect?(prev)}
      roots.delete_at(i)
    else
      i += 1
    end
  end
  root = roots.map{|each_set| each_set.min}
  related = roots_and_relateds.map{|each_set| each_set.min}
  related = related.reject{|n| root.include?(n)}
  return root, related
end

def find_lychrel(maxn, max_reversions)
  series = (1..maxn).map{|n| add_reverse(n, max_reversions*2)}
  roots_and_relateds = series.select{|s| s.length > max_reversions}
  split_roots_from_relateds(roots_and_relateds)
end

maxn, reversion_limit = 10000, 500
puts "Calculations using n = 1..#{maxn} and limiting each search to 2*#{reversion_limit} reverse-digits-and-adds"
lychrel, l_related = find_lychrel(maxn, reversion_limit)
puts "  Number of Lychrel numbers: #{lychrel.length}"
puts "    Lychrel numbers: #{lychrel}"
puts "  Number of Lychrel related: #{l_related.length}"
pals = (lychrel + l_related).select{|x| palindrome?(x)}.sort
puts "  Number of Lychrel palindromes: #{pals.length}"
puts "    Lychrel palindromes: #{pals}"


\input pst-fractal
\psfractal[type=Mandel,xWidth=14cm,yWidth=12cm,maxIter=30,dIter=20] (-2.5,-1.5)(1,1.5)
\end


\documentclass{minimal}
\usepackage{tikz}
\usetikzlibrary{shadings}
\begin{document}
\begin{tikzpicture}
    \shade[shading=Mandelbrot set] (0,0) rectangle (4,4);
\end{tikzpicture}
\end{document}


[package]
name = "lychrel"
version = "0.1.0"
authors = ["monsieursquirrel"]

[dependencies]
num = "0.1.27"


import scala.collection.mutable.LinkedHashMap

val range = 1 to 10000
val maxIter = 500;

def lychrelSeq( seed:BigInt ) : Stream[BigInt] = {
  def reverse( v:BigInt ) = BigInt(v.toString.reverse)
  def isPalindromic( v:BigInt ) = { val s = (v + reverse(v)).toString; s == s.reverse }

  def loop( v:BigInt ):Stream[BigInt] = v #:: loop( v + reverse(v) )
  val seq = loop(seed)

  seq.take( seq.take(maxIter).indexWhere( isPalindromic(_) ) match {
    case -1 => maxIter
    case n => n + 1
  })
}

// A quick test
assert( lychrelSeq(56).length == 1 )
assert( lychrelSeq(57).length == 2 )
assert( lychrelSeq(59).length == 3 )
assert( lychrelSeq(89).length == 24 )
assert( lychrelSeq(10911).length == 55 )

val lychrelNums = for( n <- range if lychrelSeq(n).length == maxIter ) yield n

val (seeds,related) = {
  val lycs = LinkedHashMap[BigInt,Int]()

  // Fill the Map not allowing duplicate values
  lychrelNums.foreach{ n => val ll = lychrelSeq(n).map( (_ -> n) ); LinkedHashMap( ll:_* ) ++= lycs }

  for( n <- lychrelNums ) {
    val ll = lychrelSeq(n).map( (_ -> n) )
    val mm = LinkedHashMap( ll:_* )
    lycs ++= (mm ++= lycs)
  }

  // Group by the Lychrel Number
  val zz = lycs.groupBy{ _._2 }.map{ case (k,m) => k -> m.keys.toList.sorted }

  // Now, group by size, seeds will have 500 or maxIter
  val yy = lychrelNums.groupBy( n => zz.filterKeys(_==n).values.flatten.size < maxIter )

  // Results: seeds are false, related true
  (yy.filterKeys(_ == false).values.toVector.flatten,
   yy.filterKeys(_ ==  true).values.toVector.flatten)
}

val lychrelPals = for( n <- lychrelNums; if n.toString == n.toString.reverse ) yield n

// Show the results
{
println( s"There are ${lychrelNums.size} Lychrel Numbers between ${range.min} and ${range.max} \n   when limited to $maxIter iterations:" )
println
println( s"\t        Seeds: ${seeds.size} (${seeds.mkString(", ")})" )
println( s"\tRelated Count: ${related.size}" )
println( s"\t  Palindromes: (${lychrelPals.mkString(", ")})")
}


PROGRAM:MANDELBR
:Input "ITER. ",D
:For(A,Xmin,Xmax,ΔX)
:For(B,Ymin,Ymax,ΔY)
:0→X
:0→Y
:0→I
:D→M
:While X^2+Y^2≤4 and I<M
:X^2-Y^2+A→R
:2XY+B→Y
:R→X
:I+1→I
:End
:If I≠M
:Then
:I→C
:Else
:0→C
:End
:If C<1
:Pt-On(A,B)
:End
:End
:End


var (
    lychrels = [],
    palindromes = [],
    seeds = [],
    max = 500,
)

for i in (1 .. 10_000) {
    var (test = [], count = 0)

    func lychrel(l) {
        count++ > max && return true
        test << (var m = (l + Num(Str(l).flip)))
        Str(m).is_palindrome && return false
        lychrel(m)
    }

    if (lychrel(i)) {
        lychrels << Pair(Str(i), test)
    }
}

seeds << lychrels[0]

for l in lychrels {
    if (l.key.is_palindrome) {
        palindromes << l.key
    }

    var h = Hash()
    h.set_keys(l.value...)

    var trial = seeds.count_by { |s|
        s.value.any { |k| h.contains(k) } ? break : true
    }

    if (trial == seeds.len) {
        seeds << l
    }
}

say ("   Number of Lychrel seed numbers < 10_000: ", seeds.len)
say ("             Lychrel seed numbers < 10_000: ", seeds.map{.key}.join(', '))
say ("Number of Lychrel related numbers < 10_000: ", lychrels.len - seeds.len)
say ("    Number of Lychrel palindromes < 10_000: ", palindromes.len)
say ("              Lychrel palindromes < 10_000: ", palindromes.join(', '))


import BigInt

public struct Lychrel<T: ReversibleNumeric & CustomStringConvertible>: Sequence, IteratorProtocol {
  @usableFromInline
  let seed: T

  @usableFromInline
  var done = false

  @usableFromInline
  var n: T

  @usableFromInline
  var iterations: T

  @inlinable
  public init(seed: T, iterations: T = 500) {
    self.seed = seed
    self.n = seed
    self.iterations = iterations
  }

  @inlinable
  public mutating func next() -> T? {
    guard !done && iterations != 0 else {
      return nil
    }

    guard !isPalindrome(n) || n == seed else {
      done = true

      return n
    }

    defer {
      n += n.reversed()
      iterations -= 1
    }

    return n
  }
}

@inlinable
public func isPalindrome<T: CustomStringConvertible>(_ x: T) -> Bool {
  let asString = String(describing: x)

  for (c, c1) in zip(asString, asString.reversed()) where c != c1 {
    return false
  }

  return true
}

public protocol ReversibleNumeric: Numeric {
  func reversed() -> Self
}

extension BigInt: ReversibleNumeric {
  public func reversed() -> BigInt {
    return BigInt(String(description.reversed()))!
  }
}

typealias LychrelReduce = (seen: Set<BigInt>, seeds: Set<BigInt>, related: Set<BigInt>)

let (seen, seeds, related): LychrelReduce =
  (1...10_000)
    .map({ BigInt($0) })
    .reduce(into: LychrelReduce(seen: Set(), seeds: Set(), related: Set()), {res, cur in
      guard !res.seen.contains(cur) else {
        res.related.insert(cur)

        return
      }

      var seen = false

      let seq = Lychrel(seed: cur).prefix(while: { seen = res.seen.contains($0); return !seen })
      let last = seq.last!

      guard !isPalindrome(last) || seen else {
        return
      }

      res.seen.formUnion(seq)

      if seq.count == 500 {
        res.seeds.insert(cur)
      } else {
        res.related.insert(cur)
      }
  })

print("Found \(seeds.count + related.count) Lychrel numbers between 1...10_000 when limited to 500 iterations")
print("Number of Lychrel seeds found: \(seeds.count)")
print("Lychrel seeds found: \(seeds.sorted())")
print("Number of related Lychrel nums found: \(related.count)")
print("Lychrel palindromes found: \(seeds.union(related).filter(isPalindrome).sorted())")


(defvar x-centre -0.5)
(defvar y-centre 0.0)
(defvar width 4.0)
(defvar i-max 800)
(defvar j-max 600)
(defvar n 100)
(defvar r-max 2.0)
(defvar file "mandelbrot.pgm")
(defvar colour-max 255)
(defvar pixel-size (/ width i-max))
(defvar x-offset (- x-centre (* 0.5 pixel-size (+ i-max 1))))
(defvar y-offset (+ y-centre (* 0.5 pixel-size (+ j-max 1))))

;; with-output-to-file macro
(defmacro with-output-to-file (name . body)
  ^(let ((*stdout* (open-file ,name "w")))
     (unwind-protect (progn ,*body) (close-stream *stdout*))))

;; complex number library
(defmacro cplx (x y) ^(cons ,x ,y))
(defmacro re (c) ^(car ,c))
(defmacro im (c) ^(cdr ,c))

(defsymacro c0 '(0 . 0))

(macro-time
  (defun with-cplx-expand (specs body)
    (tree-case specs
       (((re im expr) . rest)
        ^(tree-bind (,re . ,im) ,expr ,(with-cplx-expand rest body)))
       (() (tree-case body
             ((a b . rest) ^(progn ,a ,b ,*rest))
             ((a) a)
             (x (error "with-cplx: invalid body ~s" body))))
       (x (error "with-cplx: bad args ~s" x)))))

(defmacro with-cplx (specs . body)
  (with-cplx-expand specs body))

(defun c+ (x y)
  (with-cplx ((a b x) (c d y))
    (cplx (+ a c) (+ b d))))

(defun c* (x y)
  (with-cplx ((a b x) (c d y))
    (cplx (- (* a c) (* b d)) (+ (* b c) (* a d)))))

(defun modulus (z)
  (with-cplx ((a b z))
    (sqrt (+ (* a a) (* b b)))))

;; Mandelbrot routines
(defun inside-p (z0 : (z c0) (n n))
  (and (< (modulus z) r-max)
       (or (zerop n)
           (inside-p z0 (c+ (c* z z) z0) (- n 1)))))

(defmacro int-bool (b)
  ^(if ,b colour-max 0))

(defun pixel (i j)
  (int-bool
    (inside-p
      (cplx (+ x-offset (* pixel-size i))
            (- y-offset (* pixel-size j))))))

;; Mandelbrot loop and output
(defun plot ()
  (with-output-to-file file
    (format t "P2\n~s\n~s\n~s\n" i-max j-max colour-max)
    (each ((j (range 1 j-max)))
      (each ((i (range 1 i-max)))
        (format *stdout* "~s " (pixel i j)))
      (put-line "" *stdout*))))

(plot)


A =-21000                              ' Left Edge = -2.1
B = 15000                              ' Right Edge = 1.5
C = 15000                              ' Top Edge = 1.5
D =-15000                              ' Bottom Edge = -1.5
E = 200                                ' Max Iteration Depth
F = 350                                ' X Step Size
G = 750                                ' Y Step Size

For L = C To D Step -G                 ' Y0
    For K = A To B-1 Step F            ' X0
        V = 0                          ' Y
        U = 0                          ' X
        I = 32                         ' Char To Be Displayed
        For O = 0 To E-1               ' Iteration
            X = (U/10 * U) / 1000      ' X*X
            Y = (V/10 * V) / 1000      ' Y*Y
            If (X + Y > 40000)
                I = 48 + O             ' Print Digit 0...9
                If (O > 9)             ' If Iteration Count > 9,
                    I = 64             '  Print '@'
                Endif
                Break
            Endif
            Z = X - Y + K              ' Temp = X*X - Y*Y + X0
            V = (U/10 * V) / 500 + L   ' Y = 2*X*Y + Y0
            U = Z                      ' X = Temp
        Next
        Gosub I                        '  Ins_char(I)
    Next
    Print
Next

End
                                       ' Translate number to ASCII
32 Print " "; : Return
48 Print "0"; : Return
49 Print "1"; : Return
50 Print "2"; : Return
51 Print "3"; : Return
52 Print "4"; : Return
53 Print "5"; : Return
54 Print "6"; : Return
55 Print "7"; : Return
56 Print "8"; : Return
57 Print "9"; : Return
64 Print "@"; : Return


proc pal? {n} {
    expr {$n eq [string reverse $n]}
}

proc step {n} {
    set n_ [string reverse $n]
    set n_ [string trimleft $n_ 0]
    expr {$n + $n_}
}

proc lychrels {{max 10000} {iters 500}} {

    set lychrels {}     ;# true Lychrels
    set visited {}      ;# visited numbers for Related test
    set nRelated 0      ;# count of related numbers seen
    set pals {}         ;# palindromic Lychrels and related

    puts "Searching for Lychrel numbers in \[1,$max\]"
    puts "With a maximum of $iters iterations"

    for {set i 1} {$i <= $max} {incr i} {
        set n $i        ;# seed the sequence
        set seq {}      ;# but don't check the seed, nor remember it for the Related test
        for {set j 0} {$j < $iters} {incr j} {
            set n [step $n]
            dict set seq $n {}
            if {[dict exists $visited $n]} {
                incr nRelated
                if {[pal? $i]} {
                    lappend pals $i
                }
                break   ;# bail out if it's Related
            }
            if {[pal? $n]} {
                break   ;# bail out if it's a palindrome
            }
        }
        if {$j >= $iters} {    ;# the loop was exhausted: must be a Lychrel!
            if {[pal? $i]} {
                lappend pals $i
            }
            lappend lychrels $i
            set visited [dict merge $visited $seq]
        }
    }

    puts "[llength $lychrels] Lychrel numbers found:"
    puts $lychrels
    puts "Count of related numbers: $nRelated"
    puts "Palindromic Lychrel and related numbers: $pals"
}

lychrels


import "/big" for BigInt
import "/set" for Set

var iterations = 500
var limit = 10000
var bigLimit = BigInt.new(limit)

// In the sieve,  0 = not Lychrel, 1 = Seed Lychrel, 2 = Related Lychrel
var lychrelSieve    = List.filled(limit + 1, 0)
var seedLychrels    = []
var relatedLychrels = Set.new()

var isPalindrome = Fn.new { |bi|
    var s = bi.toString
    return s == s[-1..0]
}

var lychrelTest = Fn.new { |i, seq|
    if (i < 1) return
    var bi = BigInt.new(i)
    for (j in 1..iterations) {
        bi = bi + BigInt.new(bi.toString[-1..0])
        seq.add(bi)
        if (isPalindrome.call(bi)) return
    }
    for (j in 0...seq.count) {
        if (seq[j] <= bigLimit) {
            lychrelSieve[seq[j].toSmall] = 2
        } else {
            break
        }
    }
    var sizeBefore = relatedLychrels.count
    // if all of these can be added 'i' must be a seed Lychrel
    relatedLychrels.addAll(seq.map { |i| i.toString }) // can't add BigInts directly to a Set
    if (relatedLychrels.count - sizeBefore == seq.count) {
        seedLychrels.add(i)
        lychrelSieve[i] = 1
    } else {
        relatedLychrels.add(i.toString)
        lychrelSieve[i] = 2
    }
}

var seq = []
for (i in 1..limit) {
    if (lychrelSieve[i] == 0) {
        seq.clear()
        lychrelTest.call(i, seq)
    }
}
var related = lychrelSieve.count { |i| i == 2 }
System.print("Lychrel numbers in the range [1, %(limit)]")
System.print("Maximum iterations = %(iterations)")
System.print("\nThere are %(seedLychrels.count) seed Lychrel numbers, namely:")
System.print(seedLychrels)
System.print("\nThere are also %(related) related Lychrel numbers in this range.")
var palindromes = []
for (i in 1..limit) {
    if (lychrelSieve[i] > 0 && isPalindrome.call(BigInt.new(i))) palindromes.add(i)
}
System.print("\nThere are %(palindromes.count) palindromic Lychrel numbers, namely:")
System.print(palindromes)


var BN=Import("zklBigNum");

   // 192-->"887\01675\07436\013783\0..." ~60k bytes
fcn lychrel(n,returnListof=False){ n=BN(n); //-->Bool|Data(==StringBuf)
   sink:=(if(returnListof) Data(0,String) else Void);
   nls:=(500).pump(sink,'wrap(){
      ns:=n.add(BN(n.toString().reverse())).toString();
      if(ns==ns.reverse()) return(Void.Stop,False);  // not a Lychrel number
      ns
   });
   if(nls) if(returnListof) return(sink.mode(Int).howza(2)) else return(True);
   False;
}
fcn isPalindrome(n){ n==n.toString().reverse().toInt() }
fcn findSeeds(lychrels){
   seeds:=List(lychrels[0]);
   foreach n,lnns in ([1..].zip(lychrels[1,*])){ ln,seq:=lnns;
      foreach _,s2 in (seeds){
	 foreach s3 in (seq){
	    if(Void!=(z:=s2.findString(s3)) and 0==s2[z-1]) break(2);
	 }
      }
      fallthrough{ seeds.append(lnns) }
   }
   seeds.apply("get",0)
}


import "graphics" for Canvas, Color
import "dome" for Window

var MaxIters = 570
var Zoom = 150

class MandelbrotSet {
    construct new(width, height) {
        Window.title = "Mandelbrot Set"
        Window.resize(width, height)
        Canvas.resize(width, height)
        _w = width
        _h = height
    }

    init() {
        createMandelbrot()
    }

    createMandelbrot() {
        for (x in 0..._w) {
            for (y in 0..._h) {
                var zx = 0
                var zy = 0
                var cX = (x - 400) / Zoom
                var cY = (y - 300) / Zoom
                var i = MaxIters
                while (zx * zx + zy * zy < 4 && i > 0) {
                    var tmp = zx * zx - zy * zy + cX
                    zy = 2 * zx * zy + cY
                    zx = tmp
                    i = i - 1
                }
                var r = i * 255 / MaxIters
                Canvas.pset(x, y, Color.rgb(r, r, r))
            }
        }
    }

    update() {}

    draw(alpha) {}
}

var Game = MandelbrotSet.new(800, 600)


include c:\cxpl\codes;          \intrinsic 'code' declarations
int     X, Y,                   \screen coordinates of current point
        Cnt;                    \iteration counter
real    Cx, Cy,                 \coordinates scaled to +/-2 range
        Zx, Zy,                 \complex accumulator
        Temp;                   \temporary scratch
[SetVid($112);                                  \set 640x480x24 graphics mode
for Y:= 0 to 480-1 do                           \for all points on the screen...
    for X:= 0 to 640-1 do
        [Cx:= (float(X)/640.0 - 0.5) * 4.0;     \range: -2.0 to +2.0
         Cy:= (float(Y-240)/240.0) * 1.5;       \range: -1.5 to +1.5
         Cnt:= 0;  Zx:= 0.0;  Zy:= 0.0;         \initialize
         loop   [if Zx*Zx + Zy*Zy > 2.0 then    \Z heads toward infinity
                    [Point(X, Y, Cnt<<21+Cnt<<10+Cnt<<3); \set color of pixel to
                    quit;                       \ rate it approached infinity
                    ];                          \move on to next point
                Temp:= Zx*Zy;
                Zx:= Zx*Zx - Zy*Zy + Cx;        \calculate next iteration of Z
                Zy:= 2.0*Temp + Cy;
                Cnt:= Cnt+1;                    \count number of iterations
                if Cnt >= 1000 then quit;       \assume point is in Mandelbrot
                ];                              \ set and leave it colored black
        ];
X:= ChIn(1);                                    \wait for keystroke
SetVid($03);                                    \restore normal text display
]


<?xml version="1.0" encoding="UTF-8"?>
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">

<xsl:output method="html" indent="no"
  doctype-public="-//W3C//DTD HTML 4.01//EN"
  doctype-system="http://www.w3.org/TR/REC-html40/strict.dtd"
 />

<xsl:template match="/fractal">

   <title>XSLT fractal</title>

    Copyright © 1992,2007 Joel Yliluoma
    (http://iki.fi/bisqwit/)

XSLT fractal

<xsl:call-template name="bisqwit-mandelbrot" />

</xsl:template>

<xsl:template name="bisqwit-mandelbrot"
  ><xsl:call-template name="bisqwit-mandelbrot-line">
   <xsl:with-param name="y" select="y/min"/>
  </xsl:call-template
></xsl:template>

<xsl:template name="bisqwit-mandelbrot-line"
 ><xsl:param name="y"
 /><xsl:call-template name="bisqwit-mandelbrot-column">
  <xsl:with-param name="x" select="x/min"/>
  <xsl:with-param name="y" select="$y"/>
 </xsl:call-template
 ><xsl:if test="$y < y/max"
  >
<xsl:call-template name="bisqwit-mandelbrot-line">
   <xsl:with-param name="y" select="$y + y/step"/>
  </xsl:call-template
 ></xsl:if
></xsl:template>

<xsl:template name="bisqwit-mandelbrot-column"
 ><xsl:param name="x"
 /><xsl:param name="y"
 /><xsl:call-template name="bisqwit-mandelbrot-slot">
  <xsl:with-param name="x" select="$x" />
  <xsl:with-param name="y" select="$y" />
  <xsl:with-param name="zr" select="$x" />
  <xsl:with-param name="zi" select="$y" />
 </xsl:call-template
 ><xsl:if test="$x < x/max"
  ><xsl:call-template name="bisqwit-mandelbrot-column">
   <xsl:with-param name="x" select="$x + x/step"/>
   <xsl:with-param name="y" select="$y" />
  </xsl:call-template
 ></xsl:if
></xsl:template>

<xsl:template name="bisqwit-mandelbrot-slot"
><xsl:param name="x"
 /><xsl:param name="y"
 /><xsl:param name="zr"
 /><xsl:param name="zi"
 /><xsl:param name="iter" select="0"
 /><xsl:variable name="zrsqr" select="($zr * $zr)"
 /><xsl:variable name="zisqr" select="($zi * $zi)"
 /><xsl:choose>
  <xsl:when test="(4*scale*scale >= $zrsqr + $zisqr) and (maxiter > $iter+1)"
   ><xsl:call-template name="bisqwit-mandelbrot-slot">
    <xsl:with-param name="x" select="$x" />
    <xsl:with-param name="y" select="$y" />
    <xsl:with-param name="zi" select="(2 * $zr * $zi) div scale + $y" />
    <xsl:with-param name="zr" select="($zrsqr - $zisqr) div scale + $x" />
    <xsl:with-param name="iter" select="$iter + 1" />
   </xsl:call-template
  ></xsl:when>
  <xsl:otherwise
   ><xsl:variable name="magnitude" select="magnitude[@value=$iter]"
    /><xsl:value-of select="$magnitude/symbol"
  /></xsl:otherwise>
 </xsl:choose
></xsl:template>

</xsl:stylesheet>


;
;  Compute a Mandelbrot set on a simple Z80 computer.
;
; Porting this program to another Z80 platform should be easy and straight-
; forward: The only dependencies on my homebrew machine are the system-calls
; used to print strings and characters. These calls are performed by loading
; IX with the number of the system-call and performing an RST 08. To port this
; program to another operating system just replace these system-calls with
; the appropriate versions. Only three system-calls are used in the following:
; _crlf: Prints a CR/LF, _puts: Prints a 0-terminated string (the adress of
; which is expected in HL), and _putc: Print a single character which is
; expected in A. RST 0 give control back to the monitor.
;
#include        "mondef.asm"

                org     ram_start

scale           equ     256                     ; Do NOT change this - the
                                                ; arithmetic routines rely on
                                                ; this scaling factor! :-)
divergent       equ     scale * 4

                ld      hl, welcome             ; Print a welcome message
                ld      ix, _puts
                rst     08

; for (y = <initial_value> ; y <= y_end; y += y_step)
; {
outer_loop      ld      hl, (y_end)             ; Is y <= y_end?
                ld      de, (y)
                and     a                       ; Clear carry
                sbc     hl, de                  ; Perform the comparison
                jp      m, mandel_end           ; End of outer loop reached

;    for (x = x_start; x <= x_end; x += x_step)
;    {
                ld      hl, (x_start)           ; x = x_start
                ld      (x), hl
inner_loop      ld      hl, (x_end)             ; Is x <= x_end?
                ld      de, (x)
                and     a
                sbc     hl, de
                jp      m, inner_loop_end       ; End of inner loop reached

;      z_0 = z_1 = 0;
                ld      hl, 0
                ld      (z_0), hl
                ld      (z_1), hl

;      for (iteration = iteration_max; iteration; iteration--)
;      {
                ld      a, (iteration_max)
                ld      b, a
iteration_loop  push    bc                      ; iteration -> stack
;        z2 = (z_0 * z_0 - z_1 * z_1) / SCALE;
                ld      de, (z_1)               ; Compute DE HL = z_1 * z_1
                ld      bc, de
                call    mul_16
                ld      (z_0_square_low), hl    ; z_0 ** 2 is needed later again
                ld      (z_0_square_high), de

                ld      de, (z_0)               ; Compute DE HL = z_0 * z_0
                ld      bc, de
                call    mul_16
                ld      (z_1_square_low), hl    ; z_1 ** 2 will be also needed
                ld      (z_1_square_high), de

                and     a                       ; Compute subtraction
                ld      bc, (z_0_square_low)
                sbc     hl, bc
                ld      (scratch_0), hl         ; Save lower 16 bit of result
                ld      hl, de
                ld      bc, (z_0_square_high)
                sbc     hl, bc
                ld      bc, (scratch_0)         ; HL BC = z_0 ** 2 - z_1 ** 2

                ld      c, b                    ; Divide by scale = 256
                ld      b, l                    ; Discard the rest
                push    bc                      ; We need BC later

;        z3 = 2 * z0 * z1 / SCALE;
                ld      hl, (z_0)               ; Compute DE HL = 2 * z_0 * z_1
                add     hl, hl
                ld      de, hl
                ld      bc, (z_1)
                call    mul_16

                ld      b, e                    ; Divide by scale (= 256)
                ld      c, h                    ; BC contains now z_3

;        z1 = z3 + y;
                ld      hl, (y)
                add     hl, bc
                ld      (z_1), hl

;        z_0 = z_2 + x;
                pop     bc                      ; Here BC is needed again :-)
                ld      hl, (x)
                add     hl, bc
                ld      (z_0), hl

;        if (z0 * z0 / SCALE + z1 * z1 / SCALE > 4 * SCALE)
                ld      hl, (z_0_square_low)    ; Use the squares computed
                ld      de, (z_1_square_low)    ; above
                add     hl, de
                ld      bc, hl                  ; BC contains lower word of sum

                ld      hl, (z_0_square_high)
                ld      de, (z_1_square_high)
                adc     hl, de

                ld      h, l                    ; HL now contains (z_0 ** 2 +
                ld      l, b                    ; z_1 ** 2) / scale

                ld      bc, divergent
                and     a
                sbc     hl, bc

;          break;
                jp      c, iteration_dec        ; No break
                pop     bc                      ; Get latest iteration counter
                jr      iteration_end           ; Exit loop

;        iteration++;
iteration_dec   pop     bc                      ; Get iteration counter
                djnz    iteration_loop          ; We might fall through!
;      }
iteration_end
;      printf("%c", display[iteration % 7]);
                ld      a, b
                and     $7                      ; lower three bits only (c = 0)
                sbc     hl, hl
                ld      l, a
                ld      de, display             ; Get start of character array
                add     hl, de                  ; address and load the
                ld      a, (hl)                 ; character to be printed
                ld      ix, _putc               ; Print the character
                rst     08

                ld      de, (x_step)            ; x += x_step
                ld      hl, (x)
                add     hl, de
                ld      (x), hl

                jp      inner_loop
;    }
;    printf("\n");
inner_loop_end  ld      ix, _crlf               ; Print a CR/LF pair
                rst     08

                ld      de, (y_step)            ; y += y_step
                ld      hl, (y)
                add     hl, de
                ld      (y), hl                 ; Store new y-value

                jp      outer_loop
; }

mandel_end      ld      hl, finished            ; Print finished-message
                ld      ix, _puts
                rst     08

                rst     0                       ; Return to the monitor

welcome         defb    "Generating a Mandelbrot set"
                defb    cr, lf, eos
finished        defb    "Computation finished.", cr, lf, eos

iteration_max   defb    10                      ; How many iterations
x               defw    0                       ; x-coordinate
x_start         defw    -2 * scale              ; Minimum x-coordinate
x_end           defw    5 *  scale / 10         ; Maximum x-coordinate
x_step          defw    4  * scale / 100        ; x-coordinate step-width
y               defw    -1 * scale              ; Minimum y-coordinate
y_end           defw    1  * scale              ; Maximum y-coordinate
y_step          defw    1  * scale / 10         ; y-coordinate step-width
z_0             defw    0
z_1             defw    0
scratch_0       defw    0
z_0_square_high defw    0
z_0_square_low  defw    0
z_1_square_high defw    0
z_1_square_low  defw    0
display         defb    " .-+*=#@"              ; 8 characters for the display

;
;   Compute DEHL = BC * DE (signed): This routine is not too clever but it
; works. It is based on a standard 16-by-16 multiplication routine for unsigned
; integers. At the beginning the sign of the result is determined based on the
; signs of the operands which are negated if necessary. Then the unsigned
; multiplication takes place, followed by negating the result if necessary.
;
mul_16          xor     a                       ; Clear carry and A (-> +)
                bit     7, b                    ; Is BC negative?
                jr      z, bc_positive          ; No
                sub     c                       ; A is still zero, complement
                ld      c, a
                ld      a, 0
                sbc     a, b
                ld      b, a
                scf                             ; Set carry (-> -)
bc_positive     bit     7, D                    ; Is DE negative?
                jr      z, de_positive          ; No
                push    af                      ; Remember carry for later!
                xor     a
                sub     e
                ld      e, a
                ld      a, 0
                sbc     a, d
                ld      d, a
                pop     af                      ; Restore carry for complement
                ccf                             ; Complement Carry (-> +/-?)
de_positive     push    af                      ; Remember state of carry
                and     a                       ; Start multiplication
                sbc     hl, hl
                ld      a, 16                   ; 16 rounds
mul_16_loop     add     hl, hl
                rl      e
                rl      d
                jr      nc, mul_16_exit
                add     hl, bc
                jr      nc, mul_16_exit
                inc     de
mul_16_exit     dec     a
                jr      nz, mul_16_loop
                pop     af                      ; Restore carry from beginning
                ret     nc                      ; No sign inversion necessary
                xor     a                       ; Complement DE HL
                sub     l
                ld      l, a
                ld      a, 0
                sbc     a, h
                ld      h, a
                ld      a, 0
                sbc     a, e
                ld      e, a
                ld      a, 0
                sbc     a, d
                ld      d, a
                ret


fcn mandelbrot{  // lord this is slooooow
   bitmap:=PPM(640,480);
   foreach y,x in ([0..479],[0..639]){
      cx:=(x.toFloat()/640 - 0.5)*4.0;     //range: -2.0 to +2.0
      cy:=((y-240).toFloat()/240.0)*1.5;   //range: -1.5 to +1.5
      cnt:=0; zx:=0.0; zy:=0.0;
      do(1000){
      	 if(zx*zx + zy*zy > 2.0){	//z heads toward infinity
	    //set color of pixel to rate it approaches infinity
	    bitmap[x,y]=cnt.shiftLeft(21) + cnt.shiftLeft(10) + cnt*8;
	    break;
	 }
	 temp:=zx*zy;
	 zx=zx*zx - zy*zy + cx;		//calculate next iteration of z
	 zy=2.0*temp + cy;
	 cnt+=1;
      }
   }
   bitmap.write(File("foo.ppm","wb"));
}();


F ludic(nmax = 100000)
   V r = [1]
   V lst = Array(2..nmax)
   L !lst.empty
      r.append(lst[0])
      [Int] newlst
      V step = lst[0]
      L(i) 0 .< lst.len
         I i % step != 0
            newlst.append(lst[i])
      lst = newlst
   R r

V ludics = ludic()
print(‘First 25 ludic primes:’)
print(ludics[0.<25])
print("\nThere are #. ludic numbers <= 1000".format(sum(ludics.filter(l -> l <= 1000).map(l -> 1))))
print("\n2000'th..2005'th ludic primes:")
print(ludics[2000 - 1 .. 2004])
V n = 250
V triplets = ludics.filter(x -> x + 6 < :n &
                           x + 2 C :ludics &
                           x + 6 C :ludics).map(x -> (x, x + 2, x + 6))
print("\nThere are #. triplets less than #.:\n  #.".format(triplets.len, n, triplets))


*        Ludic numbers             23/04/2016
LUDICN   CSECT
         USING  LUDICN,R15         set base register
         LH     R9,NMAX            r9=nmax
         SRA    R9,1               r9=nmax/2
         LA     R6,2               i=2
LOOPI1   CR     R6,R9              do i=2 to nmax/2
         BH     ELOOPI1
         LA     R1,LUDIC-1(R6)     @ludic(i)
         CLI    0(R1),X'01'        if ludic(i)
         BNE    ELOOPJ1
         SR     R8,R8              n=0
         LA     R7,1(R6)           j=i+1
LOOPJ1   CH     R7,NMAX            do j=i+1 to nmax
         BH     ELOOPJ1
         LA     R1,LUDIC-1(R7)     @ludic(j)
         CLI    0(R1),X'01'        if ludic(j)
         BNE    NOTJ1
         LA     R8,1(R8)           n=n+1
NOTJ1    CR     R8,R6              if n=i
         BNE    NDIFI
         LA     R1,LUDIC-1(R7)     @ludic(j)
         MVI    0(R1),X'00'        ludic(j)=false
         SR     R8,R8              n=0
NDIFI    LA     R7,1(R7)           j=j+1
         B      LOOPJ1
ELOOPJ1  LA     R6,1(R6)           i=i+1
         B      LOOPI1
ELOOPI1  XPRNT  =C'First 25 ludic numbers:',23
         LA     R10,BUF            @buf=0
         SR     R8,R8              n=0
         LA     R6,1               i=1
LOOPI2   CH     R6,NMAX            do i=1 to nmax
         BH     ELOOPI2
         LA     R1,LUDIC-1(R6)     @ludic(i)
         CLI    0(R1),X'01'        if ludic(i)
         BNE    NOTI2
         XDECO  R6,XDEC            i
         MVC    0(4,R10),XDEC+8    output i
         LA     R10,4(R10)         @[email protected]+4
         LA     R8,1(R8)           n=n+1
         LR     R2,R8              n
         SRDA   R2,32
         D      R2,=F'5'           r2=mod(n,5)
         LTR    R2,R2              if mod(n,5)=0
         BNZ    NOTI2
         XPRNT  BUF,20
         LA     R10,BUF            @buf=0
NOTI2    EQU    *
         CH     R8,=H'25'          if n=25
         BE     ELOOPI2
         LA     R6,1(R6)           i=i+1
         B      LOOPI2
ELOOPI2  MVC    BUF(25),=C'Ludic numbers below 1000:'
         SR     R8,R8              n=0
         LA     R6,1               i=1
LOOPI3   CH     R6,=H'999'         do i=1 to 999
         BH     ELOOPI3
         LA     R1,LUDIC-1(R6)     @ludic(i)
         CLI    0(R1),X'01'        if ludic(i)
         BNE    NOTI3
         LA     R8,1(R8)           n=n+1
NOTI3    LA     R6,1(R6)           i=i+1
         B      LOOPI3
ELOOPI3  XDECO  R8,XDEC            edit n
         MVC    BUF+25(6),XDEC+6   output n
         XPRNT  BUF,31             print buffer
         MVC    BUF(80),=CL80'Ludic numbers 2000 to 2005:'
         LA     R10,BUF+28         @buf=28
         SR     R8,R8              n=0
         LA     R6,1               i=1
LOOPI4   CH     R6,NMAX            do i=1 to nmax
         BH     ELOOPI4
         LA     R1,LUDIC-1(R6)     @ludic(i)
         CLI    0(R1),X'01'        if ludic(i)
         BNE    NOTI4
         LA     R8,1(R8)           n=n+1
         CH     R8,=H'2000'        if n>=2000
         BL     NOTI4
         XDECO  R6,XDEC            edit i
         MVC    0(6,R10),XDEC+6    output i
         LA     R10,6(R10)         @[email protected]+6
         CH     R8,=H'2005'        if n=2005
         BE     ELOOPI4
NOTI4    LA     R6,1(R6)           i=i+1
         B      LOOPI4
ELOOPI4  XPRNT  BUF,80             print buffer
         XPRNT  =C'Ludic triplets below 250:',25
         LA     R6,1               i=1
LOOPI5   CH     R6,=H'243'         do i=1 to 243
         BH     ELOOPI5
         LA     R1,LUDIC-1(R6)     @ludic(i)
         CLI    0(R1),X'01'        if ludic(i)
         BNE    ITERI5
         LA     R1,LUDIC+1(R6)     @ludic(i+2)
         CLI    0(R1),X'01'        if ludic(i+2)
         BNE    ITERI5
         LA     R1,LUDIC+5(R6)     @ludic(i+6)
         CLI    0(R1),X'01'        if ludic(i+6)
         BNE    ITERI5
         MVC    BUF+0(1),=C'['     [
         XDECO  R6,XDEC            edit i
         MVC    BUF+1(4),XDEC+8    output i
         LA     R2,2(R6)           i+2
         XDECO  R2,XDEC            edit i+2
         MVC    BUF+5(4),XDEC+8    output i+2
         LA     R2,6(R6)           i+6
         XDECO  R2,XDEC            edit i+6
         MVC    BUF+9(4),XDEC+8    output i+6
         MVC    BUF+13(1),=C']'    ]
         XPRNT  BUF,14             print buffer
ITERI5   LA     R6,1(R6)           i=i+1
         B      LOOPI5
ELOOPI5  XR     R15,R15            set return code
         BR     R14                return to caller
         LTORG
BUF      DS     CL80               buffer
XDEC     DS     CL12               decimal editor
NMAX     DC     H'25000'           nmax
LUDIC    DC     25000X'01'         ludic(nmax)=true
         YREGS
         END    LUDICN


CLASS lcl_ludic DEFINITION CREATE PUBLIC.

  PUBLIC SECTION.
    TYPES: t_ludics TYPE SORTED TABLE OF i WITH UNIQUE KEY table_line.
    TYPES: BEGIN OF t_triplet,
             i1 TYPE i,
             i2 TYPE i,
             i3 TYPE i,
           END OF t_triplet.
    TYPES: t_triplets TYPE STANDARD TABLE OF t_triplet WITH EMPTY KEY.

    CLASS-METHODS:
      ludic_up_to
        IMPORTING i_int           TYPE i
        RETURNING VALUE(r_ludics) TYPE t_ludics,
      get_triplets
        IMPORTING i_ludics          TYPE t_ludics
        RETURNING VALUE(r_triplets) TYPE t_triplets.

    "RETURNING parameters (CallByValue) only used for readability of the demo
    "in "Real Life" you should use EXPORTING (CallByRef) for tables

ENDCLASS.

cl_demo_output=>begin_section( 'First 25 Ludics' ).
cl_demo_output=>write( lcl_ludic=>ludic_up_to( 110 ) ).

cl_demo_output=>begin_section( 'Ludics up to 1000' ).
cl_demo_output=>write( lines( lcl_ludic=>ludic_up_to( 1000 ) ) ).

cl_demo_output=>begin_section( '2000th - 2005th Ludics' ).
DATA(ludics) = lcl_ludic=>ludic_up_to( 22000 ).
cl_demo_output=>write( VALUE lcl_ludic=>t_ludics( FOR i = 2000 WHILE i <= 2005 ( ludics[ i ] ) ) ).

cl_demo_output=>begin_section( 'Triplets up to 250' ).
cl_demo_output=>write( lcl_ludic=>get_triplets( lcl_ludic=>ludic_up_to( 250 ) ) ).

cl_demo_output=>display( ).

CLASS lcl_ludic IMPLEMENTATION.

  METHOD ludic_up_to.

    r_ludics = VALUE #( FOR i = 2 WHILE i <= i_int ( i ) ).

    DATA(cursor) = 0.

    WHILE cursor < lines( r_ludics ).

      cursor = cursor + 1.
      DATA(this_ludic) = r_ludics[ cursor ].
      DATA(remove_cursor) = cursor + this_ludic.

      WHILE remove_cursor <= lines( r_ludics ).
        DELETE r_ludics INDEX remove_cursor.
        remove_cursor = remove_cursor + this_ludic - 1.
      ENDWHILE.

    ENDWHILE.

    INSERT 1 INTO TABLE r_ludics.  "add one as the first Ludic number (per definition)

  ENDMETHOD.

  METHOD get_triplets.

    DATA(i) = 0.
    WHILE i < lines( i_ludics ) - 2.
      i = i + 1.

      DATA(this_ludic) = i_ludics[ i ].
      IF  line_exists( i_ludics[ table_line = this_ludic + 2 ] )
      AND line_exists( i_ludics[ table_line = this_ludic + 6 ] ).
        r_triplets = VALUE #(
           BASE r_triplets
           ( i1 = i_ludics[ table_line = this_ludic ]
             i2 = i_ludics[ table_line = this_ludic + 2 ]
             i3 = i_ludics[ table_line = this_ludic + 6 ]
           )
        ).
      ENDIF.

    ENDWHILE.

  ENDMETHOD.

ENDCLASS.


DEFINE NOTLUDIC="0"
DEFINE LUDIC="1"
DEFINE UNKNOWN="2"

PROC LudicSieve(BYTE ARRAY a INT count)
  INT i,j,k

  SetBlock(a,count,UNKNOWN)
  a(0)=NOTLUDIC
  a(1)=LUDIC

  i=2
  WHILE i<count
  DO
    IF a(i)=UNKNOWN THEN
      a(i)=LUDIC
      j=i k=0
      WHILE j<count
      DO
        IF a(j)=UNKNOWN THEN
          k==+1
          IF k=i THEN
            a(j)=NOTLUDIC
            k=0
          FI
        FI
        j==+1
      OD
    FI
    i==+1
    Poke(77,0) ;turn off the attract mode
  OD
RETURN

PROC PrintLudicNumbers(BYTE ARRAY a INT count,first,last)
  INT i,j

  i=1 j=0
  WHILE i<count AND j<=last
  DO
    IF a(i)=LUDIC THEN
      IF j>=first THEN
        PrintI(i) Put(32)
      FI
      j==+1
    FI
    i==+1
  OD
  PutE() PutE()
RETURN

INT FUNC CountLudicNumbers(BYTE ARRAY a INT max)
  INT i,res

  res=0
  FOR i=1 TO max
  DO
    IF a(i)=LUDIC THEN
      res==+1
    FI
  OD
RETURN (res)

PROC PrintLudicTriplets(BYTE ARRAY a INT max)
  INT i,j

  j=0
  FOR i=0 TO max-6
  DO
    IF a(i)=LUDIC AND a(i+2)=LUDIC AND a(i+6)=LUDIC THEN
      j==+1
      PrintF("%I. %I-%I-%I%E",j,i,i+2,i+6)
    FI
  OD
RETURN

PROC Main()
  DEFINE COUNT="22000"
  BYTE ARRAY lud(COUNT+1)
  INT i,n

  PrintE("Please wait...")
  LudicSieve(lud,COUNT+1)
  Put(125) PutE() ;clear the screen

  PrintE("First 25 ludic numbers:")
  PrintLudicNumbers(lud,COUNT+1,0,24)

  n=CountLudicNumbers(lud,1000)
  PrintF("There are %I ludic numbers <= 1000%E%E",n)

  PrintE("2000'th..2005'th ludic numbers:")
  PrintLudicNumbers(lud,COUNT+1,1999,2004)

  PrintE("Ludic triplets below 250")
  PrintLudicTriplets(lud,249)
RETURN


with Ada.Text_IO;
with Ada.Containers.Vectors;

procedure Ludic_Numbers is

   package Lucid_Lists is
      new Ada.Containers.Vectors (Positive, Natural);
   use Lucid_Lists;

   List : Vector;

   procedure Fill is
      use type Ada.Containers.Count_Type;
      Vec   : Vector;
      Lucid : Natural;
      Index : Positive;
   begin
      Append (List, 1);

      for I in 2 .. 22_000 loop
         Append (Vec, I);
      end loop;

      loop
         Lucid := First_Element (Vec);
         Append (List, Lucid);

         Index := First_Index (Vec);
         loop
            Delete (Vec, Index);
            Index := Index + Lucid - 1;
            exit when Index > Last_Index (Vec);
         end loop;

         exit when Length (Vec) <= 1;
      end loop;

   end Fill;

   procedure Put_Lucid (First, Last : in Natural) is
      use Ada.Text_IO;
   begin
      Put_Line ("Lucid numbers " & First'Image & " to " & Last'Image & ":");
      for I in First .. Last loop
         Put (Natural'(List (I))'Image);
      end loop;
      New_Line;
   end Put_Lucid;

   procedure Count_Lucid (Below : in Natural) is
      Count : Natural := 0;
   begin
      for Lucid of List loop
         if Lucid <= Below then
            Count := Count + 1;
         end if;
      end loop;
      Ada.Text_IO.Put_Line ("There are " & Count'Image & " lucid numbers <=" & Below'Image);
   end Count_Lucid;

   procedure Find_Triplets (Limit : in Natural) is

      function Is_Lucid (Value : in Natural) return Boolean is
      begin
         for X in 1 .. Limit loop
            if List (X) = Value then
               return True;
            end if;
         end loop;
         return False;
      end Is_Lucid;

      use Ada.Text_IO;
      Index : Natural;
      Lucid : Natural;
   begin
      Put_Line ("All triplets of lucid numbers <" & Limit'Image);
      Index := First_Index (List);
      while List (Index) < Limit loop
         Lucid := List (Index);
         if Is_Lucid (Lucid + 2) and Is_Lucid (Lucid + 6) then
            Put ("(");
            Put (Lucid'Image);
            Put (Natural'(Lucid + 2)'Image);
            Put (Natural'(Lucid + 6)'Image);
            Put_Line (")");
         end if;
         Index := Index + 1;
      end loop;
   end Find_Triplets;

begin
   Fill;
   Put_Lucid (First => 1,
              Last  => 25);
   Count_Lucid (Below => 1000);
   Put_Lucid (First => 2000,
              Last  => 2005);
   Find_Triplets (Limit => 250);
end Ludic_Numbers;


# find some Ludic numbers                                #

# sieve the Ludic numbers up to 30 000                   #
INT   max number = 30 000;
[ 1 : max number ]INT candidates;
FOR n TO UPB candidates DO candidates[ n ] := n OD;
FOR n FROM 2 TO UPB candidates OVER 2 DO
    IF candidates[ n ] /= 0 THEN
        # have a ludic number                             #
        INT number count := -1;
        FOR remove pos FROM n TO UPB candidates DO
            IF candidates[ remove pos ] /= 0 THEN
                # have a number we haven't elminated yet  #
                number count +:= 1;
                IF number count = n THEN
                    # this number should be removed       #
                    candidates[ remove pos ] := 0;
                    number count := 0
                FI
            FI
        OD
    FI
OD;
# show some Ludic numbers and counts                      #
print( ( "Ludic numbers: " ) );
INT ludic count :=  0;
FOR n TO UPB candidates DO
    IF candidates[ n ] /= 0 THEN
        # have a ludic number                             #
        ludic count +:= 1;
        IF ludic count < 26 THEN
            # this is one of the first few Ludic numbers  #
            print( ( " ", whole( n, 0 ) ) );
            IF ludic count = 25 THEN
                print( ( " ...", newline ) )
            FI
        FI;
        IF ludic count = 2000 THEN
            print( ( "Ludic numbers 2000-2005: ", whole( n, 0 ) ) )
        ELIF ludic count > 2000 AND ludic count < 2006 THEN
            print( ( " ", whole( n, 0 ) ) );
            IF ludic count = 2005 THEN
                print( ( newline ) )
            FI
        FI
    FI;
    IF n = 1000 THEN
        # count ludic numbers up to 1000                  #
        print( ( "There are ", whole( ludic count, 0 ), " Ludic numbers up to 1000", newline ) )
    FI
OD;
# find the Ludic triplets below 250                        #
print( ( "Ludic triplets below 250:", newline ) );
FOR n TO 250 - 6 DO
    IF candidates[ n ] /= 0 AND candidates[ n + 2 ] /= 0 AND candidates[ n + 6 ] /= 0 THEN
        # have a triplet                                   #
        print( ( "    ", whole( n, -3 ), ", ", whole( n + 2, -3 ), ", ", whole( n + 6, -3 ), newline ) )
    FI
OD


-- Generate a list of the ludic numbers up to and including n.
on ludicsTo(n)
    if (n < 1) then return {}
    -- Start with an array of numbers from 2 to n and a ludic collection already containing 1.
    script o
        property array : {}
        property ludics : {1}
    end script
    repeat with i from 2 to n
        set end of o's array to i
    end repeat
    -- Collect ludics and sieve the array until a ludic matches or exceeds the remaining
    -- array length, at which point the array contains just the remaining ludics.
    set thisLudic to 2
    set arrayLength to n - 1
    repeat while (thisLudic < arrayLength)
        set end of o's ludics to thisLudic
        repeat with i from 1 to arrayLength by thisLudic
            set item i of o's array to missing value
        end repeat
        set o's array to o's array's numbers
        set thisLudic to beginning of o's array
        set arrayLength to (count o's array)
    end repeat

    return (o's ludics) & (o's array)
end ludicsTo

on doTask()
    script o
        property ludics : ludicsTo(22000)
    end script

    set output to {}
    set astid to AppleScript's text item delimiters
    set AppleScript's text item delimiters to ", "
    set end of output to "First 25 ludic numbers:"
    set end of output to (items 1 thru 25 of o's ludics) as text
    repeat with i from 1 to (count o's ludics)
        if (item i of o's ludics > 1000) then exit repeat
    end repeat
    set end of output to "There are " & (i - 1) & " ludic numbers ≤ 1000."
    set end of output to "2000th-2005th ludic numbers:"
    set end of output to (items 2000 thru 2005 of o's ludics) as text
    set end of output to "Triplets < 250:"
    set triplets to {}
    repeat with x in o's ludics
        set x to x's contents
        if (x > 243) then exit repeat
        if ((x + 2) is in o's ludics) and ((x + 6) is in o's ludics) then
            set end of triplets to "{" & {x, x + 2, x + 6} & "}"
        end if
    end repeat
    set end of output to triplets as text
    set AppleScript's text item delimiters to linefeed
    set output to output as text
    set AppleScript's text item delimiters to astid

    return output
end doTask

return doTask()


ludicGen: function [nmax][
    result: [1]
    lst: new 2..nmax+1
    i: 0
    worked: false
    while [and? [not? empty? lst] [i < size lst]][
        item: lst\[i]
        result: result ++ item
        del: 0
        worked: false
        while [del < size lst][
            worked: true
            remove 'lst .index del
            del: dec del + item
        ]
        if not? worked -> i: i + 1
    ]
    return result
]

ludics: ludicGen 25000

print "The first 25 ludic numbers:"
print first.n: 25 ludics

leThan1000: select ludics => [& =< 1000]
print ["\nThere are" size leThan1000 "ludic numbers less than/or equal to 1000\n"]

print ["The ludic numbers from 2000th to 2005th are:" slice ludics 1999 2004 "\n"]

print "The triplets of ludic numbers less than 250 are:"
print map select ludics 'x [
    all? @[ x < 250
            contains? ludics x+2
            contains? ludics x+6
    ]
] 't -> @[t, t+2, t+6]


#NoEnv
SetBatchLines, -1
Ludic := LudicSieve(22000)

Loop, 25    ; the first 25 ludic numbers
	Task1 .= Ludic[A_Index] " "

for i, Val in Ludic    ; the number of ludic numbers less than or equal to 1000
	if (Val <= 1000)
		Task2++
	else
		break

Loop, 6    ; the 2000..2005'th ludic numbers
	Task3 .= Ludic[1999 + A_Index] " "

for i, Val in Ludic {    ; all triplets of ludic numbers < 250
	if (Val + 6 > 249)
		break
	if (Ludic[i + 1] = Val + 2 && Ludic[i + 2] = Val + 6 || i = 1)
		Task4 .= "(" Val " " Val + 2 " " Val + 6 ") "
}

MsgBox, % "First 25:`t`t" Task1
	. "`nLudics below 1000:`t" Task2
	. "`nLudic 2000 to 2005:`t" Task3
	. "`nTriples below 250:`t" Task4
return

LudicSieve(Limit) {
	Arr := [], Ludic := []
	Loop, % Limit
		Arr.Insert(A_Index)
	Ludic.Insert(Arr.Remove(1))
	while Arr.MaxIndex() != 1 {
		Ludic.Insert(n := Arr.Remove(1))
		, Removed := 0
		Loop, % Arr.MaxIndex() // n {
			Arr.Remove(A_Index * n - Removed)
			, Removed++
		}
	}
	Ludic.Insert(Arr[1])
	return Ludic
}


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

typedef unsigned uint;
typedef struct { uint i, v; } filt_t;

// ludics with at least so many elements and reach at least such value
uint* ludic(uint min_len, uint min_val, uint *len)
{
	uint cap, i, v, active = 1, nf = 0;
	filt_t *f = calloc(cap = 2, sizeof(*f));
	f[1].i = 4;

	for (v = 1; ; ++v) {
		for (i = 1; i < active && --f[i].i; i++);

		if (i < active)
			f[i].i = f[i].v;
		else if (nf == f[i].i)
			f[i].i = f[i].v, ++active;  // enable one more filter
		else {
			if (nf >= cap)
				f = realloc(f, sizeof(*f) * (cap*=2));
			f[nf] = (filt_t){ v + nf, v };
			if (++nf >= min_len && v >= min_val) break;
		}
	}

	// pack the sequence into a uint[]
	// filt_t struct was used earlier for cache locality in loops
	uint *x = (void*) f;
	for (i = 0; i < nf; i++) x[i] = f[i].v;
	x = realloc(x, sizeof(*x) * nf);

	*len = nf;
	return x;
}

int find(uint *a, uint v)
{
	uint i;
	for (i = 0; a[i] <= v; i++)
		if (v == a[i]) return 1;
	return 0;
}

int main(void)
{
	uint len, i, *x = ludic(2005, 1000, &len);

	printf("First 25:");
	for (i = 0; i < 25; i++) printf(" %u", x[i]);
	putchar('\n');

	for (i = 0; x[i] <= 1000; i++);
	printf("Ludics below 1000: %u\n", i);

	printf("Ludic 2000 to 2005:");
	for (i = 2000; i <= 2005; i++) printf(" %u", x[i - 1]);
	putchar('\n');

	printf("Triples below 250:");
	for (i = 0; x[i] + 6 <= 250; i++)
		if (find(x, x[i] + 2) && find(x, x[i] + 6))
			printf(" (%u %u %u)", x[i], x[i] + 2, x[i] + 6);

	putchar('\n');

	free(x);
	return 0;
}