tasks a-s

Task/Permutation-test/Haskell/permutation-test-1.hs

@@ -0,0 +1,21 @@
+binomial n m = (f !! n) `div` (f !! m) `div` (f !! (n - m))
+	where f = scanl (*) 1 [1..]
+
+permtest treat ctrl = (fromIntegral less) / (fromIntegral total) * 100
+	where
+	total = binomial (length avail) (length treat)
+	less  = combos (sum treat) (length treat) avail
+	avail = ctrl ++ treat
+	combos total n a@(x:xs)
+		| total < 0	= binomial (length a) n
+		| n == 0	= 0
+		| n > length a	= 0
+		| n == length a = fromEnum (total < sum a)
+		| otherwise	= combos (total - x) (n - 1) xs
+				+ combos total n xs
+
+main =	let	r = permtest
+			[85, 88, 75, 66, 25, 29, 83, 39, 97]
+			[68, 41, 10, 49, 16, 65, 32, 92, 28, 98]
+	in do	putStr "> : "; print r
+		putStr "<=: "; print $ 100 - r

Task/Permutation-test/Haskell/permutation-test-2.hs

@@ -0,0 +1,19 @@
+binomial n m = (f !! n) `div` (f !! m) `div` (f !! (n - m))
+	where f = scanl (*) 1 [1..]
+
+perms treat ctrl = (less,total) where
+	total = binomial (length ctrl + length treat) (length treat)
+	less = length	$ filter (<= sum treat)
+			$ sums (treat ++ ctrl) (length treat)
+	sums x n
+		| l < n || n < 0 = []
+		| n == 0 = [0]
+		| l == n = [sum x]
+		| otherwise = [a + b | i <- [0..n], a <- sums left i, b <- sums right (n - i)]
+			where	(l, l1) = (length x, l `div` 2)
+				(left, right) = splitAt l1 x
+
+main = print $ (lt, 100 - lt) where
+	(a, b) = perms	[85, 88, 75, 66, 25, 29, 83, 39, 97]
+			[68, 41, 10, 49, 16, 65, 32, 92, 28, 98]
+	lt = (fromIntegral a) / (fromIntegral b) * 100

Task/Permutation-test/Haskell/permutation-test-3.hs

@@ -0,0 +1,26 @@
+combs maxsum len x = foldl f [(0,0,1)] x where
+	f a n = merge a (map (addNum n) $ filter (\(l,_,_) -> l < len) a)
+	addNum n (a,s,c)
+		-- anything larger than maxsum is as good as infinity
+		| s + n > maxsum = (a+1, maxsum + 1, c)
+		| otherwise = (a+1, s+n, c)
+
+	merge a [] = a
+	merge [] a = a
+	merge a@((a1,a2,a3):as) b@((b1,b2,b3):bs)
+		| a1 == b1 && a2 == b2 = (a1,a2,a3+b3):merge as bs
+		| a1 < b1 || (a1 == b1 && a2 < b2) = (a1,a2,a3):merge as b
+		| otherwise = (b1,b2,b3):merge a bs
+
+permtest a b = (lt, ge) where
+	lt = sum	$ map (\(a,b,c) -> if a == la && b < sa then c else 0)
+			$ combs sa la (a++b)
+	ge = (binomial (la + lb) la) - lt
+	(sa, la, lb) = (sum a, length a, length b)
+
+binomial n m = (f !! n) `div` (f !! m) `div` (f !! (n - m))
+	where f = scanl (*) 1 [1..]
+
+-- how many combinations are less than current sum
+main =	print$ permtest	[85, 88, 75, 66, 25, 29, 83, 39, 97]
+			[68, 41, 10, 49, 16, 65, 32, 92, 28, 98]