Here is the Dynamic result I made from your solutions. I applied the solution of Hans Michel, but I will make versions with the other solutions as well, just to learn. Thanks again to all of you :-)

Attached the nb with my latest version.

Beat

Attachments:

Result Delta Bea...nb

This is what I have so far, based on the latest version of Hans Michel.

Clear[lappingMeanShuffles, gatherlappingShuffles, lappingShuffles, 
  shuffleInterval, myxIntegers, myyIntegers];

numlines = 20;          (*  This has to be made adjustable with a Slider  *)
myxIntegers = Table[RandomInteger[100], numlines];
myyIntegers = Table[RandomInteger[100], numlines];

(*myxIntegers ={4,8,7,8}
myyIntegers ={4,8,7,8}*)

(*   FUNCTIONS    *)

shuffleInterval[x_List, n_] := 
  Module[{}, Map[({Interval[{# - n, # + n}], #}) &, x]];
lappingShuffles[x_List, n_] := 
  Module[{z = shuffleInterval[x, n]}, 
   Map[Function[y, Select[z, IntervalMemberQ[#[[1]], y] &]], x]];

(*  OF  lappingShuffles[x_List,n_]:=Module[{z=shuffleInterval[x,n]},\
Map[Function[y,Select[z,Between[y,#[[1]]]&]],x]];  *)

gatherlappingShuffles[x_List, n_] := 
  Module[{z = lappingShuffles[x, n]}, Map[(#[[All, 2]]) &, z]];
lappingMeanShuffles[x_List, n_] := 
  Module[{z = gatherlappingShuffles[x, n]}, Map[Floor[Mean[#]] &, z]];


Manipulate[
 Graphics[
  Map[Line[#] &, 
   Partition[
    Transpose[{lappingMeanShuffles[myxIntegers, n], 
      lappingMeanShuffles[myyIntegers, a]}], 2, 1]], 
  ImageSize -> 600], {{n, 20, "Delta X"}, 0, 100, 1, 
  Appearance -> "Labeled"}, {{a, 20, "Delta Y"}, 0, 100, 1, 
  Appearance -> "Labeled"}]

Hans, your manipulate seems to work fine and is what I had in mind. I adapted the script somewhat, so I generate Random x-coordinates and Randon y-coordinates from 0 - 100. That means I also adatpted the two delta's (here n and a to cover the range from 0 to 80). The results are what I expected and are promising. Nice :-)

Tomorrow I will dig deeper ionto your code to really undestand what you have done. I also will make a Slider to control the amount of points (how long the lists for x & y will be). And some more little extra's. It's great to see how a simple problem can be solved in many different ways. I wish I had started earlier with Mathematica :-)

Thanks Hans, it's really appreciated.

The first function shuffleInterval[x_List, n_] takes a List and an another vatiable n, with no constraints but assumed to be Integer(s); which returns a List of Interval(s) and original Integer(s) from x in position order as we are using Map. So the return list shapes as follows (psuedo-code):

{{Interval[x(i) - n, x(i) + n], x(i)},...}

where x(i) is the value based on position on the incoming List. This is why I used Table in my first post for easier understanding. So, on to the next step/function broken down. lappingShuffles[x_List, n_] takes output from shuffleInterval[x_List, n_] as z and accumulates, using Map and a Select function, the x(j,k,l,m,...)(s) and its Interval; where x(i) is a member of that interval. So the return list shapes as follows (psuedo-code):

{{{Interval[x(i) - n, x(i) + n], x(i)}, {Interval[x(j) - n, x(j) + n], x(j)}}, ...}

The next function gatherlappingShuffles[x_List, n_] takes output from lappingShuffles[x_List, n_] as z and takes the second column of each items of z. So the return list shapes as follows, for example (psuedo-code):

{{x(i),x(j)}, x(j), {x(k), x(l), x(m)}, ...}

This is the result which we take the Floor Mean of. However, you are stating that the functions as presented are not gathering or grouping properly, thus the Mean is off or presentation is confusing.

So how to test that gatherlappingShuffles[x_List, n_] is working as designed and as OP requested. To test just call gatherlappingShuffles[x_List, n_]. Say gatherlappingShuffles[myxIntegers, 20] and see what it returns. Then apply/map Floor Mean to each item on the list. Or on a few of those list items do some calculations by hand see what you get.

What are the rules you have in mind for the weights, if any? Otherwise, I thought I was faithfuly interpreting your request.

I thought I was being clear that the only reason I split up the functions is for you to better study the process. Each function can be called individually, with the same parameters, and their results can be observed. Just as I did in a previous post NumberLinePlot[shuffleInterval[myIntegers, 10]] to plot.

For example try:

{myxIntegers, 
  myyIntegers} = {BlockRandom[RandomInteger[100, 100], 
   RandomSeeding -> 42], 
  BlockRandom[RandomInteger[100, 100], RandomSeeding -> 44]};
gatherlappingShuffles[myxIntegers, 20]

All the next function does is Map the Floor Mean functions to each item. The above statement assumes that all 4 ...Shuffle(s) functions are defined.

Whether the solution paths provided are functional and/or make use of recursion; I can't truly speak to that. It may be best to clearly state your problem and goals. And see if this community can help you find other functional solutions. I interpreted your request to avoid procedural programming to mean use a functional programing paradigm.

"Functional programming is a programming paradigm in which we try to bind everything in pure mathematical functions style. It is a declarative type of programming style. Its main focus is on 'what to solve' in contrast to an imperative style where the main focus is 'how to solve'. It uses expressions instead of statements. An expression is evaluated to produce a value whereas a statement is executed to assign variables."

But WL provides a good environment for exploration.

So if the Mean is not what you want change it.

Please, note that Dynamic(s) are tricky. My best guess is that you may want to wrap these Dynamic variables and Slider(s) in a DynamicModule.

Hans, I've spent some hours this afternoon on your solutions and the sun is starting to come up :-)

I can follow the code (thanks also to your breaking it down into seperate functions) all through and I get the purpose and it's workings. There are some minor details in the syntax that have not yet been completely defrosted for me, but it will come. I am most gratefull for your time and effort.

I think I will use Round[] in stead of Floor[], but is jus a minor detail.

I will start to try to make your code into a Dynamic setup. I will study your suggesion to use DynamicModule. I have already made some things with Dynamic controls, but not everything is clear yet (see my previous post).

I realize that there are very basic things that I am still unaware of. It took me f.i an hour to get the Mean[[{3,4,5},{7,9}}. It does not work like this, but by exploring how you did it, I managed after a while. So I know that I am not comfortable yet with some very basic things, but it will come.

Thanks again, Hans, for your patience.

Beat

Thanks Hans, I'll will study your input tomorrow.

To make things easier to apply, I made a function called scrubber that takes one argument, named x, that must be a list. I could have named it anything. Inside the function, it puts that input list wherever I use “x”.

The module function is a way to do a sequence of commands and make variables like pos and sorted local variables to the module.

I hope that helps.

For me takes time to study all your very welcome inputs, and that is the reason that my replys are slow :-) But be sure that I'll study all of them.

Hi Neil, As you indicated, I had not clearly defined my problem. For me it was not so important whether the bigger number got repacked by the smaller or vice versa. Now I think it would be nice to take the mean of the two. This would also resolve the problem I had not noticed in my example list of integers.

{11, 28, 66, 36, 94, 8, 44}

You had rightly noticed that there are three numbers within the 10 range : 28,36,44. So to resolve situations like this, and anyhow, it might be best to take the rounded mean for the numbers that are within the defined range of 10. So eventually the list would become {9 , 36 ,66, 36 , 94 , 9 , 36}

I can follow your approach,Neil,and I like the seemingly 'Wrong' move away from the solution (the sorting), only to come back strong further on.

I just notice in your last post, that you have solved the ’28,36,44’ problem as well. Here letting the smallest number prevail.

I can tag along your solution (although I would not have been able yet to come up with it), just the following line is still unclear to me :

scrubber[x_List] := Module[{pos, sorted}, sorted = Sort[x];

Is [xList] the same as [x] but for Lists?

The part after the := I don’t get. What is ‘x’, f.i.?

Thanks, Neil

Hans, this looks very neat. I like the Slider, so I can control the amount of replacement of the numbers <= delta. That plays into what I want. Tonight I feel I am too tired to understand what you really did, but it sure seems very nice. I will dive into it as soon as I can. Thanks.

Here is again a different approach. Define a function, which finds for each element in a list the preceeding elements with a difference <= 10 and additionally their positions in the list. As there may be more than one the result is given as

{ Position of element, element ee, { e1, e2, ...} }

with Abs [ ee - ei ] <= 10.

(In the example we have always only one ei )

Then it is possible to replace ee by one of the ei's.

Clear[fF];
fF[x_, tT_] := Module[{},
  pp = Position[tT, x][[1, 1]];
  If[pp == 1, Return[0]];
  tH = Take[tT, pp - 1];
  aL = Select[tH, Abs[# - x] <= 10 &];
  res = If[aL =!= {}, {pp, x, aL}, 0];
  res
  ]

tt = {11, 28, 66, 36, 94, 8, 44}
res1 = DeleteCases[fF[#, tt] & /@ tt, 0]
res2 = {#[[1]] -> #[[3, 1]]} & /@ res1 // Flatten
tt = ReplacePart[tt, res2]

But this still does not give what you want, because the last 44 is replaced by 36.

Sorry, wrong click.

The speed is not an issue, as the lists will be max 100 numbers. I am baked for today with trying to wrap my head around hans' solution. I'll look into yours tomorrow. But many thanks for your input. To get ideas and solutions from experienced users really opens my eyes (and wears my brain :-)

In general if I want to see what's going on I put a strategic print statement in, you do have to be cautious in this regard particularly if as a result there are many items to print, it is sometimes wise to also include a Pause[1] after the print so you can interrupt the program. Anyway i made a small alteration to the original program to move the if statement outside of the do loop as shown here.

delta = 10; myint = {11, 28, 66, 36, 94, 8, 44}; Print[myint]; ss = 
 Subsets[myint, {2}]; css = 
 Cases[ss, {a_, b_} /; Abs[a - b] <= delta]; Print[css]; If[
 Length[css] > 0, 
 Do[p = Flatten[Position[myint, css[[i, 2]]]]; 
  myint[[p]] = css[[i, 1]]; Print[myint], {i, 1, Length[css]}]]; myint

To make it so the test is first or second number just change the index in css[[i,2]] to css[[i,1]] and visa versa.

Now in regard to the "mean" version I have re-written the code to hopefully cater for more than 2 terms in the delta range or any number really. It also self adjusts so once a set of numbers have been changed to the mean value, those numbers are not used again even if there is a spanning set of numbers else where, and or if the new mean is also a value in the original list, take a look and see if this is doing what you require.

delta = 10; myint = {79, 90, 67, 56, 54, 43, 8, 90, 2, 71, 17, 64, 58,
   83, 14, 98, 41, 4, 32, 85}; Print[myint]; sd = 
 Sort[myint]; groups = 
 Table[Flatten[{sd[[i]], 
    Select[sd, sd[[i]] < # <= sd[[i]] + delta &]}], {i, 1, 
   Length[sd]}]; Print[
 Flatten /@ 
  Partition[Riffle[groups, Floor /@ Mean /@ groups], 2]]; Do[
 If[Length[Intersection[myint, groups[[i]]]] == Length[groups[[i]]], 
  a = Floor[Mean[groups[[i]]]]; 
  p3 = Sort[
    Flatten[Table[
      Position[myint, groups[[i, r]]], {r, 1, Length[groups[[i]]]}]]];
   myint[[p3]] = a], {i, 1, Length[groups]}]; myint

Alter the initial list and see if it behaves as expected.

Paul.

Hi Hans, thanks again for your contribution.

All right, here the bigger number that is within the range gets replaced by the smaller. That is also all right with me.

Your solution is setting the bar quite high for me - which is great, but I need time to really explore your solution bit by bit. And live a lot in the documentation :-)

I found the following :

1. Outer[List, tt, tt], 1 makes an Array with all the possible 2 number combinations from the original list tt, which are 49 in total (7^2). So that I got.

2. Cases[#, {x, y} /; x < y] & is a pure function which searches for the pattern x<y The Flatten gives eventually back to t1 an array with the first number < second number. (21 lists left).

3. t2 = Cases[t1, {x, y} /; 0 < Abs[x - y] <= 10] Here only the lists that comply to the range criterion of 10 are included in t2.

   I think the bigger than zero part (0 < Abs[ ) could be left out, as the lists with equal numbers have already been filtered out.

4. rr = Rule @@@ (Reverse /@ t2) I see what it does, but do not understand the syntax. Could you explain a bit ?

From the doc : f@@@expr or Apply[f,expr,{1}] replaces heads at level 1 of expr by f. I don’t get this.

I tried to rewrite the line into for me more familiar form ; rr = Apply[Rule[ Map[Reverse], t2]] But this does not work. How could the line be written with Apply[] and map[] ?

1. tt /. rr This I get. The rules of rr are applied to my original list.

I understand FixedPoint. But why does FixedPoint not continue and also replace ’36’ with ’28’? The rule 36->28 is present in rr.

I also don’t get the very beginning :

newt[t_] := Module[{}, I guess the Module just protection and not really essential. But what is the {} just after.

Thanks a lot :-)

I understand FixedPoint. But why does FixedPoint not continue and also replace ’36’ with ’28’? The >rule 36->28 is present in rr.

In fact the fixedpoint is not necessary. One has to provide that rr is applied until there is no more change.

tt = {11, 28, 66, 36, 94, 8, 44}

newt[t_] := 
 Module[{}, 
  t1 = Flatten[Cases[#, {x_, y_} /; x < y] & /@ Outer[List, tt, tt], 
    1];
  t2 = Cases[t1, {x_, y_} /; 0 < Abs[x - y] <= 10];
  rr = Rule @@@ (Reverse /@ t2);
  tt //. rr]

newt[tt]

I also don’t get the very beginning :

newt[t_] := Module[{}, I guess the Module just protection and not really essential. But what is the {} >just after.

hmmm. I use Module to write longer subprograms. The {} encloses variables (here none) which are local to the Module and not visible in main.

Neil, I understand your idea. I had been thinking of sorting the list, to make things easier. Unfortunately, I need (at least in the end) , the order to be like it was in the first place, but with the adapted numbers. But the original order needs to be preserved.

Still 'Position[ ]' might be a valuable tip

With these answers I certainly can move on. Thanks. Hans : I think your second example works, but I really need to study it to get it. It's more compact than the code I write at my current level of Mathematica.

I certainly appreciate the answer of Bill Nelson, as it gives me a direction in which way to think. This is exactly what I need, a new way to think about solutions. GREAT :-)

Neil : I agree. I should have been clearer in my question. I took the first number and adapted the next one within the delta range to become as the first. I could have taken the second or the mean. And my example, I noticed is indeed a bit double, in that 44 is also within the range of 36, which in its turn is within the range of 28. I have to rethink how I want that to be solved.

But for now, I will take time to study the answeres and play with them. Thanks agian, this really helps my understanding of this wonderfull new language and way of thinking. I'll get back after working with the new ideas.

Best, Beat

Instead of giving you code, I'll give you one idea how you might try to think about this functionally.

You have to write a function. One way might be to create a function that takes two arguments, the list of items processed thus far and the list of items not yet processed.

All functional programs need a test to tell if they are finished. In this function it is finished if the second argument is empty and in that case it just returns the first argument.

If it is not finished then it takes the first item from the unprocessed list, perhaps uses the Mathematica function Nearest to test whether that item is close enough or not, and calculates the next item to append to the processed list.

Can you convince yourself that this modification process of the next item in the unprocessed list does not somehow corrupt the definition of the problem? That might or might not be exactly true. Perhaps try thinking of some really strange cases that might make this behave oddly.

Then the function calls itself with the new longer processed list and the new shorter unprocessed list.

Can you figure out what the thinking process was to get there? That is the most important step, much more important than what the answer is.

Can you convince yourself that this exactly correctly implements your description? And that your description is exactly correct?

Could you then start thinking if there might be any other way to implement this functionally?