Infix for All (leaves) - wolfram-mathematica

Infix[] works only at first level:
Infix[(c a^b)^d]
(*
-> (a^b c) ~Power~ d
*)
As I want to (don't ask why) get the full expression switched to infix notation, I tried something like:
SetAttributes[toInfx, HoldAll];
toInfx[expr_] := Module[{prfx, infx},
prfx = Level[expr, {0, Infinity}];
infx = Infix /# prfx /. {Infix[a_Symbol] -> a, Infix[a_?NumericQ] -> a};
Fold[ReplaceAll[#1, #2] &, expr, Reverse#Thread[Rule[prfx, infx]]]
]
k = toInfx[(c a^b)^d]
(*
-> (c ~Times~ (a ~Power~ b)) ~Power~ d
*)
But this has two evident problems, because
(c a^b)^d == a~Power~b~Times~c~Power~d
So what I get is not an efficient use of infix.
It is not robust, and fails for easy expressions such as k = toInfx[a/b + ArcTan[a/b]]
Is there an easy way to get Infix[] working for All (leaves)?

Here is one way:
ClearAll[toInfixAlt];
SetAttributes[toInfixAlt, HoldAll];
toInfixAlt[expr_] :=
First#MapAll[Infix, HoldForm[expr]] //.
Infix[a : _?(Function[s, AtomQ[Unevaluated#s], HoldAll]) | _[_]| _[]] :> a
I used HoldForm since you may want the code to remain unevaluated. Here is an example:
In[781]:= toInfixAlt[(c a^b)^d/(1/2)]
Out[781]= ((c ~Times~ (a ~Power~ b)) ~Power~ d) ~Times~ (1/((1/2)))
EDIT
and,
In[792]:= toInfixAlt[a/b+ArcTan[a/b]]
Out[792]= (a ~Times~ (b ~Power~ (-1))) ~Plus~ ArcTan[a ~Times~ (b ~Power~ (-1))]
End EDIT
As to the superfluous parentheses, it is harder to remove them since often they are indeed needed due to precedence of various operators, but should be possible.
EDIT 2
To take care of precedence, here is an attempt:
ClearAll[toInfixAlt];
SetAttributes[toInfixAlt, HoldAll];
toInfixAlt[expr_] :=
First#MapAll[Infix, HoldForm[expr]] //.
Infix[a : _?(Function[s, AtomQ[Unevaluated#s],HoldAll]) | _[_] | _[]] :> a //.
{
Infix[f_[a__, Infix[r : (h_[___])],b___]] /;
Precedence[Unevaluated[f]] <= Precedence[Unevaluated[h]] :> Infix[f[a, r, b]],
Infix[b___,f_[Infix[r : (h_[___])], a__]] /;
Precedence[Unevaluated[f]] <= Precedence[Unevaluated[h]] :> Infix[f[b, r, a]]
};
Now, I get:
In[963]:= toInfixAlt[a/b+ArcTan[a/b]]
Out[963]= (a b ~Power~ (-1)) ~Plus~ ArcTan[a ~Times~ (1/b)]

Here's my approach, very similar to Leonid's:
(* In[118]:= *) foo[a:_[_,__]]:=Infix[a]
foo[a_]:=a
(* In[120]:= *) MapAll[foo,(c a^b)^d]
(* Out[120]= *) (c ~Times~ (a ~Power~ b)) ~Power~ d
(* In[121]:= *) MapAll[foo,a/b+ArcTan[a/b]]
(* Out[121]= *) ArcTan[a ~Times~ (b ~Power~ (-1))] ~Plus~ (a ~Times~ (b ~Power~ (-1)))

I don't know why I am helping you make fun of me, but...
(c a^b)^d //. h_[a_, b_] :> ix[a, h, b] /. ix :> (Infix[{##}, "~"] &)

Related

SML merge_sort function using let in and pattern matching

fun merge_sort (_, nil) = nil
| merge_sort (_, [a]) = [a]
| merge_sort (f, L) =
let
fun halve nil = (nil,nil)
| halve [a] = ([a], nil)
| halve (a :: b :: rest) =
let
val (x , y) = halve rest
in
(a :: x, b :: y)
end
fun merge (f, nil, x) = x
| merge (f, x, nil) = x
| merge (f, a::b, x::y) =
if f(a, b) then a :: merge (f, b, x::y)
else x :: merge (f, a::b, y);
val (x, y) = halve L
in
merge(f, merge_sort(f, x), merge_sort(f,y))
end;
merge_sort (op <) [2,1,3,2,4,3,45];
This is a SML function that I have been working on. It is meant to take a function call as shown in the bottom and merge sort. Must be one function. I am struggling understanding the pattern matching and how to fully make this function work.
I get this error code when I compile and run it.
$sml < main.sml
Standard ML of New Jersey v110.78 [built: Thu Aug 31 03:45:42 2017]
- val merge_sort = fn : ('a * 'a list -> bool) * 'a list -> 'a list
stdIn:23.1-23.35 Error: operator and operand don't agree [tycon mismatch]
operator domain: ('Z * 'Z list -> bool) * 'Z list
operand: [< ty] * [< ty] -> bool
in expression:
merge_sort <
-
I don't entirely know what I am doing wrong
Using the convention of naming lists with a plural "s" and using the same base name for the head and tail in patterns makes the problem stick out immediately:
merge (f, x::xs, y::ys) =
if f(x, xs) then x :: merge (f, xs, y::ys)
else y :: merge (f, x::xs, ys);
where f(x, xs) should of course be f(x, y).
This convention is conventional because it's useful. Don't leave home without it.
You have a typo; this:
if f(a, b) then a :: merge (f, b, x::y)
else x :: merge (f, a::b, y);
should be this:
if f (a, x) then a :: merge (f, b, x::y)
else x :: merge (f, a::b, y)
(calling f on (a, x) rather than on (a, b)).
Since b and x have different types ('Z list and 'Z, respectively), the consequence of this typo is that f is inferred to have the wrong type ('Z * 'Z list -> bool rather than 'Z * 'Z -> bool), so the whole merge_sort function is inferred to have the wrong type scheme (('a * 'a list -> bool) * 'a list -> 'a list instead of ('a * 'a -> bool) * 'a list -> 'a list).
Some explicit type annotations (e.g. writing f : 'a * 'a -> bool in one place) might make it easier for the compiler to help you see where you're deviating from the types you intended; but, admittedly, if you don't already know where you're deviating, then it can be hard to figure out where to add annotations so the compiler can help you find where you're deviating.

Logical Equivalence: Show that R OR P implies R OR Q is equivalent to NOT R implies (P implies Q)?

I'm practicing logical equivalence and I've come across a question that I'm struggling to answer:
Show that (R or P -> R or Q) is equivalent to (not R -> (P -> Q)).
I've examined the truth tables of both implications but the question states that I should use equivalence laws to show that the implications are equivalent.
If anyone could help me out, I would appreciate it.
Thank you.
Intuitive
A formal proof (included below) which only allows one to follow the steps one by one is less useful than a proof that helps us understand why both expressions are equivalent. Consider the first expression:
(R or P) -> (R or Q)
and think about its meaning...
The expression is trivial when R=true, isn't it? Therefore the only information it encloses is that when R=false, P -> (R or Q). But when R=false, (R or Q) = Q. So, the precise meaning of the expression is that when R=false, P -> Q. In other words, not R -> (P -> Q).
Formal
(R or P) -> (R or Q) = not (R or P) or (R or Q) ;X -> Y = not X or Y
= (not R and not P) or (R or Q) ;not (X or Y) = not X or not Y
= ((not R and not P) or R) or Q ;X or (Y or Z) = (X or Y) or Z
= ((not R or R) and (not P or R)) or Q ;(X and Y) or Z = (X or Z) and (Y or Z)
= (not P or R) or Q ;(not X or X) = true
= (R or not P) or Q
= R or (not P or Q)
= R or (P -> Q)
= not (not R) or (P -> Q)
= not R -> (P -> Q) ;not X or Y = X -> Y

Existential quantifier in coq impredicative logic (System F)

I was trying to code into Coq logical connectives encoded in lambda calculus with type à la System F. Here is the bunch of code I wrote (standard things, I think)
Definition True := forall X: Prop, X -> X.
Lemma I: True.
Proof.
unfold True. intros. apply H.
Qed.
Section s.
Variables A B: Prop.
(* conjunction *)
Definition and := forall X: Prop, (A -> B -> X) -> X.
Infix "/\" := and.
Lemma and_intro: A -> B -> A/\B.
Proof.
intros HA HB. split.
apply HA.
apply HB.
Qed.
Lemma and_elim_l: A/\B -> A.
Proof.
intros H. destruct H as [HA HB]. apply HA.
Qed.
Lemma and_elim_r: A/\B -> B.
Proof.
intros H. destruct H as [HA HB]. apply HB.
Qed.
(* disjunction *)
Definition or := forall X:Prop, (A -> X) -> (B -> X) -> X.
Infix "\/" := or.
Lemma or_intro_l: A -> A\/B.
intros HA. left. apply HA.
Qed.
Lemma or_elim: forall C:Prop, A \/ B -> (A -> C) -> (B -> C) -> C.
Proof.
intros C HOR HAC HBC. destruct HOR.
apply (HAC H).
apply (HBC H).
Qed.
(* falsity *)
Definition False := forall Y:Prop, Y.
Lemma false_elim: False -> A.
Proof.
unfold False. intros. apply (H A).
Qed.
End s.
Basically, I wrote down the elimination and introduction laws for conjunction, disjunction, true and false. I am not sure of having done thing correctly, but I think that things should work that way. Now I would like to define the existential quantification, but I have no idea of how to proceed. Does anyone have a suggestion?
Existential quantification is just a generalization of conjunction, where the type of the second component of the pair depends on the value of the first component. When there's no dependency they're equivalent:
Goal forall P1 P2 : Prop, (exists _ : P1, P2) <-> P1 /\ P2.
Proof. split. intros [H1 H2]. eauto. intros [H1 H2]. eauto. Qed.
Coq'Art has a section on impredicativity starting at page 130.
Definition ex (T1 : Type) (P1 : T1 -> Prop) : Prop :=
forall P2 : Prop, (forall x1, P1 x1 -> P2) -> P2.
Notation "'exists' x1 .. x2 , P1" :=
(ex (fun x1 => .. (ex (fun x2 => P1)) ..))
(at level 200, x1 binder, right associativity,
format "'[' 'exists' '/ ' x1 .. x2 , '/ ' P1 ']'") : type_scope.
The problem with impredicative definitions (unless I'm mistaken) is that there's no dependent elimination. It's possible prove
forall (A : Type) (P : A -> Prop) (Q : Prop),
(forall x : A, P x -> Q) -> (exists x, P x) -> Q,
but not
forall (A : Type) (P : A -> Prop) (Q : (exists x, P x) -> Prop),
(forall (x : A) (H : P x), Q (ex_intro P x H)) ->
forall H : exists x, P x, Q H

Passing a function to a module without specifying its arguments

I want to write a
Module Arg[f_,n_]
that takes a function f (having <=n arguments) and a natural number n and outputs the n-th argument of the function f.
As an example, suppose that f is defined by
f[a_,b_]=a^2+b^2.
Then,
Arg[f[s,t],1]
should be s;
while
Arg[f[u,v],2]
should be v.
My question is whether this is possible. If so, what should I write in the place of "???" below?
Arg[f_,n_] := Module[{}, ??? ]
Note that I don't want to specify a_ and b_ in the definition of Arg like
Arg[f_,a_,b_,n_]
EDIT: "Arg" is just my name for the module not the internal function Arg of Mathematica.
Perhaps
SetAttributes[arg, HoldFirst];
arg[f_[x___], n_] := {x}[[n]]
f[a_, b_] := a^2 + b^2.
arg[f[arg[f[s, t], 1], t], 1]
arg[f[s, t], 2]
(*
-> s
-> t
*)
arg[ArcTan[f[Cos#Sin#x, x], t], 1]
(*
-> x^2. + Cos[Sin[x]]^2
*)
Assuming your second example should give u, this should do the job:
ClearAll[arg];
SetAttributes[arg, HoldFirst];
arg[g_, n_] := Module[
{tmp, ret},
Unprotect[Part];
tmp = Attributes[Part];
SetAttributes[Part, HoldFirst];
ret = Part[g, n];
ClearAttributes[Part, HoldFirst];
SetAttributes[Part, tmp];
Protect[Part];
ret
]
so that
f[a_, b_] = a^2 + b^2.;
arg[f[s, t], 1]
gives s.
This is very heavy-handed though, so I expect someone will find something better soon enough.
This is a bit better (doesn't redefine built-in functions even temporarily):
ClearAll[arg2];
SetAttributes[arg2, HoldFirst];
arg2[g_, n_] := Hold[g][[1, n]]

Is there a built-in Mathematica function to find operators rather than numbers in equations?

How can the following be best accomplished in Mathematica?
In[1] := Solve[f[2,3]==5,f ∈ {Plus,Minus,Divide}]
Out[1] := Plus
The desired expression syntax can be transformed into a set of Solve expressions:
fSolve[expr_, f_ ∈ functions_List] :=
Map[Solve[(expr /. f -> #) && f == #, f] &, functions] // Flatten
Sample use:
In[6]:= fSolve[f[2,3] == 5, f ∈ {Plus, Subtract, Divide}]
Out[6]= {f -> Plus}
In[7]:= fSolve[f[4,2] == 2, f ∈ {Plus, Subtract, Divide}]
Out[7]= {f -> Subtract, f -> Divide}
The advantage of this approach is that the full power of Solve remains available for more complex expressions, e.g.
In[8]:= fSolve[D[f[x], x] < f[x], f ∈ {Log, Exp}]
Out[8]= {f -> ConditionalExpression[Log, x Log[x]∈Reals && x>E^ProductLog[1]]}
In[9]:= fSolve[D[f[x], x] <= f[x], f ∈ {Log, Exp}]
Out[9]= {f -> ConditionalExpression[Log, x Log[x]∈Reals && x>=E^ProductLog[1]],
f -> ConditionalExpression[Exp, E^x ∈ Reals]}
Please tell me if this does what you want:
findFunction[expr_, head_ ∈ {ops__}] :=
Quiet#Pick[{ops}, expr /. head -> # & /# {ops}]
findFunction[f[2, 3] == 5, f ∈ {Plus, Minus, Divide}]
(* Out[]= {Plus} *)
I'm not aware of a built-in function, but it's not hard to write one yourself. Here is one approach that you can use:
Clear#correctOperatorQ;
correctOperatorQ[expr_, value_,
operators_] := (expr == value) /. Head[expr] -> # & /# operators
By the way, the correct operator for 2-3 is Subtract, not Minus. The result for your example:
correctOperatorQ[f[2, 3], 5, {Plus,Subtract,Divide}]
Out[1]={True, False, False}

Resources