Menu Close

Etiqueta: maximum

Caminos en un grafo

Definir las funciones

   grafo   :: [(Int,Int)] -> Grafo Int Int
   caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

tales que

  • (grafo as) es el grafo no dirigido definido cuyas aristas son as. Por ejemplo,
     ghci> grafo [(2,4),(4,5)]
     G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])
  • (caminos g a b) es la lista los caminos en el grafo g desde a hasta b sin pasar dos veces por el mismo nodo. Por ejemplo,
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)
     [[1,3,5,7],[1,3,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)
     [[2,5,3,7],[2,5,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)
     [[1,3,5,2],[1,3,7,5,2]]
     ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4
     []
     ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
     109601

Soluciones

import Data.List (sort)
import I1M.Grafo
import I1M.BusquedaEnEspaciosDeEstados
 
grafo :: [(Int,Int)] -> Grafo Int Int
grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]
  where ns = map fst as ++ map snd as
        m  = minimum ns
        n  = maximum ns
 
-- 1ª solución
-- ===========
 
caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos g a b = aux [[b]] where 
  aux [] = []
  aux ((x:xs):yss)
    | x == a    = (x:xs) : aux yss
    | otherwise = aux ([z:x:xs | z <- adyacentes g x
                               , z `notElem` (x:xs)] 
                       ++ yss) 
 
-- 2ª solución (mediante espacio de estados)
-- =========================================
 
caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos2 g a b = buscaEE sucesores esFinal inicial
  where inicial          = [b]
        sucesores (x:xs) = [z:x:xs | z <- adyacentes g x
                                   , z `notElem` (x:xs)] 
        esFinal (x:xs)   = x == a
 
-- Comparación de eficiencia
-- =========================
 
--    ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.57 secs, 500533816 bytes)
--    ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.53 secs, 470814096 bytes)

Camino de máxima suma en una matriz

Los caminos desde el extremo superior izquierdo (posición (1,1)) hasta el extremo inferior derecho (posición (3,4)) en la matriz

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

moviéndose en cada paso una casilla hacia abajo o hacia la derecha, son los siguientes:

   1, 7,  3, 8, 4, 9
   1, 7, 12, 8, 4, 9
   1, 7, 12, 3, 4, 9
   1, 7, 12, 3, 8, 9
   1, 6, 12, 8, 4, 9
   1, 6, 12, 3, 4, 9
   1, 6, 12, 3, 8, 9
   1, 6, 11, 3, 4, 9
   1, 6, 11, 3, 8, 9
   1, 6, 11, 2, 8, 9

Las sumas de los caminos son 32, 41, 36, 40, 40, 35, 39, 34, 38 y 37, respectivamente. El camino de máxima suma es el segundo (1, 7, 12, 8, 4, 9) que tiene una suma de 41.

Definir la función

   caminoMaxSuma :: Matrix Int -> [Int]

tal que (caminoMaxSuma m) es un camino de máxima suma en la matriz m desde el extremo superior izquierdo hasta el extremo inferior derecho, moviéndose en cada paso una casilla hacia abajo o hacia la derecha. Por ejemplo,

   λ> caminoMaxSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])
   [1,7,12,8,4,9]
   λ> sum (caminoMaxSuma (fromList 800 800 [1..]))
   766721999

Nota: Se recomienda usar programación dinámica.

Soluciones

import Data.Matrix
 
-- 1ª definición
-- =============
 
caminoMaxSuma1 :: Matrix Int -> [Int]
caminoMaxSuma1 m =
  head [c | c <- cs, sum c == k] 
  where cs = caminos1 m
        k  = maximum (map sum cs)
 
caminos1 :: Matrix Int -> [[Int]]
caminos1 m =
  map reverse (caminos1Aux m (nf,nc))
  where nf = nrows m
        nc = ncols m
 
-- (caminos1Aux p x) es la lista de los caminos invertidos en la matriz p
-- desde la posición (1,1) hasta la posición x. Por ejemplo,
caminos1Aux :: Matrix Int -> (Int,Int) -> [[Int]]
caminos1Aux m (1,1) = [[m!(1,1)]]
caminos1Aux m (1,j) = [[m!(1,k) | k <- [j,j-1..1]]]
caminos1Aux m (i,1) = [[m!(k,1) | k <- [i,i-1..1]]]
caminos1Aux m (i,j) = [m!(i,j) : xs
                      | xs <- caminos1Aux m (i,j-1) ++
                              caminos1Aux m (i-1,j)]
 
-- 2ª definición
-- =============
 
caminoMaxSuma2 :: Matrix Int -> [Int]
caminoMaxSuma2 m =
  head [c | c <- cs, sum c == k] 
  where cs = caminos2 m
        k  = maximum (map sum cs)
 
caminos2 :: Matrix Int -> [[Int]]
caminos2 m =
  map reverse (matrizCaminos m ! (nrows m, ncols m))
 
matrizCaminos :: Matrix Int -> Matrix [[Int]]
matrizCaminos m = q
  where
    q = matrix (nrows m) (ncols m) f
    f (1,y) = [[m!(1,z) | z <- [y,y-1..1]]]
    f (x,1) = [[m!(z,1) | z <- [x,x-1..1]]]
    f (x,y) = [m!(x,y) : cs | cs <- q!(x-1,y) ++ q!(x,y-1)]  
 
-- 3ª definición (con programación dinámica)
-- =========================================
 
caminoMaxSuma3 :: Matrix Int -> [Int]
caminoMaxSuma3 m = reverse (snd (q ! (nf,nc)))
  where nf = nrows m
        nc = ncols m
        q  = caminoMaxSumaAux m
 
caminoMaxSumaAux :: Matrix Int -> Matrix (Int,[Int])
caminoMaxSumaAux m = q 
  where
    nf = nrows m
    nc = ncols m
    q  = matrix nf nc f
      where
        f (1,1) = (m!(1,1),[m!(1,1)])
        f (1,j) = (k + m!(1,j), m!(1,j):xs)
          where (k,xs) = q!(1,j-1)
        f (i,1) = (k + m!(i,1), m!(i,1):xs)
          where (k,xs) = q!(i-1,1)        
        f (i,j) | k1 > k2   = (k1 + m!(i,j), m!(i,j):xs)
                | otherwise = (k2 + m!(i,j), m!(i,j):ys)
          where (k1,xs) = q!(i,j-1)
                (k2,ys) = q!(i-1,j)
 
-- Comparación de eficiencia
-- -------------------------
 
--    λ> length (caminoMaxSuma1 (fromList 11 11 [1..]))
--    21
--    (10.00 secs, 1,510,120,328 bytes)
--    λ> length (caminoMaxSuma2 (fromList 11 11 [1..]))
--    21
--    (3.84 secs, 745,918,544 bytes)
--    λ> length (caminoMaxSuma3 (fromList 11 11 [1..]))
--    21
--    (0.01 secs, 0 bytes)

Máximo de las sumas de los caminos en una matriz

Los caminos desde el extremo superior izquierdo (posición (1,1)) hasta el extremo inferior derecho (posición (3,4)) en la matriz

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

moviéndose en cada paso una casilla hacia abajo o hacia la derecha, son los siguientes:

   1, 7,  3, 8, 4, 9
   1, 7, 12, 8, 4, 9
   1, 7, 12, 3, 4, 9
   1, 7, 12, 3, 8, 9
   1, 6, 12, 8, 4, 9
   1, 6, 12, 3, 4, 9
   1, 6, 12, 3, 8, 9
   1, 6, 11, 3, 4, 9
   1, 6, 11, 3, 8, 9
   1, 6, 11, 2, 8, 9

Las sumas de los caminos son 32, 41, 36, 40, 40, 35, 39, 34, 38 y 37, respectivamente. El máximo de las suma de los caminos es 41.

Definir la función

   maximaSuma :: Matrix Int -> Int

tal que (maximaSuma m) es el máximo de las sumas de los caminos en la matriz m desde el extremo superior izquierdo hasta el extremo inferior derecho, moviéndose en cada paso una casilla hacia abajo o hacia la derecha. Por ejemplo,

   λ> maximaSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])
   41
   λ> maximaSuma (fromList 800 800 [1..])
   766721999

Nota: Se recomienda usar programación dinámica.

Soluciones

import Data.Matrix
 
-- 1ª definición
-- =============
 
maximaSuma1 :: Matrix Int -> Int
maximaSuma1 =
  maximum . map sum . caminos1
 
caminos1 :: Matrix Int -> [[Int]]
caminos1 m =
  map reverse (caminos1Aux m (nf,nc))
  where nf = nrows m
        nc = ncols m
 
-- (caminos1Aux p x) es la lista de los caminos invertidos en la matriz p
-- desde la posición (1,1) hasta la posición x. Por ejemplo,
caminos1Aux :: Matrix Int -> (Int,Int) -> [[Int]]
caminos1Aux m (1,1) = [[m!(1,1)]]
caminos1Aux m (1,j) = [[m!(1,k) | k <- [j,j-1..1]]]
caminos1Aux m (i,1) = [[m!(k,1) | k <- [i,i-1..1]]]
caminos1Aux m (i,j) = [m!(i,j) : xs
                      | xs <- caminos1Aux m (i,j-1) ++
                              caminos1Aux m (i-1,j)]
 
-- 2ª definición
-- =============
 
maximaSuma2 :: Matrix Int -> Int
maximaSuma2 =
  maximum . map sum . caminos2
 
caminos2 :: Matrix Int -> [[Int]]
caminos2 m =
  map reverse (matrizCaminos m ! (nrows m, ncols m))
 
matrizCaminos :: Matrix Int -> Matrix [[Int]]
matrizCaminos m = q
  where
    q = matrix (nrows m) (ncols m) f
    f (1,y) = [[m!(1,z) | z <- [y,y-1..1]]]
    f (x,1) = [[m!(z,1) | z <- [x,x-1..1]]]
    f (x,y) = [m!(x,y) : cs | cs <- q!(x-1,y) ++ q!(x,y-1)]  
 
-- 3ª definicion (por recursión, sin calcular el camino)
-- =====================================================
 
maximaSuma3 :: Matrix Int -> Int
maximaSuma3 m = maximaSuma3Aux m (nf,nc)
  where nf = nrows m
        nc = ncols m
 
-- (maximaSuma3Aux m p) calcula la suma máxima de un camino hasta la
-- posición p. Por ejemplo,
--    λ> maximaSuma3Aux (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]]) (3,4)
--    41
--    λ> maximaSuma3Aux (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]]) (3,3)
--    32
--    λ> maximaSuma3Aux (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]]) (2,4)
--    31
maximaSuma3Aux :: Matrix Int -> (Int,Int) -> Int
maximaSuma3Aux m (1,1) = m ! (1,1)
maximaSuma3Aux m (1,j) = maximaSuma3Aux m (1,j-1) + m ! (1,j)
maximaSuma3Aux m (i,1) = maximaSuma3Aux m (i-1,1) + m ! (i,1)
maximaSuma3Aux m (i,j) =
  max (maximaSuma3Aux m (i,j-1)) (maximaSuma3Aux m (i-1,j)) + m ! (i,j)
 
-- 4ª solución (mediante programación dinámica)
-- ============================================
 
maximaSuma4 :: Matrix Int -> Int
maximaSuma4 m = q ! (nf,nc)
  where nf = nrows m
        nc = ncols m
        q  = matrizMaximaSuma m
 
-- (matrizMaximaSuma m) es la matriz donde en cada posición p se
-- encuentra el máxima de las sumas de los caminos desde (1,1) a p en la
-- matriz m. Por ejemplo,   
--    λ> matrizMaximaSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]]) 
--    (  1  7 18 20 )
--    (  8 20 23 31 )
--    ( 11 28 32 41 )
matrizMaximaSuma :: Matrix Int -> Matrix Int
matrizMaximaSuma m = q 
  where nf = nrows m
        nc = ncols m
        q  = matrix nf nc f
          where  f (1,1) = m ! (1,1)
                 f (1,j) = q ! (1,j-1) + m ! (1,j)
                 f (i,1) = q ! (i-1,1) + m ! (i,1)
                 f (i,j) = max (q ! (i,j-1)) (q ! (i-1,j)) + m ! (i,j)
 
-- Comparación de eficiencia
-- =========================
 
--    λ> maximaSuma1 (fromList 8 8 [1..])
--    659
--    (0.11 secs, 31,853,136 bytes)
--    λ> maximaSuma1a (fromList 8 8 [1..])
--    659
--    (0.09 secs, 19,952,640 bytes)
-- 
--    λ> maximaSuma1 (fromList 10 10 [1..])
--    1324
--    (2.25 secs, 349,722,744 bytes)
--    λ> maximaSuma2 (fromList 10 10 [1..])
--    1324
--    (0.76 secs, 151,019,296 bytes)
--    
--    λ> maximaSuma2 (fromList 11 11 [1..])
--    1781
--    (3.02 secs, 545,659,632 bytes)
--    λ> maximaSuma3 (fromList 11 11 [1..])
--    1781
--    (1.57 secs, 210,124,912 bytes)
--    
--    λ> maximaSuma3 (fromList 12 12 [1..])
--    2333
--    (5.60 secs, 810,739,032 bytes)
--    λ> maximaSuma4 (fromList 12 12 [1..])
--    2333
--    (0.01 secs, 23,154,776 bytes)

Máxima longitud de sublistas crecientes

Definir la función

   longitudMayorSublistaCreciente :: Ord a => [a] -> Int

tal que (longitudMayorSublistaCreciente xs) es la el máximo de las longitudes de las sublistas crecientes de xs. Por ejemplo,

   λ> longitudMayorSublistaCreciente [3,2,6,4,5,1]
   3
   λ> longitudMayorSublistaCreciente [10,22,9,33,21,50,41,60,80]
   6
   λ> longitudMayorSublistaCreciente [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
   6
   λ> longitudMayorSublistaCreciente [1..2000]
   2000
   λ> longitudMayorSublistaCreciente [2000,1999..1]
   1
   λ> import System.Random
   λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
   λ> longitudMayorSublistaCreciente2 xs
   61
   λ> longitudMayorSublistaCreciente3 xs
   61

Nota: Se puede usar programación dinámica para aumentar la eficiencia.

Soluciones

import Data.List (nub, sort)
import Data.Array (Array, (!), array, elems, listArray)
 
-- 1ª solución
-- ===========
 
longitudMayorSublistaCreciente1 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente1 =
  length . head . mayoresCrecientes
 
-- (mayoresCrecientes xs) es la lista de las sublistas crecientes de xs
-- de mayor longitud. Por ejemplo, 
--    λ> mayoresCrecientes [3,2,6,4,5,1]
--    [[3,4,5],[2,4,5]]
--    λ> mayoresCrecientes [3,2,3,2,3,1]
--    [[2,3],[2,3],[2,3]]
--    λ> mayoresCrecientes [10,22,9,33,21,50,41,60,80]
--    [[10,22,33,50,60,80],[10,22,33,41,60,80]]
--    λ> mayoresCrecientes [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
--    [[0,4,6,9,13,15],[0,2,6,9,13,15],[0,4,6,9,11,15],[0,2,6,9,11,15]]
mayoresCrecientes :: Ord a => [a] -> [[a]]
mayoresCrecientes xs =
  [ys | ys <- xss
      , length ys == m]
  where xss = sublistasCrecientes xs
        m   = maximum (map length xss)
 
-- (sublistasCrecientes xs) es la lista de las sublistas crecientes de
-- xs. Por ejemplo,
--    λ> sublistasCrecientes [3,2,5]
--    [[3,5],[3],[2,5],[2],[5],[]]
sublistasCrecientes :: Ord a => [a] -> [[a]]
sublistasCrecientes []  = [[]]
sublistasCrecientes (x:xs) =
  [x:ys | ys <- yss, null ys || x < head ys] ++ yss
  where yss = sublistasCrecientes xs
 
-- 2ª solución
-- ===========
 
longitudMayorSublistaCreciente2 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente2 xs =
  longitudSCM xs (sort (nub xs))
 
-- (longitudSCM xs ys) es la longitud de la subsecuencia máxima de xs e
-- ys. Por ejemplo, 
--   longitudSCM "amapola" "matamoscas" == 4
--   longitudSCM "atamos" "matamoscas"  == 6
--   longitudSCM "aaa" "bbbb"           == 0
longitudSCM :: Eq a => [a] -> [a] -> Int
longitudSCM xs ys = (matrizLongitudSCM xs ys) ! (n,m)
  where n = length xs
        m = length ys
 
-- (matrizLongitudSCM xs ys) es la matriz de orden (n+1)x(m+1) (donde n
-- y m son los números de elementos de xs e ys, respectivamente) tal que
-- el valor en la posición (i,j) es la longitud de la SCM de los i
-- primeros elementos de xs y los j primeros elementos de ys. Por ejemplo,
--    λ> elems (matrizLongitudSCM "amapola" "matamoscas")
--    [0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,1,1,1,1,2,2,2,2,2,2,
--     0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,3,3,3,3,3,
--     0,1,2,2,2,2,3,3,3,3,3,0,1,2,2,3,3,3,3,3,4,4]
-- Gráficamente,
--       m a t a m o s c a s
--    [0,0,0,0,0,0,0,0,0,0,0,
-- a   0,0,1,1,1,1,1,1,1,1,1,
-- m   0,1,1,1,1,2,2,2,2,2,2,
-- a   0,1,2,2,2,2,2,2,2,3,3,
-- p   0,1,2,2,2,2,2,2,2,3,3,
-- o   0,1,2,2,2,2,3,3,3,3,3,
-- l   0,1,2,2,2,2,3,3,3,3,3,
-- a   0,1,2,2,3,3,3,3,3,4,4]
matrizLongitudSCM :: Eq a => [a] -> [a] -> Array (Int,Int) Int
matrizLongitudSCM xs ys = q
  where
    n = length xs
    m = length ys
    v = listArray (1,n) xs
    w = listArray (1,m) ys
    q = array ((0,0),(n,m)) [((i,j), f i j) | i <- [0..n], j <- [0..m]]
      where f 0 _ = 0
            f _ 0 = 0
            f i j | v ! i == w ! j = 1 + q ! (i-1,j-1)
                  | otherwise      = max (q ! (i-1,j)) (q ! (i,j-1))
 
-- 3ª solución
-- ===========
 
longitudMayorSublistaCreciente3 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente3 xs =
  maximum (elems (vectorlongitudMayorSublistaCreciente xs))
 
-- (vectorlongitudMayorSublistaCreciente xs) es el vector de longitud n
-- (donde n es el tamaño de xs) tal que el valor i-ésimo es la longitud
-- de la sucesión más larga que termina en el elemento i-ésimo de
-- xs. Por ejemplo,  
--    λ> vectorlongitudMayorSublistaCreciente [3,2,6,4,5,1]
--    array (1,6) [(1,1),(2,1),(3,2),(4,2),(5,3),(6,1)]
vectorlongitudMayorSublistaCreciente :: Ord a => [a] -> Array Int Int
vectorlongitudMayorSublistaCreciente xs = v
  where v = array (1,n) [(i,f i) | i <- [1..n]]
        n = length xs
        w = listArray (1,n) xs
        f 1 = 1
        f i | null ls   = 1
            | otherwise = 1 + maximum ls
          where ls = [v ! j | j <-[1..i-1], w ! j < w ! i]
 
-- Comparación de eficiencia
-- =========================
 
--    λ> longitudMayorSublistaCreciente1 [1..20]
--    20
--    (4.60 secs, 597,014,240 bytes)
--    λ> longitudMayorSublistaCreciente2 [1..20]
--    20
--    (0.03 secs, 361,384 bytes)
--    λ> longitudMayorSublistaCreciente3 [1..20]
--    20
--    (0.03 secs, 253,944 bytes)
--    
--    λ> longitudMayorSublistaCreciente2 [1..2000]
--    2000
--    (8.00 secs, 1,796,495,488 bytes)
--    λ> longitudMayorSublistaCreciente3 [1..2000]
--    2000
--    (5.12 secs, 1,137,667,496 bytes)
--    
--    λ> longitudMayorSublistaCreciente1 [1000,999..1]
--    1
--    (0.95 secs, 97,029,328 bytes)
--    λ> longitudMayorSublistaCreciente2 [1000,999..1]
--    1
--    (7.48 secs, 1,540,857,208 bytes)
--    λ> longitudMayorSublistaCreciente3 [1000,999..1]
--    1
--    (0.86 secs, 160,859,128 bytes)
--    
--    λ> longitudMayorSublistaCreciente1 (show (2^300))
--    10
--    (7.90 secs, 887,495,368 bytes)
--    λ> longitudMayorSublistaCreciente2 (show (2^300))
--    10
--    (0.04 secs, 899,152 bytes)
--    λ> longitudMayorSublistaCreciente3 (show (2^300))
--    10
--    (0.04 secs, 1,907,936 bytes)
--    
--    λ> longitudMayorSublistaCreciente2 (show (2^6000))
--    10
--    (0.06 secs, 9,950,592 bytes)
--    λ> longitudMayorSublistaCreciente3 (show (2^6000))
--    10
--    (3.46 secs, 686,929,744 bytes)
--    
--    λ> import System.Random
--    (0.00 secs, 0 bytes)
--    λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
--    (0.02 secs, 1,993,032 bytes)
--    λ> longitudMayorSublistaCreciente2 xs
--    61
--    (7.73 secs, 1,538,771,392 bytes)
--    λ> longitudMayorSublistaCreciente3 xs
--    61
--    (1.04 secs, 212,538,648 bytes)
--    λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
--    (0.03 secs, 1,993,032 bytes)
--    λ> longitudMayorSublistaCreciente2 xs
--    57
--    (7.56 secs, 1,538,573,680 bytes)
--    λ> longitudMayorSublistaCreciente3 xs
--    57
--    (1.05 secs, 212,293,984 bytes)

Mayor capicúa producto de dos números de n cifras

Un capicúa es un número que es igual leído de izquierda a derecha que de derecha a izquierda.

Definir la función

   mayorCapicuaP :: Integer -> Integer

tal que (mayorCapicuaP n) es el mayor capicúa que es el producto de dos números de n cifras. Por ejemplo,

   mayorCapicuaP 2  ==  9009
   mayorCapicuaP 3  ==  906609
   mayorCapicuaP 4  ==  99000099
   mayorCapicuaP 5  ==  9966006699
   mayorCapicuaP 6  ==  999000000999
   mayorCapicuaP 7  ==  99956644665999

Soluciones

-- 1ª solución
-- ===========
 
mayorCapicuaP1 :: Integer -> Integer
mayorCapicuaP1 n = head (capicuasP n)
 
-- (capicuasP n) es la lista de las capicúas de 2*n cifras que
-- pueden escribirse como productos de dos números de n cifras. Por
-- ejemplo, Por ejemplo,
--    ghci> capicuasP 2
--    [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335,
--     5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003,
--     2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001]
capicuasP n = [x | x <- capicuas n,
                        not (null (productosDosNumerosCifras n x))]
 
-- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a
-- menor. Por ejemplo, 
--    capicuas 1           ==  [99,88,77,66,55,44,33,22,11]
--    take 7 (capicuas 2)  ==  [9999,9889,9779,9669,9559,9449,9339]
capicuas :: Integer -> [Integer]
capicuas n = [capicua x | x <- numerosCifras n]
 
-- (numerosCifras n) es la lista de los números de n cifras de mayor a
-- menor. Por ejemplo,
--    numerosCifras 1           ==  [9,8,7,6,5,4,3,2,1]
--    take 7 (numerosCifras 2)  ==  [99,98,97,96,95,94,93]
--    take 7 (numerosCifras 3)  ==  [999,998,997,996,995,994,993]
numerosCifras :: Integer -> [Integer]
numerosCifras n = [a,a-1..b]
  where a = 10^n-1
        b = 10^(n-1) 
 
-- (capicua n) es la capicúa formada añadiendo el inverso de n a
--  continuación de n. Por ejemplo,
--    capicua 93  ==  9339
capicua :: Integer -> Integer
capicua n = read (xs ++ (reverse xs))
  where xs = show n
 
-- (productosDosNumerosCifras n x) es la lista de los números y de n
-- cifras tales que existe un z de n cifras y x es el producto de y por
-- z. Por ejemplo, 
--    productosDosNumerosCifras 2 9009  ==  [99,91]
productosDosNumerosCifras n x = [y | y <- numeros,
                                     mod x y == 0,
                                     div x y `elem` numeros]
  where numeros = numerosCifras n
 
-- 2ª solución
-- ===========
 
mayorCapicuaP2 :: Integer -> Integer
mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b],
                                  y <- [a,a-1..b],
                                  esCapicua (x*y)] 
  where a = 10^n-1
        b = 10^(n-1)
 
-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353  ==  True
--    esCapicua 357  ==  False
esCapicua :: Integer -> Bool
esCapicua n = xs == reverse xs
  where xs = show n
 
-- 3ª solución
-- ===========
 
mayorCapicuaP3 :: Integer -> Integer
mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b, 
                                  esCapicua (x*y)] 
  where a = 10^n-1
        b = 10^(n-1)
 
-- (pares a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares a b = [(x,z-x) | z <- [a1,a1-1..b1],
                       x <- [a,a-1..b],
                       x <= z-x, z-x <= a]
  where a1 = 2*a
        b1 = 2*b
 
-- 4ª solución
-- ===========
 
mayorCapicuaP4 :: Integer -> Integer
mayorCapicuaP4 n = maximum [x | y <- [a..b],
                                z <- [y..b],
                                let x = y * z,
                                let s = show x,
                                s == reverse s]
  where a = 10^(n-1)
        b = 10^n-1
 
-- 5ª solución
-- ===========
 
mayorCapicuaP5 :: Integer -> Integer
mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)]
  where a = 10^(n-1)
        b = 10^n-1
 
-- (pares2 a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares2 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]]
 
-- 6ª solución
-- ===========
 
mayorCapicuaP6 :: Integer -> Integer
mayorCapicuaP6 n = maximum [x*y | x <- [a..b], 
                                  y <- [x..b] , 
                                  esCapicua (x*y)]
  where a = 10^(n-1)
        b = 10^n-1
 
-- (cifras n) es la lista de las cifras de n en orden inverso. Por
-- ejemplo,  
--    cifras 325  == [5,2,3]
cifras :: Integer -> [Integer]
cifras n 
    | n < 10    = [n]
    | otherwise = (ultima n) : (cifras (quitarUltima n))
 
-- (ultima n) es la última cifra de n. Por ejemplo,
--    ultima 325  ==  5
ultima  :: Integer -> Integer
ultima n =  n - (n `div` 10)*10
 
-- (quitarUltima n) es el número obtenido al quitarle a n su última
-- cifra. Por ejemplo,
--    quitarUltima 325  =>  32 
quitarUltima :: Integer -> Integer
quitarUltima n = (n - (ultima n)) `div` 10
 
-- 7ª solución
-- ===========
 
mayorCapicuaP7 :: Integer -> Integer
mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n]
 
-- (esFactorizable x n) se verifica si x se puede escribir como producto
-- de dos números de n dígitos. Por ejemplo,
--    esFactorizable 1219 2  ==  True
--    esFactorizable 1217 2  ==  False
esFactorizable x n = aux i x
  where b = 10^n-1
        i = floor (sqrt (fromIntegral x))
        aux i x | i > b          = False
                | x `mod` i == 0 = x `div` i < b 
                | otherwise      = aux (i+1) x
 
-- Comparación de eficiencia
-- =========================
 
--    λ> mayorCapicuaP1 3
--    906609
--    (0.07 secs, 18,248,224 bytes)
--    λ> mayorCapicuaP2 3
--    906609
--    (0.51 secs, 555,695,720 bytes)
--    λ> mayorCapicuaP3 3
--    906609
--    (0.96 secs, 780,794,768 bytes)
--    λ> mayorCapicuaP4 3
--    906609
--    (0.24 secs, 255,445,448 bytes)
--    λ> mayorCapicuaP5 3
--    906609
--    (0.33 secs, 317,304,080 bytes)
--    λ> mayorCapicuaP6 3
--    906609
--    (0.26 secs, 274,987,472 bytes)
--    λ> mayorCapicuaP7 3
--    906609
--    (0.02 secs, 1,807,720 bytes)
--    
--    λ> mayorCapicuaP1 5
--    9966006699
--    (9.90 secs, 6,349,454,544 bytes)
--    λ> mayorCapicuaP7 5
--    9966006699
--    (0.06 secs, 15,958,616 bytes)

Máximo número de consecutivos iguales al dado

Definir la función

   maximoConsecutivosIguales :: Eq a => a -> [a] -> Int

tal que (maximoConsecutivosIguales x xs) es el mayor número de elementos consecutivos en xs iguales a x. Por ejemplo,

   maximoConsecutivosIguales 'b' "abbcccbbbd"    ==  3
   maximoConsecutivosIguales 'b' "abbbbcccbbbd"  ==  4
   maximoConsecutivosIguales 'e' "abbcccbbbd"    ==  0

Soluciones

import Data.List (group)
 
maximoConsecutivosIguales :: Eq a => a -> [a] -> Int
maximoConsecutivosIguales x = maximum
                            . (0:)
                            . map length
                            . filter ((== x) . head)
                            . group

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang=”haskell”> y otra con </pre>

Pensamiento

“La programación de computadoras es un arte, porque aplica el conocimiento
acumulado al mundo, porque requiere habilidad e ingenio, y especialmente
porque produce belleza. Un programador que subconscientemente se ve
a sí mismo como un artista disfrutará con lo que hace y lo hará mejor.”

Donald Knuth.

Teorema de existencia de divisores

El teorema de existencia de divisores afirma que

En cualquier subconjunto de {1, 2, …, 2m} con al menos m+1 elementos existen números distintos a, b tales que a divide a b.

Un conjunto de números naturales xs es mayoritario si existe un m tal que la lista de xs es un subconjunto de {1,2,…,2m} con al menos m+1 elementos. Por ejemplo, {2,3,5,6} porque es un subconjunto de {1,2,…,6} con más de 3 elementos.

Definir las funciones

   divisoresMultiplos :: [Integer] -> [(Integer,Integer)]
   esMayoritario :: [Integer] -> Bool

tales que

  • (divisores xs) es la lista de pares de elementos distintos de (a,b) tales que a divide a b. Por ejemplo,
     divisoresMultiplos [2,3,5,6]  ==  [(2,6),(3,6)]
     divisoresMultiplos [2,3,5]    ==  []
     divisoresMultiplos [4..8]     ==  [(4,8)]
  • (esMayoritario xs) se verifica xs es mayoritario. Por ejemplo,
     esMayoritario [2,3,5,6]  ==  True
     esMayoritario [2,3,5]    ==  False

Comprobar con QuickCheck el teorema de existencia de divisores; es decir, en cualquier conjunto mayoritario existen números distintos a, b tales que a divide a b. Para la comprobación se puede usar el siguiente generador de conjuntos mayoritarios

   mayoritario :: Gen [Integer]
   mayoritario = do
     m' <- arbitrary
     let m = 1 + abs m'
     xs' <- sublistOf [1..2*m] `suchThat` (\ys -> genericLength ys > m)
     return xs'

con lo que la propiedad que hay que comprobar con QuickCheck es

   teorema_de_existencia_de_divisores :: Property
   teorema_de_existencia_de_divisores =
     forAll mayoritario (not . null . divisoresMultiplos)

Soluciones

import Data.List (genericLength)
import Test.QuickCheck
 
divisoresMultiplos :: [Integer] -> [(Integer,Integer)]
divisoresMultiplos xs =
  [(x,y) | x <- xs
         , y <- xs
         , y /= x
         , y `mod` x == 0]
 
esMayoritario :: [Integer] -> Bool
esMayoritario xs =
  not (null xs) && length xs > ceiling (n / 2) 
  where n = fromIntegral (maximum xs)
 
-- Comprobación del teorema
-- ========================
 
-- La propiedad es
teorema_de_existencia_de_divisores :: Property
teorema_de_existencia_de_divisores =
  forAll mayoritario (not . null . divisoresMultiplos)
 
-- mayoritario es un generador de conjuntos mayoritarios. Por ejemplo, 
--    λ> sample mayoritario
--    [1,2]
--    [2,5,7,8]
--    [1,2,8,10,14]
--    [3,8,11,12,13,15,18,19,22,23,25,26]
--    [1,3,4,6]
--    [3,6,9,11,12,14,17,19]
mayoritario :: Gen [Integer]
mayoritario = do
  m' <- arbitrary
  let m = 1 + abs m'
  xs' <- sublistOf [1..2*m] `suchThat` (\ys -> genericLength ys > m)
  return xs'
 
-- La comprobación es
--    λ> quickCheck teorema_de_existencia_de_divisores
--    +++ OK, passed 100 tests.

Pensamiento

Guiomar, Guiomar,
mírame en ti castigado:
reo de haberte creado,
ya no te puedo olvidar.

Antonio Machado

Mayor producto de n dígitos consecutivos de un número

Definir la función

   mayorProducto :: Int -> Integer -> Integer

tal que (mayorProducto n x) es el mayor producto de n dígitos consecutivos del número x (suponiendo que x tiene al menos n dígitos). Por ejemplo,

   mayorProducto 2 325                  ==  10
   mayorProducto 5 11111                ==  1
   mayorProducto 5 113111               ==  3
   mayorProducto 5 110111               ==  0
   mayorProducto 5 10151112             ==  10
   mayorProducto 5 101511124            ==  10
   mayorProducto 5 (product [1..1000])  ==  41472

Nota: Este ejercicio está basado en el problema 8 del Proyecto Euler

Soluciones

import Data.List (inits, tails)
import Data.Char (digitToInt)
 
-- 1ª solución
-- ===========
 
mayorProducto :: Int -> Integer -> Integer
mayorProducto n x =
  maximum [product xs | xs <- segmentos n (digitos x)]
 
-- (digitos x) es la lista de las digitos del número x. Por ejemplo, 
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos x = map (toInteger . digitToInt) (show x)
 
-- (segmentos n xs) es la lista de los segmentos de longitud n de la
-- lista xs. Por ejemplo,
--    segmentos 2 [3,5,4,6]  ==  [[3,5],[5,4],[4,6]]
segmentos :: Int -> [Integer] -> [[Integer]]
segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))
 
-- 2ª solución
-- ===========
 
mayorProducto2 :: Int -> Integer -> Integer
mayorProducto2 n x = maximum (aux ns)
    where ns     = [read [d] | d <- show x]
          aux xs | length xs < n = []
                 | otherwise     = product (take n xs) : aux (tail xs)
 
-- 3ª solución
-- ===========
 
mayorProducto3 :: Int -> Integer -> Integer
mayorProducto3 n = maximum
                 . map (product . take n)
                 . filter ((>=n) . length) 
                 . tails
                 . digitos
 
-- 4ª solución
-- ===========
 
mayorProducto4 :: Int -> Integer -> Integer
mayorProducto4 n = maximum  
                 . map (product . map (fromIntegral . digitToInt)) 
                 . filter ((==n) . length) 
                 . concatMap inits
                 . tails 
                 . show
 
-- Comparación de eficiencia
-- =========================
 
--    λ> mayorProducto 5 (product [1..500])
--    28224
--    (0.01 secs, 1,645,256 bytes)
--    λ> mayorProducto2 5 (product [1..500])
--    28224
--    (0.03 secs, 5,848,416 bytes)
--    λ> mayorProducto3 5 (product [1..500])
--    28224
--    (0.03 secs, 1,510,640 bytes)
--    λ> mayorProducto4 5 (product [1..500])
--    28224
--    (1.85 secs, 10,932,551,216 bytes)
--    
--    λ> mayorProducto 5 (product [1..7000])
--    46656
--    (0.10 secs, 68,590,808 bytes)
--    λ> mayorProducto2 5 (product [1..7000])
--    46656
--    (1.63 secs, 157,031,432 bytes)
--    λ> mayorProducto3 5 (product [1..7000])
--    46656
--    (1.55 secs, 65,727,176 bytes)

Pensamiento

“El control de la complejidad es la esencia de la programación.” ~ B.W. Kernigan

Máxima suma de los segmentos

Un segmento de una lista xs es una sublista de xs formada por elementos consecutivos en la lista. El problema de la máxima suma de segmentos consiste en dada una lista de números enteros calcular el máximo de las sumas de todos los segmentos de la lista. Por ejemplo, para la lista [-1,2,-3,5,-2,1,3,-2,-2,-3,6] la máxima suma de segmentos es 7 que es la suma del segmento [5,-2,1,3] y para la lista [-1,-2,-3] es 0 que es la suma de la lista vacía.

Definir la función

   mss :: [Integer] -> Integer

tal que (mss xs) es la máxima suma de los segmentos de xs. Por ejemplo,

   mss [-1,2,-3,5,-2,1,3,-2,-2,-3,6]  ==  7
   mss [-1,-2,-3]                     ==  0
   mss [1..500]                       ==  125250
   mss [1..1000]                      ==  500500
   mss [-500..3]                      ==  6
   mss [-1000..3]                     ==  6

Soluciones

import Data.List (inits,tails)
 
-- 1ª solución
mss :: [Integer] -> Integer
mss = maximum . map sum . segmentos
 
-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,
--    ghci> segmentos "abc"
--    ["","a","ab","abc","","b","bc","","c",""]
segmentos :: [a] -> [[a]]
segmentos = concat . map inits . tails
 
-- 2ª definición:
mss2 :: [Integer] -> Integer
mss2 = maximum . map (maximum . scanl (+) 0) . tails
 
-- 3ª definición:
mss3 :: [Integer] -> Integer
mss3 = maximum . map sum . concatMap tails . inits 
 
-- 4ª definición
mss4 :: [Integer] -> Integer
mss4  = fst . foldr (\x (b,a) -> (max (a+x) b, max 0 (a+x))) (0,0) 
 
-- 5ª definición (con scanl):
mss5 :: [Integer] -> Integer
mss5 = maximum . scanl (\a x -> max 0 a + x) 0
 
-- Comparación de eficiencia
-- =========================
 
--    ghci> mss [1..500]
--    125250
--    (7.52 secs, 2022130824 bytes)
--    
--    ghci> mss2 [1..500]
--    125250
--    (0.01 secs, 10474956 bytes)
--    
--    ghci> mss3 [1..500]
--    125250
--    (0.98 secs, 841862016 bytes)
--    
--    ghci> mss4 [1..500]
--    125250
--    (0.01 secs, 552252 bytes)
--    
--    ghci> mss2 [1..1000]
--    500500
--    (0.06 secs, 54575712 bytes)
--    
--    ghci> mss3 [1..1000]
--    500500
--    (7.87 secs, 7061347900 bytes)
--
--    ghci> mss4 [1..1000]
--    500500
--    (0.01 secs, 549700 bytes)
--    
--    ghci> mss2 [1..2000]
--    2001000
--    (0.29 secs, 216424336 bytes)
--    
--    ghci> mss2 [1..5000]
--    12502500
--    (2.37 secs, 1356384840 bytes)
--    
--    ghci> mss4 [1..5000]
--    12502500
--    (0.02 secs, 1913548 bytes)
--
--    ghci> mss5 [1..5000]
--    12502500
--    (0.01 secs, 2886360 bytes)

Pensamiento

Nubes, sol, prado verde y caserío
en la loma, revueltos. Primavera
puso en el aire de este campo frío
la gracia de sus chopos de ribera.

Antonio Machado

Superación de límites

Una sucesión de puntuaciones se puede representar mediante una lista de números. Por ejemplo, [7,5,9,9,4,5,4,2,5,9,12,1]. En la lista anterior, los puntos en donde se alcanzan un nuevo máximo son 7, 9 y 12 (porque son mayores que todos sus anteriores) y en donde se alcanzan un nuevo mínimo son 7, 5, 4, 2 y 1 (porque son menores que todos sus anteriores). Por tanto, el máximo se ha superado 2 veces y el mínimo 4 veces.

Definir las funciones

   nuevosMaximos :: [Int] -> [Int]
   nuevosMinimos :: [Int] -> [Int]
   nRupturas     :: [Int] -> (Int,Int)

tales que

  • (nuevosMaximos xs) es la lista de los nuevos máximos de xs. Por ejemplo,
     nuevosMaximos [7,5,9,9,4,5,4,2,5,9,12,1]  ==  [7,9,12]
  • (nuevosMinimos xs) es la lista de los nuevos mínimos de xs. Por ejemplo,
     nuevosMinimos [7,5,9,9,4,5,4,2,5,9,12,1]  ==  [7,5,4,2,1]
  • (nRupturas xs) es el par formado por el número de veces que se supera el máximo y el número de veces que se supera el mínimo en xs. Por ejemplo,
     nRupturas [7,5,9,9,4,5,4,2,5,9,12,1]  ==  (2,4)

Soluciones

import Data.List (group, inits)
 
nuevosMaximos :: [Int] -> [Int]
nuevosMaximos xs = map head (group (map maximum xss))
  where xss = tail (inits xs)
 
nuevosMinimos :: [Int] -> [Int]
nuevosMinimos xs = map head (group (map minimum xss))
  where xss = tail (inits xs)
 
nRupturas :: [Int] -> (Int,Int)
nRupturas [] = (0,0)
nRupturas xs =
  ( length (nuevosMaximos xs) - 1
  , length (nuevosMinimos xs) - 1)

Pensamiento

“Todo necio confunde valor y precio.” ~ Antonio Machado.