crossover1 WIP

2024-02-23 17:12:27 +01:00 · 2024-02-23 17:12:27 +01:00 · aea502ad64
commit aea502ad64
parent a470fcc997
2 changed files with 483 additions and 1 deletions
--- a/src/LambdaCalculus.hs
+++ b/src/LambdaCalculus.hs
@ -0,0 +1,482 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module LambdaCalculus where
+
+import Data.Dynamic
+import Data.List (foldr1, last, lookup, zipWith3, (!!), (\\))
+import Data.List.Extra (delete, nubOrd, nubOrdOn)
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Map.Strict as Map
+import Data.Maybe
+import Data.Random
+import qualified Data.Text as T
+import Data.Typeable
+import GA
+import Pretty
+import Protolude
+import Test.QuickCheck hiding (sample, shuffle)
+import Test.QuickCheck.Monadic (assert, monadicIO)
+import qualified Type.Reflection as Ref
+
+data ExpressionWeights = ExpressionWeights
+  { lambdaSpucker :: Int,
+    lambdaSchlucker :: Int,
+    symbol :: Int,
+    variable :: Int,
+    constant :: Int
+  }
+
+data LambdaEnviroment = LambdaEnviroment
+  { functions :: (Map TypeRep [ConVal]),
+    constants :: (Map TypeRep [RVar ConVal]),
+    targetType :: TypeRep,
+    maxDepth :: Int,
+    weights :: ExpressionWeights
+  }
+
+showSanifid:: Show a => a -> Text
+showSanifid var = T.replace " -> " "To" (show var)
+
+exampleLE :: LambdaEnviroment
+exampleLE =
+  LambdaEnviroment
+    { functions =
+        Map.fromList
+          [ ((Ref.SomeTypeRep (Ref.TypeRep @(Int -> Int -> Int))), ["(+)", "(-)", "(*)", "mod"]),
+            ((Ref.SomeTypeRep (Ref.TypeRep @(Int -> Int -> Bool))), ["(>)", "(==)", "(>=)"]),
+            ((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Int -> Int -> Int))), ["if'"])
+          ],
+      constants =
+        Map.fromList
+          [ ((Ref.SomeTypeRep (Ref.TypeRep @(Int))), [(fmap show (uniform 0 10000 :: RVar Int))]),
+            ((Ref.SomeTypeRep (Ref.TypeRep @(Bool))), [(fmap show (uniform True False :: RVar Bool))])
+          ],
+      targetType = (Ref.SomeTypeRep (Ref.TypeRep @(Int -> Int -> Int))),
+      maxDepth = 10,
+      weights =
+        ExpressionWeights
+          { lambdaSpucker = 1,
+            lambdaSchlucker = 1,
+            symbol = 1,
+            variable = 1,
+            constant = 1
+          }
+    }
+
+type BoundVars = [TypeRep]
+
+-- we need a dynamic typ with a concept of equality here, should we want to interpret the result, instead of compiling it...
+type ConVal = Text
+
+-- LambdaSpucker - adds TypeRequester#1 as bound var and returns the result of TypeRequester#2
+
+data LambdaExpression = LambdaSpucker TypeRequester TypeRequester BoundVars | LambdaSchlucker TypeRequester BoundVars | Symbol ConVal [TypeRequester] BoundVars | Var TypeRep Int [TypeRequester] BoundVars | Constan ConVal deriving (Eq)
+
+asList :: LambdaExpression -> [TypeRequester]
+asList (LambdaSpucker tr1 tr2 _) = [tr1, tr2]
+asList (LambdaSchlucker tr _) = [tr]
+asList (Symbol _ trs _) = trs
+asList (Var _ _ trs _) = trs
+asList (Constan _) = []
+
+
+
+data TypeRequester = TR TypeRep (Maybe LambdaExpression) BoundVars deriving (Eq)
+
+toLambdaExpressionS :: TypeRequester -> Text
+toLambdaExpressionS (TR typeRep (Just lambdaExpression) boundVars) = "((" <> eToLambdaExpressionS lambdaExpression <> ") :: (" <> show typeRep <> "))"
+toLambdaExpressionS (TR _ (Nothing) _) = "Invalid Lambda Epr"
+
+-- data LambdaExpression = LambdaSpucker TypeRequester TypeRequester BoundVars | LambdaSchlucker TypeRequester BoundVars | Symbol ConVal [TypeRequester] BoundVars | Var TypeRep Int | Constan ConVal
+
+eToLambdaExpressionS :: LambdaExpression -> Text
+eToLambdaExpressionS (LambdaSpucker typeRequester1 typeRequester2 boundVars) = "(\\l" <> showSanifid (last boundVars) <> show (count boundVars (last boundVars) - 1) <> " -> " <> toLambdaExpressionS typeRequester2 <> ") " <> toLambdaExpressionS typeRequester1
+eToLambdaExpressionS (LambdaSchlucker typeRequester boundVars) = "\\l" <> showSanifid (last boundVars) <> show (count boundVars (last boundVars) - 1) <> " -> " <> toLambdaExpressionS typeRequester
+eToLambdaExpressionS (Symbol (valS) typeRequesters _) = valS <> " " <> (unwords (map toLambdaExpressionS typeRequesters))
+eToLambdaExpressionS (Var typeRep int typeRequesters _) = "l" <> showSanifid typeRep <> show int <> " " <> (unwords (map toLambdaExpressionS typeRequesters))
+eToLambdaExpressionS (Constan (valS)) = valS
+
+instance Pretty TypeRequester where
+  pretty = toLambdaExpressionShort
+
+instance Individual TypeRequester
+
+instance Pretty LambdaEnviroment where
+  pretty (LambdaEnviroment functions constants target _ _) = "Functions: " <> show functions <> " Constants: " <> show (Map.keys constants) <> " Target is a function: " <> show target
+
+genTypeRequester :: LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar TypeRequester
+genTypeRequester env depthLeft target boundVars = do
+  le <- genLambdaExpression env (depthLeft - 1) target boundVars
+  return (TR target (Just le) boundVars)
+
+genLambdaExpression :: LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
+genLambdaExpression env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar = do
+  let weightMap =
+        ( if not (canGenSchlucker target)
+            then [(constant weights, genLambdaConst env depthLeft target boundVar)]
+            else []
+        )
+          <> ( if depthLeft > 0
+                 then [(lambdaSpucker weights, genLambdaSpucker env depthLeft target boundVar)]
+                 else []
+             )
+          <> ( if canGenSchlucker target
+                 then [(lambdaSchlucker weights, genLambdaSchlucker env depthLeft target boundVar)]
+                 else []
+             )
+          <> ( if depthLeft > 0 && doAnyMatchThatType target (Map.keys functions)
+                 then [(symbol weights, genLambdaSymbol env depthLeft target boundVar)]
+                 else []
+             )
+          <> ( if depthLeft > 0 && doAnyMatchThatType target boundVar
+                 then [(variable weights, genLambdaVar env depthLeft target boundVar)]
+                 else []
+             )
+  expres <- selectWeighted weightMap
+  res <- expres
+  return res
+
+selectWeighted :: [(Int, a)] -> RVar a
+selectWeighted x = do
+  let total = sum (map fst x)
+  selection <- uniform 1 total
+  return $ selectAtWeight selection (NE.fromList x)
+
+selectAtWeight :: Int -> NonEmpty (Int, a) -> a
+selectAtWeight _ (x :| []) = snd x
+selectAtWeight w (x :| xs)
+  | fst x >= w = snd x
+  | otherwise = selectAtWeight (w - fst x) (NE.fromList xs)
+
+canGenSchlucker :: TypeRep -> Bool
+canGenSchlucker t = (typeRepTyCon t) == (typeRepTyCon (Ref.SomeTypeRep (Ref.TypeRep @(->))))
+
+doAnyMatchThatType :: TypeRep -> [TypeRep] -> Bool
+doAnyMatchThatType toGen available = any (doTypesMatch toGen) available
+
+doTypesMatch :: TypeRep -> TypeRep -> Bool
+doTypesMatch toGen available = elem toGen (available : (repeatedly (lastMay . typeRepArgs) available))
+
+genLambdaSpucker :: LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
+genLambdaSpucker env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar = do
+  lamdaTypeLength <- uniform 1 3
+  lambaTypes <- replicateM lamdaTypeLength (randomElement (Map.keys constants))
+  let lambaType = foldr1 mkFunTy lambaTypes
+  lamdaVarTypeRequester <- genTypeRequester env depthLeft lambaType boundVar
+  typeRequester <- genTypeRequester env depthLeft target (boundVar ++ [lambaType])
+  return (LambdaSpucker lamdaVarTypeRequester typeRequester (boundVar ++ [lambaType]))
+
+genLambdaSchlucker :: LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
+genLambdaSchlucker env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar = do
+  let args = typeRepArgs target
+  let lambaType = fromJust (head args)
+  let toFind = last args
+  typeRequester <- genTypeRequester env depthLeft toFind (boundVar ++ [lambaType])
+  return (LambdaSchlucker typeRequester (boundVar ++ [lambaType]))
+
+genLambdaConst :: LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
+genLambdaConst env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar = do
+  elm <- randomElement $ fromJust (Map.lookup target constants)
+  res <- elm
+  return $ Constan res
+
+genLambdaSymbol :: LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
+genLambdaSymbol env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar = do
+  let availFunTypes = filter (doTypesMatch target) (Map.keys functions)
+  (tr, fun) <- randomElement $ concatMap (\l -> zip (repeat l) (fromMaybe [] (Map.lookup l functions))) availFunTypes
+  ret <- genLambdaSymbol' tr fun [] env depthLeft target boundVar
+  return ret
+
+genLambdaSymbol' :: TypeRep -> ConVal -> [TypeRequester] -> LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
+genLambdaSymbol' tr v trs env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar
+  | tr == target = do
+      return $ Symbol v trs boundVar
+  | otherwise = do
+      let args = typeRepArgs tr
+      let param = fromJust (head args)
+      let rest = last args
+      newTypeRequ <- genTypeRequester env depthLeft param boundVar
+      ret <- genLambdaSymbol' rest v (trs ++ [newTypeRequ]) env depthLeft target boundVar
+      return ret
+
+genLambdaVar :: LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
+genLambdaVar env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar = do
+  let availTypes = filter (doTypesMatch target) boundVar
+  choosenType <- randomElement $ availTypes
+  let tCount = count boundVar choosenType
+  indexV <- uniform 0 (tCount-1)
+  ret <- genLambdaVar' choosenType choosenType indexV [] env depthLeft target boundVar
+  return ret
+
+genLambdaVar' :: TypeRep -> TypeRep -> Int -> [TypeRequester] -> LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
+genLambdaVar' tr varType varNumber trs env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar
+  | tr == target = do
+      return $ Var varType varNumber trs boundVar
+  | otherwise = do
+      let args = typeRepArgs tr
+      let param = fromJust (head args)
+      let rest = last args
+      newTypeRequ <- genTypeRequester env depthLeft param boundVar
+      ret <- genLambdaVar' rest varType varNumber (trs ++ [newTypeRequ]) env depthLeft target boundVar
+      return ret
+
+instance Environment TypeRequester LambdaEnviroment where
+new env@(LambdaEnviroment _ _ target maxDepth _) = do
+  tr <- genTypeRequester env maxDepth target []
+  return tr
+
+mutate env@(LambdaEnviroment _ _ _ maxDepth _) tr = do
+  let trCount = countTrsR(tr)
+  selectedTR <- uniform 1 trCount
+  let (depthAt,(TR trep _ bound)) = depthLeftAndTypeAtR tr selectedTR maxDepth
+  res <- genTypeRequester env depthAt trep bound
+  return $ replaceAtR selectedTR tr res
+
+crossover1 env@(LambdaEnviroment _ _ _ maxDepth _) tr1 tr2 = do
+  let trCount = countTrsR tr1
+  selectedIndex1 <- uniform 1 trCount
+  let (depthAt, selectedTr1@(TR trep _ bound)) = depthLeftAndTypeAtR tr selectedTR maxDepth
+  let indexes = findIndicesWhere tr2 ( == trep)
+  if length indexes == 0 then return Nothing else (do
+    (selectedTr2,selectedIndex2) <- randomElement indexes
+
+
+
+
+    )
+
+
+
+
+-- helper
+findIndicesWhere:: TypeRequester -> (TypeRep -> Bool) -> Int -> [(TypeRequester, Int)]
+findIndicesWhere tr@(TR t lE _) filte indx = case lE of
+                            Just le -> (tr, indx+1):(findIndicesWhere' (asList le) filte (indx+1))
+                            Nothing -> undefined
+
+findIndicesWhere':: [TypeRequester] -> (TypeRep -> Bool) -> Int -> [(TypeRequester, Int)]
+findIndicesWhere' (tr:trs) f indx = (findIndicesWhere tr f indx) ++ (findIndicesWhere' trs f (indx + countTrsR tr))
+
+
+depthLeftAndTypeInSubtreeWithIndex :: [TypeRequester] -> Int -> Int -> (Int, TypeRequester)
+depthLeftAndTypeInSubtreeWithIndex (tr:trs) indexLeft depthLeft = if countTrsR tr >= indexLeft then depthLeftAndTypeAtR tr indexLeft depthLeft else depthLeftAndTypeInSubtreeWithIndex trs (indexLeft - countTrsR tr) depthLeft
+depthLeftAndTypeInSubtreeWithIndex [] indexLeft depthLeft = undefined
+
+replaceAtR:: Int -> TypeRequester -> TypeRequester -> TypeRequester
+replaceAtR 0 _ with = with
+replaceAtR i (TR tm (Just le) bV) with = TR tm (Just (replaceAt (i-1) le with)) bV
+replaceAtR _ (TR _ Nothing _) _ = undefined
+
+-- LambdaSpucker TypeRequester TypeRequester BoundVars | LambdaSchlucker TypeRequester BoundVars | Symbol ConVal [TypeRequester] BoundVars | Var TypeRep Int [TypeRequester] BoundVars | Constan ConVal
+
+replaceAt:: Int -> LambdaExpression -> TypeRequester -> LambdaExpression
+replaceAt i le@(LambdaSpucker _ _ bv) with = LambdaSpucker (fromJust (head trs)) (last trs) bv where trs = replaceInSubtreeWithIndex i (asList le) with
+replaceAt i (LambdaSchlucker tr bv) with = LambdaSchlucker (replaceAtR i tr with) bv
+replaceAt i le@(Symbol cv _ bv) with = Symbol cv trs bv where trs = replaceInSubtreeWithIndex i (asList le) with
+replaceAt i le@(Var tr ix _ bv) with = Var tr ix trs bv where trs = replaceInSubtreeWithIndex i (asList le) with
+replaceAt _ (Constan _) _ = undefined
+
+
+
+replaceInSubtreeWithIndex :: Int -> [TypeRequester] -> TypeRequester  -> [TypeRequester]
+replaceInSubtreeWithIndex indexLeft (tr:trs) with = if countTrsR tr >= indexLeft then (replaceAtR indexLeft tr with):trs else tr:(replaceInSubtreeWithIndex (indexLeft - countTrsR tr) trs with)
+replaceInSubtreeWithIndex _ [] _ = undefined
+
+depthLeftAndTypeAtR::TypeRequester -> Int -> Int -> (Int, TypeRequester)
+depthLeftAndTypeAtR t 0 depthLeft = ((depthLeft - 1), t)
+depthLeftAndTypeAtR (TR _ (Just le)  _) indexLeft depthLeft = depthLeftAndTypeAt le (indexLeft - 1) (depthLeft - 1)
+depthLeftAndTypeAtR (TR _ Nothing  _) indexLeft depthLeft = undefined
+
+
+depthLeftAndTypeAt :: LambdaExpression -> Int -> Int -> (Int, TypeRequester)
+depthLeftAndTypeAt le indexLeft depthLeft = depthLeftAndTypeInSubtreeWithIndex (asList le) indexLeft depthLeft
+
+depthLeftAndTypeInSubtreeWithIndex :: [TypeRequester] -> Int -> Int -> (Int, TypeRequester)
+depthLeftAndTypeInSubtreeWithIndex (tr:trs) indexLeft depthLeft = if countTrsR tr >= indexLeft then depthLeftAndTypeAtR tr indexLeft depthLeft else depthLeftAndTypeInSubtreeWithIndex trs (indexLeft - countTrsR tr) depthLeft
+depthLeftAndTypeInSubtreeWithIndex [] indexLeft depthLeft = undefined
+
+
+countTrsR:: TypeRequester -> Int
+countTrsR tr@(TR t lE _) = case lE of
+                            Just le -> countTrs le + 1
+                            Nothing -> 1
+
+countTrs:: LambdaExpression -> Int
+countTrs le = sum (map countTrsR (asList le))
+
+repeatedly :: (a -> Maybe a) -> a -> [a]
+repeatedly f x = case f x of
+  Nothing -> []
+  Just y -> y : repeatedly f y
+
+count :: (Eq a) => [a] -> a -> Int
+count [] find = 0
+count ys find = length xs
+  where
+    xs = [xs | xs <- ys, xs == find]
+
+-- Test Stuff
+
+testConstInt :: TypeRequester
+testConstInt = TR (Ref.SomeTypeRep (Ref.TypeRep @Int)) (Just (Symbol ("5") [] [])) []
+
+testIntToClassCons :: TypeRequester
+testIntToClassCons = TR (Ref.SomeTypeRep (Ref.TypeRep @(Int -> ResClass))) (Just (Symbol ("Class1") [] [])) []
+
+testIntToClassCorrect :: TypeRequester
+testIntToClassCorrect =
+  TR
+    (Ref.SomeTypeRep (Ref.TypeRep @(Int -> ResClass)))
+    ( Just
+        ( LambdaSchlucker
+            ( TR
+                (Ref.SomeTypeRep (Ref.TypeRep @(ResClass)))
+                ( Just
+                    ( Symbol
+                        ("iteClass")
+                        [ ( TR
+                              (Ref.SomeTypeRep (Ref.TypeRep @(Bool)))
+                              ( Just
+                                  ( Symbol
+                                      ("eqInt")
+                                      [ ( TR
+                                            (Ref.SomeTypeRep (Ref.TypeRep @(Int)))
+                                            (Just (Var (Ref.SomeTypeRep (Ref.TypeRep @(Int))) 0 [] []))
+                                            [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                        ),
+                                        ( TR
+                                            (Ref.SomeTypeRep (Ref.TypeRep @(Int)))
+                                            (Just (Constan ("1")))
+                                            [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                        )
+                                      ]
+                                      [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                  )
+                              )
+                              [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                          ),
+                          ( TR
+                              (Ref.SomeTypeRep (Ref.TypeRep @(ResClass)))
+                              (Just (Constan ("Class1")))
+                              [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                          ),
+                          ( TR
+                              (Ref.SomeTypeRep (Ref.TypeRep @(ResClass)))
+                              ( Just
+                                  ( Symbol
+                                      ("iteClass")
+                                      [ ( TR
+                                            (Ref.SomeTypeRep (Ref.TypeRep @(Bool)))
+                                            ( Just
+                                                ( Symbol
+                                                    ("eqInt")
+                                                    [ ( TR
+                                                          (Ref.SomeTypeRep (Ref.TypeRep @(Int)))
+                                                          (Just (Var (Ref.SomeTypeRep (Ref.TypeRep @(Int))) 0 [] []))
+                                                          [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                                      ),
+                                                      ( TR
+                                                          (Ref.SomeTypeRep (Ref.TypeRep @(Int)))
+                                                          (Just (Constan ("2")))
+                                                          [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                                      )
+                                                    ]
+                                                    [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                                )
+                                            )
+                                            [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                        ),
+                                        ( TR
+                                            (Ref.SomeTypeRep (Ref.TypeRep @(ResClass)))
+                                            (Just (Constan ("Class2")))
+                                            [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                        ),
+                                        ( TR
+                                            (Ref.SomeTypeRep (Ref.TypeRep @(ResClass)))
+                                            ( Just
+                                                ( Symbol
+                                                    ("iteClass")
+                                                    [ ( TR
+                                                          (Ref.SomeTypeRep (Ref.TypeRep @(Bool)))
+                                                          ( Just
+                                                              ( Symbol
+                                                                  ("eqInt")
+                                                                  [ ( TR
+                                                                        (Ref.SomeTypeRep (Ref.TypeRep @(Int)))
+                                                                        (Just (Var (Ref.SomeTypeRep (Ref.TypeRep @(Int))) 0 [] []))
+                                                                        [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                                                    ),
+                                                                    ( TR
+                                                                        (Ref.SomeTypeRep (Ref.TypeRep @(Int)))
+                                                                        (Just (Constan ("3")))
+                                                                        [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                                                    )
+                                                                  ]
+                                                                  [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                                              )
+                                                          )
+                                                          [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                                      ),
+                                                      ( TR
+                                                          (Ref.SomeTypeRep (Ref.TypeRep @(ResClass)))
+                                                          (Just (Constan ("Class3")))
+                                                          [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                                      ),
+                                                      ( TR
+                                                          (Ref.SomeTypeRep (Ref.TypeRep @(ResClass)))
+                                                          (Just (Constan ("Class3")))
+                                                          [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                                      )
+                                                    ]
+                                                    [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                                )
+                                            )
+                                            [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                        )
+                                      ]
+                                      [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                                  )
+                              )
+                              [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                          )
+                        ]
+                        [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+                    )
+                )
+                [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+            )
+            [(Ref.SomeTypeRep (Ref.TypeRep @(Int)))]
+        )
+    )
+    []
+
+data ResClass = Class1 | Class2 | Class3 deriving (Enum, Show)
+
+eqInt :: Int -> Int -> Bool
+eqInt a b = a == b
+
+iteClass :: Bool -> ResClass -> ResClass -> ResClass
+iteClass True c _ = c
+iteClass False _ c = c
+
+toLambdaExpressionShort :: TypeRequester -> Text
+toLambdaExpressionShort (TR _ (Just lambdaExpression) _) = "(" <> eToLambdaExpressionShort lambdaExpression <> ")"
+toLambdaExpressionShort (TR _ (Nothing) _) = "Invalid Lambda Epr"
+
+-- data LambdaExpression = LambdaSpucker TypeRequester TypeRequester BoundVars | LambdaSchlucker TypeRequester BoundVars | Symbol ConVal [TypeRequester] BoundVars | Var TypeRep Int | Constan ConVal
+
+eToLambdaExpressionShort :: LambdaExpression -> Text
+eToLambdaExpressionShort (LambdaSpucker typeRequester1 typeRequester2 boundVars) = "(\\l" <> showSanifid (last boundVars) <> show (count boundVars (last boundVars) - 1) <> " -> " <> toLambdaExpressionShort typeRequester2 <> ") " <> toLambdaExpressionShort typeRequester1
+eToLambdaExpressionShort (LambdaSchlucker typeRequester boundVars) = "()\\l" <> showSanifid (last boundVars) <> show (count boundVars (last boundVars) - 1) <> " -> " <> toLambdaExpressionShort typeRequester <> ")"
+eToLambdaExpressionShort (Symbol (valS) typeRequesters _) = valS <> " " <> (unwords (map toLambdaExpressionShort typeRequesters))
+eToLambdaExpressionShort (Var typeRep int typeRequesters _) = "l" <> showSanifid typeRep <> show int <> " " <> (unwords (map toLambdaExpressionShort typeRequesters))
+eToLambdaExpressionShort (Constan (valS)) = valS
+
+res :: Int -> ResClass
+res = ((\lInt0 -> ((iteClass ((eqInt ((lInt0) :: (Int)) ((1) :: (Int))) :: (Bool)) ((Class1) :: (ResClass)) ((iteClass ((eqInt ((lInt0) :: (Int)) ((2) :: (Int))) :: (Bool)) ((Class2) :: (ResClass)) ((iteClass ((eqInt ((lInt0) :: (Int)) ((3) :: (Int))) :: (Bool)) ((Class3) :: (ResClass)) ((Class3) :: (ResClass))) :: (ResClass))) :: (ResClass))) :: (ResClass))) :: (Int -> ResClass))
--- a/src/Test.hs
+++ b/src/Test.hs
@ -38,5 +38,5 @@ if' :: Bool -> a -> a -> a
 if' True x _ = x
 if' False _ y = y

--f :: Int -> Int -> Int
+