blob: c1c77edb2b605f51487b643051fc8f464197292a (
plain)
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
|
----------------------------------------------------------------------
-- |
-- Module : Randomized
-- Maintainer : AR
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/04/21 16:23:51 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.8 $
--
-- random generation and refinement. AR 22\/8\/2001.
-- implemented as sequence of refinement menu selecsions, encoded as integers
-----------------------------------------------------------------------------
module GF.UseGrammar.Randomized where
import GF.Grammar.Abstract
import GF.UseGrammar.Editing
import GF.Data.Operations
import GF.Data.Zipper
--- import Arch (myStdGen) --- circular for hbc
import System.Random --- (mkStdGen, StdGen, randoms) --- bad import for hbc
-- random generation and refinement. AR 22/8/2001
-- implemented as sequence of refinement menu selecsions, encoded as integers
myStdGen :: Int -> StdGen
myStdGen = mkStdGen ---
-- | build one random tree; use mx to prevent infinite search
mkRandomTree :: StdGen -> Int -> CGrammar -> Either Cat Fun -> Err Tree
mkRandomTree gen mx gr cat = mkTreeFromInts (take mx (randoms gen)) gr cat
refineRandom :: StdGen -> Int -> CGrammar -> Action
refineRandom gen mx = mkStateFromInts $ take mx $ map abs (randoms gen)
-- | build a tree from a list of integers
mkTreeFromInts :: [Int] -> CGrammar -> Either Cat Fun -> Err Tree
mkTreeFromInts ints gr catfun = do
st0 <- either (\cat -> newCat gr cat initState)
(\fun -> newFun gr fun initState)
catfun
state <- mkStateFromInts ints gr st0
return $ loc2tree state
mkStateFromInts :: [Int] -> CGrammar -> Action
mkStateFromInts ints gr z = mkRandomState ints z >>= reCheckState gr where
mkRandomState [] state = do
testErr (isCompleteState state) "not completed"
return state
mkRandomState (n:ns) state = do
let refs = refinementsState gr state
refs0 = map (not . snd . snd) refs
testErr (not (null refs0)) $ "no nonrecursive refinements available for" +++
prt (actVal state)
(ref,_) <- (refs !? (n `mod` (length refs)))
state1 <- refineWithAtom False gr ref state
if isCompleteState state1
then return state1
else do
state2 <- goNextMeta state1
mkRandomState ns state2
|
