From bfbff8b7cdd07ea7e546a9f82a2bfb3c8acb3058 Mon Sep 17 00:00:00 2001
From: ProgramSnail <purpurebacterium@yandex.ru>
Date: Sat, 18 Oct 2025 13:22:07 +0300
Subject: [PATCH] get concat shuffle from 02, part of genNexts, patterns

---
 escher.hs | 53 +++++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 49 insertions(+), 4 deletions(-)

diff --git a/escher.hs b/escher.hs
index d0f5a3f..941be20 100644
--- a/escher.hs
+++ b/escher.hs
@@ -80,7 +80,7 @@ instance Monad Result where
 instance Alternative Result where
   empty = Error
   Error <|> y = y
-  NewExamples es <|> _ = NewExamples es  
+  NewExamples es <|> _ = NewExamples es
   r@(Result x) <|> _ = r
 
 instance Functor Result where
@@ -246,7 +246,7 @@ confBySynt input expr st = Conf {confInput = input,
                                  confExamples = syntExamples st}
 
 matchGoal :: Goal -> Synt -> Expr -> Bool
-matchGoal (Goal goal) st expr = let examples = syntExamples st in 
+matchGoal (Goal goal) st expr = let examples = syntExamples st in
                                 foldl checkOnInput True $ zip examples goal
   where checkOnInput False _ = False
         checkOnInput acc (input, output) = let output' = eval (confBySynt input expr st) expr in
@@ -287,8 +287,6 @@ resolveStep (ifCond, ifDoThen, ifDoElse) r = do st <- get
                                                          syntUnsolvedGoals = Set.delete goal $ syntUnsolvedGoals st,
                                                          syntExprs = (expr, []) : syntExprs st }
 
--- data Resolver = Resolver { resolverGoal :: Goal, resolverCond :: Goal, resolverThen :: Goal, resolverElse :: Goal } -- ids ??
-
 -- clear goal tree up to root, add example, calculate exprs on input (could be recursive ?)
 saturateStep :: Expr -> SyntState ()
 saturateStep expr = do st <- get
@@ -310,3 +308,50 @@ terminateStep :: Expr -> SyntState (Maybe Expr)
 terminateStep expr = do st <- get
                         return $ if matchGoal (syntRoot st) st expr
                                  then Just expr else Nothing
+
+------
+
+-- TODO: with holes ?
+patterns0 :: [Expr]
+patterns0 = [ZeroE, EmptyListE]
+
+patterns1 :: [Expr]
+patterns1 = [NotE Hole, IncE Hole,
+             DecE Hole, Div2E Hole,
+             TailE Hole, HeadE Hole,
+             IsLeafE Hole, TreeValE Hole,
+             TreeLeftE Hole, TreeRightE Hole,
+             CreateLeafE Hole, SelfE Hole,
+             InputE Hole]
+
+patterns2 :: [Expr]
+patterns2 = [Hole :&&: Hole,
+             Hole :||: Hole,
+             Hole :+: Hole,
+             Hole :-: Hole,
+             Hole :++: Hole,
+             Hole ::: Hole]
+
+patterns3 :: [Expr]
+patterns3 = [CreateNodeE {nodeLeft = Hole, nodeRoot = Hole, nodeRight = Hole},
+             IfE {ifCond = Hole, ifDoThen = Hole, ifDoElse = Hole}]
+
+genNext1 :: [[Expr]] -> [Expr]
+genNext1 = head
+
+concatShuffle :: [[a]] -> [a]
+concatShuffle xxs = let xxs' = filter (not . null) xxs in
+                    if null xxs' then [] else
+                    map head xxs' ++ concatShuffle (map tail xxs')
+
+-- 1 2 3 ... n + n (n - 1) ... 1, take (n + 1) / 2
+genNext2 :: [[Expr]] -> [(Expr, Expr)]
+genNext2 exprs = let len = length exprs in
+                 take ((len + 1) `div` 2) $
+                 concatShuffle $
+                 zipWith (\xs ys -> ([(x, y) | x <- xs, y <- ys])) exprs $
+                 reverse exprs
+
+-- beautiful way to combine ??
+genNext3 :: [[Expr]] -> [(Expr, Expr, Expr)]
+genNext3 = undefined