Menu Close

Etiqueta: permutations

Mínimo producto escalar

El producto escalar de los vectores [a1,a2,…,an] y [b1,b2,…, bn] es

   a1 * b1 + a2 * b2 + ··· + an * bn.

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

module Minimo_producto_escalar where
 
import Data.List (sort, permutations)
import Test.QuickCheck (quickCheck)
 
-- 1ª solución
-- ===========
 
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
-- ===========
 
menorProductoEscalar2 :: (Ord a, Num a) => [a] -> [a] -> a
menorProductoEscalar2 xs ys =
  minimum [sum (zipWith (*) pxs ys) | pxs <- permutations xs]
 
-- 3ª solución
-- ===========
 
menorProductoEscalar3 :: (Ord a, Num a) => [a] -> [a] -> a
menorProductoEscalar3 xs ys =
  sum (zipWith (*) (sort xs) (reverse (sort ys)))
 
-- Equivalencia
-- ============
 
-- La propiedad es
prop_menorProductoEscalar :: [Integer] -> [Integer] -> Bool
prop_menorProductoEscalar 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_menorProductoEscalar
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> menorProductoEscalar1 [0..5] [0..5]
--    20
--    (3.24 secs, 977385528 bytes)
--    λ> menorProductoEscalar2 [0..5] [0..5]
--    20
--    (0.01 secs, 4185776 bytes)
--
--    λ> menorProductoEscalar2 [0..9] [0..9]
--    120
--    (23.86 secs, 9342872784 bytes)
--    λ> menorProductoEscalar3 [0..9] [0..9]
--    120
--    (0.01 secs, 2580824 bytes)
--
--    λ> menorProductoEscalar3 [0..10^6] [0..10^6]
--    166666666666500000
--    (2.46 secs, 473,338,912 bytes)

El código se encuentra en GitHub.

Matriz dodecafónica

Como se explica en Create a Twelve-Tone Melody With a Twelve-Tone Matrix una matriz dodecafónica es una matriz de 12 filas y 12 columnas construidas siguiendo los siguientes pasos:

  • Se escribe en la primera fila una permutación de los números del 1 al 12. Por ejemplo,
     (  3  1  9  5  4  6  8  7 12 10 11  2 )
     (                                     )
     (                                     )
     (                                     )
     (                                     )
     (                                     )
     (                                     )
     (                                     )
     (                                     )
     (                                     )
     (                                     )
     (                                     )
  • Escribir la primera columna de forma que, para todo i (entre 2 y 12), a(i,1) es el número entre 1 y 12 que verifica la siguiente condición
     (a(1,1) - a(i,1)) = (a(1,i) - a(1,1)) (módulo 12)

Siguiendo con el ejemplo anterior, la matriz con la 1ª fila y la 1ª columna es

     (  3  1  9  5  4  6  8  7 12 10 11  2 )
     (  5                                  )
     (  9                                  )
     (  1                                  )
     (  2                                  )
     ( 12                                  )
     ( 10                                  )
     ( 11                                  )
     (  6                                  )
     (  8                                  )
     (  7                                  )
     (  4                                  )
  • Escribir la segunda fila de forma que, para todo j (entre 2 y 12), a(j,2) es el número entre 1 y 12 que verifica la siguiente condición
     (a(2,j) - a(1,j)) = (a(2,1) - a(1,1)) (módulo 12)

Siguiendo con el ejemplo anterior, la matriz con la 1ª fila, 1ª columna y 2ª fila es

     (  3  1  9  5  4  6  8  7 12 10 11  2 )
     (  5  3 11  7  6  8 10  9  2 12  1  4 )
     (  9                                  )
     (  1                                  )
     (  2                                  )
     ( 12                                  )
     ( 10                                  )
     ( 11                                  )
     (  6                                  )
     (  8                                  )
     (  7                                  )
     (  4                                  )
  • Las restantes filas se completan como la 2ª; es decir, para todo i (entre 3 y 12) y todo j (entre 2 y 12), a(i,j) es el número entre 1 y 12 que verifica la siguiente relación.
     (a(i,j) - a(1,j)) = (a(i,1) - a(1,1)) (módulo 12)

Siguiendo con el ejemplo anterior, la matriz dodecafónica es

     (  3  1  9  5  4  6  8  7 12 10 11  2 )
     (  5  3 11  7  6  8 10  9  2 12  1  4 )
     (  9  7  3 11 10 12  2  1  6  4  5  8 )
     (  1 11  7  3  2  4  6  5 10  8  9 12 )
     (  2 12  8  4  3  5  7  6 11  9 10  1 )
     ( 12 10  6  2  1  3  5  4  9  7  8 11 )
     ( 10  8  4 12 11  1  3  2  7  5  6  9 )
     ( 11  9  5  1 12  2  4  3  8  6  7 10 )
     (  6  4 12  8  7  9 11 10  3  1  2  5 )
     (  8  6  2 10  9 11  1 12  5  3  4  7 )
     (  7  5  1  9  8 10 12 11  4  2  3  6 )
     (  4  2 10  6  5  7  9  8  1 11 12  3 )

Definir la función

   matrizDodecafonica :: [Int] -> Matrix Int

tal que (matrizDodecafonica xs) es la matriz dodecafónica cuya primera fila es xs (que se supone que es una permutación de los números del 1 al 12). Por ejemplo,

   λ> matrizDodecafonica [3,1,9,5,4,6,8,7,12,10,11,2]
   (  3  1  9  5  4  6  8  7 12 10 11  2 )
   (  5  3 11  7  6  8 10  9  2 12  1  4 )
   (  9  7  3 11 10 12  2  1  6  4  5  8 )
   (  1 11  7  3  2  4  6  5 10  8  9 12 )
   (  2 12  8  4  3  5  7  6 11  9 10  1 )
   ( 12 10  6  2  1  3  5  4  9  7  8 11 )
   ( 10  8  4 12 11  1  3  2  7  5  6  9 )
   ( 11  9  5  1 12  2  4  3  8  6  7 10 )
   (  6  4 12  8  7  9 11 10  3  1  2  5 )
   (  8  6  2 10  9 11  1 12  5  3  4  7 )
   (  7  5  1  9  8 10 12 11  4  2  3  6 )
   (  4  2 10  6  5  7  9  8  1 11 12  3 )

Comprobar con QuickCheck para toda matriz dodecafónica D se verifican las siguientes propiedades:

  • todas las filas de D son permutaciones de los números 1 a 12,
  • todos los elementos de la diagonal de D son iguales y
  • la suma de todos los elementos de D es 936.

Nota: Este ejercicio ha sido propuesto por Francisco J. Hidalgo.

Soluciones

import Data.List
import Test.QuickCheck
import Data.Matrix
 
-- 1ª solución
-- ===========
 
matrizDodecafonica :: [Int] -> Matrix Int
matrizDodecafonica xs = matrix 12 12 f
  where f (1,j) = xs !! (j-1)
        f (i,1) = modulo12 (2 * f (1,1) - f (1,i)) 
        f (i,j) = modulo12 (f (1,j) + f (i,1) - f (1,1)) 
        modulo12 0  = 12
        modulo12 12 = 12
        modulo12 x  = x `mod` 12
 
-- 2ª solución
-- ===========
 
matrizDodecafonica2 :: [Int] -> Matrix Int
matrizDodecafonica2 xs = fromLists (secuencias xs)
 
secuencias :: [Int] -> [[Int]]
secuencias xs = [secuencia a xs | a <- inversa xs]
 
inversa :: [Int] -> [Int]
inversa xs = map conv (map (\x -> (-x) + 2* (abs a)) xs)
  where a = head xs
 
secuencia :: Int -> [Int] -> [Int]
secuencia n xs = [conv (a+(n-b)) | a <- xs] 
  where b = head xs
 
conv :: Int -> Int
conv n | n == 0 = 12
       | n < 0 = conv (n+12)
       | n > 11 = conv (mod n 12)
       | otherwise = n          
 
-- Propiedades
-- ===========
 
-- Las propiedades son
prop_dodecafonica :: Int -> Property
prop_dodecafonica n = 
  n >= 0 ==>
  all esPermutacion (toLists d)
  && all (== d!(1,1)) [d!(i,i) | i <- [2..12]]
  && sum d == 936
  where xss = permutations [1..12]
        k   = n `mod` product [1..12]
        d   = matrizDodecafonica (xss !! k)
        esPermutacion ys = sort ys == [1..12]
 
-- La comprobación es
--    λ> quickCheck prop_dodecafonica
--    +++ OK, passed 100 tests.

Pensamiento

Como el olivar,
mucho fruto lleva,
poca sombra da.

Antonio Machado

Número medio

Un número medio es número natural que es igual a la media aritmética de las permutaciones de sus dígitos. Por ejemplo, 370 es un número medio ya que las permutaciones de sus dígitos es 073, 037, 307, 370, 703 y 730 cuya media es 2220/6 que es igual a 370.

Definir las siguientes funciones

   numeroMedio                :: Integer -> Bool
   densidadesNumeroMedio      :: [Double]
   graficaDensidadNumeroMedio :: Int -> IO ()

tales que

  • (numeroMedio n) se verifica si n es un número medio. Por ejemplo,
      λ> numeroMedio 370
      True
      λ> numeroMedio 371
      False
      λ> numeroMedio 485596707818930041152263374
      True
      λ> filter numeroMedio [100..600]
      [111,222,333,370,407,444,481,518,555,592]
      λ> filter numeroMedio [3*10^5..6*10^5]
      [333333,370370,407407,444444,481481,518518,555555,592592]
  • densidades es la lista cuyo elemento n-ésimo (empezando a contar en 1) es la densidad de números medios en el intervalo [1,n]; es decir, la cantidad de números medios menores o iguales que n dividida por n. Por ejemplo,
      λ> mapM_ print (take 30 densidades)
      1.0
      1.0
      1.0
      1.0
      1.0
      1.0
      1.0
      1.0
      1.0
      0.9
      0.9090909090909091
      0.8333333333333334
      0.7692307692307693
      0.7142857142857143
      0.6666666666666666
      0.625
      0.5882352941176471
      0.5555555555555556
      0.5263157894736842
      0.5
      0.47619047619047616
      0.5
      0.4782608695652174
      0.4583333333333333
      0.44
      0.4230769230769231
      0.4074074074074074
      0.39285714285714285
      0.3793103448275862
      0.36666666666666664
  • (graficaDensidadNumeroMedio n) dibuja la gráfica de las densidades de
    los intervalos [1,k] para k desde 1 hasta n. Por ejemplo, (graficaDensidadNumeroMedio 100) dibuja

    y (graficaDensidadNumeroMedio 1000) dibuja

Soluciones

Puedes escribir tus soluciones en los comentarios o ver las soluciones propuestas pulsando [expand title=»aquí»]

import Data.List (genericLength, permutations, foldl')
import Test.QuickCheck
import Graphics.Gnuplot.Simple 
 
-- 1ª definición de numeroMedio
-- ============================
 
numeroMedio :: Integer -> Bool
numeroMedio n =
  n == media (map digitosAnumero (permutations (digitos n)))
 
-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 425  ==  [4,2,5]
digitos :: Integer -> [Integer]
digitos n =
  [read [c] | c <- show n]
 
-- (digitosAnumero xs) es el número cuya lista de dígitos es xs. Por
-- ejemplo, 
--    digitosAnumero [4,2,5]  ==  425
 
-- 1ª definición de digitosAnumero
digitosAnumero1 :: [Integer] -> Integer
digitosAnumero1 = aux . reverse
  where aux [] = 0
        aux (x:xs) = x + 10 * aux xs
 
-- 1ª definición de digitosAnumero
digitosAnumero2 :: [Integer] -> Integer
digitosAnumero2 = foldl' (\x y -> 10*x+y) 0
 
-- Comparación de eficiencia de definiciones de digitosAnumero
--    λ> length (show (digitosAnumero1 (replicate (10^5) 5)))
--    100000
--    (5.07 secs, 4,317,349,968 bytes)
--    λ> length (show (digitosAnumero2 (replicate (10^5) 5)))
--    100000
--    (0.67 secs, 4,288,054,592 bytes)
 
-- Se usará la 2ª definición de digitosAnumero
digitosAnumero :: [Integer] -> Integer
digitosAnumero = digitosAnumero2
 
-- (media xs) es la media aritmética de la lista xs (se supone que su
-- valor es entero). Por ejemplo,
--    media [370,730,73,703,37,307]  ==  370
media :: [Integer] -> Integer
media xs = sum xs `div` genericLength xs
 
-- 2ª definición de numeroMedio
-- ============================
 
numeroMedio2 :: Integer -> Bool
numeroMedio2 n =
  (10^k-1)*s == 9*k*n
  where xs = digitos n
        k  = genericLength xs
        s  = sum xs
 
-- Equivalencia de las definiciones de numeroMedio
-- ===============================================
 
-- La propiedad es
prop_numeroMedio :: Positive Integer -> Bool
prop_numeroMedio (Positive n) =
  numeroMedio n == numeroMedio2 n
 
-- La comprobación es
--    λ> quickCheck prop_numeroMedio
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia de las definiciones de numeroMedio
-- ============================================================
 
--    λ> filter numeroMedio [10000..20000]
--    [11111]
--    (1.74 secs, 1,500,858,904 bytes)
--    λ> filter numeroMedio2 [10000..20000]
--    [11111]
--    (0.11 secs, 213,060,784 bytes)
 
-- Definición de densidadesNumeroMedio
-- ===================================
 
densidadesNumeroMedio :: [Double]
densidadesNumeroMedio = 
  [genericLength (filter numeroMedio2 [1..n]) / fromIntegral n | n <- [1..]]
 
-- Definición de graficaDensidadNumeroMedio
-- ========================================
 
graficaDensidadNumeroMedio :: Int -> IO ()
graficaDensidadNumeroMedio n =
  plotList [ Title ("graficaDensidadNumeroMedio")
           , Key Nothing
           -- , PNG ("Numero_medio_" ++ show n ++ ".png" )
           , XRange (1, fromIntegral n)]
           (take n densidadesNumeroMedio)

[/expand]

El problema de las N torres

El problema de las N torres consiste en colocar N torres en un tablero con N filas y N columnas de forma que no haya dos torres en la misma fila ni en la misma columna.

Cada solución del problema de puede representar mediante una matriz con ceros y unos donde los unos representan las posiciones ocupadas por las torres y los ceros las posiciones libres. Por ejemplo,

   ( 0 1 0 )
   ( 1 0 0 )
   ( 0 0 1 )

representa una solución del problema de las 3 torres.

Definir las funciones

   torres  :: Int -> [Matrix Int]
   nTorres :: Int -> Integer

tales que
+ (torres n) es la lista de las soluciones del problema de las n torres. Por ejemplo,

      λ> torres 3
      [( 1 0 0 )
       ( 0 1 0 )
       ( 0 0 1 )
      ,( 1 0 0 )
       ( 0 0 1 )
       ( 0 1 0 )
      ,( 0 1 0 )
       ( 1 0 0 )
       ( 0 0 1 )
      ,( 0 1 0 )
       ( 0 0 1 )
       ( 1 0 0 )
      ,( 0 0 1 )
       ( 1 0 0 )
       ( 0 1 0 )
      ,( 0 0 1 )
       ( 0 1 0 )
       ( 1 0 0 )
      ]
  • (nTorres n) es el número de soluciones del problema de las n torres. Por ejemplo,
      λ> nTorres 3
      6
      λ> length (show (nTorres (10^4)))
      35660

Soluciones

[schedule expon=’2018-06-12′ expat=»06:00″]

  • Las soluciones se pueden escribir en los comentarios hasta el 17 de abril.
  • El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2018-06-12′ at=»06:00″]

import Data.List (genericLength, sort, permutations)
import Data.Matrix 
 
-- 1ª definición de torres
-- =======================
 
torres1 :: Int -> [Matrix Int]
torres1 n = 
    [permutacionAmatriz n p | p <- sort (permutations [1..n])]
 
permutacionAmatriz :: Int -> [Int] -> Matrix Int
permutacionAmatriz n p =
    matrix n n f
    where f (i,j) | (i,j) `elem` posiciones = 1
                  | otherwise               = 0
          posiciones = zip [1..n] p    
 
-- 2ª definición de torres
-- =======================
 
torres2 :: Int -> [Matrix Int]
torres2 = map fromLists . permutations . toLists . identity
 
-- El cálculo con la definición anterior es:
--    λ> identity 3
--    ( 1 0 0 )
--    ( 0 1 0 )
--    ( 0 0 1 )
--    
--    λ> toLists it
--    [[1,0,0],[0,1,0],[0,0,1]]
--    λ> permutations it
--    [[[1,0,0],[0,1,0],[0,0,1]],
--     [[0,1,0],[1,0,0],[0,0,1]],
--     [[0,0,1],[0,1,0],[1,0,0]],
--     [[0,1,0],[0,0,1],[1,0,0]],
--     [[0,0,1],[1,0,0],[0,1,0]],
--     [[1,0,0],[0,0,1],[0,1,0]]]
--    λ> map fromLists it
--    [( 1 0 0 )
--     ( 0 1 0 )
--     ( 0 0 1 )
--    ,( 0 1 0 )
--     ( 1 0 0 )
--     ( 0 0 1 )
--    ,( 0 0 1 )
--     ( 0 1 0 )
--     ( 1 0 0 )
--    ,( 0 1 0 )
--     ( 0 0 1 )
--     ( 1 0 0 )
--    ,( 0 0 1 )
--     ( 1 0 0 )
--     ( 0 1 0 )
--    ,( 1 0 0 )
--     ( 0 0 1 )
--     ( 0 1 0 )
--    ]
 
-- 1ª definición de nTorres
-- ========================
 
nTorres1 :: Int -> Integer
nTorres1 = genericLength . torres1
 
-- 2ª definición de nTorres
-- ========================
 
nTorres2 :: Int -> Integer
nTorres2 n = product [1..fromIntegral n]
 
-- Comparación de eficiencia
-- =========================
 
--    λ> nTorres1 9
--    362880
--    (4.22 secs, 693,596,128 bytes)
--    λ> nTorres2 9
--    362880
--    (0.00 secs, 0 bytes)

[/schedule]

Aplicaciones biyectivas

Definir las funciones

   biyectivas  :: (Ord a, Ord b) => [a] -> [b] -> [[(a,b)]]
   nBiyectivas :: (Ord a, Ord b) => [a] -> [b] -> Integer

tales que

  • (biyectivas xs ys) es el conjunto de las aplicaciones biyectivas del conjunto xs en el conjunto ys. Por ejemplo,
     λ> biyectivas [1,3] [2,4]
     [[(1,2),(3,4)],[(1,4),(3,2)]]
     λ> biyectivas [1,3,5] [2,4,6]
     [[(1,2),(3,4),(5,6)],[(1,4),(3,2),(5,6)],[(1,6),(3,4),(5,2)],
      [(1,4),(3,6),(5,2)],[(1,6),(3,2),(5,4)],[(1,2),(3,6),(5,4)]]
     λ> biyectivas [1,3] [2,4,6]
     []
  • (nBiyectivas xs ys) es el número de aplicaciones biyectivas del conjunto xs en el conjunto ys. Por ejemplo,
     nBiyectivas [1,3] [2,4]      ==  2
     nBiyectivas [1,3,5] [2,4,6]  ==  6
     λ> nBiyectivas [1,3] [2,4,6] ==  0
     length (show (nBiyectivas2 [1..2*10^4] [1..2*10^4]))  ==  77338

Nota: En este ejercicio los conjuntos se representan mediante listas ordenadas de elementos distintos.

Soluciones

import Data.List (genericLength, permutations)
 
-- 1ª definición de biyectivas
biyectivas :: (Ord a, Ord b) => [a] -> [b] -> [[(a,b)]]
biyectivas xs ys
  | length xs == length ys = [zip xs zs | zs <- permutations ys]
  | otherwise              = []
 
-- 1ª definición de nBiyectivas
nBiyectivas :: (Ord a, Ord b) => [a] -> [b] -> Integer
nBiyectivas xs ys
  | length xs == length ys = genericLength (biyectivas xs ys)
  | otherwise              = 0
 
-- 2ª definición de nBiyectivas
nBiyectivas2 :: (Ord a, Ord b) => [a] -> [b] -> Integer
nBiyectivas2 xs ys 
  | n == m    = product [1..n]
  | otherwise = 0
  where n = genericLength xs
        m = genericLength ys