Re: Filtering data from numerical minimization

• To: mathgroup at smc.vnet.net
• Subject: [mg116884] Re: Filtering data from numerical minimization
• From: Ray Koopman <koopman at sfu.ca>
• Date: Thu, 3 Mar 2011 05:58:41 -0500 (EST)
• References: <ijasgs\$ned\$1@smc.vnet.net> <ikfv4k\$f7v\$1@smc.vnet.net>

```On Mar 2, 1:38 am, Sebastian <sebho... at gmail.com> wrote:
> Sorry for that, there is a typo in the code above. Also,
> I should have included a sample of my data. For completeness:
>
> DefineFilter[cond_, options : OptionsPattern[]] :=
>   Module[{ret},
>    ret = Switch[OptionValue[ReturnValue], "Position", True, _,
>      False];
>    Return@
>     With[{ret = ret},
>      Function[t,
>       Select[Table[
>         If[i == 1 || i == Length@t || cond[t, i],
>          If[ret, i, t[[i]]]], {i, 1, Length@t}], # =!= Null &]]];];
> Options[DefineFilter] = {ReturnValue -> "Value"};
> Attributes[DefineFilter] = {HoldAll};
>
> filter1 =
>   DefineFilter[(f /. #1[[#2 - 1]]) < (f /. #1[[#2]]) < (f /. #1[[#2
>         + 1]]) &];
>
> noise = RandomReal[NormalDistribution[0, .75], m = 30];
> data = Table[{x -> n, f -> n + %[[n]]}, {n, 1, m}];
> fdata = {x, f} /. filter1[data];
> ListPlot[fdata]
>
> I hope it works this time. Anyway, you are of course right and my
> code does drop points which could be kept, I'm aware of that. My
> data is not to big (a few hundreds of points at most) so the brute
> force method might actually be feasible. I will definitely try it
> out at some point and tell you the results. It may be a while
> though, as I have more pressing problems to work on at the moment.
>
> Best regards,
> Sebastian

OK, I got it working. The form of the data -- pairs of rules,
instead of values -- was a real surprise.

The utility of brute force can be increased by taking a divide-and-
conquer approach to the problem. The following routine will identify
the subsequences of the data that contain all the nonmonotonicity.

max = FoldList[Max,First@y,Rest@y];
min = Reverse@FoldList[Min,Last@y,Reverse@Most@y];
p = Flatten@Position[Most@max-Rest@min,_?Negative];
Select[Transpose@{Prepend[p+1,1],Append[p,Length@y]},Less@@#&]]

It returns the subscripts of the first and last values of bad
subsequences. Apply brute force to each subsequence independently.

y = (* the data from my previous post *)
{0.92655, 1.30388, 3.03193, 5.80771, 4.66381, 5.76605, 6.96496,
7.69883, 9.1255,  9.26462, 11.0126, 12.0445, 14.4794, 15.7246,
15.9259, 14.9641, 17.0921, 17.1325, 19.0079, 19.4272, 19.8135,
22.3691, 24.1007, 24.611,  24.0087, 26.3429, 26.0191, 28.155,
30.1278, 29.3931};

{{4, 6}, {14, 16}, {23, 25}, {26, 27}, {29, 30}}

This shows the bad subsequences as joined points:

ListPlot[y, PlotRange->All, Frame->True, Axes->None,
Prolog-> (Line@Transpose@{#,y[[#]]}&) /@ Range @@@ q]

Only the values within those subsequences are out of order.
Sorting the subsequences independently is the same as sorting y.

z = y; Scan[(z[[#]] = Sort@z[[#]])&, Range@@@q]; z === Sort@y

True

```

• Prev by Date: Re: Problem exporting to LaTex
• Next by Date: Re: Vector Runge-Kutta ODE solver with compilation?
• Previous by thread: Re: Filtering data from numerical minimization
• Next by thread: Re: Filtering data from numerical minimization