2 people like it.

Similar string Markov chain

Generates strings that are similar to the input, as measured by the probability of a symbol depending on preceding symbols. (Markov chain) The order, which defines how many preceding symbols to look at before placing another, is variable.

 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: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 

// Generates strings that are similar to the input, as measured by the
// probability of a symbol depending on preceding symbols. (Markov chain)
// The order defines how many preceding symbols to look at to place another.

/// Reads a map of next characters' probabilities from a sample.
let readMap order s =
    s |> Seq.windowed (order + 1)
    |> Seq.groupBy (fun a -> System.String( a.[0 .. order - 1] ))
    |> Seq.map (fun (a, b) ->
        let counted = b |> Seq.countBy (fun a -> a.[order]) |> Seq.toList
        let total = List.sumBy snd counted
        a, counted |> List.map (fun (c, i) -> c, float i / float total))
    |> Map.ofSeq

// System.Random is broken. Replace it if you want reliable randomness.
let random = let r = System.Random() in fun () -> r.NextDouble()

/// Helper to get one character from a list of choices with probabilities
let getChar cases =
    let rec run r = function
        | [] -> failwith "getChar error"
        | (c, p) :: t when r > p -> run (r-p) t
        | (c, _) :: _ -> c
    run (random() * 0.999) cases // precision safety

/// Creates text according to a distribution. Defaults to spaces on unknown cases.
let rec generate order length acc map =
    if length < 1 then System.String(acc |> List.toArray |> Array.rev) else
    let sub = System.String(Seq.truncate order acc |> Seq.toArray |> Array.rev)
    let newChar = match Map.tryFind sub map with
                  | Some l when sub.Length = order -> getChar l
                  | _ -> ' '
    generate order (length - 1) (newChar :: acc) map

/// Generates words from sample. Generates space-separated words independently.
let wordwise order approxLength input =
    let out = (" " + input + " ").Replace(" ", String.replicate order " ")
              |> readMap order |> generate order approxLength []
    out.Replace(String.replicate order " ", " ").Remove(0,1) |> printfn "%s"


// Samples (input a long list of names to get more useful results):

let lolz = "lololololol zomg roflmao"
wordwise 1 60 lolz
wordwise 2 60 lolz

"Mercury Venus Earth Mars Jupiter Saturn Neptune Pluto Moon Terra Luna \
Adrastea Ganymede Callisto Europa Himalia Amalthea Thebe Elara Metis Pasiphae Carme \
Sinope Lysithea Ananke Leda Themisto Callirrhoe Praxidike Megaclite Iocaste Taygete \
Kalyke Autonoe Harpalyke Titan Rhea Iapetus Dione Tethys Enceladus Mimas Hyperion \
Phoebe Janus Epimetheus Prometheus Pandora Titania Oberon Umbriel Ariel Miranda \
Sycorax Puck Portia Juliet Caliban Belinda Cressida Triton Proteus Nereid Larissa \
Galatea Despina Thalassa Charon Phobos Deimos Eros Gaspra Ida Dactyl Mathilde \
Kalliope Linus Eugenia Petit-Prince Io Chaldene Erinome Isonoe Thyone Hermippe Aitne \
Eurydome Euanthe Euporie Orthosie Sponde Kale Pasithee Hegemone Mneme Aoede \
Thelxinoe Arche Kallichore Carpo Eukelade Cyllene Kore Herse Dia Helene Telesto \
Calypso Atlas Pan Ymir Paaliaq Tarvos Ijiraq Suttungr Kiviuq Mundilfari Albiorix Skathi \
Erriapus Siarnaq Thrymr Narvi Methone Pallene Polydeuces Daphnis Aegir Bebhionn \
Bergelmir Bestla Farbauti Fenrir Fornjot Hati Hyrrokkin Kari Loge Skoll Surtur Anthe \
Jarnsaxa Grei Tarqeq Aegaeon Cordelia Ophelia Bianca Cressida Desdemona Juliet \
Portia Rosalind Belinda Puck Caliban Sycorax Prospero Setebos Stephano Trinculo \
Francisco Margaret Ferdinand Perdita Mab Cupid Naiad Halimede Psamathe Sao \
Laomedeja Neso Ceres Nix Hydra Kerberos Styx Haumea Hi’iaka Namaka Eis \
Dysnomia Makemake Pallas Vesta Hygiea"
|> wordwise 2 200
val readMap : order:int -> s:seq<char> -> Map<System.String,(char * float) list>

Full name: Script.readMap


 Reads a map of next characters' probabilities from a sample.
val order : int
val s : seq<char>
module Seq

from Microsoft.FSharp.Collections
val windowed : windowSize:int -> source:seq<'T> -> seq<'T []>

Full name: Microsoft.FSharp.Collections.Seq.windowed
val groupBy : projection:('T -> 'Key) -> source:seq<'T> -> seq<'Key * seq<'T>> (requires equality)

Full name: Microsoft.FSharp.Collections.Seq.groupBy
val a : char []
namespace System
Multiple items
type String =
  new : value:char -> string + 7 overloads
  member Chars : int -> char
  member Clone : unit -> obj
  member CompareTo : value:obj -> int + 1 overload
  member Contains : value:string -> bool
  member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
  member EndsWith : value:string -> bool + 2 overloads
  member Equals : obj:obj -> bool + 2 overloads
  member GetEnumerator : unit -> CharEnumerator
  member GetHashCode : unit -> int
  ...

Full name: System.String

--------------------
System.String(value: nativeptr<char>) : unit
System.String(value: nativeptr<sbyte>) : unit
System.String(value: char []) : unit
System.String(c: char, count: int) : unit
System.String(value: nativeptr<char>, startIndex: int, length: int) : unit
System.String(value: nativeptr<sbyte>, startIndex: int, length: int) : unit
System.String(value: char [], startIndex: int, length: int) : unit
System.String(value: nativeptr<sbyte>, startIndex: int, length: int, enc: System.Text.Encoding) : unit
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.map
val a : System.String
val b : seq<char []>
val counted : (char * int) list
val countBy : projection:('T -> 'Key) -> source:seq<'T> -> seq<'Key * int> (requires equality)

Full name: Microsoft.FSharp.Collections.Seq.countBy
val toList : source:seq<'T> -> 'T list

Full name: Microsoft.FSharp.Collections.Seq.toList
val total : int
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member GetSlice : startIndex:int option * endIndex:int option -> 'T list
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val sumBy : projection:('T -> 'U) -> list:'T list -> 'U (requires member ( + ) and member get_Zero)

Full name: Microsoft.FSharp.Collections.List.sumBy
val snd : tuple:('T1 * 'T2) -> 'T2

Full name: Microsoft.FSharp.Core.Operators.snd
val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
val c : char
val i : int
Multiple items
val float : value:'T -> float (requires member op_Explicit)

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

--------------------
type float = System.Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>
Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  override Equals : obj -> bool
  member Remove : key:'Key -> Map<'Key,'Value>
  ...

Full name: Microsoft.FSharp.Collections.Map<_,_>

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
val ofSeq : elements:seq<'Key * 'T> -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.ofSeq
val random : (unit -> float)

Full name: Script.random
val r : System.Random
Multiple items
type Random =
  new : unit -> Random + 1 overload
  member Next : unit -> int + 2 overloads
  member NextBytes : buffer:byte[] -> unit
  member NextDouble : unit -> float

Full name: System.Random

--------------------
System.Random() : unit
System.Random(Seed: int) : unit
System.Random.NextDouble() : float
val getChar : cases:('a * float) list -> 'a

Full name: Script.getChar


 Helper to get one character from a list of choices with probabilities
val cases : ('a * float) list
val run : (float -> ('b * float) list -> 'b)
val r : float
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val c : 'b
val p : float
val t : ('b * float) list
val generate : order:int -> length:int -> acc:char list -> map:Map<System.String,(char * float) list> -> System.String

Full name: Script.generate


 Creates text according to a distribution. Defaults to spaces on unknown cases.
val length : int
val acc : char list
val map : Map<System.String,(char * float) list>
val toArray : list:'T list -> 'T []

Full name: Microsoft.FSharp.Collections.List.toArray
module Array

from Microsoft.FSharp.Collections
val rev : array:'T [] -> 'T []

Full name: Microsoft.FSharp.Collections.Array.rev
val sub : System.String
val truncate : count:int -> source:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.truncate
val toArray : source:seq<'T> -> 'T []

Full name: Microsoft.FSharp.Collections.Seq.toArray
val newChar : char
val tryFind : key:'Key -> table:Map<'Key,'T> -> 'T option (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.tryFind
union case Option.Some: Value: 'T -> Option<'T>
val l : (char * float) list
property System.String.Length: int
val wordwise : order:int -> approxLength:int -> input:string -> unit

Full name: Script.wordwise


 Generates words from sample. Generates space-separated words independently.
val approxLength : int
val input : string
val out : System.String
module String

from Microsoft.FSharp.Core
val replicate : count:int -> str:string -> string

Full name: Microsoft.FSharp.Core.String.replicate
System.String.Replace(oldValue: string, newValue: string) : string
System.String.Replace(oldChar: char, newChar: char) : string
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val lolz : string

Full name: Script.lolz

More information

Link:http://fssnip.net/ol
Posted:3 years ago
Author:Vandroiy
Tags: random , generator , markov chain

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.