Mathematica: Redefine multiplication so that 0*(-Inf) = 0 - wolfram-mathematica

In my Mathematica program, I do some entropy calculations and I want to use this convention: Log[0]*0 = 0. Is there a clean way to do it or I have to write my own function?
Inspired by http://tinyurl.com/9d8r4rt I tried things like this:
Unprotect[Times];
Times[0, -Infinity] := 0;
Protect[Times];
But it doesn't seem to work in my case. Is there an elegant way to do this?

I support High Performance Mark's statement above. Nevertheless this is an interesting question because the answer is nontrivial.
You would need:
Unprotect[DirectedInfinity];
DirectedInfinity /: Log[0] 0 := 0
You need DirectedInfinity because:
Log[0] // FullForm
DirectedInfinity[-1]
And you need an UpValue, made using TagSet, to override the default reaction to -∞ * 0, because UpValues are tried before other definitions.

Related

Taking Derivative of a Matrix with functions in Maple. Want to leave functions as prime (f' or f'') and not evaluate

I want to evaluate a matrix that has a function named alpha. When I take the derivative of alpha, I would like the result to give me an alpha'
Example: if I have sin(alpha) I want to get cos(alpha)alpha' but throughout the matrix.
It is quite unclear what you mean by stating that you have a "function" in Maple, of which you intend to take the derivative.
That could mean some expression depending upon a name such as t, with respect to which you intend on differentiating using Maple's diff command. And such an expression may be assigned to alpha, or it may contain the function call alpha(t).
Or perhaps you wish to treat alpha as an operator name, and differentiate functionally with Maple's D command.
I shall make a guess as to what you meant.
restart;
Typesetting:-Suppress(alpha(t));
Typesetting:-Settings(prime=t):
Typesetting:-Settings(typesetprime=true):
M := Matrix([[ sin(alpha(t)), exp(p*alpha(t)) ]]);
map(diff, M, t);
If that's not the kind of thing that you're after then you should explain your purpose and needs in greater detail.
Your question's title mentions a desire to have something not "evaluate". What did you mean by that? Have you perhaps assigned something to the name f?
Thank you for answering. I found the solution after a lot of guess and checking and reading. Here is my code with my solution.
with(Typesetting) :
Settings(typesetdot = true);
a:= alpha(t)
Rna:= [ cos(alpha), -sin(alpha), 0; sin(alpha), cos(alpha), 0; 0, 0, 1 ]
b := beta(t)
Rab:= [ cos(beta), -sin(beta), 0; sin(beta), cos(beta), 0; 0, 0, 1 ]
Rnab:= Rna . Rab
Rnab:= map(diff, Rnab, t)
Sorry for the multiple answers, I am getting use to the website.

How to use cwise operations over specific indexes of a vector? (Eigen)

I'm trying to translate the following Matlab code to C/C++.
indl = find(dlamu1 < 0); indu = find(dlamu2 < 0);
s = min([1; -lamu1(indl)./dlamu1(indl); -lamu2(indu)./dlamu2(indu)]);
I've read on another thread that there's yet no equivalent in the Eigen library to the find() function and I'm at peace with that and have brute-forced around it.
Now, if I wanted to do the coefficient-wise division of lamu1 and dlamu1, I'd go for lamu1.cwiseQuotient(dlamu1) but how do I go about doing that but only for some of their coefficients, which indexes are specified by the coefficients of indl? I haven't found anything about this in the documentation, but maybe I'm not using the right search terms.
With the default branch you can just write lamu1(indl) with indl a std::vector<int> or a Eigen::VectorXi or whatever you like that supports random access through operator[].
There is no equivalent of find (yet) even in the default branch. Your function can however be expressed using the select method (also works with Eigen 3.3.x):
double ret1 = (dlamu1.array()<0).select(-lamu1.cwiseQuotient(dlamu1), 1.0).minCoeff();
return std::min(1.0,ret1); // not necessary, if dlamu1.array()<0 at least once
select evaluates lazily, i.e., only if the condition is true, the quotient will be calculated. On the other hand, a lot of unnecessary comparisons with 1.0 will happen with the code above.
If [d]lamu are stored in Eigen::ArrayXd instead of Eigen::VectorXd, you can write:
double ret1 = (dlamu1<0).select(-lamu1/dlamu1, 1.0).minCoeff();
If you brute-forced indl anyway, you can as ggael suggested write:
lamu1(indl).cwiseQuotient(dlamu1(indl)).minCoeff();
(this is undefined/crashes if indl.size()==0)

Perform optimization with F# and Accord.net

I'm using F# with Accord.NET, and I'm trying to perform an optimization using the Nelder-Mead algorithm.
After a week of attempts, trying to follow the examples from website, I still can't perform the operation.
I didn't find the way to write the expression for optimize the function.
I wrote a custom function which accept 9 parameters:
let FunSqEuclid (F:float) (X:float[]) (T:float) (iv:float[]) (atmVol:float) (alpha:float) (beta:float) (volVol:float) (rho:float) =
let dum01 = VecAlphaSABR (F:float) (X:float[]) (T:float) (atmVol:float) (alpha:float) (beta:float) (volVol:float) (rho:float)
let dum02 = Array.map2 (+) dum01 iv
let dum03 = dum02.SquareEuclidean()
dum03
What I need is to optimize this function varying only the "volVol" and "rho" parameters, but keeping constant all the others.
Following examples (in C#), I tried with:
let ObFunc = NonlinearObjectiveFunction(function: () => (FunSqEuclid (F:float) (X:float[]) (T:float) (iv:float[]) (atmVol:float) (alpha:float) (beta:float) (volVol:float) (rho:float)))
using costraints to keep parameters constant, but I have error on keyword "function", both for NonlinearObjectiveFunction and NonlinearCostraint.
I read on documentation that objective function can be written as a Linq Expression, but I never used it.
There is an alternative way to insert objective function and costraints? Or, please, can you suggest where are similar examples in Linq Expression for F#?
EDIT
I found more informations from the examples of "Extreme Optimization" library. I have seen it has a similar approach to "Accord.net" about the optimization, and there are examples in F#, so, with appropriate adaptations, I understand how it works when parameters are simple values.
The point is that I'm trying to translate some R code to F#.
The R code performing the optimization is the following:
objective <- function(x){sum( (iv - SABR.BSIV(t, f, K, exp(x[1]), .t1(x[2]), .t2(x[3]), exp(x[4])))^2) }
x <- nlm(objective, c(0.2, 1.0, 0.0, 0.1))
where K and iv are arrays. So, I still didn't find a way to pass array arguments for the objective function in Accord.net.
Please, can you suggest me some way?
Thanks.

How do I define a new numeric constant in Mathematica?

What is the best way to define a numerical constant in Mathematica?
For example, say I want g to be the approximate acceleration due to gravity on the surface of the Earth. I give it a numerical value (in m/s^2), tell Mathematica it's numeric, positive and a constant using
Unprotect[g];
ClearAll[g]
N[g] = 9.81;
NumericQ[g] ^= True;
Positive[g] ^= True;
SetAttributes[g, Constant];
Protect[g];
Then I can use it as a symbol in symbolic calculations that will automatically evaluate to 9.81 when numerical results are called for. For example 1.0 g evaluates to 9.81.
This does not seem as well tied into Mathematica as built in numerical constants. For example Pi > 0 will evaluate to True, but g > 0 will not. (I could add g > 0 to the global $Assumptions but even then I need a call to Simplify for it to take effect.)
Also, Positive[g] returns True, but Positive[g^2] does not evaluate - compare this with the equivalent statements using Pi.
So my question is, what else should I do to define a numerical constant? What other attributes/properties can be set? Is there an easier way to go about this? Etc...
I'd recommend using a zero-argument "function". That way it can be given both the NumericFunction attribute and a numeric evaluation rule. that latter is important for predicates such as Positive.
SetAttributes[gravUnit, NumericFunction]
N[gravUnit[], prec_: $MachinePrecision] := N[981/100, prec]
In[121]:= NumericQ[gravitUnit[]]
Out[121]= True
In[122]:= Positive[gravUnit[]^2 - 30]
Out[122]= True
Daniel Lichtblau
May be I am naive, but to my mind your definitions are a good start. Things like g > 0->True can be added via UpValues. For Positive[g^2] to return True, you probably have to overload Positive, because of the depth-1 limitation for UpValues. Generally, I think the exact set of auto-evaluated expressions involving a constant is a moving target, even for built-in constants. In other words, those extra built-in rules seem to be determined from convenience and frequent uses, on a case-by-case basis, rather than from the first principles. I would just add new rules as you go, whenever you feel that you need them. You probably can not expect your constants to be as well integrated in the system as built-ins, but I think you can get pretty close. You will probably have to overload a number of built-in functions on these symbols, but again, which ones those will be, will depend on what you need from your symbol.
EDIT
I was hesitating to include this, since the code below is a hack, but it may be useful in some circumstances. Here is the code:
Clear[evalFunction];
evalFunction[fun_Symbol, HoldComplete[sym_Symbol]] := False;
Clear[defineAutoNValue];
defineAutoNValue[s_Symbol] :=
Module[{inSUpValue},
s /: expr : f_[left___, s, right___] :=
Block[{inSUpValue = True},
With[{stack = Stack[_]},
If[
expr === Unevaluated[expr] &&
(evalFunction[f, HoldComplete[s]] ||
MemberQ[
stack,
HoldForm[(op_Symbol /; evalFunction[op, HoldComplete[s]])
[___, x_ /; ! FreeQ[Unevaluated[x], HoldPattern#expr], ___]],
Infinity
]
),
f[left, N[s], right],
(* else *)
expr
]]] /; ! TrueQ[inSUpValue]];
ClearAll[substituteNumeric];
SetAttributes[substituteNumeric, HoldFirst];
substituteNumeric[code_, rules : {(_Symbol :> {__Symbol}) ..}] :=
Internal`InheritedBlock[{evalFunction},
MapThread[
Map[Function[f, evalFunction[f, HoldComplete[#]] = True], #2] &,
Transpose[List ### rules]
];
code]
With this, you may enable a symbol to auto-substitute its numerical value in places where we indicate some some functions surrounding those function calls may benefit from it. Here is an example:
ClearAll[g, f];
SetAttributes[g, Constant];
N[g] = 9.81;
NumericQ[g] ^= True;
defineAutoNValue[g];
f[g] := "Do something with g";
Here we will try to compute some expressions involving g, first normally:
In[391]:= {f[g],g^2,g^2>0, 2 g, Positive[2 g+1],Positive[2g-a],g^2+a^2,g^2+a^2>0,g<0,g^2+a^2<0}
Out[391]= {Do something with g,g^2,g^2>0,2 g,Positive[1+2 g],
Positive[-a+2 g],a^2+g^2,a^2+g^2>0,g<0,a^2+g^2<0}
And now inside our wrapper (the second argument gives a list of rules, to indicate for which symbols which functions, when wrapped around the code containing those symbols, should lead to those symbols being replaced with their numerical values):
In[392]:=
substituteNumeric[{f[g],g^2,g^2>0, 2 g, Positive[2 g+1],Positive[2g-a],g^2+a^2,g^2+a^2>0,
g<0,g^2+a^2<0},
{g:>{Positive,Negative,Greater}}]
Out[392]= {Do something with g,g^2,True,2 g,True,Positive[19.62\[VeryThinSpace]-a],
a^2+g^2,96.2361\[VeryThinSpace]+a^2>0,g<0,a^2+g^2<0}
Since the above is a hack, I can not guarantee anything about it. It may be useful in some cases, but that must be decided on a case-by-case basis.
You may want to consider working with units rather than just constants. There are a few options available in Mathematica
Units
Automatic Units
Designer units
There are quite a few technical issues and subtleties about working with units. I found the backgrounder at Designer Units very useful. There are also some interesting discussions on MathGroup. (e.g. here).

Mathematica: Overriding `Listable` property of `Plus`

I would like to define a symbol pt to hold a point (and eventually cache some data related to that point):
pt::"usage" = "pt[{x,y}] represents a point at {x,y}";
I would like to be able to use such pt objects as points in as many ways as possible, an particularly, I would like to be able to write
{a0,a1}+pt[{b0,b1}]
and have it return pt[{a0+b0,a1+b1}] rather than {a0+pt[{b0,b1}],a1+pt[{b0,b1}]}.
My original idea was to use:
pt /: Plus[pt[p0_], p1 : {_, _}] = pt[p0 + p1];
But this doesn't work (because Plus is Listable?). Is there a way to do this without unprotecting Plus?
Update:
As Leonid points out, this is not possible without globally or locally hacking Plus, since the Listable attribute is considered before any *values. This is actually described very precisely in the evaluation tutorial.
Mathematica's evaluator seems not flexible enough to do this easily. UpValues for pt indeed are applied before DownValues for Plus, but threading over lists due to Listability happens even before that. In this particular case, the following might work for you:
eval = Function[code,Block[{Plus = Plus, attr = DeleteCases[Attributes[Plus], Listable]},
SetAttributes[Plus, attr]; code], HoldAll]
To use it, wrap it around a piece of code where you want your rule for pt to apply, e.g.:
eval[{a0, a1} + pt[{b0, b1}]]
You can use $Pre as $Pre = eval to avoid typing eval every time, although generally I would not recommend this. Blocking Plus is a softer way of disabling some or all of its Attributes temporarily. The advantage w.r.t. clearing and setting attributes without Block is that you can not end up in a global state with Listable attribute permanently disabled, even if exception is thrown or the computation is Abort-ed.
Since Listable attribute directly affects evaluation rather than pattern-matching (the latter may of course be affected indirectly if some pattern has to match the result of Plus threaded over a list), this should be ok in most cases. In theory, it may still lead to some unwanted effects in some cases, particularly where pattern-matching is involved. But in practice, it might be good enough. A cleaner but more complex solution would be to create a custom evaluator tailored to your needs.
The following is a bit wasteful, but it works: The idea is to simply watch for cases where the Listable attribute of Plus has put the same pt into all elements of a list (i.e. a raw point) -- and then pull it back out. First, define a function for adding pt objects:
SetAttributes[ptPlus, {Orderless}]
ptPlus[pt[pa : {_, _}], pt[pb : {_, _}], r___] :=
ptPlus[pt[pa + pb], r];
ptPlus[p_pt] := p;
Then we make sure that any Plus which involves a pt is mapped to ptPlus (an associate the rule with pt).
Plus[h___, a_pt, t___] ^:= ptPlus[h, a, t];
The above rules means that: {x0,y0}+pt[{x1,y1}] will be expanded from {x0+pt[{x1,y1}],y0+pt[{x1,y1}]} to {ptPlus[x0,pt[{x1,y1}]],ptPlus[y0,pt[{x1,y1}]]}. Now we just make a rule to transform this to pt[{x0,y0}]+pt[{x1,y1}] (note the deferred condition which checks that the pts are equal):
{ptPlus[x__], ptPlus[y__]} ^:= Module[{
ptCases = Cases[{{x}, {y}}, _pt, {2}]},
ptCases[[1]] + pt[Plus ### DeleteCases[{{x}, {y}}, _pt, {2}]]
/; Equal ## ptCases]
A more opaque, but slightly more careful version which is easier to generalize to higher dimensions:
ptPlus /: p : {_ptPlus, _ptPlus} := Module[{ptCases, rest,
lp = ReleaseHold#Apply[List, Hold[p], {2}]},
ptCases = Cases[lp, _pt, {2}];
rest = Plus ### DeleteCases[lp, _pt, {2}];
ptCases[[1]] + pt[rest] /; And[Equal ## ptCases, VectorQ#rest]]
This whole approach will of course lead to horribly subtle bugs when {a+pt[{0,0}],a+pt[{0,b}]} /. {a -> pt[{0,0}]} evaluates to pt[{0,0}] when c==0 and {pt[{0,0}],pt[{0,c}]} otherwise...
HTH -- said the guy to himself...

Resources