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.
bad[y_] := Block[{max,min,p},
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};
q = bad[y]
{{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