1
$\begingroup$

I have a code which goes like this:

ClearAll["Global`*"]
tbl = Table[{x, N[x^0.6], N[Sqrt[x]], N[x^0.2], N[x^(1/3)]}, {x, 0, 2,
     0.01}];
const1 = 20;
const2 = 15;
modifiedr[v_, k_] := (k - v) const1/const2 ;
newrow[{k_, r1_, r2_, r3_, r4_}] := {k, r1, modifiedr[r1, k], r2, 
   modifiedr[r2, k], r3, modifiedr[r3, k], r4, modifiedr[r4, k]};
newtbl = Map[newrow, tbl];
headings = 
  Flatten[{"k", 
    Table[str = ToString[i]; {"r" <> str, "modified_r" <> str}, {i, 1,
       4}]}];
SetDirectory[NotebookDirectory[]];
Export["file" <> ToString[const1] <> ".dat", 
  Join[{headings}, newtbl]];

Here comes the first question:

  1. You can see that there is line in the code {k,r1,modifiedr[r1,k],r2,modifiedr[r2,k],r3,modifiedr[r3,k],r4,modifiedr[r4,k]}.This is okay when you have only 4 r’s (r1,r2,r3,r4). But when you have large no. of r’s, say till 20 (r1,r2,r3, …, r20), this can become tedious. Is there any way to automate this procedure just like what I have written in “headings”?

Now, I want to plot some graphs with x axis as first column in “newtbl” and second, fourth, sixth and eight columns in “newtbl” as y axis. For this one, I first extracted data into xaxis,yaxis1,yaxis2,yaxis3,yaxis4. For this, I wrote the following code:

rowlength = Length[newtbl];
xaxis = Table[newtbl[[i, 1]], {i, 1, rowlength}];
yaxis1 = Table[newtbl[[i, 2]], {i, 1, rowlength}];
yaxis2 = Table[newtbl[[i, 4]], {i, 1, rowlength}];
yaxis3 = Table[newtbl[[i, 6]], {i, 1, rowlength}];
yaxis4 = Table[newtbl[[i, 8]], {i, 1, rowlength}];
ListLinePlot[
 Transpose[{xaxis, #}] & /@ {yaxis1, yaxis2, yaxis3, yaxis4}, 
 AxesStyle -> Directive[GrayLevel[0], AbsoluteThickness[1.6]], 
 PlotLabel -> None, LabelStyle -> {16, GrayLevel[0]}, 
 AxesLabel -> {"k\[Rho]", "\[Omega]"}]

I get desired plot as shown;

Correct Expected Figure

Second question comes here:

  1. Extracting and writing xaxis,yaxis1 etc. becomes tedious if I have large no. of r’s. Is there a way of getting around this issue? I modified the code according to what was written here, i.e. ListLinePlot[Transpose[Table[Map[{newtbl[[i, 1]], #} &, Rest[newtbl[[i]]]], {i, Length[newtbl]}]]] and ListLinePlot[Thread[Thread@{#, {##2}} & @@@ newtbl]]. But while doing in both ways I am getting a plot, which is showing extra set of lines:

Wrong figure

What am I doing wrong here and first of all, what does indeed the above code means?

Third question is this:

  1. Now, I want to plot the with certain condition imposed. e.g.:

    a. plot r1 when modified_r1 has a value between 0.2 to 0.4

    b. plot r2 when modified_r2 has a value between 0.23 to 0.33

    c. plot r3 when modified_r3 has a value between 0.34 to 0.45

    d. plot r4 when modified_r4 has a value between 0.54 to 0.63

    How can I do this?

Thanks in advance…

$\endgroup$
2
$\begingroup$

For (1) you can define newrow to take a list of arbitrary length as input:

ClearAll[newrow2]
newrow2[x_List] := Flatten@MapAt[{#, (x[[1]] - #) const1/const2} &, x, {2 ;;}]

newrow2[Array[y, 5]]

{y[1], y[2], 4/3 (y[1] - y[2]), y[3], 4/3 (y[1] - y[3]), y[4], 4/3 (y[1] - y[4]), y[5], 4/3 (y[1] - y[5])}

This is the same as the output from your newrow:

newrow2[Array[y, 5]] == newrow[Array[y, 5]]

True

Alternatively,

ClearAll[newrow3]
newrow3[x_List] :=  Module[{xx = x}, 
  xx[[2 ;;]] = Transpose[{xx[[2 ;;]], (const1/const2) (xx[[1]] - xx[[ 2 ;;]])}]; 
  Flatten@xx]

newrow3[Array[y, 5]] == newrow[Array[y, 5]]

True

A better approach is to process the input table tbl in one step:

ClearAll[makeNewTbl]
makeNewTbl[t_] := Riffle[##, {3, -1, 2}] & @@@ 
    Transpose[{t, (const1/const2) (t[[All, 1]] - t[[ All, 2 ;;]])}] &;

This produces the OP's newtbl:

makeNewTbl[tbl] == newtbl

True

| improve this answer | |
$\endgroup$
  • $\begingroup$ Many thanks for providing various suggestion. But, could you please explain a bit, atleast first method? I am seeing those stuffs (especially MapAt , #) for the first time! $\endgroup$ – sreeraj t Feb 4 at 0:54
  • 2
    $\begingroup$ @sreerajt, MapAt[foo, lst, {pos_1, pos_2, ..., pos_k}] replaces the element lst[[pos_i]] with foo[lst[[pos_i]]]. See the examples in docs page MapAt . $\endgroup$ – kglr Feb 4 at 5:20

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.