Rafting Problem (Knapsack variant)
Haskell 226 228 234 268 bytes
Naive answer in Haskell
import Data.List
o=map
u=sum
p=foldr(\x t->o([x]:)t++[(x:y):r|(y:r)<-t>>=permutations])[[]]
m x=foldl(\[m,n]x->[m+(x-m)/(n+1),n+1])[0,0]x!!0
a!z=abs$u z-a
s t=(length t,u$o((m$o u t)!)t)
a n=head.sortOn s.filter(all$(<=n).u).p
Or ungolfed
partition' :: [a] -> [[[a]]]
partition' [] = [[]]
partition' (x:xs) = [[x]:ps | ps <- partition' xs]
++ [(x:p):rest | ps <- partition' xs, (p:rest) <- permutations ps]
-- from Data.Statistics
mean :: [Double] -> Double
mean xs = fst $ foldl (\(m, n) x -> (m+(x-m)/n+1, n+1)) (0, 0) xs
diff :: Double -> [Double] -> Double
diff avg xs = abs $ sum xs - avg
rawScore :: [[Double]] -> Double
rawScore xs = sum . map (diff avg) $ xs where avg = mean . map sum $ xs
score :: [[Double]] -> (Int, Double)
score xs = (length xs, rawScore xs)
-- from Data.Ord
comparing :: (Ord b) => (a -> b) -> a -> a -> Ordering
comparing p x y = compare (p x) (p y)
candidates :: Double -> [Double] -> [[[Double]]]
candidates n xs = filter (all (\ ys -> sum ys <= n)) . partition' $ xs
answer :: Double -> [Double] -> [[Double]]
answer n xs = minimumBy (comparing score) $ candidates n xs
With some test cases
import Text.PrettyPrint.Boxes
testCases :: [(Double, [Double])]
testCases = [(6 , [2,5])
,(4 , [1,1,1,1,1])
,(6 , [2,3,2])
,(6 , [2,3,2,3])
,(6 , [2,3,2,3,2])
,(12, [10,8,6,4,2])
,(6 , [4,4,4])
,(12, [12,7,6,6])]
runTests tests = transpose
$ ["n", "Bookings", "Output"]
: map (\(n, t) -> [ show . floor $ n
, show . map floor $ t
, show . map (map floor) $ a n t]) tests
test = printBox
. hsep 3 left . map (vcat top) . map (map text) . runTests $ testCases
Where test
yields
n Bookings Output
6 [2,5] [[2],[5]]
4 [1,1,1,1] [[1,1],[1,1,1]]
6 [2,3,2] [[2,2],[3]]
6 [2,3,2,3] [[2,3],[2,3]]
6 [2,3,2,3,2] [[2,2,2],[3,3]]
12 [10,8,6,4,2] [[10],[8,2],[6,4]]
6 [4,4,4] [[4],[4],[4]]
12 [12,7,6,6] [[12],[7],[6,6]]
Edit
Thanks to @flawr and @nimi for advice.
Squashed p
a bit.
Shaved off a couple bytes.
Perl 6, 163 158 bytes
{[grep $^n>=*.all.sum,map ->\p{|map {p[0,|$_ Z..^|$_,p]},(1..^p).combinations},$^s.permutations].&{.grep: .map(+*).min}.min({.map((*.sum-$s.sum/$_)**2).sum})}
Try it online!
How it works
map ->\p{|map {p[0,|$_ Z..^|$_,p]},(1..^p).combinations},$^s.permutations
Generates all possible partitions of all permutations of the input array.
grep $^n>=*.all.sum,
Filters the ones where no raft is overbooked.
.&{.grep: .map(+*).min}
Filters the ones where the number of rafts is minimal.
.min({.map((*.sum-$s.sum/$_)**2).sum})}
Gets the first one with minimal ∑(nx-a)2.
-4 bytes thanks to @Pietu1998