with javascript_semantics -- (not likely useful)
function canonicalize_cidr(string cidr)
    cidr = substitute(cidr,"."," ") -- (else %d eats 0.0 etc)
    if not find('/',cidr) then cidr &= "/32" end if
    sequence res = scanf(cidr,"%d %d %d %d/%d")
    if length(res)=1 then
        integer {a,b,c,d,m} = res[1]
        if  a>=0 and a<=255
        and b>=0 and b<=255
        and c>=0 and c<=255
        and d>=0 and d<=255
        and m>=1 and m<=32 then
            atom mask = power(2,32-m)-1,
                 addr = bytes_to_int({d,c,b,a})
            addr -= and_bits(addr,mask)
            {d,c,b,a} = int_to_bytes(addr)
            return sprintf("%d.%d.%d.%d/%d",{a,b,c,d,m})
        end if
    end if
    return "???"
end function

constant tests = {"87.70.141.1/22",
                  "36.18.154.103/12",
                  "62.62.197.11/29",
                  "67.137.119.181/4",
                  "161.214.74.21/24",
                  "184.232.176.184/18"}

for i=1 to length(tests) do
    string ti = tests[i]
    printf(1,"%-18s -> %s\n",{ti,canonicalize_cidr(ti)})
end for


#!/usr/bin/env python
# canonicalize a CIDR block specification:
# make sure none of the host bits are set

import sys
from socket import inet_aton, inet_ntoa
from struct import pack, unpack

args = sys.argv[1:]
if len(args) == 0:
    args = sys.stdin.readlines()

for cidr in args:
   # IP in dotted-decimal / bits in network part
   dotted, size_str = cidr.split('/')
   size = int(size_str)

   numeric = unpack('!I', inet_aton(dotted))[0]  # IP as an integer
   binary = f'{numeric:#034b}'                   # then as a padded binary string
   prefix = binary[:size + 2]                    # just the network part
                                                 #   (34 and +2 are to account
                                                 #    for leading '0b')

   canon_binary = prefix + '0' * (32 - size)     # replace host part with all zeroes
   canon_numeric = int(canon_binary, 2)          # convert back to integer
   canon_dotted = inet_ntoa(pack('!I',
                            (canon_numeric)))    # and then to dotted-decimal
   print(f'{canon_dotted}/{size}')               # output result


#!/usr/bin/env raku

# canonicalize a CIDR block: make sure none of the host bits are set
if (!@*ARGS) {
   @*ARGS = $*IN.lines;
}

for @*ARGS -> $cidr {

  # dotted-decimal / bits in network part
  my ($dotted, $size) = $cidr.split('/');

  # get IP as binary string
  my $binary = $dotted.split('.').map(*.fmt("%08b")).join;

  # Replace the host part with all zeroes
  $binary.substr-rw($size) = 0 x (32 - $size);

  # Convert back to dotted-decimal
  my $canon = $binary.comb(8).map(*.join.parse-base(2)).join('.');

  # And output
  say "$canon/$size";
}


/*REXX pgm canonicalizes IPv4 addresses that are in CIDR notation  (dotted─dec/network).*/
parse arg a .                                    /*obtain optional argument from the CL.*/
if a=='' | a==","  then a= '87.70.141.1/22'    , /*Not specified?  Then use the defaults*/
                           '36.18.154.103/12'  ,
                           '62.62.197.11/29'   ,
                           '67.137.119.181/4'  ,
                           '161.214.74.21/24'  ,
                           '184.232.176.184/18'

    do i=1  for words(a);  z= word(a, i)         /*process each IPv4 address in the list*/
    parse var   z    #  '/'  -0  mask            /*get the address nodes & network mask.*/
    #= subword( translate(#, , .)  0 0 0, 1, 4)  /*elide dots from addr, ensure 4 nodes.*/
    $= #                                         /*use original node address (for now). */
    hb= 32 - substr(word(mask .32, 1), 2)        /*obtain the size of the host bits.    */
    $=;                          ##=             /*crop the host bits only if mask ≤ 32.*/
            do k=1  for 4;        _= word(#, k)  /*create a 32-bit (binary) IPv4 address*/
            ##= ##  ||  right(d2b(_), 8, 0)      /*append eight bits of the   "     "   */
            end   /*k*/                          /* [↑] ... and ensure a node is 8 bits.*/
    ##= left(##, 32-hb, 0)                       /*crop bits in host part of IPv4 addr. */
    ##= left(##, 32,    0)                       /*replace cropped bits with binary '0's*/
            do j=8  by 8  for 4                  /* [↓]  parse the four nodes of address*/
            $= $ || . || b2d(substr(##, j-7, 8)) /*reconstitute the decimal nodes.      */
            end   /*j*/                          /* [↑]  and insert a dot between nodes.*/
    say                                          /*introduce a blank line between IPv4's*/
    $= substr($, 2)                              /*elid the leading decimal point in  $ */
    say '   original IPv4 address: '  z          /*display the original  IPv4  address. */
    say '   canonicalized address: '  translate( space($), ., " ")mask  /*canonicalized.*/
    end   /*i*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
b2d: return  x2d( b2x( arg(1) ) )  +  0          /*convert binary  ───►  decimal number.*/
d2b: return  x2b( d2x( arg(1) ) )  +  0          /*   "    decimal ───►   binary    "   */


#!/usr/bin/env ruby

# canonicalize a CIDR block: make sure none of the host bits are set
if ARGV.length == 0 then
    ARGV = $stdin.readlines.map(&:chomp)
end

ARGV.each do |cidr|

  # dotted-decimal / bits in network part
  dotted, size_str = cidr.split('/')
  size = size_str.to_i

  # get IP as binary string
  binary = dotted.split('.').map { |o| "%08b" % o }.join

  # Replace the host part with all zeroes
  binary[size .. -1] = '0' * (32 - size)

  # Convert back to dotted-decimal
  canon = binary.chars.each_slice(8).map { |a| a.join.to_i(2) }.join('.')

  # And output
  puts "#{canon}/#{size}"
end


import "/fmt" for Fmt, Conv
import "/str" for Str

// canonicalize a CIDR block: make sure none of the host bits are set
var canonicalize = Fn.new { |cidr|
    // dotted-decimal / bits in network part
    var split = cidr.split("/")
    var dotted = split[0]
    var size = Num.fromString(split[1])

    // get IP as binary string
    var binary = dotted.split(".").map { |n| Fmt.swrite("$08b", Num.fromString(n)) }.join()

    // replace the host part with all zeros
    binary = binary[0...size] + "0" * (32 - size)

    // convert back to dotted-decimal
    var chunks = Str.chunks(binary, 8)
    var canon = chunks.map { |c| Conv.atoi(c, 2) }.join(".")

    // and return
    return canon + "/" + split[1]
}

var tests = [
    "87.70.141.1/22",
    "36.18.154.103/12",
    "62.62.197.11/29",
    "67.137.119.181/4",
    "161.214.74.21/24",
    "184.232.176.184/18"
]

for (test in tests) {
    Fmt.print("$-18s -> $s", test, canonicalize.call(test))
}


V WIDTH = 81
V HEIGHT = 5

F cantor(start, len, index)
   V seg = len I/ 3
   I seg == 0
      R
   L(it) 0 .< :HEIGHT - index
      V i = index + it
      L(jt) 0 .< seg
         V j = start + seg + jt
         V pos = i * :WIDTH + j
         :lines[pos] = ‘ ’
   cantor(start, seg, index + 1)
   cantor(start + seg * 2, seg, index + 1)

V lines = [‘*’] * (WIDTH * HEIGHT)
cantor(0, WIDTH, 1)

L(i) 0 .< HEIGHT
   V beg = WIDTH * i
   print((lines[beg .< beg + WIDTH]).join(‘’))


PROC FillRect(INT x,y,w,h)
  INT i

  FOR i=y TO y+h-1
  DO
    Plot(x,i)
    DrawTo(x+w-1,i)
  OD
RETURN

PROC DrawCantor(INT x0,y0,h,level)
  INT x,y,i,j,w,w2,h2

  w=1
  FOR i=0 TO level-1
  DO w==*3 OD

  Color=1
  y=y0
  FOR i=0 TO level
  DO
    FillRect(x0,y,w,h)
    y==+h*2
  OD

  Color=0
  w2=1 h2=h*2
  FOR i=0 TO level-1
  DO
    x=w2 y=(level-i)*(h*2)
    WHILE x<w
    DO
      FillRect(x0+x,y0+y,w2,h2)
      x==+w2*2
    OD
    w2==*3
    h2==+h*2
  OD
RETURN

PROC Main()
  BYTE CH=$02FC,COLOR1=$02C5,COLOR2=$02C6

  Graphics(8+16)
  COLOR1=$0C
  COLOR2=$02

  DrawCantor(38,48,8,5)

  DO UNTIL CH#$FF OD
  CH=$FF
RETURN


with Ada.Text_IO;

procedure Cantor_Set is

   subtype Level_Range is Integer range 1 .. 5;
   Image : array (Level_Range) of String (1 .. 81) := (others => (others => ' '));

   procedure Cantor (Level : Natural; Length : Natural; Start : Natural) is
   begin
      if Level in Level_Range then
         Image (Level) (Start .. Start + Length - 1) := (others => '*');
         Cantor (Level + 1, Length / 3, Start);
         Cantor (Level + 1, Length / 3, Start + 2 * Length / 3);
      end if;
   end Cantor;
begin
   Cantor (Level  => Level_Range'First,
           Length => 81,
           Start  => 1);

   for L in Level_Range loop
      Ada.Text_IO.Put_Line (Image (L));
   end loop;
end Cantor_Set;


BEGIN
    # draw a Cantor Set using ASCII                                            #
    INT    lines     = 5; # number of lines for the set                        #
    # we must choose the line width so that the width of each segment is       #
    # divisible by 3 ( except for the final line where the segment width will  #
    # be 1 )                                                                   #
    INT    set width = 3 ^ ( lines - 1 );
    [ set width ]CHAR set;
    # start with a complete line #
    FOR i TO set width DO set[ i ] := "#" OD;
    print( ( set, newline ) );
    # repeatedly modify the line, replacing the middle third of each segment   #
    # with blanks                                                              #
    INT   segment width := set width OVER 3;
    WHILE segment width > 0 DO
        INT   set pos := 1;
        WHILE set pos < ( set width - segment width ) DO
            set pos   +:= segment width;
            FOR char pos FROM set pos TO ( set pos + segment width ) - 1 DO
                set[ char pos ] := " "
            OD;
            set pos +:= segment width
        OD;
        print( ( set, newline ) );
        segment width OVERAB 3
    OD
END


begin
    % draw a Cantor Set using ASCII                                            %
    integer LINES;        % number of lines for the set                        %
    integer setWidth;     % width of each line of the set                      %
    % we must choose the line width so that the width of each segment is       %
    % divisible by 3 ( except for the final line where the segment width will  %
    % be 1 )                                                                   %
    LINES    := 5;
    setWidth := round( 3 ** ( LINES - 1 ) );
    begin % start new block so the array can have computed bounds              %
        logical array set ( 1 :: setWidth );
        integer segmentWidth;
        % start with a complete line %
        for i := 1 until setWidth do set( i ) := true;
        segmentWidth := setWidth;
        for l := 1 until LINES do begin
            % print the latest line, all lines start with a "#"                %
            write( "#" );
            for i := 2 until setWidth do writeon( if set( i ) then "#" else " " );
            % modify the line, replacing the middle third of each segment      %
            % with blanks, unless this was the last line                       %
            if l < LINES then begin
                integer   setPos;
                segmentWidth := segmentWidth div 3;
                setPos := 1;
                while setPos < ( setWidth - segmentWidth ) do begin
                    setPos := setPos + segmentWidth;
                    for charPos := setPos until ( setPos + segmentWidth ) - 1 do set( charPos ) := false;
                    setPos := setPos + segmentWidth
                end while_setPos_in_range ;
            end if_l_lt_LINES
        end for_l
    end
end.


------------------------- CANTOR SET -----------------------

-- cantor :: [String] -> [String]
on cantor(xs)
    script go
        on |λ|(s)
            set m to (length of s) div 3
            set blocks to text 1 thru m of s

            if "█" = text 1 of s then
                {blocks, replicate(m, space), blocks}
            else
                {s}
            end if
        end |λ|
    end script
    concatMap(go, xs)
end cantor

---------------------------- TEST --------------------------
on run
    showCantor(5)
end run

-- showCantor :: Int -> String
on showCantor(n)
    unlines(map(my concat, ¬
        take(n, iterate(cantor, ¬
            {replicate(3 ^ (n - 1), "█")}))))
end showCantor

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

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

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

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

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

-- iterate :: (a -> a) -> a -> Gen [a]
on iterate(f, x)
    script
        property v : missing value
        property g : mReturn(f)'s |λ|
        on |λ|()
            if missing value is v then
                set v to x
            else
                set v to g(v)
            end if
            return v
        end |λ|
    end script
end iterate

-- replicate :: Int -> String -> String
on replicate(n, s)
    set out to ""
    if n < 1 then return out
    set dbl to s

    repeat while (n > 1)
        if (n mod 2) > 0 then set out to out & dbl
        set n to (n div 2)
        set dbl to (dbl & dbl)
    end repeat
    return out & dbl
end replicate

-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set c to class of xs
    if list is c then
        if 0 < n then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    else if string is c then
        if 0 < n then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else if script is c then
        set ys to {}
        repeat with i from 1 to n
            set v to xs's |λ|()
            if missing value is v then
                return ys
            else
                set end of ys to v
            end if
        end repeat
        return ys
    else
        missing value
    end if
end take

-- unlines :: [String] -> String
on unlines(xs)
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, linefeed}
    set str to xs as text
    set my text item delimiters to dlm
    str
end unlines


width: 81
height: 5

lines: array.of: height repeat `*` width

cantor: function [start length idx].export:[lines][
    seg: length / 3
    if seg = 0 -> return null

    loop idx..dec height 'i [
        loop (start + seg).. dec start + 2 * seg 'j
            -> set lines\[i] j ` `
    ]
    cantor start seg idx+1
    cantor start + 2 * seg seg idx+1
]

cantor 0 width 1

loop lines 'line
    -> print join line


# syntax: GAWK -f CANTOR_SET.AWK
# converted from C
BEGIN {
    WIDTH = 81
    HEIGHT = 5
    for (i=0; i<HEIGHT; ++i) {
      for (j=0; j<WIDTH; ++j) {
        lines[i][j] = "*"
      }
    }
    cantor(0,WIDTH,1)
    for (i=0; i<HEIGHT; ++i) {
      for (j=0; j<WIDTH; ++j) {
        printf("%s",lines[i][j])
      }
      printf("\n")
    }
    exit(0)
}
function cantor(start,leng,indx,  i,j,seg) {
    seg = int(leng/3)
    if (seg == 0) { return }
    for (i=indx; i<HEIGHT; ++i) {
      for (j=start+seg; j<start+seg*2; ++j) {
        lines[i][j] = " "
      }
    }
    cantor(start,seg,indx+1)
    cantor(start+seg*2,seg,indx+1)
}


global ancho, alto, intervalo
ancho = 81 : alto = 5
dim intervalo(alto, ancho)

subroutine Cantor()
	for i = 0 to alto - 1
		for j = 0 to ancho - 1
			intervalo[i, j] = "■"
		next j
	next i
end subroutine

subroutine ConjCantor(inicio, longitud, indice)
	segmento = longitud / 3
	if segmento = 0 then return
	for i = indice to alto - 1
		for j = inicio + segmento to inicio + segmento * 2 - 1
			intervalo[i, j] = " "
		next j
	next i
	call ConjCantor(inicio, segmento, indice + 1)
	call ConjCantor(inicio + segmento * 2, segmento, indice + 1)
end subroutine

call Cantor()
call ConjCantor(0, ancho, 1)
for i = 0 to alto - 1
	for j = 0 to ancho - 1
		print intervalo[i, j];
	next j
	print
next i
End


Cantor ← {" •" ⊏˜ >⥊¨(¯1⊸⊏⊢¨¨⊢)1‿0‿1∧⌜⍟(↕𝕩)1}


#include <stdio.h>

#define WIDTH 81
#define HEIGHT 5

char lines[HEIGHT][WIDTH];

void init() {
    int i, j;
    for (i = 0; i < HEIGHT; ++i) {
        for (j = 0; j < WIDTH; ++j) lines[i][j] = '*';
    }
}

void cantor(int start, int len, int index) {
    int i, j, seg = len / 3;
    if (seg == 0) return;
    for (i = index; i < HEIGHT; ++i) {
        for (j = start + seg; j < start + seg * 2; ++j) lines[i][j] = ' ';
    }
    cantor(start, seg, index + 1);
    cantor(start + seg * 2, seg, index + 1);
}

void print() {
    int i, j;
    for (i = 0; i < HEIGHT; ++i) {
        for (j = 0; j < WIDTH; ++j) printf("%c", lines[i][j]);
        printf("\n");
    }
}

int main() {
    init();
    cantor(0, WIDTH, 1);
    print();
    return 0;
}


using System;

namespace CantorSet {
    class Program {
        const int WIDTH = 81;
        const int HEIGHT = 5;
        private static char[,] lines = new char[HEIGHT, WIDTH];

        static Program() {
            for (int i = 0; i < HEIGHT; i++) {
                for (int j = 0; j < WIDTH; j++) {
                    lines[i, j] = '*';
                }
            }
        }

        private static void Cantor(int start, int len, int index) {
            int seg = len / 3;
            if (seg == 0) return;
            for (int i = index; i < HEIGHT; i++) {
                for (int j = start + seg; j < start + seg * 2; j++) {
                    lines[i, j] = ' ';
                }
            }
            Cantor(start, seg, index + 1);
            Cantor(start + seg * 2, seg, index + 1);
        }

        static void Main(string[] args) {
            Cantor(0, WIDTH, 1);
            for (int i = 0; i < HEIGHT; i++) {
                for (int j = 0; j < WIDTH; j++) {
                    Console.Write(lines[i,j]);
                }
                Console.WriteLine();
            }
        }
    }
}


#include <iostream>

const int WIDTH = 81;
const int HEIGHT = 5;

char lines[WIDTH*HEIGHT];

void cantor(int start, int len, int index) {
	int seg = len / 3;
	if (seg == 0) return;
	for (int i = index; i < HEIGHT; i++) {
		for (int j = start + seg; j < start + seg * 2; j++) {
			int pos = i * WIDTH + j;
			lines[pos] = ' ';
		}
	}
	cantor(start,           seg, index + 1);
	cantor(start + 2 * seg, seg, index + 1);
}

int main() {
	// init
	for (int i = 0; i < WIDTH*HEIGHT; i++) {
		lines[i] = '*';
	}

	// calculate
	cantor(0, WIDTH, 1);

	// print
	for (int i = 0; i < HEIGHT*WIDTH; i += WIDTH) {
		printf("%.*s\n", WIDTH, lines + i);
	}

	return 0;
}


cantor = cluster is make
    rep = null
    ac = array[char]
    aac = array[array[char]]

    make = proc (width, height: int, ch: char) returns (string)
        lines: aac := aac$fill_copy(0, height, ac$fill(0, width, ch))
        cantor_step(lines, 0, width, 1)
        s: stream := stream$create_output()
        for line: ac in aac$elements(lines) do
            stream$putl(s, string$ac2s(line))
        end
        return(stream$get_contents(s))
    end make

    cantor_step = proc (lines: aac, start, len, index: int)
        seg: int := len / 3
        if seg = 0 then return end
        for i: int in int$from_to(index, aac$high(lines)) do
            for j: int in int$from_to(start+seg, start+seg*2-1) do
                lines[i][j] := ' '
            end
        end
        cantor_step(lines, start, seg, index+1)
        cantor_step(lines, start+seg*2, seg, index+1)
    end cantor_step
end cantor

start_up = proc ()
    po: stream := stream$primary_output()
    cs: string := cantor$make(81, 5, '*')
    stream$puts(po, cs)
end start_up


       IDENTIFICATION DIVISION.
       PROGRAM-ID. CANTOR.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 SETTINGS.
          03 NUM-LINES     PIC 9 VALUE 5.
          03 FILL-CHAR     PIC X VALUE '#'.
       01 VARIABLES.
          03 CUR-LINE.
             05 CHAR       PIC X OCCURS 81 TIMES.
          03 WIDTH         PIC 99.
          03 CUR-SIZE      PIC 99.
          03 POS           PIC 99.
          03 MAXPOS        PIC 99.
          03 NEXTPOS       PIC 99.
          03 I             PIC 99.

       PROCEDURE DIVISION.
       BEGIN.
           COMPUTE WIDTH = 3 ** (NUM-LINES - 1).
           PERFORM INIT.
           MOVE WIDTH TO CUR-SIZE.
           DISPLAY CUR-LINE.
           PERFORM DO-LINE UNTIL CUR-SIZE IS EQUAL TO 1.
           STOP RUN.

       INIT.
           PERFORM INIT-CHAR VARYING I FROM 1 BY 1
                UNTIL I IS GREATER THAN WIDTH.

       INIT-CHAR.
           MOVE FILL-CHAR TO CHAR(I).

       DO-LINE.
           DIVIDE 3 INTO CUR-SIZE.
           MOVE 1 TO POS.
           SUBTRACT CUR-SIZE FROM WIDTH GIVING MAXPOS.
           PERFORM BLANK-REGIONS UNTIL POS IS GREATER THAN MAXPOS.
           DISPLAY CUR-LINE.

       BLANK-REGIONS.
           ADD CUR-SIZE TO POS.
           PERFORM BLANK-CHAR CUR-SIZE TIMES.

       BLANK-CHAR.
           MOVE SPACE TO CHAR(POS).
           ADD 1 TO POS.


import std.stdio;

enum WIDTH = 81;
enum HEIGHT = 5;

char[WIDTH*HEIGHT] lines;

void cantor(int start, int len, int index) {
    int seg = len / 3;
    if (seg == 0) return;
    for (int i=index; i<HEIGHT; i++) {
        for (int j=start+seg; j<start+seg*2; j++) {
            int pos = i*WIDTH + j;
            lines[pos] = ' ';
        }
    }
    cantor(start, seg, index+1);
    cantor(start+seg*2, seg, index+1);
}

void main() {
    // init
    lines[] = '*';

    // calculate
    cantor(0, WIDTH, 1);

    // print
    for (int i=0; i<HEIGHT; i++) {
        int beg = WIDTH * i;
        writeln(lines[beg..beg+WIDTH]);
    }
}


program Cantor_set;

{$APPTYPE CONSOLE}

const
  WIDTH: Integer = 81;
  HEIGHT: Integer = 5;

var
  Lines: TArray<TArray<Char>>;

procedure Init;
var
  i, j: Integer;
begin
  SetLength(lines, HEIGHT, WIDTH);
  for i := 0 to HEIGHT - 1 do
    for j := 0 to WIDTH - 1 do
      lines[i, j] := '*';
end;

procedure Cantor(start, len, index: Integer);
var
  seg, i, j: Integer;
begin
  seg := len div 3;
  if seg = 0 then
    Exit;
  for i := index to HEIGHT - 1 do
    for j := start + seg to start + seg * 2 - 1 do
      lines[i, j] := ' ';
  Cantor(start, seg, index + 1);
  Cantor(start + seg * 2, seg, index + 1);
end;

var
  i, j: Integer;

begin
  Init;
  Cantor(0, WIDTH, 1);
  for i := 0 to HEIGHT - 1 do
  begin
    for j := 0 to WIDTH - 1 do
      Write(lines[i, j]);
    Writeln;
  end;
  Readln;
end.


CANTOR
=LAMBDA(n,
    APPLYN(n)(
        LAMBDA(grid,
            APPENDROWS(grid)(
                CANTOROW(
                    LASTROW(grid)
                )
            )
        )
    )({0,1})
)

CANTOROW
=LAMBDA(xys,
    LET(
        nCols, COLUMNS(xys),

        IF(2 > nCols,
            xys,
            IF(3 < nCols,
                APPENDCOLS(
                    CANTORSLICES(TAKECOLS(2)(xys))
                )(
                    CANTOROW(DROPCOLS(2)(xys))
                ),
                CANTORSLICES(TAKECOLS(2)(xys))
            )
        )
    )
)

CANTORSLICES
=LAMBDA(ab,
    LET(
        a, INDEX(ab, 1),
        b, INDEX(ab, 2),
        third, (b - a) / 3,

        CHOOSE({1,2,3,4}, a, a + third, b - third, b)
    )
)

SHOWCANTOR
=LAMBDA(grid,
    LET(
        leaves, LASTROW(grid),
        leafWidth, INDEX(leaves, 1, 2) - INDEX(leaves, 1, 1),
        leafCount, 1 / leafWidth,

        SHOWCANTROWS(leafCount)(grid)
    )
)

SHOWCANTROWS
=LAMBDA(leafCount,
    LAMBDA(grid,
        LET(
            xs, FILTERP(
               LAMBDA(x, NOT(ISNA(x)))
            )(
                HEADCOL(grid)
            ),

            runLengths, LAMBDA(x,
                CEILING.MATH(leafCount * x))(
                    SUBTRACT(TAILROW(xs))(INITROW(xs)
                )
            ),

            iCols, SEQUENCE(1, COLUMNS(runLengths)),

            CONCAT(
                REPT(
                    IF(ISEVEN(iCols), " ", "█"),
                    runLengths
                )
            ) & IF(1 < ROWS(grid),
                CHAR(10) & SHOWCANTROWS(leafCount)(
                    TAILCOL(grid)
                ),
                ""
            )
        )
    )
)


USING: grouping.extras io kernel math sequences
sequences.repeating ;
IN: rosetta-code.cantor-set

CONSTANT: width 81
CONSTANT: depth 5

: cantor ( n -- seq )
    dup 0 = [ drop { 0 1 } ]
    [ 1 - cantor [ 3 / ] map dup [ 2/3 + ] map append ] if ;

! Produces a sequence of lengths from a Cantor set, depending on
! width. Even indices are solid; odd indices are blank.
! e.g. 2 cantor gaps -> { 9 9 9 27 9 9 9 }
!
: gaps ( seq -- seq )
    [ width * ] map [ - abs ] 2clump-map ;

: print-cantor ( n -- )
    cantor gaps [ even? "#" " " ? swap repeat ] map-index
    concat print ;

depth <iota> [ print-cantor ] each


warnings off

4  \ iterations
: **        1 swap  0 ?DO over * LOOP  nip ;
3 swap **  constant width  \ Make smallest step 1

create string  here width char # fill  width allot
: print     string width type cr ;

\  Overwrite string with new holes of size 'length'.
\  Pointer into string at TOS.
create length  width ,
: reduce    length dup @ 3 / swap ! ;
: done?     dup string - width >= ;
: hole?     dup [email protected] bl = ;
: skip      length @ + ;
: whipe     dup length @ bl fill  skip ;
: step      hole? IF skip skip skip ELSE skip whipe skip THEN ;
: split     reduce string BEGIN step done? UNTIL drop ;

\  Main
: done?     length @ 1 <= ;
: step      split print ;
: go        print BEGIN step done? UNTIL ;

go bye


Const ancho = 81
Const alto = 5
Dim Shared intervalo(alto, ancho) As String
Dim As Integer i, j

Sub Cantor()
    Dim As Integer i, j
    For i = 0 To alto - 1
        For j = 0 To ancho - 1
            intervalo(i, j) = Chr(254)
        Next j
    Next i
End Sub

Sub ConjCantor(inicio As Integer, longitud As Integer, indice As Integer)
    Dim As Integer i, j
    Dim segmento As Integer = longitud / 3
    If segmento = 0 Then Return
    For i = indice To alto - 1
        For j = inicio + segmento To inicio + segmento * 2 - 1
            intervalo(i, j) = Chr(32)
        Next j
    Next i
    ConjCantor(inicio, segmento, indice + 1)
    ConjCantor(inicio + segmento * 2, segmento, indice + 1)
End Sub

Cantor()
ConjCantor(0, ancho, 1)
For i = 0 To alto - 1
    For j = 0 To ancho - 1
        Print intervalo(i, j);
    Next j
    Print
Next i
End


package main

import "fmt"

const (
    width = 81
    height = 5
)

var lines [height][width]byte

func init() {
    for i := 0; i < height; i++ {
        for j := 0; j < width; j++ {
            lines[i][j] = '*'
        }
    }
}

func cantor(start, len, index int) {
    seg := len / 3
    if seg == 0 {
        return
    }
    for i := index; i < height; i++ {
        for j := start + seg; j < start + 2 * seg; j++ {
            lines[i][j] = ' '
        }
    }
    cantor(start, seg, index + 1)
    cantor(start + seg * 2, seg, index + 1)
}

func main() {
    cantor(0, width, 1)
    for _, line := range lines {
        fmt.Println(string(line[:]))
    }
}


class App {
    private static final int WIDTH = 81
    private static final int HEIGHT = 5

    private static char[][] lines
    static {
        lines = new char[HEIGHT][WIDTH]
        for (int i = 0; i < HEIGHT; i++) {
            for (int j = 0; j < WIDTH; j++) {
                lines[i][j] = '*'
            }
        }
    }

    private static void cantor(int start, int len, int index) {
        int seg = (int) (len / 3)
        if (seg == 0) return
        for (int i = index; i < HEIGHT; i++) {
            for (int j = start + seg; j < start + seg * 2; j++) {
                lines[i][j] = ' '
            }
        }
        cantor(start, seg, index + 1)
        cantor(start + seg * 2, seg, index + 1)
    }

    static void main(String[] args) {
        cantor(0, WIDTH, 1)
        for (int i = 0; i < HEIGHT; i++) {
            for (int j = 0; j < WIDTH; j++) {
                System.out.print(lines[i][j])
            }
            System.out.println()
        }
    }
}


F mod_(n, m)
   R ((n % m) + m) % m

F is_prime(n)
   I n C (2, 3)
      R 1B
   E I n < 2 | n % 2 == 0 | n % 3 == 0
      R 0B
   V div = 5
   V inc = 2
   L div ^ 2 <= n
      I n % div == 0
         R 0B
      div += inc
      inc = 6 - inc
   R 1B

L(p) 2 .< 62
   I !is_prime(p)
      L.continue
   L(h3) 2 .< p
      V g = h3 + p
      L(d) 1 .< g
         I (g * (p - 1)) % d != 0 | mod_(-p * p, h3) != d % h3
            L.continue;
         V q = 1 + (p - 1) * g I/ d;
         I !is_prime(q)
            L.continue
         V r = 1 + (p * q I/ h3)
         I !is_prime(r) | (q * r) % (p - 1) != 1
            L.continue
         print(p‘ x ’q‘ x ’r)


-------------------------- CANTOR ------------------------

cantor :: [(Bool, Int)] -> [(Bool, Int)]
cantor = concatMap go
  where
    go (bln, n)
      | bln && 1 < n =
          let m = quot n 3
           in [(True, m), (False, m), (True, m)]
      | otherwise = [(bln, n)]

--------------------------- TEST -------------------------
main :: IO ()
main = putStrLn $ cantorLines 5

------------------------- DISPLAY ------------------------
cantorLines :: Int -> String
cantorLines n =
  unlines $
    showCantor
      <$> take n (iterate cantor [(True, 3 ^ pred n)])

showCantor :: [(Bool, Int)] -> String
showCantor = concatMap $ uncurry (flip replicate . c)
  where
    c True = '*'
    c False = ' '


100 PROGRAM "Cantor.bas"
110 GRAPHICS HIRES 2
120 SET PALETTE BLACK,WHITE
130 CALL CANTOR(28,500,1216,32)
140 DEF CANTOR(X,Y,L,HEIGHT)
150   IF L>3 THEN
160     PLOT X,Y;X+L,Y,X,Y+4;X+L,Y+4
170     CALL CANTOR(X,Y-HEIGHT,L/3,HEIGHT)
180     CALL CANTOR(X+2*L/3,Y-HEIGHT,L/3,HEIGHT)
190   END IF
200 END DEF


with Ada.Text_IO, Miller_Rabin;

procedure Nemesis is

   type Number is range 0 .. 2**40-1; -- sufficiently large for the task

   function Is_Prime(N: Number) return Boolean is
      package MR is new Miller_Rabin(Number); use MR;
   begin
      return MR.Is_Prime(N) = Probably_Prime;
   end Is_Prime;

begin
   for P1 in Number(2) .. 61 loop
      if Is_Prime(P1) then
         for H3 in Number(1) .. P1 loop
            declare
               G: Number := H3 + P1;
               P2, P3: Number;
            begin
               Inner:
               for D in 1 .. G-1 loop
                  if ((H3+P1) * (P1-1)) mod D = 0 and then
                    (-(P1 * P1)) mod H3 = D mod H3
                  then
                     P2 := 1 + ((P1-1) * G / D);
                     P3 := 1 +(P1*P2/H3);
                     if Is_Prime(P2) and then Is_Prime(P3)
                       and then (P2*P3) mod (P1-1) = 1
                     then
                       Ada.Text_IO.Put_Line
                        ( Number'Image(P1) & " *"   & Number'Image(P2) & " *" &
                          Number'Image(P3) & "  = " & Number'Image(P1*P2*P3) );
                     end if;
                  end if;
               end loop Inner;
            end;
         end loop;
      end if;
   end loop;
end Nemesis;


# sieve of Eratosthene: sets s[i] to TRUE if i is prime, FALSE otherwise #
PROC sieve = ( REF[]BOOL s )VOID:
     BEGIN
        # start with everything flagged as prime                             #
        FOR i TO UPB s DO s[ i ] := TRUE OD;
        # sieve out the non-primes                                           #
        s[ 1 ] := FALSE;
        FOR i FROM 2 TO ENTIER sqrt( UPB s ) DO
            IF s[ i ] THEN FOR p FROM i * i BY i TO UPB s DO s[ p ] := FALSE OD FI
        OD
     END # sieve # ;

# construct a sieve of primes up to the maximum number required for the task #
# For Prime1, we need to check numbers up to around 120 000                  #
INT max number = 200 000;
[ 1 : max number ]BOOL is prime;
sieve( is prime );

# Find the Carmichael 3 Stromg Pseudoprimes for Prime1 up to 61              #

FOR prime1 FROM 2 TO 61 DO
    IF is prime[ prime 1 ] THEN
        FOR h3 TO prime1 - 1 DO
            FOR d TO ( h3 + prime1 ) - 1 DO
                IF   ( h3 + prime1 ) * ( prime1 - 1 ) MOD d = 0
                AND ( - ( prime1 * prime1 ) ) MOD h3 = d MOD h3
                THEN
                    INT prime2 = 1 + ( ( prime1 - 1 ) * ( h3 + prime1 ) OVER d );
                    IF is prime[ prime2 ] THEN
                        INT prime3 = 1 + ( prime1 * prime2 OVER h3 );
                        IF is prime[ prime3 ] THEN
                            IF ( prime2 * prime3 ) MOD ( prime1 - 1 ) = 1 THEN
                                print( ( whole( prime1, 0 ), " ", whole( prime2, 0 ), " ", whole( prime3, 0 ), newline ) )
                            FI
                        FI
                    FI
                FI
            OD
        OD
    FI
OD


public class App {
    private static final int WIDTH = 81;
    private static final int HEIGHT = 5;

    private static char[][] lines;
    static {
        lines = new char[HEIGHT][WIDTH];
        for (int i = 0; i < HEIGHT; i++) {
            for (int j = 0; j < WIDTH; j++) {
                lines[i][j] = '*';
            }
        }
    }

    private static void cantor(int start, int len, int index) {
        int seg = len / 3;
        if (seg == 0) return;
        for (int i = index; i < HEIGHT; i++) {
            for (int j = start + seg; j < start + seg * 2; j++) {
                lines[i][j] = ' ';
            }
        }
        cantor(start, seg, index + 1);
        cantor(start + seg * 2, seg, index + 1);
    }

    public static void main(String[] args) {
        cantor(0, WIDTH, 1);
        for (int i = 0; i < HEIGHT; i++) {
            for (int j = 0; j < WIDTH; j++) {
                System.out.print(lines[i][j]);
            }
            System.out.println();
        }
    }
}


# syntax: GAWK -f CARMICHAEL_3_STRONG_PSEUDOPRIMES.AWK
# converted from C
BEGIN {
    printf("%5s%8s%8s%13s\n","P1","P2","P3","PRODUCT")
    for (p1=2; p1<62; p1++) {
      if (!is_prime(p1)) { continue }
      for (h3=1; h3<p1; h3++) {
        for (d=1; d<h3+p1; d++) {
          if ((h3+p1)*(p1-1)%d == 0 && mod(-p1*p1,h3) == d%h3) {
            p2 = int(1+((p1-1)*(h3+p1)/d))
            if (!is_prime(p2)) { continue }
            p3 = int(1+(p1*p2/h3))
            if (!is_prime(p3) || (p2*p3)%(p1-1) != 1) { continue }
            printf("%5d x %5d x %5d = %10d\n",p1,p2,p3,p1*p2*p3)
            count++
          }
        }
      }
    }
    printf("%d numbers\n",count)
    exit(0)
}
function is_prime(n,  i) {
    if (n <= 3) {
      return(n > 1)
    }
    else if (!(n%2) || !(n%3)) {
      return(0)
    }
    else {
      for (i=5; i*i<=n; i+=6) {
        if (!(n%i) || !(n%(i+2))) {
          return(0)
        }
      }
      return(1)
    }
}
function mod(n,m) {
# the % operator actually calculates the remainder of a / b so we need a small adjustment so it works as expected for negative values
    return(((n%m)+m)%m)
}


(() => {
    "use strict";

    // -------------- CANTOR BOOL-INT PAIRS --------------

    // cantor :: [(Bool, Int)] -> [(Bool, Int)]
    const cantor = xs => {
        const go = ([bln, n]) =>
            bln && 1 < n ? (() => {
                const x = Math.floor(n / 3);

                return [
                    [true, x],
                    [false, x],
                    [true, x]
                ];
            })() : [
                [bln, n]
            ];

        return xs.flatMap(go);
    };

    // ---------------------- TEST -----------------------
    // main :: IO ()
    const main = () =>
        cantorLines(5);

    // --------------------- DISPLAY ---------------------

    // cantorLines :: Int -> String
    const cantorLines = n =>
        take(n)(
            iterate(cantor)([
                [true, 3 ** (n - 1)]
            ])
        )
        .map(showCantor)
        .join("\n");

    // showCantor :: [(Bool, Int)] -> String
    const showCantor = xs =>
        xs.map(
            ([bln, n]) => (
                bln ? (
                    "*"
                ) : " "
            ).repeat(n)
        )
        .join("");

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

    // iterate :: (a -> a) -> a -> Gen [a]
    const iterate = f =>
        // An infinite list of repeated
        // applications of f to x.
        function* (x) {
            let v = x;

            while (true) {
                yield v;
                v = f(v);
            }
        };

    // take :: Int -> [a] -> [a]
    // take :: Int -> String -> String
    const take = n =>
        // The first n elements of a list,
        // string of characters, or stream.
        xs => "GeneratorFunction" !== xs
        .constructor.constructor.name ? (
            xs.slice(0, n)
        ) : [].concat(...Array.from({
            length: n
        }, () => {
            const x = xs.next();

            return x.done ? [] : [x.value];
        }));

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


F cart_prod(a, b)
   V p = [(0, 0)] * (a.len * b.len)
   V i = 0
   L(aa) a
      L(bb) b
         p[i++] = (aa, bb)
   R p

print(cart_prod([1, 2], [3, 4]))
print(cart_prod([3, 4], [1, 2]))
[Int] empty_array
print(cart_prod([1, 2], empty_array))
print(cart_prod(empty_array, [1, 2]))


for i = 3 to max_sieve step 2
	isprime[i] = 1
next i

isprime[2] = 1
for i = 3 to sqr(max_sieve) step 2
	if isprime[i] = 1 then
		for j = i * i to max_sieve step i * 2
			isprime[j] = 0
		next j
	end if
next i

subroutine carmichael3(p1)
	if isprime[p1] <> 0 then
		for h3 = 1 to p1 -1
			t1 = (h3 + p1) * (p1 -1)
			t2 = (-p1 * p1) % h3
			if t2 < 0 then t2 = t2 + h3
			for d = 1 to h3 + p1 -1
				if t1 % d = 0 and t2 = (d % h3) then
					p2 = 1 + (t1 \ d)
					if isprime[p2] = 0 then continue for
					p3 = 1 + (p1 * p2 \ h3)
					if isprime[p3] = 0 or ((p2 * p3) % (p1 -1)) <> 1 then continue for
					print p1; " * "; p2; " * "; p3
				end if
			next d
		next h3
	end if
end subroutine

for i = 2 to 61
	call carmichael3(i)
next i
end


#include <stdio.h>

/* C's % operator actually calculates the remainder of a / b so we need a
 * small adjustment so it works as expected for negative values */
#define mod(n,m) ((((n) % (m)) + (m)) % (m))

int is_prime(unsigned int n)
{
    if (n <= 3) {
        return n > 1;
    }
    else if (!(n % 2) || !(n % 3)) {
        return 0;
    }
    else {
        unsigned int i;
        for (i = 5; i*i <= n; i += 6)
            if (!(n % i) || !(n % (i + 2)))
                return 0;
        return 1;
    }
}

void carmichael3(int p1)
{
    if (!is_prime(p1)) return;

    int h3, d, p2, p3;
    for (h3 = 1; h3 < p1; ++h3) {
        for (d = 1; d < h3 + p1; ++d) {
            if ((h3 + p1)*(p1 - 1) % d == 0 && mod(-p1 * p1, h3) == d % h3) {
                p2 = 1 + ((p1 - 1) * (h3 + p1)/d);
                if (!is_prime(p2)) continue;
                p3 = 1 + (p1 * p2 / h3);
                if (!is_prime(p3) || (p2 * p3) % (p1 - 1) != 1) continue;
                printf("%d %d %d\n", p1, p2, p3);
            }
        }
    }
}

int main(void)
{
    int p1;
    for (p1 = 2; p1 < 62; ++p1)
        carmichael3(p1);
    return 0;
}


# cantor(width; height)
def cantor($w; $h):
  def init: [range(0; $h) | [range(0; $w) | "*"]];

  def cantor($start; $leng; $ix):
    ($leng/3|floor) as $seg
    | if $seg == 0 then .
      else reduce range($ix; $h) as $i (.;
             reduce range($start+$seg; $start + 2*$seg) as $j (.; .[$i][$j] = " "))
      | cantor($start; $seg; $ix+1)
      | cantor($start + 2*$seg; $seg; $ix+1)
    end ;
  init | cantor(0; $w; 1);

def pp: .[] | join("");

cantor($width; $height)
| pp


const width = 81
const height = 5

function cantor!(lines, start, len, idx)
    seg = div(len, 3)
    if seg > 0
        for i in idx+1:height, j in start + seg + 1: start + seg * 2
            lines[i, j] = ' '
        end
        cantor!(lines, start, seg, idx + 1)
        cantor!(lines, start + 2 * seg, seg, idx + 1)
    end
end

lines = fill(UInt8('#'), height, width)
cantor!(lines, 0, width, 1)

for i in 1:height, j in 1:width
    print(Char(lines[i, j]), j == width ? "\n" : "")
end


// Version 1.2.31

const val WIDTH = 81
const val HEIGHT = 5

val lines = List(HEIGHT) { CharArray(WIDTH) { '*' } }

fun cantor(start: Int, len: Int, index: Int) {
    val seg = len / 3
    if (seg == 0) return
    for (i in index until HEIGHT) {
        for (j in start + seg until start + seg * 2) lines[i][j] = ' '
    }
    cantor(start, seg, index + 1)
    cantor(start + seg * 2, seg, index + 1)
}

fun main(args: Array<String>) {
    cantor(0, WIDTH, 1)
    lines.forEach { println(it) }
}


DEFINE MAX_COUNT="10"
DEFINE MAX_RESULT="100"

DEFINE PTR="CARD"

PROC PrintInput(PTR ARRAY a INT count)
  INT i,j,n
  INT ARRAY tmp

  FOR i=0 TO count-1
  DO
    tmp=a(i) n=tmp(0)
    Put('[)
    FOR j=1 TO n
    DO
      PrintI(tmp(j))
      IF j<n THEN Put(',) FI
    OD
    Put('])
    IF i<count-1 THEN Put('x) FI
  OD
RETURN

PROC PrintOutput(INT ARRAY a INT groups,count)
  INT i,j,k

  Put('[)
  k=0
  FOR i=0 TO groups-1
  DO
    Put('()
    FOR j=0 TO count-1
    DO
      PrintI(a(k)) k==+1
      IF j<count-1 THEN Put(',) FI
    OD
    Put('))
    IF i<groups-1 THEN Put(',) FI
  OD
  Put('])
RETURN

PROC Product(PTR ARRAY a INT count
  INT ARRAY r INT POINTER groups)
  INT ARRAY ind(MAX_COUNT),tmp
  INT i,j,k

  IF count>MAX_COUNT THEN Break() FI
  groups^=1
  FOR i=0 TO count-1
  DO
    ind(i)=1 tmp=a(i)
    groups^==*tmp(0)
  OD
  IF groups^=0 THEN RETURN FI

  j=count-1 k=0
  DO
    FOR i=0 TO count-1
    DO
      tmp=a(i)
      r(k)=tmp(ind(i)) k==+1
    OD

    DO
      tmp=a(j)
      IF ind(j)<tmp(0) THEN
        ind(j)==+1
        FOR i=j+1 TO count-1
        DO
          ind(i)=1
        OD
        j=count-1
        EXIT
      ELSE
        IF j=0 THEN RETURN FI
        j==-1
      FI
    OD
  OD
RETURN

PROC Test(PTR ARRAY a INT count)
  INT ARRAY r(MAX_RESULT)
  INT groups

  IF count<2 THEN Break() FI
  Product(a,count,r,@groups)
  PrintInput(a,count)
  Put('=)
  PrintOutput(r,groups,count)
  PutE()
RETURN

PROC Main()
  INT ARRAY
    a1=[2 1 2],a2=[2 3 4],a3=[0],
    a4=[2 1776 1789],a5=[2 7 12],
    a6=[3 4 14 23],a7=[2 0 1],
    a8=[3 1 2 3],a9=[1 30],a10=[2 500 100]
  PTR ARRAY a(4)

  a(0)=a1 a(1)=a2 Test(a,2)
  a(0)=a2 a(1)=a1 Test(a,2)
  a(0)=a1 a(1)=a3 Test(a,2)
  a(0)=a3 a(1)=a1 Test(a,2) PutE()
  a(0)=a4 a(1)=a5 a(2)=a6 a(3)=a7 Test(a,4) PutE()
  a(0)=a8 a(1)=a9 a(2)=a10 Test(a,3) PutE()
  a(0)=a8 a(1)=a3 a(2)=a10 Test(a,3)
RETURN


with Ada.Text_IO;  use Ada.Text_Io;
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Strings.Fixed;

procedure Cartesian is

   type Element_Type is new Long_Integer;

   package Lists is
      new Ada.Containers.Doubly_Linked_Lists (Element_Type);
   package List_Lists is
      new Ada.Containers.Doubly_Linked_Lists (Lists.List, Lists."=");

   subtype List      is Lists.List;
   subtype List_List is List_Lists.List;

   function "*" (Left, Right : List) return List_List is
      Result : List_List;
      Sub    : List;
   begin
      for Outer of Left loop
         for Inner of Right loop
            Sub.Clear;
            Sub.Append (Outer);
            Sub.Append (Inner);
            Result.Append (Sub);
         end loop;
      end loop;
      return Result;
   end "*";

   function "*" (Left  : List_List;
                 Right : List) return List_List
   is
      Result : List_List;
      Sub    : List;
   begin
      for Outer of Left loop
         for Inner of Right loop
            Sub := Outer;
            Sub.Append (Inner);
            Result.Append (Sub);
         end loop;
      end loop;
      return Result;
   end "*";

   procedure Put (L : List) is
      use Ada.Strings;
      First : Boolean := True;
   begin
      Put ("(");
      for E of L loop
         if not First then
            Put (",");
         end if;
         Put (Fixed.Trim (E'Image, Left));
         First := False;
      end loop;
      Put (")");
   end Put;

   procedure Put (LL : List_List) is
      First : Boolean := True;
   begin
      Put ("{");
      for E of LL loop
         if not First then
            Put (",");
         end if;
         Put (E);
         First := False;
      end loop;
      Put ("}");
   end Put;

   function "&" (Left : List; Right : Element_Type) return List is
      Result : List := Left;
   begin
      Result.Append (Right);
      return Result;
   end "&";

   Nil        : List renames Lists.Empty_List;
   List_1_2   : constant List := Nil & 1 & 2;
   List_3_4   : constant List := Nil & 3 & 4;
   List_Empty : constant List := Nil;
   List_1_2_3 : constant List := Nil & 1 & 2 & 3;
begin
   Put (List_1_2 * List_3_4); New_Line;

   Put (List_3_4 * List_1_2); New_Line;

   Put (List_Empty * List_1_2); New_Line;

   Put (List_1_2 * List_Empty); New_Line;

   Put (List'(Nil & 1776 & 1789) * List'(Nil & 7 & 12) *
          List'(Nil & 4 & 14 & 23) * List'(Nil & 0 & 1)); New_Line;

   Put (List_1_2_3 * List'(Nil & 30) * List'(Nil & 500 & 100)); New_Line;

   Put (List_1_2_3 * List_Empty * List'(Nil & 500 & 100)); New_Line;
end Cartesian;


#include <iomanip>
#include <iostream>

int mod(int n, int d) {
    return (d + n % d) % d;
}

bool is_prime(int n) {
    if (n < 2)
        return false;
    if (n % 2 == 0)
        return n == 2;
    if (n % 3 == 0)
        return n == 3;
    for (int p = 5; p * p <= n; p += 4) {
        if (n % p == 0)
            return false;
        p += 2;
        if (n % p == 0)
            return false;
    }
    return true;
}

void print_carmichael_numbers(int prime1) {
    for (int h3 = 1; h3 < prime1; ++h3) {
        for (int d = 1; d < h3 + prime1; ++d) {
            if (mod((h3 + prime1) * (prime1 - 1), d) != 0
                || mod(-prime1 * prime1, h3) != mod(d, h3))
                continue;
            int prime2 = 1 + (prime1 - 1) * (h3 + prime1)/d;
            if (!is_prime(prime2))
                continue;
            int prime3 = 1 + prime1 * prime2/h3;
            if (!is_prime(prime3))
                continue;
            if (mod(prime2 * prime3, prime1 - 1) != 1)
                continue;
            unsigned int c = prime1 * prime2 * prime3;
            std::cout << std::setw(2) << prime1 << " x "
                << std::setw(4) << prime2 << " x "
                << std::setw(5) << prime3 << " = "
                << std::setw(10) << c << '\n';
        }
    }
}

int main() {
    for (int p = 2; p <= 61; ++p) {
        if (is_prime(p))
            print_carmichael_numbers(p);
    }
    return 0;
}


local WIDTH = 81
local HEIGHT = 5
local lines = {}

function cantor(start, length, index)
    -- must be local, or only one side will get calculated
    local seg = math.floor(length / 3)
    if 0 == seg then
        return nil
    end

    -- remove elements that are not in the set
    for it=0, HEIGHT - index do
        i = index + it
        for jt=0, seg - 1 do
            j = start + seg + jt
            pos = WIDTH * i + j
            lines[pos] = ' '
        end
    end

    -- left side
    cantor(start,           seg, index + 1)
    -- right side
    cantor(start + seg * 2, seg, index + 1)
    return nil
end

-- initialize the lines
for i=0, WIDTH * HEIGHT do
    lines[i] = '*'
end

-- calculate
cantor(0, WIDTH, 1)

-- print the result sets
for i=0, HEIGHT-1 do
    beg = WIDTH * i
    for j=beg, beg+WIDTH-1 do
        if j <= WIDTH * HEIGHT then
            io.write(lines[j])
        end
    end
    print()
end


-- CARTESIAN PRODUCTS ---------------------------------------------------------

-- Two lists:

-- cartProd :: [a] -> [b] -> [(a, b)]
on cartProd(xs, ys)
    script
        on |λ|(x)
            script
                on |λ|(y)
                    [[x, y]]
                end |λ|
            end script
            concatMap(result, ys)
        end |λ|
    end script
    concatMap(result, xs)
end cartProd

-- N-ary – a function over a list of lists:

-- cartProdNary :: [[a]] -> [[a]]
on cartProdNary(xss)
    script
        on |λ|(accs, xs)
            script
                on |λ|(x)
                    script
                        on |λ|(a)
                            {x & a}
                        end |λ|
                    end script
                    concatMap(result, accs)
                end |λ|
            end script
            concatMap(result, xs)
        end |λ|
    end script
    foldr(result, {{}}, xss)
end cartProdNary

-- TESTS ----------------------------------------------------------------------
on run
    set baseExamples to unlines(map(show, ¬
        [cartProd({1, 2}, {3, 4}), ¬
            cartProd({3, 4}, {1, 2}), ¬
            cartProd({1, 2}, {}), ¬
            cartProd({}, {1, 2})]))

    set naryA to unlines(map(show, ¬
        cartProdNary([{1776, 1789}, {7, 12}, {4, 14, 23}, {0, 1}])))

    set naryB to show(cartProdNary([{1, 2, 3}, {30}, {500, 100}]))

    set naryC to show(cartProdNary([{1, 2, 3}, {}, {500, 100}]))

    intercalate(linefeed & linefeed, {baseExamples, naryA, naryB, naryC})
end run

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

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

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

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

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

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

-- show :: a -> String
on show(e)
    set c to class of e
    if c = list then
        script serialized
            on |λ|(v)
                show(v)
            end |λ|
        end script

        "[" & intercalate(", ", map(serialized, e)) & "]"
    else if c = record then
        script showField
            on |λ|(kv)
                set {k, ev} to kv
                "\"" & k & "\":" & show(ev)
            end |λ|
        end script

        "{" & intercalate(", ", ¬
            map(showField, zip(allKeys(e), allValues(e)))) & "}"
    else if c = date then
        "\"" & iso8601Z(e) & "\""
    else if c = text then
        "\"" & e & "\""
    else if (c = integer or c = real) then
        e as text
    else if c = class then
        "null"
    else
        try
            e as text
        on error
            ("«" & c as text) & "»"
        end try
    end if
end show

-- unlines :: [String] -> String
on unlines(xs)
    intercalate(linefeed, xs)
end unlines


(ns example
  (:gen-class))

(defn prime? [n]
  " Prime number test (using Java) "
  (.isProbablePrime (biginteger n) 16))

(defn carmichael [p1]
  " Triplets of Carmichael primes, with first element prime p1 "
  (if (prime? p1)
    (into [] (for [h3 (range 2 p1)
          :let [g (+ h3 p1)]
          d (range 1 g)
          :when (and (= (mod (* g (dec p1)) d) 0)
                     (= (mod (- (* p1 p1)) h3) (mod d h3)))
          :let [p2 (inc (quot (* (dec p1) g) d))]
          :when (prime? p2)
          :let [p3 (inc (quot (* p1 p2) h3))]
          :when (prime? p3)
          :when (= (mod (* p2 p3) (dec p1)) 1)]
         [p1 p2 p3]))))

; Generate Result
(def numbers (mapcat carmichael (range 2 62)))
(println (count numbers) "Carmichael numbers found:")
(doseq [t numbers]
  (println (format "%5d x %5d x %5d = %10d" (first t) (second t) (last t) (apply * t))))


enum mod = (in int n, in int m) pure nothrow @nogc=> ((n % m) + m) % m;

bool isPrime(in uint n) pure nothrow @nogc {
  if (n == 2 || n == 3)
    return true;
  else if (n < 2 || n % 2 == 0 || n % 3 == 0)
    return false;
  for (uint div = 5, inc = 2; div ^^ 2 <= n;
     div += inc, inc = 6 - inc)
    if (n % div == 0)
      return false;
  return true;
}

void main() {
  import std.stdio;

  foreach (immutable p; 2 .. 62) {
    if (!p.isPrime) continue;
    foreach (immutable h3; 2 .. p) {
      immutable g = h3 + p;
      foreach (immutable d; 1 .. g) {
        if ((g * (p - 1)) % d != 0 || mod(-p * p, h3) != d % h3)
          continue;
        immutable q = 1 + (p - 1) * g / d;
        if (!q.isPrime) continue;
        immutable r = 1 + (p * q / h3);
        if (!r.isPrime || (q * r) % (p - 1) != 1) continue;
        writeln(p, " x ", q, " x ", r);
      }
    }
  }
}


MODULE Cantor;
FROM Terminal IMPORT Write,WriteLn,ReadChar;

CONST
    WIDTH = 81;
    HEIGHT = 5;
VAR
    lines : ARRAY[0..HEIGHT] OF ARRAY[0..WIDTH] OF CHAR;

PROCEDURE Init;
VAR i,j : CARDINAL;
BEGIN
    FOR i:=0 TO HEIGHT DO
        FOR j:=0 TO WIDTH DO
            lines[i,j] := '*'
        END
    END
END Init;

PROCEDURE Cantor(start,len,index : CARDINAL);
VAR i,j,seg : CARDINAL;
BEGIN
    seg := len DIV 3;
    IF seg=0 THEN RETURN END;
    FOR i:=index TO HEIGHT-1 DO
        j := start+seg;
        FOR j:=start+seg TO start+seg*2-1 DO
            lines[i,j] := ' '
        END
    END;
    Cantor(start, seg, index+1);
    Cantor(start+seg*2, seg, index+1)
END Cantor;

PROCEDURE Print;
VAR i,j : CARDINAL;
BEGIN
    FOR i:=0 TO HEIGHT-1 DO
        FOR j:=0 TO WIDTH-1 DO
            Write(lines[i,j])
        END;
        WriteLn
    END
END Print;

BEGIN
    Init;
    Cantor(0,WIDTH,1);
    Print;

    ReadChar;
END Cantor.


import strutils

const
  Width = 81
  Height = 5

var lines: array[Height, string]
for line in lines.mitems: line = repeat('*', Width)

proc cantor(start, length, index: Natural) =
  let seg = length div 3
  if seg == 0: return
  for i in index..<Height:
    for j in (start + seg)..<(start + seg * 2):
      lines[i][j] = ' '
  cantor(start, seg, index + 1)
  cantor(start + seg * 2, seg, index + 1)

cantor(0, Width, 1)
for line in lines:
  echo line


;; charmichaël numbers up to N-th prime ; 61 is 18-th prime
(define (charms (N 18) local: (h31 0) (Prime2 0) (Prime3 0))
(for* ((Prime1 (primes N))
       (h3 (in-range 1 Prime1))
       (d  (+ h3 Prime1)))
      (set! h31 (+ h3 Prime1))
      #:continue (!zero? (modulo (* h31 (1- Prime1)) d))
      #:continue (!= (modulo d h3) (modulo (- (* Prime1 Prime1)) h3))
      (set! Prime2 (1+ ( * (1- Prime1) (quotient h31 d))))
      #:when (prime? Prime2)
      (set! Prime3 (1+ (quotient (*  Prime1  Prime2)  h3)))
      #:when (prime? Prime3)
      #:when (= 1 (modulo (* Prime2 Prime3) (1- Prime1)))
      (printf " 💥 %12d = %d x %d x %d"  (* Prime1 Prime2 Prime3) Prime1 Prime2 Prime3)))


// Carmichael Number . Nigel Galloway: November 19th., 2017
let fN n = Seq.collect ((fun g->(Seq.map(fun e->(n,1+(n-1)*(n+g)/e,g,e))){1..(n+g-1)})){2..(n-1)}
let fG (P1,P2,h3,d) =
  let mod' n g = (n%g+g)%g
  let fN P3 = if isPrime P3 && (P2*P3)%(P1-1)=1 then Some (P1,P2,P3) else None
  if isPrime P2 && ((h3+P1)*(P1-1))%d=0 && mod' (-P1*P1) h3=d%h3 then fN (1+P1*P2/h3) else None
let carms g = primes|>Seq.takeWhile(fun n->n<=g)|>Seq.collect fN|>Seq.choose fG
carms 61 |> Seq.iter (fun (P1,P2,P3)->printfn "%2d x %4d x %5d = %10d" P1 P2 P3 ((uint64 P3)*(uint64 (P1*P2))))


class CantorSet {
  WIDTH : static : Int;
  HEIGHT : static : Int;
  lines : static : Char[,];

  function : Init() ~ Nil {
    WIDTH := 81;
    HEIGHT := 5;
    lines := Char->New[HEIGHT, WIDTH];

    each(i : HEIGHT) {
      each(j : WIDTH) {
        lines[i,j] := '*';
      };
    };
  }

  function : Cantor(start : Int, len : Int, index : Int) ~ Nil {
    seg : Int := len / 3;

    if(seg = 0) {
      return;
    };

    for(i := index; i < HEIGHT; i += 1;) {
      for(j := start + seg; j < start + seg * 2; j += 1;) {
        lines[i,j] := ' ';
      };
    };

    Cantor(start, seg, index + 1);
    Cantor(start + seg * 2, seg, index + 1);
  }

  function : Main(args : String[]) ~ Nil {
    Init();

    Cantor(0, WIDTH, 1);
    each(i : HEIGHT) {
      each(j : WIDTH) {
        lines[i,j]->Print();
      };
      ""->PrintLine();
    };
  }
}


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

void cartesianProduct(int** sets, int* setLengths, int* currentSet, int numSets, int times){
	int i,j;

	if(times==numSets){
		printf("(");
		for(i=0;i<times;i++){
			printf("%d,",currentSet[i]);
		}
		printf("\b),");
	}
	else{
		for(j=0;j<setLengths[times];j++){
			currentSet[times] = sets[times][j];
			cartesianProduct(sets,setLengths,currentSet,numSets,times+1);
		}
	}
}

void printSets(int** sets, int* setLengths, int numSets){
	int i,j;

	printf("\nNumber of sets : %d",numSets);

	for(i=0;i<numSets+1;i++){
		printf("\nSet %d : ",i+1);
		for(j=0;j<setLengths[i];j++){
			printf(" %d ",sets[i][j]);
		}
	}
}

void processInputString(char* str){
	int **sets, *currentSet, *setLengths, setLength, numSets = 0, i,j,k,l,start,counter=0;
	char *token,*holder,*holderToken;

	for(i=0;str[i]!=00;i++)
		if(str[i]=='x')
			numSets++;

	if(numSets==0){
			printf("\n%s",str);
			return;
	}

	currentSet = (int*)calloc(sizeof(int),numSets + 1);

	setLengths = (int*)calloc(sizeof(int),numSets + 1);

	sets = (int**)malloc((numSets + 1)*sizeof(int*));

	token = strtok(str,"x");

	while(token!=NULL){
		holder = (char*)malloc(strlen(token)*sizeof(char));

		j = 0;

		for(i=0;token[i]!=00;i++){
			if(token[i]>='0' && token[i]<='9')
				holder[j++] = token[i];
			else if(token[i]==',')
				holder[j++] = ' ';
		}
		holder[j] = 00;

		setLength = 0;

		for(i=0;holder[i]!=00;i++)
			if(holder[i]==' ')
				setLength++;

		if(setLength==0 && strlen(holder)==0){
			printf("\n{}");
			return;
		}

		setLengths[counter] = setLength+1;

		sets[counter] = (int*)malloc((1+setLength)*sizeof(int));

		k = 0;

		start = 0;

		for(l=0;holder[l]!=00;l++){
			if(holder[l+1]==' '||holder[l+1]==00){
				holderToken = (char*)malloc((l+1-start)*sizeof(char));
				strncpy(holderToken,holder + start,l+1-start);
				sets[counter][k++] = atoi(holderToken);
				start = l+2;
			}
		}

		counter++;
		token = strtok(NULL,"x");
	}

	printf("\n{");
	cartesianProduct(sets,setLengths,currentSet,numSets + 1,0);
	printf("\b}");

}

int main(int argC,char* argV[])
{
	if(argC!=2)
		printf("Usage : %s <Set product expression enclosed in double quotes>",argV[0]);
	else
		processInputString(argV[1]);

	return 0;
}


USING: formatting kernel locals math math.primes math.ranges
sequences ;
IN: rosetta-code.carmichael

:: carmichael ( p1 -- )
    1 p1 (a,b) [| h3 |
        h3 p1 + [1,b) [| d |
            h3 p1 + p1 1 - * d mod zero?
            p1 neg p1 * h3 rem d h3 mod = and
            [
                p1 1 - h3 p1 + * d /i 1 +  :> p2
                p1 p2 * h3 /i 1 +          :> p3
                p2 p3 [ prime? ] both?
                p2 p3 * p1 1 - mod 1 = and
                [ p1 p2 p3 "%d %d %d\n" printf ] when
            ] when
        ] each
    ] each
;

: carmichael-demo ( -- ) 61 primes-upto [ carmichael ] each ;

MAIN: carmichael-demo


      LOGICAL FUNCTION ISPRIME(N)	!Ad-hoc, since N is not going to be big...
       INTEGER N			!Despite this intimidating allowance of 32 bits...
       INTEGER F			!A possible factor.
        ISPRIME = .FALSE.		!Most numbers aren't prime.
        DO F = 2,SQRT(DFLOAT(N))	!Wince...
          IF (MOD(N,F).EQ.0) RETURN	!Not even avoiding even numbers beyond two.
        END DO				!Nice and brief, though.
        ISPRIME = .TRUE.		!No factor found.
      END FUNCTION ISPRIME		!So, done. Hopefully, not often.

      PROGRAM CHASE
      INTEGER P1,P2,P3	!The three primes to be tested.
      INTEGER H3,D	!Assistants.
      INTEGER MSG	!File unit number.
      MSG = 6		!Standard output.
      WRITE (MSG,1)	!A heading would be good.
    1 FORMAT ("Carmichael numbers that are the product of three primes:"
     & /"    P1  x P2  x P3 =",9X,"C")
      DO P1 = 2,61	!Step through the specified range.
        IF (ISPRIME(P1)) THEN	!Selecting only the primes.
          DO H3 = 2,P1 - 1		!For 1 < H3 < P1.
            DO D = 1,H3 + P1 - 1		!For 0 < D < H3 + P1.
              IF (MOD((H3 + P1)*(P1 - 1),D).EQ.0	!Filter.
     &        .AND. (MOD(H3 + MOD(-P1**2,H3),H3) .EQ. MOD(D,H3))) THEN	!Beware MOD for negative numbers! MOD(-P1**2, may surprise...
                P2 = 1 + (P1 - 1)*(H3 + P1)/D	!Candidate for the second prime.
                IF (ISPRIME(P2)) THEN		!Is it prime?
                  P3 = 1 + P1*P2/H3			!Yes. Candidate for the third prime.
                  IF (ISPRIME(P3)) THEN			!Is it prime?
                    IF (MOD(P2*P3,P1 - 1).EQ.1) THEN		!Yes! Final test.
                      WRITE (MSG,2) P1,P2,P3, INT8(P1)*P2*P3		!Result!
    2                 FORMAT (3I6,I12)
                    END IF
                  END IF
                END IF
              END IF
            END DO
          END DO
        END IF
      END DO
      END


use strict;
use feature 'say';

sub cantor {
    our($height) = @_;
    my $width = 3 ** ($height - 1);

    our @lines = ('#' x $width) x $height;

    sub trim_middle_third {
        my($len, $start, $index) = @_;
        my $seg = int $len / 3
            or return;

        for my $i ( $index .. $height - 1 ) {
          for my $j ( 0 .. $seg - 1 ) {
            substr $lines[$i], $start + $seg + $j, 1, ' ';
          }
        }

        trim_middle_third( $seg, $start + $_, $index + 1 ) for 0, $seg * 2;
    }

    trim_middle_third( $width, 0, 1 );
    @lines;
}

say for cantor(5);


using System;
public class Program
{
    public static void Main()
    {
        int[] empty = new int[0];
        int[] list1 = { 1, 2 };
        int[] list2 = { 3, 4 };
        int[] list3 = { 1776, 1789 };
        int[] list4 = { 7, 12 };
        int[] list5 = { 4, 14, 23 };
        int[] list6 = { 0, 1 };
        int[] list7 = { 1, 2, 3 };
        int[] list8 = { 30 };
        int[] list9 = { 500, 100 };

        foreach (var sequenceList in new [] {
            new [] { list1, list2 },
            new [] { list2, list1 },
            new [] { list1, empty },
            new [] { empty, list1 },
            new [] { list3, list4, list5, list6 },
            new [] { list7, list8, list9 },
            new [] { list7, empty, list9 }
        }) {
            var cart = sequenceList.CartesianProduct()
                .Select(tuple => $"({string.Join(", ", tuple)})");
            Console.WriteLine($"{{{string.Join(", ", cart)}}}");
        }
    }
}

public static class Extensions
{
    public static IEnumerable<IEnumerable<T>> CartesianProduct<T>(this IEnumerable<IEnumerable<T>> sequences) {
        IEnumerable<IEnumerable<T>> emptyProduct = new[] { Enumerable.Empty<T>() };
        return sequences.Aggregate(
            emptyProduct,
            (accumulator, sequence) =>
            from acc in accumulator
            from item in sequence
            select acc.Concat(new [] { item }));
    }
}


' version 17-10-2016
' compile with: fbc -s console

' using a sieve for finding primes

#Define max_sieve 10000000 ' 10^7
ReDim Shared As Byte isprime(max_sieve)

' translated the pseudo code to FreeBASIC
Sub carmichael3(p1 As Integer)

  If isprime(p1) = 0 Then Exit Sub

  Dim As Integer h3, d, p2, p3, t1, t2

  For h3 = 1 To p1 -1
    t1 = (h3 + p1) * (p1 -1)
    t2 = (-p1 * p1) Mod h3
    If t2 < 0 Then t2 = t2 + h3
    For d = 1 To h3 + p1 -1
      If t1 Mod d = 0 And t2 = (d Mod h3) Then
        p2 = 1 + (t1 \ d)
        If isprime(p2) = 0 Then Continue For
        p3 = 1 + (p1 * p2 \ h3)
        If isprime(p3) = 0 Or ((p2 * p3) Mod (p1 -1)) <> 1 Then Continue For
        Print Using "### * #### * #####"; p1; p2; p3
      End If
    Next d
  Next h3
End Sub

' ------=< MAIN >=------

Dim As UInteger i, j

'set up sieve
For i = 3 To max_sieve Step 2
  isprime(i) = 1
Next i

isprime(2) = 1
For i = 3 To Sqr(max_sieve) Step 2
  If isprime(i) = 1 Then
    For j = i * i To max_sieve Step i * 2
      isprime(j) = 0
    Next j
  End If
Next i

For i = 2 To 61
  carmichael3(i)
Next i

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


package main

import "fmt"

// Use this rather than % for negative integers
func mod(n, m int) int {
    return ((n % m) + m) % m
}

func isPrime(n int) bool {
    if n < 2 { return false }
    if n % 2 == 0 { return n == 2 }
    if n % 3 == 0 { return n == 3 }
    d := 5
    for d * d <= n {
        if n % d == 0 { return false }
        d += 2
        if n % d == 0 { return false }
        d += 4
    }
    return true
}

func carmichael(p1 int) {
    for h3 := 2; h3 < p1; h3++ {
        for d := 1; d < h3 + p1; d++ {
            if (h3 + p1) * (p1 - 1) % d == 0 && mod(-p1 * p1, h3) == d % h3 {
                p2 := 1 + (p1 - 1) * (h3 + p1) / d
                if !isPrime(p2) { continue }
                p3 := 1 + p1 * p2 / h3
                if !isPrime(p3) { continue }
                if p2 * p3 % (p1 - 1) != 1 { continue }
                c := p1 * p2 * p3
                fmt.Printf("%2d   %4d   %5d     %d\n", p1, p2, p3, c)
            }
        }
    }
}

func main() {
    fmt.Println("The following are Carmichael munbers for p1 <= 61:\n")
    fmt.Println("p1     p2      p3     product")
    fmt.Println("==     ==      ==     =======")

    for p1 := 2; p1 <= 61; p1++ {
        if isPrime(p1) { carmichael(p1) }
    }
}


integer n = 5,
        w = power(3,n-1),
        len = w
string line = repeat('#',w)&"\n"

while 1 do
    puts(1,line)
    if len=1 then exit end if
    len /= 3
    integer pos = 1
    while pos<(w-len) do
        pos += len
        line[pos..pos+len-1] = ' '
        pos += len
    end while
end while


include ..\Utilitys.pmt

5 >ps
3 tps 1 - power var w
"#" 1 get nip w repeat var line

ps> for
    3 swap 1 - power
    w over / int var step
    true >ps
    for var j
    	tps not if
            step for var k
            	line 32 j 1 - step * k + set var line
            endfor
        endif
        ps> not >ps
    endfor
    cps
    line ?
endfor


WIDTH = 81
HEIGHT = 5

lines=[]
def cantor(start, len, index):
    seg = len / 3
    if seg == 0:
        return None
    for it in xrange(HEIGHT-index):
        i = index + it
        for jt in xrange(seg):
            j = start + seg + jt
            pos = i * WIDTH + j
            lines[pos] = ' '
    cantor(start,           seg, index + 1)
    cantor(start + seg * 2, seg, index + 1)
    return None

lines = ['*'] * (WIDTH*HEIGHT)
cantor(0, WIDTH, 1)

for i in xrange(HEIGHT):
    beg = WIDTH * i
    print ''.join(lines[beg : beg+WIDTH])


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

void print(const std::vector<std::vector<int>>& v) {
  std::cout << "{ ";
  for (const auto& p : v) {
    std::cout << "(";
    for (const auto& e : p) {
      std::cout << e << " ";
    }
    std::cout << ") ";
  }
  std::cout << "}" << std::endl;
}

auto product(const std::vector<std::vector<int>>& lists) {
  std::vector<std::vector<int>> result;
  if (std::find_if(std::begin(lists), std::end(lists),
    [](auto e) -> bool { return e.size() == 0; }) != std::end(lists)) {
    return result;
  }
  for (auto& e : lists[0]) {
    result.push_back({ e });
  }
  for (size_t i = 1; i < lists.size(); ++i) {
    std::vector<std::vector<int>> temp;
    for (auto& e : result) {
      for (auto f : lists[i]) {
        auto e_tmp = e;
        e_tmp.push_back(f);
        temp.push_back(e_tmp);
      }
    }
    result = temp;
  }
  return result;
}

int main() {
  std::vector<std::vector<int>> prods[] = {
    { { 1, 2 }, { 3, 4 } },
    { { 3, 4 }, { 1, 2} },
    { { 1, 2 }, { } },
    { { }, { 1, 2 } },
    { { 1776, 1789 }, { 7, 12 }, { 4, 14, 23 }, { 0, 1 } },
    { { 1, 2, 3 }, { 30 }, { 500, 100 } },
    { { 1, 2, 3 }, { }, { 500, 100 } }
  };
  for (const auto& p : prods) {
    print(product(p));
  }
  std::cin.ignore();
  std::cin.get();
  return 0;
}


#!/usr/bin/runhaskell

import Data.Numbers.Primes
import Control.Monad (guard)

carmichaels = do
  p <- takeWhile (<= 61) primes
  h3 <- [2..(p-1)]
  let g = h3 + p
  d <- [1..(g-1)]
  guard $ (g * (p - 1)) `mod` d == 0 && (-1 * p * p) `mod` h3 == d `mod` h3
  let q = 1 + (((p - 1) * g) `div` d)
  guard $ isPrime q
  let r = 1 + ((p * q) `div` h3)
  guard $ isPrime r && (q * r) `mod` (p - 1) == 1
  return (p, q, r)

main = putStr $ unlines $ map show carmichaels


link "factors"

procedure main(A)
    n := integer(!A) | 61
    every write(carmichael3(!n))
end

procedure carmichael3(p1)
    every (isprime(p1), (h := 1+!(p1-1)), (d := !(h+p1-1))) do
        if (mod(((h+p1)*(p1-1)),d) = 0, mod((-p1*p1),h) = mod(d,h)) then {
            p2 := 1 + (p1-1)*(h+p1)/d
            p3 := 1 + p1*p2/h
            if (isprime(p2), isprime(p3), mod((p2*p3),(p1-1)) = 1) then
                suspend format(p1,p2,p3)
            }
end

procedure mod(n,d)
   return (d+n%d)%d
end

procedure format(p1,p2,p3)
    return left(p1||" * "||p2||" * "||p3,20)||" = "||(p1*p2*p3)
end


_Title "Cantor Set"

Dim Shared As Integer sw, sh, wide, high
sw = 800: sh = 200: wide = 729: high = 7
Dim Shared As Integer a(wide, high)

Screen _NewImage(sw, sh, 8)
Cls , 15: Color 0

Call calc(0, wide, 1)
Call CantorSet

Sleep
System

Sub calc (start As Integer, length As Integer, index As Integer)
    Dim As Integer i, j, newLength
    newLength = length \ 3
    If newLength = 0 Then Exit Sub
    For j = index To high - 1
        For i = start + newLength To start + newLength * 2 - 1
            a(i, j) = 1
        Next
    Next
    Call calc(start, newLength, index + 1)
    Call calc(start + newLength * 2, newLength, index + 1)
End Sub

Sub CantorSet
    Dim As Integer i, j, x, y
    For y = 0 To high - 1
        j = y + 1
        For x = 0 To wide - 1
            i = x + 34
            If a(x, y) = 0 Then Line (i, j * 24 - 5)-(i, j * 24 + 17)
        Next
    Next
End Sub


  [ $ "" swap witheach
      [ nested quackery join ] ] is expand (   $ --> $ )

  [ $ "ABA" ]                    is A      (   $ --> $ )

  [ $ "BBB" ]                    is B      (   $ --> $ )

  [ char A = iff
      [ char q ] else space
    swap of echo$ ]              is draw   ( n c --> $ )

  81 $ "A"
  5 times
    [ dup witheach
        [ dip over draw ]
      cr
      i if
        [ expand
          dip [ 3 / ] ] ]
  2drop


cantorSet <- function() {
  depth <- 6L
  cs <- vector('list', depth)
  cs[[1L]] <- c(0, 1)
  for(k in seq_len(depth)) {
    cs[[k + 1L]] <- unlist(sapply(seq_len(length(cs[[k]]) / 2L), function(j) {
      p <- cs[[k]][2L] / 3
      h <- 2L * (j - 1L)
      c(
        cs[[k]][h + 1L] + c(0, p),
        cs[[k]][h + 2L] - c(p, 0)
      )
    }, simplify = FALSE))
  }
  cs
}

cantorSetGraph <- function() {
  cs <- cantorSet()

  u <- unlist(cs)

  df <- data.frame(
    x_start = u[seq_along(u) %% 2L == 1L],
    x_end   = u[seq_along(u) %% 2L == 0L],
    depth   = unlist(lapply(cs, function(e) {
      l <- length(e)
      n <- 0
      while(l > 1) {
        n <- n + 1L
        l <- l / 2
      }
      rep(n, length(e) / 2)
    }))
  )

  require(ggplot2)
  g <- ggplot(df, aes_string(x = 'x_start', y = 'depth')) +
    geom_segment(aes_string(xend = 'x_end', yend = 'depth', size = 3)) +
    scale_y_continuous(trans = "reverse") +
    theme(
      axis.title = element_blank(),
      axis.line = element_blank(),
      axis.text = element_blank(),
      axis.ticks = element_blank(),
      legend.position = 'none',
      aspect.ratio = 1/5
    )

    list(graph = g, data = df, set = cs)
}


#lang racket/base
;; {trans|Kotlin}}

(define current-width (make-parameter 81))

(define current-height (make-parameter 5))

(define (Cantor_set (w (current-width)) (h (current-height)))
  (define lines (build-list h (λ (_) (make-bytes w (char->integer #\#)))))
  (define (cantor start len index)
    (let* ((seg (quotient len 3))
           (seg-start (+ start seg))
           (seg-end (+ seg-start seg)))
      (unless (zero? seg)
        (for* ((i (in-range index h))
               (j (in-range seg-start seg-end)))
          (bytes-set! (list-ref lines i) j (char->integer #\space)))
        (cantor start seg (add1 index))
        (cantor seg-end seg (add1 index)))))
  (cantor 0 w 1)
  lines)

(module+ main
  (for-each displayln (Cantor_set)))


 (ns clojure.examples.product
	(:gen-class)
	(:require [clojure.pprint :as pp]))

(defn cart [colls]
  "Compute the cartesian product of list of lists"
  (if (empty? colls)
    '(())
    (for [more (cart (rest colls))
          x (first colls)]
      (cons x more))))


(defun cartesian-product (s1 s2)
  "Compute the cartesian product of two sets represented as lists"
  (loop for x in s1
	nconc (loop for y in s2 collect (list x y))))


public class Test {

    static int mod(int n, int m) {
        return ((n % m) + m) % m;
    }

    static boolean isPrime(int n) {
        if (n == 2 || n == 3)
            return true;
        else if (n < 2 || n % 2 == 0 || n % 3 == 0)
            return false;
        for (int div = 5, inc = 2; Math.pow(div, 2) <= n;
                div += inc, inc = 6 - inc)
            if (n % div == 0)
                return false;
        return true;
    }

    public static void main(String[] args) {
        for (int p = 2; p < 62; p++) {
            if (!isPrime(p))
                continue;
            for (int h3 = 2; h3 < p; h3++) {
                int g = h3 + p;
                for (int d = 1; d < g; d++) {
                    if ((g * (p - 1)) % d != 0 || mod(-p * p, h3) != d % h3)
                        continue;
                    int q = 1 + (p - 1) * g / d;
                    if (!isPrime(q))
                        continue;
                    int r = 1 + (p * q / h3);
                    if (!isPrime(r) || (q * r) % (p - 1) != 1)
                        continue;
                    System.out.printf("%d x %d x %d%n", p, q, r);
                }
            }
        }
    }
}


sub cantor ( Int $height ) {
    my $width = 3 ** ($height - 1);

    my @lines = ( "\c[FULL BLOCK]" x $width ) xx $height;

    my sub _trim_middle_third ( $len, $start, $index ) {
        my $seg = $len div 3
            or return;

        for ( $index ..^ $height ) X ( 0 ..^ $seg ) -> ( $i, $j ) {
            @lines[$i].substr-rw( $start + $seg + $j, 1 ) = ' ';
        }

        _trim_middle_third( $seg, $start + $_, $index + 1 ) for 0, $seg * 2;
    }

    _trim_middle_third( $width, 0, 1 );
    return @lines;
}

.say for cantor(5);


/*REXX program displays an ASCII diagram of a Canter Set as a set of (character) lines. */
w= linesize()                                    /*obtain the width of the display term.*/
if w==0  then w= 81                              /*Can't obtain width?  Use the default.*/
                   do lines=0;   _ = 3 ** lines  /*calculate powers of three  (# lines).*/
                   if _>w  then leave            /*Too large?  We passed the max value. */
                   #=_                           /*this value of a width─of─line is OK. */
                   end   /*lines*/               /* [↑]  calculate a useable line width.*/
w= #                                             /*use the (last) useable line width.   */
$= copies('■', #)                                /*populate the display line with blocks*/
                   do j=0  until #==0            /*show Cantor set as a line of chars.  */
                   if j>0  then do k=#+1  by  #+#  to w         /*skip 1st line blanking*/
                                $= overlay( left('', #), $, k)  /*blank parts of a line.*/
                                end   /*j*/
                   say $                         /*display a line of the Cantor Set.    */
                   #= # % 3                      /*the part (thirds) to be blanked out. */
                   end   /*j*/                   /*stick a fork in it,  we're all done. */


def cartesian_product(a, b)
    return a.flat_map { |i| b.map { |j| [i, j] } }
end

def cartesian_product(l)
    if l.size <= 1
        return l
    elsif l.size == 2
        return cartesian_product(l[0], l[1])
    end

    return l[0].flat_map { |i|
        cartesian_product(l[1..]).map { |j|
            [i, j].flatten
        }
    }
end

tests = [ [[1, 2], [3, 4]],
          [[3, 4], [1, 2]],
          [[1, 2], [] of Int32],
          [[] of Int32, [1, 2]],
          [[1, 2, 3], [30], [500, 100]],
          [[1, 2, 3], [] of Int32, [500, 100]],
          [[1776, 1789], [7, 12], [4, 14, 23], [0, 1]] ]

tests.each { |test|
    puts "#{test.join(" x ")} ->"
    puts "    #{cartesian_product(test)}"
    puts ""
}


import std.stdio;

void main() {
    auto a = listProduct([1,2], [3,4]);
    writeln(a);

    auto b = listProduct([3,4], [1,2]);
    writeln(b);

    auto c = listProduct([1,2], []);
    writeln(c);

    auto d = listProduct([], [1,2]);
    writeln(d);
}

auto listProduct(T)(T[] ta, T[] tb) {
    struct Result {
        int i, j;

        bool empty() {
            return i>=ta.length
                || j>=tb.length;
        }

        T[] front() {
            return [ta[i], tb[j]];
        }

        void popFront() {
            if (++j>=tb.length) {
                j=0;
                i++;
            }
        }
    }

    return Result();
}


using Primes

function carmichael(pmax::Integer)
    if pmax ≤ 0 throw(DomainError("pmax must be strictly positive")) end
    car = Vector{typeof(pmax)}(0)
    for p in primes(pmax)
        for h₃ in 2:(p-1)
            m = (p - 1) * (h₃ + p)
            pmh = mod(-p ^ 2, h₃)
            for Δ in 1:(h₃+p-1)
                if m % Δ != 0 || Δ % h₃ != pmh continue end
                q = m ÷ Δ + 1
                if !isprime(q) continue end
                r = (p * q - 1) ÷ h₃ + 1
                if !isprime(r) || mod(q * r, p - 1) == 1 continue end
                append!(car, [p, q, r])
            end
        end
    end
    return reshape(car, 3, length(car) ÷ 3)
end


fun Int.isPrime(): Boolean {
    return when {
        this == 2 -> true
        this <= 1 || this % 2 == 0 -> false
        else -> {
            val max = Math.sqrt(toDouble()).toInt()
            (3..max step 2)
                .filter { this % it == 0 }
                .forEach { return false }
            true
        }
    }
}

fun mod(n: Int, m: Int) = ((n % m) + m) % m

fun main(args: Array<String>) {
    for (p1 in 3..61) {
        if (p1.isPrime()) {
            for (h3 in 2 until p1) {
                val g = h3 + p1
                for (d in 1 until g) {
                    if ((g * (p1 - 1)) % d == 0 && mod(-p1 * p1, h3) == d % h3) {
                        val q = 1 + (p1 - 1) * g / d
                        if (q.isPrime()) {
                            val r = 1 + (p1 * q / h3)
                            if (r.isPrime() && (q * r) % (p1 - 1) == 1) {
                                println("$p1 x $q x $r")
                            }
                        }
                    }
                }
            }
        }
    }
}


local function isprime(n)
  if n < 2 then return false end
  if n % 2 == 0 then return n==2 end
  if n % 3 == 0 then return n==3 end
  local f, limit = 5, math.sqrt(n)
  while (f <= limit) do
    if n % f == 0 then return false end; f=f+2
    if n % f == 0 then return false end; f=f+4
  end
  return true
end

local function carmichael3(p)
  local list = {}
  if not isprime(p) then return list end
  for h = 2, p-1 do
    for d = 1, h+p-1 do
      if ((h + p) * (p - 1)) % d == 0 and (-p * p) % h == (d % h) then
        local q = 1 + math.floor((p - 1) * (h + p) / d)
        if isprime(q) then
          local r = 1 + math.floor(p * q / h)
          if isprime(r) and (q * r) % (p - 1) == 1 then
            list[#list+1] = { p=p, q=q, r=r }
          end
        end
      end
    end
  end
  return list
end

local found = 0
for p = 2, 61 do
  local list = carmichael3(p)
  found = found + #list
  table.sort(list, function(a,b) return (a.p<b.p) or (a.p==b.p and a.q<b.q) or (a.p==b.p and a.q==b.q and a.r<b.r) end)
  for k,v in ipairs(list) do
    print(string.format("%.f × %.f × %.f = %.f", v.p, v.q, v.r, v.p*v.q*v.r))
  end
end
print(found.." found.")


# Project : Cantor set

load "guilib.ring"
paint = null

new qapp
        {
        win1 = new qwidget() {
                  setwindowtitle("")
                  setgeometry(100,100,800,600)
                  label1 = new qlabel(win1) {
                              setgeometry(10,10,800,600)
                              settext("")
                  }
                  new qpushbutton(win1) {
                          setgeometry(150,500,100,30)
                          settext("draw")
                          setclickevent("draw()")
                  }
                  show()
        }
        exec()
        }

func draw
        p1 = new qpicture()
               color = new qcolor() {
               setrgb(0,0,255,255)
        }
        pen = new qpen() {
                 setcolor(color)
                 setwidth(10)
        }
        paint = new qpainter() {
                  begin(p1)
                  setpen(pen)

        cantor(10,20,600)

        endpaint()
        }
        label1 { setpicture(p1) show() }
        return

func cantor(x,y,lens)
        if lens >= 10
           paint.drawline(x,y,x+lens,y)
           y = y + 20
           cantor(x,y,floor(lens/3))
           cantor(x+floor(lens*2/3),y,floor(lens/3))
        ok


lines = 5

(0..lines).each do |exp|
  seg_size = 3**(lines-exp-1)
  chars = (3**exp).times.map{ |n| n.digits(3).any?(1) ? " " : "█"}
  puts chars.map{ |c| c * seg_size }.join
end


use convert_base::Convert;
use std::fmt;

struct CantorSet {
    cells: Vec<Vec<bool>>,
}
fn number_to_vec(n: usize) -> Vec<u32> {
    // for the conversion we need the digits in reverse order
    // i.e the least significant digit in the first element of the vector
    n.to_string()
        .chars()
        .rev()
        .map(|c| c.to_digit(10).unwrap())
        .collect()
}

impl CantorSet {
    fn new(lines: usize) -> CantorSet {
        // Convert from base 10- to base 3
        let mut base = Convert::new(10, 3);
        let mut cells: Vec<Vec<bool>> = vec![];

        for line in 0..lines {
            // calculate how many repeating sequence will be in the given line
            let segment_size = 3_usize.pow((lines - line - 1) as u32);
            let segment: Vec<bool> = (0..3_usize.pow(line as u32))
                .map(|n| {
                    let output = base.convert::<u32, u32>(&number_to_vec(n));
                    // return false in case the base 3 number contains at least one "1"
                    // otherwise return true
                    !output.contains(&1)
                })
                .collect();

            // copy the segment "segment_size" time
            let mut accum: Vec<bool> = Vec::with_capacity(segment.len() * segment_size);
            for c in segment.iter() {
                accum.extend(std::iter::repeat(*c).take(segment_size))
            }

            cells.push(accum);
        }

        CantorSet { cells }
    }
}

impl fmt::Display for CantorSet {
    fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
        for line in self.cells.iter() {
            for c in line {
                write!(f, "{}", if *c { "█" } else { " " })?
            }
            writeln!(f)?;
        }

        Ok(())
    }
}
fn main() {
    let cs = CantorSet::new(5);
    println!("Cantor set:");
    println!("{}", cs);
}


program Cartesian_product_of_two_or_more_lists;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

type
  TList = TArray<Integer>;

  TLists = TArray<TList>;

  TListHelper = record helper for TList
    function ToString: string;
  end;

  TListsHelper = record helper for TLists
    function ToString(BreakLines: boolean = false): string;
  end;

function cartN(arg: TLists): TLists;
var
  b, n: TList;
  argc: Integer;
begin
  argc := length(arg);

  var c := 1;
  for var a in arg do
    c := c * length(a);

  if c = 0 then
    exit;

  SetLength(result, c);
  SetLength(b, c * argc);
  SetLength(n, argc);

  var s := 0;
  for var i := 0 to c - 1 do
  begin
    var e := s + argc;
    var Resi := copy(b, s, e - s);
    Result[i] := Resi;

    s := e;
    for var j := 0 to high(n) do
    begin
      var nj := n[j];
      Resi[j] := arg[j, nj];
    end;

    for var j := high(n) downto 0 do
    begin
      inc(n[j]);
      if n[j] < Length(arg[j]) then
        Break;
      n[j] := 0;
    end;
  end;
end;

{ TListHelper }

function TListHelper.ToString: string;
begin
  Result := '[';
  for var i := 0 to High(self) do
  begin
    Result := Result + self[i].ToString;
    if i < High(self) then
      Result := Result + ' ';
  end;
  Result := Result + ']';
end;

{ TListsHelper }

function TListsHelper.ToString(BreakLines: boolean = false): string;
begin
  Result := '[';
  for var i := 0 to High(self) do
  begin
    Result := Result + self[i].ToString;
    if i < High(self) then
    begin
      if BreakLines then
        Result := Result + #10
      else
        Result := Result + ' ';
    end;
  end;
  Result := Result + ']';
end;

begin
  writeln(#10, cartN([[1, 2], [3, 4]]).ToString);
  writeln(#10, cartN([[3, 4], [1, 2]]).ToString);
  writeln(#10, cartN([[1, 2], []]).ToString);
  writeln(#10, cartN([[], [1, 2]]).ToString);

  writeln(#10, cartN([[1776, 1789], [17, 12], [4, 14, 23], [0, 1]]).ToString(True));

  writeln(#10, cartN([[1, 2, 3], [30], [500, 100]]).ToString);

  writeln(#10, cartN([[1, 2, 3], [], [500, 100]]).ToString);

  {$IFNDEF UNIX} readln; {$ENDIF}
end.


import strformat

func isPrime(n: int64): bool =
  if n == 2 or n == 3:
    return true
  elif n < 2 or n mod 2 == 0 or n mod 3 == 0:
    return false
  var `div` = 5i64
  var `inc` = 2i64
  while `div` * `div` <= n:
    if n mod `div` == 0:
      return false
    `div` += `inc`
    `inc` = 6 - `inc`
  return true

for p in 2i64 .. 61:
  if not isPrime(p):
    continue
  for h3 in 2i64 ..< p:
    var g = h3 + p
    for d in 1 ..< g:
      if g * (p - 1) mod d != 0 or (d + p * p) mod h3 != 0:
        continue
      var q = 1 + (p - 1) * g div d
      if not isPrime(q):
        continue
      var r = 1 + (p * q div h3)
      if not isPrime(r) or (q * r) mod (p - 1) != 1:
        continue
      echo &"{p:5} × {q:5} × {r:5} = {p * q * r:10}"


use ntheory qw/forprimes is_prime vecprod/;

forprimes { my $p = $_;
   for my $h3 (2 .. $p-1) {
      my $ph3 = $p + $h3;
      for my $d (1 .. $ph3-1) {               # Jameseon procedure page 6
         next if ((-$p*$p) % $h3) != ($d % $h3);
         next if (($p-1)*$ph3) % $d;
         my $q = 1 + ($p-1)*$ph3 / $d;        # Jameson eq 7
         next unless is_prime($q);
         my $r = 1 + ($p*$q-1) / $h3;         # Jameson eq 6
         next unless is_prime($r);
         next unless ($q*$r) % ($p-1) == 1;
         printf "%2d x %5d x %5d = %s\n",$p,$q,$r,vecprod($p,$q,$r);
      }
   }
} 3,61;


object CantorSetQD extends App {
  val (width, height) = (81, 5)

  val lines = Seq.fill[Array[Char]](height)(Array.fill[Char](width)('*'))

  def cantor(start: Int, len: Int, index: Int) {
    val seg = len / 3

    println(start, len, index)

    if (seg != 0) {
      for (i <- index until height;
           j <- (start + seg) until (start + seg * 2)) lines(i)(j) = ' '

      cantor(start, seg, index + 1)
      cantor(start + seg * 2, seg, index + 1)
    }
  }

  cantor(0, width, 1)
  lines.foreach(l => println(l.mkString))
}


func cantor (height) {
    var width = 3**(height - 1)
    var lines = height.of { "\N{FULL BLOCK}" * width }

    func trim_middle_third (len, start, index) {
        var seg = (len // 3) || return()

        for i, j in ((index ..^ height) ~X (0 ..^ seg)) {
            lines[i].replace!(Regex("^.{#{start + seg + j}}\\K."), ' ')
        }

        [0, 2*seg].each { |k|
            trim_middle_third(seg, start + k, index + 1)
        }
    }

    trim_middle_third(width, 0, 1)
    return lines
}

cantor(5).each { .say }


//Nigel Galloway February 12th., 2018
let cP2 n g = List.map (fun (n,g)->[n;g]) (List.allPairs n g)


IN: scratchpad { 1 2 } { 3 4 } cartesian-product .
{ { { 1 3 } { 1 4 } } { { 2 3 } { 2 4 } } }
IN: scratchpad { 3 4 } { 1 2 } cartesian-product .
{ { { 3 1 } { 3 2 } } { { 4 1 } { 4 2 } } }
IN: scratchpad { 1 2 } { } cartesian-product .
{ { } { } }
IN: scratchpad { } { 1 2 } cartesian-product .
{ }


with javascript_semantics
integer count = 0
for p1=1 to 61 do
    if is_prime(p1) then
        for h3=1 to p1 do
            atom h3p1 = h3 + p1
            for d=1 to h3p1-1 do
                if mod(h3p1*(p1-1),d)=0
                and mod(-(p1*p1),h3) = mod(d,h3) then
                    atom p2 := 1 + floor(((p1-1)*h3p1)/d),
                         p3 := 1 +floor(p1*p2/h3)
                    if is_prime(p2)
                    and is_prime(p3)
                    and mod(p2*p3,p1-1)=1 then
                        if count<5 or count>65 then
                            printf(1,"%d * %d * %d = %d\n",{p1,p2,p3,p1*p2*p3})
                        elsif count=35 then puts(1,"...\n") end if
                        count += 1
                    end if
                end if
            end for
        end for
    end if
end for
printf(1,"%d Carmichael numbers found\n",count)


Carmichael: procedure options (main, reorder);  /* 24 January 2014 */
   declare (Prime1, Prime2, Prime3, h3, d) fixed binary (31);

   put ('Carmichael numbers are:');

   do Prime1 = 1 to 61;

      do h3 = 2 to Prime1;

d_loop:  do d = 1 to h3+Prime1-1;
            if (mod((h3+Prime1)*(Prime1-1), d) = 0) &
               (mod(-Prime1*Prime1, h3) = mod(d, h3)) then
               do;
                  Prime2 = (Prime1-1) * (h3+Prime1)/d; Prime2 = Prime2 + 1;
                  if ^is_prime(Prime2) then iterate d_loop;
                  Prime3 = Prime1*Prime2/h3; Prime3 = Prime3 + 1;
                  if ^is_prime(Prime3) then iterate d_loop;
                  if mod(Prime2*Prime3, Prime1-1) ^= 1 then iterate d_loop;
                  put skip edit (trim(Prime1), ' x ', trim(Prime2), ' x ', trim(Prime3)) (A);
               end;
         end;
      end;
   end;

   /* Uses is_prime from Rosetta Code PL/I. */

end Carmichael;


Object subclass: CantorSet [

    | intervals |

    CantorSet class >> new
        [^self basicNew
            initialize;
            yourself]

    initialize
        [intervals := Array with: (CantorInterval
            from: 0
            to: 1)]

    split
        [intervals := intervals gather: [:each | each split]]

    displayOn: aStream atScale: aNumber
        [| current |
        current := 0.
        intervals do:
            [:each |
            (each start - current) * aNumber timesRepeat: [aStream space].
            each length * aNumber timesRepeat: [aStream nextPut: $#].
            current := each stop].
        aStream nl]
]

Interval subclass: CantorInterval [

    split
        [| oneThird left right |
        oneThird := self length / 3.
        left := self class
            from: start
            to: start + oneThird.
        right := self class
            from: stop - oneThird
            to: stop.
        ^Array
            with: left
            with: right]

    start  [^start]
    stop   [^stop]
    length [^stop - start]

    printOn: aStream
        [aStream << ('%1[%2,%3]' % {self class name. start. stop})]
]

Object subclass: TestCantor [

    TestCantor class >> iterations: anInteger
        [| cantorset scale count |
        scale := 3 raisedTo: anInteger. "Make smallest interval 1"
        count := 0.
        cantorset := CantorSet new.

        [cantorset
            displayOn: Transcript
            atScale: scale.
        count < anInteger] whileTrue:
            [cantorset split.
            count := count + 1]]
]

TestCantor iterations: 4.


Module Module1

    Const WIDTH = 81
    Const HEIGHT = 5
    Dim lines(HEIGHT, WIDTH) As Char

    Sub Init()
        For i = 0 To HEIGHT - 1
            For j = 0 To WIDTH - 1
                lines(i, j) = "*"
            Next
        Next
    End Sub

    Sub Cantor(start As Integer, len As Integer, index As Integer)
        Dim seg As Integer = len / 3
        If seg = 0 Then
            Return
        End If
        For i = index To HEIGHT - 1
            For j = start + seg To start + seg * 2 - 1
                lines(i, j) = " "
            Next
        Next
        Cantor(start, seg, index + 1)
        Cantor(start + seg * 2, seg, index + 1)
    End Sub

    Sub Main()
        Init()
        Cantor(0, WIDTH, 1)
        For i = 0 To HEIGHT - 1
            For j = 0 To WIDTH - 1
                Console.Write(lines(i, j))
            Next
            Console.WriteLine()
        Next
    End Sub

End Module