#! perl -slw use strict; my $n = <>; my %counts; ++$counts{ $_ } for split ' ', do{ local $/, <> }; my @sorted = sort{ $counts{$b} <=> $counts{$a} }keys %counts; my( $i, $min, $total ) = (0) x 3; ++$min while ( $total += $counts{ $sorted[ $i++ ] } ) < $n; print $min+1; print for @sorted[ 0 .. $min ]; [download] Tests: C:\test>SpotifyComp.pl 4 1009 2000 1009 2001 1002 2002 1003 2002 ^Z 2 2002 1009 C:\test>SpotifyComp.pl 2 1009 2011 1017 2011 ^Z 1 2011 [download] Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error. "Science is about questioning the status quo. Questioning authority". In the absence of evidence, opinion is indistinguishable from prejudice.

Actual:

> SpotifyComp.pl 4 1009 2000 1008 2001 1002 2002 1003 2002 ^D 3 2002 1002 1009 [download]

Expected:

3 2002 1008 or 2001 1009 or 2000 [download]

Cool. It's also a lot faster than my version. [rml@box current]$ time perl BrowserUK.pl sample-input.txt 2 2002 1009 real 0m0.006s user 0m0.002s sys 0m0.004s [rml@box current]$ time perl rml.pl sample-input.txt 2 1009 2002 real 0m0.028s user 0m0.023s sys 0m0.003s [download] -- C-x C-c

Cool. It's also a lot faster than my version. Yes. But unfortunately, fatally flawed. I should never try to assess the inherent complexity of a task when approaching my personal shutdown time :) Nor take example solutions as sufficient tests. That said, the fix to the approach doesn't seem to be too complicated, though I haven't coded it yet, so that thought might come back to bite me. Maybe I'll get to it once I cleared the non-optional tasks of my day. Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error. "Science is about questioning the status quo. Questioning authority". In the absence of evidence, opinion is indistinguishable from prejudice.

Here's my second attempt: #! perl -slw use strict; my $n = <>; my %pairings; push( @{ $pairings{ $_->[0] } }, $_->[1] ), push( @{ $pairings{ $_->[1] } }, $_->[0] ), while @{ $_ = [ split ' ', <> ] }; my $total = 0; my @guests; while( $total < $n ) { my $next = ( sort{ @{ $pairings{ $b } } <=> @{ $pairings{ $a } } } keys %pairings )[ 0 ]; push @guests, $next; $total += @{ $pairings{ $next } }; delete $pairings{ $_ } for @{ delete $pairings{ $next } }; } print scalar @guests; print for @guests; [download] It is still incomplete in that it doesn't yet favour employee 1009 in the event of their being an equally valid choice. I'll think about how to do that whilst I try to find an example that breaks it. (Generating random datasets is quite easy; verifying the answers produced not so:( ) Update: Added code to favour 1009: #! perl -slw use strict; my $n = <>; my %pairings; push( @{ $pairings{ $_->[0] } }, $_->[1] ), push( @{ $pairings{ $_->[1] } }, $_->[0] ), while @{ $_ = [split ' ', <> ] }; my $total = 0; my @guests; while( $total < $n ) { my( $best, $next ) = ( sort{ @{ $pairings{ $b } } <=> @{ $pairings{ $a } } } keys %pairings )[ 0, 1 ]; $best = $next if $next == 1009 and @{ $pairings{ $best } } == @{ $pairings{ $next } }; push @guests, $best; $total += @{ $pairings{ $best } }; delete $pairings{ $_ } for @{ delete $pairings{ $best } }; } print scalar @guests; print for @guests; [download] Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error. "Science is about questioning the status quo. Questioning authority". In the absence of evidence, opinion is indistinguishable from prejudice.

Always choosing the best-connected remaining node isn't always the best strategy. Consider the following problem set: 20 1001 2000 1002 2000 1009 2000 1011 2010 1012 2010 1013 2010 1021 2020 1022 2020 1023 2020 1031 2030 1032 2030 1033 2030 1041 2040 1042 2040 1043 2040 1100 2000 1100 2010 1100 2020 1100 2030 1100 2040 [download] Draw it out as a graph, and it's obvious that the least number of delegates required is 5.

Attempt 3: #! perl -slw use strict; use Algorithm::Combinatorics qw[ combinations ]; my $favourite = 1009; my $n = <>; my %pairings; push( @{ $pairings{ $_->[0] } }, $_->[1] ), push( @{ $pairings{ $_->[1] } }, $_->[0] ), while @{ $_ = [split ' ', <> ] }; my @ids = keys %pairings; my %idPos; @idPos{ @ids } = 0 .. @ids; my %posId; @posId{ values %idPos } = keys %idPos; my @masks; for my $id ( @ids ) { $masks[ $idPos{ $id } ] = ''; vec( $masks[ $idPos{ $id } ], $idPos{ $id }, 1 ) = 1; vec( $masks[ $idPos{ $id } ], $idPos{ $_ }, 1 ) = 1 for @{ $pairings{ $id } }; } my @hits; for my $k ( 1 .. $n ) { my $iter = combinations( [0 .. $#ids], $k ); while( my $c = $iter->next ) { my $ored = ''; $ored |= $masks[ $_ ] for @$c; my $count = unpack '%32b*', $ored; push @hits, [ $k, @$c ] if $count >= @ids; } last if @hits; } if( @hits > 1 ) { @hits = sort{ $a->[0] <=> $b->[0] } @hits; my $min = $hits[0][0]; my $i = $#hits; --$i while $hits[ $i ][0] > $min; $#hits = $i; if( @hits > 1 ) { my $first = $hits[ 0 ]; @hits = grep { scalar grep{ $posId{ $_ } == $favourite; } @$_[ 0 .. $#{ $_ } ]; } @hits; @hits = @hits >= 1 ? $hits[ 0 ] : $first; } } print @{ $hits[0] } -1; print $posId{ $_ } for @{ $hits[0] }[ 1 .. $#{ $hits[ 0 ] } ]; [download] A run: C:\test>Bilateral2.pl 20 1001 2000 1002 2000 1009 2000 1011 2010 1012 2010 1013 2010 1021 2020 1022 2020 1023 2020 1031 2030 1032 2030 1033 2030 1041 2040 1042 2040 1043 2040 1100 2000 1100 2010 1100 2020 1100 2030 1100 2040 ^Z 5 2020 2030 2000 2010 2040 [download] Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error. "Science is about questioning the status quo. Questioning authority". In the absence of evidence, opinion is indistinguishable from prejudice.

Actual:

> Bilateral2.pl 7 71 34 71 1001 72 1002 73 1003 1001 2000 1002 2000 1003 2000 ^D 3 1002 71 1003 [download]

Expected:

4 1001 1002 1003 71 or 34 [download]

Some notes below your chosen depth have not been shown here

Nice example! Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error. "Science is about questioning the status quo. Questioning authority". In the absence of evidence, opinion is indistinguishable from prejudice.

You're right, thanks. Rewriting... -- C-x C-c

NOTE: The solution below is incorrect. Please refer to the latest attempt instead.



Here's my shot at it:

use List::Util qw(reduce); my (@teams, %emp); my $n = <>; for my $i (0 .. $n - 1) { my ($e1, $e2) = (split ' ', scalar <>); push @{ $emp{$e1} }, $i; push @{ $emp{$e2} }, $i; $teams[$i] = 1; } my @picks; sub pick { my $pick = shift; push @picks, $pick; $teams[$_] = 0 for @{ $emp{$pick} }; delete $emp{$pick}; } my @favorites = (1002, 2001); $emp{$_} and pick($_) for @favorites; while (1) { my $max = reduce { $a->[1] > $b->[1] ? $a : $b } map [ $_ => scalar(grep $teams[$_], @{ $emp{$_} }) ], keys %emp; my ($winner, $cnt) = @{ $max }; last if $cnt == 0; pick($winner); } local $\ = "

"; print scalar(@picks); print for @picks; [download]

Update: Now with favorites!

I think you're over favouring. Fed this set: 10 1001 2002 1003 2002 1003 2005 1003 2005 1005 2002 1005 2002 1008 2002 1009 2005 1010 2002 1010 2002 [download] Yours outputs: 3 1009 2002 1003 [download] where this is possible and (to my interpretation of the rules) therefore better: 2 2002 2005 [download] Mine's broken in the reverse way in that it ignores (actually, doesn't even consider), equally valid solutions that would use the favoured employee. Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error. "Science is about questioning the status quo. Questioning authority". In the absence of evidence, opinion is indistinguishable from prejudice.

Thanks :) I attempted again given what you said, also considering the eye-opener that argggh pointed out. I tried hard using some comparison heuristic approach before resigning to the fact that this is really a combinatorial problem.