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.

Improve this question
$\endgroup$

2 Answers 2

Reset to default
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]
Improve this answer
$\endgroup$
5
  • $\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
    Commented Jan 8, 2016 at 21:57
  • $\begingroup$ Any ideas when the time-steps are not constant? $\endgroup$
    – John
    Commented Jan 9, 2016 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
    Commented Jan 11, 2016 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
    Commented Jan 11, 2016 at 19:49
  • $\begingroup$ Oh, yes. I had defined n=Length[timeData] but forgot to paste it here. $\endgroup$
    – Gypaets
    Commented Jan 11, 2016 at 21:30
1
$\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)

Improve this answer
$\endgroup$
3
  • $\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
    Commented Jan 12, 2016 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
    Commented Jan 12, 2016 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
    Commented Jan 12, 2016 at 17:59

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.