I've tried to implement my version of "sprintf" function (which constructs a string from a format string a number of arguments of different types), but failed. Same technique worked in Idris.
module Printf where
open import Agda.Builtin.List
open import Agda.Builtin.Char
open import Agda.Builtin.String
open import Agda.Builtin.Float
open import Agda.Builtin.Int
data Format : Set where
TChar : Char → Format → Format
TString : Format → Format
TFloat : Format → Format
TInt : Format → Format
TEnd : Format
parseFormat : List Char → Format
parseFormat ('%' :: 's' :: rest) = TString (parseFormat rest)
parseFormat ('%' :: 'f' :: rest) = TFloat (parseFormat rest)
parseFormat ('%' :: 'd' :: rest) = TInt (parseFormat rest)
parseFormat ('%' :: '%' :: rest) = TChar '%' (parseFormat rest)
parseFormat (x :: rest) = TChar x (parseFormat rest)
parseFormat [] = TEnd
But I get this error by the compiler:
Could not parse the left-hand side parseFormat ('%' :: 's' :: rest)
Operators used in the grammar:
None
when scope checking the left-hand side
parseFormat ('%' :: 's' :: rest) in the definition of parseFormat
Is it possible to pattern-match on characters like '1', 't', 'O' in Agda?
There is no constructor of List named _::_. What you meant to use is _∷_. Replacing all occurrences of :: with ∷ fixes the problem:
parseFormat : List Char → Format
parseFormat ('%' ∷ 's' ∷ rest) = TString (parseFormat rest)
parseFormat ('%' ∷ 'f' ∷ rest) = TFloat (parseFormat rest)
parseFormat ('%' ∷ 'd' ∷ rest) = TInt (parseFormat rest)
parseFormat ('%' ∷ '%' ∷ rest) = TChar '%' (parseFormat rest)
parseFormat (x ∷ rest) = TChar x (parseFormat rest)
parseFormat [] = TEnd
Related
I'm trying to use Idris 2's Text.Parser library to parse a pre-tokenized byte stream. I wrote the following utility function in the style of Parsec's expression parser:
module Text.Parser.Expression
import Text.Parser
public export
data Assoc
= AssocNone
| AssocLeft
| AssocRight
public export
data Op state k a
= Prefix (Grammar state k True (a -> a))
| Infix (Grammar state k True (a -> a -> a)) Assoc
public export
OpTable : Type -> Type -> Type -> Type
OpTable state k a = List (List (Op state k a))
public export
expressionParser :
OpTable state k a ->
Grammar state k True a ->
Grammar state k True a
expressionParser table term = foldl level term table
where
level : Grammar state k True a -> List (Op state k a) -> Grammar state k True a
level factor ops = choiceMap toP ops <|> factor
where
toP : Op state k a -> Grammar state k True a
toP (Infix op AssocNone) = do
x <- factor
f <- op
y <- factor
pure $ f x y
toP (Infix op AssocLeft) = do
x <- factor
fs <- some (flip <$> op <*> factor)
pure $ foldl (flip ($)) x fs
toP (Infix op AssocRight) = do
fs <- some (factor >>= \x => op <*> pure x)
y <- factor
pure $ foldr ($) y fs
toP (Prefix op) = op <*> factor
For certain inputs, this seems to scale really badly with the number of operator definitions. Here's a cut-down example:
public export
Number : Type
Number = Double
public export
data Fun
= IntFun
| Rnd
public export
data BinOp
= Eq
| NEq
| LT
| LE
| GT
| GE
| Plus
| Minus
| Mul
| And
| Or
public export
data Expr
= NumLitE Number
| Bin BinOp Expr Expr
| FunE Fun (List1 Expr)
public export
Show Fun where
show IntFun = "INT"
show Rnd = "RND"
public export
Show BinOp where
show Eq = "="
show NEq = "<>"
show LT = "<"
show LE = "<="
show GT = ">"
show GE = ">="
show Plus = "+"
show Minus = "-"
show Mul = "*"
show And = "AND"
show Or = "OR"
public export
Show Expr where
show (NumLitE n) = show n
show (Bin op x y) = unwords [show x, show op, show y]
show (FunE f args) = show f ++ "(" ++ show args ++ ")"
bits8 : Bits8 -> Grammar state Bits8 True ()
bits8 x = terminal ("Byte " ++ show x) $ \x' => if x == x' then Just () else Nothing
lexeme : {c : Bool} -> Grammar state Bits8 c a -> Grammar state Bits8 c a
lexeme p = afterMany (bits8 0x20) p
comma : Grammar state Bits8 True ()
comma = lexeme $ bits8 0x2c
parens : {c : Bool} -> Grammar state Bits8 c a -> Grammar state Bits8 True a
parens = between (lexeme $ bits8 0x28) (lexeme $ bits8 0x29)
digit : Grammar state Bits8 True Bits8
digit = terminal "digit" $ \x =>
toMaybe (0x30 <= x && x <= 0x39) x
digitLit : (Num a) => Grammar state Bits8 True a
digitLit = fromInteger . cast . (\x => x - 0x30) <$> digit
numLit : (Num a, Neg a) => Grammar state Bits8 True a
numLit {a} = fromDigits <$> lexeme sign <*> lexeme (some digitLit)
where
fromDigits : Bool -> List1 a -> a
fromDigits neg =
(if neg then negate else id) .
foldl (\x => \y => x * 10 + y) (the a 0)
sign : Grammar state Bits8 False Bool
sign = option False $ True <$ bits8 0xab
expr : Grammar state Bits8 True Expr
expr = expressionParser table term <|> fail "expression"
where
table : List (List (Op state Bits8 Expr))
table =
[ [ Infix (lexeme $ Bin Mul <$ bits8 0xac) AssocLeft
]
, [ Infix (lexeme $ Bin Plus <$ bits8 0xaa) AssocLeft
, Infix (lexeme $ Bin Minus <$ bits8 0xab) AssocLeft
]
, -- This next group is the one I will keep shrinking
[ Infix (lexeme $ Bin Eq <$ bits8 0xb2) AssocNone
, Infix (lexeme $ Bin NEq <$ (bits8 0xb3 *> bits8 0xb1)) AssocNone
, Infix (lexeme $ Bin GE <$ (bits8 0xb1 *> bits8 0xb2)) AssocNone
, Infix (lexeme $ Bin GT <$ bits8 0xb1) AssocNone
, Infix (lexeme $ Bin LE <$ (bits8 0xb3 *> bits8 0xb2)) AssocNone
, Infix (lexeme $ Bin LT <$ bits8 0xb3) AssocNone
]
, [ Infix (lexeme $ Bin And <$ bits8 0xaf) AssocLeft
, Infix (lexeme $ Bin Or <$ bits8 0xb0) AssocLeft
]
]
fun : Grammar state Bits8 True Fun
fun = lexeme $ choice
[ IntFun <$ bits8 0xb5
, Rnd <$ bits8 0xbb
]
term : Grammar state Bits8 True Expr
term =
NumLitE <$> numLit
<|> FunE <$> fun <*> parens (sepBy1 comma expr)
<|> parens expr
For measurement, I have tried parsing [181,40,40,187,40,49,41,172,51,41,170,49,41] while removing the parsing rules for Eq, NEq, ..., Lt. Here is the user time of parsing the above list of bytes with the number of rules not commented out in that parsing rule group:
n
usr (seconds)
1
0.41
2
1.56
3
4.67
4
13.92
5
25.71
6
45.92
What is going on here?
Not an answer, but a viable workaround is merging all comparison operators into a single parser:
cmp : Grammar state Bits8 True BinOp
cmp = choice
[ Eq <$ bits8 0xb2
, NEq <$ bits8 0xb3 <* bits8 0xb1
, GE <$ bits8 0xb1 <* bits8 0xb2
, GT <$ bits8 0xb1
, LE <$ bits8 0xb3 <* bits8 0xb2
, LT <$ bits8 0xb3
]
table : List (List (Op state Bits8 Expr))
table =
[ [ Infix (lexeme $ Bin Mul <$ bits8 0xac) AssocLeft
]
, [ Infix (lexeme $ Bin Plus <$ bits8 0xaa) AssocLeft
, Infix (lexeme $ Bin Minus <$ bits8 0xab) AssocLeft
]
, [ Infix (Bin <$> lexeme cmp) AssocNone ]
, [ Infix (lexeme $ Bin And <$ bits8 0xaf) AssocLeft
, Infix (lexeme $ Bin Or <$ bits8 0xb0) AssocLeft
]
]
This suggests a more principled improvement which is to collect all non-associative operators per precedence level in expressionParser itself and do this transformation.
I fixed this by copying more of Parsec's design. As can be seen at that link, the important idea is to parse a leading term just once, and then parse a chain of associative operators and operands following it. This avoids repeated re-parsing of higher-precedence terms, which is what's causing the slowdown in the code in the question.
I was looking at the code in agda-stdlib/src/Data/Vec/Base.agda
and saw .( in
take : ∀ m {n} → Vec A (m + n) → Vec A m
take m xs with splitAt m xs
take m .(ys ++ zs) | (ys , zs , refl) = ys
I tried removing the . in front of it and got the following error:
Could not parse the left-hand side
take m (ys ++ zs) | (ys , zs , refl)
Operators used in the grammar:
++ (infixr operator, level 5) [_++_ (/Users/fss/Dropbox/Documents/projects/Coding/dev/agda/agda-stdlib/src/Data/Vec/Base.agda:99,1-5)]
, (infixr operator, level 4) [_,_ (/usr/local/Cellar/agda/2.6.1/share/x86_64-osx-ghc-8.10.1/Agda-2.6.1/lib/prim/Agda/Builtin/Sigma.agda:9,15-18)]
when scope checking the left-hand side
take m (ys ++ zs) | (ys , zs , refl) in the definition of take
So I'm guessing it is necessary. But I don't understand what it is for exactly. I tried to look in https://agda.readthedocs.io/en/v2.6.1.1 but couldn't find anything about it.
Thanks!
First off, in
take m (ys ++ zs)
the pattern ys ++ zs is not valid because it is not a constructor applied on other patterns. If you think about it, in general it doesn't make sense to pattern match as function application because you'd need to be able to invert every function.
However, in
take : ∀ m {n} → Vec A (m + n) → Vec A m
take m xs with splitAt m xs
take m .(ys ++ zs) | (ys , zs , refl) = ys
we pattern match on the result of splitAt as well. The type of the third argument is (ys ++ zs) == xs, and the type of the constructor refl is (ys ++ zs) == (ys ++ zs). By unification, that means xs ~ (ys ++ zs), so the second argument to take cannot be anything other than ys ++ zs in this clause.
And this is exactly what a dot-pattern means:
A dot pattern (also called inaccessible pattern) can be used when the only type-correct value of the argument is determined by the patterns given for the other arguments. The syntax for a dot pattern is .t.
I want to write a function like:
sameBool :: [Bool] -> Bool
for example:
[True, False, True] => False
[True, True] => True
Here's my solution:
sameBool :: [Bool] -> Bool
sameBool xs = if head xs == True
then length (filter (== False) xs) == 0
else length (filter (== True) xs) == 0
Effective though not elegant. I'm looking for some more elegant solution.
With all:
sameBool :: [Bool] -> Bool
sameBool xs = all (== head xs) xs
With nub from Data.List:
import Data.List
sameBool :: [Bool] -> Bool
sameBool = (== 1) . length . nub
Actually, they works for any instance of Eq:
sameBool :: Eq a => [a] -> Bool
sameBool xs = all (== head xs) xs
-- Note: return True for []
sameBool :: Eq a => [a] -> Bool
sameBool = (== 1) . length . nub
-- Note: return False for []
Check nubBy for types that aren't instances of Eq.
I'm new to dependent types and, having a Haskell experience, am slowly learning Idris. For an exercize, I want to write a Huffman encoding. Currently I'm trying to write a proof that the "flattening" of the code tree produces a prefix code, but has got stuck with the quantifiers.
I have a simple inductive proposition that one list is a prefix of an another:
using (xs : List a, ys : List a)
data Prefix : List a -> List a -> Type where
pEmpty : Prefix Nil ys
pNext : (x : a) -> Prefix xs ys -> Prefix (x :: xs) (x :: ys)
Is this a valid approach? Or something like "xs is prefix of ys if there is zs such that xs ++ zs = ys" would be better?
Was it the right way to introduce a "forall" quantifier (as far as I can understand, in Agda it would be something like pNext : ∀ {x xs ys} → Prefix xs ys → Prefix (x :: xs) (y :: ys))? Should the pNext first argument be implicit? What is the semantic differences between two variants?
Then, I want to build one for a vector where none of elements forms a prefix of another:
data PrefVect : Vect n (List a) -> Type where
Empty vector has no prefixes:
pvEmpty : PrefVect Nil
and given an element x, a vector xs, and proofs that none element of xs is a prefix of x (and vice versa), x :: xs will hold that property:
pvNext : (x : [a]) -> (xs : Vect n [a]) ->
All (\y => Not (Prefix x y)) xs ->
All (\y => Not (Prefix y x)) xs ->
PrefVect (x :: xs)
This is an unvalid type which I hope to fix after dealing with the first one, but there is similar question about quantifiers in pvNext: is this variant acceptable, or there is a better way to form a "negation on relation"?
Thank you.
I think the only problem here is that you've used [a] as the type of lists of a, in the Haskell style, whereas in Idris it needs to be List a.
Your Prefix type looks fine to me, although I'd write it as:
data Prefix : List a -> List a -> Type where
pEmpty : Prefix [] ys
pNext : Prefix xs ys -> Prefix (x :: xs) (x :: ys)
That is, x can be implicit, and you don't need the using because Idris can infer the types of xs and ys. Whether this is the right approach or not really depends on what you plan to use the Prefix type for. It's certainly easy enough to test whether a list is the prefix of another. Something like:
testPrefix : DecEq a => (xs : List a) -> (ys : List a) -> Maybe (Prefix xs ys)
testPrefix [] ys = Just pEmpty
testPrefix (x :: xs) [] = Nothing
testPrefix (x :: xs) (y :: ys) with (decEq x y)
testPrefix (x :: xs) (x :: ys) | (Yes Refl) = Just (pNext !(testPrefix xs ys
testPrefix (x :: xs) (y :: ys) | (No contra) = Nothing
If you want to prove the negation, which it seems you might, you'll need the type to be:
testPrefix : DecEq a => (xs : List a) -> (ys : List a) -> Dec (Prefix xs ys)
I'll leave that one as an exercise :).
I have two lists of unequal length. When I add both of them I want the final list to have the length of the longest list.
addtwolists [0,0,221,2121] [0,0,0,99,323,99,32,2332,23,23]
>[0,0,221,2220,323,99,32,2332,23,23]
addtwolists [945,45,4,45,22,34,2] [0,34,2,34,2]
>[945,79,6,79,24,34,2]
zerolist :: Int -> [Integer]
zerolist x = take x (repeat 0)
addtwolists :: [Integer] -> [Integer] -> [Integer]
addtwolists x y = zipWith (+) (x ++ (zerolist ((length y)-(length x)))) (y ++ (zerolist ((length x)-(length y))))
This code is inefficient. So I tried:
addtwolist :: [Integer] -> [Integer] -> [Integer]
addtwolist x y = zipWith (+) (x ++ [head (zerolist ((length y)-(length x))) | (length y) > (length x)]) (y ++ [head (zerolist ((length x)-(length y))) | (length x) > (length y)])
Any other way to increase the efficiency?Could you only check once to see which list is bigger?
Your implementation is slow because it looks like you call the length function on each list multiple times on each step of zipWith. Haskell computes list length by walking the entire list and counting the number of elements it traverses.
The first speedy method that came to my mind was explicit recursion.
addLists :: [Integer] -> [Integer] -> [Integer]
addLists xs [] = xs
addLists [] ys = ys
addLists (x:xs) (y:ys) = x + y : addLists xs ys
I'm not aware of any standard Prelude functions that would fill your exact need, but if you wanted to generalize this to a higher order function, you could do worse than this. The two new values passed to the zip function are filler used in computing the remaining portion of the long list after the short list has been exhausted.
zipWithExtend :: (a -> b -> c) -> [a] -> [b] -> a -> b -> [c]
zipWithExtend f [] [] a' b' = []
zipWithExtend f (a:as) [] a' b' = f a b' : zipWithExtend f as [] a' b'
zipWithExtend f [] (b:bs) a' b' = f a' b : zipWithExtend f [] bs a' b'
zipWithExtend f (a:as) (b:bs) a' b' = f a b : zipWithExtend f as bs a' b'
Usage:
> let as = [0,0,221,2121]
> let bs = [0,0,0,99,323,99,32,2332,23,23]
> zipWithExtend (+) as bs 0 0
[0,0,221,2220,323,99,32,2332,23,23]
This can be done in a single iteration, which should be a significant improvement for long lists. It's probably simplest with explicit recursion:
addTwoLists xs [] = xs
addTwoLists [] ys = ys
addTwoLists (x:xs) (y:ys) = x+y:addTwoLists xs ys
Just because I can't help bikeshedding, you might enjoy this function:
Prelude Data.Monoid Data.List> :t map mconcat . transpose
map mconcat . transpose :: Monoid b => [[b]] -> [b]
For example:
> map (getSum . mconcat) . transpose $ [map Sum [0..5], map Sum [10,20..100]]
[10,21,32,43,54,65,70,80,90,100]
Two suggestions:
addtwolists xs ys =
let common = zipWith (+) xs ys
len = length common
in common ++ drop len xs ++ drop len ys
addtwolists xs ys | length xs < length ys = zipWith (+) (xs ++ repeat 0) ys
| otherwise = zipWith (+) xs (ys ++ repeat 0)