How do I recurrently process irregular lists until they are empty?

Question

I want to solve the following task: I have two sorted lists A and B. Let's say

A={0, 1, 8, 10, 16, 17, 24, 32, 33, 34, 40, 48} and

B={1, 2, 3, 9, 17, 18, 25, 27, 33, 34, 41}.

From those two lists I want to create pairs s.t. an element b from list B is paired with the biggest element a from A that is smaller than or equal to b. But also every element should go into maximum one pair. Also we only look ahead. That is, if we have put the nth element of A into a pair already, the next element from b we only compare to elements n+1, n+2, and so on from list A. That means some elements will be "lost" throughout the process. This is not a problem. To give an example, the result set of pairs P for the above lists would be as follows:

P={{1,1},{8,9},{17,17},{24,25},{33,33},{34,34},{40,41}}

Note that the pairs do not have to be sorted but in this example they are always of the form {A[x],B[y]}

To give an idea of how one would construct P by hand we go through the first few steps:

1. Take first element of B: B[1]=1
2. Compare B[1]to the first element of A -> 1>=0. This means A[1] = 0 is a possible candidate for the first pair
3. Compare B[1] to A[2] -> 1>=1. This means A[2] is a possible candidate for the first pair
4. Compare B[1] to A[3] -> 1<8. This means A[2] is the value for the first pair
5. First Pair is {A[2],B[1]} = {1,1}
6. Look for the next pair on the lists A'={8, 10, 16, 17, 24, 32, 33, 34, 40, 48} and B'={ 2, 3, 9, 17, 18, 25, 27, 33, 34, 41}

The next value in B' would be 2 but no value in A' is smaller than or equal to 2 so we go on to the next one in B' which is 3. Still we only have bigger values in A'. The next pair we get is then {A'[1],B'[3]}={8,9} and so on.

The problem is not really intuitive I think and I have tried alot but cannot seem to get this to work right in mathematica.

Things I have tried include doing it recursively like one would in a standard programming language and using loops. But I run into recursion depth exceptions and other problems. I would rather do it 'right' or in some nice way. Maybe some List Mapping is possible here?

I appreciate every help

Answer 1

Try this on a couple of use cases.

A = {0, 1, 8, 10, 16, 17, 24, 32, 33, 34, 40, 48};
B = {1, 2, 3, 9, 17, 18, 25, 27, 33, 34, 41};
Module[{aA = Reverse@A, res},
 Table[
  If[bs >= aA[[-1]],
   {aA, res} = TakeDrop[aA, -1 + First@FirstPosition[aA, a_ /; a <= bs]];
   {res[[1]], bs},
   Nothing
   ],
  {bs, B}]
 ]

(* {{1, 1}, {8, 9}, {17, 17}, {24, 25}, {33, 33}, {34, 34}, {40, 41}} *)

Answer 2

Clear[f]
A = {0, 1, 8, 10, 16, 17, 24, 32, 33, 34, 40, 48};
B = {1, 2, 3, 9, 17, 18, 25, 27, 33, 34, 41};
f[A_, B_] := 
 Module[{ia = 1, ib = 1}, 
  Reap[While[ib <= Length@B, 
     If[A[[ia]] <= B[[ib]], 
      While[ia <= Length@A && A[[ia]] <= B[[ib]], ++ia]; 
      Sow@{A[[ia - 1]], B[[ib]]}; 
      If[ia > Length@A, Break[]]]; ++ib]][[2, 1]]]
f[A, B]

{{1, 1}, {8, 9}, {17, 17}, {24, 25}, {33, 33}, {34, 34}, {40, 41}}

SeedRandom[123];
A = Sort@RandomInteger[10^7, 10^5];
B = Sort@RandomInteger[10^7, 10^5];
f[A, B]; // RepeatedTiming

{0.364366, Null}

Answer 3

According to the given conditions, we can combine Do and While to get the pairs and at the end split the list of pairs according to the first element of each pair using SplitBy, and finally take the first elements of the resulting sublists and thus obtain the desired output:

A = {0, 1, 8, 10, 16, 17, 24, 32, 33, 34, 40, 48};
B = {1, 2, 3, 9, 17, 18, 25, 27, 33, 34, 41};

createPairs[A_List, B_List] := Module[{pairs, ia},
    pairs = {};
    ia = 1;
    Do[
        While[And[LessEqual[ia, Length @A], LessEqual[A[[ia]], b]],
            Increment @ ia
        ];
        If[Greater[ia, 1],
            AppendTo[pairs, {Part[A, ia - 1], b}]
            ],
            {b, B}
        ];
    Map[First, SplitBy[pairs, First]]
   ];

createPairs[A, B]

Result:

{{1, 1}, {8, 9}, {17, 17}, {24, 25}, {33, 33}, {34, 34}, {40, 41}}