queue = .workqueue~new
input = .stream~new("jabberwocky.txt")
output = .output

reader = .filereader~new(input, queue)
writer = .filewriter~new(output, queue)

::class workQueue
::method init
  expose queue stopped actionpending
  queue = .queue~new
  stopped = .false
  actionPending = .false

-- add an item to the work queue.  This is a
-- guarded method, which means this is a synchronized access
::method addItem guarded
  expose queue actionPending
  use arg item
  -- add the item to the queue
  queue~queue(item)
  -- indicate there's something new.  This is a condition variable
  -- that any will wake up any thread that's waiting on access.  They'll
  -- be able to get access once we exit
  actionPending = .true

-- another method for coordinating access with the other thread.  This indicates
-- it is time to shut down
::method stop guarded
  expose actionPending stopped
  -- indicate this has been stopped and also flip the condition variable to
  -- wake up any waiters
  stopped = .true
  actionPending = .true

-- read the next item off of the queue.  .nil indicates we've reached
-- the last item on the queue.  This is also a guarded method, but we'll use
-- the GUARD ON instruction to wait for work if the queue is currently empty
::method nextItem
  expose queue stopped actionPending
  -- we might need to loop a little to get an item
  do forever
    -- if there's something on the queue, pull the front item and return
    if \queue~isEmpty then return queue~pull
    -- if the other thread says it is done sending is stuff, time to shut down
    if stopped then return .nil
    -- nothing on the queue, not stopped yet, so release the guard and wait until
    -- there's something pending to work on.
    guard on when actionPending
  end

-- one half of the synchronization effort.  This will read lines and
-- add them to the work queue.  The thread will terminate once we hit end-of-file
::class filereader
::method init
  -- accept a generic stream...the data source need not be a file
  use arg stream, queue

  reply   -- now multithreaded

  signal on notready
  loop forever
     queue~addItem(stream~linein)
  end
  -- we come here on an EOF condition.  Indicate we're done and terminate
  -- the thread
  notready:
  queue~stop

-- the other end of this.  This class will read lines from a work queue
-- and write it to a stream
::class filewriter
::method init
  -- accept a generic stream...the data source need not be a file
  use arg stream, queue

  reply   -- now multithreaded

  loop forever
     item = queue~nextItem
     -- .nil means last item received
     if item == .nil then return
     -- write to the stream
     stream~lineout(item)
  end


declare
  %% Helper function to read a file lazily.
  %% Returns a lazy list of lines.
  fun {ReadLines FN}
     F = {New class $ from Open.file Open.text end init(name:FN)}
     fun lazy {ReadNext}
        case {F getS($)} of
           false then nil
        [] Line then
           Line|{ReadNext}
        end
     end
  in
     %% close file when handle becomes unreachable
     {Finalize.register F proc {$ F} {F close} end}
     {ReadNext}
  end

  Count %% Will receive the number of lines
  PrinterPort
in
  %% Printer thread
  thread
     Stream
     Counter = {NewCell 0} %% mutable variable
  in
     PrinterPort = {NewPort ?Stream}
     for Line in Stream do
        case Line of eof then
           Count = @Counter
        else
           {System.showInfo Line}
           Counter := @Counter + 1
        end
     end
  end

  %% Send all lines to printer thread; make sure that eof is sent.
  try
     for Line in {ReadLines "input.txt"} do
        {Send PrinterPort Line}
     end
  finally
     {Send PrinterPort eof}
  end

  %% Sync on Count and print its value.
  {Wait Count}
  {Show Count}


use threads;
use Thread::Queue qw();

my $q1 = Thread::Queue->new;
my $q2 = Thread::Queue->new;

my $reader = threads->create(sub {
     my $q1 = shift;
     my $q2 = shift;

     open my $fh, '<', 'input.txt';
     $q1->enqueue($_) while <$fh>;
     close $fh;
     $q1->enqueue(undef);

     print $q2->dequeue;
}, $q1, $q2);

my $printer = threads->create(sub {
     my $q1 = shift;
     my $q2 = shift;

     my $count;
     while (my $line = $q1->dequeue) {
         print $line;
         $count++;
     };

     $q2->enqueue($count);
}, $q1, $q2);

$reader->join;
$printer->join;


-- demo\rosetta\Synchronous_concurrency.exw
without js -- threads, file i/o, command_line()
string filename = substitute(command_line()[2],".exe",".exw")

atom frThread,  -- file reader thread
     lcThread   -- line counter thread

sequence queue = {}
integer qlock = init_cs(),
    linecount = 1

procedure readfile()
    integer fn = open(filename,"r")
    while 1 do
        object line = gets(fn)
        enter_cs(qlock)
        queue = append(queue,line)
        line = atom(line)   -- kill refcount!
        leave_cs(qlock)
        if line then exit end if
    end while
    close(fn)
    wait_thread(lcThread)
    printf(1,"Lines read: %d\n",linecount)
    exit_thread(0)
end procedure

procedure countlines()
    linecount = 0
    while 1 do
        enter_cs(qlock)
        if length(queue)=0 then
            leave_cs(qlock)
--          sleep(0.1)
        else
            object line = queue[1]
            queue = queue[2..$]
            leave_cs(qlock)
            if atom(line) then exit end if
--          ?line
            linecount += 1
        end if
    end while
    exit_thread(0)
end procedure

lcThread = create_thread(countlines,{})
frThread = create_thread(readfile,{})

wait_thread(frThread)
puts(1,"done")

{} = wait_key()


# Reading task (synchronous)
(task (open "input.txt")
   (let Fd @
      (if (in Fd (line T))             # More lines?
         (udp "localhost" 4444 @)      # Yes: Send next line
         (task (port T 4445)           # Else install handler
            (prinl (udp @) " lines")   # to receive and print count
            (task (close @)) )
         (udp "localhost" 4444 T)      # Send 'T' for "Done"
         (task (close Fd)) ) ) )       # Stop the task

# Printing task (asynchronous)
(sigio (setq "Sock" (port T 4444))
   (job '((Cnt . 0))
      (let? X (udp "Sock")
         (if (=T X)                    # Done?
            (prog
               (udp "localhost" 4445 Cnt) # Yes: Send count
               (sigio (close "Sock")) )   # and stop the task
            (println X)                # Else print line to stdout
            (inc 'Cnt) ) ) ) )         # and increment count


use "files"

actor Main
  let _env: Env // The environment contains stdout, so we save it here

  new create(env: Env) =>
    _env = env
    let printer: Printer tag = Printer(env)
    try
      let path = FilePath(env.root as AmbientAuth, "input.txt")? // this may fail, hence the ?
      let file = File.open(path)
      for line in FileLines(file) do
        printer(line) // sugar for "printer.apply(line)"
      end
    end
    printer.done(this)

  be finish(count: USize) =>
    _env.out.print("Printed: " + count.string() + " lines")

actor Printer
  let _env: Env
  var _count: USize = 0
  new create(env: Env) => _env = env

  be apply(line: String) =>
    _count = _count + 1
    _env.out.print(line)

  be done(main: Main tag) => main.finish(_count)


Enumeration
  #Write
  #Done
EndEnumeration

Structure commblock
  txtline.s
  Order.i
EndStructure

Global MessageSent=CreateSemaphore()
Global LineWritten=CreateSemaphore()
Global LinesWritten, com.commblock

Procedure Writer(arg)
  Repeat
    WaitSemaphore(MessageSent)
    If com\Order=#Write
      PrintN(com\txtline)
      LinesWritten+1
    EndIf
    SignalSemaphore(LineWritten)
  Until com\Order=#Done
EndProcedure

Procedure Reader(arg)
  Protected File=ReadFile(#PB_Any,OpenFileRequester("","input.txt","",0))
  While file And Not Eof(file)
    com\txtline=ReadString(File)
    com\Order=#Write
    SignalSemaphore(MessageSent)
    WaitSemaphore(LineWritten)
  Wend
  com\Order=#Done
  SignalSemaphore(MessageSent)
  WaitSemaphore(LineWritten)
  PrintN(Str(LinesWritten)+" lines written.")
EndProcedure

If OpenConsole()
  Define Thread1=CreateThread(@Reader(),0)
  Define Thread2=CreateThread(@Writer(),0)
  WaitThread(Thread1) And WaitThread(Thread2)
  Print("Press Enter to exit"):Input()
EndIf


import sys
from Queue import Queue
from threading import Thread

lines = Queue(1)
count = Queue(1)

def read(file):
    try:
        for line in file:
            lines.put(line)
    finally:
        lines.put(None)
    print count.get()

def write(file):
    n = 0
    while 1:
        line = lines.get()
        if line is None:
            break
        file.write(line)
        n += 1
    count.put(n)

reader = Thread(target=read, args=(open('input.txt'),))
writer = Thread(target=write, args=(sys.stdout,))
reader.start()
writer.start()
reader.join()
writer.join()


(define (reader)
  (for ([line (in-lines (open-input-file "input.txt"))])
    (thread-send printer-thread line))
  (thread-send printer-thread eof)
  (printf "Number of lines: ~a\n" (thread-receive)))

(define (printer)
  (thread-send reader-thread
               (for/sum ([line (in-producer thread-receive eof)])
                 (displayln line)
                 1)))

(define printer-thread (thread printer))
(define reader-thread  (thread reader))

(for-each thread-wait
          (list printer-thread reader-thread))


sub MAIN ($infile) {
    $infile.IO.lines ==> printer() ==> my $count;
    say "printed $count lines";
}

sub printer(*@lines) {
    my $lines;
    for @lines {
	.say;
	++$lines;
    }
    $lines;
}


'input.txt' as src_file

class Queue

    new list  as items
    condition as ready

    define item_put
        items push ready notify

    define item_get
        items empty if ready wait
        items shift

Queue as lines
Queue as count

thread reader
    "file://r:%(src_file)s" open each lines.item_put
    NULL lines.item_put count.item_get "reader: %d\n" print

thread writer
    0 repeat lines.item_get dup while
        "writer: %s" print 1+
    drop count.item_put

reader as r
writer as w


count = 0
IO.foreach("input.txt") { |line| print line; count += 1 }
puts "Printed #{count} lines."


use std::fs::File;
use std::io::BufRead;
use std::io::BufReader;

use std::sync::mpsc::{channel, sync_channel};
use std::thread;

fn main() {
    // The reader sends lines to the writer via an async channel, so the reader is never blocked.
    let (reader_send, writer_recv) = channel();

    // The writer sends the final count via a blocking channel with bound 0,
    // meaning the buffer is exactly the size of the result.
    let (writer_send, reader_recv) = sync_channel(0);

    // Define the work the reader will do.
    let reader_work = move || {
        let file = File::open("input.txt").expect("Failed to open input.txt");
        let reader = BufReader::new(file);

        for line in reader.lines() {
            match line {
                Ok(msg) => reader_send
                    .send(msg)
                    .expect("Failed to send via the channel"),
                Err(e) => println!("{}", e),
            }
        }

        // Dropping the sender disconnects it and tells the receiver the connection is closed.
        drop(reader_send);

        // Now that we've sent all the lines,
        // block until the writer gives us the final count.
        let count = reader_recv
            .recv()
            .expect("Failed to receive count from printer.");

        println!("{}", count);
    };

    // Define the work the writer will do.
    let writer_work = move || {
        let mut line_count = 0;

        loop {
            match writer_recv.recv() {
                Ok(msg) => {
                    println!("{}", msg);
                    line_count += 1;
                }
                Err(_) => break, // indicates the connection has been closed by the sender.
            }
        }

        // Send the final count back to the reader.
        writer_send
            .send(line_count)
            .expect("Failed to send line count from writer.");

        drop(writer_send);
    };

    // Spawn each as a thread.
    let reader_handle = thread::spawn(reader_work);
    thread::spawn(writer_work);

    reader_handle
        .join()
        .expect("Failed to join the reader thread.");
}


case class HowMany(asker: Actor)

val printer = actor {
  var count = 0
  while (true) {
    receive {
      case line: String =>
        print(line); count = count + 1
      case HowMany(asker: Actor) => asker ! count; exit()
    }
  }
}

def reader(printer: Actor) {
  scala.io.Source.fromFile("c:\\input.txt").getLines foreach { printer ! _ }
  printer ! HowMany(
    actor {
      receive {
        case count: Int => println("line count = " + count)
      }
    })
}

reader(printer)


//
//  Reader.swift
//

import Foundation

class Reader: NSObject {
    let inputPath = "~/Desktop/input.txt".stringByExpandingTildeInPath
    var gotNumberOfLines = false

    override init() {
        super.init()
        NSNotificationCenter.defaultCenter().addObserver(self, selector: "linesPrinted:",
            name: "LinesPrinted", object: nil)
    }

    deinit {
        NSNotificationCenter.defaultCenter().removeObserver(self)
    }

    // Selector for the number of lines printed
    func linesPrinted(not:NSNotification) {
        println(not.object!)
        self.gotNumberOfLines = true
        exit(0)
    }

    func readFile() {
        var err:NSError?
        let fileString = NSString(contentsOfFile: self.inputPath,
            encoding: NSUTF8StringEncoding, error: &err)

        if let lines = fileString?.componentsSeparatedByString("\n") {
            for line in lines {
                NSNotificationCenter.defaultCenter().postNotificationName("Line", object: line)
            }
            NSNotificationCenter.defaultCenter().postNotificationName("LineNumberRequest", object: nil)

            while !self.gotNumberOfLines {
                sleep(1 as UInt32)
            }
        }
    }
}


program main;

 mailbox#(bit) p2c_cmd = new;
 mailbox#(string) p2c_data = new;
 mailbox#(int) c2p_data = new;

 initial begin
   int fh = $fopen("input.txt", "r");
   string line;
   int count;
   while ($fgets(line, fh)) begin
     p2c_cmd.put(0);
     p2c_data.put(line);
   end
   p2c_cmd.put(1);
   c2p_data.get(count);
   $display( "COUNT: %0d", count );
 end

 initial begin
   bit done;
   int count;
   while (!done) begin
     p2c_cmd.get(done);
     if (done) begin
       c2p_data.put(count);
     end
     else begin
       string line;
       p2c_data.get(line);
       $display( "LINE: %s", line);
       count++;
     end
   end
 end

endprogram


package require Thread

# Define the input thread
set input [thread::create {
    proc readFile {filename receiver} {
	set f [open $filename]
	while {[gets $f line] >= 0} {
	    thread::send $receiver [list line $line]
	}
	close $f
	thread::send $receiver lineCount lines
	puts "got $lines lines"
    }
    thread::wait
}]
# Define the output thread
set output [thread::create {
    set lines 0
    proc line {string} {
	puts $string
	incr ::lines
    }
    proc lineCount {} {return $::lines}
    thread::wait
}]

# Connect everything together and start the processing
thread::send $input [list readFile "input.txt" $output]


(defstruct thread nil
  suspended
  cont
  (:method resume (self)
    [self.cont])
  (:method give (self item)
    [self.cont item])
  (:method get (self)
    (yield-from run nil))
  (:method start (self)
    (set self.cont (obtain self.(run)))
    (unless self.suspended
      self.(resume)))
  (:postinit (self)
    self.(start)))

(defstruct consumer thread
  (count 0)
  (:method run (self)
    (whilet ((item self.(get)))
      (prinl item)
      (inc self.count))))

(defstruct producer thread
  consumer
  (:method run (self)
    (whilet ((line (get-line)))
      self.consumer.(give line))))

(let* ((con (new consumer))
       (pro (new producer suspended t consumer con)))
  pro.(resume)
  (put-line `count = @{con.count}`))


rm -f node ; mkfifo node
cat file | tee >(wc -l > node ) | cat - node


Imports System.Threading

Module Module1

   Sub Main()
       Dim t1 As New Thread(AddressOf Reader)
       Dim t2 As New Thread(AddressOf Writer)
       t1.Start()
       t2.Start()
       t1.Join()
       t2.Join()
   End Sub

   Sub Reader()
       For Each line In IO.File.ReadAllLines("input.txt")
           m_WriterQueue.Enqueue(line)
       Next
       m_WriterQueue.Enqueue(Nothing)

       Dim result As Integer
       Do Until m_ReaderQueue.TryDequeue(result)
           Thread.Sleep(10)
       Loop

       Console.WriteLine(result)

   End Sub

   Sub Writer()
       Dim count = 0
       Dim line As String = Nothing
       Do
           Do Until m_WriterQueue.TryDequeue(line)
               Thread.Sleep(10)
           Loop
           If line IsNot Nothing Then
               Console.WriteLine(line)
               count += 1
           Else
               m_ReaderQueue.Enqueue(count)
               Exit Do
           End If
       Loop
   End Sub

   Private m_WriterQueue As New SafeQueue(Of String)
   Private m_ReaderQueue As New SafeQueue(Of Integer)

End Module

Class SafeQueue(Of T)
   Private m_list As New Queue(Of T)
   Public Function TryDequeue(ByRef result As T) As Boolean
       SyncLock m_list
           If m_list.Count = 0 Then Return False
           result = m_list.Dequeue
           Return True
       End SyncLock
   End Function
   Public Sub Enqueue(ByVal value As T)
       SyncLock m_list
           m_list.Enqueue(value)
       End SyncLock
   End Sub
End Class


import "io" for File

var EOT = "\x04"

var readLines = Fiber.new { |fileName|
    var file = File.open(fileName)
    var offset = 0
    var line = ""
    while (true) {
        var b = file.readBytes(1, offset)
        offset = offset + 1
        if (b == "\n") {
            Fiber.yield(line)
            line = "" // reset line variable
        } else if (b == "\r") { // Windows
            // wait for following "\n"
        } else if (b == "") { // end of stream
            var numLines = Fiber.yield(EOT)
            System.print("Number of lines read = %(numLines)")
            break
        } else {
            line = line + b
        }
    }
    file.close()
}

var numLines = 0
while(true) {
    var line = readLines.call("input.txt")
    if (line != EOT) {
        System.print(line)
        numLines = numLines + 1
    } else {
        readLines.call(numLines)
        break
    }
}


fcn reader(fileName,out){
   n:=0; foreach line in (File(fileName)) { out.write(line); n+=1; }
   out.close();	// signal done
   Atomic.waitFor(out.Property("isOpen")); // wait for other thread to reopen Pipe
   out.write(n);
}
fcn writer(in){
   Utils.zipWith(fcn(n,line){ "%3d: %s".fmt(n,line).print() },[1..],in);
   in.open();  // signal other thread to send num lines read
   println("Other thread read ",in.read()," lines");
}

p:=Thread.Pipe();  // NOT Unix pipes, thread safe channel between threads
reader.launch("input.txt",p);
writer.future(p).noop();  // noop forces eval, ie sleep until writer finished


INCLUDE "D2:REAL.ACT" ;from the Action! Tool Kit

PROC Superellipse(INT x0 BYTE y0 REAL POINTER n BYTE a)
  INT ARRAY f(100)
  REAL ar,xr,tmp1,tmp2,tmp3,one,invn
  INT x

  IntToReal(1,one)
  RealDiv(one,n,invn) ;1/n
  IntToReal(a,ar)
  Power(ar,n,tmp1) ;a^n

  Plot(x0,y0-a)
  FOR x=0 TO a
  DO
    IntToReal(x,xr)
    Power(xr,n,tmp2) ;x^n
    RealSub(tmp1,tmp2,tmp3) ;a^n-x^n
    Power(tmp3,invn,tmp2) ;(a^n-x^n)^(1/n)
    f(x)=RealToInt(tmp2)
    DrawTo(x0+x,y0-f(x))
  OD

  x=a
  WHILE x>=0
  DO
    DrawTo(x0+x,y0+f(x))
    x==-1
  OD

  FOR x=0 TO a
  DO
    DrawTo(x0-x,y0+f(x))
  OD

  x=a
  WHILE x>=0
  DO
    DrawTo(x0-x,y0-f(x))
    x==-1
  OD
RETURN

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

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

  ValR("2.5",n)
  Superellipse(160,96,n,80)

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


with Ada.Numerics.Elementary_Functions;

with SDL.Video.Windows.Makers;
with SDL.Video.Renderers.Makers;
with SDL.Events.Events;

procedure Superelipse is

   Width  : constant := 600;
   Height : constant := 600;
   A      : constant := 200.0;
   B      : constant := 200.0;
   N      : constant := 2.5;

   Window   : SDL.Video.Windows.Window;
   Renderer : SDL.Video.Renderers.Renderer;
   Event    : SDL.Events.Events.Events;

   procedure Draw_Superelipse
   is
      use type SDL.C.int;
      use Ada.Numerics.Elementary_Functions;
      Xx, Yy : Float;
      subtype Legal_Range is Float range 0.980 .. 1.020;
   begin
      for Y in 0 .. Height loop
         for X in 0 .. Width loop
            Xx := Float (X - Width  / 2);
            Yy := Float (Y - Height / 2);
            if (abs (Xx / A)) ** N + (abs (Yy / B)) ** N in Legal_Range then
               Renderer.Draw (Point => (X => Width  / 2 + SDL.C.int (Xx),
                                        Y => Height / 2 - SDL.C.int (Yy)));
            end if;

         end loop;
      end loop;
   end Draw_Superelipse;

   procedure Wait is
      use type SDL.Events.Event_Types;
   begin
      loop
         while SDL.Events.Events.Poll (Event) loop
            if Event.Common.Event_Type = SDL.Events.Quit then
               return;
            end if;
         end loop;
         delay 0.100;
      end loop;
   end Wait;

begin
   if not SDL.Initialise (Flags => SDL.Enable_Screen) then
      return;
   end if;

   SDL.Video.Windows.Makers.Create (Win      => Window,
                                    Title    => "Superelipse",
                                    Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
                                    Size     => SDL.Positive_Sizes'(Width, Height),
                                    Flags    => 0);
   SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);
   Renderer.Set_Draw_Colour ((0, 0, 0, 255));
   Renderer.Fill (Rectangle => (0, 0, Width, Height));
   Renderer.Set_Draw_Colour ((0, 220, 0, 255));

   Draw_Superelipse;
   Window.Update_Surface;

   Wait;
   Window.Finalize;
   SDL.Finalise;
end Superelipse;


n := 2.5
a := 200
b := 200
SuperEllipse(n, a, b)
return

SuperEllipse(n, a, b){
    global
    pToken    := Gdip_Startup()
    π := 3.141592653589793, oCoord := [], oX := [], oY := []
    nn := 2/n
    loop 361
    {
        t := (A_Index-1) * π/180
        ; https://en.wikipedia.org/wiki/Superellipse
        x := abs(cos(t))**nn * a * sgn(cos(t))
        y := abs(sin(t))**nn * b * sgn(sin(t))
        oCoord[A_Index] := [x, y]
        oX[Floor(x)] := true, oY[Floor(y)] := true
    }
    dx := 0 - oX.MinIndex() + 10
    dy := 0 - oY.MinIndex() + 10
    w := oX.MaxIndex()-oX.MinIndex() + 20
    h := oY.MaxIndex()-oY.MinIndex() + 20

    Gdip1(w, h)
    pPen := Gdip_CreatePen("0xFF00FF00", 2)
    for i, obj in oCoord
    {
        x2 := obj.1+dx, y2 := obj.2+dy
        if i>1
            Gdip_DrawLine(G, pPen, x1, y1, x2, y2)
        x1 := x2, y1 := y2
    }
    UpdateLayeredWindow(hwnd, hdc)
}
;----------------------------------------------------------------
sgn(n){
    return (n>0?1:n<0?-1:0)
}
;----------------------------------------------------------------
Gdip1(w:=0, h:=0){
    global
    w := w ? w : A_ScreenWidth
    h := h ? h : A_ScreenHeight
    x := A_ScreenWidth/2 - w/2
    y := A_ScreenHeight/2 - h/2
    Gui, gdip1: -Caption +E0x80000 +LastFound +OwnDialogs +Owner +AlwaysOnTop
    Gui, gdip1: Show, w%w% h%h% x%x% y%y%
    hwnd    := WinExist()
    hbm        := CreateDIBSection(w, h)
    hdc        := CreateCompatibleDC()
    obm        := SelectObject(hdc, hbm)
    G        := Gdip_GraphicsFromHDC(hdc)
    Gdip_SetSmoothingMode(G, 4)
    pBrush    := Gdip_BrushCreateSolid("0xFF000000")
    Gdip_FillRoundedRectangle(G, pBrush, 0, 0, w, h, 5)
    Gdip_DeleteBrush(pBrush)
    UpdateLayeredWindow(hwnd, hdc)
    OnMessage(0x201, "WM_LBUTTONDOWN")
}
;----------------------------------------------------------------
Gdip2(){
    global
    SelectObject(hdc, obm)
    DeleteObject(hbm)
    DeleteDC(hdc)
    Gdip_DeleteGraphics(G)
    Gdip_Shutdown(pToken)
}
;----------------------------------------------------------------
WM_LBUTTONDOWN(){
    PostMessage, 0xA1, 2
}
;----------------------------------------------------------------
Exit:
gdip2()
ExitApp
Return
;----------------------------------------------------------------


#include<graphics.h>
#include<stdio.h>
#include<math.h>

#define pi M_PI

int main(){

	double a,b,n,i,incr = 0.0001;

	printf("Enter major and minor axes of the SuperEllipse : ");
	scanf("%lf%lf",&a,&b);

	printf("Enter n : ");
	scanf("%lf",&n);

	initwindow(500,500,"Superellipse");

	for(i=0;i<2*pi;i+=incr){
		putpixel(250 + a*pow(fabs(cos(i)),2/n)*(pi/2<i && i<3*pi/2?-1:1),250 + b*pow(fabs(sin(i)),2/n)*(pi<i && i<2*pi?-1:1),15);
	}

	printf("Done. %lf",i);

	getch();

	closegraph();
}


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

Const scr_x = 800       ' screen 800 x 800
Const scr_y = 600
Const m_x = scr_x \ 2   ' middle of screen
Const m_y = scr_y \ 2

Sub superellipse(a As Long, b As Long, n As Double)

    ReDim As Long y(0 To a)
    Dim As Long x

    y(0) = b ' value for x = 0
    y(a) = 0 ' value for x = a

    '(0,0) is in upper left corner

    PSet (m_x, m_y - y(0)) ' set starting point

    For x = 1 To a-1
        y(x) = Int( Exp( Log(1 - ((x / a) ^ n)) / n ) * b )
        Line - ((m_x + x), (m_y - y(x)))
    Next

    For x = a To 0 Step -1
        Line - ((m_x + x), (m_y + y(x)))
    Next

    For x = 0 To a
        Line - ((m_x - x), (m_y + y(x)))
    Next

    For x = a To 0 Step -1
        Line - ((m_x - x), (m_y - y(x)))
    Next

End Sub

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

ScreenRes scr_x, scr_y, 32

Dim As Long   a = 200
Dim As Long   b = 150
Dim As Double n = 2.5

superellipse(a, b, n)

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


package main

import (
    "github.com/fogleman/gg"
    "math"
)

/* assumes a and b are always equal */
func superEllipse(dc *gg.Context, n float64, a int) {
    hw := float64(dc.Width() / 2)
    hh := float64(dc.Height() / 2)

    // calculate y for each x
    y := make([]float64, a+1)
    for x := 0; x <= a; x++ {
        aa := math.Pow(float64(a), n)
        xx := math.Pow(float64(x), n)
        y[x] = math.Pow(aa-xx, 1.0/n)
    }

    // draw quadrants
    for x := a; x >= 0; x-- {
        dc.LineTo(hw+float64(x), hh-y[x])
    }
    for x := 0; x <= a; x++ {
        dc.LineTo(hw+float64(x), hh+y[x])
    }
    for x := a; x >= 0; x-- {
        dc.LineTo(hw-float64(x), hh+y[x])
    }
    for x := 0; x <= a; x++ {
        dc.LineTo(hw-float64(x), hh-y[x])
    }

    dc.SetRGB(1, 1, 1) // white ellipse
    dc.Fill()
}

func main() {
    dc := gg.NewContext(500, 500)
    dc.SetRGB(0, 0, 0) // black background
    dc.Clear()
    superEllipse(dc, 2.5, 200)
    dc.SavePNG("superellipse.png")
}


{-# LANGUAGE OverloadedStrings, RankNTypes #-}
import Reflex
import Reflex.Dom
import Data.Text (Text, pack, unpack)
import Data.Map (Map, fromList, empty)
import Text.Read (readMaybe)

width = 600
height = 500

type Point = (Float,Float)
type Segment = (Point,Point)

data Ellipse = Ellipse {a :: Float, b :: Float, n :: Float}

toFloat :: Text -> Maybe Float
toFloat  = readMaybe.unpack

toEllipse :: Maybe Float -> Maybe Float -> Maybe Float -> Maybe Ellipse
toEllipse (Just a) (Just b) (Just n) =
    if a < 1.0 || b <= 1.0 || n <= 0.0  -- not all floats are valid
    then Nothing
    else Just $ Ellipse a b n

toEllipse _ _ _ = Nothing

showError :: Maybe a -> String
showError Nothing = "invalid input"
showError _ = ""

reflect45 pts  =  pts ++ fmap (\(x,y) -> ( y,  x)) (reverse pts)
rotate90  pts  =  pts ++ fmap (\(x,y) -> ( y, -x)) pts
rotate180 pts  =  pts ++ fmap (\(x,y) -> (-x, -y)) pts
scale a b      =  fmap (\(x,y) -> ( a*x, b*y ))
segments  pts  =  zip pts $ tail pts

toLineMap :: Maybe Ellipse -> Map Int ((Float,Float),(Float,Float))
toLineMap (Just (Ellipse a b n)) =
    let f p = (1 - p**n)**(1/n)
        dp = iterate (*0.9) 1.0
        ip = map (\p -> 1.0 -p) dp
        points s =
            if n > 1.0
            then (\p -> zip p (map f p)) ip
            else (\p -> zip (map f p) p) dp

    in fromList $  -- changes list to map (for listWithKey)
       zip [0..] $ -- annotates segments with index
       segments $  -- changes points to line segments
       scale a b $
       rotate180 $ -- doubles the point count
       rotate90 $  -- doubles the point count
       reflect45 $ -- doubles the point count
       takeWhile (\(x,y) -> x < y ) $ -- stop at 45 degree line
       points 0.9

toLineMap Nothing = empty

lineAttrs :: Segment -> Map Text Text
lineAttrs ((x1,y1), (x2,y2)) =
    fromList [ ( "x1",    pack $ show (width/2+x1))
             , ( "y1",    pack $ show (height/2+y1))
             , ( "x2",    pack $ show (width/2+x2))
             , ( "y2",    pack $ show (height/2+y2))
             , ( "style", "stroke:brown;stroke-width:2")
             ]

showLine :: MonadWidget t m => Int -> Dynamic t Segment -> m ()
showLine _ dSegment = do
    elSvgns "line" (lineAttrs <$> dSegment) $ return ()
    return ()

main = mainWidget $ do
    elAttr "h1" ("style" =: "color:brown") $ text "Superellipse"
    ta <- el "div" $ do
        text "a: "
        textInput def { _textInputConfig_initialValue = "200"}

    tb <- el "div" $ do
        text "b: "
        textInput def { _textInputConfig_initialValue = "200"}

    tn <- el "div" $ do
        text "n: "
        textInput def { _textInputConfig_initialValue = "2.5"}
    let
        ab = zipDynWith toEllipse (toFloat <$> value ta) (toFloat <$> value tb)
        dEllipse = zipDynWith ($) ab (toFloat <$> value tn)
        dLines = fmap toLineMap dEllipse

        dAttrs = constDyn $ fromList
                     [ ("width" , pack $ show width)
                     , ("height", pack $ show height)
                     ]
    elAttr "div" ("style" =: "color:red") $ dynText $ fmap (pack.showError) dEllipse
    el "div" $ elSvgns "svg" dAttrs $ listWithKey dLines showLine
    return ()

-- At end to avoid Rosetta Code unmatched quotes problem.
elSvgns :: forall t m a. MonadWidget t m => Text -> Dynamic t (Map Text Text) -> m a -> m (El t, a)
elSvgns = elDynAttrNS' (Just "http://www.w3.org/2000/svg")


import java.awt.*;
import java.awt.geom.Path2D;
import static java.lang.Math.pow;
import java.util.Hashtable;
import javax.swing.*;
import javax.swing.event.*;

public class SuperEllipse extends JPanel implements ChangeListener {
    private double exp = 2.5;

    public SuperEllipse() {
        setPreferredSize(new Dimension(650, 650));
        setBackground(Color.white);
        setFont(new Font("Serif", Font.PLAIN, 18));
    }

    void drawGrid(Graphics2D g) {
        g.setStroke(new BasicStroke(2));
        g.setColor(new Color(0xEEEEEE));

        int w = getWidth();
        int h = getHeight();
        int spacing = 25;

        for (int i = 0; i < w / spacing; i++) {
            g.drawLine(0, i * spacing, w, i * spacing);
            g.drawLine(i * spacing, 0, i * spacing, w);
        }
        g.drawLine(0, h - 1, w, h - 1);

        g.setColor(new Color(0xAAAAAA));
        g.drawLine(0, w / 2, w, w / 2);
        g.drawLine(w / 2, 0, w / 2, w);
    }

    void drawLegend(Graphics2D g) {
        g.setColor(Color.black);
        g.setFont(getFont());
        g.drawString("n = " + String.valueOf(exp), getWidth() - 150, 45);
        g.drawString("a = b = 200", getWidth() - 150, 75);
    }

    void drawEllipse(Graphics2D g) {

        final int a = 200; // a = b
        double[] points = new double[a + 1];

        Path2D p = new Path2D.Double();
        p.moveTo(a, 0);

        // calculate first quadrant
        for (int x = a; x >= 0; x--) {
            points[x] = pow(pow(a, exp) - pow(x, exp), 1 / exp); // solve for y
            p.lineTo(x, -points[x]);
        }

        // mirror to others
        for (int x = 0; x <= a; x++)
            p.lineTo(x, points[x]);

        for (int x = a; x >= 0; x--)
            p.lineTo(-x, points[x]);

        for (int x = 0; x <= a; x++)
            p.lineTo(-x, -points[x]);

        g.translate(getWidth() / 2, getHeight() / 2);
        g.setStroke(new BasicStroke(2));

        g.setColor(new Color(0x25B0C4DE, true));
        g.fill(p);

        g.setColor(new Color(0xB0C4DE)); // LightSteelBlue
        g.draw(p);
    }

    @Override
    public void paintComponent(Graphics gg) {
        super.paintComponent(gg);
        Graphics2D g = (Graphics2D) gg;
        g.setRenderingHint(RenderingHints.KEY_ANTIALIASING,
                RenderingHints.VALUE_ANTIALIAS_ON);
        g.setRenderingHint(RenderingHints.KEY_TEXT_ANTIALIASING,
                RenderingHints.VALUE_TEXT_ANTIALIAS_ON);

        drawGrid(g);
        drawLegend(g);
        drawEllipse(g);
    }

    @Override
    public void stateChanged(ChangeEvent e) {
        JSlider source = (JSlider) e.getSource();
        exp = source.getValue() / 2.0;
        repaint();
    }

    public static void main(String[] args) {
        SwingUtilities.invokeLater(() -> {
            JFrame f = new JFrame();
            f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
            f.setTitle("Super Ellipse");
            f.setResizable(false);
            SuperEllipse panel = new SuperEllipse();
            f.add(panel, BorderLayout.CENTER);

            JSlider exponent = new JSlider(JSlider.HORIZONTAL, 1, 9, 5);
            exponent.addChangeListener(panel);
            exponent.setMajorTickSpacing(1);
            exponent.setPaintLabels(true);
            exponent.setBackground(Color.white);
            exponent.setBorder(BorderFactory.createEmptyBorder(20, 20, 20, 20));

            Hashtable<Integer, JLabel> labelTable = new Hashtable<>();
            for (int i = 1; i < 10; i++)
                labelTable.put(i, new JLabel(String.valueOf(i * 0.5)));
            exponent.setLabelTable(labelTable);

            f.add(exponent, BorderLayout.SOUTH);

            f.pack();
            f.setLocationRelativeTo(null);
            f.setVisible(true);
        });
    }
}


var n = 2.5, a = 200, b = 200, ctx;

function point( x, y ) {
    ctx.fillRect( x, y, 1, 1);
}

function start() {
    var can = document.createElement('canvas');
    can.width  = can.height = 600;
    ctx = can.getContext( "2d" );
    ctx.rect( 0, 0, can.width, can.height );
    ctx.fillStyle = "#000000"; ctx.fill();
    document.body.appendChild( can );

    ctx.fillStyle = "#ffffff";
    for( var t = 0; t < 1000; t += .1 ) {
       x = Math.pow( Math.abs( Math.cos( t ) ), 2 / n ) * a * Math.sign( Math.cos( t ) );
       y = Math.pow( Math.abs( Math.sin( t ) ), 2 / n ) * b * Math.sign( Math.sin( t ) );

       point( x + ( can.width >> 1 ), y + ( can.height >> 1 ) );
    }
}


function superellipse(n, a, b, step::Int=100)
    @assert n > 0 && a > 0 && b > 0
    na = 2 / n
    pc = 2π / step
    t  = 0
    xp = Vector{Float64}(undef, step + 1)
    yp = Vector{Float64}(undef, step + 1)
    for i in 0:step
        # because sin^n(x) is mathematically the same as (sin(x))^n...
        xp[i+1] = abs((cos(t))) ^ na * a * sign(cos(t))
        yp[i+1] = abs((sin(t))) ^ na * b * sign(sin(t))
        t += pc
    end
    return xp, yp
end

using UnicodePlots

x, y = superellipse(2.5, 200, 200)
println(lineplot(x, y))


// version 1.1.2

import java.awt.*
import java.awt.geom.Path2D
import javax.swing.*
import java.lang.Math.pow

/* assumes a == b */
class SuperEllipse(val n: Double, val a: Int) : JPanel() {
    init {
        require(n > 0.0 && a > 0)
        preferredSize = Dimension(650, 650)
        background = Color.black
    }

    private fun drawEllipse(g: Graphics2D) {
        val points = DoubleArray(a + 1)
        val p = Path2D.Double()
        p.moveTo(a.toDouble(), 0.0)

        // calculate first quadrant
        for (x in a downTo 0) {
            points[x] = pow(pow(a.toDouble(), n) - pow(x.toDouble(), n), 1.0 / n)
            p.lineTo(x.toDouble(), -points[x])
        }

        // mirror to others
        for (x in 0..a) p.lineTo(x.toDouble(), points[x])
        for (x in a downTo 0) p.lineTo(-x.toDouble(), points[x])
        for (x in 0..a) p.lineTo(-x.toDouble(), -points[x])

        with(g) {
            translate(width / 2, height / 2)
            color = Color.yellow
            fill(p)
        }
    }

    override fun paintComponent(gg: Graphics) {
        super.paintComponent(gg)
        val g = gg as Graphics2D
        g.setRenderingHint(RenderingHints.KEY_ANTIALIASING,
                           RenderingHints.VALUE_ANTIALIAS_ON)
        g.setRenderingHint(RenderingHints.KEY_TEXT_ANTIALIASING,
                           RenderingHints.VALUE_TEXT_ANTIALIAS_ON)
        drawEllipse(g)
    }
}

fun main(args: Array<String>) {
    SwingUtilities.invokeLater {
        val f = JFrame()
        with (f) {
            defaultCloseOperation = JFrame.EXIT_ON_CLOSE
            title = "Super Ellipse"
            isResizable = false
            add(SuperEllipse(2.5, 200), BorderLayout.CENTER)
            pack()
            setLocationRelativeTo(null)
            isVisible = true
        }
    }
}


[start]
    nomainwin
    UpperLeftX=1:UpperLeftY=1
    WindowWidth=800:WindowHeight=600
    open "Super Ellipse" for graphics_nf_nsb as #1
    #1 "trapclose [q];down;fill black;flush;color green;size 1"

    n=1.5
    a=200
    b=200

    for n = 0.1 to 5 step .1
        na=2/n
        t=.01
        for i = 0 to 314
            xp=a*sign(cos(t))*abs((cos(t)))^na+350
            yp=b*sign(sin(t))*abs((sin(t)))^na+275
            t=t+.02
            #1 "set ";xp;" ";yp
        next i
    next n

    'plot only the super ellipse for the task
    n=2.5
    na=2/n
    t=.01
    #1 "color white;size 4"
    for i = 0 to 314
        xp=a*sign(cos(t))*abs((cos(t)))^na+350
        yp=b*sign(sin(t))*abs((sin(t)))^na+275
        t=t+.02
        #1 "set ";xp;" ";yp
    next i
wait

[q]
close #1
end

function sign(x)
    if x<0 then sign=1
    if x>0 then sign=-1
    if x=0 then sign=0
end function


local abs,cos,floor,pi,pow,sin = math.abs,math.cos,math.floor,math.pi,math.pow,math.sin
local bitmap = {
  init = function(self, w, h, value)
    self.w, self.h, self.pixels = w, h, {}
    for y=1,h do self.pixels[y]={} end
    self:clear(value)
  end,
  clear = function(self, value)
    for y=1,self.h do
      for x=1,self.w do
        self.pixels[y][x] = value or "  "
      end
    end
  end,
  set = function(self, x, y, value)
    x,y = floor(x+0.5),floor(y+0.5)
    if x>0 and y>0 and x<=self.w and y<=self.h then
      self.pixels[y][x] = value or "#"
    end
  end,
  superellipse = function(self, ox, oy, n, a, b, c)
    local function sgn(n) return n>=0 and 1 or -1 end
    for t = 0, 1, 0.002 do
      local theta = t * 2 * pi
      local x = ox + a * pow(abs(cos(theta)), 2/n) * sgn(cos(theta))
      local y = oy + b * pow(abs(sin(theta)), 2/n) * sgn(sin(theta))
      self:set(x, y, c)
    end
  end,
  render = function(self)
    for y=1,self.h do
      print(table.concat(self.pixels[y]))
    end
  end,
}

bitmap:init(80, 60, "..")
bitmap:superellipse(40, 30, 2.5, 38, 28, "[]")
bitmap:render()


import math
import imageman

const
  Size = 600
  X0 = Size div 2
  Y0 = Size div 2
  Background = ColorRGBU [byte 0, 0, 0]
  Foreground = ColorRGBU [byte 255, 255, 255]

proc drawSuperEllipse(img: var Image; n: float; a, b: int) =

  var yList = newSeq[int](a + 1)
  for x in 0..a:
    let an = pow(a.toFloat, n)
    let bn = pow(b.toFloat, n)
    let xn = pow(x.toFloat, n)
    let t = max(bn - xn * bn / an, 0.0)   # Avoid negative values due to rounding errors.
    yList[x] = pow(t, 1/n).toInt

  var pos: seq[Point]
  for x in countdown(a, 0):
    pos.add (X0 + x, Y0 - yList[x])
  for x in 0..a:
    pos.add (X0 - x, Y0 - yList[x])
  for x in countdown(a, 0):
    pos.add (X0 - x, Y0 + yList[x])
  for x in 0..a:
    pos.add (X0 + x, Y0 + yList[x])
  img.drawPolyline(true, Foreground, pos)

var image = initImage[ColorRGBU](Size, Size)
image.fill(Background)
image.drawSuperEllipse(2.5, 200, 200)
image.savePNG("super_ellipse.png", compression = 9)


This program draws 5 super ellipses:
black 120,120,1.5
blue  160,160,2
red   200,200,2.5
green 240,240,3
black 280,280,4


my $a = 200;
my $b = 200;
my $n = 2.5;

# y in terms of x
sub y_from_x {
    my($x) = @_;
    int $b * abs(1 - ($x / $a) ** $n ) ** (1/$n)
}

# find point pairs for one quadrant
push @q, $_, y_from_x($_) for 0..200;

# Generate an SVG image
open  $fh, '>', 'superellipse.svg';
print $fh
  qq|<svg height="@{[2*$b]}" width="@{[2*$a]}" xmlns="http://www.w3.org/2000/svg">\n|,
  pline( 1, 1, @q ),
  pline( 1,-1, @q ), # flip and mirror
  pline(-1,-1, @q ), # for the other
  pline(-1, 1, @q ), # three quadrants
  '</svg>';

sub pline {
  my($sx,$sy,@q) = @_;

  for (0..$#q/2) {
    $q[  2*$_] *= $sx;
    $q[1+2*$_] *= $sy;
  }

  qq|<polyline points="@{[join ' ',@q]}"
  style="fill:none;stroke:black;stroke-width:3"
  transform="translate($a, $b)" />\n|
}


--
-- demo\rosetta\Superellipse.exw
-- =============================
--
with javascript_semantics
atom n = 2.5        -- '+' and '-' increase/decrease in steps of 0.1

include pGUI.e

Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas

function redraw_cb(Ihandle /*ih*/)

    integer {w, h} = IupGetIntInt(canvas, "DRAWSIZE"),
             hw = floor(w/2), hh = floor(h/2),
             a = max(10,hw-100),    -- (initially 200, from 602x   )
             b = max(10,hh-50)      -- (initially 200, from    x502)
    sequence y = b&repeat(0,a)
    for x=1 to a-1 do
        y[x+1] = floor(exp(log(1-power(x/a,n))/n)*b)
    end for

    cdCanvasActivate(cddbuffer)
    cdCanvasClear(cddbuffer)
    cdCanvasBegin(cddbuffer, CD_OPEN_LINES)
    cdCanvasVertex(cddbuffer, hw, hh-b) -- starting point
    for x=1 to a-1     do cdCanvasVertex(cddbuffer, hw+x, hh-y[x+1]) end for
    for x=a to 0 by -1 do cdCanvasVertex(cddbuffer, hw+x, hh+y[x+1]) end for
    for x=0 to a       do cdCanvasVertex(cddbuffer, hw-x, hh+y[x+1]) end for
    for x=a to 0 by -1 do cdCanvasVertex(cddbuffer, hw-x, hh-y[x+1]) end for
    cdCanvasEnd(cddbuffer)
    cdCanvasFlush(cddbuffer)

    return IUP_DEFAULT
end function

function map_cb(Ihandle ih)
    cdcanvas = cdCreateCanvas(CD_IUP, ih)
    cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
    cdCanvasSetBackground(cddbuffer, CD_WHITE)
    cdCanvasSetForeground(cddbuffer, CD_BLACK)
    return IUP_DEFAULT
end function

function key_cb(Ihandle /*ih*/, atom c)
    if c=K_ESC then return IUP_CLOSE end if
    if c='+' then
        n = min(130,n+0.1) -- (otherwise [>130] power overflow)
        IupUpdate(canvas)
    elsif c='-' then
        n = max(0.1,n-0.1) -- (otherwise [=0.0] divide by zero)
        IupUpdate(canvas)
    end if
    return IUP_CONTINUE
end function

procedure main()
    IupOpen()

    canvas = IupCanvas("RASTERSIZE=602x502")
    IupSetCallbacks(canvas, {"MAP_CB", Icallback("map_cb"),
                             "ACTION", Icallback("redraw_cb")})
    dlg = IupDialog(canvas,"TITLE=Superellipse")
    IupSetCallback(dlg, "KEY_CB", Icallback("key_cb"))
    IupShow(dlg)
    IupSetAttribute(canvas, "RASTERSIZE", NULL) -- release the minimum limitation
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()


# Superellipse drawing in Python 2.7.9
# pic can see at http://www.imgup.cz/image/712

import matplotlib.pyplot as plt
from math import sin, cos, pi

def sgn(x):
	return ((x>0)-(x<0))*1

a,b,n=200,200,2.5 # param n making shape
na=2/n
step=100 # accuracy
piece=(pi*2)/step
xp=[];yp=[]

t=0
for t1 in range(step+1):
	# because sin^n(x) is mathematically the same as (sin(x))^n...
	x=(abs((cos(t)))**na)*a*sgn(cos(t))
	y=(abs((sin(t)))**na)*b*sgn(sin(t))
	xp.append(x);yp.append(y)
	t+=piece

plt.plot(xp,yp) # plotting all point from array xp, yp
plt.title("Superellipse with parameter "+str(n))
plt.show()


_Title "Super Ellipse"

Dim As Integer sw, sh
Dim As Single i
sw = 480: sh = 480

Screen _NewImage(sw, sh, 8)
Cls , 15

'Show different possible Super Ellipse shapes
Color 10
For i = 0.2 To 5.0 Step .1
    Call SuperEllipse(sw \ 2, sh \ 2, 200, 200, i, 80)
Next

'Show task specified Super Ellipse
Color 0
Call SuperEllipse(sw \ 2, sh \ 2, 200, 200, 2.5, 200)
Sleep
System

Sub SuperEllipse (cX As Integer, cY As Integer, wide As Integer, high As Integer, pow As Double, segs As Integer)
    Dim As Double power, inc, theta, cosTheta, sinTheta
    Dim As Integer x1, y1
    'Limit 'pow' to acceptable values
    If pow < .1 Then pow = .1
    If pow > 150 Then pow = 150
    power = 2 / pow - 1
    inc = 360.0 / segs * 0.0174532925199432957692369
    PSet (wide + cX, cY)
    For theta = inc To 6.28318530717958647692528 + inc Step inc
        cosTheta = Cos(theta): sinTheta = Sin(theta)
        x1 = wide * cosTheta * Abs(cosTheta) ^ power + cX
        y1 = high * sinTheta * Abs(sinTheta) ^ power + cY
        Line -(x1, y1)
    Next
End Sub


#lang racket
(require plot)
#;(plot-new-window? #t)

(define ((superellipse a b n) x y)
  (+ (expt (abs (/ x a)) n)
     (expt (abs (/ y b)) n)))

(plot (isoline (superellipse 200 200 2.5) 1
               -220 220 -220 220))


constant a = 200;
constant b = 200;
constant n = 2.5;

# y in terms of x
sub y ($x) { sprintf "%d", b * (1 - ($x / a).abs ** n ) ** (1/n) }

# find point pairs for one quadrant
my @q = flat map -> \x { x, y(x) }, (0, 1 ... 200);

# Generate an SVG image
INIT say qq:to/STOP/;
    <?xml version="1.0" standalone="no"?>
    <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
    <svg height="{b*2}" width="{a*2}" version="1.1" xmlns="http://www.w3.org/2000/svg">
    STOP
END say '</svg>';

.put for
pline( @q ),
pline( @q «*» ( 1,-1) ), # flip and mirror
pline( @q «*» (-1,-1) ), # for the other
pline( @q «*» (-1, 1) ); # three quadrants

sub pline (@q) {
    qq:to/END/;
    <polyline points="{@q}"
    style="fill:none; stroke:black; stroke-width:3" transform="translate({a}, {b})" />
    END
}


/* REXX ***************************************************************
* Create a BMP file showing a few super ellipses
**********************************************************************/
Parse Version v
If pos('Regina',v)>0 Then
  superegg='superegga.bmp'
Else
  superegg='supereggo.bmp'
'erase' superegg
s='424d4600000000000000360000002800000038000000280000000100180000000000'X||,
  '1000000000000000000000000000000000000000'x
z.0=0
black='000000'x
white='ffffff'x
red  ='00ff00'x
green='ff0000'x
blue ='0000ff'x
m=80
n=80
hor=m*8      /* 56 */
ver=n*8      /* 40 */
s=overlay(lend(hor),s,19,4)
s=overlay(lend(ver),s,23,4)
z.=copies('f747ff'x,3192%3)
z.=copies('ffffff'x,8*m)
z.0=648
u=320
v=320
Call supegg black,080,080,0.5,u,v
Call supegg black,110,110,1 ,u,v
Call supegg black,140,140,1.5,u,v
Call supegg blue ,170,170,2 ,u,v
Call supegg red ,200,200,2.5,u,v
Call supegg green,230,230,3 ,u,v
Call supegg black,260,260,4 ,u,v
Call supegg black,290,290,7 ,u,v
Do i=1 To z.0
  s=s||z.i
  End

Call lineout superegg,s
Call lineout superegg
Exit

supegg:
Parse Arg color,a,b,n,u,v
Do y=0 To b
  t=(1-power(y/b,n))
  x=a*power(t,1/n)
  Call point color,format(u+x,4,0),format(v+y,4,0)
  Call point color,format(u-x,4,0),format(v+y,4,0)
  Call point color,format(u+x,4,0),format(v-y,4,0)
  Call point color,format(u-x,4,0),format(v-y,4,0)
  End
Do x=0 To a
  t=(1-power(x/b,n))
  y=a*power(t,1/n)
  Call point color,format(u+x,4,0),format(v+y,4,0)
  Call point color,format(u-x,4,0),format(v+y,4,0)
  Call point color,format(u+x,4,0),format(v-y,4,0)
  Call point color,format(u-x,4,0),format(v-y,4,0)
  End
Return

lend:
Return reverse(d2c(arg(1),4))

point: Procedure Expose z.
  Call trace 'O'
  Parse Arg color,x0,y0
  --Say x0 y0
  Do x=x0-2 To x0+2
    Do y=y0-2 To y0+2
      z.y=overlay(copies(color,3),z.y,3*x)
      End
    End
  Return

power: Procedure
/***********************************************************************
* Return b**x for any x -- with reasonable or specified precision
* 920903 Walter Pachl
***********************************************************************/
  Parse Arg b,x,prec
  If prec<9 Then prec=9
  Numeric Digits (2*prec)
  Numeric Fuzz   3
  If b=0 Then Return 0
  If b<>'' Then x=x*ln(b,prec+2)
  o=1
  u=1
  r=1
  Do i=1 By 1
    ra=r
    o=o*x
    u=u*i
    r=r+(o/u)
    If r=ra Then Leave
    End
  Numeric Digits (prec)
  Return r+0

ln: Procedure
/***********************************************************************
* Return ln(x) -- with specified precision
* Three different series are used for the ranges  0 to 0.5
*                                                 0.5 to 1.5
*                                                 1.5 to infinity
* 920903 Walter Pachl
***********************************************************************/
  Parse Arg x,prec,b
  If prec='' Then prec=9
  Numeric Digits (2*prec)
  Numeric Fuzz   3
  Select
    When x<=0 Then r='*** invalid argument ***'
    When x<0.5 Then Do
      z=(x-1)/(x+1)
      o=z
      r=z
      k=1
      Do i=3 By 2
        ra=r
        k=k+1
        o=o*z*z
        r=r+o/i
        If r=ra Then Leave
        End
      r=2*r
      End
    When x<1.5 Then Do
      z=(x-1)
      o=z
      r=z
      k=1
      Do i=2 By 1
        ra=r
        k=k+1
        o=-o*z
        r=r+o/i
        If r=ra Then Leave
        End
      End
    Otherwise /* 1.5<=x */ Do
      z=(x+1)/(x-1)
      o=1/z
      r=o
      k=1
      Do i=3 By 2
        ra=r
        k=k+1
        o=o/(z*z)
        r=r+o/i
        If r=ra Then Leave
        End
      r=2*r
      End
    End
  If b<>'' Then
    r=r/ln(b)
  Numeric Digits (prec)
  Return r+0


import java.awt._
import java.awt.geom.Path2D
import java.util

import javax.swing._
import javax.swing.event.{ChangeEvent, ChangeListener}

object SuperEllipse extends App {

    SwingUtilities.invokeLater(() => {
      new JFrame("Super Ellipse") {

        class SuperEllipse extends JPanel with ChangeListener {
          setPreferredSize(new Dimension(650, 650))
          setBackground(Color.white)
          setFont(new Font("Serif", Font.PLAIN, 18))
          private var exp = 2.5

          override def paintComponent(gg: Graphics): Unit = {
            val g = gg.asInstanceOf[Graphics2D]

           def drawGrid(g: Graphics2D): Unit = {
              g.setStroke(new BasicStroke(2))
              g.setColor(new Color(0xEEEEEE))
              val w = getWidth
              val h = getHeight
              val spacing = 25

              for (i <- 0 until (w / spacing)) {
                g.drawLine(0, i * spacing, w, i * spacing)
                g.drawLine(i * spacing, 0, i * spacing, w)
              }
              g.drawLine(0, h - 1, w, h - 1)
              g.setColor(new Color(0xAAAAAA))
              g.drawLine(0, w / 2, w, w / 2)
              g.drawLine(w / 2, 0, w / 2, w)
            }

            def drawLegend(g: Graphics2D): Unit = {
              g.setColor(Color.black)
              g.setFont(getFont)
              g.drawString("n = " + String.valueOf(exp), getWidth - 150, 45)
              g.drawString("a = b = 200", getWidth - 150, 75)
            }

            def drawEllipse(g: Graphics2D): Unit = {
              val a = 200
              // calculate first quadrant
              val points = Array.tabulate(a + 1)(n =>
                math.pow(math.pow(a, exp) - math.pow(n, exp), 1 / exp))
              val p = new Path2D.Double

              p.moveTo(a, 0)
              for (n <- a to 0 by -1) p.lineTo(n, -points(n))
              // mirror to others
              for (x <- points.indices) p.lineTo(x, points(x))
              for (y <- a to 0 by -1) p.lineTo(-y, points(y))
              for (z <- points.indices) p.lineTo(-z, -points(z))
              g.translate(getWidth / 2, getHeight / 2)
              g.setStroke(new BasicStroke(2))
              g.setColor(new Color(0x25B0C4DE, true))
              g.fill(p)
              g.setColor(new Color(0xB0C4DE)) // LightSteelBlue
              g.draw(p)
            }

            super.paintComponent(gg)
            g.setRenderingHint(RenderingHints.KEY_ANTIALIASING, RenderingHints.VALUE_ANTIALIAS_ON)
            g.setRenderingHint(RenderingHints.KEY_TEXT_ANTIALIASING, RenderingHints.VALUE_TEXT_ANTIALIAS_ON)
            drawGrid(g)
            drawLegend(g)
            drawEllipse(g)
          }

          override def stateChanged(e: ChangeEvent): Unit = {
            val source = e.getSource.asInstanceOf[JSlider]
            exp = source.getValue / 2.0
            repaint()
          }
        }

        setDefaultCloseOperation(WindowConstants.EXIT_ON_CLOSE)
        setResizable(false)
        val panel = new SuperEllipse
        add(panel, BorderLayout.CENTER)
        val exponent = new JSlider(SwingConstants.HORIZONTAL, 1, 9, 5)
        exponent.addChangeListener(panel)
        exponent.setBackground(Color.white)
        exponent.setBorder(BorderFactory.createEmptyBorder(20, 20, 20, 20))
        exponent.setMajorTickSpacing(1)
        exponent.setPaintLabels(true)
        val labelTable = new util.Hashtable[Integer, JLabel]
        for (i <- 1 until 10) labelTable.put(i, new JLabel(String.valueOf(i * 0.5)))

        exponent.setLabelTable(labelTable)
        add(exponent, BorderLayout.SOUTH)
        pack()
        setLocationRelativeTo(null)
        setVisible(true)
      }

    })

}


const (
    a = 200,
    b = 200,
    n = 2.5,
)

# y in terms of x
func y(x) { b * (1 - abs(x/a)**n -> root(n)) -> int }

func pline(q) {
    <<-"EOT";
    <polyline points="#{q.join(' ')}"
    style="fill:none; stroke:black; stroke-width:3" transform="translate(#{a}, #{b})" />
    EOT
}

# Generate an SVG image
say <<-"EOT"
    <?xml version="1.0" standalone="no"?>
    <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
    <svg height="#{b*2}" width="#{a*2}" version="1.1" xmlns="http://www.w3.org/2000/svg">
    EOT

# find point pairs for one quadrant
var q = { |x| (x, y(x)) }.map(0..200 `by` 2)

[
    pline(q),
    pline(q »*« [ 1,-1]), # flip and mirror
    pline(q »*« [-1,-1]), # for the other
    pline(q »*« [-1, 1]), # three quadrants
].each { .print }

say '</svg>'


import "graphics" for Canvas, Color, Point

class Game {
    static init() {
        Canvas.resize(500, 500)
        // draw 200 concentric superellipses with gradually decreasing 'n'.
        for (a in 200..1) {
            superEllipse(a/80, a)
        }
    }

    static update() {}

    static draw(alpha) {}

    static superEllipse(n, a) {
        var hw = Canvas.width / 2
        var hh = Canvas.height / 2

        // calculate y for each x
        var y = List.filled(a + 1, 0)
        for (x in 0..a) {
            var aa = a.pow(n)
            var xx = x.pow(n)
            y[x] = (aa-xx).pow(1/n)
        }

        // draw quadrants
        var prev = Point.new(hw + a, hh - y[a])
        for (x in a-1..0) {
            var curr = Point.new(hw + x, hh - y[x])
            Canvas.line(prev.x, prev.y, curr.x, curr.y, Color.white)
            prev = Point.new(curr.x, curr.y)
        }

        prev = Point.new(hw, hh + y[0])
        for (x in 1..a) {
            var curr = Point.new(hw + x, hh + y[x])
            Canvas.line(prev.x, prev.y, curr.x, curr.y, Color.white)
            prev = Point.new(curr.x, curr.y)
        }

        prev = Point.new(hw - a, hh + y[a])
        for (x in a-1..0) {
            var curr = Point.new(hw - x, hh + y[x])
            Canvas.line(prev.x, prev.y, curr.x, curr.y, Color.white)
            prev = Point.new(curr.x, curr.y)
        }

        prev = Point.new(hw, hh - y[0])
        for (x in 1..a) {
            var curr = Point.new(hw - x, hh - y[x])
            Canvas.line(prev.x, prev.y, curr.x, curr.y, Color.white)
            prev = Point.new(curr.x, curr.y)
        }
    }
}


-V MAX = 12

[Char] sp
V count = [0] * MAX
V pos = 0

F factSum(n)
   V s = 0
   V x = 0
   V f = 1
   L x < n
      f *= ++x
      s += f
   R s

F r(n)
   I n == 0
      R 0B
   V c = :sp[:pos - n]
   I --:count[n] == 0
      :count[n] = n
      I !r(n - 1)
         R 0B
   :sp[:pos++] = c
   R 1B

F superPerm(n)
   :pos = n
   V len = factSum(n)
   I len > 0
      :sp = [Char("\0")] * len
   L(i) 0 .. n
      :count[i] = i
   L(i) 1 .. n
      :sp[i - 1] = Char(code' ‘0’.code + i)
   L r(n) {}

L(n) 0 .< MAX
   superPerm(n)
   print(‘superPerm(#2) len = #.’.format(n, sp.len))


def  X0=640/2, Y0=480/2, Scale=25.0, N=2.5;
real X, Y;  int IX, IY;

proc OctPoint; [
Point(X0+IX, Y0-IY, $F);
Point(X0-IX, Y0-IY, $F);
Point(X0+IX, Y0+IY, $F);
Point(X0-IX, Y0+IY, $F);
Point(X0+IY, Y0-IX, $F);
Point(X0-IY, Y0-IX, $F);
Point(X0+IY, Y0+IX, $F);
Point(X0-IY, Y0+IX, $F);
];

[SetVid($101);  \VESA graphics 640x480x8
IX:= 0;
repeat  X:= float(IX)/Scale;
        Y:= Pow(200.0 - Pow(X,N), 1.0/N);
        IY:= fix(Y*Scale);
        OctPoint;
        IX:= IX+1;
until   IX >= IY;
]


open window 700, 600
backcolor 0,0,0
clear window

a=200
b=200
n=2.5
na=2/n
t=.01
color 0,0,255
for i = 0 to 314
    xp=a*sig(cos(t))*abs((cos(t)))^na+350
    yp=b*sig(sin(t))*abs((sin(t)))^na+275
    t=t+.02
    line to xp, yp
next i


fcn superEllipse(plot,n,color=0xff0000){ // we'll assume width <= height
   a,p:=(plot.w/2).toFloat(), 1.0/n;  // just calculate upper right quadrant
   foreach x in ([0.0 .. a]){
      y:=(a.pow(n) - x.pow(n)).pow(p);  // a==b>0 --> y=(a^n - x^n)^(1/n)
      //println( (x/a).abs().pow(n) + (y/b).abs().pow(n) );  // sanity check
      plot[x,y]=plot[-x,-y]=plot[-x,y]=plot[x,-y]=color;  // all 4 quadrants
   }
   plot
}


# syntax: GAWK -f SUPERPERMUTATION_MINIMISATION.AWK
# converted from C
BEGIN {
    arr[0] # prevents fatal: attempt to use scalar 'arr' as an array
    limit = 11
    for (n=0; n<=limit; n++) {
      leng = super_perm(n)
      printf("%2d %d ",n,leng)
#     for (i=0; i<length(arr); i++) { printf(arr[i]) } # un-comment to see the string
      printf("\n")
    }
    exit(0)
}
function fact_sum(n,  f,s,x) {
    f = 1
    s = x = 0
    for (;x<n;) {
      f *= ++x
      s += f
    }
    return(s)
}
function super_perm(n,  i,leng) {
    delete arr
    pos = n
    leng = fact_sum(n)
    for (i=0; i<leng; i++) {
      arr[i] = ""
    }
    for (i=0; i<=n; i++) {
      cnt[i] = i
    }
    for (i=1; i<=n; i++) {
      arr[i-1] = i + "0"
    }
    while (r(n)) { }
    return(leng)
}
function r(n,  c) {
    if (!n) { return(0) }
    c = arr[pos-n]
    if (!--cnt[n]) {
      cnt[n] = n
      if (!r(n-1)) { return(0) }
    }
    arr[pos++] = c
    return(1)
}


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

#define MAX 12
char *super = 0;
int pos, cnt[MAX];

// 1! + 2! + ... + n!
int fact_sum(int n)
{
	int s, x, f;
	for (s = 0, x = 0, f = 1; x < n; f *= ++x, s += f);
	return s;
}

int r(int n)
{
	if (!n) return 0;

	char c = super[pos - n];
	if (!--cnt[n]) {
		cnt[n] = n;
		if (!r(n-1)) return 0;
	}
	super[pos++] = c;
	return 1;
}

void superperm(int n)
{
	int i, len;

	pos = n;
	len = fact_sum(n);
	super = realloc(super, len + 1);
	super[len] = '\0';

	for (i = 0; i <= n; i++) cnt[i] = i;
	for (i = 1; i <= n; i++) super[i - 1] = i + '0';

	while (r(n));
}

int main(void)
{
	int n;
	for (n = 0; n < MAX; n++) {
		printf("superperm(%2d) ", n);
		superperm(n);
		printf("len = %d", (int)strlen(super));
		// uncomment next line to see the string itself
		// printf(": %s", super);
		putchar('\n');
	}

	return 0;
}


#include <array>
#include <iostream>
#include <vector>

constexpr int MAX = 12;

static std::vector<char> sp;
static std::array<int, MAX> count;
static int pos = 0;

int factSum(int n) {
    int s = 0;
    int x = 0;
    int f = 1;
    while (x < n) {
        f *= ++x;
        s += f;
    }
    return s;
}

bool r(int n) {
    if (n == 0) {
        return false;
    }
    char c = sp[pos - n];
    if (--count[n] == 0) {
        count[n] = n;
        if (!r(n - 1)) {
            return false;
        }
    }
    sp[pos++] = c;
    return true;
}

void superPerm(int n) {
    pos = n;
    int len = factSum(n);
    if (len > 0) {
        sp.resize(len);
    }
    for (size_t i = 0; i <= n; i++) {
        count[i] = i;
    }
    for (size_t i = 1; i <= n; i++) {
        sp[i - 1] = '0' + i;
    }
    while (r(n)) {}
}

int main() {
    for (size_t n = 0; n < MAX; n++) {
        superPerm(n);
        std::cout << "superPerm(" << n << ") len = " << sp.size() << '\n';
    }

    return 0;
}


import std.stdio, std.ascii, std.algorithm, core.memory, permutations2;

/** Uses greedy algorithm of adding another char (or two, or three, ...)
until an unseen perm is formed in the last n chars. */
string superpermutation(in uint n) nothrow
in {
    assert(n > 0 && n < uppercase.length);
} out(result) {
    // It's a superpermutation.
    assert(uppercase[0 .. n].dup.permutations.all!(p => result.canFind(p)));
} body {
    string result = uppercase[0 .. n];

    bool[const char[]] toFind;
    GC.disable;
    foreach (const perm; result.dup.permutations)
        toFind[perm] = true;
    GC.enable;
    toFind.remove(result);

    auto trialPerm = new char[n];
    auto auxAdd = new char[n];

    while (toFind.length) {
        MIDDLE: foreach (immutable skip; 1 .. n) {
            auxAdd[0 .. skip] = result[$ - n .. $ - n + skip];
            foreach (const trialAdd; auxAdd[0 .. skip].permutations!false) {
                trialPerm[0 .. n - skip] = result[$ + skip - n .. $];
                trialPerm[n - skip .. $] = trialAdd[];
                if (trialPerm in toFind) {
                    result ~= trialAdd;
                    toFind.remove(trialPerm);
                    break MIDDLE;
                }
            }
        }
    }

    return result;
}

void main() {
    foreach (immutable n; 1 .. 8)
        n.superpermutation.length.writeln;
}


program Superpermutation_minimisation;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

const
  Max = 12;

var
  super: ansistring;
  pos: Integer;
  cnt: TArray<Integer>;

function factSum(n: Integer): Uint64;
begin
  var s: Uint64 := 0;
  var f := 1;
  var x := 0;

  while x < n do
  begin
    inc(x);
    f := f * x;
    inc(s, f);
  end;

  Result := s;
end;

function r(n: Integer): Boolean;
begin
  if n = 0 then
    exit(false);

  var c := super[pos - n];

  dec(cnt[n]);

  if cnt[n] = 0 then
  begin
    cnt[n] := n;
    if not r(n - 1) then
      exit(false);
  end;
  super[pos] := c;
  inc(pos);
  result := true;
end;

procedure SuperPerm(n: Integer);
begin
  var pos := n;
  var le: Uint64 := factSum(n);
  SetLength(super, le);

  for var i := 0 to n do
    cnt[i] := i;

  for var i := 1 to n do
    super[i] := ansichar(i + ord('0'));

  while r(n) do
    ;
end;

begin
  SetLength(cnt, max);

  for var n := 0 to max - 1 do
  begin
    write('superperm(', n: 2, ') ');
    SuperPerm(n);
    writeln('len = ', length(super));
  end;
  {$IFNDEF UNIX}   readln; {$ENDIF}
end.


defmodule Superpermutation do
  def minimisation(1), do: [1]
  def minimisation(n) do
    Enum.chunk(minimisation(n-1), n-1, 1)
    |> Enum.reduce({[],nil}, fn sub,{acc,last} ->
      if Enum.uniq(sub) == sub do
        i = if acc==[], do: 0, else: Enum.find_index(sub, &(&1==last)) + 1
        {acc ++ (Enum.drop(sub,i) ++ [n] ++ sub), List.last(sub)}
      else
        {acc, last}
      end
    end)
    |> elem(0)
  end
end

to_s = fn list -> Enum.map_join(list, &Integer.to_string(&1,16)) end
Enum.each(1..8, fn n ->
  result = Superpermutation.minimisation(n)
  :io.format "~3w: len =~8w : ", [n, length(result)]
  IO.puts if n<5, do: Enum.join(result),
                else: to_s.(Enum.take(result,20)) <> "...." <> to_s.(Enum.slice(result,-20..-1))
end)


' version 28-06-2018
' compile with: fbc -s console

Function superpermsize(n As UInteger) As UInteger

    Dim As UInteger x, y, sum, fac
    For x = 1 To n
        fac = 1
        For y = 1 To x
            fac *= y
        Next
        sum += fac
    Next

    Function = sum

End Function

Function superperm(n As UInteger) As String

    If n = 1 Then Return "1"

    Dim As String sup_perm = "1", insert
    Dim As String p, q()
    Dim As UInteger a, b, i, l, x

    For x = 2 To n
        insert = IIf(x < 10, Str(x), Chr(x + 55))
        l = Len(sup_perm)
        If l > 1 Then l = Len(sup_perm) - x +2
        ReDim q(l)
        For i = 1 To l
            p = Mid(sup_perm, i, x -1)
            If x > 2 Then
            For a = 0 To Len(p) -2
                For b = a+1 To Len(p) -1
                    If p[a] = p[b] Then Continue For, For, For
                Next
            Next
            End If
            q(i) = p + insert + p
        Next
        sup_perm = q(1)
        For i = 2 To UBound(q)
            a = x -1
            Do
                If Right(sup_perm, a) = Left(q(i), a) Then
                    sup_perm += Mid(q(i), a +1)
                    Exit Do
                End If
                a -= 1
            Loop
        Next
    Next

    Function = sup_perm

End Function

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

Dim As String superpermutation
Dim As UInteger n

For n = 1 To 10
    superpermutation = superperm(n)
    Print Using "### ######## ########   "; n; superpermsize(n); Len(superpermutation);
    If n < 5 Then
        Print superpermutation
    Else
        Print
    End If
Next

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


package main

import "fmt"

const max = 12

var (
    super []byte
    pos   int
    cnt   [max]int
)

// 1! + 2! + ... + n!
func factSum(n int) int {
    s := 0
    for x, f := 0, 1; x < n; {
        x++
        f *= x
        s += f
    }
    return s
}

func r(n int) bool {
    if n == 0 {
        return false
    }
    c := super[pos-n]
    cnt[n]--
    if cnt[n] == 0 {
        cnt[n] = n
        if !r(n - 1) {
            return false
        }
    }
    super[pos] = c
    pos++
    return true
}

func superperm(n int) {
    pos = n
    le := factSum(n)
    super = make([]byte, le)
    for i := 0; i <= n; i++ {
        cnt[i] = i
    }
    for i := 1; i <= n; i++ {
        super[i-1] = byte(i) + '0'
    }

    for r(n) {
    }
}

func main() {
    for n := 0; n < max; n++ {
        fmt.Printf("superperm(%2d) ", n)
        superperm(n)
        fmt.Printf("len = %d\n", len(super))
    }
}


import static java.util.stream.IntStream.rangeClosed

class Superpermutation {
    final static int nMax = 12

    static char[] superperm
    static int pos
    static int[] count = new int[nMax]

    static int factSum(int n) {
        return rangeClosed(1, n)
            .map({ m -> rangeClosed(1, m).reduce(1, { a, b -> a * b }) }).sum()
    }

    static boolean r(int n) {
        if (n == 0) {
            return false
        }

        char c = superperm[pos - n]
        if (--count[n] == 0) {
            count[n] = n
            if (!r(n - 1)) {
                return false
            }
        }
        superperm[pos++] = c
        return true
    }

    static void superPerm(int n) {
        String chars = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

        pos = n
        superperm = new char[factSum(n)]

        for (int i = 0; i < n + 1; i++) {
            count[i] = i
        }
        for (int i = 1; i < n + 1; i++) {
            superperm[i - 1] = chars.charAt(i)
        }

        while (r(n)) {
        }
    }

    static void main(String[] args) {
        for (int n = 0; n < nMax; n++) {
            superPerm(n)
            printf("superPerm(%2d) len = %d", n, superperm.length)
            println()
        }
    }
}


approxmin=:3 :0
  seqs=. y{~(A.&i.~ !)#y
  r=.{.seqs
  seqs=.}.seqs
  while.#seqs do.
    for_n. i.-#y do.
      tail=. (-n){. r
      b=. tail -:"1 n{."1 seqs
      if. 1 e.b do.
        j=. b i.1
        r=. r, n}.j{seqs
        seqs=. (<<<j) { seqs
        break.
      end.
    end.
  end.
  r
)


import static java.util.stream.IntStream.rangeClosed;

public class Test {
    final static int nMax = 12;

    static char[] superperm;
    static int pos;
    static int[] count = new int[nMax];

    static int factSum(int n) {
        return rangeClosed(1, n)
                .map(m -> rangeClosed(1, m).reduce(1, (a, b) -> a * b)).sum();
    }

    static boolean r(int n) {
        if (n == 0)
            return false;

        char c = superperm[pos - n];
        if (--count[n] == 0) {
            count[n] = n;
            if (!r(n - 1))
                return false;
        }
        superperm[pos++] = c;
        return true;
    }

    static void superPerm(int n) {
        String chars = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";

        pos = n;
        superperm = new char[factSum(n)];

        for (int i = 0; i < n + 1; i++)
            count[i] = i;
        for (int i = 1; i < n + 1; i++)
            superperm[i - 1] = chars.charAt(i);

        while (r(n)) {
        }
    }

    public static void main(String[] args) {
        for (int n = 0; n < nMax; n++) {
            superPerm(n);
            System.out.printf("superPerm(%2d) len = %d", n, superperm.length);
            System.out.println();
        }
    }
}


const nmax = 12

function r!(n, s, pos, count)
    if n == 0
        return false
    end
    c = s[pos + 1 - n]
    count[n + 1] -= 1
    if count[n + 1] == 0
        count[n + 1] = n
        if r!(n - 1, s, pos, count) == 0
            return false
        end
    end
    s[pos + 1] = c
    pos += 1
    true
end

function superpermutation(n)
    count = zeros(nmax)
    pos = n
    superperm = zeros(UInt8, n < 2 ? n : mapreduce(factorial, +, 1:n))
    for i in 0:n-1
        count[i + 1] = i
        superperm[i + 1] = Char(i + '0')
    end
    count[n + 1] = n
    while r!(n, superperm, pos, count) ; end
    superperm
end

function testsuper(N, verbose=false)
    for i in 0:N-1
        s = superpermutation(i)
        println("Superperm($i) has length $(length(s)) ", (verbose ? String(s) : ""))
    end
end

testsuper(nmax)


// version 1.1.2

const val MAX = 12

var sp = CharArray(0)
val count = IntArray(MAX)
var pos = 0

fun factSum(n: Int): Int {
    var s = 0
    var x = 0
    var f = 1
    while (x < n) {
        f *= ++x
        s += f
    }
    return s
}

fun r(n: Int): Boolean {
    if (n == 0) return false
    val c = sp[pos - n]
    if (--count[n] == 0) {
        count[n] = n
        if (!r(n - 1)) return false
    }
    sp[pos++] = c
    return true
}

fun superPerm(n: Int) {
    pos = n
    val len = factSum(n)
    if (len > 0) sp = CharArray(len)
    for (i in 0..n) count[i] = i
    for (i in 1..n) sp[i - 1] = '0' + i
    while (r(n)) {}
}

fun main(args: Array<String>) {
    for (n in 0 until MAX) {
        superPerm(n)
        println("superPerm(${"%2d".format(n)}) len = ${sp.size}")
    }
}


ClearAll[OverlapDistance, ConstructDistances]
OverlapDistance[{s1_List, s2_List}] := OverlapDistance[s1, s2]
OverlapDistance[s1_List, s2_List] := Module[{overlaprange, overlap, l},
  overlaprange = {Min[Length[s1], Length[s2]], 0};
  l = LengthWhile[Range[Sequence @@ overlaprange, -1], Take[s1, -#] =!= Take[s2, #] &];
  overlap = overlaprange[[1]] - l;
  <|"Overlap" -> overlap, "Distance" -> Length[s2] - overlap|>
  ]
ConstructDistances[perms_List] := Module[{sel, OD, fullseq},
  OD = BlockMap[OverlapDistance, perms, 2, 1];
  fullseq =
   Fold[Join[#1, Drop[#2[[2]], #2[[1]]["Overlap"]]] &,
    First[perms], {OD, Rest[perms]} // Transpose];
  fullseq
  ]
Dynamic[Length[perms]]
Do[
 n = i;
 perms = Permutations[Range[n]];
 {start, perms} = TakeDrop[perms, 1];
 While[Length[perms] > 0,
  last = Last[start];
  dists =
   Table[<|"Index" -> i, OverlapDistance[last, perms[[i]]]|>, {i,
     Length[perms]}];
  sel = First[TakeSmallestBy[dists, #["Distance"] &, 1]];
  AppendTo[start, perms[[sel["Index"]]]];
  perms = Delete[perms, sel["Index"]];
  ];
 Print[{n, [email protected][start]}]
 ,
 {i, 1, 7}
]


import strformat

const MAX = 12

var super: seq[char] = @[]
var pos: int
var cnt: array[MAX, int]

proc factSum(n: int): int =
  var s, x = 0
  var f = 1
  while x < n:
    inc x
    f *= x
    inc s, f
  s

proc r(n: int): bool =
  if n == 0:
    return false
  var c = super[pos - n]
  dec cnt[n]
  if cnt[n] == 0:
    cnt[n] = n
    if not r(n - 1):
      return false
  super[pos] = c
  inc pos
  true

proc superperm(n: int) =
  pos = n
  var le = factSum(n)
  super.setLen(le)
  for i in 0..n:
    cnt[i] = i
  for i in 1..n:
    super[i-1] = char(i + ord('0'))
  while r(n):
    discard
for n in 0..<MAX:
  write(stdout, fmt"superperm({n:2})")
  superperm(n)
  writeLine(stdout, fmt" len = {len(super)}")


class SuperPermutation {
  @super : static : Char[];
  @pos : static : Int;
  @cnt : static : Int[];

  function : Main(args : String[]) ~ Nil {
    max := 12;
    @cnt := Int->New[max];
    @super := Char->New[0];

    for(n := 0; n < max; n += 1;) {
      "superperm({$n}) "->Print();
      SuperPerm(n);
      len := @super->Size() - 1;
      "len = {$len}"->PrintLine();
    };
  }

  function : native : FactSum(n : Int) ~ Int {
    s := 0; x := 0; f := 1;
    while(x < n) {
      f *= ++x; s += f;
    };
    return s;
  }

  function : native : R(n : Int) ~ Bool {
    if(n = 0) {
      return false;
     };

    c := @super[@pos - n];
    if(--@cnt[n] = 0) {
      @cnt[n] := n;
      if(<>R(n - 1)) {
        return false;
      };
    };
    @super[@pos++] := c;

    return true;
  }

  function : SuperPerm(n : Int) ~ Nil {
    @pos := n;
    len := FactSum(n);

    tmp := Char->New[len + 1];
    Runtime->Copy(tmp, 0, @super, 0, @super->Size());
    @super := tmp;

    for(i := 0; i <= n; i += 1;) {
      @cnt[i] := i;
    };

    for(i := 1; i <= n; i += 1;) {
      @super[i - 1] := i + '0';
    };

    do {
      r := R(n);
    }
    while(r);
  }
}


use ntheory qw/forperm/;
for my $len (1..8) {
  my($pre, $post, $t) = ("","");
  forperm {
    $t = join "",@_;
    $post .= $t      unless index($post ,$t) >= 0;
    $pre = $t . $pre unless index($pre, $t) >= 0;
  } $len;
  printf "%2d: %8d %8d\n", $len, length($pre), length($post);
}


with javascript_semantics
constant nMax = iff(platform()=JS?8:12)
-- Aside: on desktop/Phix, strings can be modified in situ, whereas
--        JavaScript strings are immutable, and the equivalent code
--        in p2js.js ends up doing excessive splitting and splicing
--        hence nMax has to be significantly smaller in a browser.

atom t0 = time()
string superperm
sequence count
integer pos

function factSum(int n)
    integer s = 0, f = 1
    for i=1 to n do
        f *= i
        s += f
    end for
    return s
end function

function r(int n)
    if (n == 0) then return false end if
    integer c = superperm[pos-n+1]
    count[n] -= 1
    if count[n]=0 then
        count[n] = n
        if not r(n-1) then return false end if
    end if
    pos += 1
    superperm[pos] = c
    return true
end function

procedure superPerm(int n)
    string chars = "123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"[1..n]
    pos = n
    superperm = chars&repeat(' ',factSum(n)-n)
    count = tagset(n)
    while r(n) do end while
    if n=0 then
        if superperm!="" then ?9/0 end if
    elsif n<=7 then
        -- (I estimate it would take at least 5 days to validate
        --  superPerm(12), feel free to try it on your own time)
        for i=1 to factorial(n) do
            if not match(permute(i,chars),superperm) then ?9/0 end if
        end for
    end if
end procedure

for n=0 to nMax do
    superPerm(n)
    integer l = length(superperm)
    if l>40 then superperm[20..-20] = "..." end if
    string e = elapsed(time()-t0)
    printf(1,"superPerm(%2d) len = %d  %s (%s)\n", {n, l, superperm, e})
end for


EnableExplicit
#MAX=10
Declare.i fact_sum(n.i) : Declare.i r(n.i) : Declare superperm(n.i)
Global pos.i, Dim cnt.i(#MAX), Dim super.s{1}(fact_sum(#MAX))

If OpenConsole() ;- MAIN: Superpermutation_minimisation
  Define.i n
  For n=0 To #MAX
    superperm(n) : Print("superperm("+RSet(Str(n),2)+") len = "+LSet(Str(pos),10))
    If n<=4      : Print(~"\t"+PeekS(@super(),pos)) : EndIf
    PrintN("")
  Next
  Input()
EndIf
End ;- END: Superpermutation_minimisation

Procedure.i fact_sum(n.i)
  Define.i s=0,f=1,x=0
  While x<n : x+1 : f*x : s+f : Wend
  ProcedureReturn s
EndProcedure

Procedure.i r(n.i)
  If Not n             : ProcedureReturn 0 : EndIf
  Define c.s{1}=super(pos-n)
  cnt(n)-1
  If Not cnt(n)
    cnt(n)=n
    If Not r(n-1)      : ProcedureReturn 0 : EndIf
  EndIf
  super(pos)=c : pos+1 : ProcedureReturn 1
EndProcedure

Procedure superperm(n.i)
  pos=n
  Define.i len=fact_sum(n),i
  For i=0 To n : cnt(i)=i              : Next
  For i=1 To n : super(i-1)=Chr('0'+i) : Next
  While r(n)   : Wend
EndProcedure


"Generate a short Superpermutation of n characters A... as a string using various algorithms."

from __future__ import print_function, division

from itertools import permutations
from math import factorial
import string
import datetime
import gc

MAXN = 7

def s_perm0(n):
    """
    Uses greedy algorithm of adding another char (or two, or three, ...)
    until an unseen perm is formed in the last n chars
    """
    allchars = string.ascii_uppercase[:n]
    allperms = [''.join(p) for p in permutations(allchars)]
    sp, tofind = allperms[0], set(allperms[1:])
    while tofind:
        for skip in range(1, n):
            for trial_add in (''.join(p) for p in permutations(sp[-n:][:skip])):
                #print(sp, skip, trial_add)
                trial_perm = (sp + trial_add)[-n:]
                if trial_perm in tofind:
                    #print(sp, skip, trial_add)
                    sp += trial_add
                    tofind.discard(trial_perm)
                    trial_add = None    # Sentinel
                    break
            if trial_add is None:
                break
    assert all(perm in sp for perm in allperms) # Check it is a superpermutation
    return sp

def s_perm1(n):
    """
    Uses algorithm of concatenating all perms in order if not already part
    of concatenation.
    """
    allchars = string.ascii_uppercase[:n]
    allperms = [''.join(p) for p in sorted(permutations(allchars))]
    perms, sp = allperms[::], ''
    while perms:
        nxt = perms.pop()
        if nxt not in sp:
            sp += nxt
    assert all(perm in sp for perm in allperms)
    return sp

def s_perm2(n):
    """
    Uses algorithm of concatenating all perms in order first-last-nextfirst-
    nextlast... if not already part of concatenation.
    """
    allchars = string.ascii_uppercase[:n]
    allperms = [''.join(p) for p in sorted(permutations(allchars))]
    perms, sp = allperms[::], ''
    while perms:
        nxt = perms.pop(0)
        if nxt not in sp:
            sp += nxt
        if perms:
            nxt = perms.pop(-1)
            if nxt not in sp:
                sp += nxt
    assert all(perm in sp for perm in allperms)
    return sp

def _s_perm3(n, cmp):
    """
    Uses algorithm of concatenating all perms in order first,
    next_with_LEASTorMOST_chars_in_same_position_as_last_n_chars, ...
    """
    allchars = string.ascii_uppercase[:n]
    allperms = [''.join(p) for p in sorted(permutations(allchars))]
    perms, sp = allperms[::], ''
    while perms:
        lastn = sp[-n:]
        nxt = cmp(perms,
                  key=lambda pm:
                    sum((ch1 == ch2) for ch1, ch2 in zip(pm, lastn)))
        perms.remove(nxt)
        if nxt not in sp:
            sp += nxt
    assert all(perm in sp for perm in allperms)
    return sp

def s_perm3_max(n):
    """
    Uses algorithm of concatenating all perms in order first,
    next_with_MOST_chars_in_same_position_as_last_n_chars, ...
    """
    return _s_perm3(n, max)

def s_perm3_min(n):
    """
    Uses algorithm of concatenating all perms in order first,
    next_with_LEAST_chars_in_same_position_as_last_n_chars, ...
    """
    return _s_perm3(n, min)

longest = [factorial(n) * n for n in range(MAXN + 1)]
weight, runtime = {}, {}
print(__doc__)
for algo in [s_perm0, s_perm1, s_perm2, s_perm3_max, s_perm3_min]:
    print('\n###\n### %s\n###' % algo.__name__)
    print(algo.__doc__)
    weight[algo.__name__], runtime[algo.__name__] = 1, datetime.timedelta(0)
    for n in range(1, MAXN + 1):
        gc.collect()
        gc.disable()
        t = datetime.datetime.now()
        sp = algo(n)
        t = datetime.datetime.now() - t
        gc.enable()
        runtime[algo.__name__] += t
        lensp = len(sp)
        wt = (lensp / longest[n]) ** 2
        print('  For N=%i: SP length %5i Max: %5i Weight: %5.2f'
              % (n, lensp, longest[n], wt))
        weight[algo.__name__] *= wt
    weight[algo.__name__] **= 1 / n  # Geometric mean
    weight[algo.__name__] = 1 / weight[algo.__name__]
    print('%*s Overall Weight: %5.2f in %.1f seconds.'
          % (29, '', weight[algo.__name__], runtime[algo.__name__].total_seconds()))

print('\n###\n### Algorithms ordered by shortest superpermutations first\n###')
print('\n'.join('%12s (%.3f)' % kv for kv in
                sorted(weight.items(), key=lambda keyvalue: -keyvalue[1])))

print('\n###\n### Algorithms ordered by shortest runtime first\n###')
print('\n'.join('%12s (%.3f)' % (k, v.total_seconds()) for k, v in
                sorted(runtime.items(), key=lambda keyvalue: keyvalue[1])))


#lang racket/base
(require racket/list racket/format)

(define (index-of1 x l) (for/first ((i (in-naturals 1)) (m (in-list l)) #:when (equal? m x)) i))

(define (sprprm n)
  (define n-1 (- n 1))
  (define sp:n-1 (superperm n-1))
  (let loop ((subs (let loop ((sp sp:n-1) (i (- (length sp:n-1) n-1 -1)) (rv null))
                     (cond
                       [(zero? i) (reverse rv)]
                       [else
                        (define sub (take sp n-1))
                        (loop (cdr sp)
                              (- i 1)
                              (if (check-duplicates sub) rv (cons sub rv)))])))
             (ary null))
    (if (null? subs)
        ary
        (let ((sub (car subs)))
          (define i (if (null? ary) 0 (index-of1 (last ary) sub)))
          (loop (cdr subs) (append ary (drop sub i) (list n) sub))))))

(define superperm
  (let ((hsh (make-hash (list (cons 1 (list 1))))))
    (lambda (n) (hash-ref! hsh n (lambda () (sprprm n))))))

(define (20..20 ary)
  (if (< (length ary) 41) ary (append (take ary 20) (cons '.. (take-right ary 20)))))

(for* ((n (in-range 1 (add1 8))) (ary (in-value (superperm n))))
  (printf "~a: len = ~a : ~a~%" (~a n #:width 3) (~a (length ary) #:width 8) (20..20 ary)))


for 1..8 -> $len {
  my $pre = my $post = my $t = '';
  for  ('a'..'z')[^$len].permutations -> @p {
     $t = @p.join('');
     $post ~= $t        unless index($post, $t);
     $pre   = $t ~ $pre unless index($pre,  $t);
  }
  printf "%1d: %8d %8d\n", $len, $pre.chars, $post.chars;
}


/*REXX program attempts  to find better  minimizations  for computing superpermutations.*/
parse arg cycles .                               /*obtain optional arguments from the CL*/
if cycles=='' | cycles==","  then cycles= 7      /*Not specified?  Then use the default.*/

      do n=0  to  cycles
      #= 0;                           $.=        /*populate the first permutation.      */
              do pop=1  for n;        @.pop= d2x(pop);        $.0= $.0  ||  @.pop
              end  /*pop*/

              do  while aPerm(n, 0)
              if n\==0  then #= #+1;  $.#=
                do j=1  for n;        $.#= $.#  ||  @.j
                end   /*j*/
              end     /*while*/
      z= $.0
      nm= n-1
              do p=1  for #;      if $.j==''          then iterate
                                  if pos($.p, z)\==0  then iterate
              parse  var   $.p    h  2  R  1  L  =(n)
              if  left(z, nm)==R  then do;    z= h  ||  z;    iterate;   end
              if right(z,  1)==h  then do;    z= z  ||  R;    iterate;   end
              z= z  ||  $.p
              end   /*p*/                        /* [↑]  more IFs could be added for opt*/

       L= commas( length(z) )
       say 'length of superpermutation('n") ="      right(L, max(length(L), cycles+2) )
       end   /*cycle*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: parse arg ?;  do jc=length(?)-3  to 1  by -3; ?=insert(',', ?, jc); end;  return ?
/*──────────────────────────────────────────────────────────────────────────────────────*/
aPerm: procedure expose @.;    parse arg n,i;      nm= n - 1;      if n==0  then return 0
          do k=nm  by -1  for nm; kp=k+1; if @.k<@.kp  then do; i=k; leave; end; end /*k*/
          do j=i+1  while  j<n;  parse value  @.j @.n  with  @.n @.j;    n= n-1; end /*j*/
       if i==0  then return 0
          do m=i+1  while @.m<@.i; end /*m*/;    parse value  @.m  @.i   with   @.i  @.m
       return 1


#A straight forward implementation of N. Johnston's algorithm. I prefer to look at this as 2n+1 where
#the second n is first n reversed, and the 1 is always the second symbol. This algorithm will generate
#just the left half of the result by setting l to [1,2] and looping from 3 to 6. For the purpose of
#this task I am going to start from an empty array and generate the whole strings using just the
#rules.
#
#Nigel Galloway: December 16th., 2014
#
l = []
(1..6).each{|e|
  a, i = [], e-2
  (0..l.length-e+1).each{|g|
     if not (n = l[g..g+e-2]).uniq!
       a.concat(n[(a[0]? i : 0)..-1]).push(e).concat(n)
       i = e-2
     else
       i -= 1
     end
   }
   a.each{|n| print n}; puts "\n\n"
   l = a
}


object SuperpermutationMinimisation extends App {
  val nMax = 12

  @annotation.tailrec
  def factorial(number: Int, acc: Long = 1): Long =
    if (number == 0) acc else factorial(number - 1, acc * number)

  def factSum(n: Int): Long = (1 to n).map(factorial(_)).sum

  for (n <- 0 until nMax) println(f"superPerm($n%2d) len = ${factSum(n)}%d")

}


for len in (1..8) {
    var (pre="", post="")
    @^len -> permutations {|*p|
        var t = p.join
        post.append!(t) if !post.contains(t)
        pre.prepend!(t) if !pre.contains(t)
    }
    printf("%2d: %8d %8d\n", len, pre.len, post.len)
}


import "/fmt" for Fmt

var max = 12
var sp = []
var count = List.filled(max, 0)
var pos = 0

var factSum = Fn.new { |n|
    var s = 0
    var x = 0
    var f = 1
    while (x < n) {
        x = x + 1
        f = f * x
        s = s + f
    }
    return s
}

var r // recursive
r = Fn.new { |n|
    if (n == 0) return false
    var c = sp[pos - n]
    count[n] = count[n] - 1
    if (count[n] == 0) {
        count[n] = n
        if (!r.call(n - 1)) return false
    }
    sp[pos] = c
    pos = pos + 1
    return true
}

var superPerm = Fn.new { |n|
    pos = n
    var len = factSum.call(n)
    if (len > 0) sp = List.filled(len, "\0")
    for (i in 0..n) count[i] = i
    if (n > 0) {
        for (i in 1..n) sp[i - 1] = String.fromByte(48 + i)
    }
    while (r.call(n)) {}
}

for (n in 0...max) {
    superPerm.call(n)
    Fmt.print("superPerm($2d) len = $d", n, sp.count)
}


const MAX = 12;
var super=Data(), pos, cnt;  // global state, ick

fcn fact_sum(n){ // -->1! + 2! + ... + n!
   [1..n].reduce(fcn(s,n){ s + [2..n].reduce('*,1) },0)
}

fcn r(n){
   if (not n) return(0);

   c := super[pos - n];
   if (not (cnt[n]-=1)){
      cnt[n] = n;
      if (not r(n-1)) return(0);
   }
   super[pos] = c; pos+=1;
   1
}

fcn superperm(n){
   pos = n;
   len := fact_sum(n);
   super.fill(0,len);  // this is pretty close to recalloc()

   cnt = (n+1).pump(List()); //-->(0,1,2,3,..n)
   foreach i in (n){ super[i] = i + 0x31; } //-->"1" ... "123456789:;"
   while (r(n)){}
}

foreach n in (MAX){
   superperm(n);
   print("superperm(%2d) len = %d".fmt(n,super.len()));
   // uncomment next line to see the string itself
   //print(": %s".fmt(super.text));
   println();
}


F is_prime(a)
   I a == 2
      R 1B
   I a < 2 | a % 2 == 0
      R 0B
   L(i) (3 .. Int(sqrt(a))).step(2)
      I a % i == 0
         R 0B
   R 1B

print(‘index  prime  prime sum’)
V s = 0
V idx = 0
L(n) 2..999
   I is_prime(n)
      idx++
      s += n
      I is_prime(s)
         print(f:‘{idx:3}   {n:5}   {s:7}’)


BEGIN # sum the primes below n and report the sums that are prime             #
    # sieve the primes to 999 #
    PR read "primes.incl.a68" PR
    []BOOL prime = PRIMESIEVE 999;
    # sum the primes and test the sum                                         #
    INT prime sum       := 0;
    INT prime count     := 0;
    INT prime sum count := 0;
    print( ( "prime         prime", newline ) );
    print( ( "count  prime    sum", newline ) );
    FOR i TO UPB prime DO
        IF prime[ i ] THEN
            # have another prime                                              #
            prime count  +:= 1;
            prime sum    +:= i;
            # check whether the prime sum is prime or not                     #
            BOOL is prime := TRUE;
            FOR p TO i OVER 2 WHILE is prime DO
                IF prime[ p ] THEN is prime := prime sum MOD p /= 0 FI
            OD;
            IF is prime THEN
                # the prime sum is also prime                                 #
                prime sum count +:= 1;
                print( ( whole( prime count, -5 )
                       , " "
                       , whole( i,           -6 )
                       , " "
                       , whole( prime sum,   -6 )
                       , newline
                       )
                     )
            FI
        FI
    OD;
    print( ( newline
           , "Found "
           , whole( prime sum count, 0 )
           , " prime sums of primes below "
           , whole( UPB prime + 1, 0 )
           , newline
           )
         )
END


begin % sum the primes below n and report the sums that are prime             %
    integer MAX_NUMBER;
    MAX_NUMBER := 999;
    begin
        logical array prime( 1 :: MAX_NUMBER );
        integer       primeCount, primeSum, primeSumCount;
        % sieve the primes to MAX_NUMBER                                      %
        prime( 1 ) := false; prime( 2 ) := true;
        for i := 3 step 2 until MAX_NUMBER do prime( i ) := true;
        for i := 4 step 2 until MAX_NUMBER do prime( i ) := false;
        for i := 3 step 2 until truncate( sqrt( MAX_NUMBER ) ) do begin
            integer ii; ii := i + i;
            if prime( i ) then begin
                for p := i * i step ii until MAX_NUMBER do prime( p ) := false
            end if_prime_i
        end for_i ;
        % find the prime sums that are prime                                  %
        primeCount := primeSum := primeSumCount := 0;
        write( "prime  prime" );
        write( "count    sum" );
        for i := 1 until MAX_NUMBER do begin
            if prime( i ) then begin
                % have another prime                                          %
                logical isPrime;
                primeSum   := primeSum + i;
                primeCount := primeCount + 1;
                % check whether the prime sum is also prime                   %
                isPrime := true;
                for p := 1 until i div 2 do begin
                    if prime( p ) then begin
                        isPrime := primeSum rem p not = 0;
                        if not isPrime then goto endPrimeCheck
                    end if_prime_p
                end for_p ;
endPrimeCheck:
                if isPrime then begin
                    % the prime sum is also prime                             %
                    primeSumCount := primeSumCount + 1;
                    write( i_w := 5, s_w := 0
                         , primeCount
                         , " "
                         , i_w := 6
                         , primeSum
                         )
                end if_isPrime
            end if_prime_i
        end for_i ;
        write();
        write( i_w := 1, s_w := 0
             , "Found "
             , primeSumCount
             , " prime sums of primes below "
             , MAX_NUMBER + 1
             )
    end
end.


print (pad "index" 6) ++ " | " ++
      (pad "prime" 6) ++ " | " ++
      (pad "prime sum" 11)
print "------------------------------"

s: 0
idx: 0
loop 2..999 'n [
    if prime? n [
        idx: idx + 1
        s: s + n
        if prime? s ->
            print (pad to :string idx 6) ++ " | " ++
                  (pad to :string n 6) ++ " | " ++
                  (pad to :string s 11)
    ]
]


# syntax: GAWK -f SUMMARIZE_PRIMES.AWK
BEGIN {
    start = 1
    stop = 999
    for (i=start; i<=stop; i++) {
      if (is_prime(i)) {
        count1++
        sum += i
        if (is_prime(sum)) {
          printf("the sum of %3d primes from primes 2-%-3s is %5d which is also prime\n",count1,i,sum)
          count2++
        }
      }
    }
    printf("Summarized primes %d-%d: %d\n",start,stop,count2)
    exit(0)
}
function is_prime(x,  i) {
    if (x <= 1) {
      return(0)
    }
    for (i=2; i<=int(sqrt(x)); i++) {
      if (x % i == 0) {
        return(0)
      }
    }
    return(1)
}


#include <stdbool.h>
#include <stdio.h>

bool is_prime(int n) {
    int i = 5;

    if (n < 2) {
        return false;
    }

    if (n % 2 == 0) {
        return n == 2;
    }
    if (n % 3 == 0) {
        return n == 3;
    }

    while (i * i <= n) {
        if (n % i == 0) {
            return false;
        }
        i += 2;

        if (n % i == 0) {
            return false;
        }
        i += 4;
    }

    return true;
}

int main() {
    const int start = 1;
    const int stop = 1000;

    int sum = 0;
    int count = 0;
    int sc = 0;
    int p;

    for (p = start; p < stop; p++) {
        if (is_prime(p)) {
            count++;
            sum += p;
            if (is_prime(sum)) {
                printf("The sum of %3d primes in [2, %3d] is %5d which is also prime\n", count, p, sum);
                sc++;
            }
        }
    }
    printf("There are %d summerized primes in [%d, %d)\n", sc, start, stop);

    return 0;
}


#include <iostream>

bool is_prime(int n) {
    if (n < 2) {
        return false;
    }

    if (n % 2 == 0) {
        return n == 2;
    }
    if (n % 3 == 0) {
        return n == 3;
    }

    int i = 5;
    while (i * i <= n) {
        if (n % i == 0) {
            return false;
        }
        i += 2;

        if (n % i == 0) {
            return false;
        }
        i += 4;
    }

    return true;
}

int main() {
    const int start = 1;
    const int stop = 1000;

    int sum = 0;
    int count = 0;
    int sc = 0;

    for (int p = start; p < stop; p++) {
        if (is_prime(p)) {
            count++;
            sum += p;
            if (is_prime(sum)) {
                printf("The sum of %3d primes in [2, %3d] is %5d which is also prime\n", count, p, sum);
                sc++;
            }
        }
    }
    printf("There are %d summerized primes in [%d, %d)\n", sc, start, stop);

    return 0;
}


// Summarize Primes: Nigel Galloway. April 16th., 2021
primes32()|>Seq.takeWhile((>)1000)|>Seq.scan(fun(n,g) p->(n+1,g+p))(0,0)|>Seq.filter(snd>>isPrime)|>Seq.iter(fun(n,g)->printfn "%3d->%d" n g)


USING: assocs formatting kernel math.primes math.ranges
math.statistics prettyprint ;

1000 [ [1,b] ] [ primes-upto cum-sum ] bi zip
[ nip prime? ] assoc-filter
[ "The sum of the first  %3d  primes is  %5d  (which is prime).\n" printf ] assoc-each


n:=0
s:=0
for i=1, 162 do s:=s+Prime(i);if Isprime(s)=1 then n:=n+1;!!(n,Prime(i),s) fi od


: prime? ( n -- flag )
  dup 2 < if drop false exit then
  dup 2 mod 0= if 2 = exit then
  dup 3 mod 0= if 3 = exit then
  5
  begin
    2dup dup * >=
  while
    2dup mod 0= if 2drop false exit then
    2 +
    2dup mod 0= if 2drop false exit then
    4 +
  repeat
  2drop true ;

: main
  0 0 { count sum }
  ." count  prime      sum" cr
  1000 2 do
    i prime? if
      count 1+ to count
      sum i + to sum
      sum prime? if
        ."   " count 3 .r ."     " i 3 .r ."     " sum 5 .r cr
      then
    then
  loop ;

main
bye


#include "isprime.bas"

print 1,2,2
dim as integer sum = 2, i, n=1
for i = 3 to 999 step 2
    if isprime(i) then
        sum += i
        n+=1
        if isprime(sum) then
            print n, i, sum
        end if
    end if
next i


package main

import (
    "fmt"
    "rcu"
)

func main() {
    primes := rcu.Primes(999)
    sum, n, c := 0, 0, 0
    fmt.Println("Summing the first n primes (<1,000) where the sum is itself prime:")
    fmt.Println("  n  cumulative sum")
    for _, p := range primes {
        n++
        sum += p
        if rcu.IsPrime(sum) {
            c++
            fmt.Printf("%3d   %6s\n", n, rcu.Commatize(sum))
        }
    }
    fmt.Println()
    fmt.Println(c, "such prime sums found")
}


import Data.List (scanl)
import Data.Numbers.Primes (isPrime, primes)

--------------- PRIME SUMS OF FIRST N PRIMES -------------

indexedPrimeSums :: [(Integer, Integer, Integer)]
indexedPrimeSums =
  filter (\(_, _, n) -> isPrime n) $
    scanl
      (\(i, _, m) p -> (succ i, p, p + m))
      (0, 0, 0)
      primes

--------------------------- TEST -------------------------
main :: IO ()
main =
  mapM_ print $
    takeWhile (\(_, p, _) -> 1000 > p) indexedPrimeSums


primes=: p: i. _1 p: 1000   NB. all prime numbers below 1000
sums=: +/\ primes           NB. running sum of those primes
mask=: 1 p: sums            NB. array of 0s, 1s where sums are primes

NB. indices of prime sums (incremented for 1-based indexing)
NB. "copy" only the final primes in the prime sums
NB. "copy" only the sums which are prime
results=: (>: I. mask) ,. (mask # primes) ,. (mask # sums)

NB. pretty-printed "boxed" output
output=: 2 1 $ ' n prime sum ' ; < results


def is_prime:
  . as $n
  | if ($n < 2)         then false
    elif ($n % 2 == 0)  then $n == 2
    elif ($n % 3 == 0)  then $n == 3
    elif ($n % 5 == 0)  then $n == 5
    elif ($n % 7 == 0)  then $n == 7
    elif ($n % 11 == 0) then $n == 11
    elif ($n % 13 == 0) then $n == 13
    elif ($n % 17 == 0) then $n == 17
    elif ($n % 19 == 0) then $n == 19
    else {i:23}
         | until( (.i * .i) > $n or ($n % .i == 0); .i += 2)
	 | .i * .i > $n
    end;

# primes up to but excluding $n
def primes($n): [range(2;$n) | select(is_prime)];

"Prime sums of primes less than 1000",
(primes(1000)
 | range(1; length) as $n
 | (.[: $n] | add) as $sum
 | select($sum | is_prime)
 | "The sum of the \($n) primes from 2 to \(.[$n-1]) is \($sum)." )


using Primes

p1000 = primes(1000)

for n in 1:length(p1000)
    parray = p1000[1:n]
    sparray = sum(parray)
    if isprime(sparray)
        println("The sum of the $n primes from prime 2 to prime $(p1000[n]) is $sparray, which is prime.")
    end
end


p = Prime[Range[PrimePi[1000]]];
TableForm[
 Select[Transpose[{Range[Length[p]], p, Accumulate[p]}], Last /* PrimeQ],
 TableHeadings -> {None, {"Prime count", "Prime", "Prime sum"}}
]


import math, strformat

const N = 999

func isPrime(n: Positive): bool =
  if (n and 1) == 0: return n == 2
  if (n mod 3) == 0: return n == 3
  var d = 5
  var delta = 2
  while d <= sqrt(n.toFloat).int:
    if n mod d == 0: return false
    inc d, delta
    delta = 6 - delta
  result = true

echo "index  prime  prime sum"
var s = 0
var idx = 0
for n in 2..N:
  if n.isPrime:
    inc idx
    s += n
    if s.isPrime: echo &"{idx:3}   {n:5}   {s:7}"