Mínimo producto escalar
El producto escalar de los vectores \(a_1,a_2,\dots,a_n\) y \(b_1,b_2,\dots,b_n\) es \[a_1 \times b_1 + a_2 \times b_2 + \dots + a_n \times b_n\]
Definir la función
menorProductoEscalar :: (Ord a, Num a) => [a] -> [a] -> a
tal que (menorProductoEscalar xs ys) es el mínimo de los productos escalares de las permutaciones de xs y de las permutaciones de ys. Por ejemplo,
menorProductoEscalar [3,2,5] [1,4,6] == 29 menorProductoEscalar [3,2,5] [1,4,-6] == -19 menorProductoEscalar [1..10^2] [1..10^2] == 171700 menorProductoEscalar [1..10^3] [1..10^3] == 167167000 menorProductoEscalar [1..10^4] [1..10^4] == 166716670000 menorProductoEscalar [1..10^5] [1..10^5] == 166671666700000 menorProductoEscalar [1..10^6] [1..10^6] == 166667166667000000
Soluciones
import Data.List (foldl', permutations, sort, sortBy, sortOn) import Data.Ord (Down(..), comparing) import Test.Hspec (Spec, describe, hspec, it, shouldBe) import Test.QuickCheck -- 1ª solución: Fuerza bruta basada en la definición (Muy ineficiente) -- =================================================================== menorProductoEscalar1 :: (Ord a, Num a) => [a] -> [a] -> a menorProductoEscalar1 xs ys = minimum [sum (zipWith (*) pxs pys) | pxs <- permutations xs, pys <- permutations ys] -- 2ª solución: Refinamiento de la fuerza bruta (Aún ineficiente) -- ============================================================== menorProductoEscalar2 :: (Ord a, Num a) => [a] -> [a] -> a menorProductoEscalar2 xs ys = minimum [sum (zipWith (*) pxs ys) | pxs <- permutations xs] -- 3ª solución: Enfoque algorítmico (Teorema de reordenamiento) -- ============================================================ menorProductoEscalar3 :: (Ord a, Num a) => [a] -> [a] -> a menorProductoEscalar3 xs ys = sum (zipWith (*) (sort xs) (reverse (sort ys))) -- 4ª solución: Estilo declarativo (Listas por comprensión) -- ======================================================== menorProductoEscalar4 :: (Ord a, Num a) => [a] -> [a] -> a menorProductoEscalar4 xs ys = sum [x * y | (x, y) <- zip (sort xs) (sortOn Down ys)] -- 5ª solución: Estilo funcional idiomático (zipWith + sortOn) -- =========================================================== menorProductoEscalar5 :: (Ord a, Num a) => [a] -> [a] -> a menorProductoEscalar5 xs ys = sum (zipWith (*) (sort xs) (sortOn Down ys)) -- 6ª solución: Optimización de la ordenación (sortBy + comparing) -- =============================================================== menorProductoEscalar6 :: (Ord a, Num a) => [a] -> [a] -> a menorProductoEscalar6 xs ys = sum (zipWith (*) (sort xs) (sortBy (comparing Down) ys)) -- 7ª solución: Optimización de memoria (Acumulación estricta con foldl') -- ====================================================================== menorProductoEscalar7 :: (Ord a, Num a) => [a] -> [a] -> a menorProductoEscalar7 xs ys = foldl' (+) 0 (zipWith (*) (sort xs) (sortOn Down ys)) -- 8ª solución: Fusión de bucles (zip + foldl' en un paso) -- ======================================================= menorProductoEscalar8 :: (Ord a, Num a) => [a] -> [a] -> a menorProductoEscalar8 xs ys = foldl' (+) 0 (zipWith (*) (sort xs) (sortBy (comparing Down) ys)) -- Verificación -- ============ verifica :: IO () verifica = hspec spec specG :: ([Integer] -> [Integer] -> Integer) -> Spec specG menorProductoEscalar = do it "e1" $ menorProductoEscalar [3,2,5] [1,4,6] `shouldBe` 29 it "e2" $ menorProductoEscalar [3,2,5] [1,4,-6] `shouldBe` -19 it "e3" $ menorProductoEscalar [] ([] :: [Integer]) `shouldBe` 0 it "e4" $ menorProductoEscalar [5] [3] `shouldBe` 15 spec :: Spec spec = do describe "def. 1" $ specG menorProductoEscalar1 describe "def. 2" $ specG menorProductoEscalar2 describe "def. 3" $ specG menorProductoEscalar3 describe "def. 4" $ specG menorProductoEscalar4 describe "def. 5" $ specG menorProductoEscalar5 describe "def. 6" $ specG menorProductoEscalar6 describe "def. 7" $ specG menorProductoEscalar7 describe "def. 8" $ specG menorProductoEscalar8 -- La verificación es -- λ> verifica -- 32 examples, 0 failures -- Comprobación de equivalencia -- ============================ -- La propiedad para las 3 primeras soluciones prop_menorProductoEscalar1 :: [Integer] -> [Integer] -> Bool prop_menorProductoEscalar1 xs ys = all (== menorProductoEscalar1 xs' ys') [ menorProductoEscalar2 xs' ys' , menorProductoEscalar3 xs' ys' ] where n = min (length xs) (length ys) xs' = take n xs ys' = take n ys -- La comprobación es -- λ> quickCheckWith (stdArgs {maxSize=7}) prop_menorProductoEscalar1 -- +++ OK, passed 100 tests. -- La propiedad para las restantes soluciones prop_menorProductoEscalar2 :: [Integer] -> [Integer] -> Bool prop_menorProductoEscalar2 xs ys = all (== menorProductoEscalar3 xs' ys') [ menorProductoEscalar4 xs' ys' , menorProductoEscalar5 xs' ys' , menorProductoEscalar6 xs' ys' , menorProductoEscalar7 xs' ys' , menorProductoEscalar8 xs' ys' ] where n = min (length xs) (length ys) xs' = take n xs ys' = take n ys -- La comprobación es -- λ> quickCheck prop_menorProductoEscalar2 -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> menorProductoEscalar1 [0..6] [0..6] -- 35 -- (21.58 secs, 40,304,707,600 bytes) -- λ> menorProductoEscalar2 [0..6] [0..6] -- 35 -- (0.04 secs, 8,594,304 bytes) -- λ> menorProductoEscalar2 [0..9] [0..9] -- 120 -- (3.70 secs, 7,242,359,848 bytes) -- λ> menorProductoEscalar3 [0..9] [0..9] -- 120 -- (0.01 secs, 601,936 bytes) -- -- λ> menorProductoEscalar3 [0..4*10^6] [0..4*10^6] -- 10666666666666000000 -- (2.17 secs, 1,630,167,040 bytes) -- λ> menorProductoEscalar4 [0..4*10^6] [0..4*10^6] -- 10666666666666000000 -- (3.47 secs, 2,846,167,528 bytes) -- λ> menorProductoEscalar5 [0..4*10^6] [0..4*10^6] -- 10666666666666000000 -- (2.56 secs, 2,430,167,328 bytes) -- λ> menorProductoEscalar6 [0..4*10^6] [0..4*10^6] -- 10666666666666000000 -- (1.72 secs, 1,694,167,192 bytes) -- λ> menorProductoEscalar7 [0..4*10^6] [0..4*10^6] -- 10666666666666000000 -- (1.84 secs, 2,430,167,352 bytes) -- λ> menorProductoEscalar8 [0..4*10^6] [0..4*10^6] -- 10666666666666000000 -- (2.26 secs, 1,694,167,344 bytes)