Поиск минимального скалярного произведения с использованием ST Monad

Вдохновленный вопрос о переполнении стека , Я решил попрактиковаться в Haskell, взломав Проблема минимального скалярного продукта в Google Code Jam :

  

Для двух векторов \ $ \ mathbf {v_1} = (x_1, x_2, \ ldots, x_n) \ $ и \ $ \ mathbf {v_2} = (y_1, y_2, \ ldots, y_n) \ $. Если вы можете переставить координаты каждого вектора, то каково минимальное скалярное произведение \ $ \ mathbf {v_1} \ cdot \ mathbf {v_2} \ $?

     

Ограничения:
  \ $ 100 \ le n \ le 800 \ $
  \ $ - 100000 \ le x_i, y_i \ le 100000 \ $

Я не претендую на какую-либо алгоритмическую awesomeness (это всего лишь ссылочная реализация для проверки правильности позже).

Это мой первый раз, когда я использую Vector s и монаду ST, так что я действительно хочу, это проверка работоспособности, что я использую оба правильно, и что я используя правильные инструменты для работы.

module MinimumScalarProduct where

import Control.Monad (replicateM, forM_, (>=>))
import Control.Monad.ST (runST, ST)
import Data.Vector (thaw, fromList, MVector, Vector, zipWith, foldl', length, (!))
import Data.Vector.Generic.Mutable (read, swap)
import Prelude hiding (read, zipWith, length)

-- sequnce of transpoitions to yield all permutations of n elts
-- http://en.wikipedia.org/wiki/Steinhaus-Johnson-Trotter_algorithm
transpositions :: Int -> [(Int, Int)]
transpositions n = runST $ do
          -- p maps index to element
          p <- thaw $ fromList [0 .. n-1]
          -- q maps element to index
          q <- thaw $ fromList [0 .. n-1]
          -- let the prefixes define themselves recursively
          foldr ((>=>) . extend p q) return [2..n] [] 

extend :: MVector s Int -> MVector s Int -> Int -> [(Int,Int)] -> ST s [(Int,Int)]
extend p q n ts = fmap ((ts++) . concat) . replicateM (n-1) $ do
  -- replace the element in the (n-1)'th position with its predecessor
  a <- read p (n-1)
  i <- read q (a-1)
  swap p (n-1) i
  swap q a (a-1)
  -- replay the earlier transpositions
  forM_ ts $ \(m,j) -> do
    b <- read p m
    c <- read p j
    swap p m j
    swap q b c
  return $ (n-1,i) : ts

-- reference implementation, takes O(n!)
msp :: Vector Int -> Vector Int -> Int
msp u v | length u /= length v = 0
msp u v = runST $ do
  let x = foldl' (+) 0 $ zipWith (*) u v
  let n = length u
  u' <- thaw u
  -- check each permutation of u'
  let steps = map (adjust u' v) $ transpositions n
  fmap minimum . sequence $ scanl (>>=) (return x) steps

-- adjust the current scalar product for the transposition of u
adjust :: MVector s Int -> Vector Int -> (Int, Int) -> Int -> ST s Int
adjust u v (i,j) x = do
  a <- read u i
  b <- read u j
  let c = v ! i
  let d = v ! j
  swap u i j
  return $ x - (a*c + b*d) + (a*d + b*c)
40 голосов | спросил rampion 18 MarpmSun, 18 Mar 2012 16:06:23 +04002012-03-18T16:06:23+04:0004 2012, 16:06:23

1 ответ


4

Несколько старый вопрос, но все же жаль, на что он не ответил :). Отложив асимптотически лучшее решение, предложенное в комментариях, и сосредоточив внимание только на коде:

Достоинства: типы верхнего уровня для всех функций, это очень хорошо, а также комментарии. Код показывает хорошее понимание различных функций и иконов Хаскеля.

Мое самое общее замечание состоит в том, что существует диспропорция между сложностью кода и сложностью. Обычно более сложный код должен быть более подробным и более наглядным. Визуально большая часть кода - это просто операции чтения /записи /замены ST, но важная часть сжимается в не очень простые для понимания и необычные комбинации сгибов /сканирования /последовательности /> => /> ;> = и т. д. Я бы, вероятно, разделил простые части (чтение /своп) на вспомогательные функции и немного расширил /упростил сложные части.

Функция adjust несколько смешивает чистые и изменчивые подходы. Хотя он изменяет свой первый аргумент, он сохраняет чистое скалярное произведение и передает его как аргумент в и из. Это несколько запутывает и усложняет вычисление минимума (scanl с помощью >>=). Если продукт также был переменной ST, код становится проще (непроверенный):

adjust :: MVector s Int -> Vector Int -> STRef s Int -> (Int, Int) -> ST s Int
...
msp = ...
  x <- newSTRef $ foldl' (+) 0 $ zipWith (*) u v
  fmap minimum . traverse (adjust u' v x) . transpositions $ n

В качестве альтернативы вы можете даже сохранить результат в переменной ST.

Также foldr с >=> можно заменить на foldM (untested):

foldM (flip $ extend p q) [] [2..n]

(Тогда было бы целесообразно реорганизовать тип extend, чтобы избавиться от flip.)

Некоторые вопросы:

  • Воспроизведение всех ts в extend необходимо? Поскольку это выполняется многократно, было бы целесообразно вычислить комбинированную перестановку ts отдельно или один раз, а затем просто применить ее.
  • Какой вариант алгоритма фактически используется? Использование двух векторов не похоже на что-либо в связанной статье Википедии. Хотя общая идея алгоритма понятна, для кого-то, не знакомого с ним, было бы легче получить более точные рекомендации.

Nit: порядок функций несколько неестественен: transpositions использует extend, msp использует transpositions и настроить. В этом нет видимого порядка. Одним из хороших вариантов является то, что функции всегда определяются перед использованием (с очевидным исключением взаимно-рекурсивных функций). Или наоборот: основные /экспортируемые функции являются первыми, а вспомогательные функции следуют. Или отдельные функции в (возможно, вложенные) разделы , затем упорядочение функций на самом деле не имеет значения, упорядочение секций становится важным.

ответил Petr Pudlák 15 J000000Friday16 2016, 23:01:17

Похожие вопросы

Популярные теги

security × 330linux × 316macos × 2827 × 268performance × 244command-line × 241sql-server × 235joomla-3.x × 222java × 189c++ × 186windows × 180cisco × 168bash × 158c# × 142gmail × 139arduino-uno × 139javascript × 134ssh × 133seo × 132mysql × 132