Evaluating functions at several points - wolfram-mathematica

I want to evaluate f[x,y]=-4 x + x^2 - 4 y - y^2 at points (1,-2); (2,-3); (3,-2); (2,-1).
I tried using Outer but for some reason it does not give me actual values. Help.

Remember that Mathematica has a specific way of defining functions. In your case it would be f[x_,y_]:=-4 x + x^2 - 4 y - y^2. Then you could simply use f[1,-2] etc.

Perhaps consider using a 'pure' function. For example:
-4 #1 + #1^2 - 4*#2 - #2^2 & ### {{1, -2}, {2, -3}, {3, -2}, {2, -1}}
gives
{1, -1, 1, -1}

Here are some variations on the theme:
Clear[f]
f[{x_, y_}] := -4 x + x^2 - 4 y - y^2
points = {{1, -2}, {2, -3}, {3, -2}, {2, -1}};
Map[f, points]
{1, -1, 1, -1}
f[x_, y_] := -4 x + x^2 - 4 y - y^2
f[1, -2]
1
f = Function[{x, y}, -4 x + x^2 - 4 y - y^2];
f[1, -2]
1

You can use functions like Apply and Map to evaluate a function in a list of points, for example
f[x_, y_] := -4 x + x^2 - 4 y - y^2
pts = {{1, -2}, {2, -3}, {3, -2}, {2, -1}};
Apply[f, pts, {1}]
(* out: {1, -1, 1, -1} *)
or using ### as a short hand for Apply[ ...., {1}]
f ### pts

Related

Mathematica: how to apply more than one rule at once

I have a list of points where each point is a list of its 3 coordinates: x,y and z.
But some of those points in their coordinates x and y are "bad" and I'd like to clean them. Is it possibile to write a single rule to do that? I've tried with:
cleanAdjustedPoints[adjustedPoints_List] := adjustedPoints /. {x_, y_, z_} /; x < 0 -> {0, y, z}; /; y > constB -> {x, constB, z};
and I've seen that only the first rule is applied to the points with bad x, while the ones with bad y do not change. Mathematica does not give a sintax error so I thought that it was right.
Any suggestions? thanks.
You just need to put the rules in a list. Also, note use of RuleDelayed (:>) which localises the variables x, y & z ensuring they don't pick up values from elsewhere in your program.
cleanAdjustedPoints[adjustedPoints_List] :=
adjustedPoints /. {{x_, y_, z_} /; x < 0 :> {0, y, z},
{x_, y_, z_} /; y > constB :> {x, constB, z}};
constB = 5;
cleanAdjustedPoints[{{-1, 2, 3}, {4, 5, 6}, {7, 8, 9}}]
{{0, 2, 3}, {4, 5, 6}, {7, 5, 9}}

Working with implicit functions in Mathematica

Can I plot and deal with implicit functions in Mathematica?
for example :-
x^3 + y^3 = 6xy
Can I plot a function like this?
ContourPlot[x^3 + y^3 == 6*x*y, {x, -2.7, 5.7}, {y, -7.5, 5}]
Two comments:
Note the double equals sign and the multiplication symbols.
You can find this exact input via the WolframAlpha interface. This interface is more forgiving and accepts your input almost exactly - although, I did need to specify that I wanted some type of plot.
Yes, using ContourPlot.
And it's even possible to plot the text x^3 + y^3 = 6xy along its own curve, by replacing the Line primitive with several Text primitives:
ContourPlot[x^3 + y^3 == 6 x y, {x, -4, 4}, {y, -4, 4},
Background -> Black, PlotPoints -> 7, MaxRecursion -> 1, ImageSize -> 500] /.
{
Line[s_] :>
Map[
Text[Style["x^3+y^3 = 6xy", 16, Hue[RandomReal[]]], #, {0, 0}, {1, 1}] &,
s]
}
Or you can animate the equation along the curve, like so:
res = Table[ Normal[
ContourPlot[x^3 + y^3 == 6 x y, {x, -4, 4}, {y, -4, 4},
Background -> Black,
ImageSize -> 600]] /.
{Line[s_] :> {Line[s],
Text[Style["x^3+y^3 = 6xy", 16, Red], s[[k]], {0, 0},
s[[k + 1]] - s[[k]]]}},
{k, 1, 448, 3}];
ListAnimate[res]
I'm guessing this is what you need:
http://reference.wolfram.com/mathematica/Compatibility/tutorial/Graphics/ImplicitPlot.html
ContourPlot[x^3 + y^3 == 6 x*y, {x, -10, 10}, {y, -10, 10}]

how to extract rows from matrix based on value in first entry?

This is another simple 'matrix' question in Mathematica. I want to show how I did this, and ask if there is a better answer.
I want to select all 'rows' from matrix based on value in the first column (or any column, I used first column here just as an example).
Say, find all rows where the entry in the first position is <=4 in this example:
list = {{1, 2, 3},
{4, 5, 8},
{7 , 8, 9}}
So, the result should be
{{1,2,3},
{4,5,8}}
Well, the problem is I need to use Position, since the result returned by Position can be used directly by Extract. (but can't be used by Part or [[ ]], so that is why I am just looking at Position[] ).
But I do not know how to tell Position to please restrict the 'search' pattern to only the 'first' column so I can do this in one line.
When I type
pos = Position[list, _?(# <= 4 &)]
it returns position of ALL entries which are <=4.
{{1, 1}, {1, 2}, {1, 3}, {2, 1}}
If I first get the first column, then apply Position on it, it works ofcourse
list = {{1, 2, 3},
{4, 5, 8},
{7 , 8, 9}};
pos = Position[list[[All, 1]], _?(# <= 4 &)]
Extract[list, pos]
--> {{1, 2, 3}, {4, 5, 8}}
Also I tried this:
pos = Position[list, _?(# <= 4 &)];
pos = Select[pos, #[[2]] == 1 &] (*only look at ones in the 'first' column*)
{{1, 1}, {2, 1}}--->
and this gives me the correct positions in the first column. To use that to find all rows, I did
pos = pos[[All, 1]] (* to get list of row positions*)
---> {1, 2}
list[[ pos[[1]] ;; pos[[-1]], All]]
{{1, 2, 3},
{4, 5, 8}}
So, to summarize, putting it all together, this is what I did:
method 1
list = {{1, 2, 3},
{4, 5, 8},
{7 , 8, 9}};
pos = Position[list[[All, 1]], _?(# <= 4 &)]
Extract[list, pos]
--> {{1, 2, 3}, {4, 5, 8}}
method 2
list = {{1, 2, 3},
{4, 5, 8},
{7 , 8, 9}}
pos = Position[list, _?(# <= 4 &)];
pos = Select[pos, #[[2]] == 1 &];
pos = pos[[All, 1]];
list[[ pos[[1]] ;; pos[[-1]], All]]
{{1, 2, 3},
{4, 5, 8}}
The above clearly is not too good.
Is method 1 above the 'correct' functional way to do this?
For reference, this is how I do the above in Matlab:
EDU>> A=[1 2 3;4 5 8;7 8 9]
A =
1 2 3
4 5 8
7 8 9
EDU>> A( A(:,1)<=4 , :)
1 2 3
4 5 8
I am trying to improve my 'functional' handling of working with matrices in Mathematica commands, this is an area I feel I am not good at working with lists. I find working with matrices easier for me.
The question is: Is there is a shorter/more functional way to do this in Mathematica?
thanks
You could use Pick[] as follows:
Pick[list, list[[All, 1]], _?(# <= 4 &)]
How about the following?
In[1]:= list = {{1, 2, 3}, {4, 5, 8}, {7, 8, 9}};
In[2]:= Select[list, First[#] <= 4 &]
Out[2]= {{1, 2, 3}, {4, 5, 8}}
Here's a loose translation of your matlab code:
list[[Flatten[Position[Thread[list[[All, 1]] <= 4], True]]]]
(of course, the Flatten would not be needed if I used Extract instead of Part).
There is a faster method than those already presented, using SparseArray. It is:
list ~Extract~
SparseArray[UnitStep[4 - list[[All, 1]]]]["NonzeroPositions"]
Here are speed comparisons with the other methods. I had to modify WReach's method to handle other position specifications.
f1[list_, x_] := Cases[list, {Sequence ## Table[_, {x - 1}], n_, ___} /; n <= 4]
f2[list_, x_] := Select[list, #[[x]] <= 4 &]
f3[list_, x_] := Pick[list, (#[[x]] <= 4 &) /# list]
f4[list_, x_] := Pick[list, UnitStep[4 - list[[All, x]]], 1]
f5[list_, x_] := Pick[list, Thread[list[[All, x]] <= 4]]
f6[list_, x_] := list ~Extract~
SparseArray[UnitStep[4 - list[[All, x]]]]["NonzeroPositions"]
For a table with few rows and many columns (comparing position 7):
a = RandomInteger[99, {250, 150000}];
timeAvg[#[a, 7]] & /# {f1, f2, f3, f4, f5, f6} // Column
0.02248
0.0262
0.312
0.312
0.2808
0.0009728
For a table with few columns and many rows (comparing position 7):
a = RandomInteger[99, {150000, 12}];
timeAvg[#[a, 7]] & /# {f1, f2, f3, f4, f5, f6} // Column
0.0968
0.1434
0.184
0.0474
0.103
0.002872
If you want the rows that meet the criteria, use Cases:
Cases[list, {n_, __} /; n <= 4]
(* {{1, 2, 3}, {4, 5, 8}} *)
If you want the positions within the list rather than the rows themselves, use Position instead of Cases (restricted to the first level only):
Position[list, {n_, __} /; n <= 4, {1}]
(* {{1}, {2}} *)
If you want to be very clever:
Pick[list, UnitStep[4 - list[[All, 1]]], 1]
This also avoids unpacking, which means it'll be faster and use less memory.

Using Boole with MaxValue and or PlotRegion

Why doesn't this work?
I have bypassed this before but i can't remember how i did it, and I never went on to figure out why this type of inputs didn't work. About time to get to know it!
For those who cant see the pic:
RegionPlot3D[
x^2 + 2 y^2 - 2 z^2 = 1 && -1 <= z <= 1, {x, -5, 5}, {y, -5,
5}, {z, -1, 1}]
Set::write: "Tag Plus in -2.+25.+50. is Protected"
And then there is just an empty cube without my surface.
If z is limited by other surfaces you could go like this:
RegionPlot3D[
x^2 + 2 y^2 - 2 z^2 < 1 && z < x + 2 y && z^2 < .5,
{x, -2, 2}, {y, -2, 2}, {z, -1, 1},
PlotPoints -> 50, MeshFunctions -> {Function[{x, y, z}, z]},
PlotStyle -> Directive[Red, Opacity[0.8]]]
Or with ContourPlot:
ContourPlot3D[
x^2 + 2 y^2 - 2 z^2 == 1,
{x, -2, 2}, {y, -2, 2}, {z, -1, 1},
RegionFunction -> Function[{x, y, z}, z < x + 2 y && z^2 < .5],
PlotPoints -> 50, MeshFunctions -> {Function[{x, y, z}, z]},
ContourStyle -> Directive[Red, Opacity[0.8]]]]
Try this
RegionPlot3D[x^2 + 2 y^2 - 2 z^2 < 1,
{x, -5, 5}, {y, -5, 5}, {z, -1, 1}]
Or, if you just want the surface
ContourPlot3D[x^2 + 2 y^2 - 2 z^2 == 1,
{x, -5, 5}, {y, -5, 5}, {z, -1, 1}]
Note the double equals sign, rather than the single equals sign.

Mathematica Interpolation[] that remains constant when outside range

I want to "modify" Mathematica's Interpolation[] function (in 1
dimension) by replacing extrapolation with constant values when the
input is out of range.
In other words, if the interpolation domain is [1,20] and f[1]==7 and
f[20]==12, I want:
f[x] = 7 for x<=1
f[x] = 12 for x>=20
f[x] = Interpolation[...]
However, this fails:
(* interpolation w cutoff *)
interpcut[r_] := Module[{s, minpair, maxpair},
(* sort array by x coord *)
s = Sort[r, #1[[1]] < #2[[1]] &];
(* find min x value and corresponding y value *)
minpair = s[[1]];
(* ditto for max x value *)
maxpair = s[[-1]];
(* return the pure function representing cutoff interpolation *)
Piecewise[{
{minpair[[2]] &, #1 < minpair[[1]] &},
{maxpair[[2]] &, #1 > maxpair[[1]] &},
{Interpolation[r], True}
}]]
test = Table[{x,Prime[x]},{x,1,10}]
InputForm[interpcut[test]]
Piecewise[{{minpair$59[[2]] & , #1 < minpair$59[[1]] & },
{maxpair$59[[2]] & , #1 > maxpair$59[[1]] & }},
InterpolatingFunction[{{1, 10}}, {3, 1, 0, {10}, {4}, 0, 0, 0, 0},
{{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}}, {{2}, {3}, {5}, {7}, {11}, {13}, {17},
{19}, {23}, {29}}, {Automatic}]]
I'm sure I'm missing something basic. What?
Function definition
interpcut[r_, x_] :=
Module[{s},(*sort array by x coord*)
s = SortBy[r, First];
Piecewise[
{{First[s][[2]], x < First[s][[1]]},
{Last [s][[2]], x > Last [s][[1]]},
{Interpolation[r][x], True}}]];
Test
test = Table[{x, Prime[x]}, {x, 1, 10}];
f[x_] := interpcut[test, x]
Plot[f[x], {x, -10, 30}]
Edit
Answering your comment about pure functions.
I did it that way just for clarity, not for cheating. For using pure functions just "follow the recipe":
interpcut[r_] := Module[{s},
s = SortBy[r, First];
Function[Piecewise[
{{First[s][[2]], # < First[s][[1]]},
{Last [s][[2]], # > Last [s][[1]]},
{Interpolation[r][#], True}}]]
]
test = Table[{x, Prime[x]}, {x, 1, 10}];
f = interpcut[test] // InputForm
Plot[interpcut[test][x], {x, -10, 30}]
Let me add an update to this old thread. Since V9 you can use native (but still experimental) "ExtrapolationHandler" parameter
test = Table[{x, Prime[x]}, {x, 1, 10}];
g = Interpolation[test, "ExtrapolationHandler" ->
{If[# <= test[[1, 1]], test[[1, 2]], test[[-1, 2]]] &,
"WarningMessage" -> False}];
Plot[g[x], {x, -10, 30}]
Here's a possible alternative to belisarius's answer:
interpcut[r_] := Module[{s}, s = SortBy[r, First];
Composition[Interpolation[r], Clip[#, Map[First, Through[{First, Last}[s]]]] &]]

Resources