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 SkiaSharp

    let toBitmap (arr: float[,]): SKBitmap = 
        let bmp = new SKBitmap(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
                let c = byte(c)
                let color = SKColor(c, c, c)
                bmp.SetPixel(j, i, color)
                ()
        bmp
        
    let toPngBytes (bitmap: SKBitmap) : byte[] option =
        // SKImage.FromBitmap does not take ownership of the bitmap.
        // The 'bitmap' should be disposed by its creator if no longer needed.
        use image = SKImage.FromBitmap(bitmap)
        if image = null then
            printfn "Warning: SKImage.FromBitmap returned null. Cannot create PNG."
            None
        else
            // Encode the image to PNG format. Quality is 1-100 (100 is best for PNG, often ignored as it's lossless)
            use data = image.Encode(SKEncodedImageFormat.Png, 100)
            if data = null then
                printfn "Warning: SKImage.Encode (PNG) returned null."
                None
            else
                Some(data.ToArray())        

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


let paint() = 
    // 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) |> Array.toList
            // The first token is the output variable name, second is the operation, remaining are arguments.
            let outName::op::args = parts
            lastVar <- outName // update the last output name
            let memUsed = proc.WorkingSet64 / 1024L
            
            let (|V|) k = v.[k]
            let (|Float|) s = float s
            
            
            match op, args with
            | "var-x", [] -> 
                v.[outName] <- Array x
            | "var-y", [] -> 
                v.[outName] <- Array y
            | "const", [Float(a)] -> 
                v.[outName] <- Scalar a
            | "add", [ V(a); V(b) ] ->
                v.[outName] <- add a b
            | "sub", [ V(a); V(b) ] ->
                v.[outName] <- sub a b
            | "mul", [ V(a); V(b) ] ->
                v.[outName] <- mul a b
            | "max", [ V(a); V(b) ] ->
                v.[outName] <- maxOp a b
            | "min", [ V(a); V(b) ] ->
                v.[outName] <- minOp a b
            | "neg", [ V(a) ] ->
                v.[outName] <- neg a
            | "square", [ V(a) ] ->
                v.[outName] <- square a
            | "sqrt", [ V(a) ] ->
                v.[outName] <- sqrtOp a
            | _ ->
                failwith (sprintf "unknown opcode '%s'" op)
            //  Allows us to see each step
            if c % 10 = 0 then
                match v.[lastVar] with
                | Array arr ->
                    let bmp = (Images.toBitmap arr)
                    let image = Util.Image(bmp |> Images.toPngBytes |> Option.defaultValue [||])
                    imageContainer.UpdateContent(image) |> ignore
    //                Threading.Thread.Sleep(1000)
                | Scalar _ -> 
                    ()
type VarName = string


//[<StructuredFormatDisplay("{DisplayText}")>]
type NewExpr = 
    
    | Let of VarName * NewExpr
    | Var of VarName
    | VarX
    | VarY
    | Const of float
    | Add of NewExpr * NewExpr
    | Sub of NewExpr * NewExpr
    | Mul of NewExpr * NewExpr
    | Max of NewExpr * NewExpr
    | Min of NewExpr * NewExpr
    | Neg of NewExpr
    | Square of NewExpr
    | Sqrt of NewExpr
with 
    member this.ToDump() = sprintf "%A" this
    
    


let read() = 
    [ 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) |> Array.toList
            // The first token is the output variable name, second is the operation, remaining are arguments.
            let outName::op::args = parts
//            yield outName, op, args 

            let (|V|) k = k
            let (|Float|) s = float s
            
            
            match op, args with
            | "var-x", [] -> 
                yield (outName, VarX)
            | "var-y", [] -> 
                yield (outName, VarY)
            | "const", [Float(a)] -> 
                yield (outName, Const a)
            | "add", [ V(a); V(b) ] ->
                yield (outName, Add(Var a, Var b))
            | "sub", [ V(a); V(b) ] ->
                yield (outName, Sub(Var a, Var b))
            | "mul", [ V(a); V(b) ] ->
                yield (outName, Mul(Var a, Var b))
            | "max", [ V(a); V(b) ] ->
                yield (outName, Max(Var a, Var b))
            | "min", [ V(a); V(b) ] ->
                yield (outName, Min(Var a, Var b))
            | "neg", [ V(a) ] ->
                yield (outName, Neg(Var a))
            | "square", [ V(a) ] ->
                yield (outName, Square(Var a))
            | "sqrt", [ V(a) ] ->
                yield (outName, Sqrt(Var a))

            ]

let toMermaid(list) = 
    let def n t = sprintf "\t%s[\"%s\"]" n t
    let conn a b = sprintf "\t%s --> %s" a b
    list |> List.collect (
    fun x -> [ match x with
                | (outName, VarX) -> yield def outName "var-x"
                | (outName, VarY) -> yield def outName "var-y"
                | (outName, Const a) -> 
                    yield def outName (string a)
                | (outName, Add(Var a, Var b)) -> 
                    yield def outName (string "add")
                    yield conn a outName
                    yield conn b outName
                | (outName, Sub(Var a, Var b)) -> 
                    yield def outName (string "sub")
                    yield conn a outName
                    yield conn b outName                
                | (outName, Mul(Var a, Var b)) -> 
                    yield def outName (string "mul")
                    yield conn a outName
                    yield conn b outName                                
                | (outName, Max(Var a, Var b)) -> 
                    yield def outName (string "max")
                    yield conn a outName
                    yield conn b outName                                
                | (outName, Min(Var a, Var b)) -> 
                    yield def outName (string "min")
                    yield conn a outName
                    yield conn b outName                                
                | (outName, Neg(Var a)) -> 
                    yield def outName (string "neg")
                    yield conn a outName
                | (outName, Square(Var a)) -> 
                    yield def outName (string "square")
                    yield conn a outName
                | (outName, Sqrt(Var a)) -> 
                    yield def outName (string "sqrt")
                    yield conn a outName
                ])
                
    
printfn "flowchart RL"

read() 
    |> toMermaid
    |> List.truncate 500
    |> String.concat "\n"
//    |> List.rev 
    |> Dump

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)