3 people like it.
Like the snippet!

DSL for detecting patterns in 2D

A simple domain specific langauge (DSL) that can be used to specify and recognize patterrns in 2D arrays. A pattern is defined by composing primitive checks, rotating and translating patterns. See also: http://t.co/6Poty4FL

Implementation of the DSL

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36:

/// A type that represents a function that test
/// whether an array contains some pattern at a 
/// specified location. It gets the location to 
/// test & the array as arguments and returns bool.
type ShapeDetector = SD of (int -> int -> int[,] -> bool)

/// A primitive that tests whether the value at the
/// current location contains a value 'v'
let equals v = SD (fun x y arr -> arr.[x,y] = v)

/// A combinator that takes 'ShapeDetector' and 
/// creates a new one that returns 'def' when 
/// accessing outside of the array bounds
let border def (SD f) = SD (fun x y arr -> 
  if x < 0 || y < 0 || x >= arr.GetLength(0) || y >= arr.GetLength(1) 
  then def else f x y arr)

/// A combinator that calls a given ShapeDetector
/// at a location specified by offset dx, dy
let around (dx, dy) (SD f) = SD (fun x y arr ->
  f (x + dx) (y + dy) arr)

/// A combinator that takes a ShapeDetector and
/// builds a new one, which is rotated by 90 degrees
let rotate (SD f) = SD (fun x y arr ->
  f -y x arr)

/// Creates a shape detector that succeeds only
/// when both of the arguments succeed.
let (<&>) (SD f1) (SD f2) = SD (fun x y arr ->
  f1 x y arr && f2 x y arr)

/// Creates a shape detector that succeeds 
/// when either of the arguments succeed.
let (<|>) (SD f1) (SD f2) = SD (fun x y arr ->
  f1 x y arr || f2 x y arr)

Sample pattern detector

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22:

// We want to detect patterns that look like this
// (with any rotation in any place of an array):
// 
//   X - -
//   - X X
//

// Create a detector that tests if a location
// contains 1 and returns 'false' when out of range
let one = border false (equals 1)

// A shape detector for your pattern
let pattern = 
  around (0, 0) one <&> around (1, 0) one <&> 
  around (-1, 1) one

// Test pattern with any rotation: Combine 
// 4 possible rotations with logical or.
let any = 
  pattern <|> rotate pattern <|> 
  rotate (rotate pattern) <|> 
  rotate (rotate (rotate pattern))

Run the pattern detector on a sample input

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12:

// Create a 2D array as a sample input
let inp = 
  array2D [ [ 0; 0; 1 ]
            [ 0; 1; 0 ]
            [ 0; 1; 0 ] ]

// Get the underlying function and run it
// for all possible indices in the array
let (SD f) = any
for x in 0 .. 2 do
  for y in 0 .. 2 do
    printfn "%A %A" (x, y) (f x y inp)

union case ShapeDetector.SD: (int -> int -> int [,] -> bool) -> ShapeDetector

Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>

type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool

val equals : v:int -> ShapeDetector

Full name: Script.equals

A primitive that tests whether the value at the
current location contains a value 'v'

val v : int

val x : int

val y : int

val arr : int [,]

val border : def:bool -> ShapeDetector -> ShapeDetector

Full name: Script.border

A combinator that takes 'ShapeDetector' and
creates a new one that returns 'def' when
accessing outside of the array bounds

val def : bool

val f : (int -> int -> int [,] -> bool)

System.Array.GetLength(dimension: int) : int

val around : dx:int * dy:int -> ShapeDetector -> ShapeDetector

Full name: Script.around

A combinator that calls a given ShapeDetector
at a location specified by offset dx, dy

val dx : int

val dy : int

val rotate : ShapeDetector -> ShapeDetector

Full name: Script.rotate

A combinator that takes a ShapeDetector and
builds a new one, which is rotated by 90 degrees

val f1 : (int -> int -> int [,] -> bool)

val f2 : (int -> int -> int [,] -> bool)

val one : ShapeDetector

Full name: Script.one

val pattern : ShapeDetector

Full name: Script.pattern

val any : ShapeDetector

Full name: Script.any

val inp : int [,]

Full name: Script.inp

val array2D : rows:seq<#seq<'T>> -> 'T [,]

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.array2D

val f : (int -> int -> int [,] -> bool)

Full name: Script.f

val x : int32

val y : int32

val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn

Raw view Test code New version

More information

Link:	http://fssnip.net/dI
Posted:	11 years ago
Author:	Tomas Petricek
Tags:	dsl , stackoverflow , introduction , pattern matching , array2d