Merge pull request #4524 from luc65r/121

Challenge 121 in Miranda

2 files changed, 70 insertions, 0 deletions

diff --git a/challenge-121/luc65r/miranda/ch-1.m b/challenge-121/luc65r/miranda/ch-1.m
new file mode 100755
index 0000000000..1cc4ab9794
--- /dev/null
+++ b/challenge-121/luc65r/miranda/ch-1.m
@@ -0,0 +1,18 @@
+#!/usr/bin/env -S mira -exec
+
+main = ((++ "\n") . show . frombase2 . modify (1 -) n . tobase2) m
+       where
+       m = numval ($* ! 1)
+       n = numval ($* ! 2) - 1
+
+tobase2 :: num -> [num]
+tobase2 = map (mod 2) . takewhile (~= 0) . iterate (div 2)
+
+frombase2 :: [num] -> num
+frombase2 = foldl1 ((+) . (2 *)) . reverse
+
+modify :: (* -> *) -> num -> [*] -> [*]
+modify op n l = map2 f (index l) l
+                where
+                f i = op, if i == n
+                    = id, otherwise
diff --git a/challenge-121/luc65r/miranda/ch-2.m b/challenge-121/luc65r/miranda/ch-2.m
new file mode 100755
index 0000000000..5801a52c85
--- /dev/null
+++ b/challenge-121/luc65r/miranda/ch-2.m
@@ -0,0 +1,52 @@
+#!/usr/bin/env -S mira -exec
+
+matrix == [[num]]
+
+main = lay ( "matrix:":(map show mat)
+            ++ [ ""
+               , "tour: " ++ show besttour
+               , "length: " ++ show (length mat besttour)
+               ]
+           )
+       where
+       arg = $* ! 1
+       mat = (mkrandmat . numval) arg, if (and . map digit) arg
+           = readmat arg,              otherwise
+       tour t = t ++ [t ! 0]
+       besttour = (minby (length mat) . map tour . perms) [0 .. #mat - 1]
+
+length :: matrix -> [num] -> num
+length mat tour = (sum . map get . zip2 tour . tl) tour
+                  where
+                  get (i,j) = mat ! j ! i
+
+mkrandmat :: num -> matrix
+mkrandmat n = [ [ f i j (rand ! (i * n + j)) | i <- [1..n] ] | j <- [1..n] ]
+              where
+              rand = (map ((+) 1 . (mod 9) . code) . readb) "/dev/random"
+              f i j = const 0, if i == j
+                    = id,      otherwise
+
+readmat :: [char] -> matrix
+readmat = map (map numval . words) . lines . read
+
+words :: [char] -> [[char]]
+words []     = []
+words (x:xs) = []:words xs, if x = ' '
+             = (x:y):ys,    otherwise
+               where
+               (y:ys) = words xs, if xs ~= []
+                      = []:[],    otherwise
+
+perms :: [*] -> [[*]]
+perms [] = [[]]
+perms x  = [ a:y | a <- x; y <- perms (x -- [a]) ]
+
+minby :: (* -> num) -> [*] -> *
+minby f (x:xs) = g x (f x) xs
+                 where
+                 g v mv []     = v
+                 g v mv (x:xs) = g x mx xs, if mx < mv
+                               = g v mv xs, otherwise
+                                 where
+                                 mx = f x