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 idea behind the algorithm is that, if you have two pointers in a linked list, one moving twice as fast (the hare) than the other (the tortoise), then if they intersect, there is a cycle in the linked list. If they don't intersect, then there is no cycle.
Floyd's cycle finding algorithm or Hare-Tortoise algorithm is a pointer algorithm that uses only two pointers, moving through the sequence at different speeds. This algorithm is used to find a loop in a linked list. It uses two pointers one moving twice as fast as the other one.
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.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With