Mathematica: How to prevent evaluation of In[-1]? - wolfram-mathematica

When I'm trying to get last input expression in Wolfram Mathematica 5.2 using In[-1] I get evaluated output:
In[1]:= On[In]
2 + 2
In[-1]
Out[2]= 4
During evaluation of In[1]:= In::trace: In[-1] --> In[$Line-1]. >>
During evaluation of In[1]:= In::trace: In[$Line-1] --> In[2]. >>
During evaluation of In[1]:= In::trace: In[2] --> 2+2. >>
Out[3]= 4
How can I get the input expression in unevaluated form?

You could try InString[]
In[1]:= 2 + 2
Out[1]= 4
In[2]:= InString[-1]
Out[2]= "\\(2 + 2\\)"

Here is another way:
In[1]:= 2 + 2
With[{line = $Line - 1}, HoldForm[In[line]] /. DownValues[In]]
Out[1]= 4
Out[2]= 2+2
Edit:
This method does not work properly with Unevaluated:
In[1]:= Unevaluated[2 + 2]
With[{line = $Line - 1}, HoldForm[In[line]]] /. (DownValues[In])
Out[1]= Unevaluated[2 + 2]
Out[2]= 2 + 2
I have opened a separate question on this.

Related

Double parentheses with three arguments, mathematica

If I assign something like this to variable Res:
Res=Solve[6-5x+x^2==0];
What will do the following line?
Res[[1,1,2]]
or
Res[[2,1,2]]
Let's examine the FullForm of Res to see what Res[[1,1,2]] means:
In[1]:= Res = Solve[6 - 5 x + x^2 == 0]
Out[1]= {{x -> 2}, {x -> 3}}
In[2]:= FullForm[Res]
Out[2]= List[List[Rule[x, 2]], List[Rule[x, 3]]]
Hence:
Res[[1]] = List[Rule[x,2]]
Res[[1,1]] = Rule[x,2]
Res[[1,1,2]] = 2

Simple power counting

How can one add the number of powers of x in expressions like the following?
x^2f[x]g[x^3]
or
x^2g[x^4]
or
x^2g[x^2f[x^2]]
The counting is such that all these examples must return 6.
I was thinking of using Count with some pattern, but I didn't manage to construct a pattern for this.
Here's my quick hack - some of the behaviour (see the final example) might not be quite what you want:
SetAttributes[countPowers, Listable]
countPowers[expr_, symb_] := Module[{a},
Cases[{expr} /. symb -> symb^a // PowerExpand, symb^n_ :> n,
Infinity] /. a -> 1 // Total]
Then
In[3]:= countPowers[{x^2 f[x] g[x^3], x^2 g[x^4], x^2 g[x^2 f[x^2]]}, x]
Out[3]= {6, 6, 6}
and
In[4]:= countPowers[{x^(2 I) g[x^3], g[x, x^4],
x^2 g[E^(2 Pi I x) , f[x]^x]}, x]
Out[4]= {3 + 2 I, 5, 5}
Since you want to count x as an implicit power of 1, you could use this:
powerCount[x_Symbol][expr_] :=
Tr # Reap[PowerExpand[expr] /. {x^n_ :> Sow[n], x :> Sow[1]}][[2,1]]
powerCount[x] /#
{
x^2f[x]g[x^3],
x^2g[x^4],
x^2g[x^2f[x^2]]
}
{6, 6, 6}
Alternatively, this could be written without Sow and Reap if that makes it easier to read:
powerCount[x_Symbol][expr_] :=
Module[{t = 0}, PowerExpand[expr] /. {x^n_ :> (t += n), x :> t++}; t]
Either form can be made more terse using vanishing patterns, at the possible expense of clarity:
powerCount[x_Symbol][expr_] :=
Tr # Reap[PowerExpand[expr] /. x^n_ | x :> Sow[1 n]][[2, 1]]

Why does Default behave like this?

One may set a Default value for the arguments of a function:
Default[f] = 5;
And then use:
f[a_, b_.] := {a, b}
f[1, 2]
f[1]
{1, 2}
{1, 5}
This creates the following Values:
DefaultValues[f]
DownValues[f]
{HoldPattern[Default[f]] :> 5}
{HoldPattern[f[a_, b_.]] :> {a, b}}
From this one might think that the value 5 is not fixed in the definition of f, but addresses the DefaultValues assignment. However, if we change the DefaultValues, either directly or using:
Default[f] = 9;
DefaultValues[f]
{HoldPattern[Default[f]] :> 9}
and use f again:
f[1]
{1, 5}
we see that the new value is not used.
Therefore, my questions are:
Why does the default value used by f[a_, b_.] := {a, b} not change with DefaultValues?
Where is the real default value (5) stored, since it does not appear in either DownValues or DefaultValues?
Not an answer, but:
Using the behaviour that the original default is kept until the function is redefined suggests a quick work-around:
Define a global variable for the Default before any other definitions are made.
In[1]:= Default[f]:=$f
In[2]:= f[a_.]:=a
In[3]:= f[]
Out[3]= $f
In[4]:= $f=5; f[]
Out[5]= 5
In[6]:= $f=6; f[]
Out[7]= 6
In[8]:= $f=.; f[]
Out[9]= $f
This also works for Optional
In[1]:= g[a_:$g] := a
In[2]:= g[]
Out[2]= $g
In[3]:= $g=1; g[]
Out[4]= 1
From the documentation,
The necessary values for Default[f] must always be defined before _. is used as an argument of f.
Redefining f after setting Default[f] = 9; uses the new default value. So my guess is it is defined internally the first time, f is defined, and doesn't change even if DefaultValue#f stores the new value.
I have found that this behavior in the case of local rules is due to specifics of internals of RuleDelayed.
Compare:
In[1]:= Default[f] = 5;
replaceAll[f[1],
f[a_, b_.] :> Unevaluated#{a, b}] /. (Default[f] = 9; replaceAll) ->
ReplaceAll
Default[f] = 5;
Block[{RuleDelayed},
replaceAll[f[1],
f[a_, b_.] :> Unevaluated#{a, b}] /. (Default[f] = 9;
replaceAll) -> ReplaceAll]
Out[2]= {1, 5}
Out[4]= Unevaluated[{1, 9}]
One can see that Blocking RuleDelayed makes local rules to behave as one could expect.

Using Solve in Mathematica

To get acquainted with Mathematica's solving functions, I tried to work out a solution to a MinuteMath problem:
There is a list of seven numbers. The average of the first four numbers is 5, and the
average of the last four numbers is 8. If the average of all seven numbers is 46/7, then
what is the number common to both sets of four numbers?
Of course, this is an excercise that can be solved without computer, but how can I solve this using Mathematica? My first approach
X = Table[Subscript[x, i], {i, 1, 7}];
cond = {
Mean[Part[X, 1 ;; 4]] == 5,
Mean[Part[X, 4 ;; 7]] == 8,
Mean[X] == 46/7
};
Solve[cond, Subscript[x, 4]]
returned no solution. My second approach
X = Table[Subscript[x, i], {i, 1, 7}];
rules = {Mean[Part[X, 1 ;; 4]] -> 5,
Mean[Part[X, 4 ;; 7]] -> 8,
Mean[X] -> 46/7
};
Solve[
Mean[X] == Mean[Part[X, 1 ;; 4]]
+ Mean[Part[X, 4 ;; 7]]
- Subscript[x, 4] /. rules,
Subscript[x, 4]
]
gives a wrong solution (45/7 instead 6). What did I wrong?
The first piece of code that you give is fine. The only problem is there is no solution for x_4 alone. If you replace the last line by Solve[cond] then Mathmatica automagically chooses the free variables and you'll get the solution.
I think that a simple/trivial example would make this type problem clear:
In[1]:= Solve[x==1&&y==2,x]
Solve[x==1&&y==2,{x,y}]
Out[1]= {}
Out[2]= {{x->1,y->2}}
The final output can also be obtained using Solve[x==1&&y==2], where Mma guesses the free variables. This behaviour differs from that of Mathematica 7. In Mathematica 8 a new option for Solve (and related functions) called MaxExtraCondtions was introduced. This allows Solve to give solutions that use the new ConditionalExpression and is intended to make the behaviour of solve more consistent and predictable.
Here's how it works in this simple example:
In[3]:= Solve[x==1&&y==2, x, MaxExtraConditions->1]
Out[3]= {{x -> ConditionalExpression[1, y==2]}}
See the above linked to docs for more examples that show why this Option is useful. (Although maybe defaulting to Automatic instead of 0 would be a more pragmatic design choice for the new option...)
Finally, here's your first solution rewritten a little:
In[1]:= X=Array[Symbol["x"<>ToString[#]]&,{7}]
Out[1]= {x1,x2,x3,x4,x5,x6,x7}
In[2]:= cond=Mean[X[[1;;4]]]==5&&Mean[X[[4;;7]]]==8&&Mean[X]==46/7;
In[3]:= Solve[cond]
x4/.%
Out[3]= {{x1->14-x2-x3,x4->6,x5->26-x6-x7}}
Out[4]= {6}
Perhaps more compact:
Reduce[Mean#Array[f, 4] == 5 &&
Mean#Array[f, 4, 4] == 8 &&
Mean#Array[f, 7] == 46/7]
(*
-> f[5] == 26 - f[6] - f[7] &&
f[4] == 6 &&
f[1] == 14 - f[2] - f[3]
*)
Although for clarity, I probably prefer:
Reduce[Sum[f#i, {i, 4}] == 20 &&
Sum[f#i, {i, 4, 7}] == 32 &&
Sum[f#i, {i, 7}] == 46]
Edit
Note that I am using function upvalues as vars and not list elements. I prefer this way because:
You don't need to initialize the list
(Table[Subscript ... in your
example`)
The resulting expressions are usually
less cluttered (No Part[ ;; ], etc)

How to make an analog of InString[]?

I have discovered that InString[] does not work in MathLink mode when sending input with EnterExpressionPacket header. So I need to define my own function that returns previous input line. One way I have developed here does not work in some cases:
In[1]:= Unevaluated[2 + 2]
With[{line = $Line - 1}, HoldForm[In[line]]] /. (DownValues[In])
Out[1]= Unevaluated[2 + 2]
Out[2]= 2 + 2
This is because RuleDelayed has no HoldAllComplete attribute. Adding this attribute makes this OK:
In[1]:= Unprotect[RuleDelayed];
SetAttributes[RuleDelayed, HoldAllComplete];
Protect[RuleDelayed];
Unevaluated[2 + 2]
With[{line = $Line - 1}, HoldForm[In[line]]] /. DownValues[In]
Out[4]= Unevaluated[2 + 2]
Out[5]= Unevaluated[2 + 2]
But modifying built-in functions generally is not a good idea. Is there a better way to do this?
It seems that I have solved the problem. Here is the function:
In[1]:=
getLastInput := Module[{num, f},
f = Function[{u, v},
{u /. {In -> num, HoldPattern -> First}, HoldForm[v]}, HoldAllComplete];
First#Cases[
Block[{RuleDelayed = f}, DownValues[In]],
{$Line - 1, x_} -> x, {1}, 1]]
In[2]:=
Unevaluated[2+2]
getLastInput
Out[2]=
Unevaluated[2+2]
Out[3]=
Unevaluated[2+2]
And I just have got the answer to the question on InString in MathLink mode from Todd Gayley (Wolfram Research):
InString is only assigned when using
EnterTextPacket, not
EnterExpressionPacket. There is no
string form of the input when sending
EnterExpressionPacket (whose content
is, by definition, already an
expression).
EDIT:
I just have found that my code does not work with input expressions with head Evaluate. The solution is to replace HoldForm by HoldComplete in my code:
getLastInput := Module[{num, f},
f = Function[{u, v},
{u /. {In -> num, HoldPattern -> First}, HoldComplete[v]}, HoldAllComplete];
First#Cases[
Block[{RuleDelayed = f}, DownValues[In]],
{$Line - 1, x_} -> x, {1}, 1]]
This works well. Another approach would be to unprotect HoldForm and set up attribute HoldAllComplete on it. I'm wondering why HoldForm does not have this attribute by default?
EDIT 2:
In the comments for the main question Leonid Shifrin suggested much better solution:
getLastInput :=
Block[{RuleDelayed},SetAttributes[RuleDelayed,HoldAllComplete];
With[{line=$Line-1},HoldComplete[In[line]]/.DownValues[In]]]
See comments for details.
EDIT 3:
The last code can be made even better for by replacing HoldComplete by double HoldForm:
getLastInput :=
Block[{RuleDelayed},SetAttributes[RuleDelayed,HoldAllComplete];
With[{line=$Line-1},HoldForm#HoldForm[In[line]]/.DownValues[In]]]
The idea is taken from presentation by Robby Villegas of Wolfram Research at the 1999 Developer Conference. See subsection "HoldCompleteForm: a non-printing variant of HoldComplete (just as HoldForm is to Hold)" in "Working With Unevaluated Expressions" notebook posted here.
I would use $Pre and $Line for this; unlike $PreRead, it's applied to input expressions, not input strings or box forms. All you need is to assign it a function that has the HoldAllComplete attribute, like this one which I've adapted from the example in the documentation:
SetAttributes[saveinputs, HoldAllComplete];
saveinputs[new_] :=
With[{line = $Line},
inputs[line] = HoldComplete[new]; new]
$Pre = saveinputs;
I tested this with MathLink, and the behavior seems to be what you desired (I've elided some of the transcript to highlight the key point):
In[14]:= LinkWrite[link,
Unevaluated[
EnterExpressionPacket[
SetAttributes[saveinputs, HoldAllComplete];
saveinputs[new_] :=
With[{line = $Line},
inputs[line] = HoldComplete[new]; new];
$Pre = saveinputs;]]]
In[15]:= LinkRead[link]
Out[15]= InputNamePacket["In[2]:= "]
In[20]:= LinkWrite[link,
Unevaluated[EnterExpressionPacket[Evaluate[1 + 1]]]]
In[21]:= LinkRead[link]
Out[21]= OutputNamePacket["Out[2]= "]
In[21]:= LinkRead[link]
Out[21]= ReturnExpressionPacket[2]
In[24]:= LinkWrite[link, Unevaluated[EnterExpressionPacket[DownValues[inputs]]]]
In[26]:= LinkRead[link]
Out[26]= ReturnExpressionPacket[
{HoldPattern[inputs[2]] :> HoldComplete[Evaluate[1 + 1]],
HoldPattern[inputs[3]] :> HoldComplete[DownValues[inputs]]}]
I just have found simpler but dangerous way:
In[3]:= Unevaluated[2 + 2]
Trace[In[$Line - 1]] // Last
Trace[In[$Line - 1]] // Last
Out[3]= Unevaluated[2 + 2]
Out[4]= Unevaluated[2 + 2]
During evaluation of In[3]:= $RecursionLimit::reclim: Recursion depth of 256 exceeded. >>
During evaluation of In[3]:= $RecursionLimit::reclim: Recursion depth of 256 exceeded. >>
During evaluation of In[3]:= $IterationLimit::itlim: Iteration limit of 4096 exceeded. >>
Out[5]= Hold[In[$Line-1]]
Does anybody know a way to make it safe?

Resources