Naive F# Port of Prospero

prospero-for-linqpad.fs

open System
open System.IO
open System.Collections.Generic

// Define a type to hold either a scalar or an image (2D array)
type Value =
    | Scalar of float
    | Array of float[,]  // 2D array representing the image

// Image size (for testing you might want to use a smaller value)
let imageSize = 512

// Create a linearly spaced vector from -1 to 1.
let space : float[] =
    Array.init imageSize (fun i -> -1.0 + 2.0 * float i / float (imageSize - 1))

// Create meshgrid arrays:
// x: each row is 'space'
// y: each column is '-space'
let x : float[,] = Array2D.init imageSize imageSize (fun i j -> space.[j])
let y : float[,] = Array2D.init imageSize imageSize (fun i j -> -space.[i])

// Define a dictionary to hold all the intermediate values
let v = Dictionary<string, Value>()

// Helper: given two arrays, apply the binary operator elementwise.
let inline apply2D ([<InlineIfLambda>] op: float -> float -> float) (a: float[,]) (b: float[,]) : float[,] =
    let r = a.GetLength(0)
    let c = a.GetLength(1)
    let result = Array2D.init r c (fun i j -> op a.[i,j] b.[i,j])
    result

let inline unaryOp ([<InlineIfLambda>] f: float -> float) a =
    match a with
    | Scalar x -> Scalar (f x)
    | Array arr -> Array (Array2D.map f arr)

// Define arithmetic operations that allow broadcasting from scalars to arrays.
let inline binaryOp ([<InlineIfLambda>] f) a b =
    match a, b with
    | Scalar x, Scalar y -> Scalar (f x y)
    | Scalar x, Array arr -> Array (Array2D.map (fun v -> f x v) arr)
    | Array arr, Scalar x -> Array (Array2D.map (fun v -> f v x) arr)
    | Array arr1, Array arr2 -> Array (apply2D f arr1 arr2)


// Define arithmetic operations that allow broadcasting from scalars to arrays.
let add a b = binaryOp (+) a b
let sub a b = binaryOp (-) a b
let mul a b = binaryOp (fun x y -> x * y) a b
let maxOp a b = binaryOp max a b
let minOp a b = binaryOp min a b
let neg a = unaryOp (fun x -> -x) a
let square a = unaryOp (fun x -> x * x) a
let sqrtOp a = unaryOp sqrt a

module Images = 

    open System.Drawing

    let toBitmap (arr: float[,]): Bitmap = 
        let bmp = new Bitmap(imageSize, imageSize)
        for i in 0..(imageSize - 1) do
            for j in 0..(imageSize - 1) do
                let c = if arr.[i,j] < 0.0 then int 255 else int 0
                bmp.SetPixel(j, i, Color.FromArgb(c, c, c))
                ()
        bmp

    let writeBitmap(folder, v) = 

        let outFile = Path.Combine(folder, "out.ppm")

        // Retrieve the final computed value (assumed to be an image)
        match v with
        | Scalar s ->
            // If the final value is scalar, construct an image based on whether s is negative.
            let image = Array2D.init imageSize imageSize (fun _ _ -> if s < 0.0 then byte 255 else byte 0)
            use fs = new FileStream(outFile, FileMode.Create, FileAccess.Write)
            let header = sprintf "P5\n%d %d\n255\n" imageSize imageSize
            let headerBytes = System.Text.Encoding.ASCII.GetBytes(header)
            fs.Write(headerBytes, 0, headerBytes.Length)
            for i in 0 .. imageSize - 1 do
                for j in 0 .. imageSize - 1 do
                    fs.WriteByte(image.[i,j])
        | Array arr ->
            // Write a PGM file (binary grayscale).
            use fs = new FileStream(outFile, FileMode.Create, FileAccess.Write)
            let header = sprintf "P5\n%d %d\n255\n" imageSize imageSize
            let headerBytes = System.Text.Encoding.ASCII.GetBytes(header)
            fs.Write(headerBytes, 0, headerBytes.Length)
            // Each pixel gets 255 if the value is negative, 0 otherwise.
            for i in 0 .. imageSize - 1 do
                for j in 0 .. imageSize - 1 do
                    let pixel = if arr.[i,j] < 0.0 then byte 255 else byte 0
                    fs.WriteByte(pixel)


// Read the VM file "prospero.vm" as a complete text.
let folder = Path.GetDirectoryName(Util.CurrentQueryPath)
let text = File.ReadAllText(Path.Combine(folder, "prospero.vm")).Trim()

// Variable to remember the name of the last computed value.
let mutable lastVar = ""

let proc = System.Diagnostics.Process.GetCurrentProcess()

let imageContainer = new DumpContainer()
imageContainer.Dump("Image")

// Process each non-comment line
for (c, line) in text.Split([|'\n'|]) |> Array.indexed do
    let trimmed = line.Trim()
    // Skip comments or empty lines
    if not (trimmed.StartsWith("#")) && trimmed <> "" then
        let parts = trimmed.Split([|' '; '\t'|], StringSplitOptions.RemoveEmptyEntries)
        // The first token is the output variable name, second is the operation, remaining are arguments.
        let outName = parts.[0]
        let op = parts.[1]
        let args = parts |> Array.skip 2
        lastVar <- outName // update the last output name
        let memUsed = proc.WorkingSet64 / 1024L
        
        match op with
        | "var-x" -> v.[outName] <- Array x
        | "var-y" -> v.[outName] <- Array y
        | "const" -> 
            let value = float args.[0]
            v.[outName] <- Scalar value
        | "add" ->
            let a = v.[args.[0]]
            let b = v.[args.[1]]
            v.[outName] <- add a b
        | "sub" ->
            let a = v.[args.[0]]
            let b = v.[args.[1]]
            v.[outName] <- sub a b
        | "mul" ->
            let a = v.[args.[0]]
            let b = v.[args.[1]]
            v.[outName] <- mul a b
        | "max" ->
            let a = v.[args.[0]]
            let b = v.[args.[1]]
            v.[outName] <- maxOp a b
        | "min" ->
            let a = v.[args.[0]]
            let b = v.[args.[1]]
            v.[outName] <- minOp a b
        | "neg" ->
            let a = v.[args.[0]]
            v.[outName] <- neg a
        | "square" ->
            let a = v.[args.[0]]
            v.[outName] <- square a
        | "sqrt" ->
            let a = v.[args.[0]]
            v.[outName] <- sqrtOp a
        | _ ->
            failwith (sprintf "unknown opcode '%s'" op)
        //  Allows us to see each step
        if c % 1 = 0 then
            match v.[lastVar] with
            | Array arr ->
                let bmp = Images.toBitmap arr
                imageContainer.UpdateContent(bmp)
                ()
            | Scalar _ -> 
                ()

prospero.fsx

//  Based on https://www.mattkeeter.com/projects/prospero/

open System
open System.IO
open System.Collections.Generic

// Define a type to hold either a scalar or an image (2D array)
type Value =
    | Scalar of float
    | Array of float[,]  // 2D array representing the image

// Image size (for testing you might want to use a smaller value)
let imageSize = 512

// Create a linearly spaced vector from -1 to 1.
let space : float[] =
    Array.init imageSize (fun i -> -1.0 + 2.0 * float i / float (imageSize - 1))

// Create meshgrid arrays:
// x: each row is 'space'
// y: each column is '-space'
let x : float[,] = Array2D.init imageSize imageSize (fun i j -> space.[j])
let y : float[,] = Array2D.init imageSize imageSize (fun i j -> -space.[i])

// Define a dictionary to hold all the intermediate values
let v = Dictionary<string, Value>()

// Helper: given two arrays, apply the binary operator elementwise.
let inline apply2D ([<InlineIfLambda>] op: float -> float -> float) (a: float[,]) (b: float[,]) : float[,] =
    let r = a.GetLength(0)
    let c = a.GetLength(1)
    let result = Array2D.init r c (fun i j -> op a.[i,j] b.[i,j])
    result

let inline unaryOp ([<InlineIfLambda>] f: float -> float) a =
    match a with
    | Scalar x -> Scalar (f x)
    | Array arr -> Array (Array2D.map f arr)

// Define arithmetic operations that allow broadcasting from scalars to arrays.
let inline binaryOp ([<InlineIfLambda>] f) a b =
    match a, b with
    | Scalar x, Scalar y -> Scalar (f x y)
    | Scalar x, Array arr -> Array (Array2D.map (fun v -> f x v) arr)
    | Array arr, Scalar x -> Array (Array2D.map (fun v -> f v x) arr)
    | Array arr1, Array arr2 -> Array (apply2D f arr1 arr2)


// Define arithmetic operations that allow broadcasting from scalars to arrays.
let add a b = binaryOp (+) a b
let sub a b = binaryOp (-) a b
let mul a b = binaryOp (fun x y -> x * y) a b
let maxOp a b = binaryOp max a b
let minOp a b = binaryOp min a b
let neg a = unaryOp (fun x -> -x) a
let square a = unaryOp (fun x -> x * x) a
let sqrtOp a = unaryOp sqrt a

// Read the VM file "prospero.vm" as a complete text.
let folder = Path.GetDirectoryName(Util.CurrentQueryPath)
let text = File.ReadAllText(Path.Combine(folder, "prospero.vm")).Trim()

// Variable to remember the name of the last computed value.
let mutable lastVar = ""

let proc = System.Diagnostics.Process.GetCurrentProcess()

// Process each non-comment line
for (c, line) in text.Split([|'\n'|]) |> Array.indexed do
    let trimmed = line.Trim()
    // Skip comments or empty lines
    if not (trimmed.StartsWith("#")) && trimmed <> "" then
        let parts = trimmed.Split([|' '; '\t'|], StringSplitOptions.RemoveEmptyEntries)
        // The first token is the output variable name, second is the operation, remaining are arguments.
        let outName = parts.[0]
        let op = parts.[1]
        let args = parts |> Array.skip 2
        lastVar <- outName // update the last output name
        let memUsed = proc.WorkingSet64 / 1024L
        printfn "Counter: %i - %i" c memUsed
        match op with
        | "var-x" -> v.[outName] <- Array x
        | "var-y" -> v.[outName] <- Array y
        | "const" -> 
            let value = float args.[0]
            v.[outName] <- Scalar value
        | "add" ->
            let a = v.[args.[0]]
            let b = v.[args.[1]]
            v.[outName] <- add a b
        | "sub" ->
            let a = v.[args.[0]]
            let b = v.[args.[1]]
            v.[outName] <- sub a b
        | "mul" ->
            let a = v.[args.[0]]
            let b = v.[args.[1]]
            v.[outName] <- mul a b
        | "max" ->
            let a = v.[args.[0]]
            let b = v.[args.[1]]
            v.[outName] <- maxOp a b
        | "min" ->
            let a = v.[args.[0]]
            let b = v.[args.[1]]
            v.[outName] <- minOp a b
        | "neg" ->
            let a = v.[args.[0]]
            v.[outName] <- neg a
        | "square" ->
            let a = v.[args.[0]]
            v.[outName] <- square a
        | "sqrt" ->
            let a = v.[args.[0]]
            v.[outName] <- sqrtOp a
        | _ ->
            failwith (sprintf "unknown opcode '%s'" op)

let outFile = Path.Combine(folder, "out.ppm")

// Retrieve the final computed value (assumed to be an image)
match v.[lastVar] with
| Scalar s ->
    // If the final value is scalar, construct an image based on whether s is negative.
    let image = Array2D.init imageSize imageSize (fun _ _ -> if s < 0.0 then byte 255 else byte 0)
    use fs = new FileStream(outFile, FileMode.Create, FileAccess.Write)
    let header = sprintf "P5\n%d %d\n255\n" imageSize imageSize
    let headerBytes = System.Text.Encoding.ASCII.GetBytes(header)
    fs.Write(headerBytes, 0, headerBytes.Length)
    for i in 0 .. imageSize - 1 do
        for j in 0 .. imageSize - 1 do
            fs.WriteByte(image.[i,j])
| Array arr ->
    // Write a PGM file (binary grayscale).
    use fs = new FileStream(outFile, FileMode.Create, FileAccess.Write)
    let header = sprintf "P5\n%d %d\n255\n" imageSize imageSize
    let headerBytes = System.Text.Encoding.ASCII.GetBytes(header)
    fs.Write(headerBytes, 0, headerBytes.Length)
    // Each pixel gets 255 if the value is negative, 0 otherwise.
    for i in 0 .. imageSize - 1 do
        for j in 0 .. imageSize - 1 do
            let pixel = if arr.[i,j] < 0.0 then byte 255 else byte 0
            fs.WriteByte(pixel)