extra/markov-chains/markov-chains.factor

   1 ! Copyright (C) 2020 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: assocs assocs.private grouping kernel math.extras
   5 sequences ;
   6
   7 IN: markov-chains
   8
   9 : transitions ( string -- clumps )
  10     { t } { f } surround 2 clump ;
  11
  12 : push-transitions ( table seq -- table )
  13     transitions over [
  14         [ drop H{ } clone ] cache inc-at
  15     ] with-assoc assoc-each ;
  16
  17 : transition-table ( seq -- table )
  18     H{ } clone swap [ push-transitions ] each ;
  19
  20 : markov-chain ( table -- seq )
  21     t swap '[ _ at weighted-random dup ] [ dup ] produce nip ;