Kean专题(4)—Concurrent_Programming

// Use lightweight F# syntax
#light
// Declare a specific namespace and module name
module MyNamespace.MyApplication
// Import managed assemblies
#I @"C:\Program Files\Autodesk\AutoCAD 2008"
#r "acdbmgd.dll"
#r "acmgd.dll"
open Autodesk.AutoCAD.Runtime
open Autodesk.AutoCAD.ApplicationServices
open Autodesk.AutoCAD.DatabaseServices
open Autodesk.AutoCAD.Geometry
open System.Xml
open System.Collections
open System.Collections.Generic
open System.IO
open System.Net
open Microsoft.FSharp.Control.CommonExtensions
// The RSS feeds we wish to get. The first two values are
// only used if our code is not able to parse the feed's XML
let feeds =
  [ ("Through the Interface",
     "http://blogs.autodesk.com/through-the-interface",
     "http://through-the-interface.typepad.com/through_the_interface/rss.xml");
     
    ("Don Syme's F# blog",
     "http://blogs.msdn.com/dsyme/",
     "http://blogs.msdn.com/dsyme/rss.xml");
    
    ("Shaan Hurley's Between the Lines",
     "http://autodesk.blogs.com/between_the_lines",
     "http://autodesk.blogs.com/between_the_lines/rss.xml");
    
    ("Scott Sheppard's It's Alive in the Lab",
     "http://blogs.autodesk.com/labs",
     "http://labs.blogs.com/its_alive_in_the_lab/rss.xml");
    
    ("Lynn Allen's Blog",
     "http://blogs.autodesk.com/lynn",
     "http://lynn.blogs.com/lynn_allens_blog/index.rdf");
    ("Heidi Hewett's AutoCAD Insider",
     "http://blogs.autodesk.com/autocadinsider",
     "http://heidihewett.blogs.com/my_weblog/index.rdf") ]
// Fetch the contents of a web page, asynchronously
let httpAsync(url:string) = 
  async { let req = WebRequest.Create(url) 
          use! resp = req.GetResponseAsync()
          use stream = resp.GetResponseStream() 
          use reader = new StreamReader(stream) 
          return reader.ReadToEnd() }
// Load an RSS feed's contents into an XML document object
// and use it to extract the titles and their links
// Hopefully these always match (this could be coded more
// defensively)
let titlesAndLinks (name, url, xml) =
  let xdoc = new XmlDocument()
  xdoc.LoadXml(xml)
  let titles =
    [ for n in xdoc.SelectNodes("//*[name()='title']")
        -> n.InnerText ]
  let links =
    [ for n in xdoc.SelectNodes("//*[name()='link']") ->
        let inn = n.InnerText
        if  inn.Length > 0 then
          inn
        else
          let href = n.Attributes.GetNamedItem("href").Value
          let rel = n.Attributes.GetNamedItem("rel").Value
          if href.Contains("feedburner") then
              ""
          else
            href ]
          
  let descs =
    [ for n in xdoc.SelectNodes
        ("//*[name()='description' or name()='content' or name()='subtitle']")
          -> n.InnerText ]
  // A local function to filter out duplicate entries in
  // a list, maintaining their current order.
  // Another way would be to use:
  //    Set.of_list lst |> Set.to_list
  // but that results in a sorted (probably reordered) list.
  let rec nub lst =
    match lst with
    | a::[] -> [a]
    | a::b ->
      if a = List.hd b then
        nub b
      else
        a::nub b
    | [] -> []
  // Filter the links to get (hopefully) the same number
  // and order as the titles and descriptions
  let real = List.filter (fun (x:string) -> x.Length > 0)  
  let lnks = real links |> nub
  // Return a link to the overall blog, if we don't have
  // the same numbers of titles, links and descriptions
  let lnum = List.length lnks
  let tnum = List.length titles
  let dnum = List.length descs
  
  if tnum = 0 || lnum = 0 || lnum  tnum || dnum  tnum then
    [(name,url,url)]
  else
    List.zip3 titles lnks descs
// For a particular (name,url) pair,
// create an AutoCAD HyperLink object
let hyperlink (name,url,desc) =
  let hl = new HyperLink()
  hl.Name ]
let createHyperlinksFromRss() =
  
  // Let's get the usual helpful AutoCAD objects
  
  let doc =
    Application.DocumentManager.MdiActiveDocument
  let db = doc.Database
  // "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
  
  // Add text objects linking to the provided list of
  // HyperLinks, starting at the specified location
  
  // Note the valid use of tr and ms, as they are in scope
  let addTextObjects pt lst =
    // Use a for loop, as we care about the index to
    // position the various text items
    let len = List.length lst
    for index = 0 to len - 1 do 
      let txt = new DBText()
      let (name:string,hl:HyperLink) = List.nth lst index
      txt.TextString  ignore
      tr.AddNewlyCreatedDBObject(txt,true)
      txt.Hyperlinks.Add(hl) |> ignore
  // Here's where we do the real work, by firing
  // off - and coordinating - asynchronous tasks
  // to create HyperLink objects for all our posts
  let links =
    Async.Run
      (Async.Parallel
        [ for (name,url,feed) in feeds ->
          hyperlinksAsync (name,url,feed) ]) 
  // Add the resulting objects to the model-space  
  let len = Array.length links
  for index = 0 to len - 1 do
    // This is where you can adjust:
    //  the column spacing (x value)
    //  the vertical offset from origin (y axis)
    let pt =
      new Point3d
        (15.0 * (Int32.to_float index),
         30.0,
         0.0)
    addTextObjects pt (Array.get links index)
 
  tr.Commit()

A few comments on the changes:
Lines 57-62 define our new httpAsync() function, which uses GetResponseAsync() - a function exposed in F# 1.9.3.7 - to download the contents of a web-page asynchronously [and which I stole shamelessly from Don Syme, who presented the code last summer at Microsoft's TechEd].
Lines 141-144 define another asynchronous function, hyperlinksAsync(), which calls httpAsync() and then - as before - extracts the feed information and creates a corresponding list of HyperLinks. This is significant: creation of AutoCAD HyperLink objects will be done on parallel; it is the addition of these objects to the drawing database that needs to be performed serially.
Lines 214-217 replace our very simple "map" with something slightly more complex: this code runs a list of tasks in parallel and waits for them all to complete before continuing. What is especially cool about this implementation is the fact that exceptions in individual tasks result in the overall task failing (a good thing, believe it or not :-), and the remaining tasks being terminated gracefully.
Lines 221 and 233 change our code to handle an array, rather than a list (while "map" previously returned a list, Async.Run returns an array).
When run, the code creates exactly the same thing as last time (although there are a few more posts in some of the blogs ;-)

pttnzcjp4kr.png

A quick word on timing: I used "F# Interactive" to do a little benchmarking on my system, and even though it's single-core, single-processor, there was a considerable difference between the two implementations. I'll talk more about F# Interactive at some point, but think of it to F# in Visual Studio as the command-line is to LISP in AutoCAD: you can very easily test out fragments of F#, either by entering them directly into the F# Interactive window or highlighting them in Visual Studio's text editor and hitting Alt-Enter.
To enable function timing I entered "#time;;" (without the quotations marks) in the F# Interactive window. I then selected and loaded the supporting functions needed for each test - not including the code that adds the DBText objects with their HyperLinks to the database, as we're only in Visual Studio, not inside AutoCAD - and executed the "let links = ..." assignment in our two implementations of the createHyperlinksFromRss() function (i.e. the RSS command). These functions do create lists of AutoCAD HyperLinks, but that's OK: this is something works even outside AutoCAD, although we wouldn't be able to do anything much with them. Also, the fact we're not including the addition of the entities to the AutoCAD database is not relevant: by then we should have identical data in both versions, which would be added in exactly the same way.
Here are the results:复制代码

// Use lightweight F# syntax
#light
// Declare a specific namespace and module name
module Grapher.Commands
// Import managed assemblies
open Autodesk.AutoCAD.Runtime
open Autodesk.AutoCAD.ApplicationServices
open Autodesk.AutoCAD.DatabaseServices
open Autodesk.AutoCAD.Geometry
// Define a common normalization function which makes sure
// our graph gets mapped to our grid
let normalize fn normFn x minInp maxInp maxOut =
  let res =
    fn ((maxInp - minInp) * x / maxOut)
  let normRes = normFn res
  if normRes >= 0.0 && normRes ]
let gridCommand() =
  // We'll time the command, so we can check the
  // sync vs. async efficiency
  let starttime = System.DateTime.Now
  // Let's get the usual helpful AutoCAD objects
  let doc =
    Application.DocumentManager.MdiActiveDocument
  let ed = doc.Editor
  let db = doc.Database
  // "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  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 size rad offset =
    let ids = new ObjectIdCollection()
    for i = 0 to size - 1 do
      for j = 0 to size - 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 col (id : ObjectId) =
    if id.IsValid then
      let ent =
        tr.GetObject(id, OpenMode.ForWrite) :?> Entity
      ent.ColorIndex = 0 then
        (i * size) + res
    else
        -1
  // Apply our function synchronously for each value of x
  let applySyncBelowMax size fn =
    [| for i in [0..size-1] ->
       getIndex fn size i |]
  // Apply our function asynchronously for each value of x
  let applyAsyncBelowMax size fn =
    Async.Run
      (Async.Parallel
        [ for i in [0..size-1] ->
          async { return getIndex fn size i } ]) 
  // Hardcode the size of the grid and create it
  let size = 50
  let ids = createGrid size 0.5 1.2
  // Make the circles all red to start with
  Seq.iter makeRed (Seq.cast ids)
  // From a certain index in the list, get an object ID
  let getId i =
    if i >= 0 then
      ids.[i]
    else
      ObjectId.Null
  // Apply one of our trig functions, synchronously or
  // otherwise, to our grid
  applySyncBelowMax size normSin |>
    Array.map getId |>
      Array.iter makeYellow
  // 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())

Here's what you see on AutoCAD's drawing canvas when you run the GRAPH command as it stands:

glkq3g02x1y.png

If you want to play around with other functions, you can edit the call to applySyncBelowMax to pass normCos or normTan instead of normSin.

52le4ef4m2z.png

fsemrlqryvx.png

As I mentioned earlier, if you swap the call to be applyAsyncBelowMax instead of applySyncBelowMax you will actually run the mathematics piece as asynchronous tasks. These are CPU-bound operations - they don't call across the network or write to a hard-drive, which might have increased the benefit of calling them asynchronously - so right now the async version actually runs more slowly than the sync version. If I were to have more processing cores available to me, it might also give us more benefit, but right now with my dual-core machine there's more effort spent coordinating the tasks than you gain from the parallelism. But I'll let you play around with that yourselves... you may get better results. One other note on that piece of the code: at some point I'd like to make use of the Parallel Extensions for .NET (in particular the Task Parallel Library (TPL)), but for now I've continued with what I know, the asynchronous worklows capability which is now standard in F#.
I'm travelling in India this week (and working from our Bangalore office next week), so this is likely to be my last post of the week.

// 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) (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) =
  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[]) =
    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[b]) =
    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]  ids.[i] |]
 
// Declare our command
 
[]
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 
        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 
            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  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  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:

ecm321wcx2k.png

In case you're interested, the original image can be found here.

y3ytar1ydrz.jpg