Family Day update

Task/N-queens-problem/Factor/n-queens-problem.factor

@@ -5,7 +5,7 @@ IN: queens
 
 :: safe?  ( board q -- ? )
     [let  q board nth :> x
-      q iota [
+      q <iota> [
          x swap
          [ board nth ] keep
          q swap -
@@ -15,10 +15,10 @@ IN: queens
     ] ;
 
 : solution? ( board -- ? )
-    dup length iota [ dupd safe? ] all? nip ;
+    dup length <iota> [ dupd safe? ] all? nip ;
 
 : queens ( n -- l )
-    iota all-permutations [ solution? ] filter ;
+    <iota> all-permutations [ solution? ] filter ;
 
 : .queens ( n -- )
     queens

Task/N-queens-problem/Frink/n-queens-problem.frink

@@ -0,0 +1,12 @@
+solution[board] :=
+{
+    for q = 0 to length[board] - 1
+        for c = q+1 to length[board] - 1
+            if board@q == board@c + (c - q) or board@q == board@c - (c - q)
+                return false
+    true
+}
+
+for b = array[1 to 8].permute[]
+    if solution[b]
+        println[b]

Task/N-queens-problem/Haskell/n-queens-problem-4.hs

@@ -5,41 +5,37 @@ queenPuzzle :: Int -> Int -> [[Int]]
 queenPuzzle nRows nCols
   | nRows <= 0 = [[]]
   | otherwise =
-    foldr
-      (\qs a ->
-          a ++
-          foldr
-            (\iCol b -> bool b (b ++ [qs ++ [iCol]]) (safe (nRows - 1) iCol qs))
-            []
-            [1 .. nCols])
-      []
-      (queenPuzzle (nRows - 1) nCols)
+    foldr (\qs a ->
+               a ++ foldr (\iCol b -> bool  b  (b ++ [qs ++ [iCol]])
+                                           (safe (nRows - 1) iCol qs))
+                          []
+                          [1 .. nCols])
+          []
+          (queenPuzzle (nRows - 1) nCols)
 
 safe :: Int -> Int -> [Int] -> Bool
 safe iRow iCol qs =
-  (not . or) $
-  zipWith
-    (\sc sr ->
-        (iCol == sc) || (sc + sr == (iCol + iRow)) || (sc - sr == (iCol - iRow)))
-    qs
-    [0 .. iRow - 1]
+  (not . or) $ zipWith (\sc sr -> (iCol == sc) ||
+                                  (sc + sr == (iCol + iRow)) ||
+                                  (sc - sr == (iCol - iRow)))
+                       qs
+                       [0 .. iRow - 1]
 
 -- TEST ---------------------------------------------------
 -- 10 columns of solutions for the 7*7 board:
 showSolutions :: Int -> Int -> [String]
 showSolutions nCols nSize =
-  unlines <$>
-  ((fmap (intercalate "   ") . transpose . fmap boardLines) <$>
-   chunksOf nCols (queenPuzzle nSize nSize))
+  map (unlines . map (intercalate "   ") . transpose . map boardLines)
+      $ chunksOf nCols (queenPuzzle nSize nSize)
   where
     boardLines rows =
-      (\r -> (bool '.' '♛' . (== r)) <$> [1 .. (length rows)]) <$> rows
+      [map (bool '.' '♛' . (== r)) [1 .. (length rows)] | r <- rows]
 
 chunksOf :: Int -> [a] -> [[a]]
-chunksOf i xs = take i <$> ($ (:)) (splits xs) []
+chunksOf i xs = splits xs
   where
-    splits [] _ n = []
-    splits l c n = l `c` splits (drop i l) c n
+    splits [] = []
+    splits l  = (take i l) : splits (drop i l)
 
 main :: IO ()
 main = (putStrLn . unlines) $ showSolutions 10 7

Task/N-queens-problem/Haskell/n-queens-problem-5.hs

@@ -40,21 +40,21 @@ emptySt = ([],[])
 
 -- | Breadth-first search
 bfs :: Int -> [(State, Thread)] -> (State, Thread)
-bfs n []                     = error "Couldn't find a feasible solution"
+bfs n []                     = error "Could not find a feasible solution"
 bfs n sts | (not.empty) goal = head goal
-          | otherwise        = bfs n sts'
+          | otherwise        = bfs n sts2
   where
-    goal = filter (isGoal n) sts'
-    sts' = filter (feasible n) $ (moves n) <*> sts
+    goal = filter (isGoal n) sts2
+    sts2 = filter (feasible n) $ (moves n) <*> sts
 
 -- | Depth-first search
 dfs :: Int -> (State, Thread) -> [(State, Thread)]
 dfs n st | isGoal n st     = [st]
          | infeasible n st = [emptySt]
          | otherwise       = do x   <- [1..n]
-                                st' <- dfs n $ move x st
-                                guard $ st' /= emptySt
-                                return st'
+                                st2 <- dfs n $ move x st
+                                guard $ st2 /= emptySt
+                                return st2
 
 main = do
   [narg] <- getArgs

Task/N-queens-problem/Python/n-queens-problem-8.py

@@ -10,19 +10,20 @@ def queenPuzzle(nRows, nCols):
        in which no two Queens share a row,
        column, or diagonal.
     '''
-    def go(nRows, nCols):
+    def go(nRows):
+        lessRows = nRows - 1
         return reduce(
             lambda a, xys: a + reduce(
                 lambda b, iCol: b + [xys + [iCol]] if (
-                    safe(nRows - 1, iCol, xys)
+                    safe(lessRows, iCol, xys)
                 ) else b,
                 enumFromTo(1)(nCols),
                 []
             ),
-            go(nRows - 1, nCols),
+            go(lessRows),
             []
         ) if nRows > 0 else [[]]
-    return go(nRows, nCols)
+    return go(nRows)
 
 
 # safe :: Int -> Int -> [Int] -> Bool

Task/N-queens-problem/R/n-queens-problem-1.r

@@ -0,0 +1,28 @@
+queens <- function(n) {
+  a <- seq(n)
+  u <- rep(T, 2 * n - 1)
+  v <- rep(T, 2 * n - 1)
+  m <- NULL
+  aux <- function(i) {
+    if (i > n) {
+      m <<- cbind(m, a)
+    } else {
+      for (j in seq(i, n)) {
+        k <- a[[j]]
+        p <- i - k + n
+        q <- i + k - 1
+        if (u[[p]] && v[[q]]) {
+          u[[p]] <<- v[[q]] <<- F
+          a[[j]] <<- a[[i]]
+          a[[i]] <<- k
+          aux(i + 1)
+          u[[p]] <<- v[[q]] <<- T
+          a[[i]] <<- a[[j]]
+          a[[j]] <<- k
+        }
+      }
+    }
+  }
+  aux(1)
+  m
+}

Task/N-queens-problem/R/n-queens-problem-2.r

@@ -0,0 +1,3 @@
+library(Matrix)
+a <- queens(8)
+as(a[, 1], "pMatrix")

Task/N-queens-problem/R/n-queens-problem-3.r

@@ -0,0 +1 @@
+sapply(4:12, function(n) ncol(queens(n)))

Task/N-queens-problem/R/n-queens-problem.r

@@ -1,28 +0,0 @@
-# Brute force, see the "Permutations" page for the next.perm function
-safe <- function(p) {
-  n <- length(p)
-  for (i in seq(1, n - 1)) {
-    for (j in seq(i + 1, n)) {
-      if (abs(p[j] - p[i]) == abs(j - i)) return(F)
-    }
-  }
-  return(T)
-}
-
-queens <- function(n) {
-  p <- 1:n
-  k <- 0
-  while (!is.null(p)) {
-    if(safe(p)) {
-      cat(p, "\n")
-      k <- k + 1
-    }
-    p <- next.perm(p)
-  }
-  return(k)
-}
-
-queens(8)
-# 1 5 8 6 3 7 2 4
-# ...
-# 92