I am using mathematica's Nsolve to solve a polynomial. When solved, Nsolve traditionally gives solutions like this:
{{x -> 1}, {x -> 2}, {x -> 3},{x -> 4}}
However, I need to transform this output into a list of numbers, so it looks like:
{1, 2, 3, 4}
How can I do this? There must be a simple way.
You have a list {{x -> 1}, {x -> 2}, {x -> 3},{x -> 4}} and you want to do the same thing to each item in that list, you want to replace the {x -> n} with n.
This is a very common thing to want to do in Mathematica. There is a function Map which accepts a function and a list and does that function to each item in the list. You can look up Map in the help pages and try to make sense of it.
Your list has Rule's in it. So what you have is {{Rule[x,1]}, {Rule[x,2]}, {Rule[x,3]},{Rule[x,4]}}, which Mathematica abbreviates into {x -> 1}, etc. You can look up Rule in the help system and try to make sense of it.
Let's look at one way of doing what you want
sol = {{x -> 1}, {x -> 2}, {x -> 3}, {x -> 4}};
f[r_] := ReplaceAll[x, r];
Map[f, sol]
That defines a function f which uses the ReplaceAll function with x and an individual Rule to replace all the x's in x, and there is only one, with the value from that rule. And then the Map does this over and over until it has processed all the items in your list. and the result is {1, 2, 3, 4} which is what you wanted.
Now the culture of Mathematica is that you try to abbreviate everything, you always try to use a handful of punctuation characters instead of using the name of a function. That can be pretty difficult for a new user to understand. Here is a different way a Mathematica user might write that instead.
x/.#&/#{{x -> 1}, {x -> 2}, {x -> 3}, {x -> 4}}
and that will give you the same result. You can look up /. and # and & and /# in the help system and try to make sense of those.
There are almost always a dozen different ways of accomplishing anything in Mathematica. at least several of which are almost completely incomprehensible. If you can, choose a way of doing things that you think you understand and can remember and use without making too many mistakes. But this routinely seems to become a contest to see who can accomplish something using a few less characters or who can make this run in a few less seconds.
just right the following command
sol = {{x -> 1}, {x -> 2}, {x -> 3},{x -> 4}}
x /. sol
the result will appear as intended
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]]
In Mathematica, calling Solve, returns a list of rules, e.g.,
In[1]:= g = Solve[(x - 1) (x - 2) == 0, x]
Out[1]= {{x -> 1}, {x -> 2}}
How can I extract the numerical values 1 or 2 from g?
I tried using Part e.g., g[[1]] but it returns {x -> 1} and not 1.
Please advise.
To complement Belisarius' answer,
x /. g
with g = {{x -> 1}, {x -> 2}}, returns the list
{1, 2}
So to extract the first value, 1, we could use
First[x /. g]
Other alternatives are
x /. g[[1]]
(x /. g)[[1]] (* this is equivalent to the version using First *)
g[[1,1,2]]
x /. g[[1]]
Filler -> Thirty chars minimum
Given pairs of coordinates
data = {{1, 0}, {2, 0}, {3, 1}, {4, 2}, {5, 1},
{6, 2}, {7, 3}, {8, 4}, {9, 3}, {10, 2}}
I'd like to extract peaks and valleys, thus:
{{4, 2}, {5, 1}, {8, 4}}
My current solution is this clumsiness:
Cases[
Partition[data, 3, 1],
{{ta_, a_}, {tb_, b_}, {tc_, c_}} /; Or[a < b > c, a > b < c] :> {tb, b}
]
which you can see starts out by tripling the size of the data set using Partition. I think it's possible to use Cases and PatternSequence to extract this information, but this attempt doesn't work:
Cases[
data,
({___, PatternSequence[{_, a_}, {t_, b_}, {_, c_}], ___}
/; Or[a < b > c, a > b < c]) :> {t, b}
]
That yields {}.
I don't think anything is wrong with the pattern because it works with ReplaceAll:
data /. ({___, PatternSequence[{_, a_}, {t_, b_}, {_, c_}], ___}
/; Or[a < b > c, a > b < c]) :> {t, b}
That gives the correct first peak, {4, 2}. What's going on here?
One of the reasons why your failed attempt doesn't work is that Cases by default looks for matches on level 1 of your expression. Since your looking for matches on level 0 you would need to do something like
Cases[
data,
{___, {_, a_}, {t_, b_}, {_, c_}, ___} /; Or[a < b > c, a > b < c] :> {t, b},
{0}
]
However, this only returns {4,2} as a solution so it's still not what you're looking for.
To find all matches without partitioning you could do something like
ReplaceList[data, ({___, {_, a_}, {t_, b_}, {_, c_}, ___} /;
Or[a < b > c, a > b < c]) :> {t, b}]
which returns
{{4, 2}, {5, 1}, {8, 4}}
Your "clumsy" solution is fairly fast, because it heavily restricts what gets looked at.
Here is an example.
m = 10^4;
n = 10^6;
ll = Transpose[{Range[n], RandomInteger[m, n]}];
In[266]:=
Timing[extrema =
Cases[Partition[ll, 3,
1], {{ta_, a_}, {tb_, b_}, {tc_, c_}} /;
Or[a < b > c, a > b < c] :> {tb, b}];][[1]]
Out[266]= 3.88
In[267]:= Length[extrema]
Out[267]= 666463
This seems to be faster than using replacement rules.
Faster still is to create a sign table of products of differences. Then pick entries not on the ends of the list that correspond to sign products of 1.
In[268]:= Timing[ordinates = ll[[All, 2]];
signs =
Table[Sign[(ordinates[[j + 1]] -
ordinates[[j]])*(ordinates[[j - 1]] - ordinates[[j]])], {j, 2,
Length[ll] - 1}];
extrema2 = Pick[ll[[2 ;; -2]], signs, 1];][[1]]
Out[268]= 0.23
In[269]:= extrema2 === extrema
Out[269]= True
Handling of consecutive equal ordinates is not considered in these methods. Doing that would take more work since one must consider neighborhoods larger than three consecutive elements. (My spell checker wants me to add a 'u' to the middle syllable of "neighborhoods". My spell checker must think we are in Canada.)
Daniel Lichtblau
Another alternative:
Part[#,Flatten[Position[Differences[Sign[Differences[#[[All, 2]]]]], 2|-2] + 1]] &#data
(* ==> {{4, 2}, {5, 1}, {8, 4}} *)
Extract[#, Position[Differences[Sign[Differences[#]]], {_, 2} | {_, -2}] + 1] &#data
(* ==> {{4, 2}, {5, 1}, {8, 4}} *)
This may be not exactly the implementation you ask, but along those lines:
ClearAll[localMaxPositions];
localMaxPositions[lst : {___?NumericQ}] :=
Part[#, All, 2] &#
ReplaceList[
MapIndexed[List, lst],
{___, {x_, _}, y : {t_, _} .., {z_, _}, ___} /; x < t && z < t :> y];
Example:
In[2]:= test = RandomInteger[{1,20},30]
Out[2]= {13,9,5,9,3,20,2,5,18,13,2,20,13,12,4,7,16,14,8,16,19,20,5,18,3,15,8,8,12,9}
In[3]:= localMaxPositions[test]
Out[3]= {{4},{6},{9},{12},{17},{22},{24},{26},{29}}
Once you have positions, you may extract the elements:
In[4]:= Extract[test,%]
Out[4]= {9,20,18,20,16,20,18,15,12}
Note that this will also work for plateau-s where you have more than one same maximal element in a row. To get minima, one needs to trivially change the code. I actually think that ReplaceList is a better choice than Cases here.
To use it with your data:
In[7]:= Extract[data,localMaxPositions[data[[All,2]]]]
Out[7]= {{4,2},{8,4}}
and the same for the minima. If you want to combine, the change in the above rule is also trivial.
Since one of your primary concerns about your "clumsy" method is the data expansion that takes place with Partition, you may care to know about the Developer` function PartitionMap, which does not partition all the data at once. I use Sequence[] to delete the elements that I don't want.
Developer`PartitionMap[
# /. {{{_, a_}, x : {_, b_}, {_, c_}} /; a < b > c || a > b < c :> x,
_ :> Sequence[]} &,
data, 3, 1
]
I have two arrays, say A={1, 2, 3} and B={2, 4, 8} (array item count and numbers may vary). How do I find a bijection between the arrays.
In this case, it would be f:A->B; f(x)=2^(x)
I don't think this problem has a general solution. You may try FindSequenceFunction, but it will not always find the solution. For the case at hand, you'd need a bit longer lists:
In[250]:= FindSequenceFunction[Transpose[{{1, 2, 3}, {2, 4, 8}}], n]
Out[250]= FindSequenceFunction[{{1, 2}, {2, 4}, {3, 8}}, n]
but
In[251]:= FindSequenceFunction[Transpose[{{1, 2, 3, 4}, {2, 4, 8, 16}}], n]
Out[251]= 2^n
You can also play with FindFit, if you have some guesses about the bijection:
In[252]:= FindFit[Transpose[{{1, 2, 3}, {2, 4, 8}}], p*q^x, {p, q}, x]
Out[252]= {p -> 1., q -> 2.}
As others have remarked, this problem is ill-defined.
Other possible functions that give the same results are (among probably infinite others): (8 x)/3 - x^2 + x^3/3, x + (37 x^2)/18 - (4 x^3)/3 + (5 x^4)/18, and (259 x^3)/54 - (31 x^4)/9 + (35 x^5)/54.
I found these solutions using:
n = 5; (* try various other values *)
A = {1, 2, 3} ; B = {2, 4, 8}
eqs = Table[
Sum[a[i] x[[1]]^i, {i, n}] == x[[2]], {x, {A, B}\[Transpose]}]
sol = Solve[eqs, Table[a[i], {i, n}], Reals]
Sum[a[i] x^i, {i, n}] /. sol
Sometimes not all of the a[i]'s are fully determined and you may come up with values of your own.
[tip: better not use variables starting with a capital letter in Mathematica so as not to get into conflict with reserved words]
Since you tag Mathematica, I'll use Mathematica functions as a reference.
If you are interested in an arbitrary fit of your data with a smooth function, you can use Interpolation. E.g.
a = {1, 2, 3}; b = {2, 4, 8};
f = Interpolation[Transpose[{a, b}]];
(* Graph the interpolation function *)
Show[Plot[f[x], {x, 1, 3}], Graphics[Point /# Transpose[{a, b}]],
PlotRange -> {{0, 4}, {0, 9}}, Frame -> Automatic, Axes -> None]
Interpolation uses piecewise polynomials. You can do the same in your favorite programming language if you happen know or are willing to learn a bit about numerical methods, especially B-Splines.
If instead you know something about your data, e.g. that it is of the form c d^x, then you can do a minimization to find the unknowns (c and d in this case). If your data is in fact generated from the form c d^x, then the fit will be fairly, otherwise it's the error is minimized in the least-squares sense. So for your data:
FindFit[Transpose[{a, b}], c d^x, {c, d}, {x}]
reports:
{c -> 1., d -> 2.}
Indicating that your function is 2^x, just as you knew all along.