Matrices

Mayor número de atracciones visitables

PorJosé A. Alonso 9-mayo-201816-mayo-2018

En el siguiente gráfico se representa en una cuadrícula el plano de Manhattan. Cada línea es una opción a seguir; el número representa las atracciones que se pueden visitar si se elige esa opción.

         3         2         4         0
    * ------- * ------- * ------- * ------- *
    |         |         |         |         |
    |1        |0        |2        |4        |3
    |    3    |    2    |    4    |    2    |
    * ------- * ------- * ------- * ------- *
    |         |         |         |         |
    |4        |6        |5        |2        |1
    |    0    |    7    |    3    |    4    |
    * ------- * ------- * ------- * ------- *
    |         |         |         |         |
    |4        |4        |5        |2        |1
    |    3    |    3    |    0    |    2    |
    * ------- * ------- * ------- * ------- *
    |         |         |         |         |
    |5        |6        |8        |5        |3
    |    1    |    3    |    2    |    2    |
    * ------- * ------- * ------- * ------- *

3 2 4 0

* ------- * ------- * ------- * ------- *

| | | | |

|1 |0 |2 |4 |3

| 3 | 2 | 4 | 2 |

* ------- * ------- * ------- * ------- *

| | | | |

|4 |6 |5 |2 |1

| 0 | 7 | 3 | 4 |

* ------- * ------- * ------- * ------- *

| | | | |

|4 |4 |5 |2 |1

| 3 | 3 | 0 | 2 |

* ------- * ------- * ------- * ------- *

| | | | |

|5 |6 |8 |5 |3

| 1 | 3 | 2 | 2 |

* ------- * ------- * ------- * ------- *

El turista entra por el extremo superior izquierda y sale por el extremo inferior derecha. Sólo puede moverse en las direcciones Sur y Este (es decir, hacia abajo o hacia la derecha).

Representamos el mapa mediante una matriz p tal que p(i,j) = (a,b), donde a = nº de atracciones si se va hacia el sur y b = nº de atracciones si se va al este. Además, ponemos un 0 en el valor del número de atracciones por un camino que no se puede elegir. De esta forma, el mapa anterior se representa por la matriz siguiente:

   ( (1,3)   (0,2)   (2,4)   (4,0)  (3,0) )
   ( (4,3)   (6,2)   (5,4)   (2,2)  (1,0) )
   ( (4,0)   (4,7)   (5,3)   (2,4)  (1,0) )
   ( (5,3)   (6,3)   (8,0)   (5,2)  (3,0) )
   ( (0,1)   (0,3)   (0,2)   (0,2)  (0,0) )

( (1,3) (0,2) (2,4) (4,0) (3,0) )

( (4,3) (6,2) (5,4) (2,2) (1,0) )

( (4,0) (4,7) (5,3) (2,4) (1,0) )

( (5,3) (6,3) (8,0) (5,2) (3,0) )

( (0,1) (0,3) (0,2) (0,2) (0,0) )

En este caso, si se hace el recorrido

   [S, E, S, E, S, S, E, E],

1	[S, E, S, E, S, S, E, E],

el número de atracciones es

    1  3  6  7  5  8  2  2

1	1 3 6 7 5 8 2 2

cuya suma es 34.

Definir la función

   mayorNumeroV:: M.Matrix (Int,Int) -> Int

1	mayorNumeroV:: M.Matrix (Int,Int) -> Int

tal que (mayorNumeroV p) es el máximo número de atracciones que se pueden visitar en el plano representado por la matriz p. Por ejemplo, si se define la matriz anterior por

   ejMapa :: M.Matrix (Int,Int)
   ejMapa = M.fromLists [[(1,3),(0,2),(2,4),(4,0),(3,0)], 
                         [(4,3),(6,2),(5,4),(2,2),(1,0)],
                         [(4,0),(4,7),(5,3),(2,4),(1,0)],
                         [(5,3),(6,3),(8,0),(5,2),(3,0)],
                         [(0,1),(0,3),(0,2),(0,2),(0,0)]]

ejMapa :: M.Matrix (Int,Int)

ejMapa = M.fromLists [[(1,3),(0,2),(2,4),(4,0),(3,0)],

[(4,3),(6,2),(5,4),(2,2),(1,0)],

[(4,0),(4,7),(5,3),(2,4),(1,0)],

[(5,3),(6,3),(8,0),(5,2),(3,0)],

[(0,1),(0,3),(0,2),(0,2),(0,0)]]

entonces

   mayorNumeroV ejMapa                                     ==  34
   mayorNumeroV (fromLists [[(1,3),(0,0)],[(0,3),(0,0)]])  ==  4
   mayorNumeroV (fromLists [[(1,3),(6,0)],[(0,3),(0,0)]])  ==  9

mayorNumeroV ejMapa == 34

mayorNumeroV (fromLists [[(1,3),(0,0)],[(0,3),(0,0)]]) == 4

mayorNumeroV (fromLists [[(1,3),(6,0)],[(0,3),(0,0)]]) == 9

Para los siguientes ejemplos se define un generador de mapas

   genMapa :: Int -> Matrix (Int,Int)
   genMapa n =
     extendTo (0,0) n n (fromList (n-1) (n-1) [(k,k+1) | k <- [1..]])

genMapa :: Int -> Matrix (Int,Int)

genMapa n =

extendTo (0,0) n n (fromList (n-1) (n-1) [(k,k+1) | k <- [1..]])

Entonces,

   mayorNumeroV (genMapa 10)  ==  962
   mayorNumeroV (genMapa 500)  ==  185880992

1 2	mayorNumeroV (genMapa 10) == 962 mayorNumeroV (genMapa 500) == 185880992

Soluciones

import Data.Matrix

ejMapa :: Matrix (Int,Int)
ejMapa = fromLists  [[(1,3),(0,2),(2,4),(4,0),(3,0)], 
                     [(4,3),(6,2),(5,4),(2,2),(1,0)],
                     [(4,0),(4,7),(5,3),(2,4),(1,0)],
                     [(5,3),(6,3),(8,0),(5,2),(3,0)],
                     [(0,1),(0,3),(0,2),(0,2),(0,0)]]

genMapa :: Int -> Matrix (Int,Int)
genMapa n =
  extendTo (0,0) n n (fromList (n-1) (n-1) [(k,k+1) | k <- [1..]])

-- 1ª definición (por recursión)
-- =============================

mayorNumeroV1 :: Matrix (Int,Int) -> Int
mayorNumeroV1 p = aux m n
  where m = nrows p
        n = ncols p
        aux 1 1 = 0
        aux 1 j = sum [snd (p !(1,k)) | k <- [1..j-1]]
        aux i 1 = sum [fst (p !(k,1)) | k <- [1..i-1]]
        aux i j = max ((aux (i-1) j) + fst (p !(i-1,j)))
                      ((aux i (j-1)) + snd (p !(i,j-1)))

-- 2ª solución (con programación dinámica)
-- =======================================

mayorNumeroV2 :: Matrix (Int,Int) -> Int
mayorNumeroV2 p = (matrizNumeroV p) ! (m,n)
  where m = nrows p
        n = ncols p

matrizNumeroV :: Matrix (Int,Int) -> Matrix Int
matrizNumeroV p = q
  where m = nrows p
        n = ncols p
        q = matrix m n f
        f (1,1) = 0
        f (1,j) = snd (p!(1,j-1)) + q!(1,j-1)
        f (i,1) = fst (p!(i-1,1)) + q!(i-1,1)
        f (i,j) = max (fst (p!(i-1,j)) + q!(i-1,j))
                      (snd (p!(i,j-1)) + q!(i,j-1))

-- 3ª solución (con programación dinámica)
-- =======================================

mayorNumeroV3 :: Matrix (Int, Int) -> Int
mayorNumeroV3 mapa = m ! (1,1)
  where m = matrix r c f
        r = nrows mapa
        c = ncols mapa
        f (i,j) | i == r && j == c = 0
                | i == r           = e + m !(r,j+1)
                | j == c           = s + m !(i+1,c)
                | otherwise        = max (e + m !(i, j+1)) (s + m !(i+1, j))
          where (s,e) = mapa ! (i,j)

-- Comparación de eficiencia
-- =========================

--    λ> mayorNumeroV1 (genMapa 11)
--    1334
--    (2.07 secs, 352,208,752 bytes)
--    λ> mayorNumeroV2 (genMapa 11)
--    1334
--    (0.01 secs, 319,792 bytes)
--    λ> mayorNumeroV3 (genMapa 11)
--    1334
--    (0.01 secs, 299,936 bytes)
--    
--    λ> mayorNumeroV2 (genMapa 500)
--    185880992
--    (2.26 secs, 374,557,416 bytes)
--    λ> mayorNumeroV3 (genMapa 500)
--    185880992
--    (3.15 secs, 401,098,336 bytes)

import Data.Matrix

ejMapa :: Matrix (Int,Int)

ejMapa = fromLists [[(1,3),(0,2),(2,4),(4,0),(3,0)],

[(4,3),(6,2),(5,4),(2,2),(1,0)],

[(4,0),(4,7),(5,3),(2,4),(1,0)],

[(5,3),(6,3),(8,0),(5,2),(3,0)],

[(0,1),(0,3),(0,2),(0,2),(0,0)]]

genMapa :: Int -> Matrix (Int,Int)

genMapa n =

extendTo (0,0) n n (fromList (n-1) (n-1) [(k,k+1) | k <- [1..]])

-- 1ª definición (por recursión)

-- =============================

mayorNumeroV1 :: Matrix (Int,Int) -> Int

mayorNumeroV1 p = aux m n

where m = nrows p

n = ncols p

aux 1 1 = 0

aux 1 j = sum [snd (p !(1,k)) | k <- [1..j-1]]

aux i 1 = sum [fst (p !(k,1)) | k <- [1..i-1]]

aux i j = max ((aux (i-1) j) + fst (p !(i-1,j)))

((aux i (j-1)) + snd (p !(i,j-1)))

-- 2ª solución (con programación dinámica)

-- =======================================

mayorNumeroV2 :: Matrix (Int,Int) -> Int

mayorNumeroV2 p = (matrizNumeroV p) ! (m,n)

where m = nrows p

n = ncols p

matrizNumeroV :: Matrix (Int,Int) -> Matrix Int

matrizNumeroV p = q

where m = nrows p

n = ncols p

q = matrix m n f

f (1,1) = 0

f (1,j) = snd (p!(1,j-1)) + q!(1,j-1)

f (i,1) = fst (p!(i-1,1)) + q!(i-1,1)

f (i,j) = max (fst (p!(i-1,j)) + q!(i-1,j))

(snd (p!(i,j-1)) + q!(i,j-1))

-- 3ª solución (con programación dinámica)

-- =======================================

mayorNumeroV3 :: Matrix (Int, Int) -> Int

mayorNumeroV3 mapa = m ! (1,1)

where m = matrix r c f

r = nrows mapa

c = ncols mapa

f (i,j) | i == r && j == c = 0

| i == r = e + m !(r,j+1)

| j == c = s + m !(i+1,c)

| otherwise = max (e + m !(i, j+1)) (s + m !(i+1, j))

where (s,e) = mapa ! (i,j)

-- Comparación de eficiencia

-- =========================

-- λ> mayorNumeroV1 (genMapa 11)

-- 1334

-- (2.07 secs, 352,208,752 bytes)

-- λ> mayorNumeroV2 (genMapa 11)

-- 1334

-- (0.01 secs, 319,792 bytes)

-- λ> mayorNumeroV3 (genMapa 11)

-- 1334

-- (0.01 secs, 299,936 bytes)

-- λ> mayorNumeroV2 (genMapa 500)

-- 185880992

-- (2.26 secs, 374,557,416 bytes)

-- λ> mayorNumeroV3 (genMapa 500)

-- 185880992

-- (3.15 secs, 401,098,336 bytes)

Matrices de Hadamard

PorJosé A. Alonso 17-abril-201825-abril-2021

Las matrices de Hadamard se definen recursivamente como sigue

   λ> hadamard 0
   ( 1 )
   
   λ> hadamard 1
   (  1  1 )
   (  1 -1 )
   
   λ> hadamard 2
   (  1  1  1  1 )
   (  1 -1  1 -1 )
   (  1  1 -1 -1 )
   (  1 -1 -1  1 )
   
   λ> hadamard 3
   (  1  1  1  1  1  1  1  1 )
   (  1 -1  1 -1  1 -1  1 -1 )
   (  1  1 -1 -1  1  1 -1 -1 )
   (  1 -1 -1  1  1 -1 -1  1 )
   (  1  1  1  1 -1 -1 -1 -1 )
   (  1 -1  1 -1 -1  1 -1  1 )
   (  1  1 -1 -1 -1 -1  1  1 )
   (  1 -1 -1  1 -1  1  1 -1 )

λ> hadamard 0

( 1 )

λ> hadamard 1

( 1 1 )

( 1 -1 )

λ> hadamard 2

( 1 1 1 1 )

( 1 -1 1 -1 )

( 1 1 -1 -1 )

( 1 -1 -1 1 )

λ> hadamard 3

( 1 1 1 1 1 1 1 1 )

( 1 -1 1 -1 1 -1 1 -1 )

( 1 1 -1 -1 1 1 -1 -1 )

( 1 -1 -1 1 1 -1 -1 1 )

( 1 1 1 1 -1 -1 -1 -1 )

( 1 -1 1 -1 -1 1 -1 1 )

( 1 1 -1 -1 -1 -1 1 1 )

( 1 -1 -1 1 -1 1 1 -1 )

En general, la n-ésima matriz de Hadamard, H(n), es

   ( H(n-1)  H(n-1) )
   ( H(n-1) -H(n-1) )

1 2	( H(n-1) H(n-1) ) ( H(n-1) -H(n-1) )

Definir la función

   hadamard :: Int -> Matrix Int

1	hadamard :: Int -> Matrix Int

tal que (hadamard n) es la n-ésima matriz de Hadamard.

Comprobar con QuickCheck que para todo número natural n, el producto de la n-ésima matriz de Hadamard y su traspuesta es igual al producto de 2^n por la matriz identidad de orden 2^n.

Soluciones

import Data.Matrix (Matrix, identity, joinBlocks, scaleMatrix, transpose)
import Test.QuickCheck 

hadamard :: Int -> Matrix Int
hadamard 0 = identity 1
hadamard n = joinBlocks (a, a, a, b)
  where a = hadamard (n-1)
        b = scaleMatrix (-1) a

-- La propiedad es
prop_Hadamard :: (Positive Int) -> Bool
prop_Hadamard (Positive n) =
  h * transpose h == scaleMatrix (2^n) (identity (2^n))
  where h = hadamard n

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=7}) prop_Hadamard
--    +++ OK, passed 100 tests.

import Data.Matrix (Matrix, identity, joinBlocks, scaleMatrix, transpose)

import Test.QuickCheck

hadamard :: Int -> Matrix Int

hadamard 0 = identity 1

hadamard n = joinBlocks (a, a, a, b)

where a = hadamard (n-1)

b = scaleMatrix (-1) a

-- La propiedad es

prop_Hadamard :: (Positive Int) -> Bool

prop_Hadamard (Positive n) =

h * transpose h == scaleMatrix (2^n) (identity (2^n))

where h = hadamard n

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=7}) prop_Hadamard

-- +++ OK, passed 100 tests.

Decidir si existe un subconjunto con suma dada

PorJosé A. Alonso 16-abril-201826-abril-2018

Sea S un conjunto finito de números naturales y m un número natural. El problema consiste en determinar si existe un subconjunto de S cuya suma es m. Por ejemplo, si S = [3,34,4,12,5,2] y m = 9, existe un subconjunto de S, [4,5], cuya suma es 9. En cambio, no hay ningún subconjunto de S que sume 13.

Definir la función

    existeSubSuma :: [Int] -> Int -> Bool

1	existeSubSuma :: [Int] -> Int -> Bool

tal que (existeSubSuma xs m) se verifica si existe algún subconjunto de xs que sume m. Por ejemplo,

    existeSubSuma [3,34,4,12,5,2] 9                == True
    existeSubSuma [3,34,4,12,5,2] 13               == False
    existeSubSuma ([3,34,4,12,5,2]++[20..400]) 13  == False
    existeSubSuma ([3,34,4,12,5,2]++[20..400]) 654 == True
    existeSubSuma [1..200] (sum [1..200])          == True

existeSubSuma [3,34,4,12,5,2] 9 == True

existeSubSuma [3,34,4,12,5,2] 13 == False

existeSubSuma ([3,34,4,12,5,2]++[20..400]) 13 == False

existeSubSuma ([3,34,4,12,5,2]++[20..400]) 654 == True

existeSubSuma [1..200] (sum [1..200]) == True

Soluciones

import Data.List  (subsequences, sort)
import Data.Array (Array, array, listArray, (!))
 
-- 1ª definición (Calculando todos los subconjuntos)
-- =================================================
 
existeSubSuma1 :: [Int] -> Int -> Bool
existeSubSuma1 xs n =
  any (\ys -> sum ys == n) (subsequences xs)
 
-- 2ª definición (por recursión)
-- =============================
 
existeSubSuma2 :: [Int] -> Int -> Bool
existeSubSuma2 _  0 = True
existeSubSuma2 [] _ = False
existeSubSuma2 (x:xs) n
  | n < x     = existeSubSuma2 xs n
  | otherwise = existeSubSuma2 xs (n-x) || existeSubSuma2 xs n 
  
-- 3ª definición (por programación dinámica)
-- =========================================
 
existeSubSuma3 :: [Int] -> Int -> Bool
existeSubSuma3 xs n =
  matrizExisteSubSuma3 xs n ! (length xs,n) 
 
-- (matrizExisteSubSuma3 xs m) es la matriz q tal que q(i,j) se verifica
-- si existe algún subconjunto de (take i xs) que sume j. Por ejemplo,
--    λ> elems (matrizExisteSubSuma3 [1,3,5] 9)
--    [True,False,False,False,False,False,False,False,False,False,
--     True,True, False,False,False,False,False,False,False,False,
--     True,True, False,True, True, False,False,False,False,False,
--     True,True, False,True, True, True, True, False,True, True]
-- Con las cabeceras,
--            0     1     2     3     4     5     6     7     8     9
--    []     [True,False,False,False,False,False,False,False,False,False,
--    [1]     True,True, False,False,False,False,False,False,False,False,
--    [1,3]   True,True, False,True, True, False,False,False,False,False,
--    [1,3,5] True,True, False,True, True, True, True, False,True, True]
matrizExisteSubSuma3 :: [Int] -> Int -> Array (Int,Int) Bool
matrizExisteSubSuma3 xs n = q
  where m = length xs
        v = listArray (1,m) xs
        q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],
                                                  j <- [0..n]]
        f _ 0 = True
        f 0 _ = False
        f i j | j < v ! i = q ! (i-1,j)
              | otherwise = q ! (i-1,j-v!i) || q ! (i-1,j)
 
-- 4ª definición (ordenando y por recursión)
-- =========================================
 
existeSubSuma4 :: [Int] -> Int -> Bool
existeSubSuma4 xs = aux (sort xs)
  where aux _  0 = True
        aux [] _ = False
        aux (y:ys) n
          | y <= n    = aux ys (n-y) || aux ys n
          | otherwise = False
 
-- 5ª definición (ordenando y dinámica)
-- ====================================
 
existeSubSuma5 :: [Int] -> Int -> Bool
existeSubSuma5 xs n =
  matrizExisteSubSuma5 (reverse (sort xs)) n ! (length xs,n) 
 
matrizExisteSubSuma5 :: [Int] -> Int -> Array (Int,Int) Bool
matrizExisteSubSuma5 xs n = q
  where m = length xs
        v = listArray (1,m) xs
        q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],
                                                  j <- [0..n]]
        f _ 0 = True
        f 0 _ = False
        f i j | v ! i <= j = q ! (i-1,j-v!i) || q ! (i-1,j) 
              | otherwise  = False
 
-- Equivalencia
-- ============
 
prop_existeSubSuma :: [Int] -> Int -> Bool
prop_existeSubSuma xs n =
  all (== existeSubSuma2 ys m) [ existeSubSuma3 ys m
                               , existeSubSuma4 ys m
                               , existeSubSuma5 ys m ]
  where ys = map abs xs
        m  = abs n
 
-- La comprobación es
--    λ> quickCheck prop_existeSubSuma
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia:
-- ==========================

--    λ> let xs = [1..22] in existeSubSuma1 xs (sum xs)
--    True
--    (7.76 secs, 3,892,403,928 bytes)
--    λ> let xs = [1..22] in existeSubSuma2 xs (sum xs)
--    True
--    (0.02 secs, 95,968 bytes)
--    λ> let xs = [1..22] in existeSubSuma3 xs (sum xs)
--    True
--    (0.03 secs, 6,055,200 bytes)
--    λ> let xs = [1..22] in existeSubSuma4 xs (sum xs)
--    True
--    (0.01 secs, 98,880 bytes)
--    λ> let xs = [1..22] in existeSubSuma5 xs (sum xs)
--    True
--    (0.02 secs, 2,827,560 bytes)
  
--    λ> let xs = [1..200] in existeSubSuma2 xs (sum xs)
--    True
--    (0.01 secs, 182,280 bytes)
--    λ> let xs = [1..200] in existeSubSuma3 xs (sum xs)
--    True
--    (8.89 secs, 1,875,071,968 bytes)
--    λ> let xs = [1..200] in existeSubSuma4 xs (sum xs)
--    True
--    (0.02 secs, 217,128 bytes)
--    λ> let xs = [1..200] in existeSubSuma5 xs (sum xs)
--    True
--    (8.66 secs, 1,875,087,976 bytes)
--
--    λ> and [existeSubSuma2 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (2.82 secs, 323,372,512 bytes)
--    λ> and [existeSubSuma3 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (0.65 secs, 221,806,376 bytes)
--    λ> and [existeSubSuma4 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (4.12 secs, 535,153,152 bytes)
--    λ> and [existeSubSuma5 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (0.73 secs, 238,579,696 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

import Data.List (subsequences, sort)

import Data.Array (Array, array, listArray, (!))

-- 1ª definición (Calculando todos los subconjuntos)

-- =================================================

existeSubSuma1 :: [Int] -> Int -> Bool

existeSubSuma1 xs n =

any (\ys -> sum ys == n) (subsequences xs)

-- 2ª definición (por recursión)

-- =============================

existeSubSuma2 :: [Int] -> Int -> Bool

existeSubSuma2 _ 0 = True

existeSubSuma2 [] _ = False

existeSubSuma2 (x:xs) n

| n < x = existeSubSuma2 xs n

| otherwise = existeSubSuma2 xs (n-x) || existeSubSuma2 xs n

-- 3ª definición (por programación dinámica)

-- =========================================

existeSubSuma3 :: [Int] -> Int -> Bool

existeSubSuma3 xs n =

matrizExisteSubSuma3 xs n ! (length xs,n)

-- (matrizExisteSubSuma3 xs m) es la matriz q tal que q(i,j) se verifica

-- si existe algún subconjunto de (take i xs) que sume j. Por ejemplo,

-- λ> elems (matrizExisteSubSuma3 [1,3,5] 9)

-- [True,False,False,False,False,False,False,False,False,False,

-- True,True, False,False,False,False,False,False,False,False,

-- True,True, False,True, True, False,False,False,False,False,

-- True,True, False,True, True, True, True, False,True, True]

-- Con las cabeceras,

-- 0 1 2 3 4 5 6 7 8 9

-- [] [True,False,False,False,False,False,False,False,False,False,

-- [1] True,True, False,False,False,False,False,False,False,False,

-- [1,3] True,True, False,True, True, False,False,False,False,False,

-- [1,3,5] True,True, False,True, True, True, True, False,True, True]

matrizExisteSubSuma3 :: [Int] -> Int -> Array (Int,Int) Bool

matrizExisteSubSuma3 xs n = q

where m = length xs

v = listArray (1,m) xs

q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],

j <- [0..n]]

f _ 0 = True

f 0 _ = False

f i j | j < v ! i = q ! (i-1,j)

| otherwise = q ! (i-1,j-v!i) || q ! (i-1,j)

-- 4ª definición (ordenando y por recursión)

-- =========================================

existeSubSuma4 :: [Int] -> Int -> Bool

existeSubSuma4 xs = aux (sort xs)

where aux _ 0 = True

aux [] _ = False

aux (y:ys) n

| y <= n = aux ys (n-y) || aux ys n

| otherwise = False

-- 5ª definición (ordenando y dinámica)

-- ====================================

existeSubSuma5 :: [Int] -> Int -> Bool

existeSubSuma5 xs n =

matrizExisteSubSuma5 (reverse (sort xs)) n ! (length xs,n)

matrizExisteSubSuma5 :: [Int] -> Int -> Array (Int,Int) Bool

matrizExisteSubSuma5 xs n = q

where m = length xs

v = listArray (1,m) xs

q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],

j <- [0..n]]

f _ 0 = True

f 0 _ = False

f i j | v ! i <= j = q ! (i-1,j-v!i) || q ! (i-1,j)

| otherwise = False

-- Equivalencia

-- ============

prop_existeSubSuma :: [Int] -> Int -> Bool

prop_existeSubSuma xs n =

all (== existeSubSuma2 ys m) [ existeSubSuma3 ys m

, existeSubSuma4 ys m

, existeSubSuma5 ys m ]

where ys = map abs xs

m = abs n

-- La comprobación es

-- λ> quickCheck prop_existeSubSuma

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia:

-- ==========================

-- λ> let xs = [1..22] in existeSubSuma1 xs (sum xs)

-- True

-- (7.76 secs, 3,892,403,928 bytes)

-- λ> let xs = [1..22] in existeSubSuma2 xs (sum xs)

-- True

-- (0.02 secs, 95,968 bytes)

-- λ> let xs = [1..22] in existeSubSuma3 xs (sum xs)

-- True

-- (0.03 secs, 6,055,200 bytes)

-- λ> let xs = [1..22] in existeSubSuma4 xs (sum xs)

-- True

-- (0.01 secs, 98,880 bytes)

-- λ> let xs = [1..22] in existeSubSuma5 xs (sum xs)

-- True

-- (0.02 secs, 2,827,560 bytes)

-- λ> let xs = [1..200] in existeSubSuma2 xs (sum xs)

-- True

-- (0.01 secs, 182,280 bytes)

-- λ> let xs = [1..200] in existeSubSuma3 xs (sum xs)

-- True

-- (8.89 secs, 1,875,071,968 bytes)

-- λ> let xs = [1..200] in existeSubSuma4 xs (sum xs)

-- True

-- (0.02 secs, 217,128 bytes)

-- λ> let xs = [1..200] in existeSubSuma5 xs (sum xs)

-- True

-- (8.66 secs, 1,875,087,976 bytes)

-- λ> and [existeSubSuma2 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (2.82 secs, 323,372,512 bytes)

-- λ> and [existeSubSuma3 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (0.65 secs, 221,806,376 bytes)

-- λ> and [existeSubSuma4 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (4.12 secs, 535,153,152 bytes)

-- λ> and [existeSubSuma5 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (0.73 secs, 238,579,696 bytes)

Alturas primas

PorJosé A. Alonso 10-abril-201826-marzo-2022

Se considera una enumeración de los números primos:

    p(1)=2,  p(2)=3, p(3)=5, p(4)=7, p(5)=11, p(6)=13, p(7)=17,...

1	p(1)=2, p(2)=3, p(3)=5, p(4)=7, p(5)=11, p(6)=13, p(7)=17,...

Dado un entero x > 1, su altura prima es el mayor i tal que el primo p(i) aparece en la factorización de x en números primos. Por ejemplo, la altura prima de 3500 tiene longitud 4, pues 3500=2^2×5^3×7^1 y la de 34 tiene es 7, pues 34 = 2×17. Además, se define la altura prima de 1 como 0.

Definir las funciones

   alturaPrima        :: Integer -> Integer
   alturasPrimas      :: Integer -> [Integer]
   graficaAlturaPrima :: Integer -> IO ()

alturaPrima :: Integer -> Integer

alturasPrimas :: Integer -> [Integer]

graficaAlturaPrima :: Integer -> IO ()

tales que

(alturaPrima x) es la altura prima de x. Por ejemplo,

     alturaPrima 3500  ==  4
     alturaPrima 34    ==  7

1 2	alturaPrima 3500 == 4 alturaPrima 34 == 7

(alturasPrimas n) es la lista de las altura prima de los primeros n números enteros positivos. Por ejemplo,

     alturasPrimas 15  ==  [0,1,2,1,3,2,4,1,2,3,5,2,6,4,3]
     maximum (alturasPrimas 10000)  ==  1229
     maximum (alturasPrimas 20000)  ==  2262
     maximum (alturasPrimas 30000)  ==  3245
     maximum (alturasPrimas 40000)  ==  4203

alturasPrimas 15 == [0,1,2,1,3,2,4,1,2,3,5,2,6,4,3]

maximum (alturasPrimas 10000) == 1229

maximum (alturasPrimas 20000) == 2262

maximum (alturasPrimas 30000) == 3245

maximum (alturasPrimas 40000) == 4203

(graficaAlturaPrima n) dibuja las alturas primas de los números entre 2 y n. Por ejemplo, (graficaAlturaPrima 500) dibuja

Soluciones

import Data.List (genericLength)
import Data.Numbers.Primes (isPrime, primes, primeFactors)
import Data.Array
import Graphics.Gnuplot.Simple

-- 1ª definicioń de alturaPrima
-- ============================

alturaPrima :: Integer -> Integer
alturaPrima 1 = 0
alturaPrima n = indice (mayorFactorPrimo n)

-- (mayorFactorPrimo n) es el mayor factor primo de n. Por ejemplo,
--    mayorFactorPrimo 3500  ==  7
--    mayorFactorPrimo 34    ==  17
mayorFactorPrimo :: Integer -> Integer
mayorFactorPrimo = last . primeFactors

-- (indice p) es el índice de p en la sucesión de los números
-- primos. Por ejemplo,
--    indice 7   ==  4
--    indice 17  ==  7
indice :: Integer -> Integer
indice p = genericLength (takeWhile (<=p) primes)

-- 2ª definicioń de alturaPrima
-- ============================

alturaPrima2 :: Integer -> Integer
alturaPrima2 n = v ! n
  where v = array (1,n) [(i,f i) | i <- [1..n]]
        f 1 = 0
        f k | isPrime k = indice2 k
            | otherwise = v ! (k `div` (head (primeFactors k)))

indice2 :: Integer -> Integer
indice2 p = head [n | (x,n) <- indicesPrimos, x == p]

-- indicesPrimos es la suceción formada por los números primos y sus
-- índices. Por ejemplo,
--    λ> take 10 indicesPrimos
--    [(2,1),(3,2),(5,3),(7,4),(11,5),(13,6),(17,7),(19,8),(23,9),(29,10)]
indicesPrimos :: [(Integer,Integer)]
indicesPrimos = zip primes [1..]

-- 1ª definición de alturasPrimas
-- ==============================

alturasPrimas :: Integer -> [Integer]
alturasPrimas n = map alturaPrima [1..n]

-- 2ª definición de alturasPrimas
-- ==============================

alturasPrimas2 :: Integer -> [Integer]
alturasPrimas2 n = elems v 
  where v = array (1,n) [(i,f i) | i <- [1..n]]
        f 1 = 0
        f k | isPrime k = indice2 k
            | otherwise = v ! (k `div` (head (primeFactors k)))

-- Comparación de eficiencia
-- =========================

--    λ> maximum (alturasPrimas 20000)
--    2262
--    (29.97 secs, 13,179,984,536 bytes)
--    λ> maximum (alturasPrimas2 20000)
--    2262
--    (2.11 secs, 455,259,448 bytes)

-- Definición de graficaAlturaPrima
-- ================================

graficaAlturaPrima :: Integer -> IO ()
graficaAlturaPrima n =
  plotList [ Key Nothing
           , PNG "Alturas_primas.png"
           ]
           (alturasPrimas2 n)

import Data.List (genericLength)

import Data.Numbers.Primes (isPrime, primes, primeFactors)

import Data.Array

import Graphics.Gnuplot.Simple

-- 1ª definicioń de alturaPrima

-- ============================

alturaPrima :: Integer -> Integer

alturaPrima 1 = 0

alturaPrima n = indice (mayorFactorPrimo n)

-- (mayorFactorPrimo n) es el mayor factor primo de n. Por ejemplo,

-- mayorFactorPrimo 3500 == 7

-- mayorFactorPrimo 34 == 17

mayorFactorPrimo :: Integer -> Integer

mayorFactorPrimo = last . primeFactors

-- (indice p) es el índice de p en la sucesión de los números

-- primos. Por ejemplo,

-- indice 7 == 4

-- indice 17 == 7

indice :: Integer -> Integer

indice p = genericLength (takeWhile (<=p) primes)

-- 2ª definicioń de alturaPrima

-- ============================

alturaPrima2 :: Integer -> Integer

alturaPrima2 n = v ! n

where v = array (1,n) [(i,f i) | i <- [1..n]]

f 1 = 0

f k | isPrime k = indice2 k

| otherwise = v ! (k `div` (head (primeFactors k)))

indice2 :: Integer -> Integer

indice2 p = head [n | (x,n) <- indicesPrimos, x == p]

-- indicesPrimos es la suceción formada por los números primos y sus

-- índices. Por ejemplo,

-- λ> take 10 indicesPrimos

-- [(2,1),(3,2),(5,3),(7,4),(11,5),(13,6),(17,7),(19,8),(23,9),(29,10)]

indicesPrimos :: [(Integer,Integer)]

indicesPrimos = zip primes [1..]

-- 1ª definición de alturasPrimas

-- ==============================

alturasPrimas :: Integer -> [Integer]

alturasPrimas n = map alturaPrima [1..n]

-- 2ª definición de alturasPrimas

-- ==============================

alturasPrimas2 :: Integer -> [Integer]

alturasPrimas2 n = elems v

where v = array (1,n) [(i,f i) | i <- [1..n]]

f 1 = 0

f k | isPrime k = indice2 k

| otherwise = v ! (k `div` (head (primeFactors k)))

-- Comparación de eficiencia

-- =========================

-- λ> maximum (alturasPrimas 20000)

-- 2262

-- (29.97 secs, 13,179,984,536 bytes)

-- λ> maximum (alturasPrimas2 20000)

-- 2262

-- (2.11 secs, 455,259,448 bytes)

-- Definición de graficaAlturaPrima

-- ================================

graficaAlturaPrima :: Integer -> IO ()

graficaAlturaPrima n =

plotList [ Key Nothing

, PNG "Alturas_primas.png"

]

(alturasPrimas2 n)

Operaciones binarias con matrices

PorJosé A. Alonso 28-marzo-20185-abril-2018

Entre dos matrices de la misma dimensión se pueden aplicar distintas operaciones binarias entre los elementos en la misma posición. Por ejemplo, si a y b son las matrices

   |3 4 6|     |1 4 2|
   |5 6 7|     |2 1 2|

1 2	\|3 4 6\| \|1 4 2\| \|5 6 7\| \|2 1 2\|

entonces a+b y a-b son, respectivamente

   |4 8 8|     |2 0 4|
   |7 7 9|     |3 5 5

1 2	\|4 8 8\| \|2 0 4\| \|7 7 9\| \|3 5 5

Definir la función

   opMatriz :: (Int -> Int -> Int) -> 
               Matriz Int -> Matriz Int -> Matriz Int

1 2	opMatriz :: (Int -> Int -> Int) -> Matriz Int -> Matriz Int -> Matriz Int

tal que (opMatriz f p q) es la matriz obtenida aplicando la operación f entre los elementos de p y q de la misma posición. Por ejemplo,

   λ> a = listArray ((1,1),(2,3)) [3,4,6,5,6,7]
   λ> b = listArray ((1,1),(2,3)) [1,4,2,2,1,2]
   λ> elems (opMatriz (+) a b)
   [4,8,8,7,7,9]
   λ> elems (opMatriz max a b)
   [3,4,6,5,6,7]
   λ> c = listArray ((1,1),(2,2)) ["ab","c","d","ef"]
   λ> d = listArray ((1,1),(2,2)) [3,1,0,5]
   λ> elems (opMatriz menor c d)
   [True,False,False,True]

λ> a = listArray ((1,1),(2,3)) [3,4,6,5,6,7]

λ> b = listArray ((1,1),(2,3)) [1,4,2,2,1,2]

λ> elems (opMatriz (+) a b)

[4,8,8,7,7,9]

λ> elems (opMatriz max a b)

[3,4,6,5,6,7]

λ> c = listArray ((1,1),(2,2)) ["ab","c","d","ef"]

λ> d = listArray ((1,1),(2,2)) [3,1,0,5]

λ> elems (opMatriz menor c d)

[True,False,False,True]

Soluciones

import Data.Array

-- 1ª solución
opMatriz :: (a -> b -> c) ->
            Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c
opMatriz f p q =
  array (bounds p) [(k, f (p!k) (q!k)) | k <- indices p]
          
-- 2ª solución
opMatriz2 :: (a -> b -> c) ->
            Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c
opMatriz2 f p q = 
  listArray (bounds p) [f x y | (x,y) <- zip (elems p) (elems q)]

-- 3ª solución
opMatriz3 :: (a -> b -> c) ->
            Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c
opMatriz3 f p q = 
  listArray (bounds p) (zipWith f (elems p) (elems q))

import Data.Array

-- 1ª solución

opMatriz :: (a -> b -> c) ->

Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c

opMatriz f p q =

array (bounds p) [(k, f (p!k) (q!k)) | k <- indices p]

-- 2ª solución

opMatriz2 :: (a -> b -> c) ->

Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c

opMatriz2 f p q =

listArray (bounds p) [f x y | (x,y) <- zip (elems p) (elems q)]

-- 3ª solución

opMatriz3 :: (a -> b -> c) ->

Array (Int,Int) a -> Array (Int,Int) b -> Array (Int,Int) c

opMatriz3 f p q =

listArray (bounds p) (zipWith f (elems p) (elems q))

Mayor número de atracciones visitables

Soluciones

Matrices de Hadamard

Soluciones

Decidir si existe un subconjunto con suma dada

Soluciones

Alturas primas

Soluciones

Operaciones binarias con matrices

Soluciones

Entradas recientes

Buscar

Correo electrónico