The order of articles in my ireader mode was getting too boring &
predictable, defeating half the point (in part because I had imported
a long succession of related articles).

So I wrote a script which would randomize one's articles.db, using
Oleg's shuffling code:

import Control.Monad (join)
import Data.Binary (decode, encodeFile, Binary)
import Data.Sequence (empty, length, fromList, Seq)
import Data.Foldable (toList)
import System.Random (mkStdGen, randomR, RandomGen)
import System.Directory (getHomeDirectory)
import qualified Data.ByteString.Char8 as B (readFile, ByteString)
import qualified Data.ByteString.Lazy.Char8 as BL (fromChunks)

readDB :: IO (Seq B.ByteString)
readDB = (dbLocation >>= r) `catch` (\_ -> return empty)
          where r = fmap (decode . BL.fromChunks . return) . B.readFile

dbLocation :: IO FilePath
dbLocation = getHomeDirectory >>= \home -> return (home ++ "/.yi/articles.db")

writeDB :: (Data.Binary.Binary a) =>a -> IO ()
writeDB adb = do join . fmap (`encodeFile` adb) $ dbLocation
                 return ()

main :: IO ()
main = do d <- readDB
          let ds = toList d
          let l = Data.Sequence.length d - 1
          let shuffled = shuffle1 ds (fst $ makeRs l (mkStdGen 17))
          let d' = Data.Sequence.fromList shuffled
          writeDB d'

makeRs :: RandomGen g => Int -> g -> ([Int],g)
makeRs n g = loop [] n g
  where
  loop acc 0 h = (Prelude.reverse acc,h)
  loop acc o h = let (r,h') = randomR (0,o) h
                      in loop (r:acc) (pred o) h'
data Tree a = Leaf a | Node !Int (Tree a) (Tree a) deriving Show
buildTree :: [t] -> Tree t
buildTree = grow_level . map Leaf
    where
        grow_level [node] = node
        grow_level l = grow_level $ inner l

        inner [] = []
        inner x...@[_] = x
        inner (e1:e2:rest) = combine e1 e2 : inner rest

        combine l@(Leaf _)       r@(Leaf _)       = Node 2 l r
        combine l@(Node ct _ _)  r@(Leaf _)       = Node (ct+1) l r
        combine l@(Leaf _)       r@(Node ct _ _)  = Node (ct+1) l r
        combine l@(Node ctl _ _) r@(Node ctr _ _) = Node (ctl+ctr) l r
shuffle1 :: [a] -> [Int] -> [a]
shuffle1 elements rseq = shuffle1' (buildTree elements) rseq
    where
     shuffle1' (Leaf e) [] = [e]
     shuffle1' tree (ri:r_others) = extract_tree ri tree (`shuffle1'` r_others)
     shuffle1' (Node _ _ _) [] = error "impossible; mismatched args?"
     extract_tree 0 (Node _ (Leaf e) r) k = e:k r
     extract_tree 1 (Node 2 l...@leaf{} (Leaf r)) k = r:k l
     extract_tree n (Node c l...@leaf{} r) k =
             extract_tree (n-1) r (\new_r -> k $ Node (c-1) l new_r)
     extract_tree n (Node n1 l (Leaf e)) k | n+1 == n1 = e:k l
     extract_tree n (Node c l@(Node cl _ _) r) k
      | n < cl = extract_tree n l (\new_l -> k $ Node (c-1) new_l r)
      | otherwise = extract_tree (n-cl) r (\new_r -> k $ Node (c-1) l new_r)
     extract_tree _ (Leaf _) _ = error "impossible result; mismatched
arguments?"

-- 
gwern

-- 
Yi development mailing list
[email protected]
http://groups.google.com/group/yi-devel

Attachment: randomize-seq.hs
Description: Binary data

Reply via email to