Stable mixing of 2 arrays into a 3rd

[BrowserUk]

I need to generate a random sequence from two arrays into a third array, with the caveat that the values from both arrays remain in their original order. Ie. It's only the sequence in which they get mixed together that is random. Fairness is not a consideration.

I thought (actually, I still think) that this code should do this, and it does except occasionally it throws a blank (undef) in somewhere and I just cannot see why?

#! perl -slw
use strict;

while( 1 ) {
    my @t1 = map{ "T1/$_" } 1 .. 7;
    my @t2 = map{ "T2/$_" } 1 .. 7;
    my @seq = map{ 
        shift @{ 
            ( ( rand() < .5 ) and @t1 ) 
             ? \@t1 
             : \@t2 
        } 
    } 1 .. @t1 + @t2;
    print @seq . " :@seq"; <STDIN>;
}
__END__
P:\test>junk.pl
14 :T2/1 T2/2 T1/1 T1/2 T1/3 T2/3 T2/4 T1/4 T2/5 T2/6 T1/5 T2/7 T1/6 T
+1/7

Use of uninitialized value in join or string at P:\test\junk.pl line 1
+0, <STDIN> line 1.
14 :T2/1 T1/1 T1/2 T1/3 T1/4 T2/2 T2/3 T2/4 T1/5 T2/5 T1/6 T2/6 T2/7

14 :T1/1 T1/2 T1/3 T1/4 T1/5 T1/6 T2/1 T2/2 T1/7 T2/3 T2/4 T2/5 T2/6 T
+2/7

14 :T1/1 T1/2 T1/3 T1/4 T2/1 T1/5 T1/6 T1/7 T2/2 T2/3 T2/4 T2/5 T2/6 T
+2/7

Use of uninitialized value in join or string at P:\test\junk.pl line 1
+0, <STDIN> line 4.
14 :T1/1 T2/1 T1/2 T1/3 T2/2 T2/3 T1/4 T2/4 T2/5 T2/6 T1/5 T1/6 T2/7
Terminating on signal SIGINT(2)

Janitored by Arunbear - retitled from 'Why doesn't this code do what I think it should?'

[Sidhekin]

You are checking that @t1 has not been emptied, but you are forgetting to check whether @t2 is empty. For example:

        shift @{ 
            ( !@t2 or ( rand() < .5) && @t1 ) 
             ? \@t1 
             : \@t2 
        }

[BrowserUk]

Yep! That'd do it.

[tye]

You protect against picking from @t1 when it is empty but not against picking from @t2 when it is empty.

!@t2 || @t1 && (rand < .5) ? ...

[shenme]

'Somewhere', or towards the end of the created array? I'm thinking that you are exhausting one of the arrays long before you think you should, and shift off undef to stuff into the output.

Update: I changed the code lines:

    my @t1 = map{ "T1/$_" } 1 .. 7, 42, 142, 242;
    my @t2 = map{ "T2/$_" } 1 .. 7, 43, 143, 243;
and 
    } 1 .. (7+7);

and ran that and occasionally saw:

C:\Archive\Perl\Mine\play>perl -w browseruk1.pl
14 :T2/1 T1/1 T2/2 T2/3 T1/2 T2/4 T1/3 T2/5 T2/6 T2/7 T1/4 T1/5 T2/43 T2/143

14 :T1/1 T2/1 T2/2 T1/2 T2/3 T2/4 T2/5 T2/6 T1/3 T1/4 T1/5 T2/7 T2/43 T1/6

14 :T1/1 T2/1 T1/2 T1/3 T2/2 T1/4 T1/5 T1/6 T2/3 T1/7 T1/42 T2/4 T1/142 T2/5

14 :T2/1 T1/1 T2/2 T1/2 T1/3 T2/3 T2/4 T1/4 T2/5 T2/6 T2/7 T2/43 T1/5 T2/143

14 :T1/1 T1/2 T1/3 T1/4 T1/5 T1/6 T1/7 T1/42 T1/142 T2/1 T2/2 T1/242 T2/3 T2/4

14 :T2/1 T2/2 T2/3 T1/1 T2/4 T1/2 T2/5 T1/3 T2/6 T1/4 T2/7 T1/5 T2/43 T2/143

so, yes, you are sometimes shifting off the end of an exhausted array.

[Prior Nacre V]

All exceptions occur when T2/7 is output before T1/7.

You are checking that @t1 is not empty, but not @t2.

Changing the final ternary operator expression to : @t2 ? \@t2 : \@t1 fixes this.

[BrowserUk]

Produce a function that: passed two arrays (or array refs) returns an AoA containing all possible sequences of the two input arrays according to the "random pick - values in sequence" specified in the OP.

Rules: Strict + warnings. Array contents can be anything.

Entries that take longer than an hour to run for input arrays of 100 10 elements (184756 sequences) each are disqualified:)

See thospel's post for the reason for the rule change. It's still an interesting problem to solve, even without golfing it.

[thospel]

There will be C(m+n,n) solutions, so for two 100 element input arrays that's 9e58 solutions, to be generated in one hour. I think I need to upgrade my computer.

[BrowserUk]

Geez! I knew it was getting big pretty quickly but I only needed to know up as far as 7x7 (3432) so I didn't generate it any further. I had no idea that it would get that big. Thanks for the formula.

[gaal]

First, for the original problem, there's the trivial solution of (@t1, @t2) because "fairness is not a consideration".

More seriously, if we add the contraint of both lists having the same size in the second problem, all we need to do is to enumerate all binary numbers from zero to 2 ** size of one of the lists. A zero numeral means take from t1, a one means take from t2. This is pretty fast.

Now to extend it for differently sized lists, you can just do the same but kill disqualifying members later. Probably no longer fastest, but the code would be golf fodder.

Update: That's all wrong, as BrowserUk points out.

[BrowserUk]

First, for the original problem, there's the trivial solution of (@t1, @t2) because "fairness is not a consideration".

Nice:) Of course, generally speaking random implies unpredictable. The fairness bit was to indicate that not all possible sequences need have the same chance of being produced--but it should at least be possible that every sequence could be produced.

enumerate all binary numbers from zero to 2 ** size of one of the lists

I'm not sure I understand this? If we start with the trivial case of 2 lists of 2 elements. 2**2 = 4; enumerate the binary digits from 0 .. 4 gives:

000
001
010
011
100

Five numbers; 15 digits; 5 '1's and 10 '0's.

I can't see how that helps to produce the 6 sequences?

P:\test>395791 -N=2
1 2 a b
1 a 2 b
1 a b 2
a 1 2 b
a 1 b 2
a b 1 2
6

[thospel]

I think it actually gets easier if you try to be fair since a fair method would never select from an empty array. So you'd get:

my @seq = map rand(@t1+@t2) < @t1 ? shift @t1 : shift @t2, 1..@t1+@t2;