/usr/share/doc/libghc-maths-doc/html/src/Math-Algebra-Group-RandomSchreierSims.html is in libghc-maths-doc 0.4.5-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 | <?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ -->
<title>Math/Algebra/Group/RandomSchreierSims.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>-- Copyright (c) David Amos, 2009. All rights reserved.</span>
<a name="line-2"></a>
<a name="line-3"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Math</span><span class='hs-varop'>.</span><span class='hs-conid'>Algebra</span><span class='hs-varop'>.</span><span class='hs-conid'>Group</span><span class='hs-varop'>.</span><span class='hs-conid'>RandomSchreierSims</span> <span class='hs-keyword'>where</span>
<a name="line-4"></a>
<a name="line-5"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>Random</span>
<a name="line-6"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>List</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>L</span>
<a name="line-7"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Map</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>M</span>
<a name="line-8"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Maybe</span>
<a name="line-9"></a>
<a name="line-10"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span>
<a name="line-11"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Array</span><span class='hs-varop'>.</span><span class='hs-conid'>MArray</span>
<a name="line-12"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Array</span><span class='hs-varop'>.</span><span class='hs-conid'>IO</span>
<a name="line-13"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>IO</span><span class='hs-varop'>.</span><span class='hs-conid'>Unsafe</span>
<a name="line-14"></a>
<a name="line-15"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Math</span><span class='hs-varop'>.</span><span class='hs-conid'>Common</span><span class='hs-varop'>.</span><span class='hs-conid'>ListSet</span> <span class='hs-layout'>(</span><span class='hs-varid'>toListSet</span><span class='hs-layout'>)</span>
<a name="line-16"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Math</span><span class='hs-varop'>.</span><span class='hs-conid'>Core</span><span class='hs-varop'>.</span><span class='hs-conid'>Utils</span> <span class='hs-varid'>hiding</span> <span class='hs-layout'>(</span><span class='hs-varid'>elts</span><span class='hs-layout'>)</span>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Math</span><span class='hs-varop'>.</span><span class='hs-conid'>Algebra</span><span class='hs-varop'>.</span><span class='hs-conid'>Group</span><span class='hs-varop'>.</span><span class='hs-conid'>PermutationGroup</span>
<a name="line-18"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Math</span><span class='hs-varop'>.</span><span class='hs-conid'>Algebra</span><span class='hs-varop'>.</span><span class='hs-conid'>Group</span><span class='hs-varop'>.</span><span class='hs-conid'>SchreierSims</span> <span class='hs-layout'>(</span><span class='hs-varid'>sift</span><span class='hs-layout'>,</span> <span class='hs-varid'>cosetRepsGx</span><span class='hs-layout'>,</span> <span class='hs-varid'>ss'</span><span class='hs-layout'>)</span>
<a name="line-19"></a>
<a name="line-20"></a>
<a name="line-21"></a><a name="testProdRepl"></a><span class='hs-definition'>testProdRepl</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-layout'>,</span><span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>initProdRepl</span> <span class='hs-varop'>$</span> <span class='hs-sel'>_D</span> <span class='hs-num'>10</span>
<a name="line-22"></a> <span class='hs-varid'>hs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>replicateM</span> <span class='hs-num'>20</span> <span class='hs-varop'>$</span> <span class='hs-varid'>nextProdRepl</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-layout'>,</span><span class='hs-varid'>xs</span><span class='hs-layout'>)</span>
<a name="line-23"></a> <span class='hs-varid'>mapM_</span> <span class='hs-varid'>print</span> <span class='hs-varid'>hs</span>
<a name="line-24"></a>
<a name="line-25"></a><span class='hs-comment'>-- Holt p69-71</span>
<a name="line-26"></a><span class='hs-comment'>-- Product replacement algorithm for generating uniformly distributed random elts of a black box group</span>
<a name="line-27"></a>
<a name="line-28"></a><a name="initProdRepl"></a><span class='hs-definition'>initProdRepl</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-conid'>Show</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Permutation</span> <span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>Int</span><span class='hs-layout'>,</span> <span class='hs-conid'>IOArray</span> <span class='hs-conid'>Int</span> <span class='hs-layout'>(</span><span class='hs-conid'>Permutation</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-29"></a><span class='hs-definition'>initProdRepl</span> <span class='hs-varid'>gs</span> <span class='hs-keyglyph'>=</span>
<a name="line-30"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>length</span> <span class='hs-varid'>gs</span>
<a name="line-31"></a> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>max</span> <span class='hs-num'>10</span> <span class='hs-varid'>n</span>
<a name="line-32"></a> <span class='hs-varid'>xs</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-num'>1</span><span class='hs-conop'>:</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>take</span> <span class='hs-varid'>r</span> <span class='hs-varop'>$</span> <span class='hs-varid'>concat</span> <span class='hs-varop'>$</span> <span class='hs-varid'>repeat</span> <span class='hs-varid'>gs</span>
<a name="line-33"></a> <span class='hs-keyword'>in</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>xs'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>newListArray</span> <span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-layout'>,</span><span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-varid'>xs</span>
<a name="line-34"></a> <span class='hs-varid'>replicateM_</span> <span class='hs-num'>60</span> <span class='hs-varop'>$</span> <span class='hs-varid'>nextProdRepl</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-layout'>,</span><span class='hs-varid'>xs'</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- perform initial mixing</span>
<a name="line-35"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-layout'>,</span><span class='hs-varid'>xs'</span><span class='hs-layout'>)</span>
<a name="line-36"></a>
<a name="line-37"></a><a name="nextProdRepl"></a><span class='hs-definition'>nextProdRepl</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-conid'>Show</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-conid'>Int</span><span class='hs-layout'>,</span> <span class='hs-conid'>IOArray</span> <span class='hs-conid'>Int</span> <span class='hs-layout'>(</span><span class='hs-conid'>Permutation</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-layout'>(</span><span class='hs-conid'>Maybe</span> <span class='hs-layout'>(</span><span class='hs-conid'>Permutation</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-38"></a><span class='hs-definition'>nextProdRepl</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-layout'>,</span><span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-39"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>randomRIO</span> <span class='hs-layout'>(</span><span class='hs-num'>1</span><span class='hs-layout'>,</span><span class='hs-varid'>r</span><span class='hs-layout'>)</span>
<a name="line-40"></a> <span class='hs-varid'>t</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>randomRIO</span> <span class='hs-layout'>(</span><span class='hs-num'>1</span><span class='hs-layout'>,</span><span class='hs-varid'>r</span><span class='hs-layout'>)</span>
<a name="line-41"></a> <span class='hs-varid'>u</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>randomRIO</span> <span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-layout'>,</span><span class='hs-num'>3</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span><span class='hs-layout'>)</span>
<a name="line-42"></a> <span class='hs-varid'>out</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>updateArray</span> <span class='hs-varid'>xs</span> <span class='hs-varid'>s</span> <span class='hs-varid'>t</span> <span class='hs-varid'>u</span>
<a name="line-43"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>out</span>
<a name="line-44"></a>
<a name="line-45"></a><a name="updateArray"></a><span class='hs-definition'>updateArray</span> <span class='hs-varid'>xs</span> <span class='hs-varid'>s</span> <span class='hs-varid'>t</span> <span class='hs-varid'>u</span> <span class='hs-keyglyph'>=</span>
<a name="line-46"></a> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>swap</span><span class='hs-layout'>,</span><span class='hs-varid'>invert</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>quotRem</span> <span class='hs-varid'>u</span> <span class='hs-num'>2</span> <span class='hs-keyword'>in</span>
<a name="line-47"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>s</span> <span class='hs-varop'>==</span> <span class='hs-varid'>t</span>
<a name="line-48"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-conid'>Nothing</span>
<a name="line-49"></a> <span class='hs-keyword'>else</span> <span class='hs-keyword'>do</span>
<a name="line-50"></a> <span class='hs-varid'>x_0</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>readArray</span> <span class='hs-varid'>xs</span> <span class='hs-num'>0</span>
<a name="line-51"></a> <span class='hs-varid'>x_s</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>readArray</span> <span class='hs-varid'>xs</span> <span class='hs-varid'>s</span>
<a name="line-52"></a> <span class='hs-varid'>x_t</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>readArray</span> <span class='hs-varid'>xs</span> <span class='hs-varid'>t</span>
<a name="line-53"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>x_s'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mult</span> <span class='hs-layout'>(</span><span class='hs-varid'>swap</span><span class='hs-layout'>,</span><span class='hs-varid'>invert</span><span class='hs-layout'>)</span> <span class='hs-varid'>x_s</span> <span class='hs-varid'>x_t</span>
<a name="line-54"></a> <span class='hs-varid'>x_0'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mult</span> <span class='hs-layout'>(</span><span class='hs-varid'>swap</span><span class='hs-layout'>,</span><span class='hs-num'>0</span><span class='hs-layout'>)</span> <span class='hs-varid'>x_0</span> <span class='hs-varid'>x_s'</span>
<a name="line-55"></a> <span class='hs-varid'>writeArray</span> <span class='hs-varid'>xs</span> <span class='hs-num'>0</span> <span class='hs-varid'>x_0'</span>
<a name="line-56"></a> <span class='hs-varid'>writeArray</span> <span class='hs-varid'>xs</span> <span class='hs-varid'>s</span> <span class='hs-varid'>x_s'</span>
<a name="line-57"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>x_0'</span><span class='hs-layout'>)</span>
<a name="line-58"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>mult</span> <span class='hs-layout'>(</span><span class='hs-varid'>swap</span><span class='hs-layout'>,</span><span class='hs-varid'>invert</span><span class='hs-layout'>)</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>swap</span><span class='hs-layout'>,</span><span class='hs-varid'>invert</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-59"></a> <span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-layout'>,</span><span class='hs-num'>0</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-varop'>*</span> <span class='hs-varid'>b</span>
<a name="line-60"></a> <span class='hs-layout'>(</span><span class='hs-num'>0</span><span class='hs-layout'>,</span><span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-varop'>*</span> <span class='hs-varid'>b</span><span class='hs-varop'>^-</span><span class='hs-num'>1</span>
<a name="line-61"></a> <span class='hs-layout'>(</span><span class='hs-num'>1</span><span class='hs-layout'>,</span><span class='hs-num'>0</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>b</span> <span class='hs-varop'>*</span> <span class='hs-varid'>a</span>
<a name="line-62"></a> <span class='hs-layout'>(</span><span class='hs-num'>1</span><span class='hs-layout'>,</span><span class='hs-num'>1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>b</span><span class='hs-varop'>^-</span><span class='hs-num'>1</span> <span class='hs-varop'>*</span> <span class='hs-varid'>a</span>
<a name="line-63"></a>
<a name="line-64"></a>
<a name="line-65"></a><span class='hs-comment'>-- Holt p97-8</span>
<a name="line-66"></a><span class='hs-comment'>-- Random Schreier-Sims algorithm, for finding strong generating set of permutation group</span>
<a name="line-67"></a>
<a name="line-68"></a><span class='hs-comment'>-- It's possible that the following code can be improved by introducing levels only as we need them?</span>
<a name="line-69"></a>
<a name="line-70"></a><a name="sgs"></a><span class='hs-comment'>-- |Given generators for a permutation group, return a strong generating set.</span>
<a name="line-71"></a><span class='hs-comment'>-- The result is calculated using random Schreier-Sims algorithm, so has a small (\<10^-6) chance of being incomplete.</span>
<a name="line-72"></a><span class='hs-comment'>-- The sgs is relative to the base implied by the Ord instance.</span>
<a name="line-73"></a><span class='hs-definition'>sgs</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-conid'>Show</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Permutation</span> <span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Permutation</span> <span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span>
<a name="line-74"></a><span class='hs-definition'>sgs</span> <span class='hs-varid'>gs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>toListSet</span> <span class='hs-varop'>$</span> <span class='hs-varid'>concatMap</span> <span class='hs-varid'>snd</span> <span class='hs-varop'>$</span> <span class='hs-varid'>rss</span> <span class='hs-varid'>gs</span>
<a name="line-75"></a>
<a name="line-76"></a><a name="rss"></a><span class='hs-definition'>rss</span> <span class='hs-varid'>gs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unsafePerformIO</span> <span class='hs-varop'>$</span>
<a name="line-77"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-layout'>,</span><span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>initProdRepl</span> <span class='hs-varid'>gs</span>
<a name="line-78"></a> <span class='hs-varid'>rss'</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-layout'>,</span><span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>initLevels</span> <span class='hs-varid'>gs</span><span class='hs-layout'>)</span> <span class='hs-num'>0</span>
<a name="line-79"></a>
<a name="line-80"></a><a name="rss'"></a><span class='hs-definition'>rss'</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-layout'>,</span><span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-varid'>levels</span> <span class='hs-varid'>i</span>
<a name="line-81"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>i</span> <span class='hs-varop'>==</span> <span class='hs-num'>25</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varid'>levels</span> <span class='hs-comment'>-- stop if we've had 25 successful sifts in a row</span>
<a name="line-82"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>g</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>nextProdRepl</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-layout'>,</span><span class='hs-varid'>xs</span><span class='hs-layout'>)</span>
<a name="line-83"></a> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>changed</span><span class='hs-layout'>,</span><span class='hs-varid'>levels'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>updateLevels</span> <span class='hs-varid'>levels</span> <span class='hs-varid'>g</span>
<a name="line-84"></a> <span class='hs-varid'>rss'</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-layout'>,</span><span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-varid'>levels'</span> <span class='hs-layout'>(</span><span class='hs-keyword'>if</span> <span class='hs-varid'>changed</span> <span class='hs-keyword'>then</span> <span class='hs-num'>0</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>i</span><span class='hs-varop'>+</span><span class='hs-num'>1</span><span class='hs-layout'>)</span>
<a name="line-85"></a><span class='hs-comment'>-- if we currently have an sgs for a subgroup of the group, then it must have index >= 2</span>
<a name="line-86"></a><span class='hs-comment'>-- so the chance of a random elt sifting to identity is <= 1/2</span>
<a name="line-87"></a>
<a name="line-88"></a><a name="initLevels"></a><span class='hs-definition'>initLevels</span> <span class='hs-varid'>gs</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span><span class='hs-conid'>M</span><span class='hs-varop'>.</span><span class='hs-varid'>singleton</span> <span class='hs-varid'>b</span> <span class='hs-num'>1</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-conid'>[]</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>bs</span><span class='hs-keyglyph'>]</span>
<a name="line-89"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>bs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>toListSet</span> <span class='hs-varop'>$</span> <span class='hs-varid'>concatMap</span> <span class='hs-varid'>supp</span> <span class='hs-varid'>gs</span>
<a name="line-90"></a>
<a name="line-91"></a><a name="updateLevels"></a><span class='hs-definition'>updateLevels</span> <span class='hs-varid'>levels</span> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span><span class='hs-varid'>levels</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- not strictly correct to increment count on a Nothing</span>
<a name="line-92"></a><span class='hs-definition'>updateLevels</span> <span class='hs-varid'>levels</span> <span class='hs-layout'>(</span><span class='hs-conid'>Just</span> <span class='hs-varid'>g</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-93"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>sift</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>fst</span> <span class='hs-varid'>levels</span><span class='hs-layout'>)</span> <span class='hs-varid'>g</span> <span class='hs-keyword'>of</span>
<a name="line-94"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>False</span><span class='hs-layout'>,</span> <span class='hs-varid'>levels</span><span class='hs-layout'>)</span>
<a name="line-95"></a> <span class='hs-comment'>-- Just 1 -> error "Just 1"</span>
<a name="line-96"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>g'</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>True</span><span class='hs-layout'>,</span> <span class='hs-varid'>updateLevels'</span> <span class='hs-conid'>[]</span> <span class='hs-varid'>levels</span> <span class='hs-varid'>g'</span> <span class='hs-layout'>(</span><span class='hs-varid'>minsupp</span> <span class='hs-varid'>g'</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-97"></a>
<a name="line-98"></a><a name="updateLevels'"></a><span class='hs-definition'>updateLevels'</span> <span class='hs-varid'>ls</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span><span class='hs-varid'>t</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-conop'>:</span><span class='hs-varid'>rs</span><span class='hs-layout'>)</span> <span class='hs-varid'>h</span> <span class='hs-varid'>b'</span> <span class='hs-keyglyph'>=</span>
<a name="line-99"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>b</span> <span class='hs-varop'>==</span> <span class='hs-varid'>b'</span>
<a name="line-100"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>reverse</span> <span class='hs-varid'>ls</span> <span class='hs-varop'>++</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-varid'>cosetRepsGx</span> <span class='hs-layout'>(</span><span class='hs-varid'>h</span><span class='hs-conop'>:</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>h</span><span class='hs-conop'>:</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>rs</span>
<a name="line-101"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>updateLevels'</span> <span class='hs-layout'>(</span><span class='hs-varid'>r</span><span class='hs-conop'>:</span><span class='hs-varid'>ls</span><span class='hs-layout'>)</span> <span class='hs-varid'>rs</span> <span class='hs-varid'>h</span> <span class='hs-varid'>b'</span>
<a name="line-102"></a><span class='hs-comment'>-- updateLevels' ls [] h b' = error $ "updateLevels: " ++ show (ls,[],h,b')</span>
<a name="line-103"></a>
<a name="line-104"></a><span class='hs-comment'>-- used the following in debugging</span>
<a name="line-105"></a><span class='hs-comment'>-- orderLevels levels = product $ [if M.null t then 1 else toInteger (M.size t) | ((b,t),s) <- levels]</span>
<a name="line-106"></a>
<a name="line-107"></a>
<a name="line-108"></a><a name="baseTransversalsSGS"></a><span class='hs-comment'>-- recover the base tranversals from the sgs. gs must be an sgs</span>
<a name="line-109"></a><span class='hs-comment'>-- baseTransversalsSGS gs = [let hs = [h | h <- gs, b <= minsupp h] in (b, cosetRepsGx hs b) | b <- bs]</span>
<a name="line-110"></a><span class='hs-definition'>baseTransversalsSGS</span> <span class='hs-varid'>gs</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-keyword'>let</span> <span class='hs-varid'>hs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>filter</span> <span class='hs-layout'>(</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span> <span class='hs-varop'><=</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-varid'>minsupp</span> <span class='hs-layout'>)</span> <span class='hs-varid'>gs</span> <span class='hs-keyword'>in</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-varid'>cosetRepsGx</span> <span class='hs-varid'>hs</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>bs</span><span class='hs-keyglyph'>]</span>
<a name="line-111"></a> <span class='hs-keyword'>where</span> <span class='hs-varid'>bs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>toListSet</span> <span class='hs-varop'>$</span> <span class='hs-varid'>map</span> <span class='hs-varid'>minsupp</span> <span class='hs-varid'>gs</span>
<a name="line-112"></a> <span class='hs-comment'>-- where bs = toListSet $ concatMap supp gs</span>
<a name="line-113"></a>
<a name="line-114"></a><a name="isMemberSGS"></a><span class='hs-comment'>-- |Given a strong generating set gs, isMemberSGS gs is a membership test for the group</span>
<a name="line-115"></a><span class='hs-definition'>isMemberSGS</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ord</span> <span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-conid'>Show</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Permutation</span> <span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Permutation</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-116"></a><span class='hs-definition'>isMemberSGS</span> <span class='hs-varid'>gs</span> <span class='hs-varid'>h</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>bts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>baseTransversalsSGS</span> <span class='hs-varid'>gs</span> <span class='hs-keyword'>in</span> <span class='hs-varid'>isNothing</span> <span class='hs-varop'>$</span> <span class='hs-varid'>sift</span> <span class='hs-varid'>bts</span> <span class='hs-varid'>h</span>
<a name="line-117"></a>
<a name="line-118"></a>
<a name="line-119"></a><span class='hs-comment'>{-
<a name="line-120"></a>-- Alternative where we carry on with Schreier-Sims when we finish Random Schreier-Sims, just to make sure
<a name="line-121"></a>-- !! Unfortunately, doesn't appear to work - perhaps ss' doesn't like finding empty levels
<a name="line-122"></a>sgs2 gs = toListSet $ concatMap snd $ rss2 gs
<a name="line-123"></a>
<a name="line-124"></a>rss2 gs = unsafePerformIO $
<a name="line-125"></a> do (r,xs) <- initProdRepl gs
<a name="line-126"></a> levels <- rss' (r,xs) (initLevels gs) 0
<a name="line-127"></a> return $ ss' bs (reverse levels) []
<a name="line-128"></a> where bs = toListSet $ concatMap supp gs
<a name="line-129"></a>-}</span>
</pre></body>
</html>
|