I want to translate the following Haskell code into Agda:
import Control.Arrow (first)
import Control.Monad (join)
safeTail :: [a] -> [a]
safeTail [] = []
safeTail (_:xs) = xs
floyd :: [a] -> [a] -> ([a], [a])
floyd xs [] = ([], xs)
floyd (x:xs) (_:ys) = first (x:) $ floyd xs (safeTail ys)
split :: [a] -> ([a], [a])
split = join floyd
This allows us to efficiently split a list into two:
split [1,2,3,4,5] = ([1,2,3], [4,5])
split [1,2,3,4,5,6] = ([1,2,3], [4,5,6])
So, I tried to convert this code to Agda:
floyd : {A : Set} → List A → List A → List A × List A
floyd xs [] = ([] , xs)
floyd (x :: xs) (_ :: ys) = first (x ::_) (floyd xs (safeTail ys))
The only problem is that Agda complains that I'm missing the case for floyd [] (y :: ys)
. However, this case should never arise. How can I prove to Agda that this case should never arise?
Here's a visual example of how this algorithm works:
+-------------+-------------+
| Tortoise | Hare |
+-------------+-------------+
| ^ 1 2 3 4 5 | ^ 1 2 3 4 5 |
| 1 ^ 2 3 4 5 | 1 2 ^ 3 4 5 |
| 1 2 ^ 3 4 5 | 1 2 3 4 ^ 5 |
| 1 2 3 ^ 4 5 | 1 2 3 4 5 ^ |
+-------------+-------------+
Here's another example:
+---------------+---------------+
| Tortoise | Hare |
+---------------+---------------+
| ^ 1 2 3 4 5 6 | ^ 1 2 3 4 5 6 |
| 1 ^ 2 3 4 5 6 | 1 2 ^ 3 4 5 6 |
| 1 2 ^ 3 4 5 6 | 1 2 3 4 ^ 5 6 |
| 1 2 3 ^ 4 5 6 | 1 2 3 4 5 6 ^ |
+---------------+---------------+
When the hare (the second argument to floyd
) reaches the end of the list, the tortoise (the first argument to floyd
) reaches the middle of the list. Thus, by using two pointers (the second one moving twice as fast as the first) we can efficiently split a list into two.
The same thing as Twan van Laarhoven suggests in the comments but with Vec
s. His version is probably better.
open import Function
open import Data.Nat.Base
open import Data.Product renaming (map to pmap)
open import Data.List.Base
open import Data.Vec hiding (split)
≤-step : ∀ {m n} -> m ≤ n -> m ≤ suc n
≤-step z≤n = z≤n
≤-step (s≤s le) = s≤s (≤-step le)
≤-refl : ∀ {n} -> n ≤ n
≤-refl {0} = z≤n
≤-refl {suc n} = s≤s ≤-refl
floyd : ∀ {A : Set} {n m} -> m ≤ n -> Vec A n -> Vec A m -> List A × List A
floyd z≤n xs [] = [] , toList xs
floyd (s≤s z≤n) (x ∷ xs) (y ∷ []) = x ∷ [] , toList xs
floyd (s≤s (s≤s le)) (x ∷ xs) (y ∷ z ∷ ys) = pmap (x ∷_) id (floyd (≤-step le) xs ys)
split : ∀ {A : Set} -> List A -> List A × List A
split xs = floyd ≤-refl (fromList xs) (fromList xs)
open import Relation.Binary.PropositionalEquality
test₁ : split (1 ∷ 2 ∷ 3 ∷ 4 ∷ 5 ∷ []) ≡ (1 ∷ 2 ∷ 3 ∷ [] , 4 ∷ 5 ∷ [])
test₁ = refl
test₂ : split (1 ∷ 2 ∷ 3 ∷ 4 ∷ 5 ∷ 6 ∷ []) ≡ (1 ∷ 2 ∷ 3 ∷ [] , 4 ∷ 5 ∷ 6 ∷ [])
test₂ = refl
Also, functions like ≤-refl
and ≤-step
are somewhere in the standard library, but I was lazy to search.
Here is a silly thing I like to do:
open import Function
open import Data.Nat.Base
open import Data.Product renaming (map to pmap)
open import Data.List.Base
open import Data.Vec hiding (split)
floyd : ∀ {A : Set}
-> (k : ℕ -> ℕ)
-> (∀ {n} -> Vec A (k (suc n)) -> Vec A (suc (k n)))
-> ∀ n
-> Vec A (k n)
-> List A × List A
floyd k u 0 xs = [] , toList xs
floyd k u 1 xs with u xs
... | x ∷ xs' = x ∷ [] , toList xs'
floyd k u (suc (suc n)) xs with u xs
... | x ∷ xs' = pmap (x ∷_) id (floyd (k ∘ suc) u n xs')
split : ∀ {A : Set} -> List A -> List A × List A
split xs = floyd id id (length xs) (fromList xs)
open import Relation.Binary.PropositionalEquality
test₁ : split (1 ∷ 2 ∷ 3 ∷ 4 ∷ 5 ∷ []) ≡ (1 ∷ 2 ∷ 3 ∷ [] , 4 ∷ 5 ∷ [])
test₁ = refl
test₂ : split (1 ∷ 2 ∷ 3 ∷ 4 ∷ 5 ∷ 6 ∷ []) ≡ (1 ∷ 2 ∷ 3 ∷ [] , 4 ∷ 5 ∷ 6 ∷ [])
test₂ = refl
This is partly based on the Benjamin Hodgson suggestion in the comment below.