haskellfunctional-programmingagdatheorem-provingfloyd-cycle-finding

How to implement Floyd's Hare and Tortoise algorithm in Agda?


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.


Solution

  • The same thing as Twan van Laarhoven suggests in the comments but with Vecs. 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.