证明最多进行 n 次递归调用的函数的完整性
Proving totality of a function taking at most n recursive calls
假设我们正在编写一个 lambda 演算的实现,作为其中的一部分,我们希望能够选择一个新的非冲突名称:
record Ctx where
constructor MkCtx
bindings : List String
emptyCtx : Ctx
emptyCtx = MkCtx []
addCtx : String -> Ctx -> Ctx
addCtx name = record { bindings $= (name ::) }
pickName : String -> Ctx -> (String, Ctx)
pickName = go Z
where
mkName : Nat -> String -> String
mkName Z name = name
mkName n name = name ++ show n
go n name ctx = let name' = mkName n name in
if name' `elem` bindings ctx
then go (S n) name ctx
else (name', addCtx name' ctx)
Idris totality checker 认为 pickName
不是完全的,因为 go
中的递归路径,这是正确的:事实上,完整性的证明并不依赖于任何在句法上变小的术语,但是而是根据观察,如果 bindings
有 k
个元素,那么只需 k + 1
次递归调用即可找到一个新名称。但是如何用代码表达呢?
我也倾向于外部验证,首先编写一个函数,然后编写一个(类型检查,但从不执行)证明它具有正确的属性。在这种情况下 pickName
的整体性是否可能?
受@HTNW 的启发,看起来正确的方法只是使用 Vect
而不是列表。从 vector 中删除元素将使其大小(以类型表示)在语法上更小,避免需要自己证明。因此,pickName
的(稍微重构的)版本将是
pickName : String -> Vect n String -> String
pickName name vect = go Z vect
where
mkName : Nat -> String
mkName Z = name
mkName n = name ++ show n
go : Nat -> Vect k String -> String
go {k = Z} n _ = mkName n
go {k = (S k)} n vect' =
let name' = mkName n in
case name' `isElem` vect' of
Yes prf => go (S n) $ dropElem vect' prf
No _ => name'
在序曲中,我们有:
Smaller x y = size x `LT` size y
instance Sized (List a) where size = length
sizeAccessible : Sized a => (x : a) -> Accessible Smaller x
accRec : (step : (x : a) -> ((y : a) -> rel y x -> b) -> b) ->
(z : a) -> Accessible rel z -> b
accRec
允许您以编译器可以理解为 total
的方式使用 "nonstandard recursion patterns"。它基本上是 fix : ((a -> b) -> (a -> b)) -> (a -> b)
,除了开放递归函数有义务通过一个额外的证明项来证明递归参数在某种程度上是 "smaller"。 Accessible
参数决定了所使用的递归模式;这是简单的 "decreasing Nat
-size" patten。我们最好使用 sizeRec
而不是 accRec
+ sizeAccessible
,但我无法让它工作。请随意使用 "correct" 方式进行编辑。
你的函数的每次迭代,如果你找到它,你可以删除它。
delFirst : DecEq a => (x : a) -> (xs : List a)
-> Maybe (ys : List a ** length xs = S (length ys))
delFirst _ [] = Nothing
delFirst x (y :: xs) with (decEq x y)
delFirst x (x :: xs) | Yes Refl = Just (xs ** Refl)
delFirst x (y :: xs) | No _ with (delFirst x xs)
| Nothing = Nothing
| Just (ys ** prf) = Just (x :: ys ** cong prf)
现在您可以在 pickName
中使用开放的、有根据的递归:
pickName : String -> Ctx -> (String, Ctx)
pickName s ctx = let new = go s (bindings ctx) Z
in (new, addCtx new ctx)
where mkName : Nat -> String -> String
mkName Z name = name
mkName n name = name ++ show n
ltFromRefl : n = S m -> LT m n
ltFromRefl Refl = lteRefl
go : String -> List String -> Nat -> String
go name binds = accRec (\binds, rec, n =>
let name' = mkName n name
in case delFirst name' binds of
Nothing => name'
Just (binds' ** prf) => rec binds' (ltFromRefl prf) (S n)
) binds (sizeAccessible binds)
A Nat -> a
与 Stream a
相同,所以在我看来,这样更好一些:
findNew : DecEq a => (olds : List a) -> (news : Stream a) -> a
findNew olds = accRec (\olds, rec, (new :: news) =>
case delFirst new olds of
Nothing => new
Just (olds' ** prf) => rec olds' (ltFromRefl prf) news
) olds (sizeAccessible olds)
where ltFromRefl : n = S m -> LT m n
ltFromRefl Refl = lteRefl
pickName : String -> Ctx -> (String, Ctx)
pickName name ctx = let new = findNew (bindings ctx)
(name :: map ((name ++) . show) (iterate S 1))
in (new, addCtx new ctx)
我认为,这抓住了这个想法背后的直觉,即如果你有无限多的名字,但只有有限多的旧名字,那么你肯定有无限多的新名字。
(还有,你的代码逻辑好像不对,你是不是翻转了if
的分支?)
假设我们正在编写一个 lambda 演算的实现,作为其中的一部分,我们希望能够选择一个新的非冲突名称:
record Ctx where
constructor MkCtx
bindings : List String
emptyCtx : Ctx
emptyCtx = MkCtx []
addCtx : String -> Ctx -> Ctx
addCtx name = record { bindings $= (name ::) }
pickName : String -> Ctx -> (String, Ctx)
pickName = go Z
where
mkName : Nat -> String -> String
mkName Z name = name
mkName n name = name ++ show n
go n name ctx = let name' = mkName n name in
if name' `elem` bindings ctx
then go (S n) name ctx
else (name', addCtx name' ctx)
Idris totality checker 认为 pickName
不是完全的,因为 go
中的递归路径,这是正确的:事实上,完整性的证明并不依赖于任何在句法上变小的术语,但是而是根据观察,如果 bindings
有 k
个元素,那么只需 k + 1
次递归调用即可找到一个新名称。但是如何用代码表达呢?
我也倾向于外部验证,首先编写一个函数,然后编写一个(类型检查,但从不执行)证明它具有正确的属性。在这种情况下 pickName
的整体性是否可能?
受@HTNW 的启发,看起来正确的方法只是使用 Vect
而不是列表。从 vector 中删除元素将使其大小(以类型表示)在语法上更小,避免需要自己证明。因此,pickName
的(稍微重构的)版本将是
pickName : String -> Vect n String -> String
pickName name vect = go Z vect
where
mkName : Nat -> String
mkName Z = name
mkName n = name ++ show n
go : Nat -> Vect k String -> String
go {k = Z} n _ = mkName n
go {k = (S k)} n vect' =
let name' = mkName n in
case name' `isElem` vect' of
Yes prf => go (S n) $ dropElem vect' prf
No _ => name'
在序曲中,我们有:
Smaller x y = size x `LT` size y
instance Sized (List a) where size = length
sizeAccessible : Sized a => (x : a) -> Accessible Smaller x
accRec : (step : (x : a) -> ((y : a) -> rel y x -> b) -> b) ->
(z : a) -> Accessible rel z -> b
accRec
允许您以编译器可以理解为 total
的方式使用 "nonstandard recursion patterns"。它基本上是 fix : ((a -> b) -> (a -> b)) -> (a -> b)
,除了开放递归函数有义务通过一个额外的证明项来证明递归参数在某种程度上是 "smaller"。 Accessible
参数决定了所使用的递归模式;这是简单的 "decreasing Nat
-size" patten。我们最好使用 sizeRec
而不是 accRec
+ sizeAccessible
,但我无法让它工作。请随意使用 "correct" 方式进行编辑。
你的函数的每次迭代,如果你找到它,你可以删除它。
delFirst : DecEq a => (x : a) -> (xs : List a)
-> Maybe (ys : List a ** length xs = S (length ys))
delFirst _ [] = Nothing
delFirst x (y :: xs) with (decEq x y)
delFirst x (x :: xs) | Yes Refl = Just (xs ** Refl)
delFirst x (y :: xs) | No _ with (delFirst x xs)
| Nothing = Nothing
| Just (ys ** prf) = Just (x :: ys ** cong prf)
现在您可以在 pickName
中使用开放的、有根据的递归:
pickName : String -> Ctx -> (String, Ctx)
pickName s ctx = let new = go s (bindings ctx) Z
in (new, addCtx new ctx)
where mkName : Nat -> String -> String
mkName Z name = name
mkName n name = name ++ show n
ltFromRefl : n = S m -> LT m n
ltFromRefl Refl = lteRefl
go : String -> List String -> Nat -> String
go name binds = accRec (\binds, rec, n =>
let name' = mkName n name
in case delFirst name' binds of
Nothing => name'
Just (binds' ** prf) => rec binds' (ltFromRefl prf) (S n)
) binds (sizeAccessible binds)
A Nat -> a
与 Stream a
相同,所以在我看来,这样更好一些:
findNew : DecEq a => (olds : List a) -> (news : Stream a) -> a
findNew olds = accRec (\olds, rec, (new :: news) =>
case delFirst new olds of
Nothing => new
Just (olds' ** prf) => rec olds' (ltFromRefl prf) news
) olds (sizeAccessible olds)
where ltFromRefl : n = S m -> LT m n
ltFromRefl Refl = lteRefl
pickName : String -> Ctx -> (String, Ctx)
pickName name ctx = let new = findNew (bindings ctx)
(name :: map ((name ++) . show) (iterate S 1))
in (new, addCtx new ctx)
我认为,这抓住了这个想法背后的直觉,即如果你有无限多的名字,但只有有限多的旧名字,那么你肯定有无限多的新名字。
(还有,你的代码逻辑好像不对,你是不是翻转了if
的分支?)