0
$\begingroup$

Below is a natural log list of ordered time data with variable time-steps. I would like a functional approach that selects 3-tuples of positions sublists based on the first selected elements that exceed a specified Log10 distance (smth) applied to the left and right of each element. Output from the moving window would be a list of 3-element sublists of positions, { {i-left, i, i-right},...{}}.

smth  = 0.1;
lneft = {-5.48, -4.79, -4.38, -4.1, -3.87, -3.69, -3.54, -3.41, -3.29, -3.09, -3., -2.85, -2.72, -2.6, -2.5, -2.36, -2.24, -2.13, -2.03, -1.94, -1.84, -1.74, -1.66, -1.58, -1.5, -1.42, -1.27, -1.14, -1.03, -0.93, -0.84, -0.76, -0.68, -0.61, -0.55, -0.49, -0.43, -0.38, -0.31, -0.24, -0.18, -0.12, -0.07, -0.02, 0.03, 0.07, 0.11, 0.15, 0.19, 0.23, 0.29, 0.35, 0.41, 0.46, 0.55, 0.6, 0.63, 0.71, 0.77, 0.83, 0.88, 0.92, 0.97, 1.01, 1.04, 1.08, 1.11, 1.14, 1.16, 1.19, 1.21, 1.24, 1.28, 1.32, 1.35, 1.38, 1.41, 1.43, 1.46, 1.48, 1.5, 1.52, 1.53, 1.55, 1.57, 1.58, 1.59, 1.61, 1.63, 1.65, 1.66, 1.67, 1.69, 1.7, 1.71, 1.72, 1.73, 1.74, 1.75, 1.76, 1.77, 1.78, 1.79, 1.8}

Output for the first sublist should be: {1,4,12}.

I found the initial left position with the following:

start = Position[lneft,SelectFirst[lneft,Log10[EuclideanDistance[First[lneft], #]] > smth &]]

{{4}}

"mnunos" (see below) provided a nice solution based on constant time-steps, which was my original question that I inadvertently made too simplistic. I just updated the question to include my actual data with variable time-steps.

$\endgroup$
1
$\begingroup$

With constant time steps dt:

dt=0.25;
lndata = Range[-5, 5, dt];
smth = 0.1;
dn = Ceiling[10^smth/dt];
result = {# - dn, #, # + dn} & /@ Range[dn + 1, Length@lndata - dn]

The result is

{{1, 7, 13}, {2, 8, 14},..., {28, 34, 40}, {29, 35, 41}}

EDIT 1: variable time steps

Not very elegant but it works

smth = 0.1;
timeData = FoldList[Plus, -5, RandomReal[{0, 0.5}, 40]];
result = {
    j = 1; 
    While[# - j > 1 && 
      Log10[timeData[[#]] - timeData[[# - j]]] < smth, j++]; # - j,
    #,
    i = 1; 
    While[# + i < n && 
      Log10[timeData[[# + i]] - timeData[[#]]] < smth, i++]; 
    i + #} & /@ Range[2, Length[timeData] - 1]
$\endgroup$
  • $\begingroup$ Thank you -- I very much appreciate your simple solution. I feel kinda stupid now. I was making the problem way too hard with SelectFirst. I'm on the steep part of the MMS learning curve and having trouble overcoming the old, ingrained procedural approach with arrays and Do loops. Thanks again, mnunos....John $\endgroup$ – John Jan 8 '16 at 21:57
  • $\begingroup$ Any ideas when the time-steps are not constant? $\endgroup$ – John Jan 9 '16 at 7:43
  • $\begingroup$ @John I have added a method for not constant time steps, but there is probably a better way to do it: I am very far from proficiency in MMA too. $\endgroup$ – Gypaets Jan 11 '16 at 13:07
  • $\begingroup$ Beautiful -- thank you mnunos! I like the way you think -- very clear approach. I have been struggling a long time with this yet this makes perfect sense. The only thing I changed was "n" to "Length[timeData]". You really helped me with a road block and I appreciate it very much. $\endgroup$ – John Jan 11 '16 at 19:49
  • $\begingroup$ Oh, yes. I had defined n=Length[timeData] but forgot to paste it here. $\endgroup$ – Gypaets Jan 11 '16 at 21:30
0
$\begingroup$
pos[w_, d_] := First@FirstPosition[w, _?(# > d &)]
func[lst_, d_] := 
 Module[{dist = Log10[UpperTriangularize@DistanceMatrix[lst]], can},
  can = Thread[Range[Length[dist]] -> (pos[#, d] & /@ dist)] /. 
    Rule[_, "NotFound"] :> Sequence[];
  DeleteCases[{#1, #2, Sequence @@ (List @@@ #2 /. can)} & @@@ 
    can, {_, c_, c_}]]

Applying to lneft in original post: func[lneft,0.1]:

{{1, 7, 13}, {2, 8, 14}, {3, 9, 15}, {4, 10, 16}, {5, 11, 17}, {6, 12,
   18}, {7, 13, 19}, {8, 14, 20}, {9, 15, 21}, {10, 16, 22}, {11, 17, 
  23}, {12, 18, 24}, {13, 19, 25}, {14, 20, 26}, {15, 21, 27}, {16, 
  22, 28}, {17, 23, 29}, {18, 24, 30}, {19, 25, 31}, {20, 26, 
  32}, {21, 27, 33}, {22, 28, 34}, {23, 29, 35}, {24, 30, 36}, {25, 
  31, 37}, {26, 32, 38}, {27, 33, 39}, {28, 34, 40}, {29, 35, 41}}

which has a different first result.

For lndata in other answer: func[lndata,0.1]:

{{1, 4, 13}, {2, 8, 18}, {3, 10, 22}, {4, 13, 26}, {5, 14, 27}, {6, 
  16, 29}, {7, 17, 30}, {8, 18, 31}, {9, 19, 32}, {10, 22, 37}, {11, 
  22, 37}, {12, 24, 39}, {13, 26, 42}, {14, 27, 45}, {15, 28, 
  48}, {16, 29, 50}, {17, 30, 52}, {18, 31, 54}, {19, 32, 55}, {20, 
  33, 56}, {21, 35, 58}, {22, 37, 60}, {23, 38, 61}, {24, 39, 
  63}, {25, 40, 65}, {26, 42, 68}, {27, 45, 74}, {28, 48, 77}, {29, 
  50, 81}, {30, 52, 88}, {31, 54, 96}}

(based on sorted list)

$\endgroup$
  • $\begingroup$ The code works great. I much appreciate you taking the time to help. I am not at your level so will need to study this to fully understand, but your post definitely accelerates my learning MMA. Thank you for this "ubpdgn". $\endgroup$ – John Jan 12 '16 at 9:16
  • $\begingroup$ @John I am glad this has been helpful. I am certain there are better ways and as you play you will find the way you want to achieve your goals. All the best:) (BTW: "ubpdqn" second last letter "q" not "g"...an ambigram 180 degree rotational symmetry (depending on font)... $\endgroup$ – ubpdqn Jan 12 '16 at 9:28
  • $\begingroup$ ha ha -- good catch. I see your pattern searching mind spotted the "q" not "g" right off. Thanks again -- very helpful. I really like your DistanceMatrix trick. $\endgroup$ – John Jan 12 '16 at 17:59

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.