/* ARM assembly Raspberry PI  or android 32 bits */
/*  program abelian.s   */

/* run : abelian 256 12 12  */

/* REMARK 1 : this program use routines in a include file
   see task Include a file language arm assembly
   for the routine affichageMess conversion10
   see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"
.equ MAXI, 25

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessValue:        .asciz "@ "
szMessErrParam:     .asciz "error : command line = abelian size posx posy  \n"
szMessFin:          .asciz "End display :\n"
szCarriageReturn:   .asciz "\n"

/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:        .skip 24
iSandPile:        .skip 4 * MAXI * MAXI
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                            @ entry of program
    mov fp,sp
    ldr r4,[fp]                  @ load number of parameters commend line
    cmp r4,#3                    @ < 4 -> error
    ble 99f
    add r0,fp,#16                @ load address param 4 = pos y
    ldr r0,[r0]
    bl conversionAtoD            @ conversion ascii -> numeric
    mov r3,r0
    add r0,fp,#12                @ load address param 3 = pos x
    ldr r0,[r0]
    bl conversionAtoD
    mov r2,r0
    add r0,fp,#8                 @ load address param 2 = size begin pile
    ldr r0,[r0]
    bl conversionAtoD
    ldr r4,iAdriSandPile
    mov r5,#MAXI
    mul r5,r3,r5                 @ compute offset = maxi * y
    add r5,r2                    @ + x
    str r0,[r4,r5,lsl #2]        @ and store size in pos x,y
    //mov r0,r4                    @ display start position
    //bl displaySandPile

    mov r0,r4                   @ sandpile address
    mov r1,r2                   @ pos x to start
    mov r2,r3                   @ pos y to start
    bl addSand

    ldr r0,iAdrszMessFin
    bl affichageMess
    mov r0,r4
    bl displaySandPile
    b 100f
99:                                  @ line command error
   ldr r0,iAdrszMessErrParam
   bl affichageMess
100:                                  @ standard end of the program
    mov r0, #0                        @ return code
    mov r7, #EXIT                     @ request to exit program
    svc #0                            @ perform the system call

iAdrszCarriageReturn:     .int szCarriageReturn
iAdrsZoneConv:            .int sZoneConv
iAdrszMessErrParam:       .int szMessErrParam
iAdrszMessFin:            .int szMessFin
iAdriSandPile:            .int iSandPile
/***************************************************/
/*     display  sandpile               */
/***************************************************/
// r0 contains address to sandpile
displaySandPile:
    push {r1-r6,lr}             @ save  registers
    mov r6,r0
    mov r3,#0                   @ indice y
    mov r4,#MAXI
1:
    mov r2,#0                   @ indice x
2:
    mul r5,r3,r4
    add r5,r2                   @ compute offset
    ldr r0,[r6,r5,lsl #2]       @ load value at pos x,y
    ldr r1,iAdrsZoneConv
    bl conversion10             @ call decimal conversion
    add r1,#1
    mov r7,#0
    strb r7,[r1,r0]
    ldr r0,iAdrszMessValue
    ldr r1,iAdrsZoneConv        @ insert value conversion in message
    bl strInsertAtCharInc
    bl affichageMess
    add r2,#1
    cmp r2,#MAXI
    blt 2b
    ldr r0,iAdrszCarriageReturn
    bl affichageMess
    add r3,#1
    cmp r3,#MAXI
    blt 1b

100:
    pop {r1-r6,lr}             @ restaur registers
    bx lr                      @ return
iAdrszMessValue:       .int szMessValue
/***************************************************/
/*     display  sandpile               */
/***************************************************/
// r0 contains address to sanspile
// r1 contains position x
// r2 contains position y
addSand:
    push {r1-r5,lr}             @ save  registers
    mov r3,#MAXI
    mul r4,r3,r2
    add r4,r1
    ldr r5,[r0,r4,lsl #2]
1:
    cmp r5,#4                   @ 4 grains ?
    blt 100f
    sub r5,#4                   @ yes sustract
    str r5,[r0,r4,lsl #2]
    cmp r1,#MAXI-1              @ right position ok ?
    beq 2f
    add r1,#1                   @ yes
    bl add1Sand                 @ add 1 grain
    bl addSand                  @ and compute new pile
    sub r1,#1
2:
    cmp r1,#0                   @ left position ok ?
    beq 3f
    sub r1,#1
    bl add1Sand
    bl addSand
    add r1,#1
3:
    cmp r2,#0                   @ higt position ok ?
    beq 4f
    sub r2,#1
    bl add1Sand
    bl addSand
    add r2,#1
4:
    cmp r2,#MAXI-1               @ low position ok ?
    beq 5f
    add r2,#1
    bl add1Sand
    bl addSand
    sub r2,#1
5:
   ldr r5,[r0,r4,lsl #2]       @ reload value
   b 1b                        @ and loop
100:
    pop {r1-r5,lr}             @ restaur registers
    bx lr                      @ return
/***************************************************/
/*     add 1 grain of sand              */
/***************************************************/
// r0 contains address to sanspile
// r1 contains position x
// r2 contains position y
add1Sand:
    push {r3-r5,lr}           @ save  registers
    mov r3,#MAXI
    mul r4,r3,r2
    add r4,r1                 @ compute offset
    ldr r5,[r0,r4,lsl #2]     @ load value at pos x,y
    add r5,#1
    str r5,[r0,r4,lsl #2]     @ and store
100:
    pop {r3-r5,lr}            @ restaur registers
    bx lr                     @ return
/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"


(defun ackermann (m n)
  (cond ((zerop m) (1+ n))
	((zerop n) (ackermann (1- m) 1))
	(t         (ackermann (1- m)
			      (ackermann m (1- n))))))


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

int main(int argc, char** argv)
{
	int i,j,sandPileEdge, centerPileHeight, processAgain = 1,top,down,left,right;
	int** sandPile;
	char* fileName;
	static unsigned char colour[3];

	if(argc!=3){
		printf("Usage: %s <Sand pile side> <Center pile height>",argv[0]);
		return 0;
	}

	sandPileEdge = atoi(argv[1]);
	centerPileHeight = atoi(argv[2]);

	if(sandPileEdge<=0 || centerPileHeight<=0){
		printf("Sand pile and center pile dimensions must be positive integers.");
		return 0;
	}

	sandPile = (int**)malloc(sandPileEdge * sizeof(int*));

	for(i=0;i<sandPileEdge;i++){
		sandPile[i] = (int*)calloc(sandPileEdge,sizeof(int));
	}

	sandPile[sandPileEdge/2][sandPileEdge/2] = centerPileHeight;

	printf("Initial sand pile :\n\n");

	for(i=0;i<sandPileEdge;i++){
		for(j=0;j<sandPileEdge;j++){
			printf("%3d",sandPile[i][j]);
		}
		printf("\n");
	}

	while(processAgain == 1){

		processAgain = 0;
		top = 0;
		down = 0;
		left = 0;
		right = 0;

		for(i=0;i<sandPileEdge;i++){
			for(j=0;j<sandPileEdge;j++){
				if(sandPile[i][j]>=4){
					if(i-1>=0){
						top = 1;
						sandPile[i-1][j]+=1;
						if(sandPile[i-1][j]>=4)
							processAgain = 1;
					}
					if(i+1<sandPileEdge){
						down = 1;
						sandPile[i+1][j]+=1;
						if(sandPile[i+1][j]>=4)
							processAgain = 1;
					}
					if(j-1>=0){
						left = 1;
						sandPile[i][j-1]+=1;
						if(sandPile[i][j-1]>=4)
							processAgain = 1;
					}
					if(j+1<sandPileEdge){
						right = 1;
						sandPile[i][j+1]+=1;
						if(sandPile[i][j+1]>=4)
							processAgain = 1;
					}
				sandPile[i][j] -= (top + down + left + right);
				if(sandPile[i][j]>=4)
					processAgain = 1;
				}
			}
		}
	}

	printf("Final sand pile : \n\n");

	for(i=0;i<sandPileEdge;i++){
		for(j=0;j<sandPileEdge;j++){
			printf("%3d",sandPile[i][j]);
		}
		printf("\n");
	}

	fileName = (char*)malloc((strlen(argv[1]) + strlen(argv[2]) + 23)*sizeof(char));

	strcpy(fileName,"Final_Sand_Pile_");
	strcat(fileName,argv[1]);
	strcat(fileName,"_");
	strcat(fileName,argv[2]);
	strcat(fileName,".ppm");

	FILE *fp = fopen(fileName,"wb");

	fprintf(fp,"P6\n%d %d\n255\n",sandPileEdge,sandPileEdge);

	for(i=0;i<sandPileEdge;i++){
		for(j=0;j<sandPileEdge;j++){
			colour[0] = (sandPile[i][j] + i)%256;
			colour[1] = (sandPile[i][j] + j)%256;
			colour[2] = (sandPile[i][j] + i*j)%256;
			fwrite(colour,1,3,fp);
		}
	}

	fclose(fp);

	printf("\nImage file written to %s\n",fileName);

	return 0;
}


-module(ackermann).
-export([ackermann/2]).

ackermann(0, N) ->
  N+1;
ackermann(M, 0) ->
  ackermann(M-1, 1);
ackermann(M, N) when M > 0 andalso N > 0 ->
  ackermann(M-1, ackermann(M, N-1)).


#include <iostream>
#include "xtensor/xarray.hpp"
#include "xtensor/xio.hpp"
#include "xtensor-io/ximage.hpp"

xt::xarray<int> init_grid (unsigned long x_dim, unsigned long y_dim)
{
    xt::xarray<int>::shape_type shape = { x_dim, y_dim };
    xt::xarray<int> grid(shape);

    grid(x_dim/2, y_dim/2) = 64000;

    return grid;
}

int print_grid(xt::xarray<int>& grid)
{
    // for output to the terminal uncomment next line
    // only makes sense for small grid < 32x32;
    // std::cout << grid << std::endl << std::endl;

    // output result to an image
    xt::dump_image("grid.jpg", grid);

    return 0;
}

bool iterate_grid(xt::xarray<int>& grid, const unsigned long& x_dim, const unsigned long& y_dim)
{
    bool changed = false;

    for (unsigned long i=0; i < x_dim; ++i)
    {
        for (unsigned long j=0; j < y_dim; ++j)
        {
            if ( grid(i, j) >= 4 )
            {
                grid(i, j) -= 4;
                changed = true;
                try
                {
                    grid.at(i-1, j) += 1;
                    grid.at(i+1, j) += 1;
                    grid.at(i, j-1) += 1;
                    grid.at(i, j+1) += 1;
                }
                catch (const std::out_of_range& oor)
                {
                }
            }
        }
    }

    return changed;
}

int main(int argc, char* argv[])
{
    const unsigned long x_dim { 200 };
    const unsigned long y_dim { 200 };

    xt::xarray<int> grid = init_grid(x_dim, y_dim);
    bool changed { true };

    iterate_grid(grid, x_dim, y_dim);

    while (changed == true)
    {
        changed = iterate_grid(grid, x_dim, y_dim);
    }
    print_grid(grid);

    return 0;
}


PROGRAM ACKERMAN

!
! computes Ackermann function
! (second version for rosettacode.org)
!

!$INTEGER

DIM STACK[10000]

!$INCLUDE="PC.LIB"

PROCEDURE ACK(M,N->N)
  LOOP
    CURSOR_SAVE(->CURX%,CURY%)
    LOCATE(8,1)
    PRINT("Livello Stack:";S;"  ")
    LOCATE(CURY%,CURX%)
    IF M<>0 THEN
       IF N<>0 THEN
           STACK[S]=M
           S+=1
           N-=1
        ELSE
           M-=1
           N+=1
        END IF
        CONTINUE LOOP
     ELSE
        N+=1
        S-=1
    END IF
    IF S<>0 THEN
        M=STACK[S]
        M-=1
        CONTINUE LOOP
      ELSE
        EXIT PROCEDURE
    END IF
  END LOOP
END PROCEDURE

BEGIN
   PRINT(CHR$(12);)
   FOR X=0 TO 3 DO
     FOR Y=0 TO 9 DO
        S=1
        ACK(X,Y->ANS)
        PRINT(ANS;)
     END FOR
     PRINT
   END FOR
END PROGRAM


program Abelian_sandpile_model;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  Vcl.Graphics,
  System.Classes;

type
  TGrid = array of array of Integer;

function Iterate(var Grid: TGrid): Boolean;
var
  changed: Boolean;
  i: Integer;
  j: Integer;
  val: Integer;
  Alength: Integer;
begin
  Alength := length(Grid);
  changed := False;

  for i := 0 to High(Grid) do
    for j := 0 to High(Grid[0]) do
    begin
      val := Grid[i, j];
      if val > 3 then
      begin
        Grid[i, j] := Grid[i, j] - 4;

        if i > 0 then
          Grid[i - 1, j] := Grid[i - 1, j] + 1;

        if i < Alength - 1 then
          Grid[i + 1, j] := Grid[i + 1, j] + 1;

        if j > 0 then
          Grid[i, j - 1] := Grid[i, j - 1] + 1;

        if j < Alength - 1 then
          Grid[i, j + 1] := Grid[i, j + 1] + 1;
        changed := True;
      end;
    end;
  Result := changed;
end;

procedure Simulate(var Grid: TGrid);
var
  changed: Boolean;
begin
  while Iterate(Grid) do
    ;
end;

procedure Zeros(var Grid: TGrid; Size: Integer);
var
  i, j: Integer;
begin
  SetLength(Grid, Size, Size);
  for i := 0 to Size - 1 do
    for j := 0 to Size - 1 do
      Grid[i, j] := 0;
end;

procedure Println(Grid: TGrid);
var
  i, j: Integer;
begin
  for i := 0 to High(Grid) do
  begin
    Writeln;
    for j := 0 to High(Grid[0]) do
      Write(Format('%3d', [Grid[i, j]]));
  end;
  Writeln;
end;

function Grid2Bmp(Grid: TGrid): TBitmap;
const
  Colors: array[0..2] of TColor = (clRed, clLime, clBlue);
var
  Alength: Integer;
  i: Integer;
  j: Integer;
begin
  Alength := Length(Grid);

  Result := TBitmap.Create;
  Result.SetSize(Alength, Alength);

  for i := 0 to Alength - 1 do
    for j := 0 to Alength - 1 do
    begin
      Result.Canvas.Pixels[i, j] := Colors[Grid[i, j]];
    end;
end;

procedure Grid2P6(Grid: TGrid; FileName: TFileName);
var
  f: text;
  i, j, Alength: Integer;
  ppm: TFileStream;
  Header: AnsiString;
const
  COLORS: array[0..3] of array[0..2] of byte =
 //  R,   G,    B
((0   ,   0,    0),
 (255 ,   0,    0),
 (0   , 255,   0),
 (0   ,   0, 255));
begin
  Alength := Length(Grid);
  ppm := TFileStream.Create(FileName, fmCreate);
  Header := Format('P6'#10'%d %d'#10'255'#10, [Alength, Alength]);
  writeln(Header);
  ppm.Write(Tbytes(Header), Length(Header));

  for i := 0 to Alength - 1 do
    for j := 0 to Alength - 1 do
    begin
      ppm.Write(COLORS[Grid[i, j]], 3);
    end;
  ppm.Free;
end;

const
  DIMENSION = 10;

var
  Grid: TGrid;
  bmp: TBitmap;

begin
  Zeros(Grid, DIMENSION);
  Grid[4, 4] := 64;
  Writeln('Before:');
  Println(Grid);

  Simulate(Grid);

  Writeln(#10'After:');
  Println(Grid);

  // Output bmp
  with Grid2Bmp(Grid) do
  begin
    SaveToFile('output.bmp');
    free;
  end;

  // Output ppm
  Grid2P6(Grid, 'output.ppm');

  Readln;
end.


>M=zeros(1000,1000);
>function map A(m,n) ...
$  global M;
$  if m==0 then return n+1; endif;
$  if n==0 then return A(m-1,1); endif;
$  if m<=cols(M) and n<=cols(M) then
$    M[m,n]=A(m-1,A(m,n-1));
$    return M[m,n];
$  else return A(m-1,A(m,n-1));
$  endif;
$endfunction
>shortestformat; A((0:3)',0:5)
         1         2         3         4         5         6
         2         3         4         5         6         7
         3         5         7         9        11        13
         5        13        29        61       125       253


#! /usr/bin/gforth -d 20M
\ Abelian Sandpile Model

0 assert-level !

\ command-line

: parse-number  s>number? invert throw drop ;
: parse-size    ." size  : " next-arg parse-number dup . cr ;
: parse-height  ." height: " next-arg parse-number dup . cr ;
: parse-args    cr parse-size parse-height ;

parse-args constant HEIGHT constant SIZE

: allot-erase   create here >r dup allot r> swap erase ;
: size^2        SIZE dup * cells ;
: 2cells        [ 2 cells ] literal ;
: -2cells       [ 2cells negate ] literal ;

size^2 allot-erase arr

\ array processing
: ix            swap SIZE * + cells arr + ;
: center        SIZE 2/ dup ;
: write-cell    ix @ u. ;
: write-row     SIZE 0 ?do dup i write-cell loop drop cr ;
: arr.          SIZE 0 ?do i write-row loop ;

\ stack processing

: stack-empty?  dup -1 = ;
: stack-full?   stack-empty? invert ;

\ pgm-handling

: concat        { a1 l1 a2 l2 } l1 l2 + allocate throw dup dup a1 swap l1 cmove a2 swap l1 + l2 cmove l1 l2 + ;
: write-pgm     ." P2" cr SIZE u. SIZE u. cr ." 3" cr arr. ;
: u>s           0 <# #s #> ;
: filename      s" sandpile-" SIZE u>s concat s" -" concat HEIGHT u>s concat s" .pgm" concat ;
: to-pgm        filename w/o create-file throw ['] write-pgm over outfile-execute close-file throw ;

\ sandpile

: prep-arr      HEIGHT center ix ! ;
: prep-stack    -1 HEIGHT 4 u>= if center then ;
: prepare       prep-arr prep-stack ;
: ensure        if else 2drop 0 2rdrop exit then ;
: col>=0        dup 0>= ensure ;
: col<SIZE      dup SIZE < ensure ;
: row>=0        over 0>= ensure ;
: row<SIZE      over SIZE < ensure ;
: legal?        col>=0 col<SIZE row>=0 row<SIZE 2drop true ;
: north         1. d- ;
: east          1+ ;
: south         1. d+ ;
: west          1- ;
: reduce        2dup ix dup -4 swap +! @ 4 < if 2drop then ;
: increase      2dup legal? if 2dup ix dup 1 swap +! @ 4 = if 2swap else 2drop then else 2drop then ;
: inc-north     2dup north increase ;
: inc-east      2dup east increase ;
: inc-south     2dup south increase ;
: inc-west      2dup west increase ;
: inc-all       inc-north inc-east inc-south inc-west 2drop ;
: simulate      prepare begin stack-full? while 2dup 2>r reduce 2r> inc-all repeat drop to-pgm ." written to " filename type cr ;

simulate bye


module abelian_sandpile_m

  implicit none

  private
  public :: pile

  type :: pile
    !! usage:
    !!    1) init
    !!    2) run

    integer, allocatable :: grid(:,:)
    integer              :: n(2)

  contains
    procedure :: init
    procedure :: run

    procedure, private :: process_node
    procedure, private :: inside
  end type

contains

  logical function inside(this, i)
    class(pile), intent(in) :: this
    integer,     intent(in) :: i(2)

    inside = ((i(1) > 0) .and. (i(1) <= this%n(1)) .and. (i(2) > 0) .and. (i(2) <= this%n(2)) )
  end function

  recursive subroutine process_node(this, i)
    !! start process

    class(pile), intent(inout) :: this
    integer,     intent(in)    :: i(2)
      !! node coordinates to process

    integer :: i0(2,2), j(2), d, k

    ! if node has more than 4 grains -> redistribute
    if (this%grid(i(1),i(2)) >= 4) then
      ! unit vectors: help shift only one dimension (see below)
      i0 = reshape([1,0,0,1], [2,2])

      ! subtract 4 grains
      this%grid(i(1),i(2)) = this%grid(i(1),i(2))-4

      ! add one grain to neighbor if not out of bound
      do d = 1, 2               ! loop dimensions
        do k = -1, 1, 2         ! loop +-1 step in direction d
          j = i+k*i0(:,d)       ! j = i, but one element is shifted by +-1
          if (this%inside(j)) this%grid(j(1),j(2)) = this%grid(j(1),j(2)) + 1
        end do
      end do

      ! check neighbor nodes
      do d = 1, 2               ! loop dimensions
        do k = -1, 1, 2         ! loop +-1 step in direction d
          j = i+k*i0(:,d)       ! j = i, but one element is shifted by +-1
          if (this%inside(j)) call this%process_node(j)
        end do
      end do

      ! check itself
      call this%process_node(i)
    end if
  end subroutine

  subroutine run(this)
    !! start process

    class(pile), intent(inout) :: this

    ! only node that could be unstable is inital node
    call this%process_node(this%n/2)
  end subroutine

  subroutine init(this, nx, ny, h)
    class(pile), intent(out) :: this
    integer,     intent(in)  :: nx, ny
      !! grid dimensions
    integer,     intent(in)  :: h
      !! height of and grains in middle of grid

    this%n = [nx, ny]
    allocate (this%grid(nx,ny), source=0)
    this%grid(nx/2, ny/2) = h
  end subroutine

end module


function ack(atom m, atom n)
    if m = 0 then
        return n + 1
    elsif m > 0 and n = 0 then
        return ack(m - 1, 1)
    else
        return ack(m - 1, ack(m, n - 1))
    end if
end function

for i = 0 to 3 do
    for j = 0 to 6 do
        printf( 1, "%5d", ack( i, j ) )
    end for
    puts( 1, "\n" )
end for


// Abelian sandpile model. Nigel Galloway: July 20th., 2020
type Sandpile(x,y,N:int[])=
  member private this.x=x
  member private this.y=y
  member private this.i=let rec topple n=match Array.tryFindIndex(fun n->n>3)n with
                                          None->n
                                         |Some g->let i=n.[g]/4
                                                  n.[g]<-n.[g]%4
                                                  match g%x,g/x with
                                                   (0,0)->n.[x]<-n.[x]+i;n.[1]<-n.[1]+i;topple n
                                                  |(α,0) when α=x-1->n.[g+x]<-n.[g+x]+i;n.[g-1]<-n.[g-1]+i;topple n
                                                  |(_,0)->n.[g-1]<-n.[g-1]+i;n.[g+1]<-n.[g+1]+i;n.[g+x]<-n.[g+x]+i;topple n
                                                  |(0,β) when β=y-1->n.[g-x]<-n.[g-x]+i;n.[g+1]<-n.[g+1]+i;topple n
                                                  |(0,β)->n.[g-x]<-n.[g-x]+i;n.[g+1]<-n.[g+1]+i;n.[g+x]<-n.[g+x]+i;topple n
                                                  |(α,β) when α=x-1 && β=y-1->n.[g-1]<-n.[g-1]+i;n.[g-x]<-n.[g-x]+i;topple n
                                                  |(α,_) when α=x-1->n.[g-1]<-n.[g-1]+i;n.[g-x]<-n.[g-x]+i;n.[g+x]<-n.[g+x]+i;topple n
                                                  |(_,β) when β=y-1->n.[g-1]<-n.[g-1]+i;n.[g-x]<-n.[g-x]+i;n.[g+1]<-n.[g+1]+i;topple n
                                                  |_->n.[g-1]<-n.[g-1]+i;n.[g-x]<-n.[g-x]+i;n.[g+x]<-n.[g+x]+i;n.[g+1]<-n.[g+1]+i;topple n
                        topple N
  static member (+) (n:Sandpile, g:Sandpile)=Sandpile(n.x,n.y,Array.map2(fun n g->n+g) n.i g.i)
  member this.toS=sprintf "%A" (this.i|>Array.chunkBySize x|>array2D)

printfn "%s\n" (Sandpile(3,3,[|4;3;3;3;1;2;0;2;3|])).toS
let e1=Array.zeroCreate<int> 25 in e1.[12]<-4; printfn "%s\n" (Sandpile(5,5,e1)).toS
let e1=Array.zeroCreate<int> 25 in e1.[12]<-6; printfn "%s\n" (Sandpile(5,5,e1)).toS
let e1=Array.zeroCreate<int> 25 in e1.[12]<-16; printfn "%s\n" (Sandpile(5,5,e1)).toS


நிரல்பாகம் அகெர்மன்(முதலெண், இரண்டாமெண்)

  @((முதலெண் < 0) || (இரண்டாமெண் < 0)) ஆனால்

    பின்கொடு -1

  முடி

  @(முதலெண் == 0) ஆனால்

    பின்கொடு இரண்டாமெண்+1

  முடி

  @((முதலெண் > 0) && (இரண்டாமெண் == 00)) ஆனால்

    பின்கொடு அகெர்மன்(முதலெண் - 1, 1)

  முடி

  பின்கொடு அகெர்மன்(முதலெண் - 1, அகெர்மன்(முதலெண், இரண்டாமெண் - 1))

முடி

அ = int(உள்ளீடு("ஓர் எண்ணைத் தாருங்கள், அது பூஜ்ஜியமாகவோ, அதைவிடப் பெரியதாக இருக்கலாம்: "))
ஆ = int(உள்ளீடு("அதேபோல் இன்னோர் எண்ணைத் தாருங்கள், இதுவும் பூஜ்ஜியமாகவோ, அதைவிடப் பெரியதாகவோ இருக்கலாம்: "))

விடை = அகெர்மன்(அ, ஆ)

@(விடை < 0) ஆனால்

  பதிப்பி "தவறான எண்களைத் தந்துள்ளீர்கள்!"

இல்லை

  பதிப்பி "நீங்கள் தந்த எண்களுக்கான அகர்மென் மதிப்பு: ", விடை

முடி


let rec ackermann m n =
    match m, n with
    | 0, n -> n + 1
    | m, 0 -> ackermann (m - 1) 1
    | m, n -> ackermann (m - 1) ackermann m (n - 1)

do
    printfn "%A" (ackermann (int fsi.CommandLineArgs.[1]) (int fsi.CommandLineArgs.[2]))


ScreenRes 320, 200, 8
WindowTitle "Abelian sandpile model"

Dim As Long dimen = 220
Dim As Long pila1(dimen*dimen), pila2(dimen*dimen)
Dim As Long i, x, y
Dim As Long partic = 400000
Dim As Double t0 = Timer
Do
    i = 0
    For y = 0 To dimen-1
        For x = 0 To dimen-1
            If x = dimen/2 And y = dimen/2 Then
                partic -= 4
                pila1(i) += 4
            End If
            If pila1(i) >= 4 Then
                pila1(i) -= 4
                pila2(i-1) += 1
                pila2(i+1) += 1
                pila2(i-dimen) += 1
                pila2(i+dimen) += 1
            End If
            Pset(x, y), (pila1(i)*2)
            i += 1
            Swap pila1(i), pila2(i)
        Next x
    Next y
Loop Until partic < 4
Bsave "abelian_sandpile.bmp",0
Sleep


package main

import (
    "fmt"
    "log"
    "os"
    "strings"
)

const dim = 16 // image size

func check(err error) {
    if err != nil {
        log.Fatal(err)
    }
}

// Outputs the result to the terminal using UTF-8 block characters.
func drawPile(pile [][]uint) {
    chars:= []rune(" ░▓█")
    for _, row := range pile {
        line := make([]rune, len(row))
        for i, elem := range row {
            if elem > 3 { // only possible when algorithm not yet completed.
                elem = 3
            }
            line[i] = chars[elem]
        }
        fmt.Println(string(line))
    }
}

// Creates a .ppm file in the current directory, which contains
// a colored image of the pile.
func writePile(pile [][]uint) {
    file, err := os.Create("output.ppm")
    check(err)
    defer file.Close()
    // Write the signature, image dimensions and maximum color value to the file.
    fmt.Fprintf(file, "P3\n%d %d\n255\n", dim, dim)
    bcolors := []string{"125 0 25 ", "125 80 0 ", "186 118 0 ", "224 142 0 "}
    var line strings.Builder
    for _, row := range pile {
        for _, elem := range row {
            line.WriteString(bcolors[elem])
        }
        file.WriteString(line.String() + "\n")
        line.Reset()
    }
}

// Main part of the algorithm, a simple, recursive implementation of the model.
func handlePile(x, y uint, pile [][]uint) {
    if pile[y][x] >= 4 {
        pile[y][x] -= 4
        // Check each neighbor, whether they have enough "sand" to collapse and if they do,
        // recursively call handlePile on them.
        if y > 0 {
            pile[y-1][x]++
            if pile[y-1][x] >= 4 {
                handlePile(x, y-1, pile)
            }
        }
        if x > 0 {
            pile[y][x-1]++
            if pile[y][x-1] >= 4 {
                handlePile(x-1, y, pile)
            }
        }
        if y < dim-1 {
            pile[y+1][x]++
            if pile[y+1][x] >= 4 {
                handlePile(x, y+1, pile)
            }
        }
        if x < dim-1 {
            pile[y][x+1]++
            if pile[y][x+1] >= 4 {
                handlePile(x+1, y, pile)
            }
        }

        // Uncomment this line to show every iteration of the program.
        // Not recommended with large input values.
        // drawPile(pile)

        // Finally call the function on the current cell again,
        // in case it had more than 4 particles.
        handlePile(x, y, pile)
    }
}

func main() {
    // Create 2D grid and set size using the 'dim' constant.
    pile := make([][]uint, dim)
    for i := 0; i < dim; i++ {
        pile[i] = make([]uint, dim)
    }

    // Place some sand particles in the center of the grid and start the algorithm.
    hdim := uint(dim/2 - 1)
    pile[hdim][hdim] = 16
    handlePile(hdim, hdim, pile)
    drawPile(pile)

    // Uncomment this to save the final image to a file
    // after the recursive algorithm has ended.
    // writePile(pile)
}


USING: kernel math locals combinators ;
IN: ackermann

:: ackermann ( m n -- u )
    {
        { [ m 0 = ] [ n 1 + ] }
        { [ n 0 = ] [ m 1 - 1 ackermann ] }
        [ m 1 - m n 1 - ackermann ackermann ]
    } cond ;


{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables        #-}

module Rosetta.AbelianSandpileModel.ST
    ( simulate
    , test
    , toPGM
    ) where

import Control.Monad.Reader (asks, MonadReader (..), ReaderT, runReaderT)
import Control.Monad.ST (runST, ST)
import Control.Monad.State (evalStateT, forM_, lift, MonadState (..), StateT, modify, when)
import Data.Array.ST (freeze, readArray, STUArray, thaw, writeArray)
import Data.Array.Unboxed (array, assocs, bounds, UArray, (!))
import Data.Word (Word32)
import System.IO (hPutStr, hPutStrLn, IOMode (WriteMode), withFile)
import Text.Printf (printf)

type Point     = (Int, Int)
type ArrayST s = STUArray s Point Word32
type ArrayU    = UArray Point Word32

newtype M s a = M (ReaderT (S s) (StateT [Point] (ST s)) a)
    deriving (Functor, Applicative, Monad, MonadReader (S s), MonadState [Point])

data S s = S
    { bMin :: !Point
    , bMax :: !Point
    , arr  :: !(ArrayST s)
    }

runM :: M s a -> S s -> [Point]-> ST s a
runM (M m) = evalStateT . runReaderT m

liftST :: ST s a -> M s a
liftST = M . lift . lift

simulate :: ArrayU -> ArrayU
simulate a = runST $ simulateST a

simulateST :: forall s. ArrayU -> ST s ArrayU
simulateST a = do
    let (p1, p2) = bounds a
        s = [p | (p, c) <- assocs a, c >= 4]
    b <- thaw a :: ST s (ArrayST s)
    let st = S { bMin = p1
               , bMax = p2
               , arr  = b
               }
    runM simulateM st s

simulateM :: forall s. M s ArrayU
simulateM = do
    ps <- get
    case ps of
        []      -> asks arr >>= liftST . freeze
        p : ps' -> do
            c <- changeArr p $ \x -> x - 4
            when (c < 4) $ put ps'
            forM_ [north, east, south, west] $ inc . ($ p)
            simulateM

changeArr :: Point -> (Word32 -> Word32) -> M s Word32
changeArr p f = do
    a    <- asks arr
    oldC <- liftST $ readArray a p
    let newC = f oldC
    liftST $ writeArray a p newC
    return newC

inc :: Point -> M s ()
inc p = do
    b <- inBounds p
    when b $ do
        c <- changeArr p succ
        when (c == 4) $ modify $ (p :)

inBounds :: Point -> M s Bool
inBounds p = do
    st <- ask
    return $ p >= bMin st && p <= bMax st

north, east, south, west :: Point -> Point
north (x, y) = (x, y + 1)
east  (x, y) = (x + 1, y)
south (x, y) = (x, y - 1)
west  (x, y) = (x - 1, y)

toPGM :: ArrayU -> FilePath -> IO ()
toPGM a fp = withFile fp WriteMode $ \h -> do
    let ((x1, y1), (x2, y2)) = bounds a
        width  = x2 - x1 + 1
        height = y2 - y1 + 1
    hPutStrLn h "P2"
    hPutStrLn h $ show width ++ " " ++ show height
    hPutStrLn h "3"
    forM_ [y1 .. y2] $ \y -> do
        forM_ [x1 .. x2] $ \x -> do
            let c = min 3 $ a ! (x, y)
            hPutStr h $ show c ++ " "
        hPutStrLn h ""

initArray :: Int -> Word32 -> ArrayU
initArray size height = array
    ((-size, -size), (size, size))
    [((x, y), if x == 0 && y == 0 then height else 0) | x <- [-size .. size], y <- [-size .. size]]

test :: Int -> Word32 -> IO ()
test size height = do
    printf "size = %d, height = %d\n" size height
    let a  = initArray size height
        b  = simulate a
        fp = printf "sandpile_%d_%d.pgm" size height
    toPGM b fp
    putStrLn $ "wrote image to " ++ fp


function ackermann( m, n )
 if m == 0:  return( n + 1 )
 if n == 0:  return( ackermann( m - 1, 1 ) )
 return( ackermann( m - 1, ackermann( m, n - 1 ) ) )
end

for M in [ 0:4 ]
 for N in [ 0:7 ]
   >> ackermann( M, N ), " "
 end
 >
end


grid=: 4 : 'x (<<.-:2$y)} (2$y)$0'         NB. y by y grid with x grains in middle
ab=: - [: +/@(-"2 ((,-)=/~i.2)|.!.0]) 3&<  NB. abelian sand pile for grid graph
require 'viewmat'                          NB. viewmat utility
viewmat ab ^: _ (1024 grid 25)             NB. visual


import java.awt.*;
import java.awt.event.*;
import javax.swing.*;

public class AbelianSandpile {
    public static void main(String[] args) {
        SwingUtilities.invokeLater(new Runnable() {
            public void run() {
                Frame frame = new Frame();
                frame.setVisible(true);
            }
        });
    }

    private static class Frame extends JFrame {
        private Frame() {
            super("Abelian Sandpile Model");
            setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
            Container contentPane = getContentPane();
            JPanel controlPanel = new JPanel(new FlowLayout(FlowLayout.LEFT));
            JButton start = new JButton("Restart Simulation");
            start.addActionListener(e -> restartSimulation());
            JButton stop = new JButton("Stop Simulation");
            stop.addActionListener(e -> stopSimulation());
            controlPanel.add(start);
            controlPanel.add(stop);
            contentPane.add(controlPanel, BorderLayout.NORTH);
            contentPane.add(canvas = new Canvas(), BorderLayout.CENTER);
            timer = new Timer(100, e -> canvas.runAndDraw());
            timer.start();
            pack();
        }

        private void restartSimulation() {
            timer.stop();
            canvas.initGrid();
            timer.start();
        }

        private void stopSimulation() {
            timer.stop();
        }

        private Timer timer;
        private Canvas canvas;
    }

    private static class Canvas extends JComponent {
        private Canvas() {
            setBorder(BorderFactory.createEtchedBorder());
            setPreferredSize(new Dimension(600, 600));
        }

        public void paintComponent(Graphics g) {
            int width = getWidth();
            int height = getHeight();
            g.setColor(Color.WHITE);
            g.fillRect(0, 0, width, height);
            int cellWidth = width/GRID_LENGTH;
            int cellHeight = height/GRID_LENGTH;
            for (int i = 0; i < GRID_LENGTH; ++i) {
                for (int j = 0; j < GRID_LENGTH; ++j) {
                    if (grid[i][j] > 0) {
                        g.setColor(COLORS[grid[i][j]]);
                        g.fillRect(i * cellWidth, j * cellHeight, cellWidth, cellHeight);
                    }
                }
            }
        }

        private void initGrid() {
            for (int i = 0; i < GRID_LENGTH; ++i) {
                for (int j = 0; j < GRID_LENGTH; ++j) {
                    grid[i][j] = 0;
                }
            }
        }

        private void runAndDraw() {
            for (int i = 0; i < 100; ++i)
                addSand(GRID_LENGTH/2, GRID_LENGTH/2);
            repaint();
        }

        private void addSand(int i, int j) {
            int grains = grid[i][j];
            if (grains < 3) {
                grid[i][j]++;
            }
            else {
                grid[i][j] = grains - 3;
                if (i > 0)
                    addSand(i - 1, j);
                if (i < GRID_LENGTH - 1)
                    addSand(i + 1, j);
                if (j > 0)
                    addSand(i, j - 1);
                if (j < GRID_LENGTH - 1)
                    addSand(i, j + 1);
            }
        }

        private int[][] grid = new int[GRID_LENGTH][GRID_LENGTH];
    }

    private static final Color[] COLORS = {
        Color.WHITE,
        new Color(0x00, 0xbf, 0xff),
        new Color(0xff, 0xd7, 0x00),
        new Color(0xb0, 0x30, 0x60)
    };
    private static final int GRID_LENGTH = 300;
}


V oddNumber = 1
V aCount = 0
V dSum = 0

F divisorSum(n)
   V sum = 1
   V i = Int(sqrt(n) + 1)

   L(d) 2 .< i
      I n % d == 0
         sum += d
         V otherD = n I/ d
         I otherD != d
            sum += otherD
   R sum

print(‘The first 25 abundant odd numbers:’)
L aCount < 25
   dSum = divisorSum(oddNumber)
   I dSum > oddNumber
      aCount++
      print(‘#5 proper divisor sum: #.’.format(oddNumber, dSum))
   oddNumber += 2

L aCount < 1000
   dSum = divisorSum(oddNumber)
   I dSum > oddNumber
      aCount++
   oddNumber += 2
print("\n1000th abundant odd number:")
print(‘     ’(oddNumber - 2)‘  proper divisor sum:  ’dSum)

oddNumber = 1000000001
V found = 0B
L !found
   dSum = divisorSum(oddNumber)
   I dSum > oddNumber
      found = 1B
      print("\nFirst abundant odd number > 1 000 000 000:")
      print(‘     ’oddNumber‘  proper divisor sum:  ’dSum)
   oddNumber += 2


module AbelSand

# supports output functionality for the results of the sandpile simulations
# outputs the final grid in CSV format, as well as an image file

using CSV, DataFrames, Images

function TrimZeros(A)
    # given an array A trims any zero rows/columns from its borders
    # returns a 4 tuple of integers, i1, i2, j1, j2, where the trimmed array corresponds to A[i1:i2, j1:j2]
    # A can be either numeric or a boolean array

    i1, j1 = 1, 1
    i2, j2 = size(A)

    zz = typeof(A[1, 1])(0)    # comparison of a value takes into account the type as well

    # i1 is the first row which has non zero element
    for i = 1:size(A, 1)
        q = false
        for k = 1:size(A, 2)
            if A[i, k] != zz
                q = true
                i1 = i
                break
            end
        end

        if q == true
            break
        end
    end

    # i2 is the first from below row with non zero element
    for i in size(A, 1):-1:1
        q = false
        for k = 1:size(A, 2)
            if A[i, k] != zz
                q = true
                i2 = i
                break
            end
        end

        if q == true
            break
        end
    end

    # j1 is the first column with non zero element

    for j = 1:size(A, 2)
        q = false
        for k = 1:size(A, 1)
            if A[k, j] != zz
                j1 = j
                q = true
                break
            end
        end

        if q == true
            break
        end
    end

    # j2 is the last column with non zero element

    for j in size(A, 2):-1:1
        q=false
        for k=1:size(A,1)
            if A[k, j] != zz
                j2 = j
                q=true
                break
            end
        end

        if q==true
            break
        end
    end

    return i1, i2, j1, j2
end

function addLayerofZeros(A, extraLayer)
    # adds layer of zeros from all corners to the given array A

    if extraLayer <= 0
        return A
    end

    N, M = size(A)

    Z = zeros( typeof(A[1,1]), N + 2*extraLayer, M + 2*extraLayer)
    Z[(extraLayer+1):(N + extraLayer ), (extraLayer+1):(M+extraLayer)] = A

    return Z

end

function printIntoFile(A, extraLayer, strFileName, TrimSmallValues = false)
    # exports a 2d matrix A into a csv file
    # @extraLayer is an integers adding layer of 0-s sorrounding the output matrix

    # trimming off very small values; tiny values affect the performance of CSV export
    if TrimSmallValues == true
        A = map(x -> if (abs(x - floor(x)) < 0.01) floor(x) else x end, A)
    end

    i1, i2, j1, j2  = TrimZeros( A )
    A = A[i1:i2, j1:j2]

    A = addLayerofZeros(A, extraLayer)

    CSV.write(string(strFileName,".csv"), DataFrame(A), writeheader = false)

    return A

end

function Array_magnifier(A, cell_mag, border_mag)
    # A is the main array; @cell_mag is the magnifying size of the cell,
    # @border_mag is the magnifying size of the border between lattice cells

    # creates a new array where each cell of the original array A appears magnified by size = cell_mag

    total_factor = cell_mag + border_mag

    A1 = zeros(typeof(A[1, 1]), total_factor*size(A, 1), total_factor*size(A, 2))

    for i = 1:size(A,1), j = 1:size(A,2), u = ((i-1)*total_factor+1):(i*total_factor),
                                          v = ((j-1)*total_factor+1):(j*total_factor)
        if(( u - (i - 1) * total_factor <= cell_mag) && (v - (j - 1) * total_factor <= cell_mag))
            A1[u, v] = A[i, j]
        end
    end

    return A1

end

function saveAsGrayImage(A, fileName, cell_mag, border_mag, TrimSmallValues = false)
    # given a 2d matrix A, we save it as a gray image after magnifying by the given factors
    A1 = Array_magnifier(A, cell_mag, border_mag)
    A1 = A1/maximum(maximum(A1))

    # trimming very small values from A1 to improve performance
    if TrimSmallValues == true
        A1 = map(x -> if ( x < 0.01) 0.0 else round(x, digits = 2) end, A1)
    end

    save(string(fileName, ".png") , colorview(Gray, A1))
end

function saveAsRGBImage(A, fileName, color_codes, cell_mag, border_mag)
    # color_codes is a dictionary, where key is a value in A and value is an RGB triplet
    # given a 2d array A, and color codes (mapping from values in A to RGB triples), save A
    # into fileName as png image after applying the magnifying factors

    A1 = Array_magnifier(A, cell_mag, border_mag)
    color_mat = zeros(UInt8, (3, size(A1, 1), size(A1, 2)))

    for i = 1:size(A1,1)
        for j = 1:size(A1,2)
            color_mat[:, i, j]  = get(color_codes, A1[i, j] , [0, 0, 0])
        end
    end

    save(string(fileName, ".png") , colorview(RGB, color_mat/255))
end

const N_size = 700       # the radius of the lattice Z^2, the actual size becomes (2*N+1)x(2*N+1)
const dx = [1, 0, -1, 0] # for a given (x,y) in Z^2, (x + dx, y + dy) for all (dx,dy) covers the neighborhood of (x,y)
const dy = [0, 1, 0, -1]

struct L_coord
    # represents a lattice coordinate
    x::Int
    y::Int
end

function FindCoordinate(Z::Array{L_coord,1}, a::Int, b::Int)
    # in the given array Z of coordinates finds the (first) index of the tuple (a,b)
    # if no match, returns -1

    for i=1:length(Z)
        if (Z[i].x == a) && (Z[i].y == b)
            return i
        end
    end

    return -1
end

function move(N)
    # the main function moving the pile sand grains of size N at the origin of Z^2 until the sandpile becomes stable

    Z_lat = zeros(UInt8, 2 * N_size + 1, 2 * N_size + 1)     # models the integer lattice Z^2, we will have at most 4 sands on each vertex
    V_sites = falses(2 * N_size + 1, 2 * N_size + 1)         # all sites which are visited by the sandpile process, are being marked here
    Odometer = zeros(UInt64, 2 * N_size + 1, 2 * N_size + 1) # stores the values of the odometer function

    walking = L_coord[]    # the coordinates of sites which need to move

    V_sites[N_size + 1, N_size + 1] = true

    # i1, ... j2  -> show the boundaries of the box which is visited by the sandpile process
    i1, i2, j1, j2 = N_size + 1, N_size + 1, N_size + 1, N_size + 1
    n = N

    t1 = time_ns()

    while n > 0
        n -= 1

        Z_lat[N_size + 1, N_size + 1] += 1
        if (Z_lat[N_size + 1, N_size + 1] >= 4)
            push!(walking, L_coord(N_size + 1, N_size + 1))
        end

        while(length(walking) > 0)
            w = pop!(walking)
            x = w.x
            y = w.y

            Z_lat[x, y] -= 4
            Odometer[x, y] += 4

            for k = 1:4
                Z_lat[x + dx[k], y + dy[k]] += 1
                V_sites[x + dx[k], y + dy[k]] = true
                if Z_lat[x + dx[k], y + dy[k]] >= 4
                    if FindCoordinate(walking, x + dx[k] , y + dy[k]) == -1
                        push!(walking, L_coord( x + dx[k], y + dy[k]))
                    end
                end
            end

            i1 = min(i1, x - 1)
            i2 = max(i2, x + 1)
            j1 = min(j1, y - 1)
            j2 = max(j2, y + 1)
        end

    end #end of the main while
    t2 = time_ns()

    println("The final boundaries are:: ", (i2 - i1 + 1),"x",(j2 - j1 + 1), "\n")
    print("time elapsed: " , (t2 - t1) / 1.0e9, "\n")

    Z_lat = printIntoFile(Z_lat, 0, string("Abel_Z_", N))
    Odometer = printIntoFile(Odometer, 1, string("Abel_OD_", N))

    saveAsGrayImage(Z_lat, string("Abel_Z_", N), 20, 0)
    color_code = Dict(1=>[255, 128, 255], 2=>[255, 0, 0],3 => [0, 128, 255])
    saveAsRGBImage(Z_lat, string("Abel_Z_color_", N), color_code, 20, 0)

    # for the total elapsed time, it's better to use the @time macros on the main call

    return Z_lat, Odometer # these are trimmed in output module

end # end of function move

end # module

using .AbelSand

Z_lat, Odometer = AbelSand.move(100000)


local sandpile = {
  init = function(self, dim, val)
    self.cell, self.dim = {}, dim
    for r = 1, dim do
      self.cell[r] = {}
      for c = 1, dim do
        self.cell[r][c] = 0
      end
    end
    self.cell[math.floor(dim/2)+1][math.floor(dim/2)+1] = val
  end,
  iter = function(self)
    local dim, cel, more = self.dim, self.cell
    repeat
      more = false
      for r = 1, dim do
        for c = 1, dim do
          if cel[r][c] >= 4 then
            cel[r][c] = cel[r][c] - 4
            if c > 1 then cel[r][c-1], more = cel[r][c-1]+1, more or cel[r][c-1]>=3 end
            if c < dim then cel[r][c+1], more = cel[r][c+1]+1, more or cel[r][c+1]>=3 end
            if r > 1 then cel[r-1][c], more = cel[r-1][c]+1, more or cel[r-1][c]>=3 end
            if r < dim then cel[r+1][c], more = cel[r+1][c]+1, more or cel[r+1][c]>=3 end
          end
          more = more or cel[r][c] >= 4
        end
      end
    until not more
  end,
  draw = function(self)
    for r = 1, self.dim do
      print(table.concat(self.cell[r]," "))
    end
  end,
}
sandpile:init(15, 256)
sandpile:iter()
sandpile:draw()


class Main
{
  // assuming m,n are positive
  static Int ackermann (Int m, Int n)
  {
    if (m == 0)
      return n + 1
    else if (n == 0)
      return ackermann (m - 1, 1)
    else
      return ackermann (m - 1, ackermann (m, n - 1))
  }

  public static Void main ()
  {
    (0..3).each |m|
    {
      (0..6).each |n|
      {
        echo ("Ackerman($m, $n) = ${ackermann(m, n)}")
      }
    }
  }
}


*        Abundant odd numbers      18/09/2019
ABUNODDS CSECT
         USING  ABUNODDS,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         SAVE   (14,12)            save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R8,0               n=0
         LA     R6,3               i=3
       DO WHILE=(C,R8,LT,NN1)      do i=3 by 2 until n>=nn1
         BAL    R14,SIGMA            s=sigma(i)
       IF    CR,R9,GT,R6 THEN        if s>i then
         LA     R8,1(R8)               n++
         BAL    R14,PRINT              print results
       ENDIF    ,                    endif
         LA     R6,2(R6)             i+=2
       ENDDO    ,                  enddo i
         LA     R8,0               n=0
         LA     R6,3               i=3
         XR     R1,R1              f=false
       DO WHILE=(C,R1,EQ,=F'0')    do i=3 by 2 while not f
         BAL    R14,SIGMA            s=sigma(i)
       IF    CR,R9,GT,R6 THEN        if s>i then
         LA     R8,1(R8)               n++
       IF      C,R8,GE,NN2 THEN        if n>=nn2 then
         BAL    R14,PRINT                print results
         LA     R1,1                     f=true
       ENDIF    ,                      endif
       ENDIF    ,                    endif
         LA     R6,2(R6)             i+=2
       ENDDO    ,                  enddo i
         LA     R8,0               n=0
         L      R6,NN3             i=mm3
         LA     R6,1(R6)           +1
         XR     R1,R1              f=false
       DO WHILE=(C,R1,EQ,=F'0')    do i=nn3+1 by 2 while not f
         BAL    R14,SIGMA            s=sigma(i)
       IF    CR,R9,GT,R6 THEN        if s>i then
         BAL    R14,PRINT              print results
         LA     R1,1                   f=true
       ENDIF    ,                    endif
         LA     R6,2(R6)             i+=2
       ENDDO    ,                  enddo i
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling save
SIGMA    CNOP   0,4                ---- subroutine sigma
         LA     R9,1               s=1
         LA     R7,3               j=3
         LR     R5,R7              j
         MR     R4,R7              j*j
       DO WHILE=(CR,R5,LT,R6)      do j=3 by 2 while j*j<i
         LR     R4,R6                i
         SRDA   R4,32                ~
         DR     R4,R7                i/j
       IF   LTR,R4,Z,R4 THEN         if mod(i,j)=0 then
         AR     R9,R7                  s+j
         LR     R4,R6                  i
         SRDA   R4,32                  ~
         DR     R4,R7                  i/j
         AR     R9,R5                  s=s+j+i/j
       ENDIF    ,                    endif
         LA     R7,2(R7)             j+=2
         LR     R5,R7                j
         MR     R4,R7                j*j
       ENDDO    ,                  enddo j
       IF    CR,R5,EQ,R6 THEN      if j*j=i then
         AR     R9,R7              s=s+j
       ENDIF    ,                  endif
         BR     R14                ---- end of subroutine sigma
PRINT    CNOP   0,4                ---- subroutine print
         XDECO  R8,XDEC            edit n
         MVC    BUF(4),XDEC+8      output n
         XDECO  R6,BUF+14          edit & output i
         XDECO  R9,BUF+33          edit & output s
         XPRNT  BUF,L'BUF          print buffer
         BR     R14                ---- end of subroutine print
NN1      DC     F'25'              nn1=25
NN2      DC     F'1000'            nn2=1000
NN3      DC     F'1000000000'      nn3=1000000000
BUF      DC     CL80'.... - number=............ sigma=............'
XDEC     DS     CL12               temp for edit
         REGEQU                    equate registers
         END    ABUNODDS


/* ARM assembly AARCH64 Raspberry PI 3B or android 64 bits */
/* program abundant64.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

.equ NBDIVISORS,             1000

/*******************************************/
/* Initialized data                        */
/*******************************************/
.data
szMessStartPgm:          .asciz "Program start \n"
szMessEndPgm:            .asciz "Program normal end.\n"
szMessErrorArea:         .asciz "\033[31mError : area divisors too small.\n"
szMessError:             .asciz "\033[31mError  !!!\n"
szMessErrGen:            .asciz "Error end program.\n"
szMessNbPrem:            .asciz "This number is prime !!!.\n"
szMessOverflow:          .asciz "Dépassement de capacité vérification premier.\n"
szMessResultFact:        .asciz "// "

szCarriageReturn:        .asciz "\n"

/* datas message display */
szMessEntete:            .asciz "The first 25 abundant odd numbers are:\n"
szMessResult:            .asciz "Number : @  sum : @ \n"

szMessEntete1:           .asciz "The 1000 odd abundant number :\n"
szMessEntete2:           .asciz "First odd abundant number > 1000000000 :\n"
/*******************************************/
/* UnInitialized data                      */
/*******************************************/
.bss
.align 4
sZoneConv:               .skip 24
tbZoneDecom:             .skip 16 * NBDIVISORS       // facteur 8 octets nombre 8 octets
/*******************************************/
/*  code section                           */
/*******************************************/
.text
.global main
main:                               // program start
    ldr x0,qAdrszMessStartPgm       // display start message
    bl affichageMess

    ldr x0,qAdrszMessEntete         // display result message
    bl affichageMess
    mov x2,#1
    mov x3,#0
1:
    mov x0,x2                       //  number
    bl testAbundant
    cmp x0,#1
    bne 3f
    add x3,x3,#1
    mov x0,x2
    mov x4,x1                        // save sum
    ldr x1,qAdrsZoneConv
    bl conversion10                  // convert ascii string
    ldr x0,qAdrszMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc               // and put in message
    mov x5,x0
    mov x0,x4                        // sum
    ldr x1,qAdrsZoneConv
    bl conversion10                  // convert ascii string
    mov x0,x5
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc               // and put in message

    bl affichageMess
3:
    add x2,x2,#2
    cmp x3,#25
    blt 1b

    /* 1000 abundant number  */
    ldr x0,qAdrszMessEntete1
    bl affichageMess
    mov x2,#1
    mov x3,#0
4:
    mov x0,x2                       //  number
    bl testAbundant
    cmp x0,#1
    bne 6f
    add x3,x3,#1
6:
    cmp x3,#1000
    cinc x2,x2,lt                    // add two
    cinc x2,x2,lt
    blt 4b
    mov x0,x2
    mov x4,x1                        // save sum
    ldr x1,qAdrsZoneConv
    bl conversion10                  // convert ascii string
    ldr x0,qAdrszMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc               // and put in message
    mov x5,x0
    mov x0,x4                        // sum
    ldr x1,qAdrsZoneConv
    bl conversion10                  // convert ascii string
    mov x0,x5
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc                // and put in message

    bl affichageMess

    /* abundant number>1000000000   */
    ldr x0,qAdrszMessEntete2
    bl affichageMess
    ldr x2,iN10P9
    add x2,x2,#1
    mov x3,#0
7:
    mov x0,x2                       //  number
    bl testAbundant
    cmp x0,#1
    beq 8f
    add x2,x2,#2
    b 7b
8:
    mov x0,x2
    mov x4,x1                        // save sum
    ldr x1,qAdrsZoneConv
    bl conversion10                  // convert ascii string
    ldr x0,qAdrszMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc               // and put in message
    mov x5,x0
    mov x0,x4                        // sum
    ldr x1,qAdrsZoneConv
    bl conversion10                  // convert ascii string
    mov x0,x5
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc                // and put in message

    bl affichageMess

    ldr x0,qAdrszMessEndPgm         // display end message
    bl affichageMess
    b 100f
99:                                 // display error message
    ldr x0,qAdrszMessError
    bl affichageMess
100:                                // standard end of the program
    mov x0, #0                      // return code
    mov x8, #EXIT                   // request to exit program
    svc 0                           // perform system call
qAdrszMessStartPgm:        .quad szMessStartPgm
qAdrszMessEndPgm:          .quad szMessEndPgm
qAdrszMessError:           .quad szMessError
qAdrszCarriageReturn:      .quad szCarriageReturn
qAdrtbZoneDecom:           .quad tbZoneDecom
qAdrszMessEntete:          .quad szMessEntete
qAdrszMessEntete1:         .quad szMessEntete1
qAdrszMessEntete2:         .quad szMessEntete2
qAdrszMessResult:          .quad szMessResult
qAdrsZoneConv:             .quad sZoneConv
iN10P9:                    .quad 1000000000
/******************************************************************/
/*     test if number is abundant number                         */
/******************************************************************/
/* x0 contains the number  */
/* x0 return 1 if abundant number else return 0  */
/* x1 return sum                                 */
testAbundant:
    stp x2,lr,[sp,-16]!         // save  registres
    stp x3,x4,[sp,-16]!         // save  registres
    stp x5,x6,[sp,-16]!         // save  registres
    mov x6,x0                    // save number
    ldr x1,qAdrtbZoneDecom
    bl decompFact                // create area of divisors
    cmp x0,#1                    // no divisors
    ble 99f
    lsl x5,x6,#1                 // abondant number ?
    cmp x5,x2
    bgt 99f                     // no -> end
    mov x0,#1
    sub x1,x2,x6                 // sum
    b 100f
99:
    mov x0,0
100:
    ldp x5,x6,[sp],16         // restaur des  2 registres
    ldp x3,x4,[sp],16         // restaur des  2 registres
    ldp x2,lr,[sp],16         // restaur des  2 registres
    ret
/******************************************************************/
/*     decomposition en facteur                                               */
/******************************************************************/
/* x0 contient le nombre à decomposer */
decompFact:
    stp x3,lr,[sp,-16]!        // save  registres
    stp x4,x5,[sp,-16]!        // save  registres
    stp x6,x7,[sp,-16]!        // save  registres
    stp x8,x9,[sp,-16]!        // save  registres
    stp x10,x11,[sp,-16]!        // save  registres
    mov x5,x1
    mov x8,x0                    // save number
    bl isPrime                   // prime ?
    cmp x0,#1
    beq 98f                      // yes is prime
    mov x1,#1
    str x1,[x5]                  // first factor
    mov x12,#1                   // divisors sum
    mov x11,#1                   // number odd divisors
    mov x4,#1                    // indice divisors table
    mov x1,#2                    // first divisor
    mov x6,#0                    // previous divisor
    mov x7,#0                    // number of same divisors
2:
    mov x0,x8                    // dividende
    udiv x2,x0,x1                //  x1 divisor x2 quotient x3 remainder
    msub x3,x2,x1,x0
    cmp x3,#0
    bne 5f                       // if remainder <> zero  -> no divisor
    mov x8,x2                    // else quotient -> new dividende
    cmp x1,x6                    // same divisor ?
    beq 4f                       // yes
    mov x7,x4                    // number factors in table
    mov x9,#0                    // indice
21:
    ldr x10,[x5,x9,lsl #3 ]      // load one factor
    mul x10,x1,x10               // multiply
    str x10,[x5,x7,lsl #3]       // and store in the table
    tst x10,#1                   // divisor odd ?
    cinc x11,x11,ne
    add x12,x12,x10
    add x7,x7,#1                 // and increment counter
    add x9,x9,#1
    cmp x9,x4
    blt 21b
    mov x4,x7
    mov x6,x1                    // new divisor
    b 7f
4:                               // same divisor
    sub x9,x4,#1
    mov x7,x4
41:
    ldr x10,[x5,x9,lsl #3 ]
    cmp x10,x1
    sub x13,x9,1
    csel x9,x13,x9,ne
    bne 41b
    sub x9,x4,x9
42:
    ldr  x10,[x5,x9,lsl #3 ]
    mul x10,x1,x10
    str x10,[x5,x7,lsl #3]       // and store in the table
    tst x10,#1                   // divsor odd ?
    cinc  x11,x11,ne
    add x12,x12,x10
    add x7,x7,#1                 // and increment counter
    add x9,x9,#1
    cmp x9,x4
    blt 42b
    mov x4,x7
    b 7f                         // and loop

    /* not divisor -> increment next divisor */
5:
    cmp x1,#2                    // if divisor = 2 -> add 1
    add x13,x1,#1                // add 1
    add x14,x1,#2                // else add 2
    csel x1,x13,x14,eq
    b 2b

    /* divisor -> test if new dividende is prime */
7:
    mov x3,x1                    // save divisor
    cmp x8,#1                    // dividende = 1 ? -> end
    beq 10f
    mov x0,x8                    // new dividende is prime ?
    mov x1,#0
    bl isPrime                   // the new dividende is prime ?
    cmp x0,#1
    bne 10f                      // the new dividende is not prime

    cmp x8,x6                    // else dividende is same divisor ?
    beq 9f                       // yes
    mov x7,x4                    // number factors in table
    mov x9,#0                    // indice
71:
    ldr x10,[x5,x9,lsl #3 ]      // load one factor
    mul x10,x8,x10               // multiply
    str x10,[x5,x7,lsl #3]       // and store in the table
    tst x10,#1                   // divsor odd ?
    cinc x11,x11,ne
    add x12,x12,x10
    add x7,x7,#1                 // and increment counter
    add x9,x9,#1
    cmp x9,x4
    blt 71b
    mov x4,x7
    mov x7,#0
    b 11f
9:
    sub x9,x4,#1
    mov x7,x4
91:
    ldr x10,[x5,x9,lsl #3 ]
    cmp x10,x8
    sub x13,x9,#1
    csel x9,x13,x9,ne
    bne 91b
    sub x9,x4,x9
92:
    ldr  x10,[x5,x9,lsl #3 ]
    mul x10,x8,x10
    str x10,[x5,x7,lsl #3]       // and store in the table
    tst x10,#1                   // divisor odd ?
    cinc x11,x11,ne
    add x12,x12,x10
    add x7,x7,#1                 // and increment counter
    add x9,x9,#1
    cmp x9,x4
    blt 92b
    mov x4,x7
    b 11f

10:
    mov x1,x3                    // current divisor = new divisor
    cmp x1,x8                    // current divisor  > new dividende ?
    ble 2b                       // no -> loop

    /* end decomposition */
11:
    mov x0,x4                    // return number of table items
    mov x2,x12                   // return sum
    mov x1,x11                   // return number of odd divisor
    mov x3,#0
    str x3,[x5,x4,lsl #3]        // store zéro in last table item
    b 100f

98:
    //ldr x0,qAdrszMessNbPrem
    //bl   affichageMess
    mov x0,#1                   // return code
    b 100f
99:
    ldr x0,qAdrszMessError
    bl   affichageMess
    mov x0,#-1                  // error code
    b 100f

100:
    ldp x10,x11,[sp],16          // restaur des  2 registres
    ldp x8,x9,[sp],16          // restaur des  2 registres
    ldp x6,x7,[sp],16          // restaur des  2 registres
    ldp x4,x5,[sp],16          // restaur des  2 registres
    ldp x3,lr,[sp],16          // restaur des  2 registres
    ret                        // retour adresse lr x30
qAdrszMessErrGen:          .quad szMessErrGen
qAdrszMessNbPrem:          .quad szMessNbPrem
/***************************************************/
/*   Verification si un nombre est premier         */
/***************************************************/
/* x0 contient le nombre à verifier */
/* x0 retourne 1 si premier  0 sinon */
isPrime:
    stp x1,lr,[sp,-16]!        // save  registres
    stp x2,x3,[sp,-16]!        // save  registres
    mov x2,x0
    sub x1,x0,#1
    cmp x2,0
    beq 99f                    // retourne zéro
    cmp x2,2                   // pour 1 et 2 retourne 1
    ble 2f
    mov x0,#2
    bl moduloPux64
    bcs 100f                   // erreur overflow
    cmp x0,#1
    bne 99f                    // Pas premier
    cmp x2,3
    beq 2f
    mov x0,#3
    bl moduloPux64
    blt 100f                   // erreur overflow
    cmp x0,#1
    bne 99f

    cmp x2,5
    beq 2f
    mov x0,#5
    bl moduloPux64
    bcs 100f                   // erreur overflow
    cmp x0,#1
    bne 99f                    // Pas premier

    cmp x2,7
    beq 2f
    mov x0,#7
    bl moduloPux64
    bcs 100f                   // erreur overflow
    cmp x0,#1
    bne 99f                    // Pas premier

    cmp x2,11
    beq 2f
    mov x0,#11
    bl moduloPux64
    bcs 100f                   // erreur overflow
    cmp x0,#1
    bne 99f                    // Pas premier

    cmp x2,13
    beq 2f
    mov x0,#13
    bl moduloPux64
    bcs 100f                   // erreur overflow
    cmp x0,#1
    bne 99f                    // Pas premier
2:
    cmn x0,0                   // carry à zero pas d'erreur
    mov x0,1                   // premier
    b 100f
99:
    cmn x0,0                   // carry à zero pas d'erreur
    mov x0,#0                  // Pas premier
100:
    ldp x2,x3,[sp],16          // restaur des  2 registres
    ldp x1,lr,[sp],16          // restaur des  2 registres
    ret                        // retour adresse lr x30

/**************************************************************/
/********************************************************/
/*   Calcul modulo de b puissance e modulo m  */
/*    Exemple 4 puissance 13 modulo 497 = 445         */
/********************************************************/
/* x0  nombre  */
/* x1 exposant */
/* x2 modulo   */
moduloPux64:
    stp x1,lr,[sp,-16]!        // save  registres
    stp x3,x4,[sp,-16]!        // save  registres
    stp x5,x6,[sp,-16]!        // save  registres
    stp x7,x8,[sp,-16]!        // save  registres
    stp x9,x10,[sp,-16]!        // save  registres
    cbz x0,100f
    cbz x1,100f
    mov x8,x0
    mov x7,x1
    mov x6,1                   // resultat
    udiv x4,x8,x2
    msub x9,x4,x2,x8           // contient le reste
1:
    tst x7,1
    beq 2f
    mul x4,x9,x6
    umulh x5,x9,x6
    //cbnz x5,99f
    mov x6,x4
    mov x0,x6
    mov x1,x5
    bl divisionReg128U
    cbnz x1,99f                // overflow
    mov x6,x3
2:
    mul x8,x9,x9
    umulh x5,x9,x9
    mov x0,x8
    mov x1,x5
    bl divisionReg128U
    cbnz x1,99f                // overflow
    mov x9,x3
    lsr x7,x7,1
    cbnz x7,1b
    mov x0,x6                  // result
    cmn x0,0                   // carry à zero pas d'erreur
    b 100f
99:
    ldr x1,qAdrszMessOverflow
    bl   afficheErreur
    cmp x0,0                   // carry à un car erreur
    mov x0,-1                  // code erreur

100:
    ldp x9,x10,[sp],16          // restaur des  2 registres
    ldp x7,x8,[sp],16          // restaur des  2 registres
    ldp x5,x6,[sp],16          // restaur des  2 registres
    ldp x3,x4,[sp],16          // restaur des  2 registres
    ldp x1,lr,[sp],16          // restaur des  2 registres
    ret                        // retour adresse lr x30
qAdrszMessOverflow:         .quad  szMessOverflow
/***************************************************/
/*   division d un nombre de 128 bits par un nombre de 64 bits */
/***************************************************/
/* x0 contient partie basse dividende */
/* x1 contient partie haute dividente */
/* x2 contient le diviseur */
/* x0 retourne partie basse quotient */
/* x1 retourne partie haute quotient */
/* x3 retourne le reste */
divisionReg128U:
    stp x6,lr,[sp,-16]!        // save  registres
    stp x4,x5,[sp,-16]!        // save  registres
    mov x5,#0                  // raz du reste R
    mov x3,#128                // compteur de boucle
    mov x4,#0                  // dernier bit
1:
    lsl x5,x5,#1               // on decale le reste de 1
    tst x1,1<<63               // test du bit le plus à gauche
    lsl x1,x1,#1               // on decale la partie haute du quotient de 1
    beq 2f
    orr  x5,x5,#1              // et on le pousse dans le reste R
2:
    tst x0,1<<63
    lsl x0,x0,#1               // puis on decale la partie basse
    beq 3f
    orr x1,x1,#1               // et on pousse le bit de gauche dans la partie haute
3:
    orr x0,x0,x4               // position du dernier bit du quotient
    mov x4,#0                  // raz du bit
    cmp x5,x2
    blt 4f
    sub x5,x5,x2                // on enleve le diviseur du reste
    mov x4,#1                   // dernier bit à 1
4:
                               // et boucle
    subs x3,x3,#1
    bgt 1b
    lsl x1,x1,#1               // on decale le quotient de 1
    tst x0,1<<63
    lsl x0,x0,#1              // puis on decale la partie basse
    beq 5f
    orr x1,x1,#1
5:
    orr x0,x0,x4                  // position du dernier bit du quotient
    mov x3,x5
100:
    ldp x4,x5,[sp],16          // restaur des  2 registres
    ldp x6,lr,[sp],16          // restaur des  2 registres
    ret                        // retour adresse lr x30
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


with Ada.Text_IO, Generic_Divisors;

procedure Odd_Abundant is
   function Same(P: Positive) return Positive is (P);

   package Divisor_Sum is new Generic_Divisors
     (Result_Type => Natural, None => 0, One => Same, Add =>  "+");

   function Abundant(N: Positive) return Boolean is
      (Divisor_Sum.Process(N) > N);

   package NIO is new Ada.Text_IO.Integer_IO(Natural);

   Current: Positive := 1;

   procedure Print_Abundant_Line
     (Idx: Positive; N: Positive; With_Idx: Boolean:= True) is
   begin
      if With_Idx then
	 NIO.Put(Idx, 6);  Ada.Text_IO.Put(" |");
      else
	 Ada.Text_IO.Put("   *** |");
      end if;
      NIO.Put(N, 12); Ada.Text_IO.Put(" | ");
      NIO.Put(Divisor_Sum.Process(N), 12); Ada.Text_IO.New_Line;
   end Print_Abundant_Line;

begin
   -- the first 25 abundant odd numbers
   Ada.Text_IO.Put_Line(" index |      number | proper divisor sum ");
   Ada.Text_IO.Put_Line("-------+-------------+--------------------");
   for I in 1 .. 25 loop
      while not Abundant(Current) loop
	 Current := Current + 2;
      end loop;
      Print_Abundant_Line(I, Current);
      Current := Current + 2;
   end loop;

   -- the one thousandth abundant odd number
   Ada.Text_IO.Put_Line("-------+-------------+--------------------");
   for I in 26 .. 1_000 loop
      Current := Current + 2;
      while not Abundant(Current) loop
	 Current := Current + 2;
      end loop;
   end loop;
   Print_Abundant_Line(1000, Current);

   -- the first abundant odd number greater than 10**9
   Ada.Text_IO.Put_Line("-------+-------------+--------------------");
   Current := 10**9+1;
   while not Abundant(Current) loop
      Current := Current + 2;
   end loop;
   Print_Abundant_Line(1, Current, False);
end Odd_Abundant;


ClearAll[sp]
sp[s_List] + sp[n_Integer] ^:= sp[s] + sp[ConstantArray[n, Dimensions[s]]]
sp[s_List] + sp[t_List] ^:= Module[{dim, r, tmp, neighbours}, dim = Dimensions[s];
  r = s + t;
  While[Max[r] > 3, r = ArrayPad[r, 1, 0];
   tmp = Quotient[r, 4];
   r -= 4 tmp;
   r += RotateLeft[tmp, {0, 1}] + RotateLeft[tmp, {1, 0}] +
     RotateLeft[tmp, {0, -1}] + RotateLeft[tmp, {-1, 0}];
   r = ArrayPad[r, -1];];
  sp[r]
  ]
u = sp[CenterArray[250, {15, 15}]];
u += sp[0];
StringRiffle[StringJoin /@ Map[ToString, u[[1]], {2}], "\n"]


# Abelian sandpile.

from math import sqrt
from nimPNG import savePNG24
from sequtils import repeat
from strformat import fmt
from strutils import strip, addSep, parseInt

# The grid represented as a sequence of sequences of int32.
type Grid = seq[seq[int32]]

# Colors to use for PPM and PNG files.
const Colors = [[byte 100,  40,  15],
                [byte 117,  87,  30],
                [byte 181, 134,  47],
                [byte 245, 182,  66]]

#---------------------------------------------------------------------------------------------------

func sideLength(initVal: int32): int32 =
  # Return the grid side length needed for "initVal" particles.
  # We make sure that the returned value is odd.
  result = sqrt(initVal.toFloat / 1.75).int32 + 3
  result += result and 1 xor 1

#---------------------------------------------------------------------------------------------------

func doOneStep(grid: var Grid; boundary: var array[4, int]): bool =
  ## Compute one step.

  result = false

  for y in boundary[0]..boundary[2]:
    for x in boundary[1]..boundary[3]:
      if grid[y][x] >= 4:

        let rem = grid[y][x] div 4
        grid[y][x] = grid[y][x] mod 4

        if y - 1 >= 0:
          inc grid[y - 1][x], rem
          if y == boundary[0]:
            dec boundary[0]

        if x - 1 >= 0:
          inc grid[y][x - 1], rem
          if x == boundary[1]:
            dec boundary[1]

        if y + 1 < grid.len:
          inc grid[y + 1][x], rem
          if y == boundary[2]:
            inc boundary[2]

        if x + 1 < grid.len:
          inc grid[y][x + 1], rem
          if x == boundary[3]:
            inc boundary[3]

        result = true

#---------------------------------------------------------------------------------------------------

proc display(grid: Grid; initVal: int) =
  ## Display the grid as an array of values.

  echo fmt"Starting with {initVal} particles."
  echo ""

  var line = newStringOfCap(2 * grid.len - 1)
  for row in grid:
    for value in row:
      line.addSep(" ", 0)
      line.add($value)
    echo line
    line.setLen(0)
  echo ""

#---------------------------------------------------------------------------------------------------

proc writePpmFile(grid: Grid; name: string) =
  ## Write a grid representation in a PPM file.

  var file = open(name, fmWrite)
  file.write(fmt"P6 {grid.len} {grid.len} 255 ")

  for row in grid:
    for value in row:
      discard file.writeBytes(Colors[value], 0, 3)

  file.close()
  echo fmt"PPM image written in ""{name}""."

#---------------------------------------------------------------------------------------------------

proc writePngFile(grid: Grid; name: string) =
  ## Write a grid representation in a PNG file.

  var pixels = newSeq[byte](3 * grid.len * grid.len)

  # Build pixel list.
  var idx = 0
  for row in grid:
    for value in row:
      pixels[idx..idx+2] = Colors[value]
      inc idx, 3

  discard savePNG24(name, pixels, grid.len, grid.len)
  echo fmt"PNG image written in ""{name}""."

#---------------------------------------------------------------------------------------------------

proc askInitVal(): int32 =
  # Ask user for the number of particles.

  while true:
    stdout.write("Number of particles? ")
    try:
      let input = stdin.readLine().strip().parseInt()
      if input in 4..int32.high:
        return input.int32
      echo fmt"Value not in expected range: 4..{int32.high}"
    except ValueError:
      echo "Invalid input"
    except EOFError:
      quit(QuitSuccess)

#---------------------------------------------------------------------------------------------------

# Initialize the grid.
let initVal = askInitVal()
let sideLen = sideLength(initVal)
var grid = repeat(newSeq[int32](sideLen), sideLen)
let origin = grid.len div 2
var boundaries: array[4, int] = [origin, origin, origin, origin]
grid[origin][origin] = initVal

# Run the simulation.
while doOneStep(grid, boundaries):
  discard

# Display grid.
if grid.len <= 20:
  grid.display(initVal)
#grid.writePpmFile(fmt"grid_{initVal}.ppm")
grid.writePngFile(fmt"grid_{initVal}.png")


#APPTYPE CONSOLE

TestAckermann()

PAUSE

SUB TestAckermann()
	FOR DIM m = 0 TO 3
		FOR DIM n = 0 TO 10
			PRINT AckermannF(m, n), " ";
		NEXT
		PRINT
	NEXT
END SUB

FUNCTION AckermannF(m AS INTEGER, n AS INTEGER) AS INTEGER
	IF NOT m THEN RETURN n + 1
	IF NOT n THEN RETURN AckermannA(m - 1, 1)
	RETURN AckermannC(m - 1, AckermannF(m, n - 1))
END FUNCTION

DYNC AckermannC(m AS INTEGER, n AS INTEGER) AS INTEGER


BEGIN
    # find some abundant odd numbers - numbers where the sum of the proper    #
    #                                  divisors is bigger than the number     #
    #                                  itself                                 #

    # returns the sum of the proper divisors of n                             #
    PROC divisor sum = ( INT n )INT:
    BEGIN
        INT sum := 1;
        FOR d FROM 2 TO ENTIER sqrt( n ) DO
            IF n MOD d = 0 THEN
                sum +:= d;
                IF INT other d := n OVER d;
                   other d /= d
                THEN
                    sum +:= other d
                FI
            FI
        OD;
        sum
    END # divisor sum # ;
    # find numbers required by the task                                       #
    BEGIN
        # first 25 odd abundant numbers                                       #
        INT odd number := 1;
        INT a count    := 0;
        INT d sum      := 0;
        print( ( "The first 25 abundant odd numbers:", newline ) );
        WHILE a count < 25 DO
            IF ( d sum := divisor sum( odd number ) ) > odd number THEN
                a count +:= 1;
                print( ( whole( odd number, -6 )
                       , " proper divisor sum: "
                       , whole( d sum, 0 )
                       , newline
                       )
                     )
            FI;
            odd number +:= 2
        OD;
        # 1000th odd abundant number                                          #
        WHILE a count < 1 000 DO
            IF ( d sum := divisor sum( odd number ) ) > odd number THEN
                a count := a count + 1
            FI;
            odd number +:= 2
        OD;
        print( ( "1000th abundant odd number:"
               , newline
               , "    "
               , whole( odd number - 2, 0 )
               , " proper divisor sum: "
               , whole( d sum, 0 )
               , newline
               )
             );
        # first odd abundant number > one billion                             #
        odd number := 1 000 000 001;
        BOOL found := FALSE;
        WHILE NOT found DO
            IF ( d sum := divisor sum( odd number ) ) > odd number THEN
                found  := TRUE;
                print( ( "First abundant odd number > 1 000 000 000:"
                       , newline
                       , "    "
                       , whole( odd number, 0 )
                       , " proper divisor sum: "
                       , whole( d sum, 0 )
                       , newline
                       )
                     )
            FI;
            odd number +:= 2
        OD
    END
END


module Make =
  functor (M : sig val m : int val n : int end)
  -> struct

    let grid = Array.init M.m (fun _ -> Array.make M.n 0)

    let print () =
      for i = 0 to M.m - 1
      do for j = 0 to M.n - 1
         do Printf.printf "%d " grid.(i).(j)
         done
       ; print_newline ()
       done

    let unstable = Hashtbl.create 10

    let add_grain x y
      = grid.(x).(y) <- grid.(x).(y) + 1
      ; if grid.(x).(y) >= 4 then
          Hashtbl.replace unstable (x,y) () (* Use Hashtbl.replace for uniqueness *)

    let topple x y
      = grid.(x).(y) <- grid.(x).(y) - 4
      ; if grid.(x).(y) < 4
        then Hashtbl.remove unstable (x,y)
      ; match (x,y) with
        (* corners *)
        | (0,0) -> add_grain 1 0
                 ; add_grain 0 1
        | (0,n) when n = M.n - 1
          -> add_grain 1 n
           ; add_grain 0 (n-1)
        | (m,0) when m = M.m - 1
          -> add_grain m 1
           ; add_grain (m-1) 0
        | (m,n) when m = M.m - 1 && n = M.n - 1
          -> add_grain ( m ) (n-1)
           ; add_grain (m-1) ( n )
        (* sides *)
        | (0,y) -> add_grain 1 y
                 ; add_grain 0 (y+1)
                 ; add_grain 0 (y-1)
        | (m,y) when m = M.m - 1
          -> add_grain ( m ) (y-1)
           ; add_grain ( m ) (y+1)
           ; add_grain (m-1) ( y )
        | (x,0) -> add_grain (x+1) 0
                 ; add_grain (x-1) 0
                 ; add_grain ( x ) 1
        | (x,n) when n = M.n - 1
          -> add_grain (x-1) ( n )
           ; add_grain (x+1) ( n )
           ; add_grain ( x ) (n-1)
        (* else *)
        | (x,y) -> add_grain ( x ) (y+1)
                 ; add_grain ( x ) (y-1)
                 ; add_grain (x+1) ( y )
                 ; add_grain (x-1) ( y )

    let add_sand n x y
      = for i = 1 to n
        do add_grain x y
        done

    let avalanche ()
      = while Hashtbl.length unstable > 0
        do
         let unstable' = Hashtbl.fold  (fun (x,y) () r -> (x,y) :: r) unstable []
         in List.iter (fun (x,y) -> topple x y ) unstable'
        done
  end

(* testing *)

let ()
  = let module S = Make (struct let m = 11 let n = 11 end)
    in S.add_sand 500 5 5
     ; S.avalanche ()
     ; S.print ()


Func A(m,n) = if m = 0 then n+1 else if n = 0 then A(m-1,1) else A(m-1,A(m,n-1)) fi fi.;
A(3,8)


begin
    % find some abundant odd numbers - numbers where the sum of the proper    %
    %                                  divisors is bigger than the number     %
    %                                  itself                                 %

    % computes the sum of the divisors of v using the prime                   %
    % factorisation                                                           %
    integer procedure divisor_sum( integer value v ) ; begin
        integer total, power, n, p;
        total := 1; power := 2; n := v;
        % Deal with powers of 2 first %
        while not odd( n ) do begin
            total := total + power;
            power := power * 2;
            n     := n div 2
        end while_not_odd_n ;
        % Odd prime factors up to the square root %
        p := 3;
        while ( p * p ) <= n do begin
            integer sum;
            sum   := 1;
            power := p;
            while n rem p = 0 do begin
                sum   := sum + power;
                power := power * p;
                n     := n div p
            end while_n_rem_p_eq_0 ;
            p     := p + 2;
            total := total * sum
        end while_p_x_p_le_n ;
        % If n > 1 then it's prime %
        if n > 1 then total := total * ( n + 1 );
        total
    end divisor_sum ;
    % returns the sum of the proper divisors of v                             %
    integer procedure divisorSum( integer value v ) ;
        if v < 2 then 0 else divisor_sum( v ) - v;
    % find numbers required by the task                                       %
    begin
        integer aCount, oddNumber, dSum;
        logical foundOddAn;
        % first 25 odd abundant numbers                                       %
        oddNumber := 1;
        aCount    := 0;
        write( "The first 25 abundant odd numbers:" );
        while aCount < 25 do begin
            dSum := divisorSum( oddNumber );
            if dSum > oddNumber then begin
                aCount := aCount + 1;
                write( i_w := 6, oddNumber, " proper divisor sum: ", dSum )
            end if_dSum_gt_oddNumber ;
            oddNumber := oddNumber + 2
        end while_aCount_lt_1000 ;
        % 1000th odd abundant number                                          %
        while aCount < 1000 do begin
            dSum := divisorSum( oddNumber );
            if dSum > oddNumber then aCount := aCount + 1;
            oddNumber := oddNumber + 2
        end while_aCount_lt_1000 ;
        write( "1000th abundant odd number: " );
        write( oddNumber - 2, " proper divisor sum: ", dSum );
        % first odd abundant number > one billion                             %
        oddNumber  := 1000000001;
        foundOddAn := false;
        while not foundOddAn do begin
            dSum := divisorSum( oddNumber );
            if dSum > oddNumber then begin
                foundOddAn := true;
                write( "First abundant odd number > 1000000000: " );
                write( oddNumber, " proper divisor sum: ", dSum )
            end if_dSum_gt_oddNumber ;
            oddNumber := oddNumber + 2
        end while_not_foundOddAn ;
    end
end.


on aliquotSum(n)
    if (n < 2) then return 0
    set sum to 1
    set sqrt to n ^ 0.5
    set limit to sqrt div 1
    if (limit = sqrt) then
        set sum to sum + limit
        set limit to limit - 1
    end if
    repeat with i from 2 to limit
        if (n mod i is 0) then set sum to sum + i + n div i
    end repeat

    return sum
end aliquotSum

-- Task code:
local output, counter, n, sum, astid
set output to {"The first 25 abundant odd numbers:"}
set counter to 0
set n to 1
repeat until (counter = 25)
    set sum to aliquotSum(n)
    if (sum > n) then
        set end of output to "  " & n & "  (proper divisor sum:  " & sum & ")"
        set counter to counter + 1
    end if
    set n to n + 2
end repeat

set end of output to "The one thousandth:"
repeat until (counter = 1000)
    set sum to aliquotSum(n)
    if (sum > n) then set counter to counter + 1
    set n to n + 2
end repeat
set end of output to "  " & (n - 2) & "  (proper divisor sum:  " & sum & ")"

set end of output to "The first > 1,000,000,000:"
set n to 1.000000001E+9
set sum to aliquotSum(n)
repeat until (sum > n)
    set n to n + 2
    set sum to aliquotSum(n)
end repeat
set end of output to "  " & (n div 1000000) & text 2 thru -1 of ((1000000 + ((n mod 1000000) as integer)) as text) & ¬
    "  (proper divisor sum:  " & (sum div 1000000) & text 2 thru -1 of ((1000000 + ((sum mod 1000000) as integer)) as text) & ")"

set astid to AppleScript's text item delimiters
set AppleScript's text item delimiters to linefeed
set output to output as text
set AppleScript's text item delimiters to astid
return output


#!/usr/bin/perl

use strict; # http://www.rosettacode.org/wiki/Abelian_sandpile_model
use warnings;

my ($high, $wide) = split ' ', qx(stty size);
my $mask = "\0" x $wide . ("\0" . "\177" x ($wide - 2) . "\0") x ($high - 5) .
  "\0" x $wide;
my $pile = $mask =~ s/\177/ rand() < 0.02 ? chr 64 + rand 20 : "\0" /ger;

for ( 1 .. 1e6 )
  {
  print "\e[H", $pile =~ tr/\0-\177/ 1-~/r, "\n$_";
  my $add = $pile =~ tr/\1-\177/\0\0\0\200/r; # set high bit for >=4
  $add =~ /\200/ or last;
  $pile =~ tr/\4-\177/\0-\173/; # subtract 4 if >=4
  for ("\0$add", "\0" x $wide . $add, substr($add, 1), substr $add, $wide)
    {
    $pile |= $_;
    $pile =~ tr/\200-\377/\1-\176/; # add one to each neighbor of >=4
    $pile &= $mask;
    }
  select undef, undef, undef, 0.1; # comment out for full speed
  }


: acker ( m n -- u )
	over 0= IF  nip 1+ EXIT  THEN
	swap 1- swap ( m-1 n -- )
	dup  0= IF  1+  recurse EXIT  THEN
	1- over 1+ swap recurse recurse ;


/* ARM assembly Raspberry PI  */
/* program abundant.s   */

 /* REMARK 1 : this program use routines in a include file
   see task Include a file language arm assembly
   for the routine affichageMess conversion10
   see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"

.equ NBDIVISORS,             1000

/*******************************************/
/* Initialized data                        */
/*******************************************/
.data
szMessStartPgm:          .asciz "Program start \n"
szMessEndPgm:            .asciz "Program normal end.\n"
szMessErrorArea:         .asciz "\033[31mError : area divisors too small.\n"
szMessError:             .asciz "\033[31mError  !!!\n"
szMessErrGen:            .asciz "Error end program.\n"
szMessNbPrem:            .asciz "This number is prime !!!.\n"
szMessResultFact:        .asciz "@ "

szCarriageReturn:        .asciz "\n"

/* datas message display */
szMessEntete:            .asciz "The first 25 abundant odd numbers are:\n"
szMessResult:            .asciz "Number : @  sum : @ \n"

szMessEntete1:           .asciz "The 1000 odd abundant number :\n"
szMessEntete2:           .asciz "First odd abundant number > 1000000000 :\n"
/*******************************************/
/* UnInitialized data                      */
/*******************************************/
.bss
.align 4
sZoneConv:               .skip 24
tbZoneDecom:             .skip 4 * NBDIVISORS       // facteur 4 octets
/*******************************************/
/*  code section                           */
/*******************************************/
.text
.global main
main:                               @ program start
    ldr r0,iAdrszMessStartPgm       @ display start message
    bl affichageMess

    ldr r0,iAdrszMessEntete         @ display result message
    bl affichageMess
    mov r2,#1
    mov r3,#0
1:
    mov r0,r2                       @  number
    bl testAbundant
    cmp r0,#1
    bne 3f
    add r3,#1
    mov r0,r2
    mov r4,r1                        @ save sum
    ldr r1,iAdrsZoneConv
    bl conversion10                  @ convert ascii string
    ldr r0,iAdrszMessResult
    ldr r1,iAdrsZoneConv
    bl strInsertAtCharInc               @ and put in message
    mov r5,r0
    mov r0,r4                        @ sum
    ldr r1,iAdrsZoneConv
    bl conversion10                  @ convert ascii string
    mov r0,r5
    ldr r1,iAdrsZoneConv
    bl strInsertAtCharInc               @ and put in message

    bl affichageMess
3:
    add r2,r2,#2
    cmp r3,#25
    blt 1b

    /* 1000 abundant number  */
    ldr r0,iAdrszMessEntete1
    bl affichageMess
    mov r2,#1
    mov r3,#0
4:
    mov r0,r2                       @  number
    bl testAbundant
    cmp r0,#1
    bne 6f
    add r3,#1
6:
    cmp r3,#1000
    addlt r2,r2,#2
    blt 4b
    mov r0,r2
    mov r4,r1                        @ save sum
    ldr r1,iAdrsZoneConv
    bl conversion10                  @ convert ascii string
    ldr r0,iAdrszMessResult
    ldr r1,iAdrsZoneConv
    bl strInsertAtCharInc               @ and put in message
    mov r5,r0
    mov r0,r4                        @ sum
    ldr r1,iAdrsZoneConv
    bl conversion10                  @ convert ascii string
    mov r0,r5
    ldr r1,iAdrsZoneConv
    bl strInsertAtCharInc                @ and put in message

    bl affichageMess

    /* abundant number>1000000000   */
    ldr r0,iAdrszMessEntete2
    bl affichageMess
    ldr r2,iN10P9
    add r2,#1
    mov r3,#0
7:
    mov r0,r2                       @  number
    bl testAbundant
    cmp r0,#1
    beq 8f
    add r2,r2,#2
    b 7b
8:
    mov r0,r2
    mov r4,r1                        @ save sum
    ldr r1,iAdrsZoneConv
    bl conversion10                  @ convert ascii string
    ldr r0,iAdrszMessResult
    ldr r1,iAdrsZoneConv
    bl strInsertAtCharInc               @ and put in message
    mov r5,r0
    mov r0,r4                        @ sum
    ldr r1,iAdrsZoneConv
    bl conversion10                  @ convert ascii string
    mov r0,r5
    ldr r1,iAdrsZoneConv
    bl strInsertAtCharInc                @ and put in message

    bl affichageMess

    ldr r0,iAdrszMessEndPgm         @ display end message
    bl affichageMess
    b 100f
99:                                 @ display error message
    ldr r0,iAdrszMessError
    bl affichageMess
100:                                @ standard end of the program
    mov r0, #0                      @ return code
    mov r7, #EXIT                   @ request to exit program
    svc 0                           @ perform system call
iAdrszMessStartPgm:        .int szMessStartPgm
iAdrszMessEndPgm:          .int szMessEndPgm
iAdrszMessError:           .int szMessError
iAdrszCarriageReturn:      .int szCarriageReturn
iAdrtbZoneDecom:           .int tbZoneDecom
iAdrszMessEntete:          .int szMessEntete
iAdrszMessEntete1:         .int szMessEntete1
iAdrszMessEntete2:         .int szMessEntete2
iAdrszMessResult:          .int szMessResult
iAdrsZoneConv:             .int sZoneConv
iN10P9:                    .int 1000000000
/******************************************************************/
/*     test if number is abundant number                         */
/******************************************************************/
/* r0 contains the number  */
/* r0 return 1 if Zumkeller number else return 0  */
testAbundant:
    push {r2-r6,lr}              @ save  registers
    mov r6,r0                    @ save number
    ldr r1,iAdrtbZoneDecom
    bl decompFact                @ create area of divisors
    cmp r0,#1                    @ no divisors
    movle r0,#0
    ble 100f
    lsl r5,r6,#1                 @ abondant number ?
    cmp r5,r2
    movgt r0,#0
    bgt 100f                     @ no -> end
    mov r0,#1
    sub r1,r2,r6                 @ sum
100:
    pop {r2-r6,lr}               @ restaur registers
    bx lr                        @ return

/******************************************************************/
/*     factor decomposition                                               */
/******************************************************************/
/* r0 contains number */
/* r1 contains address of divisors area */
/* r0 return divisors items in table */
/* r1 return the number of odd divisors  */
/* r2 return the sum of divisors  */
decompFact:
    push {r3-r8,lr}              @ save  registers
    mov r5,r1
    mov r8,r0                    @ save number
    bl isPrime                   @ prime ?
    cmp r0,#1
    beq 98f                      @ yes is prime
    mov r1,#1
    str r1,[r5]                  @ first factor
    mov r12,#1                   @ divisors sum
    mov r11,#1                   @ number odd divisors
    mov r4,#1                    @ indice divisors table
    mov r1,#2                    @ first divisor
    mov r6,#0                    @ previous divisor
    mov r7,#0                    @ number of same divisors
2:
    mov r0,r8                    @ dividende
    bl division                  @  r1 divisor r2 quotient r3 remainder
    cmp r3,#0
    bne 5f                       @ if remainder <> zero  -> no divisor
    mov r8,r2                    @ else quotient -> new dividende
    cmp r1,r6                    @ same divisor ?
    beq 4f                       @ yes
    mov r7,r4                    @ number factors in table
    mov r9,#0                    @ indice
21:
    ldr r10,[r5,r9,lsl #2 ]      @ load one factor
    mul r10,r1,r10               @ multiply
    str r10,[r5,r7,lsl #2]       @ and store in the table
    tst r10,#1                   @ divisor odd ?
    addne r11,#1
    add r12,r10
    add r7,r7,#1                 @ and increment counter
    add r9,r9,#1
    cmp r9,r4
    blt 21b
    mov r4,r7
    mov r6,r1                    @ new divisor
    b 7f
4:                               @ same divisor
    sub r9,r4,#1
    mov r7,r4
41:
    ldr r10,[r5,r9,lsl #2 ]
    cmp r10,r1
    subne r9,#1
    bne 41b
    sub r9,r4,r9
42:
    ldr  r10,[r5,r9,lsl #2 ]
    mul r10,r1,r10
    str r10,[r5,r7,lsl #2]       @ and store in the table
    tst r10,#1                   @ divsor odd ?
    addne r11,#1
    add r12,r10
    add r7,r7,#1                 @ and increment counter
    add r9,r9,#1
    cmp r9,r4
    blt 42b
    mov r4,r7
    b 7f                         @ and loop

    /* not divisor -> increment next divisor */
5:
    cmp r1,#2                    @ if divisor = 2 -> add 1
    addeq r1,#1
    addne r1,#2                  @ else add 2
    b 2b

    /* divisor -> test if new dividende is prime */
7:
    mov r3,r1                    @ save divisor
    cmp r8,#1                    @ dividende = 1 ? -> end
    beq 10f
    mov r0,r8                    @ new dividende is prime ?
    mov r1,#0
    bl isPrime                   @ the new dividende is prime ?
    cmp r0,#1
    bne 10f                      @ the new dividende is not prime

    cmp r8,r6                    @ else dividende is same divisor ?
    beq 9f                       @ yes
    mov r7,r4                    @ number factors in table
    mov r9,#0                    @ indice
71:
    ldr r10,[r5,r9,lsl #2 ]      @ load one factor
    mul r10,r8,r10               @ multiply
    str r10,[r5,r7,lsl #2]       @ and store in the table
    tst r10,#1                   @ divsor odd ?
    addne r11,#1
    add r12,r10
    add r7,r7,#1                 @ and increment counter
    add r9,r9,#1
    cmp r9,r4
    blt 71b
    mov r4,r7
    mov r7,#0
    b 11f
9:
    sub r9,r4,#1
    mov r7,r4
91:
    ldr r10,[r5,r9,lsl #2 ]
    cmp r10,r8
    subne r9,#1
    bne 91b
    sub r9,r4,r9
92:
    ldr  r10,[r5,r9,lsl #2 ]
    mul r10,r8,r10
    str r10,[r5,r7,lsl #2]       @ and store in the table
    tst r10,#1                   @ divisor odd ?
    addne r11,#1
    add r12,r10
    add r7,r7,#1                 @ and increment counter
    add r9,r9,#1
    cmp r9,r4
    blt 92b
    mov r4,r7
    b 11f

10:
    mov r1,r3                    @ current divisor = new divisor
    cmp r1,r8                    @ current divisor  > new dividende ?
    ble 2b                       @ no -> loop

    /* end decomposition */
11:
    mov r0,r4                    @ return number of table items
    mov r2,r12                   @ return sum
    mov r1,r11                   @ return number of odd divisor
    mov r3,#0
    str r3,[r5,r4,lsl #2]        @ store zéro in last table item
    b 100f

98:
    //ldr r0,iAdrszMessNbPrem
    //bl   affichageMess
    mov r0,#1                   @ return code
    b 100f
99:
    ldr r0,iAdrszMessError
    bl   affichageMess
    mov r0,#-1                  @ error code
    b 100f
100:
    pop {r3-r8,lr}              @ restaur registers
    bx lr
iAdrszMessNbPrem:           .int szMessNbPrem
/***************************************************/
/*   check if a number is prime              */
/***************************************************/
/* r0 contains the number            */
/* r0 return 1 if prime  0 else */
@2147483647
@4294967297
@131071
isPrime:
    push {r1-r6,lr}    @ save registers
    cmp r0,#0
    beq 90f
    cmp r0,#17
    bhi 1f
    cmp r0,#3
    bls 80f            @ for 1,2,3 return prime
    cmp r0,#5
    beq 80f            @ for 5 return prime
    cmp r0,#7
    beq 80f            @ for 7 return prime
    cmp r0,#11
    beq 80f            @ for 11 return prime
    cmp r0,#13
    beq 80f            @ for 13 return prime
    cmp r0,#17
    beq 80f            @ for 17 return prime
1:
    tst r0,#1          @ even ?
    beq 90f            @ yes -> not prime
    mov r2,r0          @ save number
    sub r1,r0,#1       @ exposant n - 1
    mov r0,#3          @ base
    bl moduloPuR32     @ compute base power n - 1 modulo n
    cmp r0,#1
    bne 90f            @ if <> 1  -> not prime

    mov r0,#5
    bl moduloPuR32
    cmp r0,#1
    bne 90f

    mov r0,#7
    bl moduloPuR32
    cmp r0,#1
    bne 90f

    mov r0,#11
    bl moduloPuR32
    cmp r0,#1
    bne 90f

    mov r0,#13
    bl moduloPuR32
    cmp r0,#1
    bne 90f

    mov r0,#17
    bl moduloPuR32
    cmp r0,#1
    bne 90f
80:
    mov r0,#1        @ is prime
    b 100f
90:
    mov r0,#0        @ no prime
100:                 @ fin standard de la fonction
    pop {r1-r6,lr}   @ restaur des registres
    bx lr            @ retour de la fonction en utilisant lr
/********************************************************/
/*   Calcul modulo de b puissance e modulo m  */
/*    Exemple 4 puissance 13 modulo 497 = 445         */
/*                                             */
/********************************************************/
/* r0  nombre  */
/* r1 exposant */
/* r2 modulo   */
/* r0 return result  */
moduloPuR32:
    push {r1-r7,lr}    @ save registers
    cmp r0,#0          @ verif <> zero
    beq 100f
    cmp r2,#0          @ verif <> zero
    beq 100f           @ TODO: vérifier les cas d erreur
1:
    mov r4,r2          @ save modulo
    mov r5,r1          @ save exposant
    mov r6,r0          @ save base
    mov r3,#1          @ start result

    mov r1,#0          @ division de r0,r1 par r2
    bl division32R
    mov r6,r2          @ base <- remainder
2:
    tst r5,#1          @  exposant even or odd
    beq 3f
    umull r0,r1,r6,r3
    mov r2,r4
    bl division32R
    mov r3,r2          @ result <- remainder
3:
    umull r0,r1,r6,r6
    mov r2,r4
    bl division32R
    mov r6,r2          @ base <- remainder

    lsr r5,#1          @ left shift 1 bit
    cmp r5,#0          @ end ?
    bne 2b
    mov r0,r3
100:                   @ fin standard de la fonction
    pop {r1-r7,lr}     @ restaur des registres
    bx lr              @ retour de la fonction en utilisant lr

/***************************************************/
/*   division number 64 bits in 2 registers by number 32 bits */
/***************************************************/
/* r0 contains lower part dividende   */
/* r1 contains upper part dividende   */
/* r2 contains divisor   */
/* r0 return lower part quotient    */
/* r1 return upper part quotient    */
/* r2 return remainder               */
division32R:
    push {r3-r9,lr}    @ save registers
    mov r6,#0          @ init upper upper part remainder  !!
    mov r7,r1          @ init upper part remainder with upper part dividende
    mov r8,r0          @ init lower part remainder with lower part dividende
    mov r9,#0          @ upper part quotient
    mov r4,#0          @ lower part quotient
    mov r5,#32         @ bits number
1:                     @ begin loop
    lsl r6,#1          @ shift upper upper part remainder
    lsls r7,#1         @ shift upper  part remainder
    orrcs r6,#1
    lsls r8,#1         @ shift lower  part remainder
    orrcs r7,#1
    lsls r4,#1         @ shift lower part quotient
    lsl r9,#1          @ shift upper part quotient
    orrcs r9,#1
                       @ divisor sustract  upper  part remainder
    subs r7,r2
    sbcs  r6,#0        @ and substract carry
    bmi 2f             @ négative ?

                       @ positive or equal
    orr r4,#1          @ 1 -> right bit quotient
    b 3f
2:                     @ negative
    orr r4,#0          @ 0 -> right bit quotient
    adds r7,r2         @ and restaur remainder
    adc  r6,#0
3:
    subs r5,#1         @ decrement bit size
    bgt 1b             @ end ?
    mov r0,r4          @ lower part quotient
    mov r1,r9          @ upper part quotient
    mov r2,r7          @ remainder
100:                   @ function end
    pop {r3-r9,lr}     @ restaur registers
    bx lr

/***************************************************/
/*      ROUTINES INCLUDE                 */
/***************************************************/
.include "../affichage.inc"