Agda: parsing nested lists - parsing

I am trying to parse nested lists in Agda. I searched on google and the closest I have found is parsing addressed in Haskell, but usually libraries like "parsec" are used that are not available in Agda.
So I would like to parse "((1,2,3),(4,5,6))" with a result type of (List (List Nat)).
And further nested lists should be supported (up to depth 5), e.g., depth 3 would be (List (List (List Nat))).
My code is very long and cumbersome, and it only works for (List (List Nat)) but not for further nested lists. I didn't make any progress on my own.
If helpful, I would like to reuse splitBy from the first answer of one of my older posts.
NesList : ℕ → Set
NesList 0 = ℕ -- this case is easy
NesList 1 = List ℕ -- this case is easy
NesList 2 = List (List ℕ)
NesList 3 = List (List (List ℕ))
NesList 4 = List (List (List (List ℕ)))
NesList 5 = List (List (List (List (List ℕ)))) -- I am only interested to list depth 5
NesList _ = ℕ -- this is a hack, but I think okay for now
-- My implementation is *not* shown here
--
--
-- (it's about 80 lines long and uses 3 different functions
parseList2 : List Char → Maybe (List (List ℕ))
parseList2 _ = nothing -- dummy result
parseList : (dept : ℕ) → String → Maybe (NesList dept)
parseList 2 s = parseList2 (toList s)
parseList _ _ = nothing
-- Test Cases that are working (in my version)
p1 : parseList 2 "((1,2,3),(4,5,6))" ≡ just ((1 ∷ 2 ∷ 3 ∷ []) ∷ (4 ∷ 5 ∷ 6 ∷ []) ∷ [])
p1 = refl
p2 : parseList 2 "((1,2,3),(4,5,6),(7,8,9,10))" ≡ just ((1 ∷ 2 ∷ 3 ∷ []) ∷ (4 ∷ 5 ∷ 6 ∷ []) ∷ (7 ∷ 8 ∷ 9 ∷ 10 ∷ []) ∷ [])
p2 = refl
p3 : parseList 2 "((1),(2))" ≡ just ((1 ∷ []) ∷ (2 ∷ []) ∷ [])
p3 = refl
p4 : parseList 2 "((1,2))" ≡ just ((1 ∷ 2 ∷ []) ∷ [])
p4 = refl
-- Test Cases that are not working
-- i.e., List (List (List Nat))
lp5 : parseList 3 "(((1,2),(3,4)),((5,6),(7,8)))" ≡ just ( ((1 ∷ 2 ∷ []) ∷ (3 ∷ 4 ∷ []) ∷ []) ∷ ((5 ∷ 6 ∷ []) ∷ (7 ∷ 8 ∷ []) ∷ []) ∷ [])
lp5 = refl
EDIT1 **
Connor's talk at ICFP is online -- the title is "Agda-curious?".
It is from two days ago. Check it out!!
.
See the video:
http://www.youtube.com/watch?v=XGyJ519RY6Y
--
EDIT2:
I found a link that seems to be almost the code I need for my parsing.
There is a tokenize function provided:
https://github.com/fkettelhoit/agda-prelude/blob/master/Examples/PrefixCalculator.agda
--
EDIT3:
I finally found a simple combinator library that should be fast enough. There are no examples included in the library so I still have to look how to solve the problem.
Here is the link:
https://github.com/crypto-agda/agda-nplib/blob/master/lib/Text/Parser.agda
There is more agda-code from Nicolas Pouillard online:
https://github.com/crypto-agda

I don't have access to an agda implementation right now, so I can't check syntax, but this is how I would address it.
First, NesList can be simplified.
NesList 0 = ℕ
NesList (succ n) = List (NesList n)
Then you need a general-purpose list parsing function. Instead of Maybe you could use List to specify alternative parses. The return value is a successful parse and the remainder of the string.
Parser : Set -> Set
Parser a = List Char -> Maybe (Pair a (List Char))
This, given a parser routine for type x, parses a parenthesis-delineated comma-separated list of x.
parseGeneralList : { a : Set } Parser a -> Parser (List a)
parseGeneralList = ...implement me!...
This parses a general NesList.
parseNesList : (a : ℕ) -> Parser (NesList a)
parseNesList 0 = parseNat
parseNesList (succ n) = parseGeneralList (parseNesList n)
Edit: As was pointed out in the comments, code using this kind of Parser won't pass agda's termination checker. I'm thinking that if you want to do parser combinators you need a Stream based setup.

I'm a bit late to the party but I am currently writing a total parser combinators library and I have a fairly compact solution re-using the neat NesList type suggested by #NovaDenizen.
I use difference lists but the basic ones would do too (we'd simply have to replace DList.toList with List.reverse because chainl1 aggregates values left to right).
NList : Set → ℕ → Set
NList A zero = A
NList A (suc n) = List (NList A n)
NList′ : {A : Set} → [ Parser A ] →
(n : ℕ) → [ Parser (NList A n) ]
NList′ A zero = A
NList′ A (suc n) = parens $ return $ DList.toList <$>
chainl1 (DList.[_] <$> NList′ A n)
(return $ DList._++_ <$ char ',')
All the test cases pass successfully. I have added the example to the (monolithic) poc file so you can check for yourself
_ : "((1,2,3),(4,5,6))" ∈ NList′ decimal 2
_ = (1 ∷ 2 ∷ 3 ∷ []) ∷ (4 ∷ 5 ∷ 6 ∷ []) ∷ [] !
_ : "((1,2,3),(4,5,6),(7,8,9,10))" ∈ NList′ decimal 2
_ = (1 ∷ 2 ∷ 3 ∷ []) ∷ (4 ∷ 5 ∷ 6 ∷ []) ∷ (7 ∷ 8 ∷ 9 ∷ 10 ∷ []) ∷ [] !
_ : "((1),(2))" ∈ NList′ decimal 2
_ = (1 ∷ []) ∷ (2 ∷ []) ∷ [] !
_ : "((1,2))" ∈ NList′ decimal 2
_ = (1 ∷ 2 ∷ []) ∷ [] !
_ : "(((1,2),(3,4)),((5,6),(7,8)))" ∈ NList′ decimal 3
_ = ((1 ∷ 2 ∷ []) ∷ (3 ∷ 4 ∷ []) ∷ []) ∷
((5 ∷ 6 ∷ []) ∷ (7 ∷ 8 ∷ []) ∷ []) ∷ [] !

I post here my solution using parser combinators.
It uses the agda-nplib library is on github.
The code is far from optimal but it works.
module NewParser where
-- dummy
open import Data.Maybe
open import Data.Bool
-- includes
open import Data.List hiding (map)
-- ***
-- WAS PRELUDE IMPORTS
open import StringHelpers using (charToℕ; stringToℕ)
open import Data.String hiding (_==_; _++_)
open import Data.Char
open import Function
open import Data.Nat
open import Data.Unit
open import Data.Maybe
-- https://github.com/crypto-agda/agda-nplib/tree/master/lib/Text
open import Text.Parser
open import ParserHelpers
--- ****
--- Lessons Learned, this is the key:
--- (was a basic error that tyeps where too specific, generalisation not possible)
-- parseList : {A : Set} → Parser (Maybe A) → Parser (Maybe A) → ℕ → Parser (List (Maybe A))
-- converted to
-- parseList : {A : Set} → Parser A → Parser A → ℕ → Parser (List A)
-- *****
-- General ... Normal List (depth 1)
parseList : {A : Set} → Parser A → Parser A → ℕ → Parser (List A)
parseList oneMatcher manyMatcher n = ⟪ _++_ · (map toL oneMatcher) · (many n manyMatcher) ⟫
parseBracketList : {A : Set} → Parser A → Parser A → ℕ → Parser (List A)
parseBracketList oneMatcher manyMatcher n = bracket '(' (parseList oneMatcher manyMatcher n) ')'
parseCommaListConvert : {A : Set} → (List Char → A) → (Parser (List Char)) → ℕ → Parser (List A)
parseCommaListConvert convert parser = parseBracketList (⟪ convert · parser ⟫) (⟪ convert · parseOne "," *> parser ⟫)
-- For Numbers
number : Parser (List Char)
number = manyOneOf (toList "1234567890")
parseNumList : ℕ → Parser (List (Maybe ℕ))
parseNumList = parseCommaListConvert charsToℕ number
-- Nested List (depth 2)
--
parseListListNum : ℕ → Parser (List (List (Maybe ℕ)))
parseListListNum n = parseList (parseNumList n) ((parseOne ",") *> (parseNumList n)) n
parseManyLists : ℕ → Parser (List (List (Maybe ℕ)))
parseManyLists n = bracket '(' (parseListListNum n) ')'
-- Run the Parsers
--
open import MaybeEliminatorHelper
-- max number of terms is the number of characters in the string
-- this is for the termination checker
runParseList' : String → Maybe (List (Maybe ℕ))
runParseList' s = runParser (parseNumList (strLength s)) (toList s)
runParseList : String → Maybe (List ℕ)
runParseList = maybe-list-maybe-eliminate ∘ runParseList'
-- nested list
runParseNesList' : String → Maybe (List (List( Maybe ℕ)))
runParseNesList' s = runParser (parseManyLists (length (toList s))) (toList s)
runParseNesList : String → Maybe (List (List ℕ))
runParseNesList = maybe-list-list-maybe-eliminate ∘ runParseNesList'
Here is are my helper functions:
module MaybeEliminatorHelper where
open import Data.Maybe
open import Category.Monad
open import Function
open import Data.List
open import Category.Functor
sequence-maybe : ∀ {a} {A : Set a} → List (Maybe A) → Maybe (List A)
sequence-maybe = sequence Data.Maybe.monad
join : {A : Set} → Maybe (Maybe A) → Maybe A
join m = m >>= id
where
open RawMonad Data.Maybe.monad
maybe-list-elem : {A : Set} → Maybe (List (Maybe A)) → Maybe (List A)
maybe-list-elem mlm = join (sequence-maybe <$> mlm)
where open RawFunctor functor
{-
sequence-maybe : [Maybe a] -> Maybe [a]
join :: Maybe (Maybe a) -> Maybe a
Maybe (List (List (Maybe A))
Maybe.fmap (List.fmap sequenc-maybe)
Maybe (List (Maybe (List A))
Maybe.fmap sequence-maybe
Maybe (Maybe (List (List A)))
join
Maybe (List (List A))
join . Maybe.fmap sequence-maybe . Maybe.fmap (List.fmap sequenc-maybe)
join . Maybe.fmap (sequence-maybe . List.fmap sequenc-maybe)
(short form)
-}
maybe-list-elem2 : {A : Set} → Maybe (List (List (Maybe A))) → Maybe (List (List A))
maybe-list-elem2 = join ∘ Mfmap (sequence-maybe ∘ Lfmap sequence-maybe)
where
open RawMonad Data.Maybe.monad hiding (join) renaming (_<$>_ to Mfmap)
open RawMonad Data.List.monad hiding (join) renaming (_<$>_ to Lfmap)
maybe-list-maybe-eliminate = maybe-list-elem
maybe-list-list-maybe-eliminate = maybe-list-elem2
Further helper functions:
-- ***
-- WAS PRELUDE IMPORTS
open import StringHelpers using (charToℕ; stringToℕ)
open import Data.String hiding (_==_)
open import Data.Char
open import Function
open import Data.Nat
open import Data.Unit
open import Data.Maybe
open import Text.Parser
open import Data.List
-- mini helpers
--
parseOne : String → Parser Char
parseOne = oneOf ∘ toList
strLength : String → ℕ
strLength = length ∘ toList
-- misc helpers
--
charsToℕ : List Char → Maybe ℕ
charsToℕ [] = nothing
charsToℕ xs = stringToℕ (fromList xs)
toL : ∀ {a} {A : Set a} → A → List A
toL x = x ∷ []
-- test
l : List (Maybe ℕ)
l = (just 3) ∷ (just 3) ∷ []
-- Parser Helpers Nicolas
--
isSpace : Char → Bool
isSpace = (_==_ ' ')
spaces : Parser ⊤
spaces = manySat isSpace *> pure _
-- decide if seperator before after brackets is spaces
someSpaces : Parser ⊤
someSpaces = someSat isSpace *> pure _
tok : Char → Parser ⊤
tok c = spaces *> char c *> pure _
bracket : ∀ {A} → Char → Parser A → Char → Parser A
bracket start p stop = tok start *> p <* tok stop
And some test cases:
tn09 : pList "12,13,,14" ≡ nothing
tn09 = refl
tn08 : pList "" ≡ nothing
tn08 = refl
tn07 : pList "12,13,14" ≡ nothing
tn07 = refl
-- not working tn06 : pList "(12,13,14,17)," ≡ nothing
-- not working tn06 = refl
tn05 : pList "aa,bb,cc" ≡ nothing
tn05 = refl
tn04 : pList "11" ≡ nothing
tn04 = refl
tn03 : pList "(11,12,13)" ≡ just (11 ∷ 12 ∷ 13 ∷ [])
tn03 = refl
-- new testcases
tn11 : pList2 "((1,2,3),(4,5,6),(7,8,9))" ≡ just ((1 ∷ 2 ∷ 3 ∷ []) ∷ (4 ∷ 5 ∷ 6 ∷ []) ∷ (7 ∷ 8 ∷ 9 ∷ []) ∷ [])
tn11 = refl
-- old testcases
p1 : pList2 "((1,2,3),(4,5,6))" ≡ just ((1 ∷ 2 ∷ 3 ∷ []) ∷ (4 ∷ 5 ∷ 6 ∷ []) ∷ [])
p1 = refl
p2 : pList2 "((1,2,3),(4,5,6),(7,8,9,10))" ≡ just ((1 ∷ 2 ∷ 3 ∷ []) ∷ (4 ∷ 5 ∷ 6 ∷ []) ∷ (7 ∷ 8 ∷ 9 ∷ 10 ∷ []) ∷ [])
p2 = refl
p3 : pList2 "((1),(2))" ≡ just ((1 ∷ []) ∷ (2 ∷ []) ∷ [])
p3 = refl
p4 : pList2 "((1,2))" ≡ just ((1 ∷ 2 ∷ []) ∷ [])
p4 = refl
I am open for suggestions to improve the code.

Related

Termination checking failed

I was trying to train on this kata about longest common subsequences of a list which I slightly modified so that it worked with my versions of agda and the standard library (Agda 2.6.2, stdlib 1.7) which results in this code
{-# OPTIONS --safe #-}
module pg where
open import Data.List
open import Data.Nat
open import Data.Product
open import Relation.Nullary
open import Relation.Binary.PropositionalEquality
open import Relation.Binary
data Subseq {n} { A : Set n } : List A → List A → Set where
subseq-nil : Subseq [] []
subseq-take : ∀ a xs ys → Subseq xs ys → Subseq (a ∷ xs) (a ∷ ys)
subseq-drop : ∀ a xs ys → Subseq xs ys → Subseq xs (a ∷ ys)
is-lcs : ∀ {n} {A : Set n} → List A → List A → List A → Set n
is-lcs zs xs ys =
(Subseq zs xs × Subseq zs ys) ×
(∀ ts → Subseq ts xs → Subseq ts ys → length ts ≤ length zs)
longest : ∀ {n} {A : Set n} → List A → List A → List A
longest s1 s2 with length s1 ≤? length s2
... | yes _ = s2
... | no _ = s1
lcs : ∀ {n} {A : Set n} → Decidable {A = A} _≡_ → List A → List A → List A
lcs _ [] _ = []
lcs _ _ [] = []
lcs dec (x ∷ xs) (y ∷ ys) with dec x y
... | yes _ = x ∷ lcs dec xs ys
... | no _ = longest (lcs dec (x ∷ xs) ys) (lcs dec xs (y ∷ ys))
Unfortunetaly, Agda fails to recognize that lcs is a terminating function, which I honestly don't understand : the recursive calls are made on structurally smaller arguments if I get it right ?
If anyone can explain me what the problem is here, it would help tremendously. Thanks in advance !
Try to avoid using with when dealing with termination. The termination checker is successful when your code is refactored as follows (note that I removed your first two definitions because they are irrelevant in your question, maybe you should edit it accordingly):
{-# OPTIONS --safe #-}
open import Data.List
open import Data.Nat
open import Relation.Nullary
open import Relation.Binary.PropositionalEquality
open import Relation.Binary
open import Data.Bool using (if_then_else_)
module Term where
longest : ∀ {a} {A : Set a} → List A → List A → List A
longest s1 s2 with length s1 ≤? length s2
... | yes _ = s2
... | no _ = s1
lcs : ∀ {a} {A : Set a} → Decidable {A = A} _≡_ → List A → List A → List A
lcs _ [] _ = []
lcs _ _ [] = []
lcs dec (x ∷ xs) (y ∷ ys) = if does (dec x y) then
x ∷ lcs dec xs ys else
longest (lcs dec (x ∷ xs) ys) (lcs dec xs (y ∷ ys))
Apparently, this is a known limitation of the with abstraction combined with the termination checker as noted in the wiki:
https://agda.readthedocs.io/en/v2.6.2.1/language/with-abstraction.html#termination-checking
Here is a similar question:
Failing termination check with a with-abstraction

How to prove unfold-reverse for Vec?

The Agda standard library has a few properties on how reverse and _++_ work on List. Trying to transfer these proofs to Vec appears to be non-trivial (disregarding universes):
open import Data.Nat
open import Data.Vec
open import Relation.Binary.HeterogeneousEquality
unfold-reverse : {A : Set} → (x : A) → {n : ℕ} → (xs : Vec A n) →
reverse (x ∷ xs) ≅ reverse xs ++ [ x ]
TL;DR: How to prove unfold-reverse?
The rest of this question outlines approaches to doing so and explains what problems surface.
The type of this property is very similar to the List counter part in Data.List.Properties. The proof involves a helper which roughly translates to:
open import Function
helper : ∀ {n m} → (xs : Vec A n) → (ys : Vec A m) →
foldl (Vec A ∘ (flip _+_ n)) (flip _∷_) xs ys ≅ reverse ys ++ xs
Trying to insert this helper in unfold-reverse fails, because the left hand reverse is a foldl application with Vec A ∘ suc as first argument whereas the left hand side of helper has a foldl application with Vec A ∘ (flip _+_ 1) as first argument. Even though suc ≗ flip _+_ 1 is readily available from Data.Nat.Properties.Simple, it cannot be used here as cong would need a non-pointwise equality here and we don't have extensionality without further assumptions.
Removing the flip from flip _+_ n in helper yields a type error, so that is no option either.
Any other ideas?
The Data.Vec.Properties module contains this function:
foldl-cong : ∀ {a b} {A : Set a}
{B₁ : ℕ → Set b}
{f₁ : ∀ {n} → B₁ n → A → B₁ (suc n)} {e₁}
{B₂ : ℕ → Set b}
{f₂ : ∀ {n} → B₂ n → A → B₂ (suc n)} {e₂} →
(∀ {n x} {y₁ : B₁ n} {y₂ : B₂ n} →
y₁ ≅ y₂ → f₁ y₁ x ≅ f₂ y₂ x) →
e₁ ≅ e₂ →
∀ {n} (xs : Vec A n) →
foldl B₁ f₁ e₁ xs ≅ foldl B₂ f₂ e₂ xs
foldl-cong _ e₁=e₂ [] = e₁=e₂
foldl-cong {B₁ = B₁} f₁=f₂ e₁=e₂ (x ∷ xs) =
foldl-cong {B₁ = B₁ ∘ suc} f₁=f₂ (f₁=f₂ e₁=e₂) xs
Here is more or less elaborated solution:
unfold-reverse : {A : Set} → (x : A) → {n : ℕ} → (xs : Vec A n) →
reverse (x ∷ xs) ≅ reverse xs ++ (x ∷ [])
unfold-reverse x xs = begin
foldl (Vec _ ∘ _+_ 1) (flip _∷_) (x ∷ []) xs
≅⟨ (foldl-cong
{B₁ = Vec _ ∘ _+_ 1}
{f₁ = flip _∷_}
{e₁ = x ∷ []}
{B₂ = Vec _ ∘ flip _+_ 1}
{f₂ = flip _∷_}
{e₂ = x ∷ []}
(λ {n} {a} {as₁} {as₂} as₁≅as₂ -> {!!})
refl
xs) ⟩
foldl (Vec _ ∘ flip _+_ 1) (flip _∷_) (x ∷ []) xs
≅⟨ helper (x ∷ []) xs ⟩
reverse xs ++ x ∷ []
∎
Note, that only B₁ and B₂ are distinct in the arguments of the foldl-cong function. After simplifying context in the hole we have
Goal: a ∷ as₁ ≅ a ∷ as₂
————————————————————————————————————————————————————————————
as₁≅as₂ : as₁ ≅ as₂
as₂ : Vec A (n + 1)
as₁ : Vec A (1 + n)
a : A
n : ℕ
A : Set
So we need to prove, that at each recursive call adding an element to an accumulator of type Vec A (n + 1) is equal to adding an element to an accumulator of type Vec A (1 + n), and then results of two foldls are equal. The proof itself is simple. Here is the whole code:
open import Function
open import Relation.Binary.HeterogeneousEquality
open import Data.Nat
open import Data.Vec
open import Data.Nat.Properties.Simple
open import Data.Vec.Properties
open ≅-Reasoning
postulate
helper : ∀ {n m} {A : Set} (xs : Vec A n) (ys : Vec A m)
-> foldl (Vec A ∘ flip _+_ n) (flip _∷_) xs ys ≅ reverse ys ++ xs
cong' : ∀ {α β γ} {I : Set α} {i j : I}
-> (A : I -> Set β) {B : {k : I} -> A k -> Set γ} {x : A i} {y : A j}
-> i ≅ j
-> (f : {k : I} -> (x : A k) -> B x)
-> x ≅ y
-> f x ≅ f y
cong' _ refl _ refl = refl
unfold-reverse : {A : Set} → (x : A) → {n : ℕ} → (xs : Vec A n) →
reverse (x ∷ xs) ≅ reverse xs ++ (x ∷ [])
unfold-reverse x xs = begin
foldl (Vec _ ∘ _+_ 1) (flip _∷_) (x ∷ []) xs
≅⟨ (foldl-cong
{B₁ = Vec _ ∘ _+_ 1}
{f₁ = flip _∷_}
{e₁ = x ∷ []}
{B₂ = Vec _ ∘ flip _+_ 1}
{f₂ = flip _∷_}
{e₂ = x ∷ []}
(λ {n} {a} {as₁} {as₂} as₁≅as₂ -> begin
a ∷ as₁
≅⟨ cong' (Vec _) (sym (≡-to-≅ (+-comm n 1))) (_∷_ a) as₁≅as₂ ⟩
a ∷ as₂
∎)
refl
xs) ⟩
foldl (Vec _ ∘ flip _+_ 1) (flip _∷_) (x ∷ []) xs
≅⟨ helper (x ∷ []) xs ⟩
reverse xs ++ x ∷ []
∎

Termination check on list merge

Agda 2.3.2.1 can't see that the following function terminates:
open import Data.Nat
open import Data.List
open import Relation.Nullary
merge : List ℕ → List ℕ → List ℕ
merge (x ∷ xs) (y ∷ ys) with x ≤? y
... | yes p = x ∷ merge xs (y ∷ ys)
... | _ = y ∷ merge (x ∷ xs) ys
merge xs ys = xs ++ ys
Agda wiki says that it's OK for the termination checker if the arguments on recursive calls decrease lexicographically. Based on that it seems that this function should also pass. So what am I missing here? Also, is it maybe OK in previous versions of Agda? I've seen similar code on the Internet and no one mentioned termination issues there.
I cannot give you the reason why exactly this happens, but I can show you how to cure the symptoms. Before I start: This is a known problem with the termination checker. If you are well-versed in Haskell, you could take a look at the source.
One possible solution is to split the function into two: first one for the case where the first argument gets smaller and second for the second one:
mutual
merge : List ℕ → List ℕ → List ℕ
merge (x ∷ xs) (y ∷ ys) with x ≤? y
... | yes _ = x ∷ merge xs (y ∷ ys)
... | no _ = y ∷ merge′ x xs ys
merge xs ys = xs ++ ys
merge′ : ℕ → List ℕ → List ℕ → List ℕ
merge′ x xs (y ∷ ys) with x ≤? y
... | yes _ = x ∷ merge xs (y ∷ ys)
... | no _ = y ∷ merge′ x xs ys
merge′ x xs [] = x ∷ xs
So, the first function chops down xs and once we have to chop down ys, we switch to the second function and vice versa.
Another (perhaps surprising) option, which is also mentioned in the issue report, is to introduce the result of recursion via with:
merge : List ℕ → List ℕ → List ℕ
merge (x ∷ xs) (y ∷ ys) with x ≤? y | merge xs (y ∷ ys) | merge (x ∷ xs) ys
... | yes _ | r | _ = x ∷ r
... | no _ | _ | r = y ∷ r
merge xs ys = xs ++ ys
And lastly, we can perform the recursion on Vectors and then convert back to List:
open import Data.Vec as V
using (Vec; []; _∷_)
merge : List ℕ → List ℕ → List ℕ
merge xs ys = V.toList (go (V.fromList xs) (V.fromList ys))
where
go : ∀ {n m} → Vec ℕ n → Vec ℕ m → Vec ℕ (n + m)
go {suc n} {suc m} (x ∷ xs) (y ∷ ys) with x ≤? y
... | yes _ = x ∷ go xs (y ∷ ys)
... | no _ rewrite lem n m = y ∷ go (x ∷ xs) ys
go xs ys = xs V.++ ys
However, here we need a simple lemma:
open import Relation.Binary.PropositionalEquality
lem : ∀ n m → n + suc m ≡ suc (n + m)
lem zero m = refl
lem (suc n) m rewrite lem n m = refl
We could also have go return List directly and avoid the lemma altogether:
merge : List ℕ → List ℕ → List ℕ
merge xs ys = go (V.fromList xs) (V.fromList ys)
where
go : ∀ {n m} → Vec ℕ n → Vec ℕ m → List ℕ
go (x ∷ xs) (y ∷ ys) with x ≤? y
... | yes _ = x ∷ go xs (y ∷ ys)
... | no _ = y ∷ go (x ∷ xs) ys
go xs ys = V.toList xs ++ V.toList ys
The first trick (i.e. split the function into few mutually recursive ones) is actually quite good to remember. Since the termination checker doesn't look inside the definitions of other functions you use, it rejects a great deal of perfectly fine programs, consider:
data Rose {a} (A : Set a) : Set a where
[] : Rose A
node : A → List (Rose A) → Rose A
And now, we'd like to implement mapRose:
mapRose : ∀ {a b} {A : Set a} {B : Set b} →
(A → B) → Rose A → Rose B
mapRose f [] = []
mapRose f (node t ts) = node (f t) (map (mapRose f) ts)
The termination checker, however, doesn't look inside the map to see if it doesn't do anything funky with the elements and just rejects this definition. We must inline the definition of map and write a pair of mutually recursive functions:
mutual
mapRose : ∀ {a b} {A : Set a} {B : Set b} →
(A → B) → Rose A → Rose B
mapRose f [] = []
mapRose f (node t ts) = node (f t) (mapRose′ f ts)
mapRose′ : ∀ {a b} {A : Set a} {B : Set b} →
(A → B) → List (Rose A) → List (Rose B)
mapRose′ f [] = []
mapRose′ f (t ∷ ts) = mapRose f t ∷ mapRose′ f ts
Usually, you can hide most of the mess in a where declaration:
mapRose : ∀ {a b} {A : Set a} {B : Set b} →
(A → B) → Rose A → Rose B
mapRose {A = A} {B = B} f = go
where
go : Rose A → Rose B
go-list : List (Rose A) → List (Rose B)
go [] = []
go (node t ts) = node (f t) (go-list ts)
go-list [] = []
go-list (t ∷ ts) = go t ∷ go-list ts
Note: Declaring signatures of both functions before they are defined can be used instead of mutual in newer versions of Agda.
Update: The development version of Agda got an update to the termination checker, I'll let the commit message and release notes speak for themselves:
A revision of call graph completion that can deal with arbitrary termination depth.
This algorithm has been sitting around in MiniAgda for some time,
waiting for its great day. It is now here!
Option --termination-depth can now be retired.
And from the release notes:
Termination checking of functions defined by 'with' has been improved.
Cases which previously required --termination-depth (now obsolete!)
to pass the termination checker (due to use of 'with') no longer
need the flag. For example
merge : List A → List A → List A
merge [] ys = ys
merge xs [] = xs
merge (x ∷ xs) (y ∷ ys) with x ≤ y
merge (x ∷ xs) (y ∷ ys) | false = y ∷ merge (x ∷ xs) ys
merge (x ∷ xs) (y ∷ ys) | true = x ∷ merge xs (y ∷ ys)
This failed to termination check previously, since the 'with'
expands to an auxiliary function merge-aux:
merge-aux x y xs ys false = y ∷ merge (x ∷ xs) ys
merge-aux x y xs ys true = x ∷ merge xs (y ∷ ys)
This function makes a call to merge in which the size of one of the
arguments is increasing. To make this pass the termination checker
now inlines the definition of merge-aux before checking, thus
effectively termination checking the original source program.
As a result of this transformation doing 'with' on a variable no
longer preserves termination. For instance, this does not
termination check:
bad : Nat → Nat
bad n with n
... | zero = zero
... | suc m = bad m
And indeed, your original function now passes the termination check!

Agda: parse a string with numbers

I am trying to parse a string with natural numbers in Agda.
e.g., the result of stringListToℕ "1,2,3" should be Just (1 ∷ 2 ∷ 3 ∷ [])
My current code is not quite right or by any means nice, but it works.
However it returns the type:
Maybe (List (Maybe ℕ))
The Question is:
How to implement the function stringListToℕ in a nice way (compared to my code);
it should have the type Maybe (List ℕ)
(optional, not important) How can I convert the type Maybe (List (Maybe ℕ)) to Maybe (List ℕ)?
My Code:
charToℕ : Char → Maybe ℕ
charToℕ '0' = just 0
charToℕ '1' = just 1
charToℕ '2' = just 2
charToℕ '3' = just 3
charToℕ '4' = just 4
charToℕ '5' = just 5
charToℕ '6' = just 6
charToℕ '7' = just 7
charToℕ '8' = just 8
charToℕ '9' = just 9
charToℕ _ = nothing
stringToℕ' : List Char → (acc : ℕ) → Maybe ℕ
stringToℕ' [] acc = just acc
stringToℕ' (x ∷ xs) acc = charToℕ x >>= λ n → stringToℕ' xs ( 10 * acc + n )
stringToℕ : String → Maybe ℕ
stringToℕ s = stringToℕ' (toList s) 0
isComma : Char → Bool
isComma h = h Ch.== ','
notComma : Char → Bool
notComma ',' = false
notComma _ = true
{-# NO_TERMINATION_CHECK #-}
split : List Char → List (List Char)
split [] = []
split s = l ∷ split (drop (length(l) + 1) s)
where l : List Char
l = takeWhile notComma s
isNothing' : Maybe ℕ → Bool
isNothing' nothing = true
isNothing' _ = false
isNothing : List (Maybe ℕ) → Bool
isNothing l = any isNothing' l
-- wrong type, should be String -> Maybe (List N)
stringListToℕ : String → Maybe (List (Maybe ℕ))
stringListToℕ s = if (isNothing res) then nothing else just res
where res : List (Maybe ℕ)
res = map stringToℕ (map fromList( split (Data.String.toList s)))
test1 = stringListToℕ "1,2,3"
-- => just (just 1 ∷ just 2 ∷ just 3 ∷ [])
EDIT
I tried to write a conversion function using from-just, but this gives a error when type checking:
conv : Maybe (List (Maybe ℕ)) → Maybe (List ℕ)
conv (just xs) = map from-just xs
conv _ = nothing
the error is:
Cannot instantiate the metavariable _143 to solution
(Data.Maybe.From-just (_145 xs) x) since it contains the variable x
which is not in scope of the metavariable or irrelevant in the
metavariable but relevant in the solution
when checking that the expression from-just has type
Maybe (_145 xs) → _143 xs
I took the liberty of rewriting your split function into something more general which also works with the termination check:
open import Data.List
open import Data.Product
open import Function
splitBy : ∀ {a} {A : Set a} → (A → Bool) → List A → List (List A)
splitBy {A = A} p = uncurry′ _∷_ ∘ foldr step ([] , [])
where
step : A → List A × List (List A) → List A × List (List A)
step x (cur , acc) with p x
... | true = x ∷ cur , acc
... | false = [] , cur ∷ acc
Also, stringToℕ "" should most likely be nothing, unless you really want:
stringListToℕ "1,,2" ≡ just (1 ∷ 0 ∷ 2 ∷ [])
Let's rewrite it a bit (note that helper is your original stringToℕ function):
stringToℕ : List Char → Maybe ℕ
stringToℕ [] = nothing
stringToℕ list = helper list 0
where {- ... -}
And now we can put it all together. For simplicity I'm using List Char everywhere, sprinkle with fromList/toList as necessary):
let x1 = s : List Char -- start
let x2 = splitBy notComma x1 : List (List Char) -- split at commas
let x3 = map stringToℕ x2 : List (Maybe ℕ) -- map our ℕ-conversion
let x4 = sequence x3 : Maybe (List ℕ) -- turn Maybe inside out
You can find sequence in Data.List; we also have to specify which monad instance we want to use. Data.Maybe exports its monad instance under the name monad. Final code:
open import Data.Char
open import Data.List
open import Data.Maybe
open import Data.Nat
open import Function
stringListToℕ : List Char → Maybe (List ℕ)
stringListToℕ = sequence Data.Maybe.monad ∘ map stringToℕ ∘ splitBy notComma
And a small test:
open import Relation.Binary.PropositionalEquality
test : stringListToℕ ('1' ∷ '2' ∷ ',' ∷ '3' ∷ []) ≡ just (12 ∷ 3 ∷ [])
test = refl
Considering your second question: there are many ways to turn a Maybe (List (Maybe ℕ)) into a Maybe (List ℕ), for example:
silly : Maybe (List (Maybe ℕ)) → Maybe (List ℕ)
silly _ = nothing
Right, this doesn't do much. We'd like the conversion to preserve the elements if they are all just. isNothing already does this part of checking but it cannot get rid of the inner Maybe layer.
from-just could work since we know that when we use it, all elements of the List must be just x for some x. The problem is that conv in its current form is just wrong - from-just works as a function of type Maybe A → A only when the Maybe value is just x! We could very well do something like this:
test₂ : Maybe (List ℕ)
test₂ = conv ∘ just $ nothing ∷ just 1 ∷ []
And since from-list behaves as a Maybe A → ⊤ when given nothing, we are esentially trying to construct a heterogeneous list with elements of type both ⊤ and ℕ.
Let's scrap this solution, I'll show a much simpler one (in fact, it should resemble the first part of this answer).
We are given a Maybe (List (Maybe ℕ)) and we gave two goals:
take the inner List (Maybe ℕ) (if any), check if all elements are just x and in this case put them all into a list wrapped in a just, otherwise return nothing
squash the doubled Maybe layer into one
Well, the second point sounds familiar - that's something monads can do! We get:
join : {A : Set} → Maybe (Maybe A) → Maybe A
join mm = mm >>= λ x → x
where
open RawMonad Data.Maybe.monad
This function could work with any monad but we'll be fine with Maybe.
And for the first part, we need a way to turn a List (Maybe ℕ) into a Maybe (List ℕ) - that is, we want to swap the layers while propagating the possible error (i.e. nothing) into the outer layer. Haskell has specialized typeclass for this kind of stuff (Traversable from Data.Traversable), this question has some excellent answers if you'd like to know more. Basically, it's all about rebuilding the structure while collecting the "side effects". We'll be fine with the version that works just for Lists and we're back at sequence again.
There's still one piece missing, let's look at what we have so far:
sequence-maybe : List (Maybe ℕ) → Maybe (List ℕ)
sequence-maybe = sequence Data.Maybe.monad
join : Maybe (Maybe (List ℕ)) → Maybe (List ℕ)
-- substituting A with List ℕ
We need to apply sequence-maybe inside one Maybe layer. That's where the Maybe functor instance comes into play (you could do it with a monad instance alone, but it's more convenient). With this functor instance, we can lift an ordinary function of type a → b into a function of type Maybe a → Maybe b. And finally:
open import Category.Functor
open import Data.Maybe
final : Maybe (List (Maybe ℕ)) → Maybe (List ℕ)
final mlm = join (sequence-maybe <$> mlm)
where
open RawFunctor functor
I had a go at it trying not to be clever and using simple recursive functions rather than stdlib magic. parse xs m ns parses xs by recording the (possibly empty) prefix already read in m while keeping the list of numbers already parsed in the accumulator ns.
If a parsing failure happens (non recognized character, two consecutive ,, etc.) everything is thrown away and we return nothing.
module parseList where
open import Data.Nat
open import Data.List
open import Data.Maybe
open import Data.Char
open import Data.String
isDigit : Char → Maybe ℕ
isDigit '0' = just 0
isDigit '1' = just 1
isDigit '2' = just 2
isDigit '3' = just 3
isDigit _ = nothing
attach : Maybe ℕ → ℕ → ℕ
attach nothing n = n
attach (just m) n = 10 * m + n
Quote : List Char → Maybe (List ℕ)
Quote xs = parse xs nothing []
where
parse : List Char → Maybe ℕ → List ℕ → Maybe (List ℕ)
parse [] nothing ns = just ns
parse [] (just n) ns = just (n ∷ ns)
parse (',' ∷ tl) (just n) ns = parse tl nothing (n ∷ ns)
parse (hd ∷ tl) m ns with isDigit hd
... | nothing = nothing
... | just n = parse tl (just (attach m n)) ns
stringListToℕ : String → Maybe (List ℕ)
stringListToℕ xs with Quote (toList xs)
... | nothing = nothing
... | just ns = just (reverse ns)
open import Relation.Binary.PropositionalEquality
test : stringListToℕ ("12,3") ≡ just (12 ∷ 3 ∷ [])
test = refl
Here is the Code from Vitus as a running example that uses the Agda Prelude
module Parse where
open import Prelude
-- Install Prelude
---- clone this git repo:
---- https://github.com/fkettelhoit/agda-prelude
-- Configure Prelude
--- press Meta/Alt and the letter X together
--- type "customize-group" (i.e. in the mini buffer)
--- type "agda2"
--- expand the Entry "Agda2 Include Dirs:"
--- add the directory
open import Data.Product using (uncurry′)
open import Data.Maybe using ()
open import Data.List using (sequence)
splitBy : ∀ {a} {A : Set a} → (A → Bool) → List A → List (List A)
splitBy {A = A} p = uncurry′ _∷_ ∘ foldr step ([] , [])
where
step : A → List A × List (List A) → List A × List (List A)
step x (cur , acc) with p x
... | true = x ∷ cur , acc
... | false = [] , cur ∷ acc
charsToℕ : List Char → Maybe ℕ
charsToℕ [] = nothing
charsToℕ list = stringToℕ (fromList list)
notComma : Char → Bool
notComma c = not (c == ',')
-- Finally:
charListToℕ : List Char → Maybe (List ℕ)
charListToℕ = Data.List.sequence Data.Maybe.monad ∘ map charsToℕ ∘ splitBy notComma
stringListToℕ : String → Maybe (List ℕ)
stringListToℕ = charListToℕ ∘ toList
-- Test
test1 : charListToℕ ('1' ∷ '2' ∷ ',' ∷ '3' ∷ []) ≡ just (12 ∷ 3 ∷ [])
test1 = refl
test2 : stringListToℕ "12,33" ≡ just (12 ∷ 33 ∷ [])
test2 = refl
test3 : stringListToℕ ",,," ≡ nothing
test3 = refl
test4 : stringListToℕ "abc,def" ≡ nothing
test4 = refl

≡-Reasoning and 'with' patterns

I was proving some properties of filter and map, everything went quite good until I stumbled on this property: filter p (map f xs) ≡ map f (filter (p ∘ f) xs). Here's a part of the code that's relevant:
open import Relation.Binary.PropositionalEquality
open import Data.Bool
open import Data.List hiding (filter)
import Level
filter : ∀ {a} {A : Set a} → (A → Bool) → List A → List A
filter _ [] = []
filter p (x ∷ xs) with p x
... | true = x ∷ filter p xs
... | false = filter p xs
Now, because I love writing proofs using the ≡-Reasoning module, the first thing I tried was:
open ≡-Reasoning
open import Function
filter-map : ∀ {a b} {A : Set a} {B : Set b}
(xs : List A) (f : A → B) (p : B → Bool) →
filter p (map f xs) ≡ map f (filter (p ∘ f) xs)
filter-map [] _ _ = refl
filter-map (x ∷ xs) f p with p (f x)
... | true = begin
filter p (map f (x ∷ xs))
≡⟨ refl ⟩
f x ∷ filter p (map f xs)
-- ...
But alas, that didn't work. After trying for one hour, I finally gave up and proved it in this way:
filter-map (x ∷ xs) f p with p (f x)
... | true = cong (λ a → f x ∷ a) (filter-map xs f p)
... | false = filter-map xs f p
Still curious about why going through ≡-Reasoning didn't work, I tried something very trivial:
filter-map-def : ∀ {a b} {A : Set a} {B : Set b}
(x : A) xs (f : A → B) (p : B → Bool) → T (p (f x)) →
filter p (map f (x ∷ xs)) ≡ f x ∷ filter p (map f xs)
filter-map-def x xs f p _ with p (f x)
filter-map-def x xs f p () | false
filter-map-def x xs f p _ | true = -- not writing refl on purpose
begin
filter p (map f (x ∷ xs))
≡⟨ refl ⟩
f x ∷ filter p (map f xs)
∎
But typechecker doesn't agree with me. It would seem that the current goal remains filter p (f x ∷ map f xs) | p (f x) and even though I pattern matched on p (f x), filter just won't reduce to f x ∷ filter p (map f xs).
Is there a way to make this work with ≡-Reasoning?
Thanks!
The trouble with with-clauses is that Agda forgets the information it learned from pattern match unless you arrange beforehand for this information to be preserved.
More precisely, when Agda sees a with expression clause, it replaces all the occurences of expression in the current context and goal with a fresh variable w and then gives you that variable with updated context and goal into the with-clause, forgetting everything about its origin.
In your case, you write filter p (map f (x ∷ xs)) inside the with-block, so it goes into scope after Agda has performed the rewriting, so Agda has already forgotten the fact that p (f x) is true and does not reduce the term.
You can preserve the proof of equality by using one of the "Inspect"-patterns from the standard library, but I'm not sure how it can be useful in your case.

Resources