I am aiming to say that if we have
sum(a) = sum(b)
then
a = b.
What would be the suitable tactic to do this, if the goal looks like this:
\big[Radd_comoid/0]_(i <- fin_img (A:=U) (B:=R_eqType) X)
Radd_comoid
(Pr P F * (i * Pr P (finset (T:=U) (preim X (pred1 i)) :&: F) / Pr P F))
(Pr P (~: F) *
(i * Pr P (finset (T:=U) (preim X (pred1 i)) :&: ~: F) / Pr P (~: F))) =
\sum_(u in U) X u * `p_ X u
Editted.
The context contains:
X: {RV (P) -> (R)}
F: {set U}
H: 0 < Pr P F
H0: Pr P F < 1
The goal after rewrite /=. looks like this:
\big[Rplus/0]_(i <- fin_img (A:=U) (B:=R_eqType) X)
(Pr P F * (i * Pr P (finset (T:=U) (preim X (pred1 i)) :&: F) / Pr P F) +
Pr P (~: F) *
(i * Pr P (finset (T:=U) (preim X (pred1 i)) :&: ~: F) / Pr P (~: F))) =
\sum_(u in U) X u * `p_ X u
If it is true, you probably need to use sum_parti_finType on the right hand side and try to identify the general terms of the summation using eq_bigr. The general term of the left hand side can be simplified using mulrC mulfVK (or something like this) on both sides of the +. And then identify a sum of probabilities with the probability of the disjoint union.
Anyway, it's not just "a tactic"...
I am trying to formalize some intuitionistic notions. One of these is the continuity principle. In Coq I defined this as:
(* Infinite sequences *)
Definition N := nat -> nat.
(* The first n elements of a and b coincide. *)
Definition con (a b : N) n := forall i, i < n -> a i = b i.
(* Brouwers Continuity Principle *)
Axiom BCP :
forall (R : N -> nat -> Prop),
(forall a, exists n, R a n) ->
(forall a, exists m n, forall b, con a b m -> R b n).
I want to generalize this to so called spreads. A spread is a subset of the Baire space that can be thought of as a tree with only infinite branches. A decider o (called the spread law) takes a finite starting sequence and returns 0 if it should be in the spread. When a sequence s is in the spread at least one extension n :: s must also be in the spread. The empty sequence must be accepted such that the spread is inhabited. I defined this as follows:
(* Spread law *)
Definition Spr_Law (o : list nat -> nat) :=
o [] = 0 /\ forall s, o s = 0 <-> exists n, o (n :: s) = 0.
One way to prove that the continuity principle generalizes to arbitrary spreads is to define a function that 'retracts' N onto a spread defined by such a decider o. This is where I get stuck because I simply do not know enough about Coq to define this well. First of all, I inserted a picture of this definition from the course notes.
The trouble is that this definition includes a 'smallest m such that o accepts m :: s'. This is not a terminating procedure in general and I do not know how to use Function to prove that this search would terminate for our purposes (it will since a spread law must accept at least one extension).
I found that I can use the Coq.Logic.ConstructiveEpsilon library to get a witness when I have an exists statement. I could pass the condition that at least one extension exists to the function. Based on this I created the following code (this is only the first part of the definition, which maps finite sequences onto the spread):
Definition find_extension o s (w : exists n, o (n :: s) = 0) : nat :=
constructive_ground_epsilon_nat (fun n => o (n :: s) = 0) (decider_dec o s) w.
(* Compute retraction for finite start sequences. *)
Fixpoint rho o (w : forall s, o s = 0 -> exists n, o (n :: s) = 0)
(s : list nat) : list nat :=
match s with
| [] => []
| n :: s => let t := rho o w s in
if o (n :: t) =? 0
then n :: t
else (find_extension o t (w t {?????})) :: t
end.
Now I encounter the real problem. The {?????} part is where I need to insert a proof that o t = 0. This holds since rho only ever returns sequences that are accepted by the decider o. Perhaps I can let rho return a tuple containing the new sequence together with a proof that this sequence is accepted (such that I can feed it into w after recursion), but I do not know how. Note that this is especially tricky for the else branch since the proof that this value is accepted holds because the witness is valid.
Of course alternative ideas for defining spreads are also welcome. I do feel that this is achievable though (there are no logical inconsistencies as far as I can see).
I seem to have figured something out:
(* Only sequences that are accepted by o *)
Inductive spr (o : decider) :=
| spr_s s : o s = 0 -> spr o.
(* Return smallest n such that o accepts n :: s. *)
Definition find_extension o s (witness : exists n, o (n :: s) = 0) : spr o :=
let P := (fun n => o (n :: s) = 0) in
let D := (decider_dec o s) in
spr_s o
((constructive_ground_epsilon_nat P D witness) :: s)
(constructive_ground_epsilon_spec_nat P D witness).
(*
To generalize BCP to spreads we first define a function that retracts the Baire
space onto an arbitrary spread given its spread law. This happens in two steps.
*)
(* Compute retraction for finite start sequences. *)
Fixpoint rho o
(Hnil : o [] = 0)
(Hcons : forall s, o s = 0 -> exists n, o (n :: s) = 0)
(s : list nat) : spr o :=
match s with
| [] => spr_s o [] Hnil
| n :: s =>
match rho o Hnil Hcons s with
| spr_s _ t Ht =>
match eq_dec (o (n :: t)) 0 with
| left Heq => spr_s o (n :: t) Heq
| right _ => find_extension o t (Hcons t Ht)
end
end
end.
(* Retraction of N onto F_o *)
Definition retract o
(Hnil : o [] = 0)
(Hcons : forall s, o s = 0 -> exists n, o (n :: s) = 0)
: N -> N :=
fun a => fun n =>
match rho o Hnil Hcons (get (n + 1) a) with
| spr_s _ [] _ => 0 (* not reachable *)
| spr_s _ (rho_n :: _) _ => rho_n
end.
The fold tactic replaces all occurrence of a term with another, so fold (id f) tries to replace all occurrences of f with (id f).
However, I want to only fold f if it occurs in the context (f [ ]), not if it occurs in the context ([ ] f). In particular repeat myfold (id f), should not loop.
Is there a general way to do this type of folding? The best I have right now is
repeat match goal with
| |- context [(f ?x)] => change (f x) with ((id f) x)
end
But the above does not work for contexts of the form forall x, f x = f x.
You can use an intermediate value not containing f. Something like
let f' := fresh in
pose (id f) as f';
change f with f'
change (id f') with f'; (* undo the change in locations where we've already added id *)
subst f'.
Edit
If you actually want to just fold things in applicative contexts, you can use three intermediate values, like this:
(* Copyright 2018 Google LLC.
SPDX-License-Identifier: Apache-2.0 *)
Ltac myfold_id f :=
let id_f := fresh in
let id_f_good := fresh in
let f' := fresh in
pose (id f) as id_f;
pose (id f) as id_f_good;
pose f as f';
repeat (change f with id_f at 1;
lazymatch goal with
| [ |- context[id_f _] ] => change id_f with id_f_good
| _ => change id_f with f'
end);
subst id_f id_f_good f'.
Goal let f := id in (f = f, f 0) = (f = f, f 0).
Proof.
intro f.
(* (f = f, f 0) = (f = f, f 0) *)
myfold_id f.
(* (f = f, id f 0) = (f = f, id f 0) *)
I've been trying to encode GADTs in PureScript using rank-2 types, as described here for Haskell
My code looks like:
data Z
data S n
data List a n
= Nil (Z -> n)
| Cons forall m. a (List a m) (S m -> n)
fw :: forall f a. (Functor f) => (forall b . (a -> b) -> f b) -> f a
fw f = f id
bw :: forall f a. (Functor f) => f a -> (forall b . (a -> b) -> f b)
bw x f = map f x
nil :: forall a. List a Z
nil = fw Nil
cons :: forall a n. a -> List a (S n)
cons a as = fw (Cons a as)
instance listFunctor :: Functor (List a) where
map f (Nil k) = Nil (f <<< k)
map f (Cons x xs k) = Cons x xs (f <<< k)
The compiler complains Wrong number of arguments to constructor Main.Cons, referring to the LHS pattern match in the Functor instance.
What is going wrong here?
Regards,
Michael
The syntax used for existential types in Haskell is not present in PureScript. What you've written for Cons is a data constructor with a single universally-quantified argument.
You might like to try using purescript-exists to encode the existential type instead.
Another option is to use a final-tagless encoding of the GADT:
class Listy l where
nil :: forall a. l Z a
cons :: forall a n. a -> l n a -> l (S n) a
You can write terms for any valid Listy instance:
myList :: forall l. (Listy l) => l (S (S Z)) Int
myList = cons 1 (cons 2 nil)
and interpret them by writing instances
newtype Length n a = Length Int
instance lengthListy :: Listy Length where
nil = Length 0
cons _ (Length n) = Length (n + 1)
newtype AsList n a = AsList (List a)
instance asListListy :: Listy AsList where
nil = AsList Nil
cons x (AsList xs) = AsList (Cons x xs)
Given a function with at least n arguments, I want to rotate the first argument so that it becomes the nth argument. For example (in untyped lambda calculus):
r(λa. a) = λa. a
r(λa. λb. a b) = λb. λa. a b
r(λa. λb. λc. a b c) = λb. λc. λa. a b c
r(λa. λb. λc. λd. a b c d) = λb. λc. λd. λa. a b c d
And so on.
Can you write r in a generic way? What if you know that n >= 2?
Here's the problem stated in Scala:
trait E
case class Lam(i: E => E) extends E
case class Lit(i: Int) extends E
case class Ap(e: E, e: E) extends E
The rotation should take Lam(a => Lam(b => Lam(c => Ap(Ap(a, b), c)))) and return Lam(b => Lam(c => Lam(a => Ap(Ap(a, b), c)))), for example.
The trick is to tag the "final" value of the functions involved, since to normal haskell, both a -> b and a -> (b->c) are just functions of a single variable.
If we do that, though, we can do this.
{-# LANGUAGE TypeFamilies,FlexibleInstances,FlexibleContexts #-}
module Rotate where
data Result a = Result a
class Rotate f where
type After f
rotate :: f -> After f
instance Rotate (a -> Result b) where
type After (a -> Result b) = a -> Result b
rotate = id
instance Rotate (a -> c) => Rotate (a -> b -> c) where
type After (a -> b -> c) = b -> After (a -> c)
rotate = (rotate .) . flip
Then, to see it in action:
f0 :: Result a
f0 = Result undefined
f1 :: Int -> Result a
f1 = const f0
f2 :: Char -> Int -> Result a
f2 = const f1
f3 :: Float -> Char -> Int -> Result a
f3 = const f2
f1' :: Int -> Result a
f1' = rotate f1
f2' :: Int -> Char -> Result a
f2' = rotate f2
f3' :: Char -> Int -> Float -> Result a
f3' = rotate f3
It's probably impossible without violating the ‘legitimacy’ of HOAS, in the sense that the E => E must be used not just for binding in the object language, but for computation in the meta language. That said, here's a solution in Haskell. It abuses a Literal node to drop in a unique ID for later substitution. Enjoy!
import Control.Monad.State
-- HOAS representation
data Expr = Lam (Expr -> Expr)
| App Expr Expr
| Lit Integer
-- Rotate transformation
rot :: Expr -> Expr
rot e = case e of
Lam f -> descend uniqueID (f (Lit uniqueID))
_ -> e
where uniqueID = 1 + maxLit e
descend :: Integer -> Expr -> Expr
descend i (Lam f) = Lam $ descend i . f
descend i e = Lam $ \a -> replace i a e
replace :: Integer -> Expr -> Expr -> Expr
replace i e (Lam f) = Lam $ replace i e . f
replace i e (App e1 e2) = App (replace i e e1) (replace i e e2)
replace i e (Lit j)
| i == j = e
| otherwise = Lit j
maxLit :: Expr -> Integer
maxLit e = execState (maxLit' e) (-2)
where maxLit' (Lam f) = maxLit' (f (Lit 0))
maxLit' (App e1 e2) = maxLit' e1 >> maxLit' e2
maxLit' (Lit i) = get >>= \k -> when (i > k) (put i)
-- Output
toStr :: Integer -> Expr -> State Integer String
toStr k e = toStr' e
where toStr' (Lit i)
| i >= k = return $ 'x':show i -- variable
| otherwise = return $ show i -- literal
toStr' (App e1 e2) = do
s1 <- toStr' e1
s2 <- toStr' e2
return $ "(" ++ s1 ++ " " ++ s2 ++ ")"
toStr' (Lam f) = do
i <- get
modify (+ 1)
s <- toStr' (f (Lit i))
return $ "\\x" ++ show i ++ " " ++ s
instance Show Expr where
show e = evalState (toStr m e) m
where m = 2 + maxLit e
-- Examples
ex2, ex3, ex4 :: Expr
ex2 = Lam(\a -> Lam(\b -> App a (App b (Lit 3))))
ex3 = Lam(\a -> Lam(\b -> Lam(\c -> App a (App b c))))
ex4 = Lam(\a -> Lam(\b -> Lam(\c -> Lam(\d -> App (App a b) (App c d)))))
check :: Expr -> IO ()
check e = putStrLn(show e ++ " ===> \n" ++ show (rot e) ++ "\n")
main = check ex2 >> check ex3 >> check ex4
with the following result:
\x5 \x6 (x5 (x6 3)) ===>
\x5 \x6 (x6 (x5 3))
\x2 \x3 \x4 (x2 (x3 x4)) ===>
\x2 \x3 \x4 (x4 (x2 x3))
\x2 \x3 \x4 \x5 ((x2 x3) (x4 x5)) ===>
\x2 \x3 \x4 \x5 ((x5 x2) (x3 x4))
(Don't be fooled by the similar-looking variable names. This is the rotation you seek, modulo alpha-conversion.)
Yes, I'm posting another answer. And it still might not be exactly what you're looking for. But I think it might be of use nonetheless. It's in Haskell.
data LExpr = Lambda Char LExpr
| Atom Char
| App LExpr LExpr
instance Show LExpr where
show (Atom c) = [c]
show (App l r) = "(" ++ show l ++ " " ++ show r ++ ")"
show (Lambda c expr) = "(λ" ++ [c] ++ ". " ++ show expr ++ ")"
So here I cooked up a basic algebraic data type for expressing lambda calculus. I added a simple, but effective, custom Show instance.
ghci> App (Lambda 'a' (Atom 'a')) (Atom 'b')
((λa. a) b)
For fun, I threw in a simple reduce method, with helper replace. Warning: not carefully thought out or tested. Do not use for industrial purposes. Cannot handle certain nasty expressions. :P
reduce (App (Lambda c target) expr) = reduce $ replace c (reduce expr) target
reduce v = v
replace c expr av#(Atom v)
| v == c = expr
| otherwise = av
replace c expr ap#(App l r)
= App (replace c expr l) (replace c expr r)
replace c expr lv#(Lambda v e)
| v == c = lv
| otherwise = (Lambda v (replace c expr e))
It seems to work, though that's really just me getting sidetracked. (it in ghci refers to the last value evaluated at the prompt)
ghci> reduce it
b
So now for the fun part, rotate. So I figure I can just peel off the first layer, and if it's a Lambda, great, I'll save the identifier and keep drilling down until I hit a non-Lambda. Then I'll just put the Lambda and identifier right back in at the "last" spot. If it wasn't a Lambda in the first place, then do nothing.
rotate (Lambda c e) = drill e
where drill (Lambda c' e') = Lambda c' (drill e') -- keep drilling
drill e' = Lambda c e' -- hit a non-Lambda, put c back
rotate e = e
Forgive the unimaginative variable names. Sending this through ghci shows good signs:
ghci> Lambda 'a' (Atom 'a')
(λa. a)
ghci> rotate it
(λa. a)
ghci> Lambda 'a' (Lambda 'b' (App (Atom 'a') (Atom 'b')))
(λa. (λb. (a b)))
ghci> rotate it
(λb. (λa. (a b)))
ghci> Lambda 'a' (Lambda 'b' (Lambda 'c' (App (App (Atom 'a') (Atom 'b')) (Atom 'c'))))
(λa. (λb. (λc. ((a b) c))))
ghci> rotate it
(λb. (λc. (λa. ((a b) c))))
One way to do it with template haskell would be like this:
With these two functions:
import Language.Haskell.TH
rotateFunc :: Int -> Exp
rotateFunc n = LamE (map VarP vars) $ foldl1 AppE $ map VarE $ (f:vs) ++ [v]
where vars#(f:v:vs) = map (\i -> mkName $ "x" ++ (show i)) [1..n]
getNumOfParams :: Info -> Int
getNumOfParams (VarI _ (ForallT xs _ _) _ _) = length xs + 1
Then for a function myF with a variable number of parameters you could rotate them this way:
$(return $ rotateFunc $ read $(stringE . show =<< (reify 'myF >>= return . getNumOfParams))) myF
There most certainly are neater ways of doing this with TH, I am very new to it.
OK, thanks to everyone who provided an answer. Here is the solution I ended up going with. Taking advantage of the fact that I know n:
rot :: Int -> [Expr] -> Expr
rot 0 xs = Lam $ \x -> foldl App x (reverse xs)
rot n xs = Lam $ \x -> rot (n - 1) (x : xs)
rot1 n = rot n []
I don't think this can be solved without giving n, since in the lambda calculus, a term's arity can depend on its argument. I.e. there is no definite "last" argument. Changed the question accordingly.
I think you could use the techniques described int the paper An n-ary zipWith in Haskell for this.
Can you write r in a generic way?
What if you know n?
Haskell
Not in plain vanilla Haskell. You'd have to use some deep templating magic that someone else (much wiser than I) will probably post.
In plain Haskell, let's try writing a class.
class Rotatable a where
rotate :: a -> ???
What on earth is the type for rotate? If you can't write its type signature, then you probably need templates to program at the level of generality you are looking for (in Haskell, anyways).
It's easy enough to translate the idea into Haskell functions, though.
r1 f = \a -> f a
r2 f = \b -> \a -> f a b
r3 f = \b -> \c -> \a -> f a b c
etc.
Lisp(s)
Some Lispy languages have the apply function (linked: r5rs), which takes a function and a list, and applies the elements of the list as arguments to the function. I imagine in that case it wouldn't be so hard to just un-rotate the list and send it on its way. I again defer to the gurus for deeper answers.