0
$\begingroup$

I want to find the first minimum of Sin[a (b + m)]. For example: In the second row, since 0.9092<0.9589, I would like to assign 0.9092 as the minimum instead of 0.4201.

CODE:

data = Table[{a, b, m, Sin[a (b + m)]}, {a, 1, 2, 0.5}, {b, 2, 3, 1}, {m, {-1, 2, 10}}];

FormatCells[table_] := With[{minPosition = OrderingBy[Abs@table, Last, 1]},MapAt[Item[#, Background -> Green] &, TableForm[{#}, TableDirections -> Row,TableHeadings -> {None, {"a", "b", "m", "F"}}] & /@ table,minPosition]]
FormatTable[table_] := Grid[FormatCells /@Abs@table, Dividers -> All]
FormatTable[N[data[[1]]]]

OUTPUT:

EDIT 1: I had missed out a part of the code which I have added now.

EDIT 2: Please help me export the minimum values to a .csv file (Using Ulrich Neumann's answer given in the addendum) as shown in this screenshot:enter image description here

I have tried the Export command in several ways but nothing works. I will truly appreciate any help.

$\endgroup$
2
  • $\begingroup$ The question is completely incomprehensible: What might be the first minimum of {{1., 3, -1, 0.909297}, {1., 3, 2, -0.958924}, {1., 3, 10, 0.420167}} ??? $\endgroup$ Dec 18, 2023 at 12:05
  • $\begingroup$ There is Abs applied to the table values, therefore I'm trying to find the first minimum of 0.909297, 0.958924, 0.420167 which is indeed 0.909297 $\endgroup$ Dec 18, 2023 at 12:43

1 Answer 1

1
$\begingroup$

Try

pickMin[list_] := Pick[list , MinDetect[list ], 1][[1]]
Map[pickMin@Abs@#[[All, -1]] &, Flatten[data , 1] ]
(*{0.536573, 0.909297, 0.279415, 0.14112, 0.909297, 0.544021}*) 

to get the Min-values of |Sin[a(b+m)]|

The correct position of these minima follow with

Map[FirstPosition[MinDetect@Abs@#[[All, -1]], 1] &, Flatten[data,1]] 
(*{{3}, {1}, {2}, {1}, {1}, {2}}*)

addendum

Here QP's corrected code

FormatCells[table_] := With[{minPosition = 
     FirstPosition[MinDetect@Abs@#[[All, -1]], 1] &[table]}, 
  MapAt[Item[#, Background -> Green] &, 
   TableForm[{#}, TableDirections -> Row, 
      TableHeadings -> {None, {"a", "b", "m", "F"}}] & /@ table, 
   minPosition]]
FormatTable[table_] := Grid[FormatCells /@ Abs@table, Dividers -> All]
FormatTable[N[Flatten[data, 1]]]

enter image description here

$\endgroup$
17
  • $\begingroup$ It would be very helpful if the output looks like the one that I am getting with my present code but with 0.909297 as the minimum in the second row. This is because the code that I have posted is actually a part of a bigger program that I have. $\endgroup$ Dec 18, 2023 at 18:14
  • $\begingroup$ I seriously can't thank you enough. You have solved my problem! @Ulrich Neumann $\endgroup$ Dec 18, 2023 at 19:40
  • $\begingroup$ You're welcpme! $\endgroup$ Dec 18, 2023 at 20:52
  • $\begingroup$ Also, how can I export these first minimum values to a .csv file? I have tried table = First@MinimalBy[#, FirstPosition[MinDetect@Abs@#[[All, -1]]]] & /@ data[[1]]; Export["Data 1.csv", table, TableHeadings -> {"a", "b", "m", "F"}], but this does not seem to work. $\endgroup$ Dec 19, 2023 at 8:04
  • 1
    $\begingroup$ Here are the three codelines which you already know: indexMin = Map[FirstPosition[MinDetect@Abs@#[[All, -1]], 1] &, Flatten[data, 1] ] /. {a_} :> a; table =MapThread[#1[[#2]] &, {Flatten[data, 1], indexMin}];Export["Data 1.csv", table, "Table", TableHeadings -> {"a", "b", "m", "F"}] $\endgroup$ Dec 20, 2023 at 11:06

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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