challenge 2 in apl, raku, hy, haskell

4 files changed, 127 insertions, 0 deletions

diff --git a/challenge-286/asherbhs/apl/ch-2.apl b/challenge-286/asherbhs/apl/ch-2.apl
new file mode 100644
index 0000000000..592f8ea98e
--- /dev/null
+++ b/challenge-286/asherbhs/apl/ch-2.apl
@@ -0,0 +1,63 @@
+⎕IO←0
+'displayr' 'cmpx'⎕cy'dfns'
+
+⍝ uses some funky reshapes
+OrderGame1←{
+	n←≢⍵
+	n≤1: ⍬
+	⌊/⊃{
+		(x y)←⊂⍤2⊢1 0 2⍉⍵⍴⍨⍺,2 2
+		,⍉↑(⌊/x)(⌈/y)
+	}/(2*⍳(n≥4)ׯ1+2⍟n),⊂⍵
+}
+
+⍝ perhaps more natural, but much slower
+OrderGame2←{
+	⊃{
+		p←↓(⊢⍴⍨2,⍨≢÷2⍨)⍵    ⍝ ⊂⍤⊢⌺(⍪2 2)⊢⍵
+		m←2|⍳≢p
+		⌈/¨@{m}⌊/¨@{~m}p
+	}⍣(2⍟≢⍵)⊢⍵
+}
+
+⍝ thought this could be faster but it's actually slower
+OrderGame3←{
+	t←⍵,⍨0⍴⍨¯2+≢⍵
+	_←2{
+		i←(⍺-2)+4×⍳⍺÷4
+		j←(⍵-2)+2×⍳⍵÷2
+		t[j  ]←t[i  ]⌊t[i+1]
+		t[j+1]←t[i+2]⌈t[i+3]
+		⍬
+	}/⌽2*1+⍳2⍟≢⍵
+	⌊/2↑t
+}
+
+⍝ slightly faster version of 2
+OrderGame4←{
+	⊃{
+		m←⍬
+		⌈/¨@{m}⌊/¨@{~m⊢←2|⍳≢⍵}↓(⊢⍴⍨2,⍨≢÷2⍨)⍵
+	}⍣(2⍟≢⍵)⊢⍵
+}
+
+⎕←OrderGame1 2 1 4 5 6 3 0 2
+⎕←OrderGame2 2 1 4 5 6 3 0 2
+⎕←OrderGame3 2 1 4 5 6 3 0 2
+⎕←OrderGame4 2 1 4 5 6 3 0 2
+
+⎕←OrderGame1 0 5 3 2
+⎕←OrderGame2 0 5 3 2
+⎕←OrderGame3 0 5 3 2
+⎕←OrderGame4 0 5 3 2
+
+⎕←OrderGame1 9 2 1 4 5 6 0 7 3 1 3 5 7 9 0 8
+⎕←OrderGame2 9 2 1 4 5 6 0 7 3 1 3 5 7 9 0 8
+⎕←OrderGame3 9 2 1 4 5 6 0 7 3 1 3 5 7 9 0 8
+⎕←OrderGame4 9 2 1 4 5 6 0 7 3 1 3 5 7 9 0 8
+
+⍝ x←?1e4⍴⍨⎕←2*20
+⍝ ⎕profile 'start'
+⍝ ⎕←cmpx 1 0 1 0/'OrderGame1 x' 'OrderGame2 x' 'OrderGame3 x' 'OrderGame4 x'
+⍝ ⎕profile 'stop'
+⍝ ⎕←⎕profile 'data'
diff --git a/challenge-286/asherbhs/haskell/ch-2.hs b/challenge-286/asherbhs/haskell/ch-2.hs
new file mode 100644
index 0000000000..5785cb8ae8
--- /dev/null
+++ b/challenge-286/asherbhs/haskell/ch-2.hs
@@ -0,0 +1,20 @@
+orderGame :: [Int] -> Int
+orderGame ints = head $ foldr
+    (\_ ints -> zipWith
+        ($)
+        (cycle $ map uncurry [min, max])
+        (pairUp ints)
+    )
+    ints
+    [1 .. logBase 2 $ fromIntegral $ length ints]
+  where
+    pairUp :: [a] -> [(a, a)]
+    pairUp [] = []
+    pairUp (x : y : xs) = (x, y) : pairUp xs
+
+
+main :: IO ()
+main = do
+    print $ orderGame [2, 1, 4, 5, 6, 3, 0, 2]
+    print $ orderGame [0, 5, 3, 2]
+    print $ orderGame [9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8]
diff --git a/challenge-286/asherbhs/hy/ch-2.hy b/challenge-286/asherbhs/hy/ch-2.hy
new file mode 100644
index 0000000000..52bd8e02c8
--- /dev/null
+++ b/challenge-286/asherbhs/hy/ch-2.hy
@@ -0,0 +1,25 @@
+(require hyrule [as-> do-n fn+])
+
+(import itertools [batched])
+(import math      [log])
+
+(defn order-game [ints] (do
+    (do-n
+        (int (log (len ints) 2))
+        (setv ints (as-> ints them
+            (enumerate them)
+            (batched them 2)
+            (map
+                (fn+ [[[i x] [_ y]]]
+                    ((if (= 0 (% i 4)) min max) x y)
+                )
+                them
+            )
+        )
+    ))
+    (next ints)
+))
+
+(print (order-game [2 1 4 5 6 3 0 2]))
+(print (order-game [0 5 3 2]))
+(print (order-game [9 2 1 4 5 6 0 7 3 1 3 5 7 9 0 8]))
diff --git a/challenge-286/asherbhs/raku/ch-2.raku b/challenge-286/asherbhs/raku/ch-2.raku
new file mode 100644
index 0000000000..1e42470950
--- /dev/null
+++ b/challenge-286/asherbhs/raku/ch-2.raku
@@ -0,0 +1,19 @@
+sub order-game(@ints) {
+	my @r = @ints;
+	for ^log @r, 2 {
+		@r.=pairs.=map({
+			($^a.key %% 4
+				?? &[min]
+				!! &[max]
+			)(
+				$^a.value,
+				$^b.value,
+			)
+		})
+	}
+	@r.head
+}
+
+say order-game (2, 1, 4, 5, 6, 3, 0, 2);
+say order-game (0, 5, 3, 2);
+say order-game (9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8);