      hbm1% = FNloadimage("C:lenna50.jpg")
      hbm2% = FNloadimage("C:lenna100.jpg")

      SYS "CreateCompatibleDC", @memhdc% TO hdc1%
      SYS "CreateCompatibleDC", @memhdc% TO hdc2%

      SYS "SelectObject", hdc1%, hbm1%
      SYS "SelectObject", hdc2%, hbm2%

      diff% = 0
      FOR y% = 0 TO 511
        FOR x% = 0 TO 511
          SYS "GetPixel", hdc1%, x%, y% TO rgb1%
          SYS "GetPixel", hdc2%, x%, y% TO rgb2%
          diff% += ABS((rgb1% AND &FF) - (rgb2% AND &FF))
          diff% += ABS((rgb1% >> 8 AND &FF) - (rgb2% >> 8 AND &FF))
          diff% += ABS((rgb1% >> 16) - (rgb2% >> 16))
        NEXT
      NEXT y%
      PRINT "Image difference = "; 100 * diff% / 512^2 / 3 / 255 " %"

      SYS "DeleteDC", hdc1%
      SYS "DeleteDC", hdc2%
      SYS "DeleteObject", hbm1%
      SYS "DeleteObject", hbm2%
      END

      DEF FNloadimage(file$)
      LOCAL iid{}, hbm%, pic%, ole%, olpp%, text%
      DIM iid{a%,b%,c%,d%}, text% LOCAL 513

      iid.a% = &7BF80980 : REM. 128-bit iid
      iid.b% = &101ABF32
      iid.c% = &AA00BB8B
      iid.d% = &AB0C3000

      SYS "MultiByteToWideChar", 0, 0, file$, -1, text%, 256

      SYS "LoadLibrary", "OLEAUT32.DLL" TO ole%
      SYS "GetProcAddress", ole%, "OleLoadPicturePath" TO olpp%
      IF olpp%=0 THEN = 0

      SYS olpp%, text%, 0, 0, 0, iid{}, ^pic% : REM. OleLoadPicturePath
      IF pic%=0 THEN = 0

      SYS !(!pic%+12), pic%, ^hbm% : REM. IPicture::get_Handle
      SYS "FreeLibrary", ole%
      = hbm%


#include <stdio.h>
#include <stdlib.h>
#include <math.h>
/* #include "imglib.h" */

#define RED_C 0
#define GREEN_C 1
#define BLUE_C 2
#define GET_PIXEL(IMG, X, Y) ((IMG)->buf[ (Y) * (IMG)->width + (X) ])

int main(int argc, char **argv)
{
   image im1, im2;
   double totalDiff = 0.0;
   unsigned int x, y;

   if ( argc < 3 )
   {
      fprintf(stderr, "usage:\n%s FILE1 FILE2\n", argv[0]);
      exit(1);
   }
   im1 = read_image(argv[1]);
   if ( im1 == NULL ) exit(1);
   im2 = read_image(argv[2]);
   if ( im2 == NULL ) { free_img(im1); exit(1); }
   if ( (im1->width != im2->width) || (im1->height != im2->height) )
   {
      fprintf(stderr, "width/height of the images must match!\n");
   } else {
   /* BODY: the "real" part! */
      for(x=0; x < im1->width; x++)
      {
         for(y=0; y < im1->width; y++)
         {
           totalDiff += fabs( GET_PIXEL(im1, x, y)[RED_C] - GET_PIXEL(im2, x, y)[RED_C] ) / 255.0;
           totalDiff += fabs( GET_PIXEL(im1, x, y)[GREEN_C] - GET_PIXEL(im2, x, y)[GREEN_C] ) / 255.0;
           totalDiff += fabs( GET_PIXEL(im1, x, y)[BLUE_C] - GET_PIXEL(im2, x, y)[BLUE_C] ) / 255.0;
         }
      }
      printf("%lf\n", 100.0 * totalDiff / (double)(im1->width * im1->height * 3) );
   /* BODY ends */
   }
   free_img(im1);
   free_img(im2);
}


// version 1.0.6

fun isPerfect(n: Int): Boolean = when {
        n < 2      -> false
        n % 2 == 1 -> false  // there are no known odd perfect numbers
        else       -> {
            var tot = 1
            var q: Int
            for (i in 2 .. Math.sqrt(n.toDouble()).toInt()) {
                if (n % i == 0) {
                    tot += i
                    q = n / i
                    if (q > i) tot += q
                }
            }
            n == tot
        }
    }

fun main(args: Array<String>) {
    // expect a run time of about 6 minutes on a typical laptop
    println("The first five perfect numbers are:")
    for (i in 2 .. 33550336) if (isPerfect(i)) print("$i ")
}


#!/usr/bin/lasso9

define isPerfect(n::integer) => {
  #n < 2 ? return false
  return #n == (
    with i in generateSeries(1, math_floor(math_sqrt(#n)) + 1)
      where #n % #i == 0
      let q = #n / #i
    sum (#q > #i ? (#i == 1 ? 1 | #q + #i) | 0)
  )
}

with x in generateSeries(1, 10000)
  where isPerfect(#x)
select #x


using System;
using System.Drawing;

class Program
{
    static void Main()
    {
        Bitmap img1 = new Bitmap("Lenna50.jpg");
        Bitmap img2 = new Bitmap("Lenna100.jpg");

        if (img1.Size != img2.Size)
        {
            Console.Error.WriteLine("Images are of different sizes");
            return;
        }

        float diff = 0;

        for (int y = 0; y < img1.Height; y++)
        {
            for (int x = 0; x < img1.Width; x++)
            {
                Color pixel1 = img1.GetPixel(x, y);
                Color pixel2 = img2.GetPixel(x, y);

                diff += Math.Abs(pixel1.R - pixel2.R);
                diff += Math.Abs(pixel1.G - pixel2.G);
                diff += Math.Abs(pixel1.B - pixel2.B);
            }
        }

        Console.WriteLine("diff: {0} %", 100 * (diff / 255) / (img1.Width * img1.Height * 3));
    }
}


#include <QImage>
#include <cstdlib>
#include <QColor>
#include <iostream>

int main( int argc , char *argv[ ] ) {
   if ( argc != 3 ) {
      std::cout << "Call this with imagecompare <file of image 1>"
	 << " <file of image 2>\n" ;
      return 1 ;
   }
   QImage firstImage ( argv[ 1 ] ) ;
   QImage secondImage ( argv[ 2 ] ) ;
   double totaldiff = 0.0 ; //holds the number of different pixels
   int h = firstImage.height( ) ;
   int w = firstImage.width( ) ;
   int hsecond = secondImage.height( ) ;
   int wsecond = secondImage.width( ) ;
   if ( w != wsecond || h != hsecond ) {
      std::cerr << "Error, pictures must have identical dimensions!\n" ;
      return 2 ;
   }
   for ( int y = 0 ; y < h ; y++ ) {
      uint *firstLine = ( uint* )firstImage.scanLine( y ) ;
      uint *secondLine = ( uint* )secondImage.scanLine( y ) ;
      for ( int x = 0 ; x < w ; x++ ) {
	 uint pixelFirst = firstLine[ x ] ;
	 int rFirst = qRed( pixelFirst ) ;
	 int gFirst = qGreen( pixelFirst ) ;
	 int bFirst = qBlue( pixelFirst ) ;
	 uint pixelSecond = secondLine[ x ] ;
	 int rSecond = qRed( pixelSecond ) ;
	 int gSecond = qGreen( pixelSecond ) ;
	 int bSecond = qBlue( pixelSecond ) ;
	 totaldiff += std::abs( rFirst - rSecond ) / 255.0 ;
	 totaldiff += std::abs( gFirst - gSecond ) / 255.0 ;
	 totaldiff += std::abs( bFirst -bSecond ) / 255.0 ;
      }
   }
   std::cout << "The difference of the two pictures is " <<
      (totaldiff * 100)  / (w * h * 3)  << " % !\n" ;
   return 0 ;
}


for n =1 to 10000
    if perfect( n) =1 then print n; " is perfect."
next n

end

function perfect( n)
    sum =0
    for i =1 TO n /2
        if n mod i =0 then
            sum =sum +i
        end if
    next i
    if sum =n then
        perfect= 1
    else
        perfect =0
    end if
end function


on isPercect (n)
  sum = 1
  cnt = n/2
  repeat with i = 2 to cnt
    if n mod i = 0 then sum = sum + i
  end repeat
  return sum=n
end


(require 'cl-jpeg)
;;; the JPEG library uses simple-vectors to store data. this is insane!
(defun compare-images (file1 file2)
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (multiple-value-bind (image1 height width) (jpeg:decode-image file1)
    (let ((image2 (jpeg:decode-image file2)))
      (loop for i of-type (unsigned-byte 8) across (the simple-vector image1)
            for j of-type (unsigned-byte 8) across (the simple-vector image2)
            sum (the fixnum (abs (- i j))) into difference of-type fixnum
            finally (return (coerce (/ difference width height #.(* 3 255))
                                    'double-float))))))

  CL-USER> (* 100 (compare-images "Lenna50.jpg" "Lenna100.jpg"))
  1.774856467652165d0


import std.stdio, std.exception, std.range, std.math, bitmap;

void main() {
    Image!RGB i1, i2;
    i1 = i1.loadPPM6("Lenna50.ppm");
    i2 = i2.loadPPM6("Lenna100.ppm");

    enforce(i1.nx == i2.nx && i1.ny == i2.ny, "Different sizes.");

    real dif = 0.0;
    foreach (p, q; zip(i1.image, i2.image))
        dif += abs(p.r - q.r) + abs(p.g - q.g) + abs(p.b - q.b);

    immutable nData = i1.nx * i1.ny * 3;
    writeln("Difference (percentage): ",
            (dif / 255.0 * 100) / nData);
}


to perfect? :n
  output equal? :n  apply "sum  filter [equal? 0  modulo :n ?]  iseq 1 :n/2
end


function isPerfect(x)
    local sum = 0
    for i = 1, x-1 do
	sum = (x % i) == 0 and sum + i or sum
    end
    return sum == x
end


Module PerfectNumbers {
      Function Is_Perfect(n as decimal) {
            s=1 : sN=Sqrt(n)
            last= n=sN*sN
            t=n
            If n mod 2=0 then s+=2+n div 2
            i=3 : sN--
            While i<sN {
            if  n mod i=0 then t=n div i :i=max.data(n div t, i): s+=t+ i
            i++
            }
            =n=s
      }
      Inventory [email protected], [email protected]
      IsPrime=lambda  Known1 (x as decimal) -> {
                  =0=1
                  if exist(Known1, x) then =1=1 : exit
                  if x<=5 OR frac(x) then {if x == 2 OR x == 3 OR x == 5 then Append Known1, x  : =1=1
                  Break}
                  if frac(x/2) else exit
                  if frac(x/3) else exit
                  x1=sqrt(x):d = [email protected]
                  {if frac(x/d ) else exit
                        d += 2: if d>x1 then Append Known1, x : =1=1 : exit
                        if frac(x/d) else exit
                        d += 4: if d<= x1 else Append Known1, x :  =1=1: exit
                   loop}
            }
      \\ Check a perfect and a non perfect number
      p=2 : n=3 : n1=2
      Document Doc$
      IsPerfect( 0, 28)
      IsPerfect( 0, 1544)
      While p<32  { ' max 32
            if isprime(2^[email protected]) then {
                   perf=(2^[email protected])*[email protected]^([email protected])
                   Rem  Print perf
                   \\ decompose pretty fast the Perferct Numbers
                   \\ all have a series of 2 and last a prime equal to perf/2^(p-1)
                   inventory queue factors
                   For i=1 to p-1 {
                         Append factors, [email protected]
                  }
                  Append factors, perf/2^(p-1)
                  \\ end decompose
                  Rem Print factors
                  IsPerfect(factors, Perf)
            }
            p++
      }

      Clipboard Doc$
      \\ exit here. No need for Exit statement
      Sub IsPerfect(factors, n)
            s=false
            if n<10000 or type$(factors)<>"Inventory" then {
                  s=Is_Perfect(n)
            } else {
                  local mm=each(factors, 1, -2), f =true
                  while mm {if eval(mm)<>2 then f=false
                  }
                  if f then if n/[email protected]**(len(mm)-1)= factors(len(factors)-1!) then s=true
            }
            Local a$=format$("{0} is {1}perfect number", n, If$(s->"", "not "))
            Doc$=a$+{
            }
            Print a$
      End Sub
}

PerfectNumbers


def imageDifference(a, b) {
  require(a.width() == b.width())
  require(a.height() == b.height())
  def X := 0..!(a.width())
  def Y := 0..!(a.height())

  var sumByteDiff := 0
  for y in Y {
    for x in X {
      def ca := a[x, y]
      def cb := b[x, y]
      sumByteDiff += (ca.rb() - cb.rb()).abs() \
                   + (ca.gb() - cb.gb()).abs() \
                   + (ca.bb() - cb.bb()).abs()
    }
    println(y)
  }
  return sumByteDiff / (255 * 3 * a.width() * a.height())
}

def imageDifferenceTask() {
  println("Read 1...")
  def a := readPPM(<import:java.io.makeFileInputStream>(<file:Lenna50.ppm>))
  println("Read 2...")
  def b := readPPM(<import:java.io.makeFileInputStream>(<file:Lenna100.ppm>))
  println("Compare...")
  def d := imageDifference(a, b)
  println(`${d * 100}% different.`)
}


//Percentage difference between 2 images. Nigel Galloway April 18th., 2018
let img50 = new System.Drawing.Bitmap("Lenna50.jpg")
let img100 = new System.Drawing.Bitmap("Lenna100.jpg")
let diff=Seq.cast<System.Drawing.Color*System.Drawing.Color>(Array2D.init img50.Width img50.Height (fun n g->(img50.GetPixel(n,g),img100.GetPixel(n,g))))|>Seq.fold(fun i (e,l)->i+abs(int(e.R)-int(l.R))+abs(int(e.B)-int(l.B))+abs(int(e.G)-int(l.G))) 0
printfn "%f" ((float diff)*100.00/(float(img50.Height*img50.Width)*255.0*3.0))


            NORMAL MODE IS INTEGER

          R FUNCTION THAT CHECKS IF NUMBER IS PERFECT
            INTERNAL FUNCTION(N)
            ENTRY TO PERFCT.
            DSUM = 0
            THROUGH SUMMAT, FOR CAND=1, 1, CAND.GE.N
SUMMAT      WHENEVER N/CAND*CAND.E.N, DSUM = DSUM+CAND
            FUNCTION RETURN DSUM.E.N
            END OF FUNCTION

          R PRINT PERFECT NUMBERS UP TO 10,000
            THROUGH SHOW, FOR I=1, 1, I.G.10000
SHOW        WHENEVER PERFCT.(I), PRINT FORMAT FMT,I

            VECTOR VALUES FMT = $I5*$
            PRINT COMMENT $ $
            END OF PROGRAM


isperfect := proc(n) return evalb(NumberTheory:-SumOfDivisors(n) = 2*n); end proc:
isperfect(6);
                              true


PerfectQ[i_Integer] := Total[Divisors[i]] == 2 i


function perf = isPerfect(n)
    total = 0;
    for k = 1:n-1
        if ~mod(n, k)
            total = total+k;
        end
    end
    perf = total == n;
end


: pixel-diff ( pixel1 pixel2 -- n )
  over 255 and over 255 and - abs >r 8 rshift swap 8 rshift
  over 255 and over 255 and - abs >r 8 rshift swap 8 rshift
                            - abs r> + r> + ;
: bdiff ( bmp1 bmp2 -- fdiff )
  2dup bdim rot bdim d<> abort" images not comparable"
  0e               ( F: total diff   )
  dup bdim * >r    ( R: total pixels )
  bdata swap bdata
  [email protected] 0 do
    over @ over @ pixel-diff 0 d>f f+
    cell+ swap cell+
  loop 2drop
  r> 3 * 255 * 0 d>f f/ ;

: .bdiff ( bmp1 bmp2 -- )
  cr bdiff 100e f* f. ." percent different" ;


program ImageDifference

  use RCImageBasic
  use RCImageIO

  implicit none

  integer, parameter :: input1_u = 20, &
                        input2_u = 21

  type(rgbimage) :: lenna1, lenna2
  real           :: totaldiff

  open(input1_u, file="Lenna100.ppm", action="read")
  open(input2_u, file="Lenna50.ppm", action="read")
  call read_ppm(input1_u, lenna1)
  call read_ppm(input2_u, lenna2)
  close(input1_u)
  close(input2_u)

  totaldiff = sum(  (abs(lenna1%red - lenna2%red) + &
                     abs(lenna1%green - lenna2%green) + &
                     abs(lenna1%blue - lenna2%blue)) / 255.0 )

  print *, 100.0 * totaldiff / (lenna1%width * lenna1%height * 3.0)

  call free_img(lenna1)
  call free_img(lenna2)

end program ImageDifference


img1 = new image["file:Lenna50.jpg"]
img2 = new image["file:Lenna100.jpg"]

[w1, h1] = img1.getSize[]
[w2, h2] = img2.getSize[]

sum = 0
for x=0 to w1-1
   for y=0 to h1-1
   {
      [r1,g1,b1] = img1.getPixel[x,y]
      [r2,g2,b2] = img2.getPixel[x,y]
      sum = sum + abs[r1-r2] + abs[g1-g2] + abs[b1-b2]
   }

errors = sum / (w1 * h1 * 3)
println["Error is " + (errors->"percent")]


package main

import (
    "fmt"
    "image/jpeg"
    "os"
    "log"
    "image"
)

func loadJpeg(filename string) (image.Image, error) {
    f, err := os.Open(filename)
    if err != nil {
        return nil, err
    }
    defer f.Close()

    img, err := jpeg.Decode(f)
    if err != nil {
        return nil, err
    }

    return img, nil
}

func diff(a, b uint32) int64 {
    if a > b {
        return int64(a - b)
    }
    return int64(b - a)
}

func main() {
    i50, err := loadJpeg("Lenna50.jpg")
    if err != nil {
        log.Fatal(err)
    }

    i100, err := loadJpeg("Lenna100.jpg")
    if err != nil {
        log.Fatal(err)
    }

    if i50.ColorModel() != i100.ColorModel() {
        log.Fatal("different color models")
    }

    b := i50.Bounds()
    if !b.Eq(i100.Bounds()) {
        log.Fatal("different image sizes")
    }

    var sum int64
    for y := b.Min.Y; y < b.Max.Y; y++ {
        for x := b.Min.X; x < b.Max.X; x++ {
            r1, g1, b1, _ := i50.At(x, y).RGBA()
            r2, g2, b2, _ := i100.At(x, y).RGBA()
            sum += diff(r1, r2)
            sum += diff(g1, g2)
            sum += diff(b1, b2)
        }
    }

    nPixels := (b.Max.X - b.Min.X) * (b.Max.Y - b.Min.Y)
    fmt.Printf("Image difference: %f%%\n",
        float64(sum*100)/(float64(nPixels)*0xffff*3))
}


fn isPerfect n =
(
    local sum = 0
    for i in 1 to (n-1) do
    (
        if mod n i == 0 then
        (
            sum += i
        )
    )
    sum == n
)


For n = 2 To 10000 Step 2
  VerifyIfPerfect()
  If isPerfect = 1 Then
    TextWindow.WriteLine(n)
  EndIf
EndFor

Sub VerifyIfPerfect
  s = 1
  sqrN = Math.SquareRoot(n)
  If Math.Remainder(n, 2) = 0 Then
    s = s + 2 + Math.Floor(n / 2)
  EndIf
  i = 3
  while i <= sqrN - 1
    If Math.Remainder(n, i) = 0 Then
      s = s + i + Math.Floor(n / i)
    EndIf
    i = i + 1
  EndWhile
  If i * i = n Then
    s = s + i
  EndIf
  If n = s Then
    isPerfect = 1
  Else
    isPerfect = 0
  EndIf
EndSub


MODULE PerfectNumbers;

FROM SWholeIO IMPORT
  WriteCard;
FROM STextIO IMPORT
  WriteLn;
FROM RealMath IMPORT
  sqrt;

VAR
  N: CARDINAL;

PROCEDURE IsPerfect(N: CARDINAL): BOOLEAN;
VAR
  S, I: CARDINAL;
  SqrtN: REAL;
BEGIN
  S := 1;
  SqrtN := sqrt(FLOAT(N));
  IF N REM 2 = 0 THEN
    S := S + 2 + N / 2;
  END;
  I := 3;
  WHILE FLOAT(I) <= SqrtN - 1.0 DO
    IF N REM I = 0 THEN
      S := S + I + N / I;
    END;
    I := I + 1;
  END;
  IF I * I = N THEN
    S := S + I;
  END;
  RETURN (N = S);
END IsPerfect;

BEGIN
  FOR N := 2 TO 10000 BY 2 DO
    IF IsPerfect(N) THEN
      WriteCard(N, 5);
      WriteLn;
    END;
  END;
END PerfectNumbers.


import Bitmap
import Bitmap.Netpbm
import Bitmap.RGB

import Control.Monad
import Control.Monad.ST
import System.Environment (getArgs)

main = do
    [path1, path2] <- getArgs
    image1 <- readNetpbm path1
    image2 <- readNetpbm path2
    diff <- stToIO $ imageDiff image1 image2
    putStrLn $ "Difference: " ++ show (100 * diff) ++ "%"

imageDiff :: Image s RGB -> Image s RGB -> ST s Double
imageDiff image1 image2 = do
      i1 <- getPixels image1
      i2 <- getPixels image2
      unless (length i1 == length i2) $
          fail "imageDiff: Images are of different sizes"
      return $
          toEnum (sum $ zipWith minus i1 i2) /
          toEnum (3 * 255 * length i1)
  where (RGB (r1, g1, b1)) `minus` (RGB (r2, g2, b2)) =
            abs (r1 - r2) + abs (g1 - g2) + abs (b1 - b2)


link printf   # for main only

procedure main()    # % difference between images
   fn1 := "Lenna100.jpg"
   fn2 := "Lenna50.jpg"
   printf("%%difference of files %i & %i = %r\n",fn1,fn2,ImageDiff(fn1,fn2))
end

procedure ImageDiff(fn1,fn2)  #: return % difference of two images
   img1 := open(1,"g","canvas=hidden","image="||fn1) | stop("Open failed ",fn1)
   img2 := open(2,"g","canvas=hidden","image="||fn2) | stop("Open failed ",fn2)

   if WAttrib(img1,"width") ~= WAttrib(img2,"width") |
      WAttrib(img1,"height") ~= WAttrib(img2,"height") then
         stop("Images must be the same size")

   pix1    := create Pixel(img1)  # access pixels one at a time
   pix2    := create Pixel(img2)  # ... facilitate interleaved access

   sum := pix := 0
   while pix +:= 1 & p1 := csv2l(@pix1) & p2 := csv2l(@pix2) do
      every sum +:= abs(p1[i := 1 to *p1] - p2[i])
   every close(img1|img2)
   return sum / (pix * 3 * 65535 / 100. )
end

procedure csv2l(p)   #: return a list from a comma separated string
L := []
p ? until pos(0) do {
   put(L,tab(find(",")|0))
   move(1)
   }
return L
end


def perf(n)
	sum = 0
	for i in range(1, n - 1)
		if (n % i) = 0
			sum += i
		end
	end
	return sum = n
end


import math

proc isPerfect(n: int): bool =
  var sum: int = 1
  for d in 2 .. int(n.toFloat.sqrt):
    if n mod d == 0:
      inc sum, d
      let q = n div d
      if q != d: inc sum, q
  result = n == sum

for n in 2..10_000:
  if n.isPerfect:
    echo n


bundle Default {
  class Test {
    function : Main(args : String[]) ~ Nil {
      "Perfect numbers from 1 to 33550337:"->PrintLine();
      for(num := 1 ; num < 33550337; num += 1;) {
        if(IsPerfect(num)) {
          num->PrintLine();
        };
      };
    }

    function : native : IsPerfect(number : Int) ~ Bool {
      sum := 0 ;
      for(i := 1; i < number; i += 1;) {
        if (number % i = 0) {
          sum += i;
        };
      };

      return sum = number;
    }
  }
}


   require 'media/image3'
   'Lenna50.jpg' (+/@,@:|@:- % 2.55 * */@[email protected]])&read_image 'Lenna100.jpg'
1.62559


import java.awt.image.BufferedImage;
import java.io.File;
import java.io.IOException;
import javax.imageio.ImageIO;

public enum ImgDiffPercent {
    ;

    public static void main(String[] args) throws IOException {
        // https://rosettacode.org/mw/images/3/3c/Lenna50.jpg
        // https://rosettacode.org/mw/images/b/b6/Lenna100.jpg
        BufferedImage img1 = ImageIO.read(new File("Lenna50.jpg"));
        BufferedImage img2 = ImageIO.read(new File("Lenna100.jpg"));

        double p = getDifferencePercent(img1, img2);
        System.out.println("diff percent: " + p);
    }

    private static double getDifferencePercent(BufferedImage img1, BufferedImage img2) {
        int width = img1.getWidth();
        int height = img1.getHeight();
        int width2 = img2.getWidth();
        int height2 = img2.getHeight();
        if (width != width2 || height != height2) {
            throw new IllegalArgumentException(String.format("Images must have the same dimensions: (%d,%d) vs. (%d,%d)", width, height, width2, height2));
        }

        long diff = 0;
        for (int y = 0; y < height; y++) {
            for (int x = 0; x < width; x++) {
                diff += pixelDiff(img1.getRGB(x, y), img2.getRGB(x, y));
            }
        }
        long maxDiff = 3L * 255 * width * height;

        return 100.0 * diff / maxDiff;
    }

    private static int pixelDiff(int rgb1, int rgb2) {
        int r1 = (rgb1 >> 16) & 0xff;
        int g1 = (rgb1 >>  8) & 0xff;
        int b1 =  rgb1        & 0xff;
        int r2 = (rgb2 >> 16) & 0xff;
        int g2 = (rgb2 >>  8) & 0xff;
        int b2 =  rgb2        & 0xff;
        return Math.abs(r1 - r2) + Math.abs(g1 - g2) + Math.abs(b1 - b2);
    }
}


let perf n =
  let sum = ref 0 in
    for i = 1 to n-1 do
      if n mod i = 0 then
        sum := !sum + i
    done;
    !sum = n


: isPerfect(n)  | i | 0 n 2 / loop: i [ n i mod ifZero: [ i + ] ] n == ;


-- first perfect number over 10000 is 33550336...let's not be crazy
loop i = 1 to 10000
    if perfectNumber(i) then say i "is a perfect number"
end

::routine perfectNumber
  use strict arg n

  sum = 0

  -- the largest possible factor is n % 2, so no point in
  -- going higher than that
  loop i = 1 to n % 2
      if n // i == 0 then sum += i
  end

  return sum = n


function getImageData(url, callback) {
	var img = document.createElement('img');
	var canvas = document.createElement('canvas');

	img.onload = function () {
		canvas.width = img.width;
		canvas.height = img.height;
		var ctx = canvas.getContext('2d');
		ctx.drawImage(img, 0, 0);
		callback(ctx.getImageData(0, 0, img.width, img.height));
	};

	img.src = url;
}

function compare(firstImage, secondImage, callback) {
	getImageData(firstImage, function (img1) {
		getImageData(secondImage, function (img2) {
			if (img1.width !== img2.width || img1.height != img2.height) {
				callback(NaN);
				return;
			}

			var diff = 0;

			for (var i = 0; i < img1.data.length / 4; i++) {
				diff += Math.abs(img1.data[4 * i + 0] - img2.data[4 * i + 0]) / 255;
				diff += Math.abs(img1.data[4 * i + 1] - img2.data[4 * i + 1]) / 255;
				diff += Math.abs(img1.data[4 * i + 2] - img2.data[4 * i + 2]) / 255;
			}

			callback(100 * diff / (img1.width * img1.height * 3));
		});
	});
}

compare('Lenna50.jpg', 'Lenna100.jpg', function (result) {
	console.log(result);
});


declare
  fun {IsPerfect N}
     fun {IsNFactor I} N mod I == 0 end
     Factors = {Filter {List.number 1 N-1 1} IsNFactor}
  in
     {Sum Factors} == N
  end

  fun {Sum Xs} {FoldL Xs Number.'+' 0} end
in
  {Show {Filter {List.number 1 10000 1} IsPerfect}}
  {Show {IsPerfect 33550336}}


program PerfectNumbers;

 function isPerfect(number: longint): boolean;
 var
  i, sum: longint;

 begin
  sum := 1;
  for i := 2 to round(sqrt(real(number))) do
    if (number mod i = 0) then
     sum := sum + i + (number div i);
  isPerfect := (sum = number);
 end;

var
 candidate: longint;

begin
 writeln('Perfect numbers from 1 to 33550337:');
 for candidate := 2 to 33550337 do
   if isPerfect(candidate) then
    writeln (candidate, ' is a perfect number.');
end.


using Images, FileIO, Printf

absdiff(a::RGB{T}, b::RGB{T}) where T = sum(abs(col(a) - col(b)) for col in (red, green, blue))
function pctdiff(A::Matrix{Color{T}}, B::Matrix{Color{T}}) where T
    size(A) != size(B) && throw(ArgumentError("images must be same-size"))
    s = zero(T)
    for (a, b) in zip(A, B)
        s += absdiff(a, b)
    end
    return 100s / 3prod(size(A))
end

img50  = load("data/lenna50.jpg") |> Matrix{RGB{Float64}};
img100 = load("data/lenna100.jpg") |> Matrix{RGB{Float64}};

d = pctdiff(img50, img100)
@printf("Percentage difference: %.4f%%\n", d)


// version 1.2.10

import java.awt.image.BufferedImage
import java.io.File
import javax.imageio.ImageIO
import kotlin.math.abs

fun getDifferencePercent(img1: BufferedImage, img2: BufferedImage): Double {
    val width = img1.width
    val height = img1.height
    val width2 = img2.width
    val height2 = img2.height
    if (width != width2 || height != height2) {
        val f = "(%d,%d) vs. (%d,%d)".format(width, height, width2, height2)
        throw IllegalArgumentException("Images must have the same dimensions: $f")
    }
    var diff = 0L
    for (y in 0 until height) {
        for (x in 0 until width) {
            diff += pixelDiff(img1.getRGB(x, y), img2.getRGB(x, y))
        }
    }
    val maxDiff = 3L * 255 * width * height
    return 100.0 * diff / maxDiff
}

fun pixelDiff(rgb1: Int, rgb2: Int): Int {
    val r1 = (rgb1 shr 16) and 0xff
    val g1 = (rgb1 shr 8)  and 0xff
    val b1 =  rgb1         and 0xff
    val r2 = (rgb2 shr 16) and 0xff
    val g2 = (rgb2 shr 8)  and 0xff
    val b2 =  rgb2         and 0xff
    return abs(r1 - r2) + abs(g1 - g2) + abs(b1 - b2)
}

fun main(args: Array<String>) {
    val img1 = ImageIO.read(File("Lenna50.jpg"))
    val img2 = ImageIO.read(File("Lenna100.jpg"))

    val p = getDifferencePercent(img1, img2)
    println("The percentage difference is ${"%.6f".format(p)}%")
}


sub perf {
    my $n = shift;
    my $sum = 0;
    foreach my $i (1..$n-1) {
        if ($n % $i == 0) {
            $sum += $i;
        }
    }
    return $sum == $n;
}


function is_perfect(integer n)
    return sum(factors(n,-1))=n
end function

for i=2 to 100000 do
    if is_perfect(i) then ?i end if
end for


function is_perfect($number)
{
    $sum = 0;
    for($i = 1; $i < $number; $i++)
    {
        if($number % $i == 0)
            $sum += $i;
    }
    return $sum == $number;
}

echo "Perfect numbers from 1 to 33550337:" . PHP_EOL;
for($num = 1; $num < 33550337; $num++)
{
    if(is_perfect($num))
        echo $num . PHP_EOL;
}


Bitmap.loadPPM = function(self, filename)
  local fp = io.open( filename, "rb" )
  if fp == nil then return false end
  local head, width, height, depth, tail = fp:read("*line", "*number", "*number", "*number", "*line")
  self.width, self.height = width, height
  self:alloc()
  self:clear( {0,0,0} )
  for y = 1, self.height do
    for x = 1, self.width do
      self.pixels[y][x] = { string.byte(fp:read(1)), string.byte(fp:read(1)), string.byte(fp:read(1)) }
    end
  end
  fp:close()
  return true
end

Bitmap.percentageDifference = function(self, other)
  if self.width ~= other.width or self.height ~= other.height then return end
  local dif, abs, spx, opx = 0, math.abs, self.pixels, other.pixels
  for y = 1, self.height do
    for x = 1, self.width do
      local sp, op = spx[y][x], opx[y][x]
      dif = dif + abs(sp[1]-op[1]) + abs(sp[2]-op[2]) + abs(sp[3]-op[3])
    end
  end
  return dif/255/self.width/self.height/3*100
end

local bm50 = Bitmap(0,0)
bm50:loadPPM("Lenna50.ppm")

local bm100 = Bitmap(0,0)
bm100:loadPPM("Lenna100.ppm")

print("%diff:", bm100:percentageDifference(bm50))


go =>
   println(perfect1=[I : I in 1..10_000, perfect1(I)]),
   nl.

perfect1(N) => sum(divisors(N)) == N.
divisors(N) = [J: J in 1..1+N div 2, N mod J == 0].


(de perfect (N)
   (let C 0
      (for I (/ N 2)
         (and (=0 (% N I)) (inc 'C I)) )
      (= C N) ) )


perfect: procedure (n) returns (bit(1));
   declare n fixed;
   declare sum fixed;
   declare i fixed binary;

   sum = 0;
   do i = 1 to n-1;
      if mod(n, i) = 0 then sum = sum + i;
   end;
   return (sum=n);
end perfect;


100H: /* FIND SOME PERFECT NUMBERS: NUMBERS EQUAL TO THE SUM OF THEIR PROPER */
      /* DIVISORS                                                            */
   /* CP/M SYSTEM CALL AND I/O ROUTINES                                      */
   BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */
      DECLARE FN BYTE, ARG ADDRESS;
      GOTO 5;
   END BDOS;
   PR$CHAR:   PROCEDURE( C ); DECLARE C BYTE;    CALL BDOS( 2, C ); END;
   PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
   PR$NL:     PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH );  END;
   PR$NUMBER: PROCEDURE( N );
      DECLARE N ADDRESS;
      DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE;
      V = N;
      W = LAST( N$STR );
      N$STR( W ) = '$';
      N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
      DO WHILE( ( V := V / 10 ) > 0 );
         N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
      END;
      CALL PR$STRING( .N$STR( W ) );
   END PR$NUMBER;

   /* TASK                                                                   */
   /* RETURNS TRUE IF N IS PERFECT, 0 OTHERWISE                              */
   IS$PERFECT: PROCEDURE( N )BYTE;
      DECLARE N               ADDRESS;
      DECLARE ( F1, F2, SUM ) ADDRESS;
      SUM = 1;
      F1  = 2;
      F2  = N;
      DO WHILE( F1 * F1 <= N );
         IF N MOD F1 = 0 THEN DO;
            SUM = SUM + F1;
            F2  =  N  / F1;
            /* AVOID COUNTING E.G., 2 TWICE AS A FACTOR OF 4                 */
            IF F2 > F1 THEN SUM = SUM + F2;
         END;
         F1 = F1 + 1;
      END;
      RETURN SUM = N;
   END IS$PERFECT ;
   /* TEST IS$PERFECT                                                        */
   DECLARE N ADDRESS;
   DO N = 2 TO 10$000;
      IF IS$PERFECT( N ) THEN DO;
         CALL PR$CHAR( ' ' );
         CALL PR$NUMBER( N );
      END;
   END;
EOF


now =time$( "seconds")
nomainwin

WindowWidth  = 1620
WindowHeight =  660

open "jpeg.dll" for dll as #j   '   "JPEG.DLL copyright Alyce Watson, 2003. "

open "RC Image Comparison- difference shown as 20 times abs( pixel_difference." for graphics_nf_nsb as #1
    #1 "trapclose [quit]"
    #1 "down ; fill black"

    hW =hwnd( #1)
    calldll #user32,"GetDC", hW as ulong, hdc as ulong

    jname1$   ="Lenna50.jpg"
    hPic1     =LoadImageFile( hW, jname1$)
    if hPic1 =0 then notice "Function failed.": wait
    loadbmp "demo1", hPic1
    hDemo1 =hbmp( "demo1")
    #1 "drawbmp demo1 10 10 ; flush"

    jname2$ ="Lenna100.jpg"
    hPic2     =LoadImageFile( hW, jname2$)
    if hPic2 =0 then notice "Function failed.": wait
    loadbmp "demo2", hPic2
    hDemo1    =hbmp( "demo2")
    #1 "drawbmp demo2 550 10 ; flush"

    c1 =16777216
    c2 =   65536
    c3 =     256
    x1 =10
    y1 =10
    x2 =550
    y2 =10

    for y =0 to 511
        for x =0 to 511
            pixel1  =( GetPixel( hdc,  x1 +x, y1 +y) + c1) mod c1
            b1      = int(  pixel1  /c2)
            g1      = int(( pixel1 -b1 *c2) /c3)
            r1      = int(  pixel1 -b1 *c2 -g1 *c3)

            pixel2  =( GetPixel( hdc, x2 +x, y2 +y) + c1) mod c1
            b2      = int(  pixel2  /c2)
            g2      = int(( pixel2 -b2 *c2) /c3)
            r2      = int(  pixel2 -b2 *c2 -g2 *c3)

            totalDiff =totalDiff +abs( r1 -r2) +abs( g1 -g2)+ abs( b1 -b2)

            #1 "color "; 20 *abs( r2 -r1); " "; 20 *abs( g2 -g1); " "; 20 *abs( b2 -b1)
            #1 "set "; 1090 +x; " "; 10 +y
            scan
        next x
    next y

   #1 "place 90 575 ; color white ; backcolor black"
   #1 "font courier 9 bold"
   #1 "\"; " Difference between images          =";  using( "#.#####", 100.0 *totalDiff / 512 /512 /3 /255); "%."
   #1 "\"; " Rosetta Code for these two images  =1.62125%."; "   Time taken ="; time$( "seconds") -now; " seconds."
   #1 "flush"

wait

function LoadImageFile( hWnd, file$)
    calldll #j,     "LoadImageFile",   hWnd as ulong, file$ as ptr, LoadImageFile as ulong
end function

function GetPixel( hDC, x, y)
    calldll #gdi32, "GetPixel",        hDC As uLong,  x As long,    y As long,     GetPixel As long
end function

[quit]
    if hPic1  <>0 then calldll #gdi32, "DeleteObject", hPic1 as long, re as long
    if hPic2  <>0 then calldll #gdi32, "DeleteObject", hPic2 as long, re as long
    if hDemo1 <>0 then unloadbmp "demo1"
    if hDemo2 <>0 then unloadbmp "demo2"
    close #1
    close #j
    end


Function IsPerfect($n)
{
$sum=0
 for($i=1;$i-lt$n;$i++)
 {
  if($n%$i -eq 0)
  {
  $sum += $i
  }
 }
return $sum -eq $n
}

Returns "True" if the given number is perfect and "False" if it's not.


tt_divisors(X, N, TT) :-
	Q is X / N,
	(   0 is X mod N -> (Q = N -> TT1 is N + TT;
                             TT1 is N + Q + TT);
            TT = TT1),
	(   sqrt(X) > N + 1 -> N1 is N+1, tt_divisors(X, N1, TT1);
	    TT1 = X).

perfect(X) :-
	tt_divisors(X, 2, 1).

perfect_numbers(N, L) :-
	numlist(2, N, LN),
	include(perfect, LN, L).


Procedure is_Perfect_number(n)
  Protected summa, i=1, result=#False
  Repeat
    If Not n%i
      summa+i
    EndIf
    i+1
  Until i>=n
  If summa=n
    result=#True
  EndIf
  ProcedureReturn result
EndProcedure


img50 = [email protected][NotebookDirectory[] <> "Lenna50.jpg"];
img100 = [email protected][NotebookDirectory[] <> "Lenna100.jpg"];
diff = img50 - img100;
Print["Total Difference between both Lenas = ",
 [email protected]@[email protected]/Times @@ [email protected]*100, "%"]


% Percentage difference between images
function p = PercentageDifferenceBetweenImages(im1,im2)

if numel(im1)~=numel(im2),
    error('Error: images have to be the same size');
end

d = abs(single(im1) - single(im2))./255;
p = sum(d(:))./numel(im1)*100;

disp(['Percentage difference between images is: ', num2str(p), '%'])


fn diffImages =
(
	local img1 = selectBitmap caption:"Select Image 1"
	local img2 = selectBitmap caption:"Select Image 2"
	local totalDiff = 0
	for i in 0 to (img1.height-1) do
	(
		local img1Row = getPixels img1 [0, i] img1.width
		local img2Row = getPixels img2 [0, i] img2.width

		for j in 1 to img1.width do
		(
			totalDiff += (abs (img1Row[j].r - img2Row[j].r)) / 255.0
			totalDiff += (abs (img1Row[j].g - img2Row[j].g)) / 255.0
			totalDiff += (abs (img1Row[j].b - img2Row[j].b)) / 255.0
		)
	)
	format "Diff: %\%\n" (totalDiff / ((img1.width * img1.height * 3) as float) * 100)
)


import strformat
import imageman

var img50, img100: Image[ColorRGBU]
try:
  img50 = loadImage[ColorRGBU]("Lenna50.jpg")
  img100 = loadImage[ColorRGBU]("Lenna100.jpg")
except IOError:
  echo getCurrentExceptionMsg()
  quit QuitFailure

let width = img50.width
let height = img50.height
if img100.width != width or img100.height != height:
  quit "Images have different sizes.", QuitFailure

var sum = 0
for x in 0..<height:
  for y in 0..<width:
    let color1 = img50[x, y]
    let color2 = img100[x, y]
    for i in 0..2:
      sum += abs(color1[i].int - color2[i].int)

echo &"Image difference: {sum * 100 / (width * height * 3 * 255):.4f} %"


def perf1(n):
    sum = 0
    for i in range(1, n):
        if n % i == 0:
            sum += i
    return sum == n


  [ 0 swap witheach + ]          is sum     ( [ --> n )

  [ factors -1 pluck dip sum = ] is perfect ( n --> n )

  say "Perfect numbers less than 10000:" cr
  10000 times
    [ i^ 1+ perfect if [ i^ 1+ echo cr ] ]


is.perf <- function(n){
	if (n==0|n==1) return(FALSE)
	s <- seq (1,n-1)
	x <- n %% s
	m <- data.frame(s,x)
	out <- with(m, s[x==0])
	return(sum(out)==n)
}
# Usage - Warning High Memory Usage
is.perf(28)
sapply(c(6,28,496,8128,33550336),is.perf)


#lang racket
(require math)

(define (perfect? n)
  (=
   (* n 2)
   (sum (divisors n))))

; filtering to only even numbers for better performance
(filter perfect? (filter even? (range 1e5)))
;-> '(0 6 28 496 8128)


sub is-perf($n) { $n == [+] grep $n %% *, 1 .. $n div 2 }

# used as
put ((1..Inf).hyper.grep: {.&is-perf})[^4];


#! /usr/bin/env ocaml
#directory "+glMLite/"
#load "jpeg_loader.cma"
#load "bigarray.cma"
open Jpeg_loader

let () =
  let img1, width1, height1, col_comp1, color_space1 = load_img (Filename Sys.argv.(1))
  and img2, width2, height2, col_comp2, color_space2 = load_img (Filename Sys.argv.(2)) in

  assert(width1 = width2);
  assert(height1 = height2);
  assert(col_comp1 = col_comp2);  (* number of color components *)
  assert(color_space1 = color_space2);

  let img1 = Bigarray.array3_of_genarray img1
  and img2 = Bigarray.array3_of_genarray img2 in

  let sum = ref 0.0
  and num = ref 0 in

  for x=0 to pred width1 do
    for y=0 to pred height1 do
      for c=0 to pred col_comp1 do
        let v1 = float img1.{x,y,c}
        and v2 = float img2.{x,y,c} in
        let diff = (abs_float (v1 -. v2)) /. 255. in
        sum := diff +. !sum;
        incr num;
      done;
    done;
  done;

  let diff_percent = !sum /. float !num in
  Printf.printf " diff: %f percent\n" diff_percent;
;;


use Image::Imlib2;

my $img1 = Image::Imlib2->load('Lenna50.jpg')  || die;
my $img2 = Image::Imlib2->load('Lenna100.jpg') || die;

my $w = $img1->width;
my $h = $img1->height;

my $sum = 0;

for my $x (0..$w-1) {
    for my $y (0..$h-1) {
        my ($r1, $g1, $b1) = $img1->query_pixel($x, $y);
        my ($r2, $g2, $b2) = $img2->query_pixel($x, $y);
        $sum += abs($r1-$r2) + abs($g1-$g2) + abs($b1-$b2);
    }
}

printf "%% difference = %.4f\n", 100 * $sum / ($w * $h * 3 * 255);


perfect?:  func [n [integer!] /local sum] [
    sum: 0
    repeat i (n - 1) [
        if zero? remainder n i [
            sum: sum + i
        ]
    ]
    sum = n
]


/*REXX version of the  ooRexx  program (the code was modified to run with Classic REXX).*/
      do i=1  to 10000                                 /*statement changed:  LOOP ──► DO*/
      if perfectNumber(i)  then say  i   "is a perfect number"
      end
exit

perfectNumber: procedure; parse arg n                  /*statements changed: ROUTINE,USE*/
sum=0
             do i=1  to n%2                            /*statement changed:  LOOP ──► DO*/
             if n//i==0 then sum=sum+i                 /*statement changed:  sum += i   */
             end
return sum=n


for i = 1 to 10000
    if perfect(i) see i + nl ok
next

func perfect n
     sum = 0
     for i = 1 to n - 1
         if n % i = 0 sum = sum + i ok
     next
if sum = n return 1 else return 0 ok
return sum


def perf(n)
  sum = 0
  for i in 1...n
    sum += i  if n % i == 0
  end
  sum == n
end


-- demo\rosetta\Percentage_difference_between_images.exw
without js -- (file i/o)
include ppm.e

function split_colour(integer c)
    return sq_div(sq_and_bits(c, {#FF0000,#FF00,#FF}),
                                 {#010000,#0100,#01})
end function

function percentage_diff(sequence img1, img2)
    if length(img1)!=length(img2)
    or length(img1[1])!=length(img2[1]) then
        return "sizes do not match"
    end if
    atom diff = 0
    for i=1 to length(img1) do
        for j=1 to length(img1[i]) do
            integer {r1,g1,b1} = split_colour(img1[i,j]),
                    {r2,g2,b2} = split_colour(img2[i,j])
            diff += abs(r1-r2)+abs(g1-g2)+abs(b1-b2)
        end for
    end for
    return 100*diff/(length(img1)*length(img1[1]))/3/255
end function

sequence img1 = read_ppm("Lenna50.ppm"),
         img2 = read_ppm("Lenna100.ppm")
?percentage_diff(img1,img2)

{} = wait_key()


(call "convert" "Lenna50.jpg" (tmp "Lenna50.ppm"))
(call "convert" "Lenna100.jpg" (tmp "Lenna100.ppm"))

(let (Total 0  Diff 0)
   (in (tmp "Lenna50.ppm")
      (in (tmp "Lenna100.ppm")
         (while (rd 1)
            (inc 'Diff
               (*/
                  (abs (- @ (in -1 (rd 1))))
                  1000000
                  255 ) )
            (inc 'Total) ) ) )
   (prinl "Difference is " (format (*/ Diff Total) 4) " percent") )


for i = 1 to 10000
 if perf(i) then print i;" ";
next i

FUNCTION perf(n)
for i = 1 TO n - 1
  IF n MOD i = 0 THEN sum = sum + i
next i
IF sum = n THEN perf = 1
END FUNCTION


fn main ( ) {
	fn factor_sum(n: i32) -> i32 {
	    let mut v = Vec::new(); //create new empty array
	    for  x in 1..n-1 {      //test vaules 1 to n-1
	    	if n%x == 0 {   //if current x is a factor of n
	    		v.push(x);      //add x to the array
	    	}
	    }
    let mut sum = v.iter().sum(); //iterate over array and sum it up
    return sum;
    }

    fn perfect_nums(n: i32) {
    	for x in 2..n {       //test numbers from 1-n
    		if factor_sum(x) == x {//call factor_sum on each value of x, if return value is = x
    			println!("{} is a perfect number.", x); //print value of x
    		}
    	}
    }
    perfect_nums(10000);
}


|| The function which takes a number and returns a list of its factors (including one but excluding itself)
|| can be written
factors n = { a <- 1.. n/2; n rem a = 0 }
|| If we define a perfect number as one which is equal to the sum of its factors (for example 6 = 3 + 2 + 1 is perfect)
|| we can write the list of all perfect numbers as
perfects = { n <- 1... ; n = sum(factors n) }


$lines

rem - return p mod q
function mod(p, q = integer) = integer
end = p - q * (p/q)

rem - return true if n is perfect, otherwise false
function isperfect(n = integer) = integer
  var sum, f1, f2 = integer
  sum = 1
  f1 = 2
  while (f1 * f1) <= n do
    begin
      if mod(n, f1) = 0 then
        begin
          sum = sum + f1
          f2 = n / f1
          if f2 > f1 then sum = sum + f2
        end
      f1 = f1 + 1
    end
end = (sum = n)

rem - exercise the function

var k, found = integer

print "Searching up to"; search_limit; " for perfect numbers ..."
found = 0
for k = 2 to search_limit
  if isperfect(k) then
     begin
        print k
        found = found + 1
     end
next k
print found; " were found"

end


def perfectInt(input: Int) = ((2 to sqrt(input).toInt).collect {case x if input % x == 0 => x + input / x}).sum == input - 1


#URL1="http://rosettacode.org/mw/images/3/3c/Lenna50.jpg"
#URL2="http://rosettacode.org/mw/images/b/b6/Lenna100.jpg"

Procedure.s GetTempFileName(basename$="",Extension$=".tmp")
  Protected file$, i
  Repeat: file$=GetTemporaryDirectory()+basename$+"_"+Str(i)+Extension$: i+1
  Until FileSize(file$) = -1 ; E.g. File not found
  ProcedureReturn file$
EndProcedure

Procedure ImageToMatrix(Image,Array P(2))
  Protected Width=ImageWidth(0)-1, Height=ImageHeight(0)-1, x, y
  ; Scaling down Width & Height by -1 to compensate for using 0-based arrays
  Dim P(Width,Height)
  StartDrawing(ImageOutput(Image))
  For x=0 To Width
    For y=0 To Height
      P(x,y)=Point(x,y)
    Next y
  Next x
  StopDrawing()
EndProcedure

Define File1$, File2$, totalDiff, x, y, w, h

; Load the pictures from RoettaCode
InitNetwork()
File1$=GetTempFileName("",".jpg"): ReceiveHTTPFile(#URL1,File1$)
File2$=GetTempFileName("",".jpg"): ReceiveHTTPFile(#URL2,File2$)

; Decode the images & clean up temporary files
UseJPEGImageDecoder()
LoadImage(0,File1$):LoadImage(1,File2$)
DeleteFile(File1$): DeleteFile(File2$)

; Make two 2D arrays to hold the data
Dim Pic1(0,0): Dim Pic2(0,0)

;Load the image data into the matrixes
ImageToMatrix(0,Pic1()): ImageToMatrix(1,Pic2())

; Compare the data
w=ArraySize(pic1()): h=ArraySize(pic1(),2)
For x=0 To w
  For y=0 To h
    totalDiff+ Abs(  Red(Pic1(x,y)) -   Red(Pic2(x,y)))
    totalDiff+ Abs(Green(Pic1(x,y)) - Green(Pic2(x,y)))
    totalDiff+ Abs( Blue(Pic1(x,y)) -  Blue(Pic2(x,y)))
  Next y
Next x

MessageRequester("Result","Diff= "+StrD(100*totalDiff/(255*w*h*3),3)+" %")


(define (perf n)
  (let loop ((i 1)
             (sum 0))
    (cond ((= i n)
           (= sum n))
          ((= 0 (modulo n i))
           (loop (+ i 1) (+ sum i)))
          (else
           (loop (+ i 1) sum)))))


$ include "seed7_05.s7i";

const func boolean: isPerfect (in integer: n) is func
  result
    var boolean: isPerfect is FALSE;
  local
    var integer: i is 0;
    var integer: sum is 1;
    var integer: q is 0;
  begin
    for i range 2 to sqrt(n) do
      if n rem i = 0 then
        sum +:= i;
        q := n div i;
        if q > i then
          sum +:= q;
        end if;
      end if;
    end for;
    isPerfect := sum = n;
  end func;

const proc: main is func
  local
    var integer: n is 0;
  begin
    for n range 2 to 33550336 do
      if isPerfect(n) then
        writeln(n);
      end if;
    end for;
  end func;


func is_perfect(n) {
    n.sigma == 2*n
}

for n in (1..10000) {
    say n if is_perfect(n)
}


from PIL import Image

i1 = Image.open("image1.jpg")
i2 = Image.open("image2.jpg")
assert i1.mode == i2.mode, "Different kinds of images."
assert i1.size == i2.size, "Different sizes."

pairs = zip(i1.getdata(), i2.getdata())
if len(i1.getbands()) == 1:
    # for gray-scale jpegs
    dif = sum(abs(p1-p2) for p1,p2 in pairs)
else:
    dif = sum(abs(c1-c2) for p1,p2 in pairs for c1,c2 in zip(p1,p2))

ncomponents = i1.size[0] * i1.size[1] * 3
print ("Difference (percentage):", (dif / 255.0 * 100) / ncomponents)


#lang racket
(require racket/draw)

(define (percentage-difference bitmap1 bitmap2)
  (define width (send bitmap1 get-width))
  (define height (send bitmap1 get-height))
  (define buffer1 (make-bytes (* width height 4)))
  (define buffer2 (make-bytes (* width height 4)))
  (send (send bitmap1 make-dc) get-argb-pixels 0 0 width height buffer1)
  (send (send bitmap2 make-dc) get-argb-pixels 0 0 width height buffer2)
  (/ (* 100.0
        (for/fold ((difference 0))
          ((i (in-naturals)) (x1 (in-bytes buffer1)) (x2 (in-bytes buffer2)))
          (if (zero? (remainder i 4))
              difference
              (+ difference (abs (- x1 x2))))))
     width height 3 256))

(define lenna50 (read-bitmap "lenna50.jpg"))
(define lenna100 (read-bitmap "lenna100.jpg"))

(percentage-difference lenna50 lenna100) ;-> 1.7749329408009846


use GD::Raw;

my $fh1 = fopen('./Lenna50.jpg', "rb") or die;
my $img1 = gdImageCreateFromJpeg($fh1);
my $fh2 = fopen('./Lenna100.jpg', "rb") or die;
my $img2 = gdImageCreateFromJpeg($fh2);

my $img1X = gdImageSX($img1);
my $img1Y = gdImageSY($img1);
my $img2X = gdImageSX($img2);
my $img2Y = gdImageSY($img2);

($img1X == $img2X and $img1Y == $img2Y) or die "Image dimensions must match.";

my $diff = 0;
my ($px1, $px2);
loop (my $i = 0; $i < $img1X; $i++) {
   loop (my $j = 0; $j < $img1Y; $j++) {

      $px1 = gdImageGetPixel($img1, $i, $j);
      $px2 = gdImageGetPixel($img2, $i, $j);

      $diff += abs(gdImageRed($img1, $px1) - gdImageRed($img2, $px2));
      $diff += abs(gdImageGreen($img1, $px1) - gdImageGreen($img2, $px2));
      $diff += abs(gdImageBlue($img1, $px1) - gdImageBlue($img2, $px2));
   }
}

say "%difference = ", $diff/($img1X*$img1Y*3*255)*100;

gdImageDestroy($img1);
gdImageDestroy($img2);


BOOLEAN PROCEDURE PERF(N); INTEGER N;
BEGIN
    INTEGER SUM;
    FOR I := 1 STEP 1 UNTIL N-1 DO
        IF MOD(N, I) = 0 THEN
            SUM := SUM + I;
    PERF := SUM = N;
END PERF;


[email protected](Integer traits) isPerfect
[
  (((2 to: n // 2 + 1) select: [| :m | (n rem: m) isZero])
    inject: 1 into: #+ `er) = n
].


Integer extend [

  "Translation of the C version; this is faster..."
  isPerfectC [ |tot| tot := 1.
     (2 to: (self sqrt) + 1) do: [ :i |
        (self rem: i) = 0
        ifTrue: [ |q|
                  tot := tot + i.
                  q := self // i.
                  q > i ifTrue: [ tot := tot + q ]
        ]
     ].
     ^ tot = self
  ]

  "... but this seems more idiomatic"
  isPerfect [
     ^ ( ( ( 2 to: self // 2 + 1) select: [ :a | (self rem: a) = 0 ] )
         inject: 1 into: [ :a :b | a + b ] ) = self
  ]
].


rebol [
	Title: "Percent Image Difference"
	URL: http://rosettacode.org/wiki/Percentage_of_difference_between_2_images
]

; Load from local storage. Un/comment as preferred.
; a: load-image %lenna50.jpg
; b: load-image %lenna100.jpg

; Download from rosettacode.org.
a: load-image http://rosettacode.org/mw/images/3/3c/Lenna50.jpg
b: load-image http://rosettacode.org/mw/images/b/b6/Lenna100.jpg

if a/size <> b/size [print "Image dimensions must match."  halt]

; Compute difference. REBOL has built-in image processing as part of
; its GUI package that I can take advantage of here:

diff: to-image layout/tight [image a effect [difference b]]

; Calculate deviation. I use 'repeat' to rip through the image pixels
; (it knows how to deal with images) and sum, then average. Note that
; I can treat the image like an array to get number of pixels.

t: 0
repeat p diff [t: t + p/1 + p/2 + p/3]
print rejoin ["Difference: "  100 * t / (255 * 3 * length? diff)  "%"]

; Optional: Since I now have a difference image, I may as well show
; it. Use the buttons or keys 'a', 'b' and 'd' to switch between the
; various images.

flip: func [
	"Change to new image and label."
	name [word!] "Image to switch to."
][x/text: rejoin ["Image " name]  x/image: get name  show x]

; Because the differences between the images are very small, I enhance
; the diff with a high contrast to make the result easier to
; see. Comment this out for the "pure" image.

diff: to-image layout/tight [image diff effect [contrast 100]]

view l: layout [
	x: image diff
	across
	button "a" #"a"          [flip 'a]
	button "b" #"b"          [flip 'b]
	button "difference" #"d" [flip 'diff]
]


require 'raster_graphics'

class RGBColour
  # the difference between two colours
  def -(a_colour)
    (@red - a_colour.red).abs +
    (@green - a_colour.green).abs +
    (@blue - a_colour.blue).abs
  end
end

class Pixmap
  # the difference between two images
  def -(a_pixmap)
    if @width != a_pixmap.width or @height != a_pixmap.height
      raise ArgumentError, "can't compare images with different sizes"
    end
    sum = 0
    each_pixel {|x,y| sum += self[x,y] - a_pixmap[x,y]}
    Float(sum) / (@width * @height * 255 * 3)
  end
end

lenna50 = Pixmap.open_from_jpeg('Lenna50.jpg')
lenna100 = Pixmap.open_from_jpeg('Lenna100.jpg')

puts "difference: %.5f%%" % (100.0 * (lenna50 - lenna100))


func perfect(n:Int) -> Bool {
    var sum = 0
    for i in 1..<n {
        if n % i == 0 {
            sum += i
        }
    }
    return sum == n
}

for i in 1..<10000 {
    if perfect(i) {
        println(i)
    }
}


proc perfect n {
    set sum 0
    for {set i 1} {$i <= $n} {incr i} {
        if {$n % $i == 0} {incr sum $i}
    }
    expr {$sum == 2*$n}
}


#import std
#import nat

is_perfect = ~&itB&& ^(~&,~&t+ iota); ^E/~&l sum:-0+ ~| not remainder


Private Function Factors(x As Long) As String
    Application.Volatile
    Dim i As Long
    Dim cooresponding_factors As String
    Factors = 1
    corresponding_factors = x
    For i = 2 To Sqr(x)
        If x Mod i = 0 Then
            Factors = Factors & ", " & i
            If i <> x / i Then corresponding_factors = x / i & ", " & corresponding_factors
        End If
    Next i
    If x <> 1 Then Factors = Factors & ", " & corresponding_factors
End Function
Private Function is_perfect(n As Long)
    fs = Split(Factors(n), ", ")
    Dim f() As Long
    ReDim f(UBound(fs))
    For i = 0 To UBound(fs)
        f(i) = Val(fs(i))
    Next i
    is_perfect = WorksheetFunction.Sum(f) - n = n
End Function
Public Sub main()
    Dim i As Long
    For i = 2 To 100000
        If is_perfect(i) Then Debug.Print i
    Next i
End Sub


extern crate image;

use image::{GenericImageView, Rgba};

fn diff_rgba3(rgba1 : Rgba<u8>, rgba2 : Rgba<u8>) -> i32 {
    (rgba1[0] as i32 - rgba2[0] as i32).abs()
    + (rgba1[1] as i32 - rgba2[1] as i32).abs()
    + (rgba1[2] as i32 - rgba2[2] as i32).abs()
}

fn main() {
    let img1 = image::open("Lenna100.jpg").unwrap();
    let img2 = image::open("Lenna50.jpg").unwrap();
    let mut accum = 0;
    let zipper = img1.pixels().zip(img2.pixels());
    for (pixel1, pixel2) in zipper {
        accum += diff_rgba3(pixel1.2, pixel2.2);
    }
    println!("Percent difference {}", accum as f64 * 100.0/ (255.0 * 3.0 * (img1.width() * img1.height()) as f64));
}


require('Imager')

func img_diff(a, b) {

    func from_file(name) {
         %s|Imager|.new(file => name)
    }

    func size(img) {
        (img.getwidth, img.getheight)
    }

    func pixel_diff(p1, p2) {
        [p1.rgba] »-« [p2.rgba] -> map { .abs }.sum
    }

    func read_pixel(img, x, y) {
        img.getpixel(x => x, y => y)
    }

    var(img1, img2) = (from_file(a), from_file(b))

    var(w1, h1) = size(img1)
    var(w2, h2) = size(img2)

    if ((w1 != w2) || (h1 != h2)) {
        return nil
    }

    var sum = 0
    for y,x in (^h1 ~X ^w1) {
        sum += pixel_diff(read_pixel(img1, x, y), read_pixel(img2, x, y))
    }

    sum / (w1 * h1 * 255 * 3)
}

say 100*img_diff('Lenna50.jpg', 'Lenna100.jpg')


func pixelValues(fromCGImage imageRef: CGImage?) -> [UInt8]?
{
    var width = 0
    var height = 0
    var pixelValues: [UInt8]?

    if let imageRef = imageRef {
        width = imageRef.width
        height = imageRef.height
        let bitsPerComponent = imageRef.bitsPerComponent
        let bytesPerRow = imageRef.bytesPerRow
        let totalBytes = height * bytesPerRow
        let bitmapInfo = imageRef.bitmapInfo

        let colorSpace = CGColorSpaceCreateDeviceRGB()
        var intensities = [UInt8](repeating: 0, count: totalBytes)

        let contextRef = CGContext(data: &intensities,
                                  width: width,
                                 height: height,
                       bitsPerComponent: bitsPerComponent,
                            bytesPerRow: bytesPerRow,
                                  space: colorSpace,
                             bitmapInfo: bitmapInfo.rawValue)
        contextRef?.draw(imageRef, in: CGRect(x: 0.0, y: 0.0, width: CGFloat(width), height: CGFloat(height)))

        pixelValues = intensities
    }

    return pixelValues
}

func compareImages(image1: UIImage, image2: UIImage) -> Double? {
    guard let data1 = pixelValues(fromCGImage: image1.cgImage),
        let data2 = pixelValues(fromCGImage: image2.cgImage),
        data1.count == data2.count else {
            return nil
    }

    let width = Double(image1.size.width)
    let height = Double(image1.size.height)

    return zip(data1, data2)
        .enumerated()
        .reduce(0.0) {
            $1.offset % 4 == 3 ? $0 : $0 + abs(Double($1.element.0) - Double($1.element.1))
        }
        * 100 / (width * height * 3.0) / 255.0
}

let image1 = UIImage(named: "Lenna50")
let image2 = UIImage(named: "Lenna100")

compareImages(image1: image1, image2: image2)


Function IsPerfect(n)
	IsPerfect = False
	i = n - 1
	sum = 0
	Do While i > 0
		If n Mod i = 0 Then
			sum = sum + i
		End If
		i = i - 1
	Loop
	If sum = n Then
		IsPerfect = True
	End If
End Function

WScript.StdOut.Write IsPerfect(CInt(WScript.Arguments(0)))
WScript.StdOut.WriteLine


fn compute_perfect(n i64) bool {
    mut sum := i64(0)
    for i := i64(1); i < n; i++ {
        if n%i == 0 {
            sum += i
        }
    }
    return sum == n
}

// following fntion satisfies the task, returning true for all
// perfect numbers representable in the argument type
fn is_perfect(n i64) bool {
    return n in [i64(6), 28, 496, 8128, 33550336, 8589869056,
        137438691328, 2305843008139952128]
}

// validation
fn main() {
    for n := i64(1); ; n++ {
        if is_perfect(n) != compute_perfect(n) {
            panic("bug")
        }
        if n%i64(1e3) == 0 {
            println("tested $n")
        }
    }
}


var isPerfect = Fn.new { |n|
    if (n <= 2) return false
    var tot = 1
    for (i in 2..n.sqrt.floor) {
        if (n%i == 0) {
            tot = tot + i
            var q = (n/i).floor
            if (q > i) tot = tot + q
        }
    }
    return n == tot
}

System.print("The first four perfect numbers are:")
var count = 0
var i = 2
while (count < 4) {
    if (isPerfect.call(i)) {
        System.write("%(i) ")
        count = count + 1
    }
    i = i + 2  // there are no known odd perfect numbers
}
System.print()


package require Tk

proc imageDifference {img1 img2} {
    if {
	[image width $img1] != [image width $img2] ||
	[image height $img1] != [image height $img2]
    } then {
	return -code error "images are different size"
    }
    set diff 0
    for {set x 0} {$x<[image width $img1]} {incr x} {
	for {set y 0} {$y<[image height $img1]} {incr y} {
	    lassign [$img1 get $x $y] r1 g1 b1
	    lassign [$img2 get $x $y] r2 g2 b2
	    incr diff [expr {abs($r1-$r2)+abs($g1-$g2)+abs($b1-$b2)}]
	}
    }
    expr {$diff/double($x*$y*3*255)}
}

# Package only used for JPEG loader
package require Img
image create photo lenna50 -file lenna50.jpg
image create photo lenna100 -file lenna100.jpg
puts "difference is [expr {[imageDifference lenna50 lenna100]*100.}]%"
exit ;# Need explicit exit here; don't want a GUI


Chdir("|(USER_MACRO)\Rosetta\data")
File_Open("Lenna50.bmp", BROWSE)
#10 = Buf_Num				// #10 = buffer for 1st image
File_Open("Lenna100.bmp", BROWSE)
#20 = Buf_Num				// #20 = buffer for 2nd image

Goto_Pos(10)  				// offset to pixel data
Goto_Pos(Cur_Char + Cur_Char(1)*256)
Buf_Switch(#10)
Goto_Pos(10)
Goto_Pos(Cur_Char + Cur_Char(1)*256)

#15 = 0					// #15 = difference
#16 = 0					// #16 = total number of samples
While(!At_EOF) {
    #11 = Cur_Char; Char
    Buf_Switch(#20)
    #21 = Cur_Char; Char
    #15 += abs(#11-#21)
    #16++
    Buf_Switch(#10)
}

#19 = #15 / (#16*256/100000)
M("Sum of diff: ") NT(#15)
M("Total bytes: ") NT(#16)
M("Difference:  ") NT(#19/1000,LEFT+NOCR) M(".") NT(#19%1000,LEFT+NOCR) M("%\n")

Buf_Switch(#10) Buf_Quit(OK)
Buf_Switch(#20) Buf_Quit(OK)


include c:\cxpl\codes;  \intrinsic 'code' declarations

func Perfect(N);        \Return 'true' if N is a perfect number
int  N, S, I, Q;
[S:= 1;
for I:= 2 to sqrt(N) do
        [Q:= N/I;
        if rem(0)=0 then S:= S+I+Q;
        ];
return S=N & N#1;
];

int  A, N;
[for A:= 1 to 16 do
        [N:= (1<<A - 1) * 1<<(A-1);
        if Perfect(N) then [IntOut(0, N);  CrLf(0)];
        ];
]


sub isPerfect(n)
    if (n < 2) or mod(n, 2) = 1 then return false : endif
    // asumimos que los números impares no son perfectos
    sum = 0
    for i = 1 to n-1
        if mod(n,i) = 0 then sum = sum + i : endif
    next i
    if sum = n then return true else return false : endif
end sub

print "Los primeros 5 numeros perfectos son:"
for i = 1 to 33550336
	if isPerfect(i) then print i, " ", : endif
next i
print
end


const std = @import("std");
const expect = std.testing.expect;
const stdout = std.io.getStdOut().outStream();

pub fn main() !void {
    var i: u32 = 2;
    try stdout.print("The first few perfect numbers are: ", .{});
    while (i <= 10_000) : (i += 2) if (propersum(i) == i)
        try stdout.print("{} ", .{i});
    try stdout.print("\n", .{});
}

fn propersum(n: u32) u32 {
    var sum: u32 = 1;
    var d: u32 = 2;
    while (d * d <= n) : (d += 1) if (n % d == 0) {
        sum += d;
        const q = n / d;
        if (q > d)
            sum += q;
    };
    return sum;
}

test "Proper divisors" {
    expect(propersum(28) == 28);
    expect(propersum(71) == 1);
    expect(propersum(30) == 42);
}


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

class PercentageDifference {
    construct new(width, height, image1, image2) {
        Window.title = "Perecentage difference between images"
        Window.resize(width, height)
        Canvas.resize(width, height)
        _img1 = ImageData.loadFromFile(image1)
        _img2 = ImageData.loadFromFile(image2)
        // display images side by side
        _img1.draw(0, 0)
        _img2.draw(550, 0)
        Canvas.print(image1, 200, 525, Color.white)
        Canvas.print(image2, 750, 525, Color.white)
    }

    init() {
        var dpc = (getDifferencePercent(_img1, _img2) * 1e5).round / 1e5
        System.print("Percentage difference between images: %(dpc)\%")
    }

    getDifferencePercent(img1, img2) {
        var width   = img1.width
        var height  = img1.height
        var width2  = img2.width
        var height2 = img2.height
        if (width != width2 || height != height2) {
            var f = "(%(width), %(height)) vs. (%(width2), %(height2))"
            Fiber.abort("Images must have the same dimensions: %(f)")
        }
        var diff = 0
        for (y in 0...height) {
            for (x in 0...width) {
                diff = diff + pixelDiff(img1.pget(x, y), img2.pget(x, y))
            }
        }
        var maxDiff = 3 * 255 * width * height
        return 100 * diff / maxDiff
    }

    pixelDiff(c1, c2) { (c1.r - c2.r).abs + (c1.g - c2.g).abs + (c1.b - c2.b).abs }

    update() {}

    draw(alpha) {}
}

var Game = PercentageDifference.new(1100, 550, "Lenna50.jpg", "Lenna100.jpg")


fcn isPerfectNumber1(n)
   { n == [1..n-1].filter('wrap(i){ n % i == 0 }).sum(); }


fcn imageDiff(img1,img2){
   if(img1.w!=img2.w or img1.h!=img2.h)
      throw(Exception.ValueError("width/height of the images must match!"));
   img1.data.howza(0).walker().zip(img2.data.howza(0)) // lazy bytes, not strings
   .reduce(fcn(totalDiff,[(a,b)]){ totalDiff + (a - b).abs() },0)
   .toFloat()/img1.w/img1.h/3/255; // or: .toFloat()/img1.data.len()/255
}


UInt32 seed = 0
F nonrandom()
   :seed = 1664525 * :seed + 1013904223
   R Int(:seed >> 16) / Float(FF'FF)

T Grid
   [[Int]] cell, hwall, vwall
   F (cell, hwall, vwall)
      .cell = cell
      .hwall = hwall
      .vwall = vwall

V (M, nn, t) = (10, 10, 100)

T PercolatedException
   (Int, Int) t
   F (t)
      .t = t

V HVF = ([‘ .’, ‘ _’], [‘:’, ‘|’], [‘ ’, ‘#’])

F newgrid(p)
   V hwall = (0 .. :nn).map(n -> (0 .< :M).map(m -> Int(nonrandom() < @@p)))
   V vwall = (0 .< :nn).map(n -> (0 .. :M).map(m -> (I m C (0, :M) {1} E Int(nonrandom() < @@p))))
   V cell = (0 .< :nn).map(n -> (0 .< :M).map(m -> 0))
   R Grid(cell, hwall, vwall)

F pgrid(grid, percolated)
   V (cell, hwall, vwall) = grid
   V (h, v, f) = :HVF
   L(n) 0 .< :nn
      print(‘    ’(0 .< :M).map(m -> @h[@hwall[@n][m]]).join(‘’))
      print(‘#.)  ’.format(n % 10)‘’(0 .. :M).map(m -> @v[@vwall[@n][m]]‘’@f[I m < :M {@cell[@n][m]} E 0]).join(‘’)[0 .< (len)-1])
   V n = :nn
   print(‘    ’(0 .< :M).map(m -> @h[@hwall[@n][m]]).join(‘’))
   I percolated != (-1, -1)
      V where = percolated[0]
      print(‘!)  ’(‘  ’ * where)‘ ’f[1])

F flood_fill(m, n, &cell, hwall, vwall) -> N
   cell[n][m] = 1
   I n < :nn - 1 & !hwall[n + 1][m] & !cell[n + 1][m]
      flood_fill(m, n + 1, &cell, hwall, vwall)
   E I n == :nn - 1 & !hwall[n + 1][m]
      X PercolatedException((m, n + 1))
   I m & !vwall[n][m] & !cell[n][m - 1]
      flood_fill(m - 1, n, &cell, hwall, vwall)
   I m < :M - 1 & !vwall[n][m + 1] & !cell[n][m + 1]
      flood_fill(m + 1, n, &cell, hwall, vwall)
   I n != 0 & !hwall[n][m] & !cell[n - 1][m]
      flood_fill(m, n - 1, &cell, hwall, vwall)

F pour_on_top(Grid &grid) -> (Int, Int)?
   V n = 0
   X.try
      L(m) 0 .< :M
         I grid.hwall[n][m] == 0
            flood_fill(m, n, &grid.cell, grid.hwall, grid.vwall)
   X.catch PercolatedException ex
      R ex.t
   R N

V sample_printed = 0B
[Float = Int] pcount
L(p10) 11
   V p = (10 - p10) / 10.0
   pcount[p] = 0
   L(tries) 0 .< t
      V grid = newgrid(p)
      (Int, Int)? percolated = pour_on_top(&grid)
      I percolated != N
         pcount[p]++
         I !sample_printed
            print("\nSample percolating #. x #. grid".format(M, nn))
            pgrid(grid, percolated ? (-1, -1))
            sample_printed = 1B
print("\n p: Fraction of #. tries that percolate through".format(t))

L(p, c) sorted(pcount.items())
   print(‘#.1: #.’.format(p, c / Float(t)))


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

// cell states
#define FILL 1
#define RWALL 2 // right wall
#define BWALL 4 // bottom wall

typedef unsigned int c_t;

c_t *cells, *start, *end;
int m, n;

void make_grid(double p, int x, int y)
{
    int i, j, thresh = RAND_MAX * p;
    m = x, n = y;

    // Allocate two addition rows to avoid checking bounds.
    // Bottom row is also required by drippage
    start = realloc(start, m * (n + 2) * sizeof(c_t));
    cells = start + m;

    for (i = 0; i < m; i++)
        start[i] = BWALL | RWALL;

    for (i = 0, end = cells; i < y; i++) {
        for (j = x; --j; )
            *end++ = (rand() < thresh ? BWALL : 0)
                |(rand() < thresh ? RWALL : 0);
        *end++ = RWALL | (rand() < thresh ? BWALL: 0);
    }
    memset(end, 0, sizeof(c_t) * m);
}

void show_grid(void)
{
    int i, j;

    for (j = 0; j < m; j++) printf("+--");
    puts("+");

    for (i = 0; i <= n; i++) {
        putchar(i == n ? ' ' : '|');
        for (j = 0; j < m; j++) {
            printf((cells[i*m + j] & FILL) ? "[]" : "  ");
            putchar((cells[i*m + j] & RWALL) ? '|' : ' ');
        }
        putchar('\n');

        if (i == n) return;

        for (j = 0; j < m; j++)
            printf((cells[i*m + j] & BWALL) ? "+--" : "+  ");
        puts("+");
    }
}

int fill(c_t *p)
{
    if ((*p & FILL)) return 0;
    *p |= FILL;
    if (p >= end) return 1; // success: reached bottom row

    return  ( !(p[ 0] & BWALL) && fill(p + m) ) ||
        ( !(p[ 0] & RWALL) && fill(p + 1) ) ||
        ( !(p[-1] & RWALL) && fill(p - 1) ) ||
        ( !(p[-m] & BWALL) && fill(p - m) );
}

int percolate(void)
{
    int i;
    for (i = 0; i < m && !fill(cells + i); i++);

    return i < m;
}

int main(void)
{
    make_grid(.5, 10, 10);
    percolate();
    show_grid();

    int cnt, i, p;

    puts("\nrunning 10x10 grids 10000 times for each p:");
    for (p = 1; p < 10; p++) {
        for (cnt = i = 0; i < 10000; i++) {
            make_grid(p / 10., 10, 10);
            cnt += percolate();
            //show_grid(); // don't
        }
        printf("p = %3g: %.4f\n", p / 10., (double)cnt / i);
    }

    free(start);
    return 0;
}


#include <cstdlib>
#include <cstring>
#include <iostream>
#include <string>

using namespace std;

class Grid {
public:
    Grid(const double p, const int x, const int y) : m(x), n(y) {
        const int thresh = static_cast<int>(RAND_MAX * p);

        // Allocate two addition rows to avoid checking bounds.
        // Bottom row is also required by drippage
        start = new cell[m * (n + 2)];
        cells = start + m;
        for (auto i = 0; i < m; i++) start[i] = RBWALL;
        end = cells;
        for (auto i = 0; i < y; i++) {
            for (auto j = x; --j;)
                *end++ = (rand() < thresh ? BWALL : 0) | (rand() < thresh ? RWALL : 0);
            *end++ = RWALL | (rand() < thresh ? BWALL : 0);
        }
        memset(end, 0u, sizeof(cell) * m);
    }

    ~Grid() {
        delete[] start;
        cells = 0;
        start = 0;
        end = 0;
    }

    int percolate() const {
        auto i = 0;
        for (; i < m && !fill(cells + i); i++);
        return i < m;
    }

    void show() const {
        for (auto j = 0; j < m; j++)
            cout << ("+-");
        cout << '+' << endl;

        for (auto i = 0; i <= n; i++) {
            cout << (i == n ? ' ' : '|');
            for (auto j = 0; j < m; j++) {
                cout << ((cells[i * m + j] & FILL) ? "#" : " ");
                cout << ((cells[i * m + j] & RWALL) ? '|' : ' ');
            }
            cout << endl;

            if (i == n) return;

            for (auto j = 0; j < m; j++)
                cout << ((cells[i * m + j] & BWALL) ? "+-" : "+ ");
            cout << '+' << endl;
        }
    }

private:
    enum cell_state {
        FILL   = 1 << 0,
        RWALL  = 1 << 1,       // right wall
        BWALL  = 1 << 2,       // bottom wall
        RBWALL = RWALL | BWALL // right/bottom wall
    };

    typedef unsigned int cell;

    bool fill(cell* p) const {
        if ((*p & FILL)) return false;
        *p |= FILL;
        if (p >= end) return true; // success: reached bottom row

        return (!(p[0] & BWALL) && fill(p + m)) || (!(p[0] & RWALL) && fill(p + 1))
                ||(!(p[-1] & RWALL) && fill(p - 1)) || (!(p[-m] & BWALL) && fill(p - m));
    }

    cell* cells;
    cell* start;
    cell* end;
    const int m;
    const int n;
};

int main() {
    const auto M = 10, N = 10;
    const Grid grid(.5, M, N);
    grid.percolate();
    grid.show();

    const auto C = 10000;
    cout << endl << "running " << M << "x" << N << " grids " << C << " times for each p:" << endl;
    for (auto p = 1; p < M; p++) {
        auto cnt = 0, i = 0;
        for (; i < C; i++)
            cnt += Grid(p / static_cast<double>(M), M, N).percolate();
        cout << "p = " << p / static_cast<double>(M) << ": " << static_cast<double>(cnt) / i << endl;
    }

    return EXIT_SUCCESS;
}


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

struct Grid {
    // Not enforced by runtime and type system:
    // a Cell must contain only the flags bits.
    alias Cell = uint;

    enum : Cell { // Cell states (bit flags).
        empty      = 0,
        filled     = 1,
        rightWall  = 2,
        bottomWall = 4
    }

    const size_t nc, nr;
    Cell[] cells;

    this(in size_t nRows, in size_t nCols) pure nothrow {
        nr = nRows;
        nc = nCols;

        // Allocate two addition rows to avoid checking bounds.
        // Bottom row is also required by drippage.
        cells = new Cell[nc * (nr + 2)];
    }

    void initialize(in double prob, ref Xorshift rng) {
        cells[0 .. nc] = bottomWall | rightWall; // First row.

        uint pos = nc;
        foreach (immutable r; 1 .. nr + 1) {
            foreach (immutable c; 1 .. nc)
                cells[pos++] = (uniform01 < prob ?bottomWall : empty) |
                               (uniform01 < prob ? rightWall : empty);
            cells[pos++] = rightWall |
                           (uniform01 < prob ? bottomWall : empty);
        }

        cells[$ - nc .. $] = empty; // Last row.
    }

    bool percolate() pure nothrow @nogc {
        bool fill(in size_t i) pure nothrow @nogc {
            if (cells[i] & filled)
                return false;

            cells[i] |= filled;

            if (i >= cells.length - nc)
                return true; // Success: reached bottom row.

            return (!(cells[i]      & bottomWall) && fill(i + nc)) ||
                   (!(cells[i]      & rightWall)  && fill(i + 1)) ||
                   (!(cells[i - 1]  & rightWall)  && fill(i - 1)) ||
                   (!(cells[i - nc] & bottomWall) && fill(i - nc));
        }

        return iota(nc, nc + nc).any!fill;
    }

    void show() const {
        writeln("+-".replicate(nc), '+');

        foreach (immutable r; 1 .. nr + 2) {
            write(r == nr + 1 ? ' ' : '|');
            foreach (immutable c; 0 .. nc) {
                immutable cell = cells[r * nc + c];
                write((cell & filled) ? (r <= nr ? '#' : 'X') : ' ');
                write((cell & rightWall) ? '|' : ' ');
            }
            writeln;

            if (r == nr + 1)
                return;

            foreach (immutable c; 0 .. nc)
                write((cells[r * nc + c] & bottomWall) ? "+-" : "+ ");
            '+'.writeln;
        }
    }
}

void main() {
    enum uint nr = 10, nc = 10; // N. rows and columns of the grid.
    enum uint nTries = 10_000;  // N. simulations for each probability.
    enum uint nStepsProb = 10;  // N. steps of probability.

    auto rng = Xorshift(2);
    auto g = Grid(nr, nc);
    g.initialize(0.5, rng);
    g.percolate;
    g.show;

    writefln("\nRunning %dx%d grids %d times for each p:",
             nr, nc, nTries);
    foreach (immutable p; 0 .. nStepsProb) {
        immutable probability = p / double(nStepsProb);
        uint nPercolated = 0;
        foreach (immutable i; 0 .. nTries) {
            g.initialize(probability, rng);
            nPercolated += g.percolate;
        }
        writefln("p = %0.2f: %.4f",
                 probability, nPercolated / double(nTries));
    }
}


package main

import (
	"fmt"
	"math/rand"
	"strings"
	"time"
)

func main() {
	const (
		m, n           = 10, 10
		t              = 1000
		minp, maxp, Δp = 0.1, 0.99, 0.1
	)

	// Purposely don't seed for a repeatable example grid:
	g := NewGrid(.5, m, n)
	g.Percolate()
	fmt.Println(g)

	rand.Seed(time.Now().UnixNano()) // could pick a better seed
	for p := float64(minp); p < maxp; p += Δp {
		count := 0
		for i := 0; i < t; i++ {
			g := NewGrid(p, m, n)
			if g.Percolate() {
				count++
			}
		}
		fmt.Printf("p=%.2f, %.3f\n", p, float64(count)/t)
	}
}

type cell struct {
	full        bool
	right, down bool // true if open to the right (x+1) or down (y+1)
}

type grid struct {
	cell [][]cell // row first, i.e. [y][x]
}

func NewGrid(p float64, xsize, ysize int) *grid {
	g := &grid{cell: make([][]cell, ysize)}
	for y := range g.cell {
		g.cell[y] = make([]cell, xsize)
		for x := 0; x < xsize-1; x++ {
			if rand.Float64() > p {
				g.cell[y][x].right = true
			}
			if rand.Float64() > p {
				g.cell[y][x].down = true
			}
		}
		if rand.Float64() > p {
			g.cell[y][xsize-1].down = true
		}
	}
	return g
}

var (
	full  = map[bool]string{false: "  ", true: "**"}
	hopen = map[bool]string{false: "--", true: "  "}
	vopen = map[bool]string{false: "|", true: " "}
)

func (g *grid) String() string {
	var buf strings.Builder
	// Don't really need to call Grow but it helps avoid multiple
	// reallocations if the size is large.
	buf.Grow((len(g.cell) + 1) * len(g.cell[0]) * 7)

	for _ = range g.cell[0] {
		buf.WriteString("+")
		buf.WriteString(hopen[false])
	}
	buf.WriteString("+\n")
	for y := range g.cell {
		buf.WriteString(vopen[false])
		for x := range g.cell[y] {
			buf.WriteString(full[g.cell[y][x].full])
			buf.WriteString(vopen[g.cell[y][x].right])
		}
		buf.WriteByte('\n')
		for x := range g.cell[y] {
			buf.WriteString("+")
			buf.WriteString(hopen[g.cell[y][x].down])
		}
		buf.WriteString("+\n")
	}
	ly := len(g.cell) - 1
	for x := range g.cell[ly] {
		buf.WriteByte(' ')
		buf.WriteString(full[g.cell[ly][x].down && g.cell[ly][x].full])
	}
	return buf.String()
}

func (g *grid) Percolate() bool {
	for x := range g.cell[0] {
		if g.fill(x, 0) {
			return true
		}
	}
	return false
}

func (g *grid) fill(x, y int) bool {
	if y >= len(g.cell) {
		return true // Out the bottom
	}
	if g.cell[y][x].full {
		return false // Allready filled
	}
	g.cell[y][x].full = true

	if g.cell[y][x].down && g.fill(x, y+1) {
		return true
	}
	if g.cell[y][x].right && g.fill(x+1, y) {
		return true
	}
	if x > 0 && g.cell[y][x-1].right && g.fill(x-1, y) {
		return true
	}
	if y > 0 && g.cell[y-1][x].down && g.fill(x, y-1) {
		return true
	}
	return false
}


{-# LANGUAGE OverloadedStrings #-}
import Control.Monad
import Control.Monad.Random
import Data.Array.Unboxed
import Data.List
import Formatting

data Field = Field { f :: UArray (Int, Int) Char
                   , hWall :: UArray (Int, Int) Bool
                   , vWall :: UArray (Int, Int) Bool
                   }

-- Start percolating some seepage through a field.
-- Recurse to continue percolation with new seepage.
percolateR :: [(Int, Int)] -> Field -> (Field, [(Int,Int)])
percolateR [] (Field f h v) = (Field f h v, [])
percolateR seep (Field f h v) =
    let ((xLo,yLo),(xHi,yHi)) = bounds f
        validSeep = filter (\p@(x,y) ->    x >= xLo
                                        && x <= xHi
                                        && y >= yLo
                                        && y <= yHi
                                        && f!p == ' ') $ nub $ sort seep

        north (x,y) = if v ! (x  ,y  ) then [] else [(x  ,y-1)]
        south (x,y) = if v ! (x  ,y+1) then [] else [(x  ,y+1)]
        west  (x,y) = if h ! (x  ,y  ) then [] else [(x-1,y  )]
        east  (x,y) = if h ! (x+1,y  ) then [] else [(x+1,y  )]
        neighbors (x,y) = north(x,y) ++ south(x,y) ++ west(x,y) ++ east(x,y)

    in  percolateR
            (concatMap neighbors validSeep)
            (Field (f // map (\p -> (p,'.')) validSeep) h v)

-- Percolate a field;  Return the percolated field.
percolate :: Field -> Field
percolate start@(Field f _ _) =
    let ((_,_),(xHi,_)) = bounds f
        (final, _) = percolateR [(x,0) | x <- [0..xHi]] start
    in final

-- Generate a random field.
initField :: Int -> Int -> Double -> Rand StdGen Field
initField width height threshold = do
    let f = listArray ((0,0), (width-1, height-1)) $ repeat ' '

    hrnd <- fmap (<threshold) <$> getRandoms
    let h0 = listArray ((0,0),(width, height-1)) hrnd
        h1 = h0 // [((0,y), True) | y <- [0..height-1]]     -- close left
        h2 = h1 // [((width,y), True) | y <- [0..height-1]] -- close right

    vrnd <- fmap (<threshold) <$> getRandoms
    let v0 = listArray ((0,0),(width-1, height)) vrnd
        v1 = v0 // [((x,0), True) | x <- [0..width-1]]  -- close top

    return $ Field f h2 v1

-- Assess whether or not percolation reached bottom of field.
leaks :: Field -> [Bool]
leaks (Field f _ v) =
    let ((xLo,_),(xHi,yHi)) = bounds f
    in [f!(x,yHi)=='.' && not (v!(x,yHi+1)) | x <- [xLo..xHi]]

-- Run test once; Return bool indicating success or failure.
oneTest :: Int -> Int -> Double -> Rand StdGen Bool
oneTest width height threshold =
    or.leaks.percolate <$> initField width height threshold

-- Run test multple times; Return the number of tests that pass.
multiTest :: Int -> Int -> Int -> Double -> Rand StdGen Double
multiTest testCount width height threshold = do
    results <- replicateM testCount $ oneTest width height threshold
    let leakyCount = length $ filter id results
    return $ fromIntegral leakyCount / fromIntegral testCount

-- Helper function for display
alternate :: [a] -> [a] -> [a]
alternate [] _ = []
alternate (a:as) bs = a : alternate bs as

-- Display a field with walls and leaks.
showField :: Field -> IO ()
showField field@(Field a h v) =  do
    let ((xLo,yLo),(xHi,yHi)) = bounds a
        fLines =  [ [ a!(x,y) | x <- [xLo..xHi]] | y <- [yLo..yHi]]
        hLines =  [ [ if h!(x,y) then '|' else ' ' | x <- [xLo..xHi+1]] | y <- [yLo..yHi]]
        vLines =  [ [ if v!(x,y) then '-' else ' ' | x <- [xLo..xHi]] | y <- [yLo..yHi+1]]
        lattice =  [ [ '+' | x <- [xLo..xHi+1]] | y <- [yLo..yHi+1]]

        hDrawn = zipWith alternate hLines fLines
        vDrawn = zipWith alternate lattice vLines
    mapM_ putStrLn $ alternate vDrawn hDrawn

    let leakLine = [ if l then '.' else ' ' | l <- leaks field]
    putStrLn $ alternate (repeat ' ') leakLine

main :: IO ()
main = do
  g <- getStdGen
  let threshold = 0.45
      (startField, g2) = runRand (initField 10 10 threshold) g

  putStrLn ("Unpercolated field with " ++ show threshold ++ " threshold.")
  putStrLn ""
  showField startField

  putStrLn ""
  putStrLn "Same field after percolation."
  putStrLn ""
  showField $ percolate startField

  let testCount = 10000
      densityCount = 10
  putStrLn ""
  putStrLn ("Results of running percolation test " ++ show testCount ++ " times with thresholds ranging from 0/" ++ show densityCount ++ " to " ++ show densityCount ++ "/" ++ show densityCount ++ " .")
  let densities = [0..densityCount]
  let tests = sequence [multiTest testCount 10 10 v
                           | density <- densities,
                             let v = fromIntegral density / fromIntegral densityCount ]
  let results = zip densities (evalRand tests g2)
  mapM_ print [format ("p=" % int % "/" % int % " -> " % fixed 4) density densityCount x | (density,x) <- results]


using Printf, Distributions

struct Grid
    cells::BitArray{2}
    hwall::BitArray{2}
    vwall::BitArray{2}
end
function Grid(p::AbstractFloat, m::Integer=10, n::Integer=10)
    cells = fill(false, m, n)
    hwall = rand(Bernoulli(p), m + 1, n)
    vwall = rand(Bernoulli(p), m, n + 1)
    vwall[:, 1] = true
    vwall[:, end] = true
    return Grid(cells, hwall, vwall)
end

function Base.show(io::IO, g::Grid)
    H = (" .", " _")
    V = (":", "|")
    C = (" ", "#")
    ind = findfirst(g.cells[end, :] .& .!g.hwall[end, :])
    percolated = !iszero(ind)
    println(io, "$(size(g.cells, 1))×$(size(g.cells, 2)) $(percolated ? "Percolated" : "Not percolated") grid")
    for r in 1:size(g.cells, 1)
        println(io, "    ", join(H[w+1] for w in g.hwall[r, :]))
        println(io, " $(r % 10)) ", join(V[w+1] * C[c+1] for (w, c) in zip(g.vwall[r, :], g.cells[r, :])))
    end
    println(io, "    ", join(H[w+1] for w in g.hwall[end, :]))
    if percolated
        println(io, " !)  ", "  " ^ (ind - 1), '#')
    end
end

function floodfill!(m::Integer, n::Integer, cells::AbstractMatrix{<:Integer},
                    hwall::AbstractMatrix{<:Integer}, vwall::AbstractMatrix{<:Integer})
    # fill cells
    cells[m, n] = true
    percolated = false
    # bottom
    if m < size(cells, 1) && !hwall[m+1, n] && !cells[m+1, n]
        percolated = percolated || floodfill!(m + 1, n, cells, hwall, vwall)
    # The Bottom
    elseif m == size(cells, 1) && !hwall[m+1, n]
        return true
    end
    # left
    if n > 1 && !vwall[m, n] && !cells[m, n-1]
        percolated = percolated || floodfill!(m, n - 1, cells, hwall, vwall)
    end
    # right
    if n < size(cells, 2) && !vwall[m, n+1] && !cells[m, n+1]
        percolated = percolated || floodfill!(m, n + 1, cells, hwall, vwall)
    end
    # top
    if m > 1 && !hwall[m, n] && !cells[m-1, n]
        percolated = percolated || floodfill!(m - 1, n, cells, hwall, vwall)
    end
    return percolated
end
function pourontop!(g::Grid)
    m, n = 1, 1
    percolated = false
    while !percolated && n ≤ size(g.cells, 2)
        percolated = !g.hwall[m, n] && floodfill!(m, n, g.cells, g.hwall, g.vwall)
        n += 1
    end
    return percolated
end

function main(probs, nrep::Integer=1000)
    sampleprinted = false
    pcount = zeros(Int, size(probs))
    for (i, p) in enumerate(probs), _ in 1:nrep
        g = Grid(p)
        percolated = pourontop!(g)
        if percolated
            pcount[i] += 1
            if !sampleprinted
                println(g)
                sampleprinted = true
            end
        end
    end
    return pcount ./ nrep
end

probs = collect(10:-1:0) ./ 10
percprobs = main(probs)

println("Fraction of 1000 tries that percolate through:")
for (pr, pp) in zip(probs, percprobs)
    @printf("\tp = %.3f ⇒ freq. = %5.3f\n", pr, pp)
end


// version 1.2.10

import java.util.Random

val rand = Random()
const val RAND_MAX = 32767

// cell states
const val FILL  = 1
const val RWALL = 2  // right wall
const val BWALL = 4  // bottom wall

val x = 10
val y = 10
var grid = IntArray(x * (y + 2))
var cells = 0
var end = 0
var m = 0
var n = 0

fun makeGrid(p: Double) {
    val thresh = (p * RAND_MAX).toInt()
    m = x
    n = y
    grid.fill(0)  // clears grid
    for (i in 0 until m) grid[i] = BWALL or RWALL
    cells = m
    end = m
    for (i in 0 until y) {
        for (j in x - 1 downTo 1) {
            val r1 = rand.nextInt(RAND_MAX + 1)
            val r2 = rand.nextInt(RAND_MAX + 1)
            grid[end++] = (if (r1 < thresh) BWALL else 0) or
                          (if (r2 < thresh) RWALL else 0)
        }
        val r3 = rand.nextInt(RAND_MAX + 1)
        grid[end++] = RWALL or (if (r3 < thresh) BWALL else 0)
    }
}

fun showGrid() {
    for (j in 0 until m) print("+--")
    println("+")

    for (i in 0..n) {
        print(if (i == n) " " else "|")
        for (j in 0 until m) {
            print(if ((grid[i * m + j + cells] and FILL) != 0) "[]" else "  ")
            print(if ((grid[i * m + j + cells] and RWALL) != 0) "|" else " ")
        }
        println()
        if (i == n) return
        for (j in 0 until m) {
            print(if ((grid[i * m + j + cells] and BWALL) != 0) "+--" else "+  ")
        }
        println("+")
    }
}

fun fill(p: Int): Boolean {
    if ((grid[p] and FILL) != 0) return false
    grid[p] = grid[p] or FILL
    if (p >= end) return true  // success: reached bottom row
    return (((grid[p + 0] and BWALL) == 0) && fill(p + m)) ||
           (((grid[p + 0] and RWALL) == 0) && fill(p + 1)) ||
           (((grid[p - 1] and RWALL) == 0) && fill(p - 1)) ||
           (((grid[p - m] and BWALL) == 0) && fill(p - m))
}

fun percolate(): Boolean {
    var i = 0
    while (i < m && !fill(cells + i)) i++
    return i < m
}

fun main(args: Array<String>) {
    makeGrid(0.5)
    percolate()
    showGrid()

    println("\nrunning $x x $y grids 10,000 times for each p:")
    for (p in 1..9) {
        var cnt = 0
        val pp = p / 10.0
        for (i in 0 until 10_000) {
            makeGrid(pp)
            if (percolate()) cnt++
        }
        println("p = %3g: %.4f".format(pp, cnt.toDouble() / 10_000))
    }
}


import random, sequtils, strformat, tables

type

  Cell = object
    full: bool
    right, down: bool     # True if open to the right (x+1) or down (y+1).

  Grid = seq[seq[Cell]]   # Row first, i.e. [y][x].

proc newGrid(p: float; xsize, ysize: Positive): Grid =

  result = newSeqWith(ysize, newSeq[Cell](xsize))
  for row in result.mitems:
    for x in 0..(xsize - 2):
      if rand(1.0) > p: row[x].right = true
      if rand(1.0) > p: row[x].down = true
    if rand(1.0) > p: row[xsize - 1].down = true

const
  Full = {false: "  ", true: "()"}.toTable
  HOpen = {false: "--", true: "  "}.toTable
  VOpen = {false: "|", true: " "}.toTable

proc `$`(grid: Grid): string =

  # Preallocate result to avoid multiple reallocations.
  result = newStringOfCap((grid.len + 1) * grid[0].len * 7)

  for _ in 0..grid[0].high:
    result.add '+'
    result.add HOpen[false]
  result.add "+\n"

  for row in grid:
    result.add VOpen[false]
    for cell in row:
      result.add Full[cell.full]
      result.add VOpen[cell.right]
    result.add '\n'
    for cell in row:
      result.add '+'
      result.add HOpen[cell.down]
    result.add "+\n"

  for cell in grid[^1]:
    result.add ' '
    result.add Full[cell.down and cell.full]

proc fill(grid: var Grid; x, y: Natural): bool =

  if y >= grid.len: return true     # Out the bottom.
  if grid[y][x].full: return false  # Already filled.
  grid[y][x].full = true

  if grid[y][x].down and grid.fill(x, y + 1): return true
  if grid[y][x].right and grid.fill(x + 1, y): return true
  if x > 0 and grid[y][x - 1].right and grid.fill(x - 1, y): return true
  if y > 0 and grid[y - 1][x].down and grid.fill(x, y - 1): return true

proc percolate(grid: var Grid): bool =
  for x in 0..grid[0].high:
    if grid.fill(x, 0): return true

const
  M = 10
  N = 10
  T = 1000
  MinP = 0.1
  MaxP = 0.99
  ΔP = 0.1

# Purposely don't seed for a repeatable example grid.
var grid = newGrid(0.4, M, N)
discard grid.percolate()
echo grid
echo ""

randomize()
var p = MinP
while p < MaxP:
  var count = 0
  for _ in 1..T:
    var grid = newGrid(p, M, N)
    if grid.percolate(): inc count
  echo &"p = {p:.2f}: {count / T:.3f}"
  p += ΔP


my @bond;
my $grid = 10;
my $water = '▒';
$D{$_} = $i++ for qw<DeadEnd Up Right Down Left>;

sub percolate {
    generate(shift || 0.6);
    fill(my $x = 1,my $y = 0);
    my @stack;

    while () {
        if (my $dir = direction($x,$y)) {
            push @stack, [$x,$y];
            ($x,$y) = move($dir, $x, $y)
        } else {
            return 0 unless @stack;
            ($x,$y) = @{pop @stack}
        }
        return 1 if $y == $#bond;
    }
}

sub direction {
    my($x, $y) = @_;
    return $D{Down}  if $bond[$y+1][$x  ] =~ / /;
    return $D{Left}  if $bond[$y  ][$x-1] =~ / /;
    return $D{Right} if $bond[$y  ][$x+1] =~ / /;
    return $D{Up}    if defined $bond[$y-1][$x  ] && $bond[$y-1][$x] =~ / /;
    return $D{DeadEnd}
}

sub move {
    my($dir,$x,$y) = @_;
    fill(  $x,--$y), fill(  $x,--$y) if $dir == $D{Up};
    fill(  $x,++$y), fill(  $x,++$y) if $dir == $D{Down};
    fill(--$x,  $y), fill(--$x,  $y) if $dir == $D{Left};
    fill(++$x,  $y), fill(++$x,  $y) if $dir == $D{Right};
    $x, $y
}

sub fill {
    my($x, $y) = @_;
    $bond[$y][$x] =~ s/ /$water/g
}

sub generate {
    our($prob) = shift || 0.5;
    @bond = ();
    our $sp = '   ';
    push @bond, ['│', ($sp, ' ') x ($grid-1), $sp, '│'],
                ['├', hx('┬'), h(), '┤'];
    push @bond, ['│', vx(   ), $sp, '│'],
                ['├', hx('┼'), h(), '┤'] for 1..$grid-1;
    push @bond, ['│', vx(   ), $sp, '│'],
                ['├', hx('┴'), h(), '┤'],
                ['│', ($sp, ' ') x ($grid-1), $sp, '│'];

    sub hx { my($c)=@_; my @l; push @l, (h(),$c) for 1..$grid-1; return @l; }
    sub vx {            my @l; push @l, $sp, v() for 1..$grid-1; return @l; }
    sub h { rand() < $prob ? $sp : '───' }
    sub v { rand() < $prob ? ' ' : '│'   }
}

print "Sample percolation at .6\n";
percolate(.6);
for my $row (@bond) {
    my $line = '';
    $line .= join '', $_ for @$row;
    print "$line\n";
}

my $tests = 100;
print "Doing $tests trials at each porosity:\n";
my @table;
for my $p (1 .. 10) {
    $p = $p/10;
    my $total = 0;
    $total += percolate($p) for 1..$tests;
    printf "p = %0.1f: %0.2f\n", $p, $total / $tests
}


with javascript_semantics
constant w = 10, h = 10

sequence wall = join(repeat("+",w+1),"---")&"\n",
         cell = join(repeat("|",w+1),"   ")&"\n",
         grid

procedure new_grid(atom p)
    grid = split(join(repeat(wall,h+1),cell),'\n')
    -- now knock down some walls
    for i=1 to length(grid)-1 do
        integer jstart = 5-mod(i,2)*3,
                jlimit = length(grid[i])-3
        -- (ie 2..38 on odd lines, 5..37 on even)
        for j=jstart to jlimit by 4 do
            if rnd()>p then
                grid[i][j..j+2] = "   "
            end if
        end for
    end for
end procedure

function percolate(integer x=0, y=0)
    if x=0 then
        for j=3 to length(grid[1])-2 by 4 do
            if grid[1][j]=' ' and percolate(1,j) then
                return true
            end if
        end for
    elsif grid[x][y]=' ' then
        grid[x][y] = '*'
        if (x=length(grid)-1)
        or (         grid[x+1][y]=' ' and percolate(x+1,y))
        or (y>6  and grid[x][y-2]=' ' and percolate(x,y-4))
        or (y<36 and grid[x][y+2]=' ' and percolate(x,y+4))
        or (x>1  and grid[x-1][y]=' ' and percolate(x-1,y)) then
            return true
        end if
    end if
    return false
end function

constant LIM=1000

for p=0 to 10 do
    integer count = 0
    for t=1 to LIM do
        new_grid(p/10)
        count += percolate()
    end for
    printf(1,"p=%.1f: %5.3f\n",{p/10,count/LIM})
end for
puts(1,"sample grid for p=0.6:\n")
new_grid(0.6)
{} = percolate()
printf(1,"%s\n",{join(grid,'\n')})


from collections import namedtuple
from random import random
from pprint import pprint as pp

Grid = namedtuple('Grid', 'cell, hwall, vwall')

M, N, t = 10, 10, 100

class PercolatedException(Exception): pass

HVF = [(' .', ' _'), (':', '|'), (' ', '#')]  # Horiz, vert, fill chars

def newgrid(p):
    hwall = [[int(random() < p) for m in range(M)]
             for n in range(N+1)]
    vwall = [[(1 if m in (0, M) else int(random() < p)) for m in range(M+1)]
             for n in range(N)]
    cell = [[0 for m in range(M)]
             for n in range(N)]
    return Grid(cell, hwall, vwall)

def pgrid(grid, percolated=None):
    cell, hwall, vwall = grid
    h, v, f = HVF
    for n in range(N):
        print('    ' + ''.join(h[hwall[n][m]] for m in range(M)))
        print('%i)  ' % (n % 10) + ''.join(v[vwall[n][m]] + f[cell[n][m] if m < M else 0]
                                          for m in range(M+1))[:-1])
    n = N
    print('    ' + ''.join(h[hwall[n][m]] for m in range(M)))
    if percolated:
        where = percolated.args[0][0]
        print('!)  ' + '  ' * where + ' ' + f[1])

def pour_on_top(grid):
    cell, hwall, vwall = grid
    n = 0
    try:
        for m in range(M):
            if not hwall[n][m]:
                flood_fill(m, n, cell, hwall, vwall)
    except PercolatedException as ex:
        return ex
    return None

def flood_fill(m, n, cell, hwall, vwall):
    # fill cell
    cell[n][m] = 1
    # bottom
    if n < N - 1 and not hwall[n + 1][m] and not cell[n+1][m]:
        flood_fill(m, n+1, cell, hwall, vwall)
    # THE bottom
    elif n == N - 1 and not hwall[n + 1][m]:
        raise PercolatedException((m, n+1))
    # left
    if m and not vwall[n][m] and not cell[n][m - 1]:
        flood_fill(m-1, n, cell, hwall, vwall)
    # right
    if m < M - 1 and not vwall[n][m + 1] and not cell[n][m + 1]:
        flood_fill(m+1, n, cell, hwall, vwall)
    # top
    if n and not hwall[n][m] and not cell[n-1][m]:
        flood_fill(m, n-1, cell, hwall, vwall)

if __name__ == '__main__':
    sample_printed = False
    pcount = {}
    for p10 in range(11):
        p = (10 - p10) / 10.0    # count down so sample print is interesting
        pcount[p] = 0
        for tries in range(t):
            grid = newgrid(p)
            percolated = pour_on_top(grid)
            if percolated:
                pcount[p] += 1
                if not sample_printed:
                    print('\nSample percolating %i x %i grid' % (M, N))
                    pgrid(grid, percolated)
                    sample_printed = True
    print('\n p: Fraction of %i tries that percolate through' % t )

    pp({p:c/float(t) for p, c in pcount.items()})


#lang racket

(define has-left-wall?   (lambda (x) (bitwise-bit-set? x 0)))
(define has-right-wall?  (lambda (x) (bitwise-bit-set? x 1)))
(define has-top-wall?    (lambda (x) (bitwise-bit-set? x 2)))
(define has-bottom-wall? (lambda (x) (bitwise-bit-set? x 3)))
(define has-fluid?       (lambda (x) (bitwise-bit-set? x 4)))

(define (walls->cell l? r? t? b?)
  (+ (if l? 1 0) (if r? 2 0) (if t? 4 0) (if b? 8 0)))

(define (bonded-percol-grid M N p)
  (define rv (make-vector (* M N)))
  (for* ((idx (in-range (* M N))))
    (define left-wall?
      (or (zero? (modulo idx M))
          (has-right-wall? (vector-ref rv (sub1 idx)))))
    (define right-wall?
      (or (= (modulo idx M) (sub1 M))
          (< (random) p)))
    (define top-wall?
      (if (< idx M) (< (random) p)
          (has-bottom-wall? (vector-ref rv (- idx M)))))
    (define bottom-wall? (< (random) p))
    (define cell-value
      (walls->cell left-wall? right-wall? top-wall? bottom-wall?))
    (vector-set! rv idx cell-value))
  rv)

(define (display-percol-grid M . vs)
  (define N (/ (vector-length (car vs)) M))
  (define-syntax-rule (tab-eol m)
    (when (= m (sub1 M)) (printf "\t")))
  (for ((n N))
    (for* ((v vs) (m M))
      (when (zero? m) (printf "+"))
      (printf
       (match (vector-ref v (+ (* n M) m))
         ((? has-top-wall?) "-+")
         ((? has-fluid?)    "#+")
         (else ".+")))
      (tab-eol m))
    (newline)
    (for* ((v vs) (m M))
      (when (zero? m) (printf "|"))
      (printf
       (match (vector-ref v (+ (* n M) m))
         ((and (? has-fluid?) (? has-right-wall?)) "#|")
         ((? has-right-wall?) ".|")
         ((? has-fluid?) "##")
         (else "..")))
      (tab-eol m))
    (newline))
  (for* ((v vs) (m M))
    (when (zero? m) (printf "+"))
    (printf
     (match (vector-ref v (+ (* (sub1 M) M) m))
       ((? has-bottom-wall?) "-+")
       ((? has-fluid?)    "#+")
       (else ".+")))
    (tab-eol m))
  (newline))

(define (find-bonded-grid-t/b-path M v)
  (define N (/ (vector-length v) M))

  (define (flood-cell idx)
    (cond
      [(= (quotient idx M) N) #t] ; wootiments!
      [(has-fluid? (vector-ref v idx)) #f] ; been here
      [else (define cell (vector-ref v idx))
            (vector-set! v idx (bitwise-ior cell 16))
            (or (and (not (has-bottom-wall? cell)) (flood-cell (+ idx M)))
                (and (not (has-left-wall? cell))   (flood-cell (- idx 1)))
                (and (not (has-right-wall? cell))  (flood-cell (+ idx 1)))
                (and (not (has-top-wall? cell))
                     (>= idx M) ; not top row
                     (flood-cell (- idx M))))]))

  (for/first ((m (in-range M))
              #:unless (has-top-wall? (vector-ref v m))
              #:when (flood-cell m)) #t))

(define t (make-parameter 1000))
(define (experiment p)
  (/ (for*/sum ((sample (in-range (t)))
                (v (in-value (bonded-percol-grid 10 10 p)))
                #:when (find-bonded-grid-t/b-path 10 v)) 1)
     (t)))

(define (main)
  (for ((tenths (in-range 0 (add1 10))))
    (define p (/ tenths 10))
    (define e (experiment p))
    (printf "proportion of grids that percolate p=~a : ~a (~a)~%"
            p e (real->decimal-string e 5))))

(module+ test
  (define (make/display/flood/display-bonded-grid M N p attempts (atmpt 1))
    (define v (bonded-percol-grid M N p))
    (define v+ (vector-copy v))
    (cond [(or (find-bonded-grid-t/b-path M v+) (= attempts 0))
           (define v* (vector-copy v+))
           (define (flood-bonded-grid)
             (when (find-bonded-grid-t/b-path M v*)
               (flood-bonded-grid)))
           (flood-bonded-grid)
           (display-percol-grid M v v+ v*)
           (printf "After ~a attempt(s)~%~%" atmpt)]
          [else
           (make/display/flood/display-bonded-grid
            M N p (sub1 attempts) (add1 atmpt))]))

  (make/display/flood/display-bonded-grid 10 10 0   20)
  (make/display/flood/display-bonded-grid 10 10 .25 20)
  (make/display/flood/display-bonded-grid 10 10 .50 20)
  (make/display/flood/display-bonded-grid 10 10 .75 20000))


my @bond;
my $grid = 10;
my $geom = $grid - 1;
my $water = '▒';

enum Direction <DeadEnd Up Right Down Left>;

say 'Sample percolation at .6';
percolate .6;
.join.say for @bond;
say "\n";

my $tests = 100;
say "Doing $tests trials at each porosity:";
for .1, .2 ... 1 -> $p {
    printf "p = %0.1f: %0.2f\n", $p, (sum percolate($p) xx $tests) / $tests
}

sub percolate ( $prob ) {
    generate $prob;
    my @stack;
    my $current = [1;0];
    $current.&fill;

    loop {
        if my $dir = direction( $current ) {
            @stack.push: $current;
            $current = move $dir, $current
        }
        else {
            return False unless @stack;
            $current = @stack.pop
        }
        return True if $current[1] == +@bond - 1
    }

    sub direction( [$x, $y] ) {
        ( Down  if @bond[$y + 1][$x].contains: ' ' ) ||
        ( Left  if @bond[$y][$x - 1].contains: ' ' ) ||
        ( Right if @bond[$y][$x + 1].contains: ' ' ) ||
        ( Up    if @bond[$y - 1][$x].defined && @bond[$y - 1][$x].contains: ' ' ) ||
        DeadEnd
    }

    sub move ( $dir, @cur ) {
        my ( $x, $y ) = @cur;
        given $dir {
            when Up    { [$x,--$y].&fill xx 2 }
            when Down  { [$x,++$y].&fill xx 2 }
            when Left  { [--$x,$y].&fill xx 2 }
            when Right { [++$x,$y].&fill xx 2 }
        }
        [$x, $y]
    }

    sub fill ( [$x, $y] ) { @bond[$y;$x].=subst(' ', $water, :g) }
}

sub generate ( $prob = .5 ) {
    @bond = ();
    my $sp = '   ';
    append @bond, [flat '│', ($sp, ' ') xx $geom, $sp, '│'],
                  [flat '├', (h(), '┬') xx $geom, h(), '┤'];
    append @bond, [flat '│', ($sp, v()) xx $geom, $sp, '│'],
                  [flat '├', (h(), '┼') xx $geom, h(), '┤'] for ^$geom;
    append @bond, [flat '│', ($sp, v()) xx $geom, $sp, '│'],
                  [flat '├', (h(), '┴') xx $geom, h(), '┤'],
                  [flat '│', ($sp, ' ') xx $geom, $sp, '│'];

    sub h () { rand < $prob ?? $sp !! '───' }
    sub v () { rand < $prob ?? ' ' !! '│'   }
}