Need Mathematica short code like these same from Maple - matrix

I have one problem with exportation results from Mathematica. Two matrices A and B have to be exported in special form.
These two codes make a list of data exported from Maple.
It is important that exported file opened with wordpad looks like column (File attached).
Please, just if you already checked that it is working, write me answer, thank you! You can check your answer comparing with files down.
Codes are here
Matrices A and B with code in Maple and exported file
http://www.2shared.com/file/49wW8Z0-/EXAMPLE_EXPORT_MAPLE_FINAL.html
And also I will present it here to everybody can see easy
Code 1)
A := Matrix(2, 2, {(1, 1) = (455200000000/6133413)*w(1), (1, 2) = -(1792000000000/116534847)*w(1), (2, 1) = (455200000000/6133413)*w(2), (2, 2) = -(1792000000000/116534847)*w(2)})
precision := double: writeto(`Aexport.for`):
for i from 1 to 2 do:for j from 1 to 2 do:
if A[i,j]<>0 then codegen[fortran]([A00[i,j]=A[i,j]],optimized):
fi:od:od:writeto(terminal):
Code 2)
B := Matrix(2, 2, {(1, 1) = 6436781.609, (1, 2) = 0, (2, 1) = 0, (2, 2) = 3862068.966})
writeto(Bexport);
for i to 2 do
for j to 2 do
printf("%016.15E\n", B[i, j])
end do:
end do:
writeto(terminal)

This is a translation of the (B) part only:
matrix = {{6436781.609, 0}, {0, 3862068.966}}
Export["Bexport", Map[FortranForm, N#Flatten[matrix]], "Table"]
Please test it and let me know if it works for you.
Differences compared to the Maple version: the E is written as lowercase and the number of digits that are output is not fixed (but, as you can see, all significant digits are preserved). Will these differences cause problems in your application?

I believe this does what you want for matrix B:
b = {{6436781.609, 0}, {0, 3862068.966}}
bformatted =
NumberForm[
Flatten#b,
{16, 15},
NumberFormat -> (Row[{#, "E+", StringTake["00" <> #3, -2]}] &)
];
bstring =
StringReplace[
ToString#bformatted,
{"{"|"}"|" " -> "", "," -> "\n"}
];
WriteString["Bexport.dat", bstring, "\n"]
Close["Bexport.dat"]

Related

Making a matrix in a for loop

I am currently working with mathematica and I got stuck on some technicalities.
Rvec[R_] := UnitVector[Length[R], RandomInteger[{1, Length[R]}]]
Fvec[R_] := R - Rvec[R] + Rvec[R]
vec[R_] := Module[{S = Fvec[R]}, If[Count[S, -1] > 0, R, S]]
Loop[R_, n_] := For[i = 1; L = R, i < n + 1, i++, L = vec[L]; Print[L]]
The idea is that I now have a loop going that will randomly subtract one number from one entry in a set and add it to another in the next iteration, but with the catch that no entry can drop below zero. The output I then get is a set of outcomes put beneath each other.
Having done that I would like to know how I could put the entire output in the form of one matrix:
https://i.gyazo.com/a4ef70ba5670fd53003e0ac5ec1e434e.png
Instead of having the output like that, I would like to have it in matrix form, as in having this set of outputs placed in a larger set containing those sets as elements. This would greatly help me, as I would be able to manipulate and work with the entire output.
If you need to make matrix by consequently adding vector by vector, you can do like this:
vector = {1, 2, 3, 4, 5};
matrix = {}; (* Initialize matrix *)
Do[matrix = Append[matrix, vector], 5]; (* Construct matrix by adding line by line*)
MatrixForm[matrix] (* Print matrix *)
Please tell me If I didn't understanf youy problem properly.

Interpolation on shell script bash

I have a data file containing values of longitudes and latitudes (displayed on two columns) measured by a GPS along a profile at regular intervals. at a certain point on my profile, the GPS stopped working, hence in my data i have zeros instead of values of longitudes and latitudes. I want to interpolate between this fields to get values of longitudes and latitudes instead of zeros.
to be more clear here is a simple example of how my file looks like.
[12 7] ;
[14 8 ];
[0 0];
[0 0];
[20 11];
[22 12]
NB: the number are on two columns, it's the editor's problem
i want to interpolate where i got zeros. i am working on bash and i have no idea on how to do it
You might have luck with a linear regression done once for the first column and once for the second column.
Assume we're working on the first column. The input / x axis is the index of the measurement, and the output / y axis is the measurement itself. So your data can become ((1, 12), (2, 14), (3, 0), (4, 0), (5, 20), (6, 22)). Based on the known input-output relationships, for indices (1, 2, 5, 6), you need to deduce a formula of the form y = ax + b. So you basically need to find a and b. Once you have those you can find the y for input 3 as 3a + b and the y for input 4 as 4a + b.
You'll find a different a and b for the second column.
How to find a and b is a little bit complicated. You can look at this article for a nice introduction as well as the formulas for computing a and b (named b0 and b1 inside).
One last thing - I would not attempt doing such a thing in Bash. While it is possible, as Bash has support for arrays and math, it is not what it was designed for. Call out to Matlab/Octave or R, and use their results. Those tools have builtin support for reading files such as yours as well as for doing the regression.
You can do that with awk, here is a script:
script.awk
BEGIN { FS="[ [\\];]+"
# decide on the number of floating digits for the interpolated figures
FMTStr= "[%.1f, %.1f];\n"
}
{ if( ($2== 0) && ( $3 == 0) ) { zeroLines++ }
else {
for( i = 1; i <= zeroLines; i++ ) {
t1 = prev1 + (($2 - prev1) / (zeroLines + 1 )) * i
t2 = prev2 + (($3 - prev2) / (zeroLines + 1 ) ) * i
printf(FMTStr, t1, t2)
}
# either printf(FMTStr, $2, $3) #or
print $0
prev1 = $2
prev2 = $3
zeroLines = 0
}
}
Use it so: awk -f script.awk yourfile, it gives you
[12 7] ;
[14 8 ];
[16.0, 9.0];
[18.0, 10.0];
[20 11];
[22 12];

Mathematica, define multiple functions using for loop

I am using usual for-loop for computation in Mathematica:
For[i=1,i<n+1,i++, ...calculation... ]
For each i I need to define a function F_i[x_,y_]:=.... Here "i" is suuposed to be a label of the function. This is however not the corrcet Mathematica expression.
The question is, how to define multiple functions distinguished by the label i? I mean, what is the correct syntax?
Thanks a lot.
I'm not exactly sure what you are trying to do, but I have some confidence that the for loop is not the way to go in Mathematica. Mathematica already has pattern matching that likely eliminates the need for the loop.
What about something like this
f[i_][x_,y_]:= i(x+y)
or something like this
f[s_String][x_,y_]:=StringLength[s](x+y)
or even
f[s_,x_,y_]:=StringLength[s](x+y)
Here are some steps which may help. There are two versions below, the second one includes the value of i on the RHS of the function definition.
n = 2;
For[i = 1, i < n + 1, i++,
f[i][x_, y_] := (x + y)*i]
?f
Global`f
f[1][x_,y_] := (x+y) i
f[2][x_,y_] := (x+y) i
Clear[i]
f[2][2, 3]
5 i
Quit[]
n = 2;
For[i = 1, i < n + 1, i++,
With[{j = i},
f[i][x_, y_] := (x + y)*j]]
?f
Global`f
f[1][x$,y$] := (x$+y$) 1
f[2][x$,y$] := (x$+y$) 2
Clear[i]
f[2][2, 3]
10

How to test if a list contains consecutive integers in Mathematica?

I want to test if a list contains consecutive integers.
consQ[a_] := Module[
{ret = True},
Do[If[i > 1 && a[[i]] != a[[i - 1]] + 1, ret = False; Break[]], {i,
1, Length[a]}]; ret]
Although the function consQ does the job, I wonder if there is a better ( shorter, faster ) method of doing this, preferably using functional programming style.
EDIT:
The function above maps lists with consecutive integers in decreasing sequence to False. I would like to change this to True.
Szablics' solution is probably what I'd do, but here's an alternative:
consQ[a : {___Integer}] := Most[a] + 1 === Rest[a]
consQ[_] := False
Note that these approaches differ in how they handle the empty list.
You could use
consQ[a_List ? (VectorQ[#, IntegerQ]&)] := Union#Differences[a] === {1}
consQ[_] = False
You may want to remove the test for integers if you know that every list you pass to it will only have integers.
EDIT: A little extra: if you use a very old version that doesn't have Differences, or wonder how to implement it,
differences[a_List] := Rest[a] - Most[a]
EDIT 2: The requested change:
consQ[a : {Integer___}] := MatchQ[Union#Differences[a], {1} | {-1} | {}]
consQ[_] = False
This works with both increasing and decreasing sequences, and gives True for a list of size 1 or 0 as well.
More generally, you can test if the list of numbers are equally spaced with something like equallySpacedQ[a_List] := Length#Union#Differences[a] == 1
I think the following is also fast, and comparing reversed lists does not take longer:
a = Range[10^7];
f[a_] := Range[Sequence ## ##, Sign[-#[[1]] + #[[2]]]] &#{a[[1]], a[[-1]]} == a;
Timing[f[a]]
b = Reverse#a;
Timing[f[b]]
Edit
A short test for the fastests solutions so far:
a = Range[2 10^7];
Timing#consQSzab#a
Timing#consQBret#a
Timing#consQBeli#a
(*
{6.5,True}
{0.703,True}
{0.203,True}
*)
I like the solutions by the other two, but I'd be concerned about very long lists. Consider the data
d:dat[n_Integer?Positive]:= d = {1}~Join~Range[1, n]
which has its non-sequential point at the very beginning. Setting consQ1 for Brett's and consQ2 for Szabolcs, I get
AbsoluteTiming[ #[dat[ 10000 ] ]& /# {consQ1, consQ2}
{ {0.000110, False}, {0.001091, False} }
Or, roughly a ten times difference between the two, which stays relatively consistent with multiple trials. This time can be cut in roughly half by short-circuiting the process using NestWhile:
Clear[consQ3]
consQ3[a : {__Integer}] :=
Module[{l = Length[a], i = 1},
NestWhile[# + 1 &, i,
(#2 <= l) && a[[#1]] + 1 == a[[#2]] &,
2] > l
]
which tests each pair and only continues if they return true. The timings
AbsoluteTiming[consQ3[dat[ 10000 ]]]
{0.000059, False}
with
{0.000076, False}
for consQ. So, Brett's answer is fairly close, but occasionally, it will take twice as long.
Edit: I moved the graphs of the timing data to a Community Wiki answer.
Fold can be used in a fairly concise expression that runs very quickly:
consQFold[a_] := (Fold[If[#2 == #1 + 1, #2, Return[False]] &, a[[1]]-1, a]; True)
Pattern-matching can be used to provide a very clear expression of intent at the cost of substantially slower performance:
consQMatch[{___, i_, j_, ___}] /; j - i != 1 := False
consQMatch[_] = True;
Edit
consQFold, as written, works in Mathematica v8.0.4 but not in earlier versions of v8 or v7. To correct this problem, there are a couple of alternatives. The first is to explicitly name the Return point:
consQFold[a_] :=
(Fold[If[#2==#1+1, #2, Return[False,CompoundExpression]] &, a[[1]]-1, a]; True)
The second, as suggested by #Mr.Wizard, is to replace Return with Throw / Catch:
consQFold[a_] :=
Catch[Fold[If[#2 == #1 + 1, #2, Throw[False]]&, a[[1]]-1, a]; True]
Since the timing seems to be rather important. I've moved the comparisons between the various methods to this, Community Wiki, answer.
The data used are simply lists of consecutive integers, with a single non-consecutive point, and they're generated via
d : dat[n_Integer?Positive] := (d = {1}~Join~Range[1, n])
d : dat[n_Integer?Positive, p_Integer?Positive] /; p <= n :=
Range[1, p]~Join~{p}~Join~Range[p + 1, n]
where the first form of dat[n] is equivalent to dat[n, 1]. The timing code is simple:
Clear[consQTiming]
Options[consQTiming] = {
NonConsecutivePoints -> {10, 25, 50, 100, 250,500, 1000}};
consQTiming[fcns__, OptionPattern[]]:=
With[{rnd = RandomInteger[{1, #}, 100]},
With[{fcn = #},
Timing[ fcn[dat[10000, #]] & /# rnd ][[1]]/100
] & /# {fcns}
] & /# OptionValue[NonConsecutivePoints]
It generates 100 random integers between 1 and each of {10, 25, 50, 100, 250, 500, 1000} and dat then uses each of those random numbers as the non-consecutive point in a list 10,000 elements long. Each consQ implementation is then applied to each list produced by dat, and the results are averaged. The plotting function is simply
Clear[PlotConsQTimings]
Options[PlotConsQTimings] = {
NonConsecutivePoints -> {10, 25, 50, 100, 250, 500, 1000}};
PlotConsQTimings[timings : { _?VectorQ ..}, OptionPattern[]] :=
ListLogLogPlot[
Thread[{OptionValue[NonConsecutivePoints], #}] & /# Transpose[timings],
Frame -> True, Joined -> True, PlotMarkers -> Automatic
]
I timed the following functions consQSzabolcs1, consQSzabolcs2, consQBrett, consQRCollyer, consQBelisarius, consQWRFold, consQWRFold2, consQWRFold3, consQWRMatch, and MrWizard's version of consQBelisarius.
In ascending order of the left most timing: consQBelisarius, consQWizard, consQRCollyer, consQBrett, consQSzabolcs1, consQWRMatch, consQSzabolcs2, consQWRFold2, consQWRFold3,and consQWRFold.
Edit: Reran all of the functions with timeAvg (the second one) instead of Timing in consQTiming. I did still average over 100 runs, though. For the most part, there was any change, except for the lowest two where there is some variation from run to run. So, take those two lines with a grain of salt as they're timings are practically identical.
I am now convinced that belisarius is trying to get my goat by writing intentionally convoluted code. :-p
I would write: f = Range[##, Sign[#2 - #]]& ## #[[{1, -1}]] == # &
Also, I believe that WReach probably intended to write something like:
consQFold[a_] :=
Catch[
Fold[If[#2 === # + 1, #2, Throw#False] &, a[[1]] - 1, a];
True
]

how to put the results in a table or array in mathematica?

Hi
I have a list of numbers for example k_1,k_2,...k_n, and f is a function.
Now I apply f on the list of numbers and I need those numbers such that f is increasing,i.e.
f(k_i)>f(k_j) for any i>j .
I can get the results number k_i's each in different line, but I need the results in one table separated with comma or something else and counting the number of results.
For example:
k = Table[k1, k2, k3, k4, k5, k6, k7, k8, k9, k10];
count = 0;
i=1;
For[j = i, j <= 10, j++,
If[f[k[[j]]] - f[k[[i]]] > 0, i = j; Print["k", i];
count = count + 1]];
Print["count= ", count]
I got the result like:
k2
k3
k5
k9
count=4
but I need the results to be together:
{k2,k3,k5,k9}
count=4
any idea?
thanks
Instead of Print, you could do AppendTo, ie
list={};AppendTo[list,5]
It might be good to start learning functional programming approach as Mathematica has tools to make it efficient, your above code might look something like this
pairs = Partition[list, 2, 1];
increasingPairs = Select[pairs, f[First[#]] < f[Last[#]] &];
Last /# increasingPairs
You seem to want the longest increasing subsequence. The simplest and most efficient way I am aware of to get it in Mathematica is the following:
lis[f_, vals_List] := LongestCommonSequence[#, Sort[#]] &[Map[f, vals]];
Example:
In[8]:= lis[# &, {5, 3, 6, 1, 5, 7}]
Out[8]= {5, 6, 7}
In principle, the answer is not unique - there may be several different longest increasing subsequences with the same length.

Resources