How to resolve the algorithm Percolation/Bond percolation step by step in the Racket programming language

Published on 12 May 2024 09:40 PM
#Racket

How to resolve the algorithm Percolation/Bond percolation step by step in the Racket programming language

Table of Contents

Problem Statement

Given an

M × N

{\displaystyle M\times N}

rectangular array of cells numbered

c e l l

[ 0.. M − 1 , 0.. N − 1 ]

{\displaystyle \mathrm {cell} [0..M-1,0..N-1]}

, assume

M

{\displaystyle M}

is horizontal and

N

{\displaystyle N}

is downwards. Each

c e l l

[ m , n ]

{\displaystyle \mathrm {cell} [m,n]}

is bounded by (horizontal) walls

h w a l l

[ m , n ]

{\displaystyle \mathrm {hwall} [m,n]}

and

h w a l l

[ m + 1 , n ]

{\displaystyle \mathrm {hwall} [m+1,n]}

; (vertical) walls

v w a l l

[ m , n ]

{\displaystyle \mathrm {vwall} [m,n]}

and

v w a l l

[ m , n + 1 ]

{\displaystyle \mathrm {vwall} [m,n+1]}

Assume that the probability of any wall being present is a constant

p

{\displaystyle p}

where Except for the outer horizontal walls at

m

0

{\displaystyle m=0}

and

m

M

{\displaystyle m=M}

which are always present. Simulate pouring a fluid onto the top surface (

n

0

{\displaystyle n=0}

) where the fluid will enter any empty cell it is adjacent to if there is no wall between where it currently is and the cell on the other side of the (missing) wall.
The fluid does not move beyond the horizontal constraints of the grid. The fluid may move “up” within the confines of the grid of cells. If the fluid reaches a bottom cell that has a missing bottom wall then the fluid can be said to 'drip' out the bottom at that point. Given

p

{\displaystyle p}

repeat the percolation

t

{\displaystyle t}

times to estimate the proportion of times that the fluid can percolate to the bottom for any given

p

{\displaystyle p}

. Show how the probability of percolating through the random grid changes with

p

{\displaystyle p}

going from

0.0

{\displaystyle 0.0}

to

1.0

{\displaystyle 1.0}

in

0.1

{\displaystyle 0.1}

increments and with the number of repetitions to estimate the fraction at any given

p

{\displaystyle p}

as

t

100

{\displaystyle t=100}

. Use an

M

10 , N

10

{\displaystyle M=10,N=10}

grid of cells for all cases. Optionally depict fluid successfully percolating through a grid graphically. Show all output on this page.

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Percolation/Bond percolation step by step in the Racket programming language

Source code in the racket programming language

#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))

You may also check:How to resolve the algorithm Ordered words step by step in the Simula programming language
You may also check:How to resolve the algorithm Sorting algorithms/Bubble sort step by step in the Mathematica/Wolfram Language programming language
You may also check:How to resolve the algorithm Animation step by step in the Logo programming language
You may also check:How to resolve the algorithm Nautical bell step by step in the Ring programming language
You may also check:How to resolve the algorithm Draw a pixel step by step in the Kotlin programming language