I actually don't think I'd like an all-popular-vote system — I think it'd allow politicians to slice up the country into ideological interest groups rather than making them have some kind of breadth of appeal. Though I do think it'd be good if the number of electoral votes a state got was tied to the number of people who actually turned out to vote, so that you could actually make a difference in a state like the one in which I used to live (Texas) by not voting.

--

You didn't get to the part about the bad side.

Subsitute North Carolina (15) for Virginia.
__
Sommerhus til salg, første række til Kattegat.

assuming everyone either votes for the candidate or the same opponent. <sticks tongue out>

--

but I think the discrepency might be what I am considering a majority. I am taking it to basically be 50% of voters rather than rounding up to the nearest 1000

why sit, when you can sit and swivel with The Ab-Swiveller^TM

--

Written in Haskell. {-

   MICRO-MINI-PFC: ELECTORAL-COLLEGE-BLASTER! 
   Solution for Tom Moertel <tom@moertel.com>

   $Id: pfc-20041006-tgm.hs,v 1.4 2004/10/07 21:43:22 thor Exp $

   Task: http://www.hulver.com/scoop/story/2004/10/6/112537/693
  

GOAL

Find the smallest percentage of the voting population that could vote
for a candidate and still reach 270 electoral votes.  More formally:

  Minimize    Sum_s[ v_s * min_majority_s ]
  Subject to  Sum_s[ v_s * ec_votes_s ] >= 270
  Where       v_s = 1 if candidate wins state s; 0, otherwise
              min_majority_s = fewest voters needed to win state
              ec_votes_s = electoral college votes that state provides

  Result:     Sum_s[ v_s * min_majority_s ] / Sum_s[ pop_s ]



ASSUMPTIONS

We assume that all voters will turn out to vote for one of two
candidates.  Thus a candidate needs half of a state's votes plus one
to carry the state.


DISCUSSION

The brute-force approach requires trying all 2^50 possible solutions
and choosing the one that minimizes the sum of voters for our
candidate.  At about 1.1 trillion trials, that approach seems
impractical.  So, we must try something else.

Fortunately, our problem lends itself to dynamic programming (and is
in-fact isomorphic to the 0-1 knapsack problem).  If we have an
optimal solution for V=X electoral-college votes, we can remove the
most expensive state from that solution to yield another optimal
solution for some smaller V=Y, Y<X.

The method used is the reverse of the above removal process.  To yield
an optimum solution for some number of e-c votes V=X, we start by
finding the optimal solutions for V=0, and then V=1, and so on up to
V=X.  At each step, we consider each of the unused states to see if we
can add it to some previous solution to yield a better solution than
we already have for the current value of V.  If so, it becomes our
best solution so far. We continue until the remaining states have been
processed.  At that point, we have the optimum solution for the given
value of V.  Then we increase V and repeat until we reach V=X.


USAGE

$ ./pfc-20041006-tgm 270 < state-stats.txt

-}

module Main where

import Data.List
import Data.Char
import Data.Set
import Data.FiniteMap
import Numeric (showFFloat)
import System.Environment (getArgs)

data State              =  State { name         :: String
                                 , pop          :: Int
                                 , minMajority  :: Int
                                 , ecVotes      :: Int
                                 }
                           deriving (Show, Read, Eq, Ord)

data Soln               =  Soln  { states        :: Set State
                                 , totMaj        :: Int
                                 , totPop        :: Int
                                 , totEcv        :: Int
                                 }

main                    =  getArgs >>=
                           interact . readSolveAndShow . read . head

readSolveAndShow v
    | v > 0             =  showSolution
                        .  flip findMinWinSubset v
                        .  readStateStats
    | otherwise         =  const "Please specify > 0 target e-c votes\n"

readStateStats          =  map mkStatsEntry
                        .  groupsOf 3
                        .  map (filter isAlphaNum)
                        .  words

mkStatsEntry [st, ecv, population]
                        =  State { name         = st
                                 , pop          = pop_
                                 , minMajority  = mmaj_
                                 , ecVotes      = ecv_
                                 }
  where
    pop_                =  read population * 1000
    ecv_                =  read ecv
    mmaj_               =  (pop_ `div` 2) + 1
mkStatsEntry entry      =  error $ "Bogus state spec: " ++ join " " entry

groupsOf _ []           =  []
groupsOf n xs           =  take n xs : groupsOf n (drop n xs)

findMinWinSubset ss v   =  (,) ss . head . snd $
                           break ( \soln -> totEcv soln >= v ) $
                           concatMap (drop (v-1) . eltsFM) solns
  where
    solns               =  scanl optimum emptyOptima [1..]
    optimum optima ecv  =  foldl (improve ecv) optima ss

improve ecv optima s    =  let gap = ecv - ecVotes s in
                           if gap < 0 then optima
                           else case lookupFM optima gap of
                           Nothing ->
                               keepIfBetter (emptySoln `addState` s)
                           Just soln ->
                               if s `elementOf` states soln
                               then optima
                               else keepIfBetter $ soln `addState` s
  where
    keepIfBetter soln   =  addToFM_C better optima ecv soln
    better a b          =  if totMaj a < totMaj b then a else b

addState soln s         =  Soln { states = states soln `addToSet` s
                                , totMaj = totMaj soln + minMajority s
                                , totPop = totPop soln + pop s
                                , totEcv = totEcv soln + ecVotes s }

emptyOptima             :: FiniteMap Int Soln
emptyOptima             =  emptyFM

emptySoln               =  Soln emptySet 0 0 0

showSolution (allStates, soln)
                        =  "Candidate takes\n" ++ stateBlock
                        ++ "for " ++ show (totEcv soln)
                        ++ " electoral-college votes.\n"
                        ++ "A minimum of " ++ show totMaj_
                        ++ " votes are needed to take the states,\n"
                        ++ "representing " ++ pct ++ " percent "
                        ++ "of the popular vote (" ++ show allPop ++ ").\n\n"
                        ++ "Solution details:\n"
                        ++ unlines (map show states_)
  where
    pct                 =  flip (showFFloat (Just 3)) "" $
                           100.0 * fromIntegral totMaj_ / fromIntegral allPop
    allPop              =  sum (map pop allStates)
    totMaj_             =  totMaj soln
    stateBlock          =  unlines . map (("    "++) . join " ")
                        .  groupsOf 10 $ map name states_
    states_             =  setToList $ states soln

join                    =  (concat.) . intersperse

instance Show Soln where
    show (Soln ss tm tp ecv)
                        =  show (tm, tp, ecv, setToList ss)

-- Local Variables:
-- compile-command: "ghc -O2 -o pfc-20041006-tgm --make pfc-20041006-tgm.hs"
-- End:

--
Write Perl code? Check out LectroTest. Write markup-dense XML? Check out PXSL.

Here's what the results are for jacob's input data and a target of 270 electoral-college votes:

$ ./pfc-20041006-tgm 270 < state-stats.txt
Candidate takes
    ak al ar az co ct dc de hi ia
    id ks ky la ma md me mn mo ms
    mt nc nd ne nh nj nm ok or ri
    sc sd tn ut va vt wi wv wy
for 270 electoral-college votes.
A minimum of 63414539 votes are needed to take the states,
representing 22.175 percent of the popular vote (285979000).

Solution details:
State {name = "ak", pop = 700000, minMajority = 350001, ecVotes = 3}
State {name = "al", pop = 4631000, minMajority = 2315501, ecVotes = 9}
State {name = "ar", pop = 2750000, minMajority = 1375001, ecVotes = 6}
State {name = "az", pop = 5230000, minMajority = 2615001, ecVotes = 10}
State {name = "co", pop = 4468000, minMajority = 2234001, ecVotes = 9}
State {name = "ct", pop = 3317000, minMajority = 1658501, ecVotes = 7}
State {name = "dc", pop = 529000, minMajority = 264501, ecVotes = 3}
State {name = "de", pop = 800000, minMajority = 400001, ecVotes = 3}
State {name = "hi", pop = 1342000, minMajority = 671001, ecVotes = 4}
State {name = "ia", pop = 2941000, minMajority = 1470501, ecVotes = 7}
State {name = "id", pop = 1480000, minMajority = 740001, ecVotes = 4}
State {name = "ks", pop = 2761000, minMajority = 1380501, ecVotes = 6}
State {name = "ky", pop = 4098000, minMajority = 2049001, ecVotes = 8}
State {name = "la", pop = 4535000, minMajority = 2267501, ecVotes = 9}
State {name = "ma", pop = 6310000, minMajority = 3155001, ecVotes = 12}
State {name = "md", pop = 5467000, minMajority = 2733501, ecVotes = 10}
State {name = "me", pop = 1285000, minMajority = 642501, ecVotes = 4}
State {name = "mn", pop = 5005000, minMajority = 2502501, ecVotes = 10}
State {name = "mo", pop = 5718000, minMajority = 2859001, ecVotes = 11}
State {name = "ms", pop = 2908000, minMajority = 1454001, ecVotes = 6}
State {name = "mt", pop = 1006000, minMajority = 503001, ecVotes = 3}
State {name = "nc", pop = 8227000, minMajority = 4113501, ecVotes = 15}
State {name = "nd", pop = 677000, minMajority = 338501, ecVotes = 3}
State {name = "ne", pop = 1761000, minMajority = 880501, ecVotes = 5}
State {name = "nh", pop = 1281000, minMajority = 640501, ecVotes = 4}
State {name = "nj", pop = 8392000, minMajority = 4196001, ecVotes = 15}
State {name = "nm", pop = 2016000, minMajority = 1008001, ecVotes = 5}
State {name = "ok", pop = 3491000, minMajority = 1745501, ecVotes = 7}
State {name = "or", pop = 3613000, minMajority = 1806501, ecVotes = 7}
State {name = "ri", pop = 1012000, minMajority = 506001, ecVotes = 4}
State {name = "sc", pop = 4033000, minMajority = 2016501, ecVotes = 8}
State {name = "sd", pop = 810000, minMajority = 405001, ecVotes = 3}
State {name = "tn", pop = 5966000, minMajority = 2983001, ecVotes = 11}
State {name = "ut", pop = 2411000, minMajority = 1205501, ecVotes = 5}
State {name = "va", pop = 7324000, minMajority = 3662001, ecVotes = 13}
State {name = "vt", pop = 638000, minMajority = 319001, ecVotes = 3}
State {name = "wi", pop = 5479000, minMajority = 2739501, ecVotes = 10}
State {name = "wv", pop = 1849000, minMajority = 924501, ecVotes = 5}
State {name = "wy", pop = 568000, minMajority = 284001, ecVotes = 3}

--
Write Perl code? Check out LectroTest. Write markup-dense XML? Check out PXSL.

Here's an improved version of my earlier submission. It is slightly more efficient and handles a few corner cases that my earlier code didn't. (In particular, you can now solve for e-c vote targets of 0 and > the max possible.)

{-

   MICRO-MINI-PFC: ELECTORAL-COLLEGE-BLASTER! 
   Solution for Tom Moertel <tom@moertel.com>

   $Id: pfc-20041006-tgm.hs,v 1.5 2004/10/08 22:40:48 thor Exp $

   Task: http://www.hulver.com/scoop/story/2004/10/6/112537/693
  

GOAL

Find the smallest percentage of the voting population that could vote
for a candidate and still reach 270 electoral votes.  More formally:

  Minimize    Sum_s[ v_s * min_majority_s ]
  Subject to  Sum_s[ v_s * ec_votes_s ] >= 270
  Where       v_s = 1 if candidate wins state s; 0, otherwise
              min_majority_s = fewest voters needed to win state
              ec_votes_s = electoral college votes that state provides

  Result:     Sum_s[ v_s * min_majority_s ] / Sum_s[ pop_s ]



ASSUMPTIONS

We assume that all voters will turn out to vote for one of two
candidates.  Thus a candidate needs half of a state's votes plus one
to carry the state.


DISCUSSION

The brute-force approach requires trying all 2^51 possible solutions
and choosing the one that minimizes the sum of voters for our
candidate.  At about 2.2 trillion trials, that approach seems
impractical.  So, we must try something else.

Fortunately, our problem lends itself to dynamic programming (and is
in-fact isomorphic to the 0-1 knapsack problem).  If we have an
optimal solution for V=X electoral-college votes, we can remove the
most expensive state from that solution to yield another optimal
solution for some smaller V=Y, Y<X.

The method used to solve the 0-1 knapsack problem is the reverse of
the above removal process.  To yield an optimum solution for some
number of e-c votes V=X, we start by finding the optimal solutions for
V=0, and then V=1, and so on up to V=X.  At each step, we consider
each of the unused states to see if we can add it to some previous
solution to yield a better solution than we already have for the
current value of V.  If so, it becomes our best solution so far. We
continue until the remaining states have been processed.  At that
point, we have the optimum solution for the given value of V.  Then we
increase V and repeat until we reach V=X.

But there is a wrinkle.  Our problem differs from the classical 0-1
knapsack problem in one crucial way: For any V=X, we want to find the
least-costly states that give us at *least* X e-c votes, whereas in
the classical problem we want at *most* X.  For this reason, the
following code converts our original problem into a classical 0-1
knapsack problem by inverting it.  That is, we find the
*most-expensive* set of states that can be *removed* from the set of
all states to leave behind at least V=X e-c votes, and then we remove
those states to yield the final solution.


USAGE

$ ./pfc-20041006-tgm 270 < state-stats.txt

-}

module Main where

import Data.List
import Data.Char
import Data.Set
import Data.FiniteMap
import Numeric (showFFloat)
import System.Environment (getArgs)

data State              =  State { name         :: String
                                 , pop          :: !Int
                                 , minMajority  :: !Int
                                 , ecVotes      :: !Int
                                 }
                           deriving (Show, Read, Eq, Ord)

data Soln               =  Soln  { states        :: Set State
                                 , totMaj        :: !Int
                                 , totPop        :: !Int
                                 , totEcv        :: !Int
                                 }

main                    =  getArgs >>=
                           interact . readSolveAndShow . read . head

readSolveAndShow v
    | v >= 0            =  showSolution
                        .  flip findMinWinSoln v
                        .  readStateStats
    | otherwise         =  const "Please specify >= 0 target e-c votes\n"

readStateStats          =  map mkStatsEntry
                        .  groupsOf 3
                        .  map (filter isAlphaNum)
                        .  words

mkStatsEntry [st, ecv, population]
                        =  State st pop_ mmaj_ (read ecv)
  where
    pop_                =  read population * 1000
    mmaj_               =  (pop_ `div` 2) + 1
mkStatsEntry entry      =  error $ "Bogus state spec: " ++ join " " entry

groupsOf _ []           =  []
groupsOf n xs           =  take n xs : groupsOf n (drop n xs)

findMinWinSoln ss v     =  (ss, statesToSoln ss `minusSoln` maxLoseSoln)
  where
    v'                  =  case sum (map ecVotes ss) - v of
                               x | x < 0     -> error "No solution."
                                 | otherwise -> x
    Just maxLoseSoln    =  foldl optimum emptyOptima [0..v'] `lookupFM` v'
    optimum optima ecv  =  foldl (improve ecv) (initialize optima ecv) ss

initialize optima ecv   =  addToFM optima ecv $
                           lookupWithDefaultFM optima emptySoln (ecv-1)

improve ecv optima s    =  case lookupFM optima (ecv - ecVotes s) of
                           Nothing   -> optima
                           Just soln ->
                               if s `elementOf` states soln then optima
                               else keepIfBetter $ soln `addState` s
  where
    keepIfBetter soln   =  addToFM_C better optima ecv soln
    better a b          =  if totMaj a > totMaj b then a else b

addState soln s         =  Soln { states = states soln `addToSet` s
                                , totMaj = totMaj soln + minMajority s
                                , totPop = totPop soln + pop s
                                , totEcv = totEcv soln + ecVotes s }

emptyOptima             :: FiniteMap Int Soln
emptyOptima             =  emptyFM

emptySoln               =  Soln emptySet 0 0 0

setToSoln stateSet      =  statesToSoln (setToList stateSet)
statesToSoln ss         =  foldl addState emptySoln ss
minusSoln a b           =  setToSoln (states a `minusSet` states b)

showSolution (allStates, soln)
                        =  "Candidate takes " ++ show (length states_)
                        ++ " states\n" ++ stateBlock
                        ++ "for " ++ show (totEcv soln)
                        ++ " electoral-college votes.\n"
                        ++ "A minimum of " ++ show totMaj_
                        ++ " votes are needed to take the states,\n"
                        ++ "representing " ++ pct ++ " percent "
                        ++ "of the popular vote (" ++ show allPop ++ ").\n\n"
                        ++ "Solution details:\n"
                        ++ unlines (map show states_)
  where
    pct                 =  flip (showFFloat (Just 3)) "" $
                           100.0 * fromIntegral totMaj_ / fromIntegral allPop
    allPop              =  sum (map pop allStates)
    totMaj_             =  totMaj soln
    stateBlock          =  unlines . map (("    "++) . join " ")
                        .  groupsOf 10 $ map name states_
    states_             =  setToList $ states soln

join                    =  (concat.) . intersperse

instance Show Soln where
    show (Soln ss tm tp ecv)
                        =  show (tm, tp, ecv, setToList ss)

-- Local Variables:
-- compile-command: "ghc -O2 -o pfc-20041006-tgm --make pfc-20041006-tgm.hs"
-- End:

--
Write Perl code? Check out LectroTest. Write markup-dense XML? Check out PXSL.

Mr. Bush can get by with 44.730% of the popular vote and still be elected president. This is assuming that everybody can vote - you gave us only population stats, not voter stats.

My reasoning: Sort the states after decreasing (electoral votes / population) - this gives a listing of the states with the ones who gives the most votes per pop first. Then simply select one of this list incrementally until the number of electoral votes exceeds 270.

Since the auto-code-formatting sucks big time (at least when you're using an apocryphal programming language), I won't post the code here. Instead -> clicky

Incidentally, I'm quite sure this can't be the right answer, as I didn't find the problem v. hard ;-)
__
Sommerhus til salg, første række til Kattegat.

program VoterThingy;

uses
  SysUtils;

{$APPTYPE CONSOLE}

Type
RState = Record
  State: String[2];
  votes: Integer;
  Voters: Integer;
  VotesPerHead: Double;
  end;

AStateArray = Array [0..50] of RState;
ACHAArray = Array[1..34] of Boolean;

var
    StateArray: AStateArray;
    LeastVoters: Integer;

const
    FinsihingPost = 270;

function State(AState: String; AVotes: Integer; AVoters: Integer): RState;
begin
Result.State := AState;
Result.Votes := AVotes;
Result.Voters := AVoters;
Result.VotesPerHead := AVotes/AVoters;
end;

procedure MakeStateArray(AStateArray: Array of RState);
begin
Move(AStateArray[0], StateArray[0], 51 * Sizeof(RState));
end;

procedure SortStateArray(iLo, iHi: Integer);
var
  Lo, Hi: Integer;
  T: RState;
  Mid: Double;
begin
  Lo := iLo;
  Hi := iHi;
  Mid := StateArray[(Lo + Hi) div 2].VotesPerHead;
  repeat
    while StateArray[Lo].votesPerHead > Mid do Inc(Lo);
    while StateArray[Hi].votesPerHead < Mid do Dec(Hi);
    if Lo <= Hi then
    begin
      T := StateArray[Lo];
      StateArray[Lo] := StateArray[Hi];
      StateArray[Hi] := T;
      Inc(Lo);
      Dec(Hi);
    end;
  until Lo > Hi;
  if Hi > iLo then SortStateArray(iLo, Hi);
  if Lo < iHi then SortStateArray(Lo, iHi);
end;

procedure RecursiveFindLeast(StateIndex, CurrVotes, CurrAgVotes, CurrVoters: Integer; CHAArray: ACHAArray);
var
    WMVotes, WMVoters: Integer;
    i: Integer;
begin
WMVotes := CurrVotes + StateArray[StateIndex].Votes;
WMVoters := CurrVoters + StateArray[StateIndex].Voters;
if WMVoters < leastVoters then
    begin
    if StateArray[StateIndex].Votes + CurrVotes >= FinsihingPost then
        begin
        leastVoters := WMVoters;
        end
    else if StateIndex < High(StateArray) then
        begin
        RecursiveFindLeast(StateIndex + 1, WMVotes, CurrAgVotes, WMVoters, CHAArray);
        end;
    end;
if (StateIndex < High(StateArray)) and not CHAArray[StateArray[StateIndex].Votes] then
    begin
    for i := 0 to (34 - StateArray[StateIndex].Votes) do
        begin
        CHAArray[i + StateArray[StateIndex].Votes] := True;
        end;

    CHAArray[StateArray[StateIndex].Votes] := True;

    CurrAgVotes := CurrAgVotes + StateArray[StateIndex].Votes;
    if CurrAgVotes < FinsihingPost then
        begin
        RecursiveFindLeast(StateIndex + 1, CurrVotes, CurrAgVotes, CurrVoters, CHAArray);
        end
    else
        begin
        leastVoters := leastVoters;
        end;
    end;
end;

var
    TotalVotesCast: Integer;
    i: Integer;
    CHAArray: ACHAArray;

begin
MakeStateArray([State('al', 9,  4631),  State('ak', 3,  700),  State('az', 10, 5230),  State('ar', 6 , 2750),  State('ca', 55, 34441),
   State('co', 9,  4468),  State('ct', 7,  3317), State('de', 3 , 800) ,  State('dc', 3 , 529) ,  State('fl', 27, 16279),
   State('ga', 15, 8413),  State('hi', 4,  1342), State('id', 4 , 1480),  State('il', 21, 12266), State('in', 11, 6215) ,
   State('ia', 7,  2941),  State('ks', 6,  2761), State('ky', 8 , 4098),  State('la', 9 , 4535) , State('me', 4 , 1285) ,
   State('md', 10, 5467),  State('ma', 12, 6310), State('mi', 17, 9763),  State('mn', 10, 5005) , State('ms', 6 , 2908) ,
   State('mo', 11, 5718),  State('mt', 3,  1006), State('ne', 5 , 1761),  State('nv', 3 , 2070) , State('nh', 4 , 1281) ,
   State('nj', 15, 8392),  State('nm', 5,  2016), State('ny', 31, 18250), State('nc', 15, 8227) , State('nd', 3 , 677)  ,
   State('oh', 20, 11428), State('ok', 7,  3491), State('or', 7 , 3613),  State('pa', 21, 12281), State('ri', 4 , 1012) ,
   State('sc', 8,  4033),  State('sd', 3,  810) , State('tn', 11, 5966),  State('tx', 34, 21486), State('ut', 5 , 2411) ,
   State('vt', 3,  638),   State('va', 13, 7324), State('wa', 11, 6258),  State('wv', 5,  1849) , State('wi', 10, 5479) ,
   State('wy', 3,  568)]);

SortStateArray(0, High(StateArray));

TotalVotesCast := 0;
for i := 0 to High(StateArray) do
     begin
     Inc(TotalVotesCast, StateArray[i].Voters);
     end;

LeastVoters := TotalVotesCast;
RecursiveFindLeast(0, 0, 0, 0, CHAArray);

WriteLn(Format('Candidate wins with %f%% of the vote', [100 * LeastVoters/(TotalVotesCast*2)]));
end.

why sit, when you can sit and swivel with The Ab-Swiveller^TM

can be found at http://www.freepascal.org/

It has a couple of syntax variations compared to Delphi which is why the arrays are defined in the odd manner they are (to get it working ASAP after I originally wrote it in Delphi).

why sit, when you can sit and swivel with The Ab-Swiveller^TM

but a lot lot slower (twas a stupid bloody mistake), it gives the same (I believe correct) answer, but atleast there's less of a luck element involved.

program VoterThingy;

uses
  SysUtils;

{$APPTYPE CONSOLE}

Type
RState = Record
  State: String[2];
  votes: Integer;
  Voters: Integer;
  VotesPerHead: Double;
  end;

AStateArray = Array [0..50] of RState;
ACHAArray = Array[1..34] of Boolean;

var
    StateArray: AStateArray;
    LeastVoters: Integer;

const
    FinsihingPost = 270;

function State(AState: String; AVotes: Integer; AVoters: Integer): RState;
begin
Result.State := AState;
Result.Votes := AVotes;
Result.Voters := AVoters;
Result.VotesPerHead := AVotes/AVoters;
end;

procedure MakeStateArray(AStateArray: Array of RState);
begin
Move(AStateArray[0], StateArray[0], 51 * Sizeof(RState));
end;

procedure SortStateArray(iLo, iHi: Integer);
var
  Lo, Hi: Integer;
  T: RState;
  Mid: Double;
begin
  Lo := iLo;
  Hi := iHi;
  Mid := StateArray[(Lo + Hi) div 2].VotesPerHead;
  repeat
    while StateArray[Lo].votesPerHead > Mid do Inc(Lo);
    while StateArray[Hi].votesPerHead < Mid do Dec(Hi);
    if Lo <= Hi then
    begin
      T := StateArray[Lo];
      StateArray[Lo] := StateArray[Hi];
      StateArray[Hi] := T;
      Inc(Lo);
      Dec(Hi);
    end;
  until Lo > Hi;
  if Hi > iLo then SortStateArray(iLo, Hi);
  if Lo < iHi then SortStateArray(Lo, iHi);
end;

procedure RecursiveFindLeast(StateIndex, CurrVotes, CurrAgVotes, CurrVoters: Integer; CHAArray: ACHAArray);
var
    WMVotes, WMVoters: Integer;
    i: Integer;
begin
WMVotes := CurrVotes + StateArray[StateIndex].Votes;
WMVoters := CurrVoters + StateArray[StateIndex].Voters;
if WMVoters < leastVoters then
    begin
    if StateArray[StateIndex].Votes + CurrVotes >= FinsihingPost then
        begin
        leastVoters := WMVoters;
        end
    else if StateIndex < High(StateArray) then
        begin
        RecursiveFindLeast(StateIndex + 1, WMVotes, CurrAgVotes, WMVoters, CHAArray);
        end;
    end;
if (StateIndex < High(StateArray)) and not CHAArray[StateArray[StateIndex].Votes] then
    begin
    for i := 1 to (34 - StateArray[StateIndex].Votes) do
        begin
        CHAArray[i + StateArray[StateIndex].Votes] := CHAArray[i];
        end;

    CHAArray[StateArray[StateIndex].Votes] := True;

    CurrAgVotes := CurrAgVotes + StateArray[StateIndex].Votes;
    if CurrAgVotes < FinsihingPost then
        begin
        RecursiveFindLeast(StateIndex + 1, CurrVotes, CurrAgVotes, CurrVoters, CHAArray);
        end;
    end;
end;

var
    TotalVotesCast: Integer;
    i: Integer;
    CHAArray: ACHAArray;

begin
MakeStateArray([State('al', 9,  4631),  State('ak', 3,  700),  State('az', 10, 5230),  State('ar', 6 , 2750),  State('ca', 55, 34441),
   State('co', 9,  4468),  State('ct', 7,  3317), State('de', 3 , 800) ,  State('dc', 3 , 529) ,  State('fl', 27, 16279),
   State('ga', 15, 8413),  State('hi', 4,  1342), State('id', 4 , 1480),  State('il', 21, 12266), State('in', 11, 6215) ,
   State('ia', 7,  2941),  State('ks', 6,  2761), State('ky', 8 , 4098),  State('la', 9 , 4535) , State('me', 4 , 1285) ,
   State('md', 10, 5467),  State('ma', 12, 6310), State('mi', 17, 9763),  State('mn', 10, 5005) , State('ms', 6 , 2908) ,
   State('mo', 11, 5718),  State('mt', 3,  1006), State('ne', 5 , 1761),  State('nv', 3 , 2070) , State('nh', 4 , 1281) ,
   State('nj', 15, 8392),  State('nm', 5,  2016), State('ny', 31, 18250), State('nc', 15, 8227) , State('nd', 3 , 677)  ,
   State('oh', 20, 11428), State('ok', 7,  3491), State('or', 7 , 3613),  State('pa', 21, 12281), State('ri', 4 , 1012) ,
   State('sc', 8,  4033),  State('sd', 3,  810) , State('tn', 11, 5966),  State('tx', 34, 21486), State('ut', 5 , 2411) ,
   State('vt', 3,  638),   State('va', 13, 7324), State('wa', 11, 6258),  State('wv', 5,  1849) , State('wi', 10, 5479) ,
   State('wy', 3,  568)]);

SortStateArray(0, High(StateArray));

TotalVotesCast := 0;
for i := 0 to High(StateArray) do
     begin
     Inc(TotalVotesCast, StateArray[i].Voters);
     end;

LeastVoters := TotalVotesCast;
RecursiveFindLeast(0, 0, 0, 0, CHAArray);

WriteLn(Format('Candidate wins with %f%% of the vote', [100 * LeastVoters/(TotalVotesCast*2)]));
end.

why sit, when you can sit and swivel with The Ab-Swiveller^TM

It should be this even... I thought that was a abit slow.

program VoterThingy;

uses
  SysUtils;

{$APPTYPE CONSOLE}

Type
RState = Record
  State: String[2];
  votes: Integer;
  Voters: Integer;
  VotesPerHead: Double;
  end;

AStateArray = Array [0..50] of RState;
ACHAArray = Array[1..34] of Boolean;

var
    StateArray: AStateArray;
    LeastVoters: Integer;

const
    FinsihingPost = 270;

function State(AState: String; AVotes: Integer; AVoters: Integer): RState;
begin
Result.State := AState;
Result.Votes := AVotes;
Result.Voters := AVoters;
Result.VotesPerHead := AVotes/AVoters;
end;

procedure MakeStateArray(AStateArray: Array of RState);
begin
Move(AStateArray[0], StateArray[0], 51 * Sizeof(RState));
end;

procedure SortStateArray(iLo, iHi: Integer);
var
  Lo, Hi: Integer;
  T: RState;
  Mid: Double;
begin
  Lo := iLo;
  Hi := iHi;
  Mid := StateArray[(Lo + Hi) div 2].VotesPerHead;
  repeat
    while StateArray[Lo].votesPerHead > Mid do Inc(Lo);
    while StateArray[Hi].votesPerHead < Mid do Dec(Hi);
    if Lo <= Hi then
    begin
      T := StateArray[Lo];
      StateArray[Lo] := StateArray[Hi];
      StateArray[Hi] := T;
      Inc(Lo);
      Dec(Hi);
    end;
  until Lo > Hi;
  if Hi > iLo then SortStateArray(iLo, Hi);
  if Lo < iHi then SortStateArray(Lo, iHi);
end;

procedure RecursiveFindLeast(StateIndex, CurrVotes, CurrAgVotes, CurrVoters: Integer; CHAArray: ACHAArray);
var
    WMVotes, WMVoters: Integer;
    i: Integer;
begin
WMVotes := CurrVotes + StateArray[StateIndex].Votes;
WMVoters := CurrVoters + StateArray[StateIndex].Voters;
if WMVoters < leastVoters then
    begin
    if StateArray[StateIndex].Votes + CurrVotes >= FinsihingPost then
        begin
        leastVoters := WMVoters;
        end
    else if StateIndex < High(StateArray) then
        begin
        RecursiveFindLeast(StateIndex + 1, WMVotes, CurrAgVotes, WMVoters, CHAArray);
        end;
    end;
if (StateIndex < High(StateArray)) and not CHAArray[StateArray[StateIndex].Votes] then
    begin
    for i := 1 to (34 - StateArray[StateIndex].Votes) do
        begin
        CHAArray[i + StateArray[StateIndex].Votes] := CHAArray[i] or CHAArray[i + StateArray[StateIndex].Votes];
        end;

    CHAArray[StateArray[StateIndex].Votes] := True;

    CurrAgVotes := CurrAgVotes + StateArray[StateIndex].Votes;
    if CurrAgVotes < FinsihingPost then
        begin
        RecursiveFindLeast(StateIndex + 1, CurrVotes, CurrAgVotes, CurrVoters, CHAArray);
        end;
    end;
end;

var
    TotalVotesCast: Integer;
    i: Integer;
    CHAArray: ACHAArray;

begin
MakeStateArray([State('al', 9,  4631),  State('ak', 3,  700),  State('az', 10, 5230),  State('ar', 6 , 2750),  State('ca', 55, 34441),
   State('co', 9,  4468),  State('ct', 7,  3317), State('de', 3 , 800) ,  State('dc', 3 , 529) ,  State('fl', 27, 16279),
   State('ga', 15, 8413),  State('hi', 4,  1342), State('id', 4 , 1480),  State('il', 21, 12266), State('in', 11, 6215) ,
   State('ia', 7,  2941),  State('ks', 6,  2761), State('ky', 8 , 4098),  State('la', 9 , 4535) , State('me', 4 , 1285) ,
   State('md', 10, 5467),  State('ma', 12, 6310), State('mi', 17, 9763),  State('mn', 10, 5005) , State('ms', 6 , 2908) ,
   State('mo', 11, 5718),  State('mt', 3,  1006), State('ne', 5 , 1761),  State('nv', 3 , 2070) , State('nh', 4 , 1281) ,
   State('nj', 15, 8392),  State('nm', 5,  2016), State('ny', 31, 18250), State('nc', 15, 8227) , State('nd', 3 , 677)  ,
   State('oh', 20, 11428), State('ok', 7,  3491), State('or', 7 , 3613),  State('pa', 21, 12281), State('ri', 4 , 1012) ,
   State('sc', 8,  4033),  State('sd', 3,  810) , State('tn', 11, 5966),  State('tx', 34, 21486), State('ut', 5 , 2411) ,
   State('vt', 3,  638),   State('va', 13, 7324), State('wa', 11, 6258),  State('wv', 5,  1849) , State('wi', 10, 5479) ,
   State('wy', 3,  568)]);

SortStateArray(0, High(StateArray));

TotalVotesCast := 0;
for i := 0 to High(StateArray) do
     begin
     Inc(TotalVotesCast, StateArray[i].Voters);
     end;

LeastVoters := TotalVotesCast;
RecursiveFindLeast(0, 0, 0, 0, CHAArray);

WriteLn(Format('Candidate wins with %f%% of the vote', [100 * LeastVoters/(TotalVotesCast*2)]));
end.

why sit, when you can sit and swivel with The Ab-Swiveller^TM

occurred to me that the deadendarray could be a bit smarter in that say you had not picked a earlier (ie more voting powerper head) 15 Vote State but had picked a subsequent 10 vote state then you could also mark 5 vote states as being dead ends...

so this change reflects that

http://www.hulver.com/scoop-files/102/VoterThingy.dpr

why sit, when you can sit and swivel with The Ab-Swiveller^TM

Here's a python implementation.

It starts by calculating a cost for the electoral votes in each state and then sorts the list of states with the cheapest electoral votes first.

Then go through the list and add states until the number of electoral votes overshoot the goal. After that try to replace the last state added with the next one until we get as close to the goal as possible.

Here's the code:


state_populations = [
    ["al", 9,  4631],  ["ak", 3,  700],  ["az", 10, 5230],  ["ar", 6,  2750],  ["ca", 55, 34441],
    ["co", 9,  4468],  ["ct", 7,  3317], ["de", 3,  800],   ["dc", 3,  529],   ["fl", 27, 16279],
    ["ga", 15, 8413],  ["hi", 4,  1342], ["id", 4,  1480],  ["il", 21, 12266], ["in", 11, 6215],
    ["ia", 7,  2941],  ["ks", 6,  2761], ["ky", 8,  4098],  ["la", 9,  4535],  ["me", 4,  1285],
    ["md", 10, 5467],  ["ma", 12, 6310], ["mi", 17, 9763],  ["mn", 10, 5005],  ["ms", 6,  2908],
    ["mo", 11, 5718],  ["mt", 3,  1006], ["ne", 5,  1761],  ["nv", 3,  2070],  ["nh", 4,  1281],
    ["nj", 15, 8392],  ["nm", 5,  2016], ["ny", 31, 18250], ["nc", 15, 8227],  ["nd", 3,  677],
    ["oh", 20, 11428], ["ok", 7,  3491], ["or", 7,  3613],  ["pa", 21, 12281], ["ri", 4,  1012],
    ["sc", 8,  4033],  ["sd", 3,  810],  ["tn", 11, 5966],  ["tx", 34, 21486], ["ut", 5,  2411],
    ["vt", 3,  638],   ["va", 13, 7324], ["wa", 11, 6258],  ["wv", 5,  1849],  ["wi", 10, 5479],
    ["wy", 3,  568]]

needed = 270

# Calculates a relative cost for the electoral votes in the given state
def vote_cost(state):
    return 1.0 * state[1] / state[2];

# Sort the list with the least expensive states first
def expense_compare(s1, s2):
    if(s1[3] < s2[3]):
        return 1;
    return -1;

# Calculate the total number of votes
total_votes = 0;
for s in state_populations:
    total_votes += s[2]

# Extend the list of states with costs
map(lambda(s) : s.append(vote_cost(s)), state_populations)

# Sort with the cheapest state first
state_populations.sort(expense_compare)

electoral = 0
states = []
overshot = -1
for state in state_populations:
    if(electoral < needed):
        # Add cheap states until we overshoot the goal
        states.append(state)
        electoral += state[1]
    else:
        # See if we get a better match by removing the last state and adding this one
        last = states[len(states)-1]
        if(electoral - last[1] + state[1] >= needed):
            states.pop()
            states.append(state)
            electoral = electoral - last[1] + state[1]
    # If we get a perfect match we're done
    if(electoral == needed):
        break

# Calculate the votest needed to get these states
needed_votes = 0
for s in states:
    needed_votes += s[2]/2.0;

print "Found match with", electoral, "electoral votes in these states:"
for s in states:
    print s[0],

print "\nNeeds", needed_votes, "votes, i.e", (100.0*needed_votes/total_votes), "%"


The output produced is:


Found match with 270 electoral votes in these states:
dc wy vt nd ak ri de sd nh me mt hi ne wv id nm ia ar ks ct ut ms co ok mn la sc ky al or mo az ma tn md wi nc nj va
Needs 63414.5 votes, i.e 22.1745302977 %


; Copyright 2004 (c) Scott Dial <scott@scottdial.com>
; Greedy solution to the voting problem

(define state-populations
 '((al 9  4631)  (ak 3  700)  (az 10 5230)  (ar 6  2750)  (ca 55 34441)
   (co 9  4468)  (ct 7  3317) (de 3  800)   (dc 3  529)   (fl 27 16279)
   (ga 15 8413)  (hi 4  1342) (id 4  1480)  (il 21 12266) (in 11 6215)
   (ia 7  2941)  (ks 6  2761) (ky 8  4098)  (la 9  4535)  (me 4  1285)
   (md 10 5467)  (ma 12 6310) (mi 17 9763)  (mn 10 5005)  (ms 6  2908)
   (mo 11 5718)  (mt 3  1006) (ne 5  1761)  (nv 3  2070)  (nh 4  1281)
   (nj 15 8392)  (nm 5  2016) (ny 31 18250) (nc 15 8227)  (nd 3  677)
   (oh 20 11428) (ok 7  3491) (or 7  3613)  (pa 21 12281) (ri 4  1012)
   (sc 8  4033)  (sd 3  810)  (tn 11 5966)  (tx 34 21486) (ut 5  2411)
   (vt 3  638)   (va 13 7324) (wa 11 6258)  (wv 5  1849)  (wi 10 5479)
   (wy 3  568)))
  
(define (tocarry state)
 (+ (quotient (list-ref state 2) 2) 1))

(define (e-less? a b)
 (<
  (/ (tocarry a) (list-ref a 1))
  (/ (tocarry b) (list-ref b 1))
 ))

(define beststates (sort state-populations e-less?))

(define allvotes
 (let sum ((left beststates))
  (if (null? left)
   0
   (+ (list-ref (car left) 2) (sum (cdr left)))
  )))
 
(define (bestwin state-populations)
 (let ((beststates (sort state-populations e-less?))
       (allvotes
        (let sum ((left beststates))
         (if (null? left)
          0
          (+ (list-ref (car left) 2) (sum (cdr left)))
         )))
       (best
        (do
         ((curstate '(() 0 0) (car states))
          (states beststates (cdr states))
          (gotelec 0 (+ gotelec (list-ref curstate 1)))
          (gotpop 0 (+ gotpop (tocarry curstate)))
          (gotsts '() (append gotsts (list (list-ref curstate 0))))
         )
         ((> gotelec 270) (list gotelec gotpop gotsts))))
      )
 
  (display "Electoral Votes: ") (display (list-ref best 0)) (newline)
  (display "Popular Votes %: ") (display (* (/ (list-ref best 1) allvotes) 100)) (newline)
  (display "States: ") (map (lambda (s) (if (not (null? s)) (begin (display s) (display " ")))) (list-ref best 2)) (newline)
 ))

My code posts was stupid and lacks the "(bestwin state-populations)" call to allow you to just run it via "guile -s foo.ss" .. sorry..

Electoral Votes: 272

Popular Votes %: 22.3754191741352

States: dc wy vt nd ak ri de sd nh me hi mt ne wv id nm ia ar ks ct ut ms co ok mn la sc ky al or mo az ma tn md wi nc nj ga

; format: (state postal code, state electoral votes, state population in thousands)
(define state-populations
  '((al 9  4631)  (ak 3  700)  (az 10 5230)  (ar 6  2750)  (ca 55 34441)
    (co 9  4468)  (ct 7  3317) (de 3  800)   (dc 3  529)   (fl 27 16279)
    (ga 15 8413)  (hi 4  1342) (id 4  1480)  (il 21 12266) (in 11 6215)
    (ia 7  2941)  (ks 6  2761) (ky 8  4098)  (la 9  4535)  (me 4  1285)
    (md 10 5467)  (ma 12 6310) (mi 17 9763)  (mn 10 5005)  (ms 6  2908)
    (mo 11 5718)  (mt 3  1006) (ne 5  1761)  (nv 3  2070)  (nh 4  1281)
    (nj 15 8392)  (nm 5  2016) (ny 31 18250) (nc 15 8227)  (nd 3  677)
    (oh 20 11428) (ok 7  3491) (or 7  3613)  (pa 21 12281) (ri 4  1012)
    (sc 8  4033)  (sd 3  810)  (tn 11 5966)  (tx 34 21486) (ut 5  2411)
    (vt 3  638)   (va 13 7324) (wa 11 6258)  (wv 5  1849)  (wi 10 5479)
    (wy 3  568)))

(define (range lo hi)
  (cond
    [(= lo hi) '()]
    [else (cons lo (range (add1 lo) hi))]))

; this is a special memoize function tailored to the function below. It memoizes a
; function of two arguments, a number (<= the given n) and an eq-able value. Using
; this function means that there are at most 270*51 = 13770 possibilities
(define (memoize n f)
  (let ((ht-array (make-vector (add1 n))))
    (for-each (lambda (x) (vector-set! ht-array x (make-hash-table))) (range 0 (add1 n)))
    (lambda (n m)
      (let ((ht (vector-ref ht-array n)))
        (hash-table-get
         ht
         m
         (lambda ()
           (let ((ans (f n m)))
             (hash-table-put! ht m ans)
             ans)))))))

; f : listof state * number -> (union (list number (listof sym)) #f)
; given a list of states and a number of electoral votes needed, outputs the minimum population
; needed to vote for a particular candidate. #f indicates it's not possible.
(define min-votes-needed
  (memoize
   270
   (lambda (needed states)
     (cond
       [(and (null? states) (zero? needed)) (list 0 '())]
       [(and (null? states) (not (zero? needed))) #f]
       [else
        (let ((s (car states)))
          (let ((num-electoral-votes (cadr s))
                (population          (caddr s)))
            (let ([carries-the-state
                   (let ((x (min-votes-needed (max (- needed num-electoral-votes) 0) (cdr states))))
                     (cond
                       [x (list (+ (car x) (/ population 2)) (cons (car s) (cadr x)))]
                       [(>= num-electoral-votes needed) (list (/ population 2) (list (cadr x)))]
                       [else #f]))]
                  [loses-the-states (min-votes-needed needed (cdr states))])
              (if (and carries-the-state loses-the-states)
                  (if (< (car carries-the-state) (car loses-the-states))
                      carries-the-state
                      loses-the-states)
                  (or carries-the-state loses-the-states)))))]))))

--