Parallelized pixelization inside AutoCAD using F#

As promised in the last post, we're now going to look at how to change the code to make the colour averaging routine work in parallel. The overall performance is marginally better on my dual-core machine, but I fully expect it to get quicker and quicker as the number of cores multiply.

To start with, though, here's the modified "synchronous" version of the code - as I went through making the code work in parallel, I noticed a bunch of general enhancements that were applicable to both versions. Here's the updated F# code:

// Use lightweight F# syntax
 
#light
 
// Declare a specific namespace and module name
 
module SyncPixelizer.Commands
 
// Import managed assemblies
 
#nowarn "9" // ... because we're using NativePtr
 
open Autodesk.AutoCAD.Runtime
open Autodesk.AutoCAD.ApplicationServices
open Autodesk.AutoCAD.DatabaseServices
open Autodesk.AutoCAD.EditorInput
open Autodesk.AutoCAD.Geometry
open Autodesk.AutoCAD.Colors
open System.Drawing.Imaging
open Microsoft.FSharp.NativeInterop
 
// Add up the RGB values of a list of pixels
 
// We use a recursive function with an accumulator argument,
// (rt, gt, bt), to allow tail call optimization
 
let rec sumColors (pix : List<(byte*byte*byte)>) (rt,gt,bt) =
  match pix with
    | [] -> (rt, gt, bt)
    | (r, g, b) :: tl ->
        sumColors tl
          (rt + Byte.to_int r,
          gt + Byte.to_int g,
          bt + Byte.to_int b)
 
// Average out the RGB values of a list of pixels
 
let getAverageColour (pixels : List<(byte*byte*byte)>) =
  let (rsum, gsum, bsum) =
    sumColors pixels (0, 0, 0)
  let count = pixels.Length
  let ravg = Byte.of_int (rsum / count)
  let gavg = Byte.of_int (gsum / count)
  let bavg = Byte.of_int (bsum / count)
 
  // For some reason the pixel needs ro be reversed - probably
  // because of the bitmap format (needs investigation)
 
  Color.FromRgb(bavg, gavg, ravg)
 
// Function to get an index into our flat array
// from an x,y pair
 
let getIndexFromXY ysize x y =
  (x * ysize) + y
 
//  Get a chunk of pixels to average from one row
 
// We use a recursive function with an accumulator argument
// to allow tail call optimization
 
let rec getChunkRowPixels p xsamp acc =
  if xsamp = 0 then
    acc
  else
    let pix =
      [(NativePtr.get p 0,
        NativePtr.get p 1,
        NativePtr.get p 2)]
    let p = NativePtr.add p 3 // We do *not* mutate here
    getChunkRowPixels p (xsamp-1) (pix @ acc)
 
// Get a chunk of pixels to average from multiple rows
 
// We use a recursive function with an accumulator argument
// to allow tail call optimization
 
let rec getChunkPixels p stride xsamp ysamp acc =
  if ysamp = 0 then
    acc
  else
    let pix = getChunkRowPixels p xsamp []
    let p = NativePtr.add p stride  // We do *not* mutate here
    getChunkPixels p stride xsamp (ysamp-1) (pix @ acc)
 
// Get the various chunks of pixels to average across
// a complete bitmap image
 
let pixelizeBitmap (image:System.Drawing.Bitmap) xsize ysize =
 
  // Create a 1-dimensional array of pixel lists (one list,
  // which then needs averaging, per final pixel)
 
  let (arr : List<(byte*byte*byte)>[]) =
    Array.create (xsize * ysize) []
 
  // Lock the entire memory block related to our image
 
  let bd =
    image.LockBits
      (System.Drawing.Rectangle
        (0, 0, image.Width ,image.Height),
      ImageLockMode.ReadOnly, image.PixelFormat)
 
  // Establish the number of pixels to sample per chunk
  // in each of the x and y directions
 
  let xsamp = image.Width / xsize
  let ysamp = image.Height / ysize
 
  // We have a mutable pointer to step through the image
 
  let mutable (p:nativeptr<byte>) =
    NativePtr.of_nativeint (bd.Scan0)
 
  // Loop through the various chunks
 
  for i = 0 to ysize - 1 do
 
    // We take a copy of the current value of p, as we
    // don't want to mutate p while extracting the pixels
    // within a row
 
    let mutable xp = p
    for j = 0 to xsize - 1 do
 
      // Get the square chunk of pixels starting at
      // this x,y position
 
      let chk =
        getChunkPixels xp bd.Stride xsamp ysamp []
 
      // Add it into our array
 
      let idx = getIndexFromXY ysize j (ysize-1-i)
      arr.[idx] <- chk
 
      // Mutate the pointer to move along to the right
      // by a value of 3 (our RGB value) times the
      // number of pixels we're sampling in x
 
      xp <- NativePtr.add xp (xsamp * 3)
    done
 
    // Mutate the original p pointer to move on one row
 
    p <- NativePtr.add p (bd.Stride * ysamp)
  done
 
  // Finally unlock the bitmap data and return the array
 
  image.UnlockBits(bd)
  arr
 
// Create an array of ObjectIds from a collection
 
let getIdArray (ids : ObjectIdCollection) =
  [| for i in [0..ids.Count-1] -> ids.[i] |]
 
// Declare our command
 
[<CommandMethod("pix")>]
let pixelize() =
 
  // Let's get the usual helpful AutoCAD objects
 
  let doc =
    Application.DocumentManager.MdiActiveDocument
  let ed = doc.Editor
  let db = doc.Database
 
  // Prompt the user for the file and the width of the image
 
  let pofo =
    new PromptOpenFileOptions
      ("Select an image to import and pixelize")
  pofo.Filter <-
    "Jpeg Image (*.jpg)|*.jpg|All files (*.*)|*.*"
  let pfnr = ed.GetFileNameForOpen(pofo)
 
  let file =
    match pfnr.Status with
    | PromptStatus.OK ->
        pfnr.StringResult
    | _ ->
        ""
 
  if System.IO.File.Exists(file) then
 
    let img = System.Drawing.Image.FromFile(file)
 
    let pio =
      new PromptIntegerOptions
        ("\nEnter number of horizontal pixels: ")
    pio.AllowNone <- true
    pio.UseDefaultValue <- true
    pio.LowerLimit <- 1
    pio.UpperLimit <- img.Width
    pio.DefaultValue <- 100
 
    let pir = ed.GetInteger(pio)
    let xsize =
      match pir.Status with
        | PromptStatus.None ->
            img.Width
        | PromptStatus.OK ->
            pir.Value
        | _ -> -1
 
    if xsize > 0 then
 
      // Calculate the vertical size from the horizontal
 
      let ysize = img.Height * xsize / img.Width
 
      if ysize > 0 then
 
        // We'll time the command, so we can check the
        // sync vs. async efficiency
 
        let starttime = System.DateTime.Now
 
        // "use" has the same effect as "using" in C#
 
        use tr =
          db.TransactionManager.StartTransaction()
 
        // Get appropriately-typed BlockTable and BTRs
 
        let bt =
          tr.GetObject
            (db.BlockTableId,OpenMode.ForRead)
          :?> BlockTable
 
        let ms =
          tr.GetObject
            (bt.[BlockTableRecord.ModelSpace],
            OpenMode.ForWrite)
          :?> BlockTableRecord
 
        // Function to create a filled circle (hatch) at a
        // specific location
 
        // Note the valid use of tr and ms, as they are in scope
 
        let createCircle pt rad =
          let hat = new Hatch()
          hat.SetDatabaseDefaults()
          hat.SetHatchPattern
            (HatchPatternType.PreDefined,
            "SOLID")
 
          let id = ms.AppendEntity(hat)
          tr.AddNewlyCreatedDBObject(hat, true)
 
          // Now we create the loop, which we make db-resident
          // (appending a transient loop caused problems, so
          // we're going to use the circle and then erase it)
 
          let cir = new Circle()
          cir.Radius <- rad
          cir.Center <- pt
 
          let lid = ms.AppendEntity(cir)
          tr.AddNewlyCreatedDBObject(cir, true)
 
          // Have the hatch use the loop we created
 
          let loops = new ObjectIdCollection()
          loops.Add(lid) |> ignore
          hat.AppendLoop(HatchLoopTypes.Default, loops)
          hat.EvaluateHatch(true)
 
          // Now we erase the loop
 
          cir.Erase()
          id
 
        // Function to create our grid of circles
 
        let createGrid xsize ysize rad offset =
          let ids = new ObjectIdCollection()
          for i = 0 to xsize - 1 do
            for j = 0 to ysize - 1 do
              let pt =
                new Point3d
                  (offset * (Int32.to_float i),
                   offset * (Int32.to_float j),
                   0.0)
              let id = createCircle pt rad
              ids.Add(id) |> ignore
          ids
 
        // Function to change the colour of an entity
 
        let changeColour (id : ObjectId) (col : Color) =
          if id.IsValid then
            let ent =
              tr.GetObject(id, OpenMode.ForWrite) :?> Entity
            ent.Color <- col
 
        // Create our basic grid
 
        let ids = createGrid xsize ysize 0.5 1.2
 
        // Cast our image to a bitmap and then
        // get the chunked pixels
 
        let bmp = img :?> System.Drawing.Bitmap
        let arr = pixelizeBitmap bmp xsize ysize
 
        // Loop through the pixel list and average them out
        // (which could be parallelized), using the results
        // to change the colour of the circles in our grid
 
        Array.map getAverageColour arr |>
          Array.iter2 changeColour (getIdArray ids)
 
        // Commit the transaction
 
        tr.Commit()
 
        // Check how long it took
 
        let elapsed =
          System.DateTime.op_Subtraction
            (System.DateTime.Now, starttime)
 
        ed.WriteMessage
          ("\nElapsed time: " + elapsed.ToString())

To change this to run the colour averaging asynchronously (in parallel, if you have the cores) is really simple. We replace one line of code "Array.map getAverageColour arr" with the following:

Async.Run
  (Async.Parallel
    [ for a in arr ->
        async { return getAverageColour a }])

This essentially performs a parallel array map (albeit a somewhat naive one), returning basically the same results as the previous line - just hopefully a little more quickly. In case you want to build the two files into one project to test them side-by-side, here they are, the synchronous and asynchronous versions, with the changes needed to allow them to live in and execute from the same assembly.

Here's one more image that's been processed by the PIX command: