You are creating a long ruler, with physical lengths marked off according to the weight of each ship's initiative. You throw a stone randomly on the ruler, and whoever owns the area it lands in, wins the draw. That is a fine algorithm, but here is one might suit you better.

You, me, and Dupree each have ships - yours is 25 powerful, mine is 15, and Dupree's is 60.

1. Make index cards for each of us, writing our names and power levels on each card.
2. Total up all the power levels, and stack up the cards.
   (Conveniently, it adds up to 100, but this works with any total.)
3. Roll a 100-sided (or whatever_the_total_is-sided) die. This time, we roll 41.
4. Leaf through the cards, summing as you go. When your sum exceeds your rolled number, stop on that card.
   • No card - 0; sum = 0; less than 41 -> continue
   • You - 25; sum = 25; less than 41 -> continue
   • Me - 15; sum = 40; less than 41 -> continue
   • Dupree - 60; sum = 100; greater than 41 -> Stop! Dupree wins the draw.

Note that this technique works with real (non-integer) values (we do not round off the result of rand()), and works without having to sort the cards. Sorting in a descending order could yield a *slightly* faster search, depending on the distribution of values. In fact, if you are building the card deck few enough times, and scanning it many times, and never changing the values, you can speed it up even more by writing the running total on each card. This does not match your use-case, though.

I rely on other, less-sleepy monks to warn if I have an off-by-one error, or have completely botched the weighted implementation.
Completely untested code:

use List::Util qw( sum );

sub simulate_mayhem {
    my @shipsInCombat = @_;

    # Initiative levels for each ship.
    # This is a parallel array to @shipsInCombat.
    my @ship_initiatives = map {
        $_->{thruster} * 2  +  1;
    } @shipsInCombat;
    
    while ( my $total_initiative = sum @ship_initiatives ) {
    
        my $chosen_initiative = rand $total_initiative;
        my $initiative_sum = 0;
        
        # Required - can't use the loop var after the loop
        # See PBP 6.9. Non-Lexical Loop Iterators
        my $chosen_ship_number;
    
        for my $ship_number ( 0 .. $#shipsInCombat ) {
            $initiative_sum += $ship_initiatives[$ship_number];
            next if $initiative_sum <= $chosen_initiative;
            $chosen_ship_number = $ship_number;
            last;
        }
        die "Can't happen" if not defined $chosen_ship_number;
        my $chosen_ship = $shipsInCombat[$chosen_ship_number];
    
        ship_does_something($chosen_ship);
    
        # Now reduce that ship to 0, so it cannot be picked again.
        $ship_initiatives[$chosen_ship_number] = 0;
        
        # If you want, you can recalculate {thruster} on any ship
        # affected by ship_does_something(), as long as you have a
        # way of tracking the ones that had used their initiative,
        # and force it back to 0.
        ### $ship_numbers_that_used_initiative{$chosen_ship_number} = 
+1;
        ### recalc_thrusters(\@shipsToAct);
        ### @ship_initiatives = map {
        ###     $_->{thruster} * 2  +  1;
        ### } @shipsInCombat;
        ### ship_initiatives[$_] = 0 for keys %ship_numbers_that_used_
+initiative;
    }
}
# Loop exits when all ships have 0 initiative.
[download]

It seems to me that the OP's algorithm is linear in the sum of the thrusters, while yours in quadratic in the number of ships. However, yours wins in memory usage, your memory usage is linear in the number ships, while the OPs algorithm needs memory linear in the sum of the thrusters.

But since the OP says it's just 1000 ships, most of them having a weight of less than 10, I doubt the OPs approach (or yours) should be much of a resource hog.

Did you roll your own shuffle, because List::Util has shuffle, which may very well be faster/more random for your shuffling.

The weighted draw has come up a few times over the years (I was looking at this b/c of some Secret Santa stuff I was doing and my mind wondered) - check out Efficiently selecting a random, weighted element. Since you are doing an exhaustive search, I'd think the small amount of processor time spent on spinning with your next is much cheaper than a histogram based solution would be (weight*rand). In any case, never forget Amdahl's Law: a little time spent improving that I/O will always do wonders.

When can I start losing hours of my life to Space Wars?

I did write it myself, mainly because it is trivially simple and O(n).


sub shuffle
{
    # Move each element to a random location
    my $arrayref = shift;
    
    my $temp;
    for (my $i = 0; $i < scalar @$arrayref; $i++)
    {
        my $r = rand( scalar @$arrayref);
        $temp = $arrayref->[$r];
        $arrayref->[$r] = $arrayref->[$i];
        $arrayref->[$i] = $temp;
    }
}
[download]

I do recall that day when all the weighted selection questions came out, but this one is somewhat unique in that every item must be selected... it is only the order of selection that needs to be randomized.

PS:
As far as playing the game, work is currently focused on a GUI and a web based auto-host. I'll let you know how it goes.

The fact that you needed to visit each element once is why I think your shuffle-and-shift approach is best, as opposed to the integrated thrust approach which has come up a couple times in this thread. The shuffle out of List:Util will scale the same as your implementation, but will likely have a lower constant and use less memory since it uses map in place of a for loop. I've also gotten admonished on using C-style for loops - maybe swap to for my $i (0 .. $#$arrayref) to reduce the bug risk.

If you do dig the the idea of picking weighted ships in place of the shuffle approach, you can swap it to O(n) (or actually O(n*m^2), where m is # of bins) by sorting and caching bounds, so you don't have to count up each ship. Maybe something like this:

my %shipToActBins = ();
foreach my $ship (@shipsInCombat) {
    # Add ship to initiative hash
    if (not exists $shipToActBins{$ship->{thruster}}) {
        $shipToActBins{$ship->{thruster}} = [];
    }
    push @{$shipToActBins{$ship->{thruster}}}, $ship;
}
my %weights = ();
for (keys %shipToActBins) {
    $weights{$_} = 2 * $_ + 1;
}
SHIP: for (0 .. $#shipsInCombat) {
    my $ship;
    my $sum = 0;
    my @bounds = ();

    for (sort keys %shipToActBins) {
        if (@{$shipToActBins{$_}} == 0) {
            delete ($shipToActBins{$_});
        } else {
            $sum += $weights{$_}*@{$shipToActBins{$_}};
            push @bounds, $sum;
        }
    }
    my $roll = int(rand($sum));

    CHOOSE: for (sort keys %shipToActBins) {
        if ($bounds[0] >= $roll) {
            $roll = int(($bounds[0] - $roll - 1)/$weights{$_});
            $ship = splice(@{$shipToActBins{$_}},$roll,1);
            last CHOOSE;
        } else {
            shift @bounds;
        }
    }
    #...
    #Simulated mayhem
    #...
}
[download]

As I understand this, for each "round", the weight for every ship is calculated, and then every ship is picked -- at random, biased by weight.

Using a weighted selection, this is O(n^2) in the number of ships. Using your shuffled ballots it's essentially linear in the number of ballots, which is some multiple of the number of ships. The downside of the ballots scheme being that the finer the gradation of ballots, the larger the multiple.

As the number of ships approaches 1,000, O(n^2) may become a pain. The only thing I can think of is a divide and conquer strategy, along the lines below. This code:

• includes a "simple" weighted selection implementation.

• and a "tree" implementation, which for more than 70-odd ships, constructs a form of tree selection structure, which does not slow down so quickly as the number of ships increases.

• supports weights to any grain, though it uses integer weights internally. Assumes weights are given as floating values, scaling to hundredths for processing. (This scaling is configurable.)

• allows the weight of ship(s) not yet selected to be adjusted.

• for 100 ships the tree runs slightly faster; at 200 ships it's nearly twice as fast; at 1,000 it is seven times faster.

That O(n^2) will get you, every time.

Read more... See the code (15 kB)

If you total the weights, pick a rand number between 0 and that total, and then scan the weights, subtracting each from the picked number until it drops below zero; the index of the weight at that point is the ship you want.

sub pick {
    my( $total, @weights ) = @_;
    my $rand = rand $total;
    ( $rand -= $weights[ $_ ] ) < 0
        and return $_ 
        for 0 .. $#weights;
}
[download]

This also works for real weights.

If the number of weights gets to be more than a few tens often, then switching the sub to take an array ref is simple.

And if the weights change frequently, you can do the totalling inside the sub also. I left it external for the test harness.

A little test harness to check it is fair:

#! perl -slw
use strict;
use List::Util qw[ sum ];

our $SHIPS ||= 10;
our $REPS ||= 1e5;

sub pick {
    my( $total, @weights ) = @_;
    my $rand = rand $total;
    ( $rand -= $weights[ $_ ] ) < 0
        and return $_ for 0 .. $#weights;
}

my @weights = map rand( 16 ), 1 .. $SHIPS;
my $total = sum @weights;

my @stats;
for ( 1 .. $REPS ) {
    ++$stats[ pick( $total, @weights ) ];
}

for ( 0 .. $#stats ) {
    printf "%2d: Expected: %6.3f%% Actual: %6.3f%%\n",
        $_,
        $weights[ $_ ] *100 / $total,
        $stats[ $_ ] *100 / $REPS;
}
print sum( @stats ) *100 / $REPS, '%' ;
[download]

Gives:

C:\test>junk6 -SHIPS=4 -REPS=1e5
 0: Expected: 16.519% Actual: 16.604%
 1: Expected: 14.400% Actual: 14.466%
 2: Expected: 51.934% Actual: 51.844%
 3: Expected: 17.147% Actual: 17.086%
100%

C:\test>junk6 -SHIPS=20 -REPS=1e5
 0: Expected:  2.126% Actual:  2.103%
 1: Expected:  6.746% Actual:  6.834%
 2: Expected:  0.847% Actual:  0.825%
 3: Expected:  4.063% Actual:  4.133%
 4: Expected:  4.473% Actual:  4.412%
 5: Expected:  6.020% Actual:  6.079%
 6: Expected:  2.758% Actual:  2.727%
 7: Expected:  5.133% Actual:  5.055%
 8: Expected:  4.221% Actual:  4.215%
 9: Expected:  0.189% Actual:  0.191%
10: Expected:  2.151% Actual:  2.171%
11: Expected:  9.417% Actual:  9.511%
12: Expected:  5.079% Actual:  5.148%
13: Expected:  6.905% Actual:  7.080%
14: Expected:  9.644% Actual:  9.539%
15: Expected:  6.291% Actual:  6.266%
16: Expected:  1.084% Actual:  1.073%
17: Expected:  7.653% Actual:  7.578%
18: Expected:  9.065% Actual:  9.043%
19: Expected:  6.133% Actual:  6.017%

C:\test>junk6 -SHIPS=2 -REPS=1e2
 0: Expected: 92.414% Actual: 96.000%
 1: Expected:  7.586% Actual:  4.000%
100%

C:\test>junk6 -SHIPS=2 -REPS=1e2
 0: Expected: 56.789% Actual: 55.000%
 1: Expected: 43.211% Actual: 45.000%
100%
[download]

If I understand you correctly, this would require a recalculation of the @weights and $total after each pick in order to avoid getting the same pick repeatedly.

The trick in this particular question is that every choice must be picked once, and only the order is important.

this would require a recalculation of the @weights and $total after each pick in order to avoid getting the same pick repeatedly

Yes, but:

1. Recalculating the total is: $total -= $weights[ $pick ]; which is hardly onerous.
2. Recalculating @weights is just: $weights[ $pick ] = 0;

   If you set the weight of the previous pick to 0, it'll never get picked again.

So, to pick them all in a random order, you pick the first, subtract its weight from the total, set it weight to 0 and pick again. Repeat for N:

sub pickAll{
    my @weights = @_;
    my $total = sum @weights;
    my @order;
    for( 0 .. $#_ ) {
        my $pick = pick( \@weights, $total );
        push @order, $pick;
        $total -= $weights[ $pick ];
        $weights[ $pick ] = 0;
    }
    return @order;
}
[download]

Putting it all together you get:

#! perl -slw
use strict;
use List::Util qw[ sum ];

our $SHIPS ||= 10;
our $REPS ||= 1e5;

sub pick {
    my( $weights, $total ) = @_;
    my $rand = rand $total;
    ( $rand -= $weights->[ $_ ] ) < 0 
        and return $_ for 0 .. $#$weights;
}

sub pickAll{
    my @weights = @_;
    my $total = sum @weights;
    my @order;
    for( 0 .. $#_ ) {
        my $pick = pick( \@weights, $total );
        push @order, $pick;
        $total -= $weights[ $pick ];
        $weights[ $pick ] = 0;
    }
    return @order;
}

my @weights = map rand( 16 ), 1 .. $SHIPS;
print "$_ : $weights[ $_ ]" for 0 .. $#weights;

my $total = sum @weights;

print "\n";

print join ' ', pickAll( @weights ) for 1 .. $REPS;
[download]

I just spent a couple of hours trying to work out how to demonstrate that this results in a properly weighted distribution, but it's beyond me today. But by cherry picking a couple of runs, I think you can see it at work:

In this run you can see that ship 1 has a much lower weighting whilst the other three are very similar. With the result that the first ships 0,2 & 3 are pretty evenly distributed in the first 3 places, and ship 1 is (almost) always picked last:

C:\test>WeightedPick.pl -SHIPS=4 -REPS=30
0 : 14.4176797792315
1 : 1.80334489420056
2 : 14.493153475225
3 : 14.258566647768

3 2 0 1
3 0 2 1
0 3 2 1
0 3 1 2
0 3 2 1
0 2 3 1
3 2 0 1
0 2 3 1
3 0 2 1
1 0 3 2
3 2 0 1
3 0 2 1
0 3 2 1
3 0 2 1
3 0 2 1
0 2 3 1
3 1 2 0
2 3 0 1
2 0 3 1
3 2 0 1
0 3 2 1
2 3 0 1
3 0 2 1
3 2 0 1
2 3 0 1
2 3 1 0
3 0 2 1
0 2 1 3
3 2 0 1
0 2 3 1
[download]

In this run, ship 3 is weighted roughly twice ship 1 which is roughly twice ship 2; whilst ship 0 is almost not there. With the result that the first two picks are mostly 1s and 3s; the 3rd pick is mostly 2s and the last pick mostly 0s:

C:\test>WeightedPick.pl -SHIPS=4 -REPS=30
0 : 0.762649480253458
1 : 10.0145217105746
2 : 6.81761548668146
3 : 15.7317210100591

1 3 2 0
1 2 3 0
2 1 3 0
3 1 2 0
3 2 1 0
2 1 3 0
3 1 2 0
1 3 2 0
3 1 2 0
1 2 3 0
1 3 2 0
1 3 2 0
3 1 2 0
1 3 2 0
1 3 2 0
2 1 3 0
2 3 1 0
1 3 2 0
3 1 2 0
2 3 1 0
2 3 1 0
1 2 3 0
3 1 2 0
3 1 2 0
2 3 1 0
3 1 2 0
2 3 1 0
1 3 0 2
3 1 2 0
3 1 2 0
[download]

If any of the math gurus want to show me how to check the distributions arithmetically, I'm all ears :)

Also, I think the big-O rating is: O( 2n + n(n-1)/4 ). Can anyone verify that for me?

---

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.

"Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."