this is a lofi representation of images for experimenting in F#

AsciiPixels.fsx

#load "FsSampleImage.fsx"

open System.Collections.Generic
open FsSampleImage

let rows<'T> (samples: Map<Index,'T>) = 
    samples                     // extracts rows of samples from the "image" Map
    |> Seq.sortBy (fun samp -> samp.Key.x)
    |> Seq.groupBy (fun samp -> samp.Key.y)
    |> Seq.map snd

let formatRow<'T> (delim:string)    // format a row for a map, given a formatting function
        (formatFunc:KeyValuePair<Index,'T>->string) 
        (samplesInRow: KeyValuePair<Index,'T> seq) =
    System.String.Join(delim, 
        samplesInRow 
        |> Seq.sortBy (fun samp -> samp.Key.x)
        |> Seq.map formatFunc)

let floatSampleFormat               // basic float formatting
        (samp:KeyValuePair<Index,float>) = 
    sprintf "%f" samp.Value

let normalizationFunc (samples:seq<float>) =
    let max = samples |> Seq.max
    let min = samples |> Seq.min
    (fun x -> (x - min) / (max - min))      // helper to produce a normalizing function

// for the AsciiPixels, use a set of strings for each pixel value
let pixelStrings = [| "   "; " . "; "..."; ".:."; ":::"; ":|:"; "|||" |];

let floatAsciiPixels 
        (normalize:float->float)
        (samp:KeyValuePair<Index,float>) =
    let pixelIndex = normalize(samp.Value) * (float (pixelStrings.Length-1))
    pixelStrings.[int pixelIndex]           // give the pixel string for the normalized value

FsSampleImage.fsx

open System
open System.Collections.Generic

type Index(at:int*int) =    // this is the basic Index class that will help in keeping track of image pixels
    interface IComparable with
        member this.CompareTo (other:obj) = 
            match other with
            | :? Index as otherIndex -> 
                match this.y.CompareTo(otherIndex.y) with
                | 0 -> this.x.CompareTo(otherIndex.x)
                | yComparison -> yComparison
            | _ -> raise (new Exception("unsupported comparison"))
    member this.x = fst at
    member this.y = snd at
    static member (+) (l : Index, r : Index) = Index(l.x + r.x, l.y + r.y)
    static member (-) (l : Index, r : Index) = Index(l.x - r.x, l.y - r.y)
    override this.Equals (other:obj) = 
        match other with
        | :? Index as otherIndex -> 
            (this.x = otherIndex.x && this.y = otherIndex.y)
        | _ -> false
    override this.GetHashCode () = 
        (this.x, this.y).GetHashCode()
    override this.ToString() = sprintf "<%d,%d>" this.x this.y

let domain (sz:int) =       // construct a sequence of Index that are a given sized square
    ( seq { -sz..sz }, seq { -sz..sz } )
    ||> Seq.allPairs 
    |> Seq.map (fun at -> Index(at))

let fromFunc<'T> (func:Index->'T) (domain:Index seq) =
    domain                  // construct an "image" as a Map<Index,'T>, given a function to populate
    |> Seq.map (fun pos -> (pos, func(pos)))
    |> Map.ofSeq

let sampleValues<'U,'T when 'U : comparison> (map:Map<'U,'T>) =
    map                     // from an "image" Map<Index,'T>, extract the values (i.e. of type 'T)
    |> Seq.map (fun kvp -> kvp.Value)

Image.fsx

open System
open System.Collections.Generic

type Index(at:int*int) =
    interface IComparable with
        member this.CompareTo (other:obj) = 
            match other with
            | :? Index as otherIndex -> 
                match this.y.CompareTo(otherIndex.y) with
                | 0 -> this.x.CompareTo(otherIndex.x)
                | yComparison -> yComparison
            | _ -> raise (new Exception("unsupported comparison"))
    member this.x = fst at
    member this.y = snd at
    static member (+) (l : Index, r : Index) = Index(l.x + r.x, l.y + r.y)
    static member (-) (l : Index, r : Index) = Index(l.x - r.x, l.y - r.y)
    override this.Equals (other:obj) = 
        match other with
        | :? Index as otherIndex -> 
            (this.x = otherIndex.x && this.y = otherIndex.y)
        | _ -> false
    override this.GetHashCode () = 
        (this.x, this.y).GetHashCode()
    override this.ToString() = sprintf "<%d,%d>" this.x this.y

let domain (sz:int) = 
    ( seq { -sz..sz }, seq { -sz..sz } )
    ||> Seq.allPairs 
    |> Seq.map (fun at -> Index(at))

let fromFunc<'T> (func:Index->'T) (domain:Index seq) =
    domain 
    |> Seq.map (fun pos -> (pos, func(pos)))
    |> Map.ofSeq

let sampleValues<'U,'T when 'U : comparison> (map:Map<'U,'T>) =
    map |> Seq.map (fun kvp -> kvp.Value)

let rows<'T> (samples: Map<Index,'T>) = 
    samples 
    |> Seq.sortBy (fun samp -> samp.Key.x)
    |> Seq.groupBy (fun samp -> samp.Key.y)
    |> Seq.map snd

let formatRow<'T> (delim:string) 
        (formatFunc:KeyValuePair<Index,'T>->string) 
        (samplesInRow: KeyValuePair<Index,'T> seq) =
    System.String.Join(delim, 
        samplesInRow 
        |> Seq.sortBy (fun samp -> samp.Key.x)
        |> Seq.map formatFunc)

let floatSampleFormat 
        (samp:KeyValuePair<Index,float>) = 
    sprintf "%f" samp.Value

let normalizationFunc (samples:float seq) =
    let max = samples |> Seq.max
    let min = samples |> Seq.min
    (fun x -> (x - min) / (max - min))

let pixelStrings = [| "   "; " . "; "..."; ".:."; ":::"; ":|:"; "|||" |];

let floatAsciiPixels 
        (normalize:float->float)
        (samp:KeyValuePair<Index,float>) =
    let pixelIndex = normalize(samp.Value) * (float (pixelStrings.Length-1))
    pixelStrings.[int pixelIndex]



let sqMap = 
    let sq (at:Index) = 
        float (at.x * at.x + at.y * at.y)
    domain 3 |> fromFunc sq

sqMap |> rows |> Seq.map (sprintf "%A")
|> Seq.iter (printfn "[%s]")

sqMap |> rows |> Seq.map (formatRow "|" floatSampleFormat)
|> Seq.iter (printfn "[%s]")

sqMap |> rows 
|> Seq.map 
    (formatRow "" 
        (sqMap |> sampleValues |> normalizationFunc |> floatAsciiPixels))
|> Seq.iter (printfn "[%s]")



let gaussMap = 
    let gaussFunction (sigma:double) (at:Index) = 
        exp(float -(at.x * at.x + at.y * at.y) / (sigma * sigma))
    domain 6 |> fromFunc (gaussFunction 4.0)

gaussMap |> rows 
|> Seq.map 
    (formatRow "" 
        (gaussMap |> sampleValues |> normalizationFunc |> floatAsciiPixels))
|> Seq.iter (printfn "[%s]")

ImageFilters.fsx

type ImageFunc = int->int->float

(* create rectangle function *)
let rectangle width x y = 
    if -width<x && x<width && -width<y && y<width then 1.0 else 0.0

(* create circle function *)
let circle radius x y = 
    if (x*x + y*y) < radius*radius then 1.0 else 0.0

(* create gauss function *)
let gauss sigma x y = exp(float -(x*x + y*y) / (float sigma * sigma))

(* create gabor function *)
let gabor sigma kx ky x y = 
    (gauss sigma x y) * cos((float x)*kx + (float y)*ky)

(* create parabolic function *)
let parab x y = float (x*x + y*y)

(* decimate operator *)
let decimate image = fun x y -> (image (x*2) (y*2))

(* expand operator *)
let expand image = fun x y -> (image (x/2) (y/2))

(* convolve operator *)
let convolve kSize (kernel:ImageFunc) (image:ImageFunc) x y =
    (seq {-kSize..kSize}, seq {-kSize..kSize})
    ||> Seq.allPairs
    |> Seq.map (fun (kx,ky) -> (kernel kx ky) * (image (x+kx) (y+ky)))
    |> Seq.sum

(* ascii image output *)
let asciiImage range (image:ImageFunc) =
    let range1dSeq = seq {-range..range}
    let range2dSeq = (range1dSeq, range1dSeq) ||> Seq.allPairs
    let values = range2dSeq |> Seq.map (fun (x,y) -> image x y)
    let asciiPixel value = 
        let asciiPixelArray = [|"   "; " . "; " .."; "..."; "..:"; ".::"; ":::"|]
        let min = values |> Seq.min
        let max = values |> Seq.max
        let index = (value - min) / (max - min) * float (asciiPixelArray.Length-1)
        asciiPixelArray.[int index]
    range1dSeq
    |> Seq.map (fun row -> 
            System.String.Join("", 
                range1dSeq |> Seq.map (fun column -> asciiPixel(image column row))))
    |> Seq.iter (printf "%s\n")

Som.fsx

module Som

type Vector2D = 
    { x:float; y:float }
    static member (+) (l, r) = {x = l.x+r.x; y = l.y+r.y}
    static member (-) (l, r) = {x = l.x-r.x; y = l.y-r.y}

type VectorND = 
    { value: array<float> }
    member this.lengthSq = (this.value,this.value) ||> Array.map2 (*) |> Array.sum
    member this.Item(i) = this.value.[i]
    static member (+) (l, r) = { value = (l.value, r.value) ||> Array.map2 (+) }
    static member (-) (l, r) = { value = (l.value, r.value) ||> Array.map2 (-) }

(* test + for VectorND
let v = {value=[|0.0;1.0;2.0|]}
let u = {value=[|3.0;4.0;5.0|]}
v+u 
*)

type UnitNode =
    { pos:Vector2D; target:VectorND; }
    member this.distToValue (value:VectorND) = (value - target).lengthSq
    member this.distToNode ({pos=otherPos}) = this.pos - otherPos 

let createSom sz (init:int->int->VectorND) = 
    (seq {0..sz}, seq {0..sz}) 
    ||> Seq.allPairs 
    |> Seq.map (fun (x,y) ->
        {pos = {x=float x;y=float y}; 
            target = init x y})
            
type ImageFunc = int->int->float


(* ascii image output *)
let asciiImage range (image:ImageFunc) =
    let range1dSeq = seq {-range..range}
    let range2dSeq = (range1dSeq, range1dSeq) ||> Seq.allPairs
    let values = range2dSeq |> Seq.map (fun (x,y) -> image x y)
    let asciiPixel value = 
        let asciiPixelArray = [|"   "; " . "; " .."; "..."; "..:"; ".::"; ":::"|]
        let min = values |> Seq.min
        let max = values |> Seq.max
        let index = (value - min) / (max - min) * float (asciiPixelArray.Length-1)
        asciiPixelArray.[int index]
    range1dSeq
    |> Seq.map (fun row -> 
            System.String.Join("", 
                range1dSeq |> Seq.map (fun column -> asciiPixel(image column row))))
    |> Seq.iter (printf "%s\n")

let printSom n som =
    fun x y ->
        som 
        |> Seq.tryFind (fun node -> int node.pos.x = x && int node.pos.y = y) 
        |> function 
            | Some node -> node.target.[n]
            | None -> 0.0
    |> asciiImage 10


(* example: sawtooth 5.0 for period of 5*)
let sawtooth period x y =
    let fy = float y
    let period = 5.0
    let depth = fy - period*floor(fy/period)
    {value = [|float x; float y; depth|]}
(* seq {0..30} |> Seq.map (sawtooth 5.0 1) |> Seq.iter (fun {value=[|_;_;z|]} -> printfn "%f" z) *)

let gauss sigma weight (at:VectorND) (vector:VectorND) = 
    let distSq = (at - vector).lengthSq
    exp(-distSq/sigma**2.0)
    
let induce (image:ImageFunc) (som:seq<UnitNode>) (at:VectorND)=
    som
    |> Seq.map (fun {pos={x=x;y=y};target=target} ->
        let weight = image (int x) (int y)
        gauss 5.0 weight target at)
    |> Seq.sum
 

sawtooth 5.0 
|> createSom 10
|> printSom 2