ShoulderDaemon fucked around with this message at 23:25 on Jan 28, 2009

DontMockMySmock fucked around with this message at 18:17 on Jan 30, 2009

double[,] Reflux(double[,] array, int n) {
  int m = array.GetLength(0);

  double nRecip = 1.0 / (double)n;

  double[,] ret = new double[n, n];

  int inRow = 0;
  int outRow = 0;

  int size = m * n;

  while (inRow < m) {
    int d1 = (outRow + 1) * m - inRow * n;
    if (d1 <= 0) {
      ++ outRow;
    }
    else {
      double rowFactor = nRecip * (double)Math.Min(n, d1);
      int inCol = 0;
      int outCol = 0;
      while (inCol < m) {
        int d2 = (outCol + 1) * m - n * inCol;
        if (d2 <= 0) {
	  ++ outCol;
	}
	else {
	  double colFactor = nRecip * (double)Math.Min(n, d2);
	  ret[outRow, outCol] = rowFactor * colFactor * array[inRow, inCol];

	  ++ inCol;
	}
      }

      ++ inRow;
    }
  }

  return ret;
}

shrughes fucked around with this message at 03:29 on Jan 30, 2009

Get a bundle of imports out of the way.

> import Control.Monad.Identity
> import Control.Monad.List
> import Control.Monad.Reader
> import Control.Monad.State
> import Control.Monad.Writer
> import Data.List
> import qualified Data.Map as M

Assignments are tuples of integers and characters, values are integers.

> type Assignment = (Int, Char)
> type Value      = Int

We'll maintain maps of available assignments (that is, assignments which do not conflict with any existing assignment) to values.

> type AvailableAssignments = M.Map Assignment Value

The starting set of available assignments.

> topAvailable :: AvailableAssignments
> topAvailable = M.fromList
>   [ ((1, 'a'), 10), ((1, 'b'),  9), ((1, 'c'),  5)
>   , ((2, 'a'),  8), ((2, 'b'),  1), ((2, 'c'),  2)
>   , ((3, 'a'),  5), ((3, 'b'),  3), ((3, 'c'),  7)
>   ]

Backtracking search in ListT with global state, per-result list of assignments, and local available assignments.

> type Search a = WriterT [Assignment] (ReaderT AvailableAssignments (ListT (StateT Value (Identity)))) a

> runSearch :: Search a -> [(a, [Assignment])]
> runSearch s = runIdentity $ evalStateT (runListT $ runReaderT (runWriterT s) topAvailable) (-1)

Backtracking choice of available assignment.
We take the associations from the available assignments map, sort to maximize the value, then lift that list into our search monad.

> getAssignment :: Search (Assignment, Value)
> getAssignment = do
>   availableMap <- ask
>   let availableList = sortBy (\(a1, v1) (a2, v2) -> compare v2 v1) $ M.assocs availableMap
>   msum $ map return availableList

Given an assignment and a subsearch, we add the assignment to the per-result list of assignments taken,
and locally filter the available assignments to remove those that conflict for the subsearch.

> withAssignment :: Assignment -> Search a -> Search a
> withAssignment a@(r,c) s = do
>   tell [a]
>   local (M.filterWithKey (\(r',c') v -> r /= r' && c /= c')) s

Given a current value, we find the best value for every column remaining to be assigned, sum those values,
and prune the search if that doesn't exceed the best result we've seen.

> pruneByColumns :: Value -> Search ()
> pruneByColumns value = do
>   available <- ask
>   let bestPossibleColumns = M.foldWithKey (\(r, c) v m -> M.insert c (max v $ M.findWithDefault 0 c m) m) M.empty available
>   let bestPossibleTotal   = sum $ M.elems bestPossibleColumns
>   best <- get
>   guard $ value + bestPossibleTotal > best

Same for rows.

> pruneByRows :: Value -> Search ()
> pruneByRows value = do
>   available <- ask
>   let bestPossibleRows  = M.foldWithKey (\(r, c) v m -> M.insert r (max v $ M.findWithDefault 0 r m) m) M.empty available
>   let bestPossibleTotal = sum $ M.elems bestPossibleRows
>   best <- get
>   guard $ value + bestPossibleTotal > best

We're done if there are no remaining assignments.

> areDone :: Search Bool
> areDone = do
>   availableMap <- ask
>   return $ M.size availableMap == 0

The search itself. We prune first, then check if we're done.
If we are, save the current value as the new best value (pruning ensures it can't be worse), then return it.
Otherwise, we take an assignment, and subsearch with that assignment.

> theSearch :: Value -> Search Value
> theSearch value = do
>   pruneByColumns value
>   pruneByRows value
>   done <- areDone
>   if done
>     then do
>       put value
>       return value
>     else do
>       (assignment, assignmentValue) <- getAssignment
>       withAssignment assignment $ theSearch $ value + assignmentValue

The best result is the last result.

> main :: IO ()
> main = do
>   let result = runSearch $ theSearch 0
>   print $ last result

ShoulderDaemon fucked around with this message at 23:43 on Jan 30, 2009

private double CustomRound(double val, double position) {
   double positionShift = Math.pow(10, position);
   Math.Floor(val * positionShift + 0.5) / positionShift;
}

chocojosh fucked around with this message at 07:28 on Jan 31, 2009

Rocko Bonaparte fucked around with this message at 20:18 on Feb 2, 2009

mistermojo fucked around with this message at 02:21 on Feb 3, 2009

Scaevolus fucked around with this message at 02:31 on Feb 4, 2009