Automating a code to use Map function, using it to plot with ListLinePlot command and plotting with certain imposed conditon

Question

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;

Second question comes here:

2. 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:

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

Third question is this:

3. 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…

Answer 1

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