a-conjecture-of-mine

An exercise on polyglossy: the same problem solved on multiple languages

Commit
1554a98150bf64df0e10dadd4f991f17925d31f5
Parent
81a611cfe7ffa7a6499e18eb8961645378a76527
Author
Pablo Escobar Gaviria <gark.garcia@protonmail.com>
Date

Removed the Idris implementation from the repo, sice it is far from complete.

Diffstat

3 files changed, 0 insertions, 222 deletions

Status File Name N° Changes Insertions Deletions
Deleted Idris/Data/Map.ibc 0 0 0
Deleted Idris/Data/Map.idr 149 0 149
Deleted Idris/Main.idr 73 0 73
diff --git a/Idris/Data/Map.ibc b/Idris/Data/Map.ibc
Binary files differ.
diff --git a/Idris/Data/Map.idr b/Idris/Data/Map.idr
@@ -1,149 +0,0 @@
-module Data.Map
-
-public export
-data Map k a = Bin Nat k a (Map k a) (Map k a)
-             | Tip
-
-implementation Sized (Map k a) where
-  size (Bin s _ _ _ _) = s
-  size Tip = 0
-
-ratio : Nat
-ratio = 2
-
-delta : Nat
-delta = 3
-
-raise : String -> Map k v
-raise _ = ?undefined
-
--- | /O(1)/. The empty map.
-public export
-empty : Map k a
-empty = Tip
-
--- | /O(1)/. A map with a single element.
---
--- > singleton 1 'a'        == fromList [(1, 'a')]
--- > size (singleton 1 'a') == 1
-public export
-singleton : k -> a -> Map k a
-singleton k x = Bin 1 k x Tip Tip
-
--- balanceL is called when left subtree might have been inserted to or when
--- right subtree might have been deleted from.
-balanceL : k -> a -> Map k a -> Map k a -> Map k a
-balanceL k x l r = 
-  case r of
-    Tip =>
-      case l of
-        Tip => Bin 1 k x Tip Tip
-        (Bin _ _ _ Tip Tip) => Bin 2 k x l Tip
-        (Bin _ lk lx Tip (Bin _ lrk lrx _ _)) => Bin 3 lrk lrx (Bin 1 lk lx Tip Tip) (Bin 1 k x Tip Tip)
-        (Bin _ lk lx ll@(Bin _ _ _ _ _) Tip) => Bin 3 lk lx ll (Bin 1 k x Tip Tip)
-        (Bin ls lk lx ll@(Bin lls _ _ _ _) lr@(Bin lrs lrk lrx lrl lrr)) =>
-          if lrs < ratio*lls 
-            then Bin (1+ls) lk lx ll (Bin (1+lrs) k x lr Tip)
-            else Bin (1+ls) lrk lrx (Bin (1+lls+size lrl) lk lx ll lrl) (Bin (1+size lrr) k x lrr Tip)
-
-    (Bin rs _ _ _ _) =>
-      case l of
-        Tip => Bin (1+rs) k x Tip r
-        (Bin ls lk lx ll lr) =>
-          if ls > delta*rs
-            then case (ll, lr) of
-              (Bin lls _ _ _ _, Bin lrs lrk lrx lrl lrr) =>
-                if lrs < ratio*lls
-                  then Bin (1+ls+rs) lk lx ll (Bin (1+rs+lrs) k x lr r)
-                  else Bin (1+ls+rs) lrk lrx (Bin (1+lls+size lrl) lk lx ll lrl) (Bin (1+rs+size lrr) k x lrr r)
-              (_, _) => raise "Failure in Data.Map.balanceL"
-            else Bin (1+ls+rs) k x l r
-
--- balanceR is called when right subtree might have been inserted to or when
--- left subtree might have been deleted from.
-balanceR : k -> a -> Map k a -> Map k a -> Map k a
-balanceR k x l r =
-  case l of
-    Tip =>
-      case r of
-        Tip => Bin 1 k x Tip Tip
-        (Bin _ _ _ Tip Tip) => Bin 2 k x Tip r
-        (Bin _ rk rx Tip rr@(Bin _ _ _ _ _)) => Bin 3 rk rx (Bin 1 k x Tip Tip) rr
-        (Bin _ rk rx (Bin _ rlk rlx _ _) Tip) => Bin 3 rlk rlx (Bin 1 k x Tip Tip) (Bin 1 rk rx Tip Tip)
-        (Bin rs rk rx rl@(Bin rls rlk rlx rll rlr) rr@(Bin rrs _ _ _ _)) =>
-          if rls < ratio*rrs
-            then Bin (1+rs) rk rx (Bin (1+rls) k x Tip rl) rr
-            else Bin (1+rs) rlk rlx (Bin (1+size rll) k x Tip rll) (Bin (1+rrs+size rlr) rk rx rlr rr)
-    (Bin ls _ _ _ _) =>
-      case r of
-        Tip => Bin (1+ls) k x l Tip
-        (Bin rs rk rx rl rr) =>
-          if rs > delta*ls
-            then case (rl, rr) of
-              (Bin rls rlk rlx rll rlr, Bin rrs _ _ _ _) =>
-                if  rls < ratio*rrs 
-                  then Bin (1+ls+rs) rk rx (Bin (1+ls+rls) k x l rl) rr
-                  else Bin (1+ls+rs) rlk rlx (Bin (1+ls+size rll) k x l rll) (Bin (1+rrs+size rlr) rk rx rlr rr)
-              (_, _) => raise "Failure in Data.Map.balanceR"
-            else Bin (1+ls+rs) k x l r
-
-
--- | /O(log n)/. Insert a new key and value in the map.
--- If the key is already present in the map, the associated value is
--- replaced with the supplied value. 'insert' is equivalent to
--- @'insertWith' 'const'@.
---
--- > insert 5 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'x')]
--- > insert 7 'x' (fromList [(5,'a'), (3,'b')]) == fromList [(3, 'b'), (5, 'a'), (7, 'x')]
--- > insert 5 'x' empty                         == singleton 5 'x'
---
--- See Map.Internal.Note: Type of local 'go' function
-public export
-insert : Ord k => k -> a -> Map k a -> Map k a
-insert = go where
-  go : Ord k => k -> a -> Map k a -> Map k a
-  go kx x Tip = singleton kx x
-  go kx x (Bin sz ky y l r) =
-    case compare kx ky of
-      LT => balanceL ky y (go kx x l) r
-      GT => balanceR ky y l (go kx x r)
-      EQ => Bin sz kx x l r
-
--- | /O(log n)/. Lookup the value at a key in the map.
---
--- The function will return the corresponding value as @('Just' value)@,
--- or 'Nothing' if the key isn't in the map.
---
--- An example of using @lookup@:
---
--- > import Prelude hiding (lookup)
--- > import Data.Map
--- >
--- > employeeDept = fromList([("John","Sales"), ("Bob","IT")])
--- > deptCountry = fromList([("IT","USA"), ("Sales","France")])
--- > countryCurrency = fromList([("USA", "Dollar"), ("France", "Euro")])
--- >
--- > employeeCurrency : String -> Maybe String
--- > employeeCurrency name = do
--- >     dept <- lookup name employeeDept
--- >     country <- lookup dept deptCountry
--- >     lookup country countryCurrency
--- >
--- > main = do
--- >     putStrLn $ "John's currency: " ++ (show (employeeCurrency "John"))
--- >     putStrLn $ "Pete's currency: " ++ (show (employeeCurrency "Pete"))
---
--- The output of this program:
---
--- >   John's currency: Just "Euro"
--- >   Pete's currency: Nothing
-public export
-lookup : Ord k => k -> Map k a -> Maybe a
-lookup = go where
-  go _ Tip = Nothing
-  go k (Bin _ kx x l r) =
-    case compare k kx of
-      LT => go k l
-      GT => go k r
-      EQ => Just x
-
diff --git a/Idris/Main.idr b/Idris/Main.idr
@@ -1,73 +0,0 @@
--- The following program is a simple test for the following conjecture:
-
--- Let S: N -> N be the sum of the digits of a positive integer.
--- For all A and B in N, S(A + B) = S(A) + S(B) - 9k, where k is an integer.
-
-module Main
-
-import System
-
-main : IO Int
-main = do
-    args <- getArgs
-        
-    case readDec <$> head' args of
-      Just [(max, "")] =>
-        if counter' max then exitFailure else exitSuccess
-      _ => exitInvalidInput
-      
-    where
-      head' : List a -> Maybe a
-      head' [] = Nothing
-      head' xs = Just (head xs)
-
--- Calculates the sum of the digits of `n`.
-sum' : Nat -> Int
-sum' n
-     | n < 10 = fromEnum n
-     | otherwise = fromEnum (n `mod` 10) + sum' (n `div` 10)
-
--- Returns `Just updated` if the if the conjecture holds for pair, where
--- `updated` is an updated versions of the sums cache provided by `sums`.
--- Otherwise returns `Nothing`.
-test' : Map Nat Int -> (Nat, Nat) -> Maybe (Map Nat Int)
-test' sums pair =
-    case diff sums pair of
-        Left updated =>
-            test' updated pair
-
-        Right dif =>
-            if dif `mod` 9 == 0 then Just sums else Nothing
-
--- Given a cache of the image of `sum'`, attemps to lookup `sum' a`, `sum' b`
--- and `sum' $ a + b`.
--- If the lookup succeeds, returns `Right (sum' (a + b) - sum' a - sum' a)`.
--- Otherwise inserts the value that caused the failure to `sums` and returns
--- `Left sums`.
-diff : Map Nat Int -> (Nat, Nat) -> Either (Map Nat Int) Int
-diff sums (a, b) = do
-    sa  <- lookupOrInsert a
-    sb  <- lookupOrInsert b
-    sab <- lookupOrInsert $ a + b
-
-    return $ sab - sa - sb
-    where lookupOrInsert x =
-            case Data.Map.lookup x sums of
-                Just sx => Right sx
-                
-                Nothing => Left (insert x (sum' x) sums)
-
--- Checks if there is any counterexample in
--- [(a, b) | a <- [0..max], b <- [a..max]].
---
--- Returns `True` if a counter example was found.
--- Otherwise returns `False`.
-counter' : Nat -> Bool
-counter' max =
-    case foldM test' empty [(a, b) | a <- [0..max], b <- [a..max]] of
-        Nothing => True
-        Just _  => False
-
-exitInvalidInput : IO Int
-exitInvalidInput = exitWith $ ExitFailure 2
-