Skip to content

Instantly share code, notes, and snippets.

@dg1an3

dg1an3/AsciiPixels.fsx

Last active Dec 20, 2018
Embed
What would you like to do?
this is a lofi representation of images for experimenting in F#
#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
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)
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]")
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")
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment