From: Mart Lubbers Date: Tue, 21 Apr 2015 12:25:25 +0000 (+0200) Subject: rare zooi X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=892075a5f701177235c0296c28899563836b42e2;p=fp1415.git rare zooi --- diff --git a/fp2/week1/mart/Random.dcl b/fp2/week1/mart/Random.dcl new file mode 100644 index 0000000..47a7c18 --- /dev/null +++ b/fp2/week1/mart/Random.dcl @@ -0,0 +1,19 @@ +definition module Random + + // Random number generator voor Linux gebruikers + // interface compatible met Random.dcl (helaas) + // -- mschool@science.ru.nl + +import StdFile + +:: RandomSeed + +// nullRandomSeed generates a fixed RandomSeed +nullRandomSeed :: RandomSeed + +// GetNewRandomSeed generates a good RandomSeed, using /dev/urandom +getNewRandomSeed :: !*env -> (!RandomSeed, !*env) | FileSystem env + +// Given a RandomSeed, Random generates a random number and a new RandomSeed. +random :: !RandomSeed -> .(!Int, !RandomSeed) + diff --git a/fp2/week1/mart/Random.icl b/fp2/week1/mart/Random.icl new file mode 100644 index 0000000..b6e0768 --- /dev/null +++ b/fp2/week1/mart/Random.icl @@ -0,0 +1,20 @@ +implementation module Random + +import StdFile, StdList, StdMisc, StdArray, Random + +:: RandomSeed :== Int + +nullRandomSeed :: RandomSeed +nullRandomSeed = 0 + +getNewRandomSeed :: !*env -> (!RandomSeed, !*env) | FileSystem env +getNewRandomSeed env +# (ok, src, env) = sfopen "/dev/urandom" FReadData env +| not ok => abort "could not open /dev/urandom" +# (bytes, src) = sfreads src 4 + seed = foldl (\x y->(x<<8)+toInt y) 0 [c \\ c<-:bytes] +| otherwise => (seed, env) + +random :: !RandomSeed -> .(!Int, !RandomSeed) +random seed = (seed>>16 bitand 0xFFFF, seed*0x08088405+1) + diff --git a/fp2/week1/mart/RandomGetallen b/fp2/week1/mart/RandomGetallen new file mode 100755 index 0000000..0482437 Binary files /dev/null and b/fp2/week1/mart/RandomGetallen differ diff --git a/fp2/week1/mart/RandomGetallen.dcl b/fp2/week1/mart/RandomGetallen.dcl new file mode 100644 index 0000000..66a2c6c --- /dev/null +++ b/fp2/week1/mart/RandomGetallen.dcl @@ -0,0 +1,7 @@ +definition module RandomGetallen + +import Random + +random_n :: Int RandomSeed -> ([Int],RandomSeed) +random_inf :: RandomSeed -> [Int] +//shuffle :: [a] RandomSeed -> [a] diff --git a/fp2/week1/mart/RandomGetallen.icl b/fp2/week1/mart/RandomGetallen.icl new file mode 100644 index 0000000..b756c91 --- /dev/null +++ b/fp2/week1/mart/RandomGetallen.icl @@ -0,0 +1,33 @@ +implementation module RandomGetallen + +import StdEnv, Random + +//Start :: *World -> ([Int],*World) +//Start world +//# (rs,world) = getNewRandomSeed world +//= (shuffle [1..10] rs,world) + + +Start = shuffle [1..10] nullRandomSeed + +random_n :: Int RandomSeed -> ([Int],RandomSeed) +random_n n seed = seqList (repeatn n random) seed + +random_inf :: RandomSeed -> [Int] +random_inf seed = iterateSt random seed + +iterateSt :: (s -> (a,s)) s -> [a] +iterateSt f s = [a : iterateSt f s`] +where + (a,s`) = f s + +shuffle :: [a] RandomSeed -> [a] +shuffle xs seed = (perms xs) !! ((fst (random seed)) rem (fac (length xs))) + +fac :: Int -> Int +fac 0 = 1 +fac n = n * fac (n-1) + +perms :: [a] -> [[a]] +perms [] = [[]] +perms xs = [[xs!!i : xs`] \\ i <- [0..length xs - 1] , xs` <- perms (take i xs ++ drop (i+1) xs)] diff --git a/fp2/week2/ReturnEnBind.icl b/fp2/week2/ReturnEnBind.icl new file mode 100644 index 0000000..0bece5f --- /dev/null +++ b/fp2/week2/ReturnEnBind.icl @@ -0,0 +1,19 @@ +module ReturnEnBind + +import StdEnv, Random + +Start = 42 + +(bind1) infix 0 :: (St s a) (a -> (St s b)) -> St s b +//(bind1) infix 0 :: (s -> *(a,s)) (a -> (a -> *(a,s))) -> (s -> *(b,s)) +(bind1) f1 f2 = \st0 f2 (fst (f1 st0) (snd (f1 st0)) +// (r, st1) = f1 st0 +//(bind) f f2 :== \st0 -> let (r,st1) = f st0 +// in f2 r st1 + + +som2 :: (RandomSeed -> (Int,RandomSeed)) +som2 ... + +seqList1 :: [St s a] -> St s [a] +seqList1 ...