dim info$( 50, 50)    '   NB pre-dimension before calling file-exists
                      '        needed for file-exists function
open "test.dat" for output as #1    'create file
    for i = 1 to 10000
        #1 chr$( int( 256 *rnd( 1)));
    next
close #1

call truncateFile, "test.dat", 5000

wait

sub truncateFile fn$, length
    if fileExists( DefaultDir$, fn$) =0 then notice "No such file": exit sub
    open fn$ for input as #i
        file$ =input$( #i, lof( #i))
        if len( file$) <length then notice "Too short": close #i: exit sub
        file$ =left$( file$, length)
    close #i
    open "test.dat" for output as #o
        #o file$
    close #o
end sub

function fileExists( path$, filename$)
  files path$, filename$, info$()
  fileExists =val( info$( 0, 0))  'non zero is true
end function

end


----------------------------------------
-- Truncates file
-- @param {string} filename
-- @param {integer} length
-- @return {bool} success
----------------------------------------
on truncate (filename, length)
  fp = xtra("fileIO").new()
  fp.openFile(filename, 0)
  if fp.status() then return false
  if fp.getLength()=length then
    -- nothing to do
    fp.closeFile()
    return true
  end if
  data = fp.readByteArray(length)
  if data.length<>length then
    fp.closeFile()
    return false
  end if
  fp.delete()
  fp.createFile(filename)
  fp.openFile(filename, 2)
  fp.writeByteArray(data)
  ok = fp.status()=0
  fp.closeFile()
  return ok
end


function truncate (filename, length)
    local inFile = io.open(filename, 'r')
    if not inFile then
        error("Specified filename does not exist")
    end
    local wholeFile = inFile:read("*all")
    inFile:close()
    if length >= wholeFile:len() then
        error("Provided length is not less than current file length")
    end
    local outFile = io.open(filename, 'w')
    outFile:write(wholeFile:sub(1, length))
    outFile:close()
end


Truncate[file_, n_] := Module[{filename = file, nbbytes = n, temp},
  temp = $TemporaryPrefix <> filename;
  BinaryWrite[temp, BinaryReadList[filename, "Byte", nbbytes]];
  Close[temp]; DeleteFile[filename]; RenameFile[temp, filename];
  ]


function truncate_a_file(fn,count);

fid=fopen(fn,'r');
s = fread(fid,count,'uint8');
fclose(fid);

fid=fopen(fn,'w');
s = fwrite(fid,s,'uint8');
fclose(fid);


import posix

discard truncate("filename", 1024)


val truncate : string -> int -> unit
(** Truncates the named file to the given size. *)


install("truncate", "isL", "trunc")

trunc("/tmp/test.file", 20)


Program FileTruncate;

uses
  SysUtils;

var
  myfile:   file of byte;
  filename: string;
  position: integer;

begin
  write('File for truncation: ');
  readln(filename);
  if not FileExists(filename) then
  begin
    writeln('Error: File does not exist.');
    exit;
  end;

  write('Truncate position: ');
  readln(position);

  Assign(myfile, filename);
  Reset(myfile);
  if FileSize(myfile) < position then
  begin
    writeln('Warning: The file "', filename, '" is too short. No need to truncate at position ', position);
    Close(myfile);
    exit;
  end;

  Seek(myfile, position);
  Truncate(myfile);
  Close(myfile);
  writeln('File "', filename, '" truncated at position ', position, '.');
end.


# Open a file for writing, and truncate it to 1234 bytes.
open FOO, ">>file" or die;
truncate(FOO, 1234);
close FOO;

# Truncate a file to 567 bytes.
truncate("file", 567);


without js -- (file i/o)
?get_file_size("test.txt")
?set_file_size("test.txt",100)
?get_file_size("test.txt")
?set_file_size("test.txt",1024)
?get_file_size("test.txt")


(de truncate (File Len)
   (native "@" "truncate" 'I File Len) )


/* Parameters to be read in by the program are:   */
/* 1. the name of the file to be truncated, and   */
/* 2. the size of file after truncation.          */

truncate_file: procedure options (main); /* 12 July 2012 */
   declare (i, n) fixed binary (31);
   declare filename character(50) varying;
   declare in file record input, out file record output;

   put ('What is the name of the file to be truncated?');
   get edit (filename) (L);
   put ('What is the length of file to be retained?');
   get (n);

   begin;
      declare c(n) character (1), ch character (1);

      open file (in) title ('/' || filename || ',type(fixed),recsize(1)' )
         input;
      do i = 1 to n; read file (in) into (ch); c(i) = ch; end;
      close file (in);

      open file (out) title ('/' || filename || ',append(n),type(fixed),
         recsize(' || trim(n) || ')' );
      write file (out) from (c);
      close file (out);
   end;
end truncate_file;


SUB truncateFile (file AS STRING, length AS DWORD)
    IF LEN(DIR$(file)) THEN
        DIM f AS LONG
        f = FREEFILE
        OPEN file FOR BINARY AS f
        IF length > LOF(f) THEN
            CLOSE f
            ERROR 62 'Input past end
        ELSE
            SEEK f, length + 1
            SETEOF f
            CLOSE f
        END IF
    ELSE
        ERROR 53 'File not found
    END IF
END SUB


Function Truncate-File(fname) {
   $null | Set-Content -Path "$fname"
}


Procedure SetFileSize(File$, length.q)
  Protected fh, pos, i
  If FileSize(File$) < length
    Debug "File to small, is a directory or does not exist."
    ProcedureReturn #False
  Else
    fh = OpenFile(#PB_Any, File$)
    FileSeek(fh, length)
    TruncateFile(fh)
    CloseFile(fh)
  EndIf
  ProcedureReturn #True
EndProcedure


def truncate_file(name, length):
    if not os.path.isfile(name):
        return False
    if length >= os.path.getsize(name):
        return False
    with open(name, 'ab') as f:
        f.truncate(length)
    return True


truncate_file <- function(filename, n_bytes) {

  # check file exists and size is greater than n_bytes
  stopifnot(
    "file does not exist"= file.exists(filename),
    "not enough bytes in file"= file.size(filename) >= n_bytes
  )

  # read bytes from input file
  input.con <- file(filename, "rb")
  bindata <- readBin(input.con, integer(), n=n_bytes/4)
  close(input.con)

  # write bytes to temporary file
  tmp.filename <- tempfile()
  output.con <- file(tmp.filename, "wb")
  writeBin(bindata, output.con)
  close(output.con)

  # double check that everything worked before overwriting original file
  stopifnot(
    "temp file is not expected size"= file.size(tmp.filename) == n_bytes
  )

  # overwrite input file with temporary file
  file.rename(tmp.filename, filename)

}


#lang racket

(define (truncate file size)
  (unless (file-exists? file) (error 'truncat "missing file: ~a" file))
  (when (> size (file-size file)) (printf "Warning: extending file size.\n"))
  (call-with-output-file* file #:exists 'update
    (λ(o) (file-truncate o size))))


use NativeCall;

sub truncate(Str, int32 --> int32) is native {*}

sub MAIN (Str $file, Int $to) {
    given $file.IO {
        .e        or die "$file doesn't exist";
        .w        or die "$file isn't writable";
        .s >= $to or die "$file is not big enough to truncate";
    }
    truncate($file, $to) == 0 or die "Truncation was unsuccessful";
}


/*REXX program  truncates  a file  to a  specified  (and smaller)  number of bytes.     */
parse arg siz FID                                /*obtain required arguments from the CL*/
FID=strip(FID)                                   /*elide  FID  leading/trailing blanks. */
if siz==''             then call ser "No truncation size was specified  (1st argument)."
if FID==''             then call ser "No fileID was specified  (2nd argument)."
if \datatype(siz,'W')  then call ser "trunc size isn't an integer: "          siz
if siz<1               then call ser "trunc size isn't a positive integer: "  siz
_=charin(FID,1,siz+1)                            /*position file and read a wee bit more*/
#=length(_)                                      /*get the length of the part just read.*/
if #==0                then call ser "the specified file doesn't exist: "     FID
if #<siz               then call ser "the file is smaller than trunc size: "   #
call lineout FID                                 /*close the file used, just to be safe.*/
'ERASE'      FID                                 /*invoke a command to delete the file  */
call lineout FID                                 /*close the file, maybe for REXX's use.*/
call charout FID, left(_,siz), 1                 /*write a truncated version of the file*/
call lineout FID                                 /*close the file used, just to be safe.*/
say 'file '  FID " truncated to "  siz  'bytes.' /*display some information to terminal.*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
ser:  say '***error***'  arg(1);      exit 13    /*display an error message  and  exit. */


file = "C:\Ring\ReadMe.txt"
fp = read(file)
fpstr = left(fp, 100)
see fpstr + nl
write(file, fpstr)


# Open a file for writing, and truncate it to 1234 bytes.
File.open("file", "ab") do |f|
  f.truncate(1234)
  f << "Killroy was here" # write to file
end  # file is closed now.

# Just truncate a file to 567 bytes.
File.truncate("file", 567)


use std::path::Path;
use std::fs;

fn truncate_file<P: AsRef<Path>>(filename: P, filesize: usize) -> Result<(), Error> {
    use Error::*;
    let file = fs::read(&filename).or(Err(NotFound))?;

    if filesize > file.len() {
        return Err(FilesizeTooSmall)
    }

    fs::write(&filename, &file[..filesize]).or(Err(UnableToWrite))?;
    Ok(())
}

#[derive(Debug)]
enum Error {
    /// File not found
    NotFound,
    /// Truncated size would be larger than the current size
    FilesizeTooSmall,
    /// Likely due to having read but not write permissions
    UnableToWrite,
}


import java.io.FileOutputStream

object TruncFile extends App {
  if (args.length < 2) println("Usage: java TruncFile fileName newSize")
  else { //turn on "append" so it doesn't clear the file
    val outChan = new FileOutputStream(args(0), true).getChannel()
    val newSize = args(1).toLong
    outChan.truncate(newSize)
  }
}


func truncate(filename, len) {
    var file = File(filename);
    len > file.size ->
        && die "The provided length is greater than the length of the file";
    file.truncate(len);
}

# truncate "file.ext" to 1234 bytes
truncate("file.ext", 1234);


local
  open Posix.FileSys
  val perm = S.flags [S.irusr, S.iwusr, S.irgrp, S.iwgrp, S.iroth, S.iwoth]
in
  fun truncate (path, len) =
    let
      val fd = createf (path, O_WRONLY, O.noctty, perm)
    in
      ftruncate (fd, len); Posix.IO.close fd
    end
end


package require Tcl 8.5

set f [open "file" r+];	# Truncation is done on channels
chan truncate $f 1234;		# Truncate at a particular length (in bytes)
close $f


# Truncate a file named "myfile" to 1440 kilobytes.
ls myfile >/dev/null &&
  dd if=/dev/null of=myfile bs=1 seek=1440k


Sub truncate(fpath,n)
	'Check if file exist
	Set objfso = CreateObject("Scripting.FileSystemObject")
	If objfso.FileExists(fpath) = False Then
		WScript.Echo fpath & " does not exist"
		Exit Sub
	End If
	content = ""
	'stream the input file
	Set objinstream = CreateObject("Adodb.Stream")
	With objinstream
		.Type = 1
		.Open
		.LoadFromFile(fpath)
		'check if the specified size is larger than the file content
		If n <= .Size Then
			content = .Read(n)
		Else
			WScript.Echo "The specified size is larger than the file content"
			Exit Sub
		End If
		.Close
	End With
	'write the truncated version
	Set objoutstream = CreateObject("Adodb.Stream")
	With objoutstream
		.Type = 1
		.Open
		.Write content
		.SaveToFile fpath,2
		.Close
	End With
	Set objinstream = Nothing
	Set objoutstream = Nothing
	Set objfso = Nothing
End Sub

'testing
Call truncate("C:\temp\test.txt",30)


import "/ioutil" for FileUtil

var fileName = "temp.txt"

// create a file of length 26 bytes
FileUtil.write(fileName, "abcdefghijklmnopqrstuvwxyz")
System.print("Contents before truncation: %(FileUtil.read(fileName))")

// truncate file to 13 bytes
FileUtil.truncate(fileName, 13)
System.print("Contents after truncation : %(FileUtil.read(fileName))")

// attempt to truncate file to 20 bytes
FileUtil.truncate(fileName, 20)
System.print("Contents are still        : %(FileUtil.read(fileName))")


int     I, Size, FD;
char    C, FN(80), Array;
[I:= 0;                 \get file name from command line
loop    [C:= ChIn(8);
        if C = $20 \space\ then quit;
        FN(I):= C;
        I:= I+1;
        ];
FN(I):= 0;
Size:= IntIn(8);        \get number of bytes from command line
if Size = 0 then [Text(0, "Length not found (or zero)");  exit 1];

Trap(false);            \disable abort on errors
FD:= FOpen(FN, 0);      \open specified file for input
FSet(FD, ^i);
OpenI(3);
if GetErr then [Text(0, "File not found");  exit 1];

Array:= Reserve(0);     \64MB available if no procedures are called
for I:= 0 to Size-1 do  \read specified number of bytes
        [Array(I):= ChIn(3);
        if GetErr then [Text(0, "File is too short");  exit 1];
        ];              \if end of file encountered, show error
FClose(FD);

FD:= FOpen(FN, 1);      \open file by same name for output
FSet(FD, ^o);
OpenO(3);
if GetErr then [Text(0, "Output error");  exit 1];
for I:= 0 to Size-1 do ChOut(3, Array(I));
Close(3);
]


10 CLEAR 29999
20 INPUT "Which file do you want to truncate?";f$
30 PRINT "Start tape to load file to truncate."
40 LOAD f$ CODE 30000
50 "Input how many bytes do you want to keep?";n
60 PRINT "Please rewind the tape and press record."
70 SAVE f$ CODE 30000,n
80 STOP


F cell(n, =x, =y, start = 1)
   V d = 0
   y = y - n I/ 2
   x = x - (n - 1) I/ 2
   V l = 2 * max(abs(x), abs(y))
   d = I y >= x {(l * 3 + x + y)} E (l - x - y)
   R (l - 1) ^ 2 + d + start - 1

F show_spiral(n, symbol = ‘# ’, start = 1, =space = ‘’)
   V top = start + n * n + 1
   V is_prime = [0B, 0B, 1B] [+] [1B, 0B] * (top I/ 2)
   L(x) 3 .< 1 + Int(sqrt(top))
      I !is_prime[x]
         L.continue
      L(i) (x * x .< top).step(x * 2)
         is_prime[i] = 0B

   (Int -> String) f = _ -> @symbol

   I space == ‘’
      space = ‘ ’ * symbol.len

   I symbol.empty
      V max_str = String(n * n + start - 1).len
      I space == ‘’
         space = (‘.’ * max_str)‘ ’
      f = x -> String(x).rjust(@max_str)‘ ’

   V cell_str = x -> I @is_prime[x] {@f(x)} E @space

   L(y) 0 .< n
      print((0 .< n).map(x -> cell(@n, x, @y, @start)).map(v -> @cell_str(v)).join(‘’))
   print()

show_spiral(10, symbol' ‘# ’, space' ‘  ’)
show_spiral(9, symbol' ‘’, space' ‘ - ’)


*        Ulam spiral               26/04/2016
ULAM     CSECT
         USING  ULAM,R13           set base register
SAVEAREA B      STM-SAVEAREA(R15)  skip savearea
         DC     17F'0'             savearea
STM      STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         save previous SA
         ST     R15,8(R13)         linkage in previous SA
         LR     R13,R15            establish addressability
         LA     R5,1               n=1
         LH     R8,NSIZE           x=nsize
         SRA    R8,1
         LA     R8,1(R8)           x=nsize/2+1
         LR     R9,R8              y=x
         LR     R1,R5              n
         BAL    R14,ISPRIME
         C      R0,=F'1'           if isprime(n)
         BNE    NPRMJ0
         BAL    R14,SPIRALO        spiral(x,y)=o
NPRMJ0   LA     R5,1(R5)           n=n+1
         LA     R6,1               i=1
LOOPI1   LH     R2,NSIZE           do i=1 to nsize-1 by 2
         BCTR   R2,0
         CR     R6,R2              if i>nsize-1
         BH     ELOOPI1
         LR     R7,R6              j=i; do j=1 to i
LOOPJ1   LA     R8,1(R8)           x=x+1
         LR     R1,R5              n
         BAL    R14,ISPRIME
         C      R0,=F'1'           if isprime(n)
         BNE    NPRMJ1
         BAL    R14,SPIRALO        spiral(x,y)=o
NPRMJ1   LA     R5,1(R5)           n=n+1
         BCT    R7,LOOPJ1          next j
ELOOPJ1  LR     R7,R6              j=i; do j=1 to i
LOOPJ2   BCTR   R9,0               y=y-1
         LR     R1,R5              n
         BAL    R14,ISPRIME
         C      R0,=F'1'           if isprime(n)
         BNE    NPRMJ2
         BAL    R14,SPIRALO        spiral(x,y)=o
NPRMJ2   LA     R5,1(R5)           n=n+1
         BCT    R7,LOOPJ2          next j
ELOOPJ2  LR     R7,R6              j=i
         LA     R7,1(R7)           j=i+1; do j=1 to i+1
LOOPJ3   BCTR   R8,0               x=x-1
         LR     R1,R5              n
         BAL    R14,ISPRIME
         C      R0,=F'1'           if isprime(n)
         BNE    NPRMJ3
         BAL    R14,SPIRALO        spiral(x,y)=o
NPRMJ3   LA     R5,1(R5)           n=n+1
         BCT    R7,LOOPJ3          next j
ELOOPJ3  LR     R7,R6              j=i
         LA     R7,1(R7)           j=i+1; do j=1 to i+1
LOOPJ4   LA     R9,1(R9)           y=y+1
         LR     R1,R5              n
         BAL    R14,ISPRIME
         C      R0,=F'1'           if isprime(n)
         BNE    NPRMJ4
         BAL    R14,SPIRALO        spiral(x,y)=o
NPRMJ4   LA     R5,1(R5)           n=n+1
         BCT    R7,LOOPJ4          next j
ELOOPJ4  LA     R6,2(R6)           i=i+2
         B      LOOPI1
ELOOPI1  LH     R7,NSIZE           j=nsize
         BCTR   R7,0               j=nsize-1; do j=1 to nsize-1
LOOPJ5   LA     R8,1(R8)           x=x+1
         LR     R1,R5              n
         BAL    R14,ISPRIME
         C      R0,=F'1'           if isprime(n)
         BNE    NPRMJ5
         BAL    R14,SPIRALO        spiral(x,y)=o
NPRMJ5   LA     R5,1(R5)           n=n+1
         BCT    R7,LOOPJ5          next j
ELOOPJ5  LA     R6,1               i=1
LOOPI2   CH     R6,NSIZE           do i=1 to nsize
         BH     ELOOPI2
         LA     R10,PG             reset buffer
         LA     R7,1               j=1
LOOPJ6   CH     R7,NSIZE           do j=1 to nsize
         BH     ELOOPJ6
         LR     R1,R7              j
         BCTR   R1,0               (j-1)
         MH     R1,NSIZE           (j-1)*nsize
         AR     R1,R6              r1=(j-1)*nsize+i
         LA     R14,SPIRAL-1(R1)   @spiral(j,i)
         MVC    0(1,R10),0(R14)    output spiral(j,i)
         LA     R10,1(R10)         pgi=pgi+1
         LA     R7,1(R7)           j=j+1
         B      LOOPJ6
ELOOPJ6  XPRNT  PG,80              print
         LA     R6,1(R6)           i=i+1
         B      LOOPI2
ELOOPI2  L      R13,4(0,R13)       reset previous SA
         LM     R14,R12,12(R13)    restore previous env
         XR     R15,R15            set return code
         BR     R14                call back
ISPRIME  CNOP   0,4     ---------- isprime function
         C      R1,=F'2'           if nn=2
         BNE    NOT2
         LA     R0,1               rr=1
         B      ELOOPII
NOT2     C      R1,=F'2'           if nn<2
         BL     RRZERO
         LR     R2,R1              nn
         LA     R4,2               2
         SRDA   R2,32              shift
         DR     R2,R4              nn/2
         C      R2,=F'0'           if nn//2=0
         BNE    TAGII
RRZERO   SR     R0,R0              rr=0
         B      ELOOPII
TAGII    LA     R0,1               rr=1
         LA     R4,3               ii=3
LOOPII   LR     R3,R4              ii
         MR     R2,R4              ii*ii
         CR     R3,R1              if ii*ii<=nn
         BH     ELOOPII
         LR     R3,R1              nn
         LA     R2,0               clear
         DR     R2,R4              nn/ii
         LTR    R2,R2              if nn//ii=0
         BNZ    NEXTII
         SR     R0,R0              rr=0
         B      ELOOPII
NEXTII   LA     R4,2(R4)           ii=ii+2
         B      LOOPII
ELOOPII  BR     R14     ---------- end isprime return rr
SPIRALO  CNOP   0,4     ---------- spiralo subroutine
         LR     R1,R8              x
         BCTR   R1,0               x-1
         MH     R1,NSIZE           (x-1)*nsize
         AR     R1,R9              r1=(x-1)*nsize+y
         LA     R10,SPIRAL-1(R1)   [email protected](x,y)
         MVC    0(1,R10),O         spiral(x,y)=o
         BR     R14     ---------- end spiralo
NS       EQU    79                 4n+1
NSIZE    DC     AL2(NS)            =H'ns'
O        DC     CL1'*'             if prime
PG       DC     CL80' '            buffer
         LTORG
SPIRAL   DC     (NS*NS)CL1' '
         YREGS
         END    ULAM


generic
   Size: Positive;
      -- determines the size of the square
   with function Represent(N: Natural) return String;
      -- this turns a number into a string to be printed
      -- the length of the output should not change
      -- e.g., Represent(N) may return " #" if N is a prime
      -- and "  " else
   with procedure Put_String(S: String);
      -- outputs a string, no new line
   with procedure New_Line;
      -- the name says all
package Generic_Ulam is

   procedure Print_Spiral;
   -- calls Put_String(Represent(I)) N^2 times
   --       and New_Line N times

end Generic_Ulam;


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

typedef uint32_t bitsieve;

unsigned sieve_check(bitsieve *b, const unsigned v)
{
    if ((v != 2 && !(v & 1)) || (v < 2))
        return 0;
    else
        return !(b[v >> 6] & (1 << (v >> 1 & 31)));
}

bitsieve* sieve(const unsigned v)
{
    unsigned i, j;
    bitsieve *b = calloc((v >> 6) + 1, sizeof(uint32_t));

    for (i = 3; i <= sqrt(v); i += 2)
        if (!(b[i >> 6] & (1 << (i >> 1 & 31))))
            for (j = i*i; j < v; j += (i << 1))
                b[j >> 6] |= (1 << (j >> 1 & 31));

    return b;
}

#define max(x,y) ((x) > (y) ? (x) : (y))

/* This mapping taken from python solution */
int ulam_get_map(int x, int y, int n)
{
    x -= (n - 1) / 2;
    y -= n / 2;

    int mx = abs(x), my = abs(y);
    int l = 2 * max(mx, my);
    int d = y >= x ? l * 3 + x + y : l - x - y;

    return pow(l - 1, 2) + d;
}

/* Passing a value of 0 as glyph will print numbers */
void output_ulam_spiral(int n, const char glyph)
{
    /* An even side length does not make sense, use greatest odd value < n */
    n -= n % 2 == 0 ? 1 : 0;

    const char *spaces = ".................";
    int mwidth = log10(n * n) + 1;

    bitsieve *b = sieve(n * n + 1);
    int x, y;

    for (x = 0; x < n; ++x) {
        for (y = 0; y < n; ++y) {
            int z = ulam_get_map(y, x, n);

            if (glyph == 0) {
                if (sieve_check(b, z))
                    printf("%*d ", mwidth, z);
                else
                    printf("%.*s ", mwidth, spaces);
            }
            else {
                printf("%c", sieve_check(b, z) ? glyph : spaces[0]);
            }
        }
        printf("\n");
    }

    free(b);
}

int main(int argc, char *argv[])
{
    const int n = argc < 2 ? 9 : atoi(argv[1]);

    output_ulam_spiral(n, 0);
    printf("\n");

    output_ulam_spiral(n, '#');
    printf("\n");

    return 0;
}


#include <cmath>
#include <iostream>
#include <string>
#include <iomanip>
#include <vector>

class ulamSpiral {
public:
    void create( unsigned n, unsigned startWith = 1 ) {
        _lst.clear();
        if( !( n & 1 ) ) n++;
        _mx = n;
        unsigned v = n * n;
        _wd = static_cast<unsigned>( log10( static_cast<long double>( v ) ) ) + 1;
        for( unsigned u = 0; u < v; u++ )
            _lst.push_back( -1 );

        arrange( startWith );

    }
    void display( char c ) {
        if( !c ) displayNumbers();
        else displaySymbol( c );
    }

private:
    bool isPrime( unsigned u ) {
        if( u < 4 ) return u > 1;
        if( !( u % 2 ) || !( u % 3 ) ) return false;

        unsigned q = static_cast<unsigned>( sqrt( static_cast<long double>( u ) ) ),
                 c = 5;
        while( c <= q ) {
            if( !( u % c ) || !( u % ( c + 2 ) ) ) return false;
            c += 6;
        }
        return true;
    }
    void arrange( unsigned s ) {
        unsigned stp = 1, n = 1, posX = _mx >> 1,
                 posY = posX, stC = 0;
        int dx = 1, dy = 0;

        while( posX < _mx && posY < _mx ) {
            _lst.at( posX + posY * _mx ) =  isPrime( s ) ? s : 0;
            s++;

            if( dx ) {
                posX += dx;
                if( ++stC == stp ) {
                    dy = -dx;
                    dx = stC = 0;
                }
            } else {
                posY += dy;
                if( ++stC == stp ) {
                    dx = dy;
                    dy = stC = 0;
                    stp++;
                }
            }
        }
    }
    void displayNumbers() {
        unsigned ct = 0;
        for( std::vector<unsigned>::iterator i = _lst.begin(); i != _lst.end(); i++ ) {
            if( *i ) std::cout << std::setw( _wd ) << *i << " ";
            else std::cout << std::string( _wd, '*' ) << " ";
            if( ++ct >= _mx ) {
                std::cout << "\n";
                ct = 0;
            }
        }
        std::cout << "\n\n";
    }
    void displaySymbol( char c ) {
        unsigned ct = 0;
        for( std::vector<unsigned>::iterator i = _lst.begin(); i != _lst.end(); i++ ) {
            if( *i ) std::cout << c;
            else std::cout << " ";
            if( ++ct >= _mx ) {
                std::cout << "\n";
                ct = 0;
            }
        }
        std::cout << "\n\n";
    }

    std::vector<unsigned> _lst;
    unsigned _mx, _wd;
};

int main( int argc, char* argv[] )
{
    ulamSpiral ulam;
    ulam.create( 9 );
    ulam.display( 0 );
    ulam.create( 35 );
    ulam.display( '#' );
    return 0;
}


(defun ulam-spiral (n)
  (loop for a in (spiral n n (* n n)) do
        (format t "~{~d~}~%" a)))

(defun spiral
    (n m b &aux (row (loop for a below n
                           collect (if (primep (- b a))
                                       '* '#\space))))
  (if (= m 1) (list row)
      (cons row (mapcar #'reverse
                        (apply #'mapcar #'list
                               (spiral (1- m) n
                                       (- b n)))))))
(defun primep (n)
  (when (> n 1) (loop for a from 2 to (isqrt n)
                      never (zerop (mod n a)))))


enum Direction
  RIGHT
  UP
  LEFT
  DOWN
end

def generate(n : Int32, i : Int32, c : Int32 | String)
  s = Array.new(n) { Array.new(n) { "" } }

  dir = Direction::RIGHT
  y = n // 2
  x = n % 2 == 0 ? y - 1 : y

  j = 1
  while j <= n * n - 1 + i
    s[y][x] = is_prime(j) ? j.to_s : c.to_s

    # printf "j: %s, x: %s, y: %s \n", j, x, y

    case dir
    when Direction::RIGHT
      dir = Direction::UP if x <= n - 1 && s[y - 1][x] == "" && j > i
    when Direction::UP
      dir = Direction::LEFT if s[y][x - 1] == ""
    when Direction::LEFT
      dir = Direction::DOWN if x == 0 || s[y + 1][x] == ""
    when Direction::DOWN
      dir = Direction::RIGHT if s[y][x + 1] == ""
    end

    case dir
    when Direction::RIGHT
      x += 1
    when Direction::UP
      y -= 1
    when Direction::LEFT
      x -= 1
    when Direction::DOWN
      y += 1
    end

    j += 1
  end

  s.map(&.join("\t")).join("\n")
end

def is_prime(n : Int32) : Bool
  return true if n == 2
  return false if n % 2 == 0 || n < 1

  i = 3
  while i <= Math.sqrt(n)
    return false if n % i == 0
    i += 2
  end

  true
end

puts generate 7, 1, "*"


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

int cell(in int n, int x, int y, in int start=1) pure nothrow @safe @nogc {
    x = x - (n - 1) / 2;
    y = y - n / 2;
    immutable l = 2 * max(x.abs, y.abs);
    immutable d = (y > x) ? (l * 3 + x + y) : (l - x - y);
    return (l - 1) ^^ 2 + d + start - 1;
}

void showSpiral(in int n, in string symbol="# ", in int start=1, string space=null) /*@safe*/ {
    if (space is null)
        space = " ".replicate(symbol.length);

    immutable top = start + n ^^ 2 + 1;
    auto isPrime = [false, false, true] ~ [true, false].replicate(top / 2);
    foreach (immutable x; 3 .. 1 + cast(int)real(top).sqrt) {
        if (!isPrime[x])
            continue;
        foreach (immutable i; iota(x ^^ 2, top, x * 2))
            isPrime[i] = false;
    }

    string cellStr(in int x) pure nothrow @safe @nogc {
        return isPrime[x] ? symbol : space;
    }

    foreach (immutable y; 0 .. n)
        n.iota.map!(x => cell(n, x, y, start)).map!cellStr.joiner.writeln;
}

void main() {
    35.showSpiral;
}


(lib 'plot)

(define *red* (rgb 1 0 0))
(define (ulam n nmax) (if ( prime? n) *red* (gray (// n nmax))))
(plot-spiral ulam 1000) ;; range [0...1000]


defmodule Ulam do
  defp cell(n, x, y, start) do
    y = y - div(n, 2)
    x = x - div(n - 1, 2)
    l = 2 * max(abs(x), abs(y))
    d = if y >= x, do: l*3 + x + y, else: l - x - y
    (l - 1)*(l - 1) + d + start - 1
  end

  def show_spiral(n, symbol\\nil, start\\1) do
    IO.puts "\nN : #{n}"
    if symbol==nil, do: format = "~#{length(to_char_list(start + n*n - 1))}s "
    prime = prime(n*n + start)
    Enum.each(0..n-1, fn y ->
      Enum.each(0..n-1, fn x ->
        i = cell(n, x, y, start)
        if symbol do
          IO.write if i in prime, do: Enum.at(symbol,0), else: Enum.at(symbol,1)
        else
          :io.fwrite format, [if i in prime do to_char_list(i) else "" end]
        end
      end)
      IO.puts ""
    end)
  end

  defp prime(num), do: prime(Enum.to_list(2..num), [])
  defp prime([], p), do: Enum.reverse(p)
  defp prime([h|t], p), do: prime((for i <- t, rem(i,h)>0, do: i), [h|p])
end

Ulam.show_spiral(9)
Ulam.show_spiral(25)
Ulam.show_spiral(25, ["#"," "])


PROGRAM SPIRAL

!$INTEGER

CONST RIGHT=1,UP=2,LEFT=3,DOWN=4

!$DYNAMIC
DIM SPIRAL$[0,0]

PROCEDURE PRT_ULAM(N)
  FOR ROW=0 TO N DO
    FOR COL=0 TO N DO
        PRINT(SPIRAL$[ROW,COL];)
    END FOR
    PRINT
  END FOR
  PRINT
  GET(K$)
  FOR ROW=0 TO N DO
    FOR COL=0 TO N DO
        IF VAL(SPIRAL$[ROW,COL])<>0 THEN PRINT("  * ";)  ELSE PRINT(SPIRAL$[ROW,COL];) END IF
    END FOR
    PRINT
  END FOR
END PROCEDURE

PROCEDURE IS_PRIME(A->RES%)
     LOCAL N
     IF A=2 THEN RES%=TRUE EXIT PROCEDURE END IF
     IF A<=1 OR (A MOD 2=0) THEN RES%=FALSE EXIT PROCEDURE END IF
     MAX=SQR(A)
     FOR N=3 TO MAX STEP 2 DO
        IF (A MOD N=0) THEN RES%=FALSE EXIT PROCEDURE END IF
     END FOR
     RES%=TRUE
END PROCEDURE

PROCEDURE GEN_ULAM(N,I)
     DIR=RIGHT
     J=I
     Y=INT(N/2)
     IF (N MOD 2=0) THEN X=Y-1 ELSE X=Y END IF ! shift left for even n's
          WHILE J<=(N*N)-1+I DO

              IS_PRIME(J->RES%)
              IF RES% THEN SPIRAL$[Y,X]=RIGHT$("  "+STR$(J),4) ELSE SPIRAL$[Y,X]=" ---" END IF

              CASE DIR OF
                    RIGHT->
                       IF (X<=(N-1) AND SPIRAL$[Y-1,X]="" AND J>I) THEN DIR=UP END IF
                    END ->
                    UP->
                       IF SPIRAL$[Y,X-1]="" THEN DIR=LEFT END IF
                    END ->
                    LEFT->
                       IF (X=0) OR SPIRAL$[Y+1,X]="" THEN DIR=DOWN END IF
                    END ->
                    DOWN->
                       IF SPIRAL$[Y,X+1]="" THEN DIR=RIGHT END IF
                    END ->
              END CASE

              CASE DIR OF
                    RIGHT-> X=X+1 END ->
                    UP->    Y=Y-1 END ->
                    LEFT->  X=X-1 END ->
                    DOWN->  Y=Y+1 END ->
              END CASE
              J=J+1
          END WHILE
          PRT_ULAM(N)
END PROCEDURE

BEGIN
     N=9
     !$DIM SPIRAL$[N,N]
     GEN_ULAM(N,1)
END PROGRAM


USING: arrays grouping kernel math math.combinatorics
math.matrices math.primes math.ranges math.statistics
prettyprint sequences sequences.repeating ;
IN: rosetta-code.ulam-spiral

: counts ( n -- seq ) 1 [a,b] 2 repeat rest ;

: vals ( n -- seq )
    [ -1 swap neg 2dup [ neg ] [email protected] 4array ] [ 2 * 1 - cycle ] bi ;

: evJKT2 ( n -- seq )
    [ counts ] [ vals ] bi [ <array> ] 2map concat ;

: spiral ( n -- matrix )
    [ evJKT2 cum-sum inverse-permutation ] [ group ] bi ;

: ulam-spiral ( n -- matrix )
    spiral dup dim first sq 1 -
    [ swap - 1 + prime? "o " "  " ? ] curry matrix-map ;

: ulam-demo ( -- ) 21 ulam-spiral simple-table. ;

MAIN: ulam-demo


 43 constant border                                                         \ grid size is border x border
 border border * constant size

 variable crawler                                                           \ position of the crawler

 : set.crawler border 2 mod 0= if                                           \ positions the crawler in the middle of the grid
	 size 2 / border 2/ + 1 - crawler !
	 else
	 size 2 / crawler ! then ;

 set.crawler
 create Grid size cells allot                                               \ creates the grid
 here constant GridEnd                                                      \ used for debugging

 : is.divisor
	over 2over
	mod 0= swap drop + ;

 : sub.one
	 swap 1 - swap ;

 : next.div
	 is.divisor sub.one ;

 : three.test                                                                \ counts divisors for numbers bigger than 2
	 dup 0
     begin
	 next.div
     over 1 = until
	 swap drop
	 swap drop 1 + ;

 : not.prime                                                                 \ counts the number of divisors. Primes have exactly two.
    dup
    2 < if drop true else
	three.test then ;

 : sub.four                                                                   \ the crawler takes a number from the stack as direction
	 dup 4 > if 4 - then ;                                                \ this word makes the number roll over.
                                                                              \ 1-right 2-up 3-left 4-down
 : craw.left                                                                  \ rotates the crawler 90 degrees counter-clockwise
	 1 + sub.four ;

 : scan.right
	 grid crawler @ 1 + cells + @ 0= ;                                    \ checks if cell to the right of the crawler is zero

 : scan.left
	 grid crawler @ 1 - cells + @ 0= ;                                    \ cell to the left

 : scan.up
	 grid crawler @ border - cells + @ 0= ;                               \ cell above

 : scan.down
	 grid crawler @ border + cells + @ 0= ;                               \ and cell below

 : crawler.go                                                                 \ moves crawler one cell ahead checks cell to the left...
	 dup                                                                  \ ...of the direction the crawler is facing, if zero, turns
	 1 = if crawler @ 1 + crawler ! scan.up if craw.left then else
	 dup
	 2 = if crawler @ border - crawler ! scan.left if craw.left then else
	 dup
	 3 = if crawler @ 1 - crawler ! scan.down if craw.left then else
	 dup
	 4  = if crawler @ border + crawler ! scan.right if craw.left then else

	 then then then then ;

 : run.crawler                                                              \ crawler moves through the grid and fills it with numbers
	 border 2 < if 1 grid 0 cells + ! else                              \ if the grid is a single cell, puts 1 in it
	 crawler @ border - crawler !	                                    \ crawler moves one step and turn before setting the first...
	 4                                                                  \ ...number so it is repositioned one cell up facing down
  	 size -1 * 0 do  i
	 i -1 * grid crawler @ cells + ! drop
	 crawler.go
	 -1 +loop then drop ;

 : leave.primes                                                                    \ removes non-primes from the grid
	 size 0 do i
	 grid i cells + @ not.prime if 0 grid i cells + ! then drop
	 loop ;

 : star.draw1                                                                      \ draws a "*" where number is not zero
	 0> if 42 emit else 32 emit
	 then ;

 : star.draw2
	 0> if 42 emit 32 emit else 32 emit 32 emit                                 \ same but adds a space for better presentation
	 then ;

 : star.draw3
	 0> if 32 emit 42 emit 32 emit else 32 emit 32 emit 32 emit                 \ adds two spaces
	 then ;

 : draw.grid                                                                         \ cuts the array into lines and displays it
	page
	size 0 do i
	i border mod 0= if  cr  then
	grid i cells + @ star.draw2 drop                                             \ may use star.draw1 or 3 here
	loop ;

 : ulam.spiral run.crawler leave.primes draw.grid ;                                  \ draws the spiral. Execute this word to run.


program ulam
  implicit none

  integer, parameter :: nsize = 49
  integer :: i, j, n, x, y
  integer :: a(nsize*nsize) = (/ (i, i = 1, nsize*nsize) /)
  character(1)  :: spiral(nsize, nsize) = " "
  character(2)  :: sstr
  character(10) :: fmt

  n = 1
  x = nsize / 2 + 1
  y = x
  if(isprime(a(n))) spiral(x, y) = "O"
  n = n + 1

  do i = 1, nsize-1, 2
    do j = 1, i
      x = x + 1
      if(isprime(a(n))) spiral(x, y) = "O"
      n = n + 1
    end do

    do j = 1, i
      y = y - 1
      if(isprime(a(n))) spiral(x, y) = "O"
      n = n + 1
    end do

    do j = 1, i+1
      x = x - 1
      if(isprime(a(n))) spiral(x, y) = "O"
      n = n + 1
    end do

    do j = 1, i+1
      y = y + 1
      if(isprime(a(n))) spiral(x, y) = "O"
      n = n + 1
    end do
  end do

  do j = 1, nsize-1
    x = x + 1
    if(isprime(a(n))) spiral(x, y) = "O"
    n = n + 1
  end do

  write(sstr, "(i0)") nsize
  fmt = "(" // sstr // "(a,1x))"
  do i = 1, nsize
    write(*, fmt) spiral(:, i)
  end do

contains

function isprime(number)
  logical :: isprime
  integer, intent(in) :: number
  integer :: i

  if(number == 2) then
    isprime = .true.
  else if(number < 2 .or. mod(number,2) == 0) then
    isprime = .false.
  else
    isprime = .true.
    do i = 3, int(sqrt(real(number))), 2
      if(mod(number,i) == 0) then
        isprime = .false.
        exit
      end if
    end do
  end if
end function
end program


#define SIZE 639

screenres SIZE, SIZE, 4

function is_prime( n as ulongint ) as boolean
    if n < 2 then return false
    if n = 2 then return true
    if n mod 2 = 0 then return false
    for i as uinteger = 3 to int(sqr(n))+1 step 2
        if n mod i = 0 then return false
    next i
    return true
end function

function is_turn( byval n as unsigned integer ) as boolean
    n -= 1
    if int(sqr(n))^2 = n then return true
    n = n -  int(sqr(n))
    if int(sqr(n))^2 = n then return true
    return false
end function

dim as integer n = 1, x=SIZE/2, y=SIZE/2, dx = 1, dy = 0

do
    if is_prime(n) then pset (x, y), 15
    x = x + dx
    y = y + dy
    if x >= SIZE orelse y >= SIZE orelse x < 0 orelse y < 0 then exit do
    n = n + 1
    if is_turn(n) then
        dx = -dx
        swap dx, dy
    end if
loop

sleep
end


package main

import (
	"math"
	"fmt"
)

type Direction byte

const (
	RIGHT Direction = iota
	UP
	LEFT
	DOWN
)

func generate(n,i int, c byte) {
	s := make([][]string, n)
	for i := 0; i < n; i++ { s[i] = make([]string, n) }
	dir := RIGHT
	y := n / 2
	var x int
	if (n % 2 == 0) { x = y - 1 } else { x = y } // shift left for even n's

	for j := i; j <= n * n - 1 + i; j++ {
		if (isPrime(j)) {
			if (c == 0) { s[y][x] = fmt.Sprintf("%3d", j) } else { s[y][x] = fmt.Sprintf("%2c ", c) }
		} else { s[y][x] = "---" }

		switch dir {
		case RIGHT : if (x <= n - 1 && s[y - 1][x] == "" && j > i) { dir = UP }
		case UP : if (s[y][x - 1] == "") { dir = LEFT }
		case LEFT : if (x == 0 || s[y + 1][x] == "") { dir = DOWN }
		case DOWN : if (s[y][x + 1] == "") { dir = RIGHT }
		}

		switch dir {
		case RIGHT : x += 1
		case UP : y -= 1
		case LEFT : x -= 1
		case DOWN : y += 1
		}
	}

	for _, row := range s { fmt.Println(fmt.Sprintf("%v", row)) }
	fmt.Println()
}

func isPrime(a int) bool {
	if (a == 2) { return true }
	if (a <= 1 || a % 2 == 0) { return false }
	max := int(math.Sqrt(float64(a)))
	for n := 3; n <= max; n += 2 { if (a % n == 0) { return false } }
	return true
}

func main() {
	generate(9, 1, 0) // with digits
	generate(9, 1, '*') // with *
}


import Data.List
import Data.Numbers.Primes

ulam n representation = swirl n . map representation


import java.util.Arrays;

public class Ulam{
	enum Direction{
		RIGHT, UP, LEFT, DOWN;
	}

	private static String[][] genUlam(int n){
		return genUlam(n, 1);
	}

	private static String[][] genUlam(int n, int i){
		String[][] spiral = new String[n][n];
		Direction dir = Direction.RIGHT;
		int j = i;
		int y = n / 2;
		int x = (n % 2 == 0) ? y - 1 : y; //shift left for even n's
		while(j <= ((n * n) - 1 + i)){
			spiral[y][x] = isPrime(j) ? String.format("%4d", j) : " ---";

			switch(dir){
			case RIGHT:
				if(x <= (n - 1) && spiral[y - 1][x] == null && j > i) dir = Direction.UP; break;
			case UP:
				if(spiral[y][x - 1] == null) dir = Direction.LEFT; break;
			case LEFT:
				if(x == 0 || spiral[y + 1][x] == null) dir = Direction.DOWN; break;
			case DOWN:
				if(spiral[y][x + 1] == null) dir = Direction.RIGHT; break;
			}

			switch(dir){
				case RIGHT:	x++; break;
				case UP: 	y--; break;
				case LEFT:	x--; break;
				case DOWN:	y++; break;
			}
			j++;
		}
		return spiral;
	}

	public static boolean isPrime(int a){
		   if(a == 2) return true;
		   if(a <= 1 || a % 2 == 0) return false;
		   long max = (long)Math.sqrt(a);
		   for(long n = 3; n <= max; n += 2){
		      if(a % n == 0) return false;
		   }
		   return true;
		}

	public static void main(String[] args){
		String[][] ulam = genUlam(9);
		for(String[] row : ulam){
			System.out.println(Arrays.toString(row).replaceAll(",", ""));
		}
		System.out.println();

		for(String[] row : ulam){
			System.out.println(Arrays.toString(row).replaceAll("\\[\\s+\\d+", "[  * ").replaceAll("\\s+\\d+", "   * ").replaceAll(",", ""));
		}
	}
}


<title>Ulam Spiral</title>

  Plot/print style:
  <input type="radio" onclick="rbCheck();" name="rb" id="rbDef"/>Plot
  <input type="radio" onclick="rbCheck();" name="rb" id="rbAst"/>Print *
  <input type="radio" onclick="rbCheck();" name="rb" id="rbNum"/>Print numbers
  <input type="button" value="Plot it!" onclick="pspUlam();">

Ulam Spiral

  <canvas id="cvsId" width="300" height="300" style="border: 2px inset;"></canvas>


def array($init): [range(0; .) | $init];

# Test if input is a one-character string holding a digit
def isDigit:
  type=="string" and length==1 and explode[0] as $c | (48 <= $c and $c <= 57);

def lpad($len): tostring | ($len - length) as $l | (" " * $l)[:$l] + .;

def generate($n; $i; $c):
  if $n <= 1 then "'n' must be more than 1." | error
  else {   s: ($n|array(array(""))),
         dir: "right",
           y: (($n/2)|floor) }
  | .x = if ($n % 2 == 0) then .y - 1 else .y end  # shift left for even n
  | reduce range($i; $n * $n + $i) as $j (.;
      .s[.y][.x] = (
            if $j | is_prime
	    then (if $c|isDigit then $j|lpad(4) else "  \($c) " end)
	    else " ---"
	    end)
      | if .dir == "right"
        then if (.x <= $n - 1 and .s[.y - 1][.x] == "" and $j > i) then .dir = "up" else . end
        elif .dir == "up"
        then if (.s[.y][.x - 1] == "") then .dir = "left" else . end
        elif .dir == "left"
        then if (.x == 0 or .s[.y + 1][.x] == "") then .dir = "down" else . end
        elif .dir == "down"
        then if (.s[.y][.x + 1] == "") then .dir = "right" else . end
        else .
	end
     | if   .dir == "right" then .x += 1
       elif .dir == "up"    then .y += -1
       elif .dir == "left"  then .x += -1
       elif .dir == "down"  then .y += 1
       else .
       end )
   | .s[] | join(" ")
   end ;

# with digits
generate(9; 1; "0"), "",

# with *
generate(9; 1; "*")


using Primes

function ulamspiral(ord::Int)
    # Possible directions
    dirs = [[0, 1], [-1, 0], [0, -1], [1, 0]]
    # fdir = ["→", "↑", "←", "↓"] # for debug pourpose
    cur = maxsteps = 1  # starting direction & starting max steps
    steps = n = 0       # starting steps     & starting number in cell
    pos = [ord ÷ 2 + 1, isodd(ord) ? ord ÷ 2 + 1 : ord ÷ 2] # starting position
    M = Matrix{Bool}(ord, ord) # result matrix
    while n < ord ^ 2  # main loop (stop when the matrix is filled)
        n += 1
        M[pos[1], pos[2]] = isprime(n)
        steps += 1
        # Debug print
        # @printf("M[%i, %i] = %5s (%2i), step %i/%i, nxt %s\n", pos[1], pos[2], isprime(n), n, steps, maxsteps, fdir[cur])
        pos  .+= dirs[cur] # increment position
        if steps == maxsteps # if reached max number of steps in that direction...
            steps = 0        # ...reset steps
            if iseven(cur) maxsteps += 1 end # if the current direction is even increase the number of steps
            cur  += 1        # change direction
            if cur > 4 cur -= 4 end # correct overflow
        end
    end
    return M
end

mprint(m::Matrix) = for i in 1:size(m, 1) println(join(el ? " ∙ " : "   " for el in m[i, :]), '\n') end

M = ulamspiral(9)
mprint(M)


object Ulam {
    fun generate(n: Int, i: Int = 1, c: Char = '*') {
        require(n > 1)
        val s = Array(n) { Array(n, { "" }) }
        var dir = Direction.RIGHT
        var y = n / 2
        var x = if (n % 2 == 0) y - 1 else y // shift left for even n's
        for (j in i..n * n - 1 + i) {
            s[y][x] = if (isPrime(j)) if (c.isDigit()) "%4d".format(j) else "  $c " else " ---"

            when (dir) {
                Direction.RIGHT -> if (x <= n - 1 && s[y - 1][x].none() && j > i) dir = Direction.UP
                Direction.UP -> if (s[y][x - 1].none()) dir = Direction.LEFT
                Direction.LEFT -> if (x == 0 || s[y + 1][x].none()) dir = Direction.DOWN
                Direction.DOWN -> if (s[y][x + 1].none()) dir = Direction.RIGHT
            }

            when (dir) {
                Direction.RIGHT -> x++
                Direction.UP -> y--
                Direction.LEFT -> x--
                Direction.DOWN -> y++
            }
        }
        for (row in s) println("[" + row.joinToString("") + ']')
        println()
    }

    private enum class Direction { RIGHT, UP, LEFT, DOWN }

    private fun isPrime(a: Int): Boolean {
        when {
            a == 2 -> return true
            a <= 1 || a % 2 == 0 -> return false
            else -> {
                val max = Math.sqrt(a.toDouble()).toInt()
                for (n in 3..max step 2)
                    if (a % n == 0) return false
                return true
            }
        }
    }
}

fun main(args: Array<String>) {
    Ulam.generate(9, c = '0')
    Ulam.generate(9)
}


local function ulamspiral(n, f)
  print("n = " .. n)
  local function isprime(p)
    if p < 2 then return false end
    if p % 2 == 0 then return p==2 end
    if p % 3 == 0 then return p==3 end
    local limit = math.sqrt(p)
    for f = 5, limit, 6 do
      if p % f == 0 or p % (f+2) == 0 then return false end
    end
    return true
  end
  local function spiral(x, y)
    if n%2==1 then x, y = n-1-x, n-1-y end
    local m = math.min(x, y, n-1-x, n-1-y)
    return x<y and (n-2*m-2)^2+(x-m)+(y-m) or (n-2*m)^2-(x-m)-(y-m)
  end
  for y = 0, n-1 do
    for x = 0, n-1 do
      io.write(f(isprime(spiral(x,y))))
    end
    print()
  end
  print()
end

-- filling a 132 column terminal (with a 2-wide glyph to better preserve aspect ratio)
ulamspiral(132/2, function(b) return b and "██" or "  " end)


ClearAll[iCCWSpiralEast]
iCCWSpiralEast[n_Integer]:=Table[(1/2 (-1)^# ({1,-1} (Abs[#^2-t]-#)+#^2-t-Mod[#,2])&)[Round[Sqrt[t]]],{t,0,n-1}]
n=20
start=1;
pts=iCCWSpiralEast[n^2];
pts=Pick[pts,PrimeQ[start+Range[n^2]-1],True];
grid=Table[({i,j}/.([email protected]@pts)->"#")/.{_,_}->" ",{j,Round[n/2],-Round[n/2],-1},{i,-Round[n/2],Round[n/2],1}];
Grid[grid]


import strutils

const N = 51  # Grid width and height.

type
  Vec2 = tuple[x, y: int]
  Grid = array[N, array[N, string]]

const Deltas: array[4, Vec2] = [(0, 1), (-1, 0), (0, -1), (1, 0)]

proc `+`(v1, v2: Vec2): Vec2 =
  ## Vector addition.
  (v1.x + v2.x, v1.y + v2.y)

proc isPrime(n: Positive): bool =
  ## Check if a number is prime.
  if n == 1: return false
  if (n and 1) == 0: return n == 2
  if (n mod 3) == 0: return n == 3
  var delta = 2
  var d = 5
  while d * d <= n:
    if n mod d == 0: return false
    inc d, delta
    delta = 6 - delta
  return true

proc fill(grid: var Grid; start: Positive = 1) =
  ## Fill the grid using Ulam algorithm.

  template isEmpty(pos: Vec2): bool = grid[pos.x][pos.y].len == 0

  # Fill the grid with successive numbers (as strings).
  var pos: Vec2 = (N div 2, N div 2)
  grid[pos.x][pos.y] = $start
  var currIdx = 3
  for n in (start + 1)..<(start + N * N):
    let nextIdx = (currIdx + 1) and 3
    var nextPos = pos + Deltas[nextIdx]
    if nextPos.isEmpty():
      # Direction change is OK.
      currIdx = nextIdx
    else:
      # Continue in same direction.
      nextPos = pos + Deltas[currIdx]
    pos = move(nextPos)
    grid[pos.x][pos.y] = $n

  # Replace the values with a symbol (if prime) or a space (if composite).
  for row in 0..<N:
    for col in 0..<N:
      grid[row][col] = if grid[row][col].parseInt().isPrime(): "• " else: "  "

var grid: Grid
grid.fill()
for row in grid:
  echo row.join()


\\ Ulam spiral (plotting/printing)
\\ 4/19/16 aev
plotulamspir(n,pflg=0)={
my(n=if(n%2==0,n++,n),M=matrix(n,n),x,y,xmx,ymx,cnt,dir,n2=n*n,pch,sz=#Str(n2),pch2=srepeat(" ",sz));
if(pflg<0||pflg>2,pflg=0);
print(" *** Ulam spiral: ",n,"x",n," matrix, p-flag=",pflg);
x=y=n\2+1; xmx=ymx=cnt=1; dir="R";
for(i=1,n2,
    if(isprime(i), if(!insm(M,x,y), break); if(pflg==2, M[y,x]=i, M[y,x]=1));
    if(dir=="R", if(xmx>0, x++;xmx--, dir="U";ymx=cnt;y--;ymx--); next);
    if(dir=="U", if(ymx>0, y--;ymx--, dir="L";cnt++;xmx=cnt;x--;xmx--); next);
    if(dir=="L", if(xmx>0, x--;xmx--, dir="D";ymx=cnt;y++;ymx--); next);
    if(dir=="D", if(ymx>0, y++;ymx--, dir="R";cnt++;xmx=cnt;x++;xmx--); next);
   );\\fend
\\Plot/Print according to the p-flag(0-real plot,1-"*",2-primes)
if(pflg==0, plotmat(M));
if(pflg==1, for(i=1,n,
            for(j=1,n, if(M[i,j]==1, pch="*", pch=" ");
                       print1(" ",pch)); print(" ")));
if(pflg==2, for(i=1,n,
            for(j=1,n, if(M[i,j]==0, pch=pch2, pch=spad(Str(M[i,j]),sz,,1));
                       print1(" ",pch)); print(" ")));
}

{\\ Executing:
plotulamspir(9,1); \\ (see output)
plotulamspir(9,2); \\ (see output)
plotulamspir(100); \\ ULAMspiral1.png
plotulamspir(200); \\ ULAMspiral2.png
}


Program Ulam; Uses crt;
{Concocted by R.N.McLean (whom God preserve), ex Victoria university, NZ.}
{$B- evaluate boolean expressions only so far as necessary.}
{$R+ range checking...}

 FUNCTION Trim(S : string) : string;
  var L1,L2 : integer;
 BEGIN
  L1 := 1;
  WHILE (L1 <= LENGTH(S)) AND (S[L1] = ' ') DO INC(L1);
  L2 := LENGTH(S);
  WHILE (S[L2] = ' ') AND (L2 > L1) DO DEC(L2);
  IF L2 >= L1 THEN Trim := COPY(S,L1,L2 - L1 + 1) ELSE Trim := '';
 END; {Of Trim.}

FUNCTION Ifmt(Digits : integer) : string;
 var  S : string[255];
 BEGIN
  STR(Digits,S);
  Ifmt := Trim(S);
 END; { Ifmt }
 Function min(i,j: integer): integer;
  begin
   if i <= j then min:=i else min:=j;
  end;
 Procedure Croak(Gasp: string);        {A lethal word.}
  Begin
   WriteLn;
   WriteLn(Gasp);
   HALT;                   {This way to the egress...}
  End;
 var ScreenLine,ScreenColumn: byte;	{Line and column position.}
{=========================enough support===================}
 const Mstyle = 6;	{Display different results.}
 const StyleName: array[1..Mstyle] of string = ('IsPrime','First Prime Factor Index',
  'First Prime Factor','Number of Prime Factors',
  'Sum of Prime Factors','Sum of Proper Factors');
 const OrderLimit = 49; Limit2 = OrderLimit*OrderLimit;		{A 50-line screen has room for a heading.}
 var Tile: array[1..OrderLimit,1..OrderLimit] of integer; 	{Alas, can't put [Order,Order], only constants.}
 var FirstPrimeFactorIndex,FirstPrimeFactor,NumPFactor,SumPFactor,SumFactor: array[1..Limit2] of integer;
 const enuffP = 17;	{Given the value of Limit2.}
 const Prime: array[1..enuffP] of integer = (1,2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53);
 Procedure Prepare;	{Various arrays are to be filled for the different styles.}
  var i,j,p: integer;
  Begin
   for i:=1 to limit2 do	{Alas, can't just put A:=0;}
    begin			{Nor clear A;}
     FirstPrimeFactorIndex[i]:=1;	{Prime[1] = 1, so this means no other divisor.}
     FirstPrimeFactor[i]:=0;
     NumPFactor[i]:=0;
     SumPFactor[i]:=0;
     SumFactor[i]:=1;		{1 is counted as a proper factor.}
    end;
   FirstPrimeFactorIndex[1]:=0;	{Fiddle, as 1 is not a prime number.}
   SumFactor[1]:=0;		{N is not a proper factor of N, so 1 has no proper factors...}
   for i:=2 to enuffP do	{Prime[1] = 1, Prime[2] = 2, so start with i = 2.}
    begin
     p:=Prime[i];
     j:=p + p;
     while j <= Limit2 do
      begin
       if FirstPrimeFactorIndex[j] = 1 then FirstPrimeFactorIndex[j]:=i;
       if FirstPrimeFactor[j] = 0 then FirstPrimeFactor[j]:=p;
       SumPFactor[j]:=SumPFactor[j] + p;
       inc(NumPFactor[j]);
       j:=j + p;
      end;
    end;
   for i:=2 to Limit2 div 2 do	{Step through all possible proper factors.}
    begin			{N is not a proper factor of N, so start at 2N,}
     j:=2*i;	 		{for which N is a proper factor of 2N.}
     while j <= Limit2 do	{Sigh. for j:=2*i:Limit2:i do ... Next i;}
      begin
       SumFactor[j]:=SumFactor[j] + i;
       j:=j + i;
      end;
    end;
  End;	{Enough preparation.}

 const enuffC = 11;	{Perhaps the colours will highlight interesting patterns.}
 const colour:array[0..enuffC] of byte = (black,white,LightRed,
  LightMagenta,Yellow,LightGreen,LightCyan,LightBlue,LightGray,
  Red,Green,DarkGray);		{Colours on the screen don't always match their name!}

 Procedure UlamSpiral(Order,Start,Style: integer);	{Generate the numbers, then display.}
  Function Encode(N: integer): integer;	{Acording to Style, choose a result to show.}
   Begin
    if N <= 1 then Encode:=0
     else
      case style of
     1:if FirstPrimeFactorIndex[N] = 1 then Encode:=1 else Encode:=0;	{1 = Prime.}
     2:Encode:=FirstPrimeFactorIndex[N];
     3:Encode:=FirstPrimeFactor[N];
     4:Encode:=NumPFactor[N];
     5:Encode:=SumPFactor[N];
     6:Encode:=SumFactor[N];
      end;
   End;	{So much for encoding.}
  var Place,Way: array[1..2] of integer;	{Complex numbers.}
  var m,	{Middle.}
      N,	{Counter.}
      length,	{length of a side.}
      lunge,	{two lunges for each length.}
      step	{steps to make up a lunge of some length.}
      : integer;
  var i,j: integer;	{Steppers.}
  var code,it: integer;	{Mess with the results.}
  label XX;		{Escape the second lunge.}
  var OutF: text;	{Utter drivel. It is a disc file.}
  Begin
   Write('Ulam Spiral, order ',Order,', start ',Start,', style ',style);	{Start the heading.}
   if style <= 0 then Croak('Must be a positive style');
   if style > Mstyle then croak('Last known style is '+ifmt(Mstyle));
   if Order > OrderLimit then Croak('Array OrderLimit is order '+IFmt(OrderLimit));
   if Order mod 2 <>1 then Croak('The order must be an odd number!');
   writeln(': ',StyleName[Style]);	{Finish the heading. The pattern starts with line two.}
   Assign(OutF,'Ulam.txt'); Rewrite(OutF); Writeln(OutF,'Ulam spiral: the codes for ',StyleName[style]);
   m:=order div 2 + 1;		{This is why Order must be odd.}
   Place[1]:=m; Place[2]:=m;	{Start at the middle.}
   way[1]:=1; way[2]:=0;	{Initial direction is along the x-axis.}
   n:=Start;
   for length:=1 to Order do	{Advance through the lengths.}
    for lunge:=1 to 2 do		{Two lunges for each length.}
     begin
      for step:=1 to length do			{Make the steps.}
       begin
        Tile[Place[1],Place[2]]:=N;
        for i:=1 to 2 do Place[i]:=Place[i] + Way[i];   {Place:=Place + Way;}
        N:=N + 1;
       end;
      if N >= Order*Order then goto XX;	{Each corner piece is part of two lunges.}
      i:=Way[1]; Way[1]:=-Way[2]; Way[2]:=i;	{Way:=Way*(0,1) in complex numbers: (x,y)*(0,1) = (-y,x).}
     end;
XX:for i:=order downto 1 do     {Output: Lines count downwards, y runs upwards.}
    begin			{The first line is the topmost y.}
     for j:=1 to order do	{(line,column) = (y,x).}
      begin				{Work along the line.}
       it:=Tile[j,i];			{Grab the number.}
       code:=Encode(it);		{Presentation scheme.}
       Write(OutF,'(',it:4,':',code:2,')');	{Debugging...}
       if FirstPrimeFactorIndex[it] > 1 then TextBackGround(Black)	{Not a prime.}
        else if it = 1 then TextBackGround(Black)	{Darkness for one, also.}
         else TextBackGround(White);		{A prime number!}
       TextColor(Colour[min(code,enuffC)]);	{A lot of fuss for this!}
       {Write(code:2);}
       {Write(it:3);}
       if it <= 9 then write(it) else Write('*');	{Thus mark the centre.}
      end;					{Next position along the line.}
     if i > 1 then WriteLn;		{Ending the last line would scroll the heading up.}
     WriteLn(OutF);			{But this is good for the text file.}
    end;			{On to the next line.}
    Close(OutF);		{Finished with the trace.}
{Some revelations to help in choosing a colour sequence.}
    ScreenLine:=WhereY; ScreenColumn:=WhereX;	{Gibberish to find the location.}
    if Style > 1 then	{Only the fancier styles go beyond 0 and 1.}
     begin			{So explain only for them.}
      GoToXY(ScreenColumn + 1,ScreenLine - 4);		{Unused space is to the right.}
      TextColor(White); write('Colour sequence');	{Given 80-column displays.}
      GoToXY(ScreenColumn + 1,ScreenLine - 3);		{And no more than 50 lines.}
      for i:=1 to enuffC do begin TextColor(Colour[i]); write(i); end;	{My sequence.}
      GoToXY(ScreenColumn + 1,ScreenLine - 2);
      TextColor(White); write('From options');
      GoToXY(ScreenColumn + 1,ScreenLine - 1);
      for i:=1 to 15 do begin TextColor(i);write(i); end;		{The options.}
     end;
  End;   {of UlamSpiral.}

 var start,wot,order: integer;	{A selector.}
 BEGIN	{After all that.}
  TextMode(Lo(LastMode) + Font8x8);	{Gibberish sets 43 lines on EGA and 50 on VGA.}
  ClrScr; TextColor(White);		{This also gives character blocks that are almost square...}
  WriteLn('Presents consecutive integers in a spiral, as per Stanislaw Ulam.');
  WriteLn('Starting with 1, runs up to Order*Order.');
  Write('What value for Order? (Limit ' + Ifmt(OrderLimit),'): ');
  ReadLn(Order);			{ReadKey needs no "enter", but requires decoding.}
  if (order < 1) or (order > OrderLimit) then Croak('Out of range!');	{Oh dear.}
  Prepare;
  wot:=1;	{The original task.}
  Repeat		{Until bored?}
   ClrScr;			{Scrub any previous stuff.}
   UlamSpiral(Order,1,wot);		{The deed!}
   GoToXY(ScreenColumn + 1,ScreenLine);		{Note that the last WriteLn was skipped.}
   TextColor(White); Write('Enter 0, or 1 to '+Ifmt(Mstyle),': ');	{Wot now?}
   ReadLn(wot);						{Receive.}
  Until (wot <= 0) or (wot > Mstyle);		{Alas, "Enter" must be pressed.}
 END.


use ntheory qw/is_prime/;
use Imager;

my $n = shift || 512;
my $start = shift || 1;
my $file = "ulam.png";

sub cell {
  my($n, $x, $y, $start) = @_;
  $y -= $n>>1;
  $x -= ($n-1)>>1;
  my $l = 2*(abs($x) > abs($y) ? abs($x) : abs($y));
  my $d = ($y > $x)  ?  $l*3 + $x + $y  : $l-$x-$y;
  ($l-1)**2 + $d + $start - 1;
}

my $black = Imager::Color->new('#000000');
my $white = Imager::Color->new('#FFFFFF');
my $img = Imager->new(xsize => $n, ysize => $n, channels => 1);
$img->box(filled=>1, color=>$white);

for my $y (0 .. $n-1) {
  for my $x (0 .. $n-1) {
    my $v = cell($n, $x, $y, $start);
    $img->setpixel(x => $x, y => $y, color => $black) if is_prime($v);
  }
}

$img->write(file => $file) or die "Cannot write $file: ", $img->errstr, "\n";


with javascript_semantics
function spiral(integer w, h, x, y)
    return iff(y?w+spiral(h-1,w,y-1,w-x-1):x)
end function

integer w = 9, h = 9
for i=h-1 to 0 by -1 do
    for j=w-1 to 0 by -1 do
        integer p = w*h-spiral(w,h,j,i)
        puts(1,"o "[2-is_prime(p)])
    end for
    puts(1,'\n')
end for


(load "@lib/simul.l")

(de ceil (A)
   (/ (+ A 1) 2) )

(de prime? (N)
   (or
      (= N 2)
      (and
         (> N 1)
         (bit? 1 N)
         (let S (sqrt N)
            (for (D 3  T  (+ D 2))
               (T (> D S) T)
               (T (=0 (% N D)) NIL) ) ) ) ) )

(de ulam (N)
   (let
      (G (grid N N)
         D '(north west south east .)
         M (ceil N) )
      (setq This
         (intern
            (pack
               (char
                  (+ 96 (if (bit? 1 N) M (inc M))) )
               M ) ) )
      (=: V '_)
      (with ((car D) This)
         (for (X 2 (>= (* N N) X) (inc X))
            (=: V (if (prime? X) '. '_))
            (setq This
               (or
                  (with ((cadr D) This)
                     (unless (: V) (pop 'D) This) )
                  ((pop D) This) ) ) ) )
      G ) )

(mapc
   '((L)
      (for This L
         (prin (align 3 (: V))) )
      (prinl) )
   (ulam 9) )

(bye)


function New-UlamSpiral ( [int]$N )
    {
    #  Generate list of primes
    $Primes = @( 2 )
    For ( $X = 3; $X -le $N*$N; $X += 2 )
        {
        If ( -not ( $Primes | Where { $X % $_ -eq 0 } | Select -First 1 ) ) { $Primes += $X }
        }

    #  Initialize variables
    $X = 0
    $Y = -1
    $i = $N * $N + 1
    $Sign = 1

    #  Intialize array
    $A = New-Object 'boolean[,]' $N, $N

    #  Set top row
    1..$N | ForEach { $Y += $Sign; $A[$X,$Y] = --$i -in $Primes }

    #  For each remaining half spiral...
    ForEach ( $M in ($N-1)..1 )
        {
        #  Set the vertical quarter spiral
        1..$M | ForEach { $X += $Sign; $A[$X,$Y] = --$i -in $Primes }

        #  Curve the spiral
        $Sign = -$Sign

        #  Set the horizontal quarter spiral
        1..$M | ForEach { $Y += $Sign; $A[$X,$Y] = --$i -in $Primes }
        }

    #  Convert the array of booleans to text output of dots and spaces
    $Spiral = ForEach ( $X in 1..$N ) { ( 1..$N | ForEach { ( ' ', '.' )[$A[($X-1),($_-1)]] } ) -join '' }
    return $Spiral
    }

New-UlamSpiral 100


# coding=UTF-8
from __future__ import print_function, division
from math import sqrt

def cell(n, x, y, start=1):
    d, y, x = 0, y - n//2, x - (n - 1)//2
    l = 2*max(abs(x), abs(y))
    d = (l*3 + x + y) if y >= x else (l - x - y)
    return (l - 1)**2 + d + start - 1

def show_spiral(n, symbol='# ', start=1, space=None):
    top = start + n*n + 1
    is_prime = [False,False,True] + [True,False]*(top//2)
    for x in range(3, 1 + int(sqrt(top))):
        if not is_prime[x]: continue
        for i in range(x*x, top, x*2):
            is_prime[i] = False

    cell_str = lambda x: f(x) if is_prime[x] else space
    f = lambda _: symbol # how to show prime cells

    if space == None: space = ' '*len(symbol)

    if not len(symbol): # print numbers instead
        max_str = len(str(n*n + start - 1))
        if space == None: space = '.'*max_str + ' '
        f = lambda x: ('%' + str(max_str) + 'd ')%x

    for y in range(n):
        print(''.join(cell_str(v) for v in [cell(n, x, y, start) for x in range(n)]))
    print()

show_spiral(10, symbol=u'♞', space=u'♘') # black are the primes
show_spiral(9, symbol='', space=' - ')
# for filling giant terminals
#show_spiral(1001, symbol='*', start=42)


## Plotting Ulam spiral (for primes) 2/12/17 aev
## plotulamspirR(n, clr, fn, ttl, psz=600), where: n - initial size;
## clr - color; fn - file name; ttl - plot title; psz - picture size.
##
require(numbers);
plotulamspirR <- function(n, clr, fn, ttl, psz=600) {
  cat(" *** START:", date(), "n=",n, "clr=",clr, "psz=", psz, "\n");
  if (n%%2==0) {n=n+1}; n2=n*n;
  x=y=floor(n/2); xmx=ymx=cnt=1; dir="R";
  ttl= paste(c(ttl, n,"x",n," matrix."), sep="", collapse="");
  cat(" ***", ttl, "\n");
  M <- matrix(c(0), ncol=n, nrow=n, byrow=TRUE);
  for (i in 1:n2) {
    if(isPrime(i)) {M[x,y]=1};
    if(dir=="R") {if(xmx>0) {x=x+1;xmx=xmx-1}
                  else {dir="U";ymx=cnt;y=y-1;ymx=ymx-1}; next};
    if(dir=="U") {if(ymx>0) {y=y-1;ymx=ymx-1}
                  else {dir="L";cnt=cnt+1;xmx=cnt;x=x-1;xmx=xmx-1}; next};
    if(dir=="L") {if(xmx>0) {x=x-1;xmx=xmx-1}
                  else {dir="D";ymx=cnt;y=y+1;ymx=ymx-1}; next};
    if(dir=="D") {if(ymx>0) {y=y+1;ymx=ymx-1}
                  else {dir="R";cnt=cnt+1;xmx=cnt;x=x+1;xmx=xmx-1}; next};
  };
  plotmat(M, fn, clr, ttl,,psz);
  cat(" *** END:",date(),"\n");
}

## Executing:
plotulamspirR(100, "red", "UlamSpiralR1", "Ulam Spiral: ");
plotulamspirR(200, "red", "UlamSpiralR2", "Ulam Spiral: ",1240);


#lang racket
(require (only-in math/number-theory prime?))

(define ((cell-fn n (start 1)) x y)
  (let* ((y (- y (quotient n 2)))
         (x (- x (quotient (sub1 n) 2)))
         (l (* 2 (if (> (abs x) (abs y)) (abs x) (abs y))))
         (d (if (>= y x) (+ (* l 3) x y) (- l x y))))
    (+ (sqr (- l 1)) d start -1)))

(define (show-spiral n
                     #:symbol (smb "# ")
                     #:start (start 1)
                     #:space (space (and smb (make-string (string-length smb) #\space))))
  (define top (+ start (* n n) 1))
  (define cell (cell-fn n start))
  (define print-cell
    (if smb
        (λ (i p?) (display (if p? smb space)))
        (let* ((max-len (string-length (~a (+ (sqr n) start -1))))
               (space (or space (make-string (string-length (~a (+ (sqr n) start -1))) #\_))))
          (λ (i p?)
            (display (if p? (~a #:width max-len i #:align 'right) space))
            (display #\space)))))

  (for* ((y (in-range 0 n)) #:when (unless (= y 0) (newline)) (x (in-range 0 n)))
    (define c (cell x y))
    (define p? (prime? c))
    (print-cell c p?))
  (newline))

(show-spiral 9 #:symbol #f)
(show-spiral 10 #:symbol "♞" #:space "♘") ; black are the primes
(show-spiral 50 #:symbol "*" #:start 42)
; for filling giant terminals
; (show-spiral 1001 #:symbol "*" #:start 42)


sub MAIN($max = 160, $start = 1) {
    (my %world){0}{0} = 0;
    my $loc = 0+0i;
    my $dir = 1;
    my $n = $start;
    my $side = 0;

    while ++$side < $max {
	step for ^$side;
	turn-left;
	step for ^$side;
	turn-left;
    }

    braille-graphics %world;

    sub step {
	$loc += $dir;
	%world{$loc.im}{$loc.re} = $n if (++$n).is-prime;
    }

    sub turn-left  { $dir *= -i; }
    sub turn-right { $dir *= i; }

}

sub braille-graphics (%a) {
    my ($ylo, $yhi, $xlo, $xhi);
    for %a.keys -> $y {
	$ylo min= +$y; $yhi max= +$y;
	for %a{$y}.keys -> $x {
	    $xlo min= +$x; $xhi max= +$x;
	}
    }

    for $ylo, $ylo + 4 ...^ * > $yhi -> \y {
	for $xlo, $xlo + 2 ...^ * > $xhi -> \x {
	    my $cell = 0x2800;
	    $cell += 1   if %a{y + 0}{x + 0};
	    $cell += 2   if %a{y + 1}{x + 0};
	    $cell += 4   if %a{y + 2}{x + 0};
	    $cell += 8   if %a{y + 0}{x + 1};
	    $cell += 16  if %a{y + 1}{x + 1};
	    $cell += 32  if %a{y + 2}{x + 1};
	    $cell += 64  if %a{y + 3}{x + 0};
	    $cell += 128 if %a{y + 3}{x + 1};
	    print chr($cell);
	}
	print "\n";
    }
}


/*REXX program shows counter─clockwise  Ulam spiral  of primes shown in a square matrix.*/
parse arg size init char .                       /*obtain optional arguments from the CL*/
if size=='' | size==","  then size= 79           /*Not specified?  Then use the default.*/
if init=='' | init==","  then init=  1           /* "      "         "   "   "     "    */
if char==''              then char= "█"          /* "      "         "   "   "     "    */
tot=size**2                                      /*the total number of numbers in spiral*/
                                                 /*define the upper/bottom right corners*/
uR.=0; bR.=0;   do od=1  by 2  to tot;  _=od**2+1;  uR._=1;  _=_+od;   bR._=1;  end /*od*/
                                                 /*define the bottom/upper left corners.*/
bL.=0; uL.=0;   do ev=2  by 2  to tot;  _=ev**2+1;  bL._=1;  _=_+ev;   uL._=1;  end /*ev*/

app=1;    bigP=0;    #p=0;    inc=0;     minR=1;    maxR=1;    r=1;    $=0;    $.=;    !.=
                     /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ construct the spiral #s.*/
  do i=init  for tot;    r= r + inc;     minR= min(minR, r);      maxR= max(maxR, r)
  x= isPrime(i);   if x  then bigP= max(bigP, i);          #p= #p + x   /*bigP, #primes.*/
  if app  then $.r= $.r ||  x                                           /*append  token.*/
          else $.r=  x  || $.r                                          /*prepend token.*/
  if uR.i  then do;  app= 1;  inc= +1;  iterate  /*i*/;    end          /*advance  ↓    */
  if bL.i  then do;  app= 0;  inc= -1;  iterate  /*i*/;    end          /*   "     ↑    */
  if bR.i  then do;  app= 0;  inc=  0;  iterate  /*i*/;    end          /*   "     ►    */
  if uL.i  then do;  app= 1;  inc=  0;  iterate  /*i*/;    end          /*   "     ◄    */
  end   /*i*/                                                           /* [↓] pack two */
                                                                        /*lines ──► one.*/
  do j=minR  to maxR  by 2;    jp= j + 1;              $= $ + 1         /*fold two lines*/
    do k=1  for  length($.j);  top= substr($.j, k, 1)                   /*the  1st line.*/
                               bot= word( substr($.jp, k, 1)   0, 1)    /*the  2nd line.*/
    if top  then if  bot  then !.$= !.$'█'                              /*has top & bot.*/
                          else !.$= !.$'▀'                              /*has top,¬ bot.*/
            else if  bot  then !.$= !.$'▄'                              /*¬ top, has bot*/
                          else !.$= !.$' '                              /*¬ top,   ¬ bot*/
    end   /*k*/
  end     /*j*/                                  /* [↓]  show the  prime  spiral matrix.*/
                                    do m=1  for $;     say !.m;     end  /*m*/
say;  say init 'is the starting point,'  ,
          tot  'numbers used,'   #p   "primes found, largest prime:"   bigP
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isPrime: procedure; parse arg x;  if wordpos(x, '2 3 5 7 11 13 17 19') \==0  then return 1
         if x<17  then return 0;                            if x// 2    ==0  then return 0
                                                            if x// 3    ==0  then return 0
         /*get the last digit*/    parse var x  ''  -1  _;  if         _==5  then return 0
                                                            if x// 7    ==0  then return 0
                                                            if x//11    ==0  then return 0
                                                            if x//13    ==0  then return 0

                  do j=17  by 6  until  j*j > x;            if x//j     ==0  then return 0
                                                            if x//(j+2) ==0  then return 0
                  end   /*j*/;          return 1


# Project : Ulam spiral (for primes)

load "guilib.ring"
load "stdlib.ring"

paint = null

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

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

        usn = 81
        ulamspiral(usn)

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

func ulamspiral(nr)
        button = list(nr)
        win1{
                sizenew = sqrt(nr)
                 for n = 1 to nr
                     col = n%9
                     if col = 0 col = 9 ok
                     row = ceil(n/9)

                     button[n] = new qpushbutton(win1)
                     {
                                        setgeometry(60+col*40,60+row*40,40,40)
                                        setclickevent("movetile(" + string(n) +")")
                                        show()
                     }
                next
        n = 9
        result = newlist(n,n)
        k = 1
        top = 1
        bottom = n
        left = 1
        right = n
        while (k<=n*n)
                 for i=left to right
                      result[top][i]=k
                      k = k + 1
                 next
                 top = top + 1
                 for i=top to bottom
                     result[i][right]=k
                     k = k + 1
                 next
                 right = right - 1
                 for i=right to left step -1
                      result[bottom][i]=k
                      k = k + 1
                 next
                 bottom = bottom - 1
                 for i=bottom to top step -1
                      result[i][left] = k
                      k = k + 1
                 next
                 left = left + 1
        end
        for m = 1 to n
             for p = 1 to n
                  pos = (m-1)*n + p
                  if isprime(result[m][p])
                     button[pos] {settext(string(result[m][p]))}
                  ok
             next
         next
         }


require 'prime'

def cell(n, x, y, start=1)
  y, x = y - n/2, x - (n - 1)/2
  l = 2 * [x.abs, y.abs].max
  d = y >= x ? l*3 + x + y : l - x - y
  (l - 1)**2 + d + start - 1
end

def show_spiral(n, symbol=nil, start=1)
  puts "\nN : #{n}"
  format = "%#{(start + n*n - 1).to_s.size}s "
  n.times do |y|
    n.times do |x|
      i = cell(n,x,y,start)
      if symbol
        print i.prime? ? symbol[0] : symbol[1]
      else
        print format % (i.prime? ? i : '')
      end
    end
    puts
  end
end

show_spiral(9)
show_spiral(25)
show_spiral(25, "# ")


use std::fmt;

enum Direction { RIGHT, UP, LEFT, DOWN }
use ulam::Direction::*;

/// Indicates whether an integer is a prime number or not.
fn is_prime(a: u32) -> bool {
    match a {
        2 => true,
        x if x <= 1 || x % 2 == 0 => false,
        _ => {
            let max = f64::sqrt(a as f64) as u32;
            let mut x =  3;
            while x <= max {
                if a % x == 0 { return false; }
                x += 2;
            }
            true
        }
    }
}

pub struct Ulam { u : Vec<Vec<String>> }

impl Ulam {
    /// Generates one `Ulam` object.
    pub fn new(n: u32, s: u32, c: char) -> Ulam {
        let mut spiral = vec![vec![String::new(); n as usize]; n as usize];
        let mut dir = RIGHT;
        let mut y = (n / 2) as usize;
        let mut x = if n % 2 == 0 { y - 1 } else { y }; // shift left for even n's
        for j in s..n * n + s {
            spiral[y][x] = if is_prime(j) {
                if c == '\0' { format!("{:4}", j) } else { format!("  {} ", c) }
            }
            else { String::from(" ---") };

            match dir {
                RIGHT => if x as u32 <= n - 1 && spiral[y - 1][x].is_empty() && j > s { dir = UP; },
                UP => if spiral[y][x - 1].is_empty() { dir = LEFT; },
                LEFT => if x == 0 || spiral[y + 1][x].is_empty() { dir = DOWN; },
                DOWN => if spiral[y][x + 1].is_empty() { dir = RIGHT; }
            };

            match dir { RIGHT => x += 1, UP => y -= 1, LEFT => x -= 1, DOWN => y += 1 };
        }
        Ulam { u: spiral }
    }
}

impl fmt::Display for Ulam {
    fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
        for row in &self.u {
            writeln!(f, "{}", format!("{:?}", row).replace("\"", "").replace(", ", ""));
        };
        writeln!(f, "")
    }
}


object Ulam extends App {
    generate(9)()
    generate(9)('*')

    private object Direction extends Enumeration { val RIGHT, UP, LEFT, DOWN = Value }

    private def generate(n: Int, i: Int = 1)(c: Char = 0) {
        assert(n > 1, "n > 1")
        val s = new Array[Array[String]](n).transform {_ => new Array[String](n) }

        import Direction._
        var dir = RIGHT
        var y = n / 2
        var x = if (n % 2 == 0) y - 1 else y // shift left for even n's
        for (j <- i to n * n - 1 + i) {
            s(y)(x) = if (isPrime(j)) if (c == 0) "%4d".format(j) else s"  $c " else " ---"

            dir match {
                case RIGHT => if (x <= n - 1 && s(y - 1)(x) == null && j > i) dir = UP
                case UP => if (s(y)(x - 1) == null) dir = LEFT
                case LEFT => if (x == 0 || s(y + 1)(x) == null) dir = DOWN
                case DOWN => if (s(y)(x + 1) == null) dir = RIGHT
            }

            dir match {
                case RIGHT => x += 1
                case UP => y -= 1
                case LEFT => x -= 1
                case DOWN => y += 1
            }
        }
        println("[" + s.map(_.mkString("")).reduceLeft(_ + "]\n[" + _) + "]\n")
    }

    private def isPrime(a: Int): Boolean = {
        if (a == 2) return true
        if (a <= 1 || a % 2 == 0) return false
        val max = Math.sqrt(a.toDouble).toInt
        for (n <- 3 to max by 2)
            if (a % n == 0) return false
        true
    }
}


require('Imager')

var (n=512, start=1, file='ulam.png')

ARGV.getopt(
    'n=i' => \n,
    's=i' => \start,
    'f=s' => \file,
)

func cell(n, x, y, start) {
    y -= (n   >> 1)
    x -= (n-1 >> 1)
    var l = 2*(x.abs > y.abs ? x.abs : y.abs)
    var d = (y > x ? (l*3 + x + y) : (l - x - y))
    (l-1)**2 + d + start - 1
}

var black = %O<Imager::Color>.new('#000000')
var white = %O<Imager::Color>.new('#FFFFFF')

var img = %O<Imager>.new(xsize => n, ysize => n, channels => 1)
img.box(filled => 1, color => white)

for y=(^n), x=(^n) {
    if (cell(n, x, y, start).is_prime) {
        img.setpixel(x => x, y => y, color => black)
    }
}

img.write(file => file)


proc is_prime {n} {
    if {$n == 1} {return 0}
    if {$n in {2 3 5}} {return 1}
    for {set i 2} {$i*$i <= $n} {incr i} {
        if {$n % $i == 0} {return 0}
    }
    return 1
}

proc spiral {w h} {
    yield [info coroutine]
    set x [expr {$w / 2}]
    set y [expr {$h / 2}]
    set n 1
    set dir 0
    set steps 1
    set step 1
    while {1} {
        yield [list $x $y]
        switch $dir {
            0   {incr x}
            1   {incr y -1}
            2   {incr x -1}
            3   {incr y}
        }
        if {![incr step -1]} {
            set dir [expr {($dir+1)%4}]
            if {$dir % 2 == 0} {
                incr steps
            }
            set step $steps
        }
    }
}

set radius 16
set side  [expr {1 + 2 * $radius}]
set n     [expr {$side * $side}]
set cells [lrepeat $side [lrepeat $side ""]]
set i     1

coroutine spin spiral $side $side

while {$i < $n} {
    lassign [spin] y x
    set c [expr {[is_prime $i] ? "\u169b" : " "}]
    lset cells $x $y $c
    incr i
}

puts [join [lmap row $cells {join $row " "}] \n]


Function build_spiral(n)
	'declare a two dimentional array
	Dim matrix()
	ReDim matrix(n-1,n-1)
	'determine starting point
	x = (n-1)/2 : y = (n-1)/2
	'set the initial iterations
	x_max = 1 : y_max = 1 : count = 1
	'set initial direction
	dir = "R"
	'populate the array
	For i = 1 To n*n
		l = Len(n*n)
		If IsPrime(i) Then
			matrix(x,y) = Right("000" & i,l)
		Else
			matrix(x,y) = String(l,"-")
		End If
		Select Case dir
			Case "R"
				If x_max > 0 Then
					x = x + 1 : x_max = x_max - 1
				Else
					dir = "U" : y_max = count
					y = y - 1 : y_max = y_max - 1
				End If
			Case "U"
				If y_max > 0 Then
					y = y - 1 : y_max = y_max - 1
				Else
					dir = "L" : count = count + 1 : x_max = count
					x = x - 1 : x_max = x_max - 1
				End If
			Case "L"
				If x_max > 0 Then
					x = x - 1 : x_max = x_max - 1
				Else
					dir = "D" : y_max = count
					y = y + 1 : y_max = y_max - 1
				End If
			Case "D"
				If y_max > 0 Then
					y = y + 1 : y_max = y_max - 1
				Else
					dir = "R" : count = count + 1 : x_max = count
					x = x + 1 : x_max = x_max - 1
				End If
		End Select
	Next
	'print the matrix
	For y = 0 To n - 1
		For x = 0 To n - 1
			If x = n - 1 Then
				WScript.StdOut.Write matrix(x,y)
			Else
				WScript.StdOut.Write matrix(x,y) & vbTab
			End If
		Next
		WScript.StdOut.WriteLine
	Next
End Function

Function IsPrime(n)
	If n = 2 Then
		IsPrime = True
	ElseIf n <= 1 Or n Mod 2 = 0 Then
		IsPrime = False
	Else
		IsPrime = True
		For i = 3 To Int(Sqr(n)) Step 2
			If n Mod i = 0 Then
				IsPrime = False
				Exit For
			End If
		Next
	End If
End Function

'test with 9
build_spiral(9)


import "/dynamic" for Enum
import "/math" for Int
import "/str" for Char
import "/fmt" for Fmt

var Direction = Enum.create("Direction", ["right", "up", "left", "down"])

class Ulam {
    static generate(n, i, c) {
        if (n <= 1) Fiber.abort ("'n' must be more than 1.")
        var s = List.filled(n, null)
        for (i in 0...n) s[i] = List.filled(n, "")
        var dir = Direction.right
        var y = (n/2).floor
        var x = (n % 2 == 0) ? y - 1 : y  // shift left for even n's
        for (j in i..n * n - 1 + i) {
            s[y][x] = Int.isPrime(j) ? (Char.isDigit(c) ? Fmt.d(4, j) : "  %(c) ") : " ---"
            if (dir == Direction.right) {
                if (x <= n - 1 && s[y - 1][x] == "" && j > i) dir = Direction.up
            } else if (dir == Direction.up) {
                if (s[y][x - 1] == "") dir = Direction.left
            } else if (dir == Direction.left) {
                if (x == 0 || s[y + 1][x] == "") dir = Direction.down
            } else if (dir == Direction.down) {
                if (s[y][x + 1] == "") dir = Direction.right
            }

            if (dir == Direction.right) {
                x = x + 1
            } else if (dir == Direction.up) {
                y = y - 1
            } else if (dir == Direction.left) {
                x = x - 1
            } else if (dir == Direction.down) {
                y = y + 1
            }
        }

        for (row in s) Fmt.print("$s", row)
        System.print()
    }
}

Ulam.generate(9, 1, "0") // with digits
Ulam.generate(9, 1, "*") // with *


func IsPrime(N);        \Return 'true' if N is prime
int  N, I;
[if N <= 2 then return N = 2;
if (N&1) = 0 then \even >2\ return false;
for I:= 3 to sqrt(N) do
    [if rem(N/I) = 0 then return false;
    I:= I+1;
    ];
return true;
];

int N, X, Y, Len, Dir, DX, DY, Side, Step;
[SetVid($13);
X:= 320/2;  Y:= 200/2;
N:= 1;
Len:= 1;
Dir:= 0;        \Rt, Up, Lt, Dn
DX:= [1, 0, -1, 0];
DY:= [0, -1, 0, 1];
repeat  for Side:= 1 to 2 do
            [for Step:= 1 to Len do
                [if IsPrime(N) then Point(X, Y, $F);
                N:= N+1;
                X:= X + DX(Dir); \move in current direction
                Y:= Y + DY(Dir);
                ];
            Dir:= (Dir+1) & 3;   \set next direction
            ];
        Len:= Len+1;
until   Y = 0;                  \reached top
]


sub is_prime(n)
    local p

    for p=2 to n
        if p*p>n break
        if mod(n,p)=0 return false
    next
    return n>=2
end sub

sub spiral(w, h, x, y)
    if y then
        return w+spiral(h-1,w,y-1,w-x-1)
    else
        return x
    end if
end sub

w = 9 : h = 9
for i=h-1 to 0 step -1
    for j=w-1 to 0 step -1
        p = w*h-spiral(w,h,j,i)
        print mid$(" o", is_prime(p) + 1, 1);
    next
    print
next


var primes =Utils.Generator(Import("sieve.zkl").postponed_sieve);  // lazy
var offsets=Utils.cycle( T(0,1),T(-1,0),T(0,-1),T(1,0) );  // (N,E,S,W), lazy
const BLACK=0, WHITE=0xff|ff|ff, GREEN=0x00|ff|00, EMPTY=0x080|80|80;
fcn uspiral(N){
   if((M:=N).isEven) M+=1;  // need odd width, height
   img,p := PPM(M,M,EMPTY), primes.next(); // 2 .. 250,007: 22,045 primes
   x,y,n := N/2,x,2; img[x,y]=GREEN; x+=1; // start on 2 facing "north"
   while(True){
      ox,oy:=offsets.next(); leftx,lefty:=offsets.peek();  // set direction
      while(True){
	 img[x,y]=( if(n==p){ p=primes.next(); WHITE } else BLACK );
	 if(n==N*N) break(2); // all done
	 n+=1;
	 if(img[x+leftx,y+lefty]==EMPTY) // nothing to my left, turn left
	    { x+=leftx; y+=lefty; break; }
	 x+=ox; y+=oy;	// move in a straight line
      }
   }
   img
}

uspiral(500).write(File("ulamSpiral.ppm","wb"));


[([Int] -> Bool)] predicates
predicates [+]= st -> st.len == 12
predicates [+]= st -> sum(st[(len)-6 ..]) == 3
predicates [+]= st -> sum(st[(1..).step(2)]) == 2
predicates [+]= st -> I st[4] {(st[5] [&] st[6])} E 1
predicates [+]= st -> sum(st[1.<4]) == 0
predicates [+]= st -> sum(st[(0..).step(2)]) == 4
predicates [+]= st -> sum(st[1.<3]) == 1
predicates [+]= st -> I st[6] {(st[4] [&] st[5])} E 1
predicates [+]= st -> sum(st[0.<6]) == 3
predicates [+]= st -> (st[10] [&] st[11])
predicates [+]= st -> sum(st[6.<9]) == 1
predicates [+]= st -> sum(st[0.<11]) == 4

F to_str(b)
   R (0.<12).filter(i -> @b[i]).map(i -> i + 1).join(‘ ’)

print(‘Exact hits:’)
L(n) 0 .< (1 << 12)
   V bools = [0] * 12
   L(i) 12
      I n [&] (1 << (11 - i)) != 0
         bools[i] = 1

   L(predicate) predicates
      I Int(predicate(bools)) != bools[L.index]
         L.break
   L.was_no_break
      print(‘    ’to_str(bools))

print("\nNear misses:")
L(n) 0 .< (1 << 12)
   V bools = [0] * 12
   L(i) 12
      I n [&] (1 << (11 - i)) != 0
         bools[i] = 1

   V count = 0
   L(predicate) predicates
      I Int(predicate(bools)) == bools[L.index]
         count++
   I count == 11
      L(predicate) predicates
         V i = L.index
         I Int(predicate(bools)) != bools[i]
            print(f:‘    (Fails at statement {i + 1:2})  {to_str(bools)}’)
            L.break


with Ada.Text_IO, Logic;

procedure Twelve_Statements is

   package L is new Logic(Number_Of_Statements => 12); use L;

   -- formally define the 12 statements as expression function predicates
   function P01(T: Table) return Boolean is (T'Length = 12);              -- list of 12 statements
   function P02(T: Table) return Boolean is (Sum(T(7 .. 12)) = 3);        -- three of last six
   function P03(T: Table) return Boolean is (Sum(Half(T, Even)) = 2);     -- two of the even
   function P04(T: Table) return Boolean is (if T(5) then T(6) and T(7)); -- if 5 is true, then ...
   function P05(T: Table) return Boolean is
      ( (not T(2)) and (not T(3)) and (not T(4)) );                       -- none of preceding three
   function P06(T: Table) return Boolean is (Sum(Half(T, Odd)) = 4);      -- four of the odd
   function P07(T: Table) return Boolean is (T(2) xor T(3));              -- either 2 or 3, not both
   function P08(T: Table) return Boolean is (if T(7) then T(5) and T(6)); -- if 7 is true, then ...
   function P09(T: Table) return Boolean is (Sum(T(1 .. 6)) = 3);         -- three of first six
   function P10(T: Table) return Boolean is (T(11) and T(12));            -- next two
   function P11(T: Table) return Boolean is (Sum(T(7..9)) = 1);           -- one of 7, 8, 9
   function P12(T: Table) return Boolean is (Sum(T(1 .. 11)) = 4);        -- four of the preding

   -- define a global list of statements
   Statement_List: constant Statements :=
     (P01'Access, P02'Access, P03'Access, P04'Access, P05'Access, P06'Access,
      P07'Access, P08'Access, P09'Access, P10'Access, P11'Access, P12'Access);

   -- try out all 2^12 possible choices for the table
   procedure Try(T: Table; Fail: Natural; Idx: Indices'Base := Indices'First) is

      procedure Print_Table(T: Table) is
	 use Ada.Text_IO;
      begin
	 Put("    ");
	 if Fail > 0 then
	    Put("(wrong at");
	    for J in T'Range loop
	       if Statement_List(J)(T) /= T(J) then
		  Put(Integer'Image(J) & (if J < 10 then ")  " else ") "));
	       end if;
	    end loop;
	 end if;
	 if T = (1..12 => False) then
	    Put_Line("All false!");
	 else
	    Put("True are");
	    for J in T'Range loop
	       if T(J) then
		  Put(Integer'Image(J));
	       end if;
	    end loop;
	    New_Line;
	 end if;
      end Print_Table;

      Wrong_Entries: Natural := 0;

   begin
      if Idx <= T'Last then
	 Try(T(T'First .. Idx-1) & False & T(Idx+1 .. T'Last), Fail, Idx+1);
	 Try(T(T'First .. Idx-1) & True  & T(Idx+1 .. T'Last), Fail, Idx+1);
      else -- now Index > T'Last and we have one of the 2^12 choices to test
	 for J in T'Range loop
	    if Statement_List(J)(T) /= T(J) then
	       Wrong_Entries := Wrong_Entries + 1;
	    end if;
	 end loop;
	 if Wrong_Entries = Fail then
	    Print_Table(T);
	 end if;
      end if;
   end Try;

begin
   Ada.Text_IO.Put_Line("Exact hits:");
   Try(T => (1..12 => False), Fail => 0);
   Ada.Text_IO.New_Line;
   Ada.Text_IO.Put_Line("Near Misses:");
   Try(T => (1..12 => False), Fail => 1);
end Twelve_Statements;


begin
    % we have 12 statements to determine the truth/falsehood of (see task)  %

    logical array stmt, expected( 1 :: 12 );

    % logical (boolean) to integer utility procedure                        %
    integer procedure toInteger ( logical value v ) ; if v then 1 else 0;

    % procedure to determine whether the statements are true or not         %
    procedure findExpectedValues ;
    begin
        expected(  1 ) := true;
        expected(  2 ) := 3 = ( toInteger( stmt(  7 ) ) + toInteger( stmt(  8 ) )
                              + toInteger( stmt(  9 ) ) + toInteger( stmt( 10 ) )
                              + toInteger( stmt( 11 ) ) + toInteger( stmt( 12 ) )
                              );
        expected(  3 ) := 2 = ( toInteger( stmt(  2 ) ) + toInteger( stmt(  4 ) )
                              + toInteger( stmt(  6 ) ) + toInteger( stmt(  8 ) )
                              + toInteger( stmt( 10 ) ) + toInteger( stmt( 12 ) )
                              );
        expected(  4 ) := ( not stmt( 5 ) ) or ( stmt( 6 ) and stmt( 7 ) );
        expected(  5 ) := not ( stmt( 2 ) or stmt( 3 ) or stmt( 4 ) );
        expected(  6 ) := 4 = ( toInteger( stmt(  1 ) ) + toInteger( stmt(  3 ) )
                              + toInteger( stmt(  5 ) ) + toInteger( stmt(  7 ) )
                              + toInteger( stmt(  9 ) ) + toInteger( stmt( 11 ) )
                              );
        expected(  7 ) := stmt( 2 ) not = stmt( 3 );
        expected(  8 ) := ( not stmt( 7 ) ) or ( stmt( 5 ) and stmt( 6 ) );
        expected(  9 ) := 3 = ( toInteger( stmt(  1 ) ) + toInteger( stmt(  2 ) )
                              + toInteger( stmt(  3 ) ) + toInteger( stmt(  4 ) )
                              + toInteger( stmt(  5 ) ) + toInteger( stmt(  6 ) )
                              );
        expected( 10 ) := stmt( 11 ) and stmt( 12 );
        expected( 11 ) := 1 = ( toInteger( stmt(  7 ) )
                              + toInteger( stmt(  8 ) )
                              + toInteger( stmt(  9 ) )
                              );
        expected( 12 ) := 4 = ( toInteger( stmt(  1 ) ) + toInteger( stmt(  2 ) )
                              + toInteger( stmt(  3 ) ) + toInteger( stmt(  4 ) )
                              + toInteger( stmt(  5 ) ) + toInteger( stmt(  6 ) )
                              + toInteger( stmt(  7 ) ) + toInteger( stmt(  8 ) )
                              + toInteger( stmt(  9 ) ) + toInteger( stmt( 10 ) )
                              + toInteger( stmt( 11 ) )
                              );
    end expected ;

    % clearly, statement 1 is true, however to enumerate the near           %
    % solutions, we need to consider "solutions" where statement 1 is false %
    % we iterate through the possibilities for the statements,              %
    % looking for a non-contradictory set of values                         %
    % we print the solutions with allowedContradictions contradictions      %
    procedure printSolutions ( integer    value allowedContradictions
                             ; string(60) value heading
                             ) ;
    begin
        logical array wrong( 1 :: 12 );
        write( heading );
        write( "     1  2  3  4  5  6  7  8  9 10 11 12"  );
        write( "    ====================================" );
        % there are 12 statements, so we have 2^12 possible combinations    %
        for solution := 1 until 4096 do begin
            integer n, incorrect;
            % convert the number to the set of true/false values            %
            n := solution;
            for dPos := 1 until 12 do begin
                stmt( dPos ) := odd( n );
                n := n div 2;
            end for_dPos ;
            % get the expected values of the statements, based on the       %
            % suggested values                                              %
            findExpectedValues;
            % count the contradictions, if we have the required number,     %
            % print the solution                                            %
            incorrect := 0;
            for dPos := 1 until 12 do begin
                wrong( dPos ) := expected( dPos ) not = stmt( dPos );
                incorrect     := incorrect + toInteger( wrong( dPos ) );
            end for_dPos ;
            if incorrect = allowedContradictions then begin
                % have a solution                                            %
                write( "    " );
                for s := 1 until 12 do writeon( s_w := 0
                                              , " "
                                              , if stmt(  s ) then "T" else "-"
                                              , if wrong( s ) then "*" else " "
                                              );
            end ;
        end for_solution ;
    end printSolutions ;

    % find complete solutions                                                %
    printSolutions( 0, "Solutions" );
    % find near solutions                                                    %
    printSolutions( 1, "Near solutions (incorrect values marked ""*"")" );

end.


; Note: the original puzzle provides 12 statements and starts with
; "Given the following twelve statements...", so the first statement
; should ignore the F1 flag and always be true (see "( N == 1 )").

S := 12 ; number of statements
Output := ""
Loop, % 2**S {
	;;If !Mod(A_Index,100) ;; optional 'if' to show the loop progress
	;;	ToolTip, Index: %A_Index%
	SetFlags(A_Index-1), Current := "", Count := 0
	Loop, %S%
		R := TestStatement(A_Index), Current .= " " R, Count += (R == F%A_Index%)
	If ( Count >= S-1 )
		Output .= Count " ->" Current "`n"
	If ( Count = S )
		Solution := "`nSolution = " Current
}
ToolTip
MsgBox, % Output . Solution
Return

;-------------------------------------------------------------------------------------

SetFlags(D) {
	Local I
	Loop, %S%
		I := S-A_Index+1 , F%I% := (D >> (S-A_Index)) & 1
}

;-------------------------------------------------------------------------------------

TestStatement(N) {
	Local I, C := 0
	If ( N == 1 ) ; This is a numbered list of twelve statements.
		Return ( S == 12 ) ; should always be true
	If ( N == 2 ) { ; Exactly 3 of the last 6 statements are true.
		Loop, 6
			I := S-A_Index+1 , C += F%I%
		Return ( C == 3 )
	}
	If ( N == 3 ) { ; Exactly 2 of the even-numbered statements are true.
		Loop, %S%
			C += ( !Mod(A_Index,2) & F%A_Index% )
		Return ( C == 2 )
	}
	If ( N == 4 ) ; If statement 5 is true, then statements 6 and 7 are both true.
		Return ( F5 ? F6 & F7 : 1 )
	If ( N == 5 ) { ; The 3 preceding statements are all false.
		Loop, 3
			I := N-A_Index , C += F%I%
		Return ( C == 0 )
	}
	If ( N == 6 ) { ; Exactly 4 of the odd-numbered statements are true.
		Loop, %S%
			C += ( !!Mod(A_Index,2) & F%A_Index% )
		Return ( C == 4 )
	}
	If ( N == 7 ) ; Either statement 2 or 3 is true, but not both.
		Return ( F2 ^ F3 )
	If ( N == 8 ) ; If statement 7 is true, then 5 and 6 are both true.
		Return ( F7 ? F5 & F6 : 1 )
	If ( N == 9 ) { ; Exactly 3 of the first 6 statements are true.
		Loop, 6
			C += F%A_Index%
		Return ( C == 3 )
	}
	If ( N == 10 ) ; The next two statements are both true.
		Return ( F11 & F12 )
	If ( N == 11 ) ; Exactly 1 of statements 7, 8 and 9 are true
		Return ( F7+F8+F9 == 1 )
	If ( N == 12 ) { ; Exactly 4 of the preceding statements are true
		Loop, % N-1
			C += F%A_Index%
		Return ( C == 4 )
	}
}