Recursión – Página 8

Números compuestos por un conjunto de primos

PorJosé A. Alonso 20-abril-201830-abril-2018

Los números compuestos por un conjunto de primos son los números cuyos factores primos pertenecen al conjunto. Por ejemplo, los primeros números compuestos por [2,5,7] son

   1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70,...

1	1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70,...

El 28 es compuesto ya que sus divisores primos son 2 y 7 que están en [2,5,7].

Definir la función

   compuestos :: [Integer] -> [Integer]

1	compuestos :: [Integer] -> [Integer]

tal que (compuesto ps) es la lista de los números compuestos por el conjunto de primos ps. Por ejemplo,

   λ> take 20 (compuestos [2,5,7])
   [1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70]
   λ> take 20 (compuestos [2,5])
   [1,2,4,5,8,10,16,20,25,32,40,50,64,80,100,125,128,160,200,250]
   λ> take 20 (compuestos [2,3,5])
   [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36]
   λ> take 20 (compuestos [3,5,7,11,13])
   [1,3,5,7,9,11,13,15,21,25,27,33,35,39,45,49,55,63,65,75]
   λ> take 15 (compuestos [2])
   [1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384]
   λ> compuestos [2,7] !! (10^4)
   57399514149595471961908157955229677377312712667508119466382354072731648
   λ> compuestos [2,3,5] !! (10^5)
   290237644800000000000000000000000000000

λ> take 20 (compuestos [2,5,7])

[1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70]

λ> take 20 (compuestos [2,5])

[1,2,4,5,8,10,16,20,25,32,40,50,64,80,100,125,128,160,200,250]

λ> take 20 (compuestos [2,3,5])

[1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36]

λ> take 20 (compuestos [3,5,7,11,13])

[1,3,5,7,9,11,13,15,21,25,27,33,35,39,45,49,55,63,65,75]

λ> take 15 (compuestos [2])

[1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384]

λ> compuestos [2,7] !! (10^4)

57399514149595471961908157955229677377312712667508119466382354072731648

λ> compuestos [2,3,5] !! (10^5)

290237644800000000000000000000000000000

Soluciones

import Data.Numbers.Primes (primeFactors)

-- 1ª solución
-- ===========

compuestos1 :: [Integer] -> [Integer]
compuestos1 ps =
  [n | n <- [1..], esCompuesto ps n]

-- (esCompuesto ps n) se verifica si los factores primos de n pertenecen
-- a ps. Por ejemplo, 
--    esCompuesto [2,3,7]    28  ==  True
--    esCompuesto [2,3,7]   140  ==  False
--    esCompuesto [2,3,5,7] 140  ==  True
esCompuesto :: [Integer] -> Integer -> Bool
esCompuesto ps n =
  subconjunto (primeFactors n) ps

-- (subconjunto xs ys) se verifica si todos los elementos de xs
-- pertenecen a ys. Por ejemplo, 
--    subconjunto [2,7,2] [7,5,2]  ==  True
--    subconjunto [2,7,3] [7,5,2]  ==  False
subconjunto :: Eq a => [a] -> [a] -> Bool
subconjunto xs ys =
  all (`elem` ys) xs

-- 2ª solución
-- ===========

compuestos2 :: [Integer] -> [Integer]
compuestos2 ps =
   1 : mezclaTodas (combinaciones ps)

-- (combinaciones ps) es la lista de los productos de cada elemento de
-- ps por los números compuestos con ps. Por ejemplo,
--    λ> take 8 (compuestos4 [2,5,7])
--    [1,2,4,5,7,8,10,14]
--    λ> map (take 6) (combinaciones [2,5,7])
--    [[2,4,8,10,14,16],[5,10,20,25,35,40],[7,14,28,35,49,56]]
combinaciones :: [Integer] -> [[Integer]]
combinaciones ps =
  [[p * q | q <- compuestos2 ps] | p <- ps]

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como
-- sus elementos son listas infinitas ordenadas. Por ejemplo, 
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])
--    [2,3,4,5,6,7,8,9,10,11]
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])
--    [2,4,6,8,9,10,12,14,16,18]
mezclaTodas :: [[Integer]] -> [Integer]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la mezcla, eliminando repetidos, de las lista
-- ordenadas xs e ys. Por ejemplo,  
mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla []     ys              = ys
mezcla xs     []              = xs
mezcla us@(x:xs) vs@(y:ys) | x == y     = x : mezcla xs ys
                           | x < y      = x : mezcla xs vs
                           | otherwise  = y : mezcla us ys

-- 3ª solución
-- ===========

compuestos3 :: [Integer] -> [Integer]
compuestos3 [] = [1]
compuestos3 (p:ps) =
  mezclaTodas [map (*y) (compuestos3 ps) | y <- [p^k | k <- [0..]]]

-- 4ª solución
-- ===========

compuestos4 :: [Integer] -> [Integer]
compuestos4 ps = foldl aux xs (tail ps)
  where p        = head ps
        xs       = [p^k | k <- [0..]]
        aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

-- 5ª solución
-- ===========

compuestos5 :: [Integer] -> [Integer]
compuestos5 = foldl aux [1] 
  where aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

-- 6ª solución
-- ===========

compuestos6 :: [Integer] -> [Integer]
compuestos6 xs = aux
  where aux = 1 : mezclas xs aux
        mezclas []     _  = []
        mezclas (x:xs) zs = mezcla (map (x*) zs) (mezclas xs zs)

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

--    λ> compuestos1 [2,3,5] !! 300
--    84375
--    (5.85 secs, 2,961,101,088 bytes)
--    λ> compuestos2 [2,3,5] !! 300
--    84375
--    (3.54 secs, 311,137,952 bytes)
--    λ> compuestos2 [2,3,5] !! 400
--    312500
--    (13.01 secs, 1,229,801,184 bytes)
--    λ> compuestos3 [2,3,5] !! 400
--    312500
--    (0.02 secs, 2,066,152 bytes)
--    λ> compuestos3 [2,3,5] !! 20000
--    15441834907098675000000
--    (1.57 secs, 203,061,864 bytes)
--    λ> compuestos4 [2,3,5] !! 20000
--    15441834907098675000000
--    (0.40 secs, 53,335,080 bytes)
--    λ> compuestos4 [2,3,5] !! 50000
--    2379528690747474604574166220800
--    (1.25 secs, 170,058,496 bytes)
--    λ> compuestos5 [2,3,5] !! 50000
--    2379528690747474604574166220800
--    (1.26 secs, 170,104,648 bytes)
--    λ> compuestos6 [2,3,5] !! 50000
--    2379528690747474604574166220800
--    (0.26 secs, 40,490,280 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

import Data.Numbers.Primes (primeFactors)

-- 1ª solución

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

compuestos1 :: [Integer] -> [Integer]

compuestos1 ps =

[n | n <- [1..], esCompuesto ps n]

-- (esCompuesto ps n) se verifica si los factores primos de n pertenecen

-- a ps. Por ejemplo,

-- esCompuesto [2,3,7] 28 == True

-- esCompuesto [2,3,7] 140 == False

-- esCompuesto [2,3,5,7] 140 == True

esCompuesto :: [Integer] -> Integer -> Bool

esCompuesto ps n =

subconjunto (primeFactors n) ps

-- (subconjunto xs ys) se verifica si todos los elementos de xs

-- pertenecen a ys. Por ejemplo,

-- subconjunto [2,7,2] [7,5,2] == True

-- subconjunto [2,7,3] [7,5,2] == False

subconjunto :: Eq a => [a] -> [a] -> Bool

subconjunto xs ys =

all (`elem` ys) xs

-- 2ª solución

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

compuestos2 :: [Integer] -> [Integer]

compuestos2 ps =

1 : mezclaTodas (combinaciones ps)

-- (combinaciones ps) es la lista de los productos de cada elemento de

-- ps por los números compuestos con ps. Por ejemplo,

-- λ> take 8 (compuestos4 [2,5,7])

-- [1,2,4,5,7,8,10,14]

-- λ> map (take 6) (combinaciones [2,5,7])

-- [[2,4,8,10,14,16],[5,10,20,25,35,40],[7,14,28,35,49,56]]

combinaciones :: [Integer] -> [[Integer]]

combinaciones ps =

[[p * q | q <- compuestos2 ps] | p <- ps]

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como

-- sus elementos son listas infinitas ordenadas. Por ejemplo,

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])

-- [2,3,4,5,6,7,8,9,10,11]

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])

-- [2,4,6,8,9,10,12,14,16,18]

mezclaTodas :: [[Integer]] -> [Integer]

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la mezcla, eliminando repetidos, de las lista

-- ordenadas xs e ys. Por ejemplo,

mezcla :: [Integer] -> [Integer] -> [Integer]

mezcla [] ys = ys

mezcla xs [] = xs

mezcla us@(x:xs) vs@(y:ys) | x == y = x : mezcla xs ys

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

-- 3ª solución

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

compuestos3 :: [Integer] -> [Integer]

compuestos3 [] = [1]

compuestos3 (p:ps) =

mezclaTodas [map (*y) (compuestos3 ps) | y <- [p^k | k <- [0..]]]

-- 4ª solución

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

compuestos4 :: [Integer] -> [Integer]

compuestos4 ps = foldl aux xs (tail ps)

where p = head ps

xs = [p^k | k <- [0..]]

aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

-- 5ª solución

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

compuestos5 :: [Integer] -> [Integer]

compuestos5 = foldl aux [1]

where aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

-- 6ª solución

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

compuestos6 :: [Integer] -> [Integer]

compuestos6 xs = aux

where aux = 1 : mezclas xs aux

mezclas [] _ = []

mezclas (x:xs) zs = mezcla (map (x*) zs) (mezclas xs zs)

-- Comparación de eficiencia

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

-- λ> compuestos1 [2,3,5] !! 300

-- 84375

-- (5.85 secs, 2,961,101,088 bytes)

-- λ> compuestos2 [2,3,5] !! 300

-- 84375

-- (3.54 secs, 311,137,952 bytes)

-- λ> compuestos2 [2,3,5] !! 400

-- 312500

-- (13.01 secs, 1,229,801,184 bytes)

-- λ> compuestos3 [2,3,5] !! 400

-- 312500

-- (0.02 secs, 2,066,152 bytes)

-- λ> compuestos3 [2,3,5] !! 20000

-- 15441834907098675000000

-- (1.57 secs, 203,061,864 bytes)

-- λ> compuestos4 [2,3,5] !! 20000

-- 15441834907098675000000

-- (0.40 secs, 53,335,080 bytes)

-- λ> compuestos4 [2,3,5] !! 50000

-- 2379528690747474604574166220800

-- (1.25 secs, 170,058,496 bytes)

-- λ> compuestos5 [2,3,5] !! 50000

-- 2379528690747474604574166220800

-- (1.26 secs, 170,104,648 bytes)

-- λ> compuestos6 [2,3,5] !! 50000

-- 2379528690747474604574166220800

-- (0.26 secs, 40,490,280 bytes)

Notas de evaluación acumulada

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

La evaluación acumulada, las notas se calculan recursivamente con la siguiente función

   N(1) = E(1)
   N(k) = máximo(E(k), 0.4*N(k-1)+0.6*E(k))

1 2	N(1) = E(1) N(k) = máximo(E(k), 0.4N(k-1)+0.6E(k))

donde E(k) es la nota del examen k. Por ejemplo, si las notas de los exámenes son [3,7,6,3] entonces las acumuladas son [3.0,7.0,6.4,4.4]

Las notas e los exámenes se encuentran en ficheros CSV con los valores separados por comas. Cada línea representa la nota de un alumno, el primer valor es el identificador del alumno y los restantes son sus notas. Por ejemplo, el contenido de examenes.csv es

   juaruigar,3,7,9,3
   evadialop,3,6,7,4
   carrodmes,0,9,8,7

juaruigar,3,7,9,3

evadialop,3,6,7,4

carrodmes,0,9,8,7

Definir las funciones

   acumuladas      :: [Double] -> [Double]
   notasAcumuladas :: FilePath -> FilePath -> IO ()

1 2	acumuladas :: [Double] -> [Double] notasAcumuladas :: FilePath -> FilePath -> IO ()

tales que

(acumuladas xs) es la lista de las notas acumuladas (redondeadas con un decimal) de los notas de los exámenes xs. Por ejemplo,

     acumuladas [2,5]      ==  [2.0,5.0]
     acumuladas [5,2]      ==  [5.0,3.2]
     acumuladas [3,7,6,3]  ==  [3.0,7.0,6.4,4.4]
     acumuladas [3,6,7,3]  ==  [3.0,6.0,7.0,4.6]

acumuladas [2,5] == [2.0,5.0]

acumuladas [5,2] == [5.0,3.2]

acumuladas [3,7,6,3] == [3.0,7.0,6.4,4.4]

acumuladas [3,6,7,3] == [3.0,6.0,7.0,4.6]

(notasAcumuladas f1 f2) que escriba en el fichero f2 las notas acumuladas correspondientes a las notas de los exámenes del fichero f1. Por ejemplo, al evaluar

     notasAcumuladas "examenes.csv" "acumuladas.csv"

1	notasAcumuladas "examenes.csv" "acumuladas.csv"

escribe en el fichero acumuladas.csv

     juaruigar,3.0,7.0,9.0,5.4
     evadialop,3.0,6.0,7.0,5.2
     carrodmes,0.0,9.0,8.4,7.6

juaruigar,3.0,7.0,9.0,5.4

evadialop,3.0,6.0,7.0,5.2

carrodmes,0.0,9.0,8.4,7.6

Soluciones

import Text.CSV
import Data.Either

-- Definicioń de acumuladas
-- ========================

acumuladas :: [Double] -> [Double]
acumuladas = reverse . aux . reverse
  where aux []     = []
        aux [x]    = [x]
        aux (x:xs) = conUnDecimal (max x (0.6*x+0.4*y)) : y : ys 
          where (y:ys) = aux xs

--    conUnDecimal 7.26  ==  7.3
--    conUnDecimal 7.24  ==  7.2
conUnDecimal :: Double -> Double
conUnDecimal x = fromIntegral (round (10*x)) / 10

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

notasAcumuladas :: FilePath -> FilePath -> IO ()
notasAcumuladas f1 f2 = do
  cs <- readFile f1
  writeFile f2 (unlines (map ( acumuladaACadena
                             . notaAAcumuladas
                             . listaANota
                             . cadenaALista
                             )
                             (contenidoALineasDeNotas cs)))

--   λ> contenidoALineasDeNotas "juaruigar,3,7,6,3\nevadialop,3,6,7,3\n\n  \n"
--   ["juaruigar,3,7,6,3","evadialop,3,6,7,3"]
contenidoALineasDeNotas :: String -> [String]
contenidoALineasDeNotas = filter esLineaDeNotas . lines
  where esLineaDeNotas = elem ','

--    cadenaALista "a,b c,d"            ==  ["a","b c","d"]
--    cadenaALista "juaruigar,3,7,6,3"  ==  ["juaruigar","3","7","6","3"]
cadenaALista :: String -> [String]
cadenaALista cs
  | tieneComas cs = d : cadenaALista ds
  | otherwise     = [cs]
  where (d,_:ds)   = span (/=',') cs
        tieneComas = elem ','

--    λ> listaANota ["juaruigar","3","7","6","3"]
--    ("juaruigar",[3.0,7.0,6.0,3.0])
listaANota :: [String] -> (String,[Double])
listaANota (x:xs) = (x,map read xs)

--   λ> notaAAcumuladas ("juaruigar",[3.0,7.0,6.0,3.0])
--   ("juaruigar",[3.0,7.0,6.4,4.4])
notaAAcumuladas :: (String,[Double]) -> (String,[Double])
notaAAcumuladas (x,xs) = (x, acumuladas xs)

--    λ> acumuladaACadena ("juaruigar",[3.0,7.0,6.4,4.4])
--    "juaruigar,3.0,7.0,6.4,4.4"
acumuladaACadena :: (String,[Double]) -> String
acumuladaACadena (x,xs) =
  x ++ "," ++ tail (init (show xs))

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

notasAcumuladas2 :: FilePath -> FilePath -> IO ()
notasAcumuladas2 f1 f2 = do
  cs <- readFile f1
  let (Right csv) = parseCSV f1 cs
  let notas = [xs | xs <- csv, length xs > 1]
  writeFile f2 (unlines (map ( acumuladaACadena
                             . notaAAcumuladas
                             . listaANota
                             )
                             notas))

import Text.CSV

import Data.Either

-- Definicioń de acumuladas

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

acumuladas :: [Double] -> [Double]

acumuladas = reverse . aux . reverse

where aux [] = []

aux [x] = [x]

aux (x:xs) = conUnDecimal (max x (0.6*x+0.4*y)) : y : ys

where (y:ys) = aux xs

-- conUnDecimal 7.26 == 7.3

-- conUnDecimal 7.24 == 7.2

conUnDecimal :: Double -> Double

conUnDecimal x = fromIntegral (round (10*x)) / 10

-- 1ª definición de notasAcumuladas

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

notasAcumuladas :: FilePath -> FilePath -> IO ()

notasAcumuladas f1 f2 = do

cs <- readFile f1

writeFile f2 (unlines (map ( acumuladaACadena

. notaAAcumuladas

. listaANota

. cadenaALista

)

(contenidoALineasDeNotas cs)))

-- λ> contenidoALineasDeNotas "juaruigar,3,7,6,3\nevadialop,3,6,7,3\n\n \n"

-- ["juaruigar,3,7,6,3","evadialop,3,6,7,3"]

contenidoALineasDeNotas :: String -> [String]

contenidoALineasDeNotas = filter esLineaDeNotas . lines

where esLineaDeNotas = elem ','

-- cadenaALista "a,b c,d" == ["a","b c","d"]

-- cadenaALista "juaruigar,3,7,6,3" == ["juaruigar","3","7","6","3"]

cadenaALista :: String -> [String]

cadenaALista cs

| tieneComas cs = d : cadenaALista ds

| otherwise = [cs]

where (d,_:ds) = span (/=',') cs

tieneComas = elem ','

-- λ> listaANota ["juaruigar","3","7","6","3"]

-- ("juaruigar",[3.0,7.0,6.0,3.0])

listaANota :: [String] -> (String,[Double])

listaANota (x:xs) = (x,map read xs)

-- λ> notaAAcumuladas ("juaruigar",[3.0,7.0,6.0,3.0])

-- ("juaruigar",[3.0,7.0,6.4,4.4])

notaAAcumuladas :: (String,[Double]) -> (String,[Double])

notaAAcumuladas (x,xs) = (x, acumuladas xs)

-- λ> acumuladaACadena ("juaruigar",[3.0,7.0,6.4,4.4])

-- "juaruigar,3.0,7.0,6.4,4.4"

acumuladaACadena :: (String,[Double]) -> String

acumuladaACadena (x,xs) =

x ++ "," ++ tail (init (show xs))

-- 2ª definición de notasAcumuladas

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

notasAcumuladas2 :: FilePath -> FilePath -> IO ()

notasAcumuladas2 f1 f2 = do

cs <- readFile f1

let (Right csv) = parseCSV f1 cs

let notas = [xs | xs <- csv, length xs > 1]

writeFile f2 (unlines (map ( acumuladaACadena

. notaAAcumuladas

. listaANota

)

notas))

Reducción de opuestos

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

Se considera el siguiente procedimiento de reducción de listas: busca un par de elementos consecutivos iguales pero con signos opuestos, se eliminan dichos elementos y se continúa el proceso hasta que no se encuentren pares de elementos consecutivos iguales pero con signos opuestos. Por ejemplo, la reducción de [-2,1,-1,2,3,4,-3] es

   [-2,1,-1,2,3,4,-3]    (se elimina el par (1,-1))
   -> [-2,2,3,4,-3]      (se elimina el par (-2,2))
   -> [3,4,-3]           (el par (3,-3) no son consecutivos)

[-2,1,-1,2,3,4,-3] (se elimina el par (1,-1))

-> [-2,2,3,4,-3] (se elimina el par (-2,2))

-> [3,4,-3] (el par (3,-3) no son consecutivos)

Definir la función

   reducida :: [Int] -> [Int]

1	reducida :: [Int] -> [Int]

tal que (reducida xs) es la lista obtenida aplicando a xs el de eliminación de pares de elementos consecutivos opuestos. Por ejemplo,

   reducida [-2,1,-1,2,3,4,-3]           == [3,4,-3]
   reducida [-2,1,-1,2,3,-4,4,-3]        == []
   reducida [-2,1,-1,2,5,3,-4,4,-3]      == [5]
   reducida [-2,1,-1,2,5,3,-4,4,-3,-5]   == []

reducida [-2,1,-1,2,3,4,-3] == [3,4,-3]

reducida [-2,1,-1,2,3,-4,4,-3] == []

reducida [-2,1,-1,2,5,3,-4,4,-3] == [5]

reducida [-2,1,-1,2,5,3,-4,4,-3,-5] == []

Soluciones

-- 1ª solución
-- ===========

reducida :: [Int] -> [Int]
reducida xs | xs == ys  = xs
            | otherwise = reducida ys
            where ys = paso xs

paso :: [Int] -> [Int]
paso [] = []
paso [x] = [x]
paso (x:y:zs) | x == -y   = paso zs
              | otherwise = x : paso (y:zs)

-- 2ª solución
-- ===========

reducida2 :: [Int] -> [Int]
reducida2 xs = aux xs []
    where aux [] ys                   = reverse ys
          aux (x:xs) (y:ys) | x == -y = aux xs ys
          aux (x:xs) ys               = aux xs (x:ys)

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

--    λ> reducida (take (10^7) (cycle [1,-1]))
--    []
--    (9.40 secs, 1,280,127,720 bytes)
--    λ> reducida2 (take (10^7) (cycle [1,-1]))
--    []
--    (12.16 secs, 2,080,127,560 bytes)

-- 1ª solución

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

reducida :: [Int] -> [Int]

reducida xs | xs == ys = xs

| otherwise = reducida ys

where ys = paso xs

paso :: [Int] -> [Int]

paso [] = []

paso [x] = [x]

paso (x:y:zs) | x == -y = paso zs

| otherwise = x : paso (y:zs)

-- 2ª solución

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

reducida2 :: [Int] -> [Int]

reducida2 xs = aux xs []

where aux [] ys = reverse ys

aux (x:xs) (y:ys) | x == -y = aux xs ys

aux (x:xs) ys = aux xs (x:ys)

-- Comparación de eficiencia

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

-- λ> reducida (take (10^7) (cycle [1,-1]))

-- []

-- (9.40 secs, 1,280,127,720 bytes)

-- λ> reducida2 (take (10^7) (cycle [1,-1]))

-- []

-- (12.16 secs, 2,080,127,560 bytes)

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)

Búsqueda en los dígitos de pi

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

El fichero Digitos_de_pi.txt contiene el número pi con un millón de decimales; es decir,

   3.1415926535897932384626433832 ... 83996346460422090106105779458151

1	3.1415926535897932384626433832 ... 83996346460422090106105779458151

Definir la función

   posicion :: String -> IO (Maybe Int)

1	posicion :: String -> IO (Maybe Int)

tal que (posicion n) es (Just k) si k es la posición de n en la sucesión formada por un millón dígitos decimales del número pi y Nothing si n no ocurre en dicha sucesión. Por ejemplo,

   λ> posicion "15"
   Just 3
   λ> posicion "2017"
   Just 8897
   λ> posicion "022017"
   Just 382052
   λ> posicion "14022017"
   Nothing
   λ> posicion "999999"
   Just 762
   λ> posicion "458151"
   Just 999995

λ> posicion "15"

Just 3

λ> posicion "2017"

Just 8897

λ> posicion "022017"

Just 382052

λ> posicion "14022017"

Nothing

λ> posicion "999999"

Just 762

λ> posicion "458151"

Just 999995

Nota. Se puede comprobar la función mediante The pi-search page o Pi search engine.

Soluciones

import Data.List (isPrefixOf)

posicion :: String -> IO (Maybe Int)
posicion ns = do
  ds <- readFile "Digitos_de_pi.txt"
  return (posicionEnLista (drop 2 ds) ns)

posicionEnLista :: Eq a => [a] -> [a] -> Maybe Int
posicionEnLista xs ys = aux xs 1
  where aux [] _ = Nothing
        aux (x:xs) n | ys `isPrefixOf` (x:xs) = Just n
                     | otherwise              = aux xs (n+1)

import Data.List (isPrefixOf)

posicion :: String -> IO (Maybe Int)

posicion ns = do

ds <- readFile "Digitos_de_pi.txt"

return (posicionEnLista (drop 2 ds) ns)

posicionEnLista :: Eq a => [a] -> [a] -> Maybe Int

posicionEnLista xs ys = aux xs 1

where aux [] _ = Nothing

aux (x:xs) n | ys `isPrefixOf` (x:xs) = Just n

| otherwise = aux xs (n+1)

Números superpares

PorJosé A. Alonso 12-abril-201819-abril-2018

Definir la función

   superpar :: Int -> Bool

1	superpar :: Int -> Bool

tal que (superpar n) se verifica si n es un número par tal que todos sus dígitos son pares. Por ejemplo,

   superpar 426  ==  True
   superpar 456  ==  False

1 2	superpar 426 == True superpar 456 == False

Soluciones

-- 1ª definición (por recursión)
superpar :: Int -> Bool
superpar n | n < 10    = even n
           | otherwise = even n && superpar (n `div` 10)

-- 2ª definición (por comprensión):
superpar2 :: Int -> Bool
superpar2 n = and [even d | d <- digitos n]

digitos :: Int -> [Int]
digitos n = [read [d] | d <- show n]

-- 3ª definición (por recursión sobre los dígitos):
superpar3 :: Int -> Bool
superpar3 n = sonPares (digitos n)
    where sonPares []     = True
          sonPares (d:ds) = even d && sonPares ds

-- la función sonPares se puede definir por plegado:
superpar3' :: Int -> Bool
superpar3' n = sonPares (digitos n)
    where sonPares ds = foldr ((&&) . even) True ds

-- 4ª definición (con all):
superpar4 :: Int -> Bool
superpar4 n = all even (digitos n)

-- 5ª definición (con filter):
superpar5 :: Int -> Bool
superpar5 n = filter even (digitos n) == digitos n

-- 6ª definición (con filter):
superpar6 :: Int -> Bool
superpar6 n = all (`elem` "02468") (show n)

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

superpar :: Int -> Bool

superpar n | n < 10 = even n

| otherwise = even n && superpar (n `div` 10)

-- 2ª definición (por comprensión):

superpar2 :: Int -> Bool

superpar2 n = and [even d | d <- digitos n]

digitos :: Int -> [Int]

digitos n = [read [d] | d <- show n]

-- 3ª definición (por recursión sobre los dígitos):

superpar3 :: Int -> Bool

superpar3 n = sonPares (digitos n)

where sonPares [] = True

sonPares (d:ds) = even d && sonPares ds

-- la función sonPares se puede definir por plegado:

superpar3' :: Int -> Bool

superpar3' n = sonPares (digitos n)

where sonPares ds = foldr ((&&) . even) True ds

-- 4ª definición (con all):

superpar4 :: Int -> Bool

superpar4 n = all even (digitos n)

-- 5ª definición (con filter):

superpar5 :: Int -> Bool

superpar5 n = filter even (digitos n) == digitos n

-- 6ª definición (con filter):

superpar6 :: Int -> Bool

superpar6 n = all (`elem` "02468") (show n)

Ampliación de árboles binarios

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

Representamos los árboles binarios mediante el tipo de dato

   data Arbol a = H a
                | N a (Arbol a) (Arbol a)
     deriving Show

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

Una forma de ampliar un árbol binario es añadiendo un nuevo nivel donde
las nuevas hojas sean iguales a la suma de los valores de los nodos
desde el padre hasta llegar a la raíz (inclusives). Por ejemplo:

      5               5       |         3                3
     / \             / \      |        / \             /   \
    2   0    ==>    2   0     |       2   4    ==>    2     4
                   / \ / \    |      / \             / \   / \
                  7  7 5  5   |     0   1           0   1 7   7
                              |                    /\   /\
                              |                   5  5 6  6

5 5 | 3 3

/ \ / \ | / \ / \

2 0 ==> 2 0 | 2 4 ==> 2 4

/ \ / \ | / \ / \ / \

7 7 5 5 | 0 1 0 1 7 7

| /\ /\

| 5 5 6 6

Definir la función

   ampliaArbol:: Num a => Arbol a -> Arbol a

1	ampliaArbol:: Num a => Arbol a -> Arbol a

tal que (ampliaArbol a) es el árbol a ampliado en un nivel. Por
ejemplo,

   λ> ampliaArbol (N 5 (H 2)(H 0))
   N 5 (N 2 (H 7) (H 7)) (N 0 (H 5) (H 5))
   λ> ampliaArbol (N 3 (N 2 (H 0) (H 1)) (H 4))
   N 3 (N 2 (N 0 (H 5) (H 5)) (N 1 (H 6) (H 6))) (N 4 (H 7) (H 7))
   λ> ampliaArbol (H 1)
   N 1 (H 1) (H 1)
   λ> ampliaArbol N 1 (H 1) (H 1)
   N 1 (N 1 (H 2) (H 2)) (N 1 (H 2) (H 2))

λ> ampliaArbol (N 5 (H 2)(H 0))

N 5 (N 2 (H 7) (H 7)) (N 0 (H 5) (H 5))

λ> ampliaArbol (N 3 (N 2 (H 0) (H 1)) (H 4))

N 3 (N 2 (N 0 (H 5) (H 5)) (N 1 (H 6) (H 6))) (N 4 (H 7) (H 7))

λ> ampliaArbol (H 1)

N 1 (H 1) (H 1)

λ> ampliaArbol N 1 (H 1) (H 1)

N 1 (N 1 (H 2) (H 2)) (N 1 (H 2) (H 2))

Soluciones

data Arbol a = H a
             | N a (Arbol a) (Arbol a)
  deriving Show

ampliaArbol :: Num a => Arbol a -> Arbol a
ampliaArbol a = aux 0 a
  where aux n (H x)     = N x (H (n+x)) (H (n+x))
        aux n (N x i d) = N x (aux (n+x) i) (aux (n+x) d)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

ampliaArbol :: Num a => Arbol a -> Arbol a

ampliaArbol a = aux 0 a

where aux n (H x) = N x (H (n+x)) (H (n+x))

aux n (N x i d) = N x (aux (n+x) i) (aux (n+x) d)

Clases de equivalencia

PorJosé A. Alonso 5-abril-201812-abril-2018

Definir la función

   clasesEquivalencia :: Ord a => 
                         Set a -> (a -> a -> Bool) -> Set (Set a)

1 2	clasesEquivalencia :: Ord a => Set a -> (a -> a -> Bool) -> Set (Set a)

tal que (clasesEquivalencia xs r) es el conjunto de las clases de equivalencia de xs respecto de la relación de equivalencia r. Por ejemplo,

   ghci> let c = fromList [-3..3]
   ghci> clasesEquivalencia c (\x y -> x `mod` 3 == y `mod` 3)
   fromList [fromList [-3,0,3],fromList [-2,1],fromList [-1,2]]
   ghci> clasesEquivalencia c (\x y -> (x - y) `mod` 2 == 0)
   fromList [fromList [-3,-1,1,3],fromList [-2,0,2]]

ghci> let c = fromList [-3..3]

ghci> clasesEquivalencia c (\x y -> x `mod` 3 == y `mod` 3)

fromList [fromList [-3,0,3],fromList [-2,1],fromList [-1,2]]

ghci> clasesEquivalencia c (\x y -> (x - y) `mod` 2 == 0)

fromList [fromList [-3,-1,1,3],fromList [-2,0,2]]

Soluciones

import Data.Set as S

clasesEquivalencia :: Ord a => 
                      Set a -> (a -> a -> Bool) -> Set (Set a)
clasesEquivalencia xs r 
    | S.null xs =  empty
    | otherwise =  us `insert` clasesEquivalencia vs r
    where (y,ys)  = deleteFindMin xs
          (us,vs) = partition (r y) xs

import Data.Set as S

clasesEquivalencia :: Ord a =>

Set a -> (a -> a -> Bool) -> Set (Set a)

clasesEquivalencia xs r

| S.null xs = empty

| otherwise = us `insert` clasesEquivalencia vs r

where (y,ys) = deleteFindMin xs

(us,vs) = partition (r y) xs

La carrera de Collatz

PorJosé A. Alonso 4-abril-201811-abril-2018

Sea f la siguiente función, aplicable a cualquier número entero positivo:

Si el número es par, se divide entre 2.
Si el número es impar, se multiplica por 3 y se suma 1.

La carrera de Collatz consiste en, dada una lista de números ns, sustituir cada número n de ns por f(n) hasta que alguno sea igual a 1. Por ejemplo, la siguiente sucesión es una carrera de Collatz

   [ 3, 6,20, 49, 73]
   [10, 3,10,148,220]
   [ 5,10, 5, 74,110]
   [16, 5,16, 37, 55]
   [ 8,16, 8,112,166]
   [ 4, 8, 4, 56, 83]
   [ 2, 4, 2, 28,250]
   [ 1, 2, 1, 14,125]

[ 3, 6,20, 49, 73]

[10, 3,10,148,220]

[ 5,10, 5, 74,110]

[16, 5,16, 37, 55]

[ 8,16, 8,112,166]

[ 4, 8, 4, 56, 83]

[ 2, 4, 2, 28,250]

[ 1, 2, 1, 14,125]

En esta carrera, los ganadores son 3 y 20.

Definir la función

   ganadores :: [Int] -> [Int]

1	ganadores :: [Int] -> [Int]

tal que (ganadores ns) es la lista de los ganadores de la carrera de Collatz a partir de la lista inicial ns. Por ejmplo,

   ganadores [3,6,20,49,73]  ==  [3,20]

1	ganadores [3,6,20,49,73] == [3,20]

Soluciones

ganadores :: [Int] -> [Int]
ganadores xs = selecciona xs (final xs)

-- (final xs) es el estado final de la carrera de Collatz a partir de
-- xs. Por ejemplo,
--    final [3,6,20,49,73]  ==  [1,2,1,14,125]
final :: [Int] -> [Int]
final xs | elem 1 xs = xs
         | otherwise = final [siguiente x | x <- xs]

-- (siguiente x) es el siguiente de x en la carrera de Collatz. Por
-- ejemplo, 
--    siguiente 3  ==  10
--    siguiente 6  ==  3
siguiente :: Int -> Int
siguiente x | even x    = x `div` 2
            | otherwise = 3*x+1

-- (selecciona xs ys) es la lista de los elementos de xs cuyos tales que
-- los elementos de ys en la misma posición son iguales a 1. Por ejemplo,
--    selecciona [3,6,20,49,73] [1,2,1,14,125]  ==  [3,20]
selecciona :: [Int] -> [Int] -> [Int]
selecciona xs ys =
  [x | (x,y) <- zip xs ys, y == 1]

ganadores :: [Int] -> [Int]

ganadores xs = selecciona xs (final xs)

-- (final xs) es el estado final de la carrera de Collatz a partir de

-- xs. Por ejemplo,

-- final [3,6,20,49,73] == [1,2,1,14,125]

final :: [Int] -> [Int]

final xs | elem 1 xs = xs

| otherwise = final [siguiente x | x <- xs]

-- (siguiente x) es el siguiente de x en la carrera de Collatz. Por

-- ejemplo,

-- siguiente 3 == 10

-- siguiente 6 == 3

siguiente :: Int -> Int

siguiente x | even x = x `div` 2

| otherwise = 3*x+1

-- (selecciona xs ys) es la lista de los elementos de xs cuyos tales que

-- los elementos de ys en la misma posición son iguales a 1. Por ejemplo,

-- selecciona [3,6,20,49,73] [1,2,1,14,125] == [3,20]

selecciona :: [Int] -> [Int] -> [Int]

selecciona xs ys =

[x | (x,y) <- zip xs ys, y == 1]

Árbol de subconjuntos

PorJosé A. Alonso 30-marzo-20187-abril-2018

Definir las siguientes funciones

   arbolSubconjuntos       :: [a] -> Tree [a]
   nNodosArbolSubconjuntos :: Integer -> Integer
   sumaNNodos              :: Integer -> Integer

arbolSubconjuntos :: [a] -> Tree [a]

nNodosArbolSubconjuntos :: Integer -> Integer

sumaNNodos :: Integer -> Integer

tales que

(arbolSubconjuntos xs) es el árbol de los subconjuntos de xs. Por ejemplo.

     λ> putStrLn (drawTree (arbolSubconjuntos "abc"))
     abc
     |
     +- bc
     |  |
     |  +- c
     |  |
     |  `- b
     |
     +- ac
     |  |
     |  +- c
     |  |
     |  `- a
     |
     `- ab
        |
        +- b
        |
        `- a

λ> putStrLn (drawTree (arbolSubconjuntos "abc"))

abc

+- bc

| |

| +- c

| |

| `- b

+- ac

| |

| +- c

| |

| `- a

`- ab

+- b

`- a

(nNodosArbolSubconjuntos xs) es el número de nodos del árbol de xs. Por ejemplo

     nNodosArbolSubconjuntos "abc"  ==  10
     nNodosArbolSubconjuntos [1..4*10^4] `mod` (7+10^9) == 546503960

1 2	nNodosArbolSubconjuntos "abc" == 10 nNodosArbolSubconjuntos [1..4*10^4] `mod` (7+10^9) == 546503960

(sumaNNodos n) es la suma del número de nodos de los árboles de los subconjuntos de [1..k] para 1 <= k <= n. Por ejemplo,

     λ> sumaNNodos 3  ==  14
     sumaNNodos (4*10^4) `mod` (7+10^9)  ==  249479844

1 2	λ> sumaNNodos 3 == 14 sumaNNodos (4*10^4) `mod` (7+10^9) == 249479844

Soluciones

import Data.List (genericLength, genericTake)
import Data.Tree (Tree (Node))

-- Definición de arbolSubconjuntos
-- ===============================

arbolSubconjuntos :: [a] -> Tree [a]
arbolSubconjuntos [x] = Node [x] []
arbolSubconjuntos xs =
  Node xs (map arbolSubconjuntos (sinUno xs))

-- (sinUno xs) es la lista obtenidas eliminando un elemento de xs. Por
-- ejemplo, 
--    sinUno "abcde"  ==  ["bcde","acde","abde","abce","abcd"]
sinUno :: [a] -> [[a]]
sinUno xs =
  [ys ++ zs | n <- [0..length xs - 1]
            , let (ys,_:zs) = splitAt n xs]       

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

nNodosArbolSubconjuntos :: [a] -> Integer
nNodosArbolSubconjuntos =
  fromIntegral . length . arbolSubconjuntos 

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

nNodosArbolSubconjuntos2 :: [a] -> Integer
nNodosArbolSubconjuntos2 = aux . genericLength
  where aux 1 = 1
        aux n = 1 + n * aux (n-1)

-- 3ª definición de nNodosArbolSubconjuntos
-- ========================================

nNodosArbolSubconjuntos3 :: [a] -> Integer
nNodosArbolSubconjuntos3 xs =
  sucNNodos !! (n-1)
  where n = length xs

-- sucNNodos es la sucesión de los números de nodos de los árboles de
-- los subconjuntos con 1, 2, ... elementos. Por ejemplo.
--    λ> take 10 sucNNodos
--    [1,3,10,41,206,1237,8660,69281,623530,6235301]
sucNNodos :: [Integer]
sucNNodos =
  1 : map (+ 1) (zipWith (*) [2..] sucNNodos)

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

--    λ> nNodosArbolSubconjuntos 10
--    6235301
--    (9.66 secs, 5,491,704,944 bytes)
--    λ> nNodosArbolSubconjuntos2 10
--    6235301
--    (0.00 secs, 145,976 bytes)
--
--    λ> length (show (nNodosArbolSubconjuntos2 (4*10^4)))
--    166714
--    (1.07 secs, 2,952,675,472 bytes)
--    λ> length (show (nNodosArbolSubconjuntos3 (4*10^4)))
--    166714
--    (1.53 secs, 2,959,020,680 bytes)

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

sumaNNodos :: Integer -> Integer
sumaNNodos n =
  sum [nNodosArbolSubconjuntos [1..k] | k <- [1..n]]

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

sumaNNodos2 :: Integer -> Integer
sumaNNodos2 n =
  sum [nNodosArbolSubconjuntos2 [1..k] | k <- [1..n]]

-- 3ª definición de sumaNNodos
-- ===========================

sumaNNodos3 :: Integer -> Integer
sumaNNodos3 n =
  sum (genericTake n sucNNodos)

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

--    λ> sumaNNodos 10 `mod` (7+10^9)
--    6938270
--    (16.00 secs, 9,552,410,688 bytes)
--    λ> sumaNNodos2 10 `mod` (7+10^9)
--    6938270
--    (0.00 secs, 177,632 bytes)
-- 
--    λ> sumaNNodos2 (2*10^3) `mod` (7+10^9)
--    851467820
--    (2.62 secs, 4,622,117,976 bytes)
--    λ> sumaNNodos3 (2*10^3) `mod` (7+10^9)
--    851467820
--    (0.01 secs, 8,645,336 bytes)

100

101

102

103

104

import Data.List (genericLength, genericTake)

import Data.Tree (Tree (Node))

-- Definición de arbolSubconjuntos

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

arbolSubconjuntos :: [a] -> Tree [a]

arbolSubconjuntos [x] = Node [x] []

arbolSubconjuntos xs =

Node xs (map arbolSubconjuntos (sinUno xs))

-- (sinUno xs) es la lista obtenidas eliminando un elemento de xs. Por

-- ejemplo,

-- sinUno "abcde" == ["bcde","acde","abde","abce","abcd"]

sinUno :: [a] -> [[a]]

sinUno xs =

[ys ++ zs | n <- [0..length xs - 1]

, let (ys,_:zs) = splitAt n xs]

-- 1ª definición de nNodosArbolSubconjuntos

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

nNodosArbolSubconjuntos :: [a] -> Integer

nNodosArbolSubconjuntos =

fromIntegral . length . arbolSubconjuntos

-- 2ª definición de nNodosArbolSubconjuntos

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

nNodosArbolSubconjuntos2 :: [a] -> Integer

nNodosArbolSubconjuntos2 = aux . genericLength

where aux 1 = 1

aux n = 1 + n * aux (n-1)

-- 3ª definición de nNodosArbolSubconjuntos

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

nNodosArbolSubconjuntos3 :: [a] -> Integer

nNodosArbolSubconjuntos3 xs =

sucNNodos !! (n-1)

where n = length xs

-- sucNNodos es la sucesión de los números de nodos de los árboles de

-- los subconjuntos con 1, 2, ... elementos. Por ejemplo.

-- λ> take 10 sucNNodos

-- [1,3,10,41,206,1237,8660,69281,623530,6235301]

sucNNodos :: [Integer]

sucNNodos =

1 : map (+ 1) (zipWith (*) [2..] sucNNodos)

-- Comparación de eficiencia de nNodosArbolSubconjuntos

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

-- λ> nNodosArbolSubconjuntos 10

-- 6235301

-- (9.66 secs, 5,491,704,944 bytes)

-- λ> nNodosArbolSubconjuntos2 10

-- 6235301

-- (0.00 secs, 145,976 bytes)

-- λ> length (show (nNodosArbolSubconjuntos2 (4*10^4)))

-- 166714

-- (1.07 secs, 2,952,675,472 bytes)

-- λ> length (show (nNodosArbolSubconjuntos3 (4*10^4)))

-- 166714

-- (1.53 secs, 2,959,020,680 bytes)

-- 1ª definición de sumaNNodos

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

sumaNNodos :: Integer -> Integer

sumaNNodos n =

sum [nNodosArbolSubconjuntos [1..k] | k <- [1..n]]

-- 2ª definición de sumaNNodos

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

sumaNNodos2 :: Integer -> Integer

sumaNNodos2 n =

sum [nNodosArbolSubconjuntos2 [1..k] | k <- [1..n]]

-- 3ª definición de sumaNNodos

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

sumaNNodos3 :: Integer -> Integer

sumaNNodos3 n =

sum (genericTake n sucNNodos)

-- Comparación de eficiencia de sumaNNodos

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

-- λ> sumaNNodos 10 `mod` (7+10^9)

-- 6938270

-- (16.00 secs, 9,552,410,688 bytes)

-- λ> sumaNNodos2 10 `mod` (7+10^9)

-- 6938270

-- (0.00 secs, 177,632 bytes)

-- λ> sumaNNodos2 (2*10^3) `mod` (7+10^9)

-- 851467820

-- (2.62 secs, 4,622,117,976 bytes)

-- λ> sumaNNodos3 (2*10^3) `mod` (7+10^9)

-- 851467820

-- (0.01 secs, 8,645,336 bytes)

Números tetranacci

PorJosé A. Alonso 27-marzo-201826-marzo-2022

Los números tetranacci son una generalización de los números de Fibonacci definidos por

   T(0) = 0,
   T(1) = 1,
   T(2) = 1,
   T(3) = 2, 
   T(n) = T(n-1) + T(n-2) + T(n-3) + T(n-4), para n > 3.

T(0) = 0,

T(1) = 1,

T(2) = 1,

T(3) = 2,

T(n) = T(n-1) + T(n-2) + T(n-3) + T(n-4), para n > 3.

Los primeros números tetranacci son

   0, 1, 1, 2, 4, 8, 15, 29, 56, 108, 208

1	0, 1, 1, 2, 4, 8, 15, 29, 56, 108, 208

Definir las funciones

   tetranacci        :: Int -> Integer
   graficaTetranacci :: Int -> IO ()

1 2	tetranacci :: Int -> Integer graficaTetranacci :: Int -> IO ()

tales que

(tetranacci n) es el n-ésimo número tetranacci. Por ejemplo,

     λ> tetranacci 10
     208
     λ> map tetranacci [0..10]
     [0,1,1,2,4,8,15,29,56,108,208]
     λ> length (show (tetranacci5 (10^5)))
     28501

λ> tetranacci 10

208

λ> map tetranacci [0..10]

[0,1,1,2,4,8,15,29,56,108,208]

λ> length (show (tetranacci5 (10^5)))

28501

(graficaTetranacci n) dibuja la gráfica de los cocientes de n primeros pares de número tetranacci. Por ejemplo, (graficaTetranacci 300) dibuja

Soluciones

import Data.List (zipWith4)
import Data.Array
import Graphics.Gnuplot.Simple

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

tetranacci :: Int -> Integer
tetranacci 0 = 0
tetranacci 1 = 1
tetranacci 2 = 1
tetranacci 3 = 2
tetranacci n =
  tetranacci (n-1) + tetranacci (n-2) + tetranacci (n-3) + tetranacci (n-4) 

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

tetranacci2 :: Int -> Integer
tetranacci2 n = tetranaccis2 !! n

tetranaccis2 :: [Integer]
tetranaccis2 = 
    0 : 1 : 1 : 2 : zipWith4 f (r 0) (r 1) (r 2) (r 3)
    where f a b c d = a+b+c+d
          r n       = drop n tetranaccis2

-- 3ª solución (con acumuladores)
-- ==============================

tetranacci3 :: Int -> Integer
tetranacci3 n = tetranaccis3 !! n

tetranaccis3 :: [Integer]
tetranaccis3 = p (0, 1, 1, 2)
    where p (a, b, c, d) = a : p (b, c, d, a + b + c + d)

-- 4ª solución
-- =============

tetranacci4 :: Int -> Integer
tetranacci4 n = tetranaccis4 !! n

tetranaccis4 :: [Integer]
tetranaccis4 = 0 : 1 : 1 : 2 : p tetranaccis4
   where p (a:b:c:d:xs) = (a+b+c+d): p (b:c:d:xs)

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

tetranacci5 :: Int -> Integer
tetranacci5 n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f 0 = 0
  f 1 = 1
  f 2 = 1
  f 3 = 2
  f k = v!(k-1) + v!(k-2) + v!(k-3) + v!(k-4) 

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

--    λ> tetranacci 26
--    7555935
--    (3.04 secs, 1,649,520,064 bytes)
--    λ> tetranacci2 26
--    7555935
--    (0.00 secs, 148,064 bytes)
-- 
--    λ> length (show (tetranacci2 (10^5)))
--    28501
--    (1.22 secs, 1,844,457,288 bytes)
--    λ> length (show (tetranacci3 (10^5)))
--    28501
--    (0.88 secs, 1,860,453,968 bytes)
--    λ> length (show (tetranacci4 (10^5)))
--    28501
--    (0.77 secs, 1,882,852,168 bytes)
--    λ> length (show (tetranacci5 (10^5)))
--    28501
--    (0.72 secs, 1,905,707,408 bytes)

-- Gráfica
-- =======

graficaTetranacci :: Int -> IO ()
graficaTetranacci n =
  plotList [ Key Nothing
           , Title "Tasa de crecimiento de los numeros tetranacci"
           , PNG ("Numeros_tetranacci_" ++ show n ++ ".png")
           ]
           (take n (zipWith (/) (tail xs) xs))
  where xs = (map fromIntegral tetranaccis4) :: [Double]

import Data.List (zipWith4)

import Data.Array

import Graphics.Gnuplot.Simple

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

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

tetranacci :: Int -> Integer

tetranacci 0 = 0

tetranacci 1 = 1

tetranacci 2 = 1

tetranacci 3 = 2

tetranacci n =

tetranacci (n-1) + tetranacci (n-2) + tetranacci (n-3) + tetranacci (n-4)

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

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

tetranacci2 :: Int -> Integer

tetranacci2 n = tetranaccis2 !! n

tetranaccis2 :: [Integer]

tetranaccis2 =

0 : 1 : 1 : 2 : zipWith4 f (r 0) (r 1) (r 2) (r 3)

where f a b c d = a+b+c+d

r n = drop n tetranaccis2

-- 3ª solución (con acumuladores)

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

tetranacci3 :: Int -> Integer

tetranacci3 n = tetranaccis3 !! n

tetranaccis3 :: [Integer]

tetranaccis3 = p (0, 1, 1, 2)

where p (a, b, c, d) = a : p (b, c, d, a + b + c + d)

-- 4ª solución

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

tetranacci4 :: Int -> Integer

tetranacci4 n = tetranaccis4 !! n

tetranaccis4 :: [Integer]

tetranaccis4 = 0 : 1 : 1 : 2 : p tetranaccis4

where p (a:b:c:d:xs) = (a+b+c+d): p (b:c:d:xs)

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

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

tetranacci5 :: Int -> Integer

tetranacci5 n = v ! n where

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

f 0 = 0

f 1 = 1

f 2 = 1

f 3 = 2

f k = v!(k-1) + v!(k-2) + v!(k-3) + v!(k-4)

-- Comparación de eficiencia

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

-- λ> tetranacci 26

-- 7555935

-- (3.04 secs, 1,649,520,064 bytes)

-- λ> tetranacci2 26

-- 7555935

-- (0.00 secs, 148,064 bytes)

-- λ> length (show (tetranacci2 (10^5)))

-- 28501

-- (1.22 secs, 1,844,457,288 bytes)

-- λ> length (show (tetranacci3 (10^5)))

-- 28501

-- (0.88 secs, 1,860,453,968 bytes)

-- λ> length (show (tetranacci4 (10^5)))

-- 28501

-- (0.77 secs, 1,882,852,168 bytes)

-- λ> length (show (tetranacci5 (10^5)))

-- 28501

-- (0.72 secs, 1,905,707,408 bytes)

-- Gráfica

-- =======

graficaTetranacci :: Int -> IO ()

graficaTetranacci n =

plotList [ Key Nothing

, Title "Tasa de crecimiento de los numeros tetranacci"

, PNG ("Numeros_tetranacci_" ++ show n ++ ".png")

]

(take n (zipWith (/) (tail xs) xs))

where xs = (map fromIntegral tetranaccis4) :: [Double]

Máxima longitud de sublistas crecientes

PorJosé A. Alonso 23-marzo-201825-abril-2021

Definir la función

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

1	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]]
   λ> longitudMayorSublistaCreciente xs
   61

λ> longitudMayorSublistaCreciente [3,2,6,4,5,1]

λ> longitudMayorSublistaCreciente [10,22,9,33,21,50,41,60,80]

λ> longitudMayorSublistaCreciente [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]

λ> longitudMayorSublistaCreciente [1..2000]

2000

λ> longitudMayorSublistaCreciente [2000,1999..1]

λ> import System.Random

λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]

λ> longitudMayorSublistaCreciente xs

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)

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

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

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)

Mayores sublistas crecientes

PorJosé A. Alonso 22-marzo-201830-marzo-2018

Definir la función

   mayoresCrecientes :: Ord a => [a] -> [[a]]

1	mayoresCrecientes :: Ord a => [a] -> [[a]]

tal que (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]]
   λ> length (head (mayoresCrecientes (show (2^300))))
   10

λ> 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]]

λ> length (head (mayoresCrecientes (show (2^300))))

Soluciones

import Data.List (subsequences)

-- 1ª solución
-- ===========

mayoresCrecientes1 :: Ord a => [a] -> [[a]]
mayoresCrecientes1 xs =
  [ys | ys <- xss
      , length ys == m]
  where xss = sublistasCrecientes xs
        m   = maximum (map length xss)

-- (sublistasCrecientes1 xs) es la lista de las sublistas crecientes de
-- xs. Por ejemplo,
--    λ> sublistasCrecientes [3,2,5]
--    [[],[3],[2],[5],[3,5],[2,5]]
sublistasCrecientes :: Ord a => [a] -> [[a]]
sublistasCrecientes xs =
  [ys | ys <- subsequences xs
      , esCreciente ys]

-- (esCreciente xs) se verifica si la lista xs es creciente. Por
-- ejemplo,  
--    esCreciente [2,3,5]  ==  True
--    esCreciente [2,3,1]  ==  False
--    esCreciente [2,3,3]  ==  False
esCreciente :: Ord a => [a] -> Bool
esCreciente (x:y:zs) = x < y && esCreciente (y:zs)
esCreciente _        = True

-- 2ª solución
-- ===========

mayoresCrecientes2 :: Ord a => [a] -> [[a]]
mayoresCrecientes2 xs =
  [ys | ys <- xss
      , length ys == m]
  where xss = sublistasCrecientes2 xs
        m   = maximum (map length xss)

-- (sublistasCrecientes2 xs) es la lista de las sublistas crecientes de
-- xs. Por ejemplo,
--    λ> sublistasCrecientes2 [3,2,5]
--    [[3,5],[3],[2,5],[2],[5],[]]
sublistasCrecientes2 :: Ord a => [a] -> [[a]]
sublistasCrecientes2 []  = [[]]
sublistasCrecientes2 (x:xs) =
  [x:ys | ys <- yss, null ys || x < head ys] ++ yss
  where yss = sublistasCrecientes2 xs

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

--    λ> length (head (mayoresCrecientes1 (show (2^70))))
--    5
--    (10.93 secs, 1,958,822,896 bytes)
--    λ> length (head (mayoresCrecientes2 (show (2^70))))
--    5
--    (0.02 secs, 0 bytes)

import Data.List (subsequences)

-- 1ª solución

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

mayoresCrecientes1 :: Ord a => [a] -> [[a]]

mayoresCrecientes1 xs =

[ys | ys <- xss

, length ys == m]

where xss = sublistasCrecientes xs

m = maximum (map length xss)

-- (sublistasCrecientes1 xs) es la lista de las sublistas crecientes de

-- xs. Por ejemplo,

-- λ> sublistasCrecientes [3,2,5]

-- [[],[3],[2],[5],[3,5],[2,5]]

sublistasCrecientes :: Ord a => [a] -> [[a]]

sublistasCrecientes xs =

[ys | ys <- subsequences xs

, esCreciente ys]

-- (esCreciente xs) se verifica si la lista xs es creciente. Por

-- ejemplo,

-- esCreciente [2,3,5] == True

-- esCreciente [2,3,1] == False

-- esCreciente [2,3,3] == False

esCreciente :: Ord a => [a] -> Bool

esCreciente (x:y:zs) = x < y && esCreciente (y:zs)

esCreciente _ = True

-- 2ª solución

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

mayoresCrecientes2 :: Ord a => [a] -> [[a]]

mayoresCrecientes2 xs =

[ys | ys <- xss

, length ys == m]

where xss = sublistasCrecientes2 xs

m = maximum (map length xss)

-- (sublistasCrecientes2 xs) es la lista de las sublistas crecientes de

-- xs. Por ejemplo,

-- λ> sublistasCrecientes2 [3,2,5]

-- [[3,5],[3],[2,5],[2],[5],[]]

sublistasCrecientes2 :: Ord a => [a] -> [[a]]

sublistasCrecientes2 [] = [[]]

sublistasCrecientes2 (x:xs) =

[x:ys | ys <- yss, null ys || x < head ys] ++ yss

where yss = sublistasCrecientes2 xs

-- Comparación de eficiencia

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

-- λ> length (head (mayoresCrecientes1 (show (2^70))))

-- 5

-- (10.93 secs, 1,958,822,896 bytes)

-- λ> length (head (mayoresCrecientes2 (show (2^70))))

-- 5

-- (0.02 secs, 0 bytes)

Particiones primas

PorJosé A. Alonso 20-marzo-201828-marzo-2018

Una partición prima de un número natural n es un conjunto de primos cuya suma es n. Por ejemplo, el número 7 tiene 7 particiones primas ya que

   7 = 7 = 5 + 2 = 3 + 2 + 2

1	7 = 7 = 5 + 2 = 3 + 2 + 2

Definir la función

   particiones :: Int -> [[Int]]

1	particiones :: Int -> [[Int]]

tal que (particiones n) es el comjunto de las particiones primas de n. Por ejemplo,

   particiones 7             ==  [[7],[5,2],[3,2,2]]
   particiones 8             ==  [[5,3],[3,3,2],[2,2,2,2]]
   particiones 9             ==  [[7,2],[5,2,2],[3,3,3],[3,2,2,2]]
   length (particiones 100)  ==  40899

particiones 7 == [[7],[5,2],[3,2,2]]

particiones 8 == [[5,3],[3,3,2],[2,2,2,2]]

particiones 9 == [[7,2],[5,2,2],[3,3,3],[3,2,2,2]]

length (particiones 100) == 40899

Soluciones

import Data.Numbers.Primes (primes)
import Data.Array          (Array, (!), array)

-- 1ª solución
-- ===========

particiones1 :: Int -> [[Int]]
particiones1 0 = [[]]
particiones1 n = [x:y | x <- xs, 
                        y <- particiones1 (n-x), 
                        [x] >= take 1 y]
  where xs = reverse (takeWhile (<= n) primes)

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

particiones2 :: Int -> [[Int]]
particiones2 n = (vectorParticiones n) ! n

-- (vectorParticiones n) es el vector con índices de 0 a n tal que el
-- valor del índice k es la lista de las particiones primas de k. Por
-- ejemplo, 
--    λ> mapM_ print (elems (vectorParticiones 9))
--    [[]]
--    []
--    [[2]]
--    [[3]]
--    [[2,2]]
--    [[5],[3,2]]
--    [[3,3],[2,2,2]]
--    [[7],[5,2],[3,2,2]]
--    [[5,3],[3,3,2],[2,2,2,2]]
--    [[7,2],[5,2,2],[3,3,3],[3,2,2,2]]
--    λ> elems (vectorParticiones 9) == map particiones1 [0..9]
--    True
vectorParticiones :: Int -> Array Int [[Int]]
vectorParticiones n = v where
  v = array (0,n) [(i,f i) | i <- [0..n]]
    where f 0 = [[]]
          f m = [x:y | x <- xs, 
                       y <- v ! (m-x), 
                       [x] >= take 1 y]
            where xs = reverse (takeWhile (<= m) primes)

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

--    λ> length (particiones1 35)
--    175
--    (5.88 secs, 2,264,266,040 bytes)
--    λ> length (particiones2 35)
--    175
--    (0.02 secs, 1,521,560 bytes)

import Data.Numbers.Primes (primes)

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

-- 1ª solución

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

particiones1 :: Int -> [[Int]]

particiones1 0 = [[]]

particiones1 n = [x:y | x <- xs,

y <- particiones1 (n-x),

[x] >= take 1 y]

where xs = reverse (takeWhile (<= n) primes)

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

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

particiones2 :: Int -> [[Int]]

particiones2 n = (vectorParticiones n) ! n

-- (vectorParticiones n) es el vector con índices de 0 a n tal que el

-- valor del índice k es la lista de las particiones primas de k. Por

-- ejemplo,

-- λ> mapM_ print (elems (vectorParticiones 9))

-- [[]]

-- []

-- [[2]]

-- [[3]]

-- [[2,2]]

-- [[5],[3,2]]

-- [[3,3],[2,2,2]]

-- [[7],[5,2],[3,2,2]]

-- [[5,3],[3,3,2],[2,2,2,2]]

-- [[7,2],[5,2,2],[3,3,3],[3,2,2,2]]

-- λ> elems (vectorParticiones 9) == map particiones1 [0..9]

-- True

vectorParticiones :: Int -> Array Int [[Int]]

vectorParticiones n = v where

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

where f 0 = [[]]

f m = [x:y | x <- xs,

y <- v ! (m-x),

[x] >= take 1 y]

where xs = reverse (takeWhile (<= m) primes)

-- Comparación de eficiencia

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

-- λ> length (particiones1 35)

-- 175

-- (5.88 secs, 2,264,266,040 bytes)

-- λ> length (particiones2 35)

-- 175

-- (0.02 secs, 1,521,560 bytes)

La sucesión de Sylvester

PorJosé A. Alonso 19-marzo-201825-abril-2021

La sucesión de Sylvester es la sucesión que comienza en 2 y sus restantes términos se obtienen multiplicando los anteriores y sumándole 1.

Definir las funciones

   sylvester        :: Integer -> Integer
   graficaSylvester :: Integer -> Integer -> IO ()

1 2	sylvester :: Integer -> Integer graficaSylvester :: Integer -> Integer -> IO ()

tales que

(sylvester n) es el n-ésimo término de la sucesión de Sylvester. Por ejemplo,

     λ> [sylvester n | n <- [0..7]]
     [2,3,7,43,1807,3263443,10650056950807,113423713055421844361000443]
     λ> length (show (sylvester 25))
     6830085

λ> [sylvester n | n <- [0..7]]

[2,3,7,43,1807,3263443,10650056950807,113423713055421844361000443]

λ> length (show (sylvester 25))

6830085

(graficaSylvester d n) dibuja la gráfica de los d últimos dígitos de los n primeros términos de la sucesión de Sylvester. Por ejemplo,
- (graficaSylvester 3 30) dibuja
- (graficaSylvester 4 30) dibuja
- (graficaSylvester 5 30) dibuja

Soluciones

import Data.List               (genericIndex)
import Data.Array              ((!), array)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, PNG))

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

sylvester1 :: Integer -> Integer
sylvester1 0 = 2
sylvester1 n = 1 + product [sylvester1 k | k <- [0..n-1]]

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

sylvester2 :: Integer -> Integer
sylvester2 n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f 0 = 2
  f m = 1 + product [v!k | k <- [0..m-1]]

-- 3ª solución
-- ===========

sylvester3 :: Integer -> Integer
sylvester3 0 = 2
sylvester3 n = 1 + x^2 - x
  where x = sylvester3 (n-1)

-- 4ª solución
-- ===========

sylvester4 :: Integer -> Integer
sylvester4 n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f 0 = 2
  f m = 1 + x^2 - x
    where x = v ! (m-1)

-- 4ª solución
-- ===========

sylvester5 :: Integer -> Integer
sylvester5 0 = 2
sylvester5 n = 1 + (productosSylvester `genericIndex` (n-1))

sucSylvester5 :: [Integer]
sucSylvester5 = map sylvester5 [0..]

productosSylvester :: [Integer]
productosSylvester = scanl1 (*) sucSylvester5

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

--    λ> length (show (sylvester1 20))
--    213441
--    (3.40 secs, 519,249,840 bytes)
--    λ> length (show (sylvester2 20))
--    213441
--    (0.10 secs, 13,716,024 bytes)
--    λ> length (show (sylvester3 20))
--    213441
--    (0.16 secs, 13,646,472 bytes)
--    λ> length (show (sylvester4 20))
--    213441
--    (0.18 secs, 13,654,064 bytes)
--    λ> length (show (sylvester5 20))
--    213441
--    (0.12 secs, 13,497,192 bytes)

graficaSylvester :: Integer -> Integer -> IO ()
graficaSylvester d n =
  plotList [ Key Nothing
           , PNG ("La_sucesion_de_Sylvester_" ++ show (d,n) ++ ".png")
           ]
           [sylvester5 k `mod` (10^d) | k <- [0..n]]

import Data.List (genericIndex)

import Data.Array ((!), array)

import Graphics.Gnuplot.Simple (plotList, Attribute (Key, PNG))

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

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

sylvester1 :: Integer -> Integer

sylvester1 0 = 2

sylvester1 n = 1 + product [sylvester1 k | k <- [0..n-1]]

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

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

sylvester2 :: Integer -> Integer

sylvester2 n = v ! n where

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

f 0 = 2

f m = 1 + product [v!k | k <- [0..m-1]]

-- 3ª solución

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

sylvester3 :: Integer -> Integer

sylvester3 0 = 2

sylvester3 n = 1 + x^2 - x

where x = sylvester3 (n-1)

-- 4ª solución

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

sylvester4 :: Integer -> Integer

sylvester4 n = v ! n where

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

f 0 = 2

f m = 1 + x^2 - x

where x = v ! (m-1)

-- 4ª solución

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

sylvester5 :: Integer -> Integer

sylvester5 0 = 2

sylvester5 n = 1 + (productosSylvester `genericIndex` (n-1))

sucSylvester5 :: [Integer]

sucSylvester5 = map sylvester5 [0..]

productosSylvester :: [Integer]

productosSylvester = scanl1 (*) sucSylvester5

-- Comparación de eficiencia

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

-- λ> length (show (sylvester1 20))

-- 213441

-- (3.40 secs, 519,249,840 bytes)

-- λ> length (show (sylvester2 20))

-- 213441

-- (0.10 secs, 13,716,024 bytes)

-- λ> length (show (sylvester3 20))

-- 213441

-- (0.16 secs, 13,646,472 bytes)

-- λ> length (show (sylvester4 20))

-- 213441

-- (0.18 secs, 13,654,064 bytes)

-- λ> length (show (sylvester5 20))

-- 213441

-- (0.12 secs, 13,497,192 bytes)

graficaSylvester :: Integer -> Integer -> IO ()

graficaSylvester d n =

plotList [ Key Nothing

, PNG ("La_sucesion_de_Sylvester_" ++ show (d,n) ++ ".png")

]

[sylvester5 k `mod` (10^d) | k <- [0..n]]

Camino de máxima suma en una matriz

PorJosé A. Alonso 16-marzo-201825-abril-2021

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 )

( 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

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]

1	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 500 500 [1..]))
   187001249

λ> caminoMaxSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])

[1,7,12,8,4,9]

λ> sum (caminoMaxSuma (fromList 500 500 [1..]))

187001249

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)

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

PorJosé A. Alonso 15-marzo-201825-abril-2021

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 )

( 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

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

1	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

λ> maximaSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])

λ> maximaSuma (fromList 800 800 [1..])

766721999

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)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

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)

Caminos en una matriz

PorJosé A. Alonso 14-marzo-201825-abril-2021

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 )

( 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

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

Definir la función

   caminos :: Matrix Int -> [[Int]]

1	caminos :: Matrix Int -> [[Int]]

tal que (caminos m) es la lista 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,

   λ> caminos (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])
   [[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]]
   λ> length (caminos (fromList 12 13 [1..]))
   1352078

λ> caminos (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])

[[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]]

λ> length (caminos (fromList 12 13 [1..]))

1352078

Soluciones

import Data.Matrix

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

caminos1 :: Matrix Int -> [[Int]]
caminos1 a = aux (1,1)
  where
    aux (i,j)
      | i == m           = [[a!(i,k) | k <- [j..n]]]
      | j == n           = [[a!(k,j) | k <- [i..m]]]
      | otherwise        = [a!(i,j) : cs | cs <- aux (i+1,j) ++ aux (i,j+1)]
      where m = nrows a
            n = ncols a

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

caminos2 :: Matrix Int -> [[Int]]
caminos2 a = q ! (1,1)
  where
    q = matrix m n f
    m = nrows a
    n = ncols a
    f (i,j) | i == m    = [[a!(i,k) | k <- [j..n]]]
            | j == n    = [[a!(k,j) | k <- [i..m]]]
            | otherwise = [a!(i,j) : cs | cs <- q!(i+1,j) ++ q!(i,j+1)]  

-- 3ª solución
-- ===========

caminos3 :: Matrix Int -> [[Int]]
caminos3 a
  | m == 1 || n == 1 = [toList a]
  | otherwise = map (a ! (1,1):) (caminos3 (submatrix 2 m 1 n a) ++
                                  caminos3 (submatrix 1 m 2 n a)) 
  where m = nrows a
        n = ncols a

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

--    λ> length (caminos1 (fromList 11 11 [1..]))
--    184756
--    (4.15 secs, 738,764,712 bytes)
--    λ> length (caminos2 (fromList 11 11 [1..]))
--    184756
--    (0.74 secs, 115,904,952 bytes)
--    λ> length (caminos3 (fromList 11 11 [1..]))
--    184756
--    (2.22 secs, 614,472,136 bytes)

import Data.Matrix

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

-- ----------------------------------------

caminos1 :: Matrix Int -> [[Int]]

caminos1 a = aux (1,1)

where

aux (i,j)

| i == m = [[a!(i,k) | k <- [j..n]]]

| j == n = [[a!(k,j) | k <- [i..m]]]

| otherwise = [a!(i,j) : cs | cs <- aux (i+1,j) ++ aux (i,j+1)]

where m = nrows a

n = ncols a

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

-- --------------------------------------------

caminos2 :: Matrix Int -> [[Int]]

caminos2 a = q ! (1,1)

where

q = matrix m n f

m = nrows a

n = ncols a

f (i,j) | i == m = [[a!(i,k) | k <- [j..n]]]

| j == n = [[a!(k,j) | k <- [i..m]]]

| otherwise = [a!(i,j) : cs | cs <- q!(i+1,j) ++ q!(i,j+1)]

-- 3ª solución

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

caminos3 :: Matrix Int -> [[Int]]

caminos3 a

| m == 1 || n == 1 = [toList a]

| otherwise = map (a ! (1,1):) (caminos3 (submatrix 2 m 1 n a) ++

caminos3 (submatrix 1 m 2 n a))

where m = nrows a

n = ncols a

-- Comparación de eficiencia

-- -------------------------

-- λ> length (caminos1 (fromList 11 11 [1..]))

-- 184756

-- (4.15 secs, 738,764,712 bytes)

-- λ> length (caminos2 (fromList 11 11 [1..]))

-- 184756

-- (0.74 secs, 115,904,952 bytes)

-- λ> length (caminos3 (fromList 11 11 [1..]))

-- 184756

-- (2.22 secs, 614,472,136 bytes)

Suma de las alturas de los nodos de un árbol

PorJosé A. Alonso 13-marzo-201820-marzo-2018

Las árboles binarios se pueden representar con el siguiente tipo

   data Arbol a = H
                | N a (Arbol a) (Arbol a)
     deriving Show

data Arbol a = H

| N a (Arbol a) (Arbol a)

deriving Show

Por ejemplo, el árbol

/ \

2 3

/ \

4 5

se representa por

   ej1 :: Arbol Int
   ej1 = N 1 (N 2 (N 4 H H) (N 5 H H)) (N 3 H H)

1 2	ej1 :: Arbol Int ej1 = N 1 (N 2 (N 4 H H) (N 5 H H)) (N 3 H H)

La altura de cada elemento del árbol es la máxima distancia a las hojas en su rama. Por ejemplo, en el árbol anterior, la altura de 1 es 3, la de 2 es 2, la de 3 es 1, la de 4 es 1 y la de 5 es 1.

Definir la función

   sumaAlturas :: Arbol t -> Int

1	sumaAlturas :: Arbol t -> Int

tal que (sumaAlturas a) es la suma de las alturas de los elementos de a. Por ejemplo,

   λ> sumaAlturas (N 1 (N 2 (N 4 H H) (N 5 H H)) (N 3 H H))
   8
   λ> sumaAlturas (N 1 (N 2 (N 4 H H) H) (N 3 H H))
   7
   λ> sumaAlturas (N 1 (N 2 (N 4 H H) H) (N 2 (N 4 H H) (N 5 H H)))
   10

λ> sumaAlturas (N 1 (N 2 (N 4 H H) (N 5 H H)) (N 3 H H))

λ> sumaAlturas (N 1 (N 2 (N 4 H H) H) (N 3 H H))

λ> sumaAlturas (N 1 (N 2 (N 4 H H) H) (N 2 (N 4 H H) (N 5 H H)))

Soluciones

data Arbol a = H
             | N a (Arbol a) (Arbol a)
  deriving Show

-- 1ª definición
-- =============

sumaAlturas :: Arbol t -> Int
sumaAlturas H = 0
sumaAlturas a@(N _ i d) = altura a + sumaAlturas i + sumaAlturas d 

-- (altura a) es la altura del árbol a. Por ejemplo,
--    altura H                          ==  0
--    altura (N 7 H H)                  ==  1
--    altura (N 7 (N 5 H H) H)          ==  2
--    altura (N 7 (N 5 H (N 6 H H)) H)  ==  3
altura :: Arbol t -> Int
altura H         = 0
altura (N _ i d) = 1 + max (altura i) (altura d)

-- 2ª definición
-- =============

sumaAlturas2 :: Arbol t -> Int
sumaAlturas2 = snd . alturaYsumaAlturas

-- (alturaYsumaAlturas a) es el par formado por la altura del árbol a y
-- la suma de las alturas de los nodos de a. Por ejemplo,
--    alturaYsumaAlturas H                          ==  (0,0)
--    alturaYsumaAlturas (N 7 H H)                  ==  (1,1)
--    alturaYsumaAlturas (N 7 (N 5 H H) H)          ==  (2,3)
--    alturaYsumaAlturas (N 7 (N 5 H (N 6 H H)) H)  ==  (3,6)
alturaYsumaAlturas :: Arbol t -> (Int,Int)
alturaYsumaAlturas H         = (0,0)
alturaYsumaAlturas (N _ i d) = (a,a + si + sd)
  where (ai,si) = alturaYsumaAlturas i
        (ad,sd) = alturaYsumaAlturas d
        a       = 1 + max ai ad

-- 3ª definición
-- =============

sumaAlturas3 :: Arbol t -> Int
sumaAlturas3 = sum . alturas
 
-- (alturas a) es la lista de las alturas de los nodos del árbol a. Por
-- ejemplo, 
--    alturas H                          ==  [0]
--    alturas (N 7 H H)                  ==  [1,0,0]
--    alturas (N 7 (N 5 H H) H)          ==  [2,1,0,0,0]
--    alturas (N 7 (N 5 H (N 6 H H)) H)  ==  [3,2,0,1,0,0,0]
alturas :: Arbol t -> [Int]
alturas H         = [0]
alturas (N _ a b) = (1 + max x y) : xs ++ ys
  where xs@(x : _) = alturas a
        ys@(y : _) = alturas b

data Arbol a = H

| N a (Arbol a) (Arbol a)

deriving Show

-- 1ª definición

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

sumaAlturas :: Arbol t -> Int

sumaAlturas H = 0

sumaAlturas a@(N _ i d) = altura a + sumaAlturas i + sumaAlturas d

-- (altura a) es la altura del árbol a. Por ejemplo,

-- altura H == 0

-- altura (N 7 H H) == 1

-- altura (N 7 (N 5 H H) H) == 2

-- altura (N 7 (N 5 H (N 6 H H)) H) == 3

altura :: Arbol t -> Int

altura H = 0

altura (N _ i d) = 1 + max (altura i) (altura d)

-- 2ª definición

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

sumaAlturas2 :: Arbol t -> Int

sumaAlturas2 = snd . alturaYsumaAlturas

-- (alturaYsumaAlturas a) es el par formado por la altura del árbol a y

-- la suma de las alturas de los nodos de a. Por ejemplo,

-- alturaYsumaAlturas H == (0,0)

-- alturaYsumaAlturas (N 7 H H) == (1,1)

-- alturaYsumaAlturas (N 7 (N 5 H H) H) == (2,3)

-- alturaYsumaAlturas (N 7 (N 5 H (N 6 H H)) H) == (3,6)

alturaYsumaAlturas :: Arbol t -> (Int,Int)

alturaYsumaAlturas H = (0,0)

alturaYsumaAlturas (N _ i d) = (a,a + si + sd)

where (ai,si) = alturaYsumaAlturas i

(ad,sd) = alturaYsumaAlturas d

a = 1 + max ai ad

-- 3ª definición

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

sumaAlturas3 :: Arbol t -> Int

sumaAlturas3 = sum . alturas

-- (alturas a) es la lista de las alturas de los nodos del árbol a. Por

-- ejemplo,

-- alturas H == [0]

-- alturas (N 7 H H) == [1,0,0]

-- alturas (N 7 (N 5 H H) H) == [2,1,0,0,0]

-- alturas (N 7 (N 5 H (N 6 H H)) H) == [3,2,0,1,0,0,0]

alturas :: Arbol t -> [Int]

alturas H = [0]

alturas (N _ a b) = (1 + max x y) : xs ++ ys

where xs@(x : _) = alturas a

ys@(y : _) = alturas b

Suma de las sumas de los cuadrados de los divisores

PorJosé A. Alonso 7-marzo-201814-marzo-2018

La suma de las sumas de los cuadrados de los divisores de los 6 primeros números enteros positivos es

     1² + (1²+2²) + (1²+3²) + (1²+2²+4²) + (1²+5²) + (1²+2²+3²+6²)
   = 1  + 5       + 10      + 21         + 26      + 50
   = 113

1² + (1²+2²) + (1²+3²) + (1²+2²+4²) + (1²+5²) + (1²+2²+3²+6²)

= 1 + 5 + 10 + 21 + 26 + 50

= 113

Definir la función

   sumaSumasCuadradosDivisores :: Integer -> Integer

1	sumaSumasCuadradosDivisores :: Integer -> Integer

tal que (sumaSumasCuadradosDivisores n) es la suma de las sumas de los cuadrados de los divisores de los n primeros números enteros positivos. Por ejemplo,

   sumaSumasCuadradosDivisores 6       ==  113
   sumaSumasCuadradosDivisores (10^6)  ==  400686363385965077

1 2	sumaSumasCuadradosDivisores 6 == 113 sumaSumasCuadradosDivisores (10^6) == 400686363385965077

Soluciones

import Data.List (genericIndex)

-- 1ª solución
-- ===========

sumaSumasCuadradosDivisores :: Integer -> Integer
sumaSumasCuadradosDivisores n =
  sum [sumaCuadradosDivisores k | k <- [1..n]]

-- (sumaCuadradosDivisores n) es la suma de los cuadrados de los
-- divisores de n. Por ejemplo,
--    sumaCuadradosDivisores 6  ==  50
sumaCuadradosDivisores :: Integer -> Integer
sumaCuadradosDivisores n = sum (map (^2) (divisores n))

-- (divisores n) es la lista de los divisores de n. Por ejemplo, 
--    divisores 6  ==  [1,6,2,3]
divisores :: Integer -> [Integer]
divisores 1 = [1]
divisores n = 1 : n : [x | x <- [2..n `div` 2], n `mod` x == 0]

-- 2ª solución
-- ===========

sumaSumasCuadradosDivisores2 :: Integer -> Integer
sumaSumasCuadradosDivisores2 n =
  sumasSumasCuadradosDivisores `genericIndex` (n-1)

-- sumasSumasCuadradosDivisores es la sucesión cuyo n-ésimo término es
-- la suma de las sumas de los cuadrados de los divisores de n. Por
-- ejemplo, 
--    take 6 sumasSumasCuadradosDivisores  ==  [1,6,16,37,63,113]
sumasSumasCuadradosDivisores :: [Integer]
sumasSumasCuadradosDivisores = 1 : sig 1 2
  where sig m n = y : sig y (n+1)
          where y = m + sumaCuadradosDivisores n

-- 3ª solución
-- ===========

sumaSumasCuadradosDivisores3 :: Integer -> Integer
sumaSumasCuadradosDivisores3 n =
  last (sumasSumasCuadradosDivisores3 n)

-- (sumasSumasCuadradosDivisores3 n) es la sucesión cuyo k-ésimo término
-- es la suma de las sumas de los cuadrados de los divisores de k, para
-- k entre 0 y n. Por ejemplo, 
--    sumasSumasCuadradosDivisores3 6  ==  [0,6,18,36,52,77,113]
sumasSumasCuadradosDivisores3 :: Integer -> [Integer]
sumasSumasCuadradosDivisores3 n = scanl f 0 [1..n]
  where f x k = x + k^2 * (n `div` k)

-- 4ª solución
-- ===========

sumaSumasCuadradosDivisores4 :: Integer -> Integer
sumaSumasCuadradosDivisores4 n =
  last (sumasSumasCuadradosDivisores4 n)

-- (sumasSumasCuadradosDivisores4 n) es la sucesión cuyo k-ésimo término
-- es la suma de las sumas de los cuadrados de los divisores de k, para
-- k entre 0 y n. Por ejemplo, 
--    sumasSumasCuadradosDivisores4 6  ==  [0,6,18,36,52,77,113]
sumasSumasCuadradosDivisores4 :: Integer -> [Integer]
sumasSumasCuadradosDivisores4 n = scanl1 f [0,1..n]
  where f x k = x + k^2 * (n `div` k)

-- 5ª solución
-- ===========

sumaSumasCuadradosDivisores5 :: Integer -> Integer
sumaSumasCuadradosDivisores5 n =
  last (sumasSumasCuadradosDivisores5 n)

-- (sumasSumasCuadradosDivisores5 n) es la sucesión cuyo k-ésimo término
-- es la suma de las sumas de los cuadrados de los divisores de k, para
-- k entre 0 y n. Por ejemplo, 
--    sumasSumasCuadradosDivisores5 6  ==  [0,6,18,36,52,77,113]
sumasSumasCuadradosDivisores5 :: Integer -> [Integer]
sumasSumasCuadradosDivisores5 n = scanl1 f [0,1..n]
  where f x k = x + k * (n - (n `mod` k))

-- 6ª solución
-- ===========

-- Cada elemento k de [1..n], al cuadrado, aparece tantas veces como la
-- parte entera de n/k; luego,
--    sumaSumasCuadradosDivisores n =
--       1^2*n + 2^2*(n `div` 2) + 3^2*(n `div` 3) + ... + n^2*1

sumaSumasCuadradosDivisores6 :: Integer -> Integer
sumaSumasCuadradosDivisores6 n = sum (zipWith (*) ds vs)
  where ds = map (^2) [1..n]
        vs = [n `div` k | k <- [1..n]]

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

--    λ> sumaSumasCuadradosDivisores (3*10^3)
--    10825397502
--    (3.29 secs, 468,721,192 bytes)
--    λ> sumaSumasCuadradosDivisores2 (3*10^3)
--    10825397502
--    (3.25 secs, 469,462,600 bytes)
--    λ> sumaSumasCuadradosDivisores3 (3*10^3)
--    10825397502
--    (0.03 secs, 2,788,752 bytes)
--    λ> sumaSumasCuadradosDivisores4 (3*10^3)
--    10825397502
--    (0.03 secs, 2,813,304 bytes)
--    λ> sumaSumasCuadradosDivisores5 (3*10^3)
--    10825397502
--    (0.03 secs, 1,467,056 bytes)
--    λ> sumaSumasCuadradosDivisores6 (3*10^3)
--    10825397502
--    (0.03 secs, 3,291,664 bytes)
--    
--    λ> sumaSumasCuadradosDivisores3 (5*10^5)
--    50085873311988831
--    (2.34 secs, 440,961,640 bytes)
--    λ> sumaSumasCuadradosDivisores4 (5*10^5)
--    50085873311988831
--    (2.29 secs, 444,962,904 bytes)
--    λ> sumaSumasCuadradosDivisores5 (5*10^5)
--    50085873311988831
--    (1.23 secs, 220,960,152 bytes)
--    λ> sumaSumasCuadradosDivisores6 (5*10^5)
--    50085873311988831
--    (2.76 secs, 524,962,464 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

import Data.List (genericIndex)

-- 1ª solución

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

sumaSumasCuadradosDivisores :: Integer -> Integer

sumaSumasCuadradosDivisores n =

sum [sumaCuadradosDivisores k | k <- [1..n]]

-- (sumaCuadradosDivisores n) es la suma de los cuadrados de los

-- divisores de n. Por ejemplo,

-- sumaCuadradosDivisores 6 == 50

sumaCuadradosDivisores :: Integer -> Integer

sumaCuadradosDivisores n = sum (map (^2) (divisores n))

-- (divisores n) es la lista de los divisores de n. Por ejemplo,

-- divisores 6 == [1,6,2,3]

divisores :: Integer -> [Integer]

divisores 1 = [1]

divisores n = 1 : n : [x | x <- [2..n `div` 2], n `mod` x == 0]

-- 2ª solución

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

sumaSumasCuadradosDivisores2 :: Integer -> Integer

sumaSumasCuadradosDivisores2 n =

sumasSumasCuadradosDivisores `genericIndex` (n-1)

-- sumasSumasCuadradosDivisores es la sucesión cuyo n-ésimo término es

-- la suma de las sumas de los cuadrados de los divisores de n. Por

-- ejemplo,

-- take 6 sumasSumasCuadradosDivisores == [1,6,16,37,63,113]

sumasSumasCuadradosDivisores :: [Integer]

sumasSumasCuadradosDivisores = 1 : sig 1 2

where sig m n = y : sig y (n+1)

where y = m + sumaCuadradosDivisores n

-- 3ª solución

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

sumaSumasCuadradosDivisores3 :: Integer -> Integer

sumaSumasCuadradosDivisores3 n =

last (sumasSumasCuadradosDivisores3 n)

-- (sumasSumasCuadradosDivisores3 n) es la sucesión cuyo k-ésimo término

-- es la suma de las sumas de los cuadrados de los divisores de k, para

-- k entre 0 y n. Por ejemplo,

-- sumasSumasCuadradosDivisores3 6 == [0,6,18,36,52,77,113]

sumasSumasCuadradosDivisores3 :: Integer -> [Integer]

sumasSumasCuadradosDivisores3 n = scanl f 0 [1..n]

where f x k = x + k^2 * (n `div` k)

-- 4ª solución

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

sumaSumasCuadradosDivisores4 :: Integer -> Integer

sumaSumasCuadradosDivisores4 n =

last (sumasSumasCuadradosDivisores4 n)

-- (sumasSumasCuadradosDivisores4 n) es la sucesión cuyo k-ésimo término

-- es la suma de las sumas de los cuadrados de los divisores de k, para

-- k entre 0 y n. Por ejemplo,

-- sumasSumasCuadradosDivisores4 6 == [0,6,18,36,52,77,113]

sumasSumasCuadradosDivisores4 :: Integer -> [Integer]

sumasSumasCuadradosDivisores4 n = scanl1 f [0,1..n]

where f x k = x + k^2 * (n `div` k)

-- 5ª solución

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

sumaSumasCuadradosDivisores5 :: Integer -> Integer

sumaSumasCuadradosDivisores5 n =

last (sumasSumasCuadradosDivisores5 n)

-- (sumasSumasCuadradosDivisores5 n) es la sucesión cuyo k-ésimo término

-- es la suma de las sumas de los cuadrados de los divisores de k, para

-- k entre 0 y n. Por ejemplo,

-- sumasSumasCuadradosDivisores5 6 == [0,6,18,36,52,77,113]

sumasSumasCuadradosDivisores5 :: Integer -> [Integer]

sumasSumasCuadradosDivisores5 n = scanl1 f [0,1..n]

where f x k = x + k * (n - (n `mod` k))

-- 6ª solución

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

-- Cada elemento k de [1..n], al cuadrado, aparece tantas veces como la

-- parte entera de n/k; luego,

-- sumaSumasCuadradosDivisores n =

-- 1^2*n + 2^2*(n `div` 2) + 3^2*(n `div` 3) + ... + n^2*1

sumaSumasCuadradosDivisores6 :: Integer -> Integer

sumaSumasCuadradosDivisores6 n = sum (zipWith (*) ds vs)

where ds = map (^2) [1..n]

vs = [n `div` k | k <- [1..n]]

-- Comparación de eficiencia:

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

-- λ> sumaSumasCuadradosDivisores (3*10^3)

-- 10825397502

-- (3.29 secs, 468,721,192 bytes)

-- λ> sumaSumasCuadradosDivisores2 (3*10^3)

-- 10825397502

-- (3.25 secs, 469,462,600 bytes)

-- λ> sumaSumasCuadradosDivisores3 (3*10^3)

-- 10825397502

-- (0.03 secs, 2,788,752 bytes)

-- λ> sumaSumasCuadradosDivisores4 (3*10^3)

-- 10825397502

-- (0.03 secs, 2,813,304 bytes)

-- λ> sumaSumasCuadradosDivisores5 (3*10^3)

-- 10825397502

-- (0.03 secs, 1,467,056 bytes)

-- λ> sumaSumasCuadradosDivisores6 (3*10^3)

-- 10825397502

-- (0.03 secs, 3,291,664 bytes)

-- λ> sumaSumasCuadradosDivisores3 (5*10^5)

-- 50085873311988831

-- (2.34 secs, 440,961,640 bytes)

-- λ> sumaSumasCuadradosDivisores4 (5*10^5)

-- 50085873311988831

-- (2.29 secs, 444,962,904 bytes)

-- λ> sumaSumasCuadradosDivisores5 (5*10^5)

-- 50085873311988831

-- (1.23 secs, 220,960,152 bytes)

-- λ> sumaSumasCuadradosDivisores6 (5*10^5)

-- 50085873311988831

-- (2.76 secs, 524,962,464 bytes)

Suma de los dígitos de las repeticiones de un número

PorJosé A. Alonso 6-marzo-201814-marzo-2018

Dados dos números naturales n y x, su suma reducida se obtiene a partir del número obtenido repitiendo n veces el x sumando sus dígitos hasta obtener un número con sólo un dígito. Por ejemplo, si n es 3 y x es 24 las transformaciones son

   242424 ==> 18 ==> 9

1	242424 ==> 18 ==> 9

Análogamente, si n es 4 y x es 7988 las transformaciones son

   7988798879887988 ==> 128 ==> 11 ==> 2

1	7988798879887988 ==> 128 ==> 11 ==> 2

Definir las funciones

   sumaReducidaDigitosRepeticiones :: Integer -> Integer -> Integer
   grafica                         :: Integer -> IO ()

1 2	sumaReducidaDigitosRepeticiones :: Integer -> Integer -> Integer grafica :: Integer -> IO ()

tales que

(sumaReducidaDigitosRepeticiones n x) es la suma reducida de n repeticiones de x. Por ejemplo

     sumaReducidaDigitosRepeticiones 3 24                    ==  9
     sumaReducidaDigitosRepeticiones 4 7988                  == 2
     sumaReducidaDigitosRepeticiones (12^(10^7)) (12^(10^7)) == 9

sumaReducidaDigitosRepeticiones 3 24 == 9

sumaReducidaDigitosRepeticiones 4 7988 == 2

sumaReducidaDigitosRepeticiones (12^(10^7)) (12^(10^7)) == 9

(grafica n) dibuja la gráfica de los n primeros elementos de la sucesión cuyo elementos k-ésimo es (sumaReducidaDigitosRepeticiones k k). Por ejemplo, (grafica 50) dibuja

Soluciones

import Data.List (genericReplicate)
import Graphics.Gnuplot.Simple
import Test.QuickCheck

-- 1ª solución
-- ===========

sumaReducidaDigitosRepeticiones :: Integer -> Integer -> Integer
sumaReducidaDigitosRepeticiones n x =
  sumaReducidaDigitos (repeticiones n x) 

-- (repeticiones n x) es el número obtenido repitiendo n veces el x. Por
-- ejemplo, 
--    repeticiones 3 24   ==  242424
--    repeticiones 4 325  ==  325325325325
repeticiones :: Integer -> Integer -> Integer
repeticiones n x = read (concat (genericReplicate n (show x)))

-- (sumaDigitos x) es la suma de los dígitos de x. Por ejemplo,
--    sumaDigitos 325  ==  10
sumaDigitos :: Integer -> Integer
sumaDigitos x | x < 10    = x
              | otherwise = b + sumaDigitos a
  where (a,b) = divMod x 10

-- (sumaReducidaDigitos x) es el número obtenido a partir de x
-- reiterando la suma de los dígitos hasta obtener un número con sólo un
-- dígito. Por ejemplo,
--    sumaReducidaDigitos 24   ==  6
--    sumaReducidaDigitos 325  ==  1
sumaReducidaDigitos :: Integer -> Integer
sumaReducidaDigitos x | x < 10    = x
                      | otherwise = sumaReducidaDigitos (sumaDigitos x)

-- 2ª solución
-- ===========

sumaReducidaDigitosRepeticiones2 :: Integer -> Integer -> Integer
sumaReducidaDigitosRepeticiones2 n x =
  sumaReducidaDigitos2 (n * sumaReducidaDigitos2 x) 

sumaReducidaDigitos2 :: Integer -> Integer
sumaReducidaDigitos2 0 = 0
sumaReducidaDigitos2 x | y == 0    = 9
                       | otherwise = y
  where y = x `mod` 9

-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_equiv :: Positive Integer -> Positive Integer -> Bool
prop_equiv (Positive n) (Positive x) =
  sumaReducidaDigitosRepeticiones n x == sumaReducidaDigitosRepeticiones2 n x 

-- La comprobación es
--    λ> quickCheck prop_equiv
--    +++ OK, passed 100 tests.

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

--    λ> sumaReducidaDigitosRepeticiones (10^4) (10^4)
--    1
--    (2.00 secs, 574,667,384 bytes)
--    λ> sumaReducidaDigitosRepeticiones2 (10^4) (10^4)
--    1
--    (0.03 secs, 141,120 bytes)
  
-- Gráfica
-- =======
                      
grafica :: Integer -> IO ()
grafica n =
  plotList [Key Nothing]
           [sumaReducidaDigitosRepeticiones2 k k | k <- [1..n]]

import Data.List (genericReplicate)

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª solución

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

sumaReducidaDigitosRepeticiones :: Integer -> Integer -> Integer

sumaReducidaDigitosRepeticiones n x =

sumaReducidaDigitos (repeticiones n x)

-- (repeticiones n x) es el número obtenido repitiendo n veces el x. Por

-- ejemplo,

-- repeticiones 3 24 == 242424

-- repeticiones 4 325 == 325325325325

repeticiones :: Integer -> Integer -> Integer

repeticiones n x = read (concat (genericReplicate n (show x)))

-- (sumaDigitos x) es la suma de los dígitos de x. Por ejemplo,

-- sumaDigitos 325 == 10

sumaDigitos :: Integer -> Integer

sumaDigitos x | x < 10 = x

| otherwise = b + sumaDigitos a

where (a,b) = divMod x 10

-- (sumaReducidaDigitos x) es el número obtenido a partir de x

-- reiterando la suma de los dígitos hasta obtener un número con sólo un

-- dígito. Por ejemplo,

-- sumaReducidaDigitos 24 == 6

-- sumaReducidaDigitos 325 == 1

sumaReducidaDigitos :: Integer -> Integer

sumaReducidaDigitos x | x < 10 = x

| otherwise = sumaReducidaDigitos (sumaDigitos x)

-- 2ª solución

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

sumaReducidaDigitosRepeticiones2 :: Integer -> Integer -> Integer

sumaReducidaDigitosRepeticiones2 n x =

sumaReducidaDigitos2 (n * sumaReducidaDigitos2 x)

sumaReducidaDigitos2 :: Integer -> Integer

sumaReducidaDigitos2 0 = 0

sumaReducidaDigitos2 x | y == 0 = 9

| otherwise = y

where y = x `mod` 9

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_equiv :: Positive Integer -> Positive Integer -> Bool

prop_equiv (Positive n) (Positive x) =

sumaReducidaDigitosRepeticiones n x == sumaReducidaDigitosRepeticiones2 n x

-- La comprobación es

-- λ> quickCheck prop_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> sumaReducidaDigitosRepeticiones (10^4) (10^4)

-- 1

-- (2.00 secs, 574,667,384 bytes)

-- λ> sumaReducidaDigitosRepeticiones2 (10^4) (10^4)

-- 1

-- (0.03 secs, 141,120 bytes)

-- Gráfica

-- =======

grafica :: Integer -> IO ()

grafica n =

plotList [Key Nothing]

[sumaReducidaDigitosRepeticiones2 k k | k <- [1..n]]

Nodos con máxima suma de hijos

PorJosé A. Alonso 1-marzo-201830-marzo-2020

Los árboles se pueden representar mediante el siguiente tipo de datos

   data Arbol a = N a [Arbol a]
                  deriving Show

1 2	data Arbol a = N a [Arbol a] deriving Show

Por ejemplo, los árboles

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

1 3

/ \ /|\

2 3 / | \

| 5 4 7

4 | /|\

6 2 8 6

se representan por

   ej1, ej2 :: Arbol Int
   ej1 = N 1 [N 2 [], N 3 [N 4 []]]
   ej2 = N 3 [N 5 [N 6 []], 
              N 4 [], 
              N 7 [N 2 [], N 8 [], N 6 []]]

ej1, ej2 :: Arbol Int

ej1 = N 1 [N 2 [], N 3 [N 4 []]]

ej2 = N 3 [N 5 [N 6 []],

N 4 [],

N 7 [N 2 [], N 8 [], N 6 []]]

Definir la función

   nodosSumaMaxima :: (Num t, Ord t) => Arbol t -> [t]

1	nodosSumaMaxima :: (Num t, Ord t) => Arbol t -> [t]

tal que (nodosSumaMaxima a) es la lista de los nodos del árbol a cuyos hijos tienen máxima suma. Por ejemplo,

   nodosSumaMaxima ej1  ==  [1]
   nodosSumaMaxima ej2  ==  [7,3]

1 2	nodosSumaMaxima ej1 == [1] nodosSumaMaxima ej2 == [7,3]

Soluciones

import Data.List     (groupBy, sort)
import Data.Function (on)

data Arbol a = N a [Arbol a]
  deriving Show

ej1, ej2 :: Arbol Int
ej1 = N 1 [N 2 [], N 3 [N 4 []]]
ej2 = N 3 [N 5 [N 6 []], 
           N 4 [], 
           N 7 [N 2 [], N 8 [], N 6 []]]

-- 1ª solución
-- ===========

nodosSumaMaxima :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima a =
  [x | (s,x) <- ns, s == m]
  where ns = reverse (sort (nodosSumas a))
        m  = fst (head ns)

-- (nodosSumas x) es la lista de los pares (s,n) donde n es un nodo del
-- árbol x y s es la suma de sus hijos. Por ejemplo,  
--    λ> nodosSumas ej1
--    [(5,1),(0,2),(4,3),(0,4)]
--    λ> nodosSumas ej2
--    [(16,3),(6,5),(0,6),(0,4),(16,7),(0,2),(0,8),(0,6)]
nodosSumas :: Num t => Arbol t -> [(t,t)]
nodosSumas (N x []) = [(0,x)]
nodosSumas (N x as) = (sum (raices as),x) : concatMap nodosSumas as

-- (raices b) es la lista de las raíces del bosque b. Por ejemplo,
--    raices [ej1,ej2]  ==  [1,3]
raices :: [Arbol t] -> [t]
raices = map raiz

-- (raiz a) es la raíz del árbol a. Por ejemplo,
--    raiz ej1  ==  1
--    raiz ej2  ==  3
raiz :: Arbol t -> t
raiz (N x _) = x

-- 2ª solución
-- ===========

nodosSumaMaxima2 :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima2 a =
  [x | (s,x) <- ns, s == m]
  where ns = sort (nodosOpSumas a)
        m  = fst (head ns)

-- (nodosOpSumas x) es la lista de los pares (s,n) donde n es un nodo del
-- árbol x y s es el opuesto de la suma de sus hijos. Por ejemplo,  
--    λ> nodosOpSumas ej1
--    [(-5,1),(0,2),(-4,3),(0,4)]
--    λ> nodosOpSumas ej2
--    [(-16,3),(-6,5),(0,6),(0,4),(-16,7),(0,2),(0,8),(0,6)]
nodosOpSumas :: Num t => Arbol t -> [(t,t)]
nodosOpSumas (N x []) = [(0,x)]
nodosOpSumas (N x as) = (-sum (raices as),x) : concatMap nodosOpSumas as


-- 3ª solución
-- ===========

nodosSumaMaxima3 :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima3 a =
  [x | (s,x) <- ns, s == m]
  where ns = sort (nodosOpSumas a)
        m  = fst (head ns)

-- 4ª solución
-- ===========

nodosSumaMaxima4 :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima4 a =
  map snd (head (groupBy (\p q -> fst p == fst q)
                         (sort (nodosOpSumas a))))

-- 5ª solución
-- ===========

nodosSumaMaxima5 :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima5 a =
  map snd (head (groupBy ((==) `on` fst)
                         (sort (nodosOpSumas a))))

-- 6ª solución
-- ===========

nodosSumaMaxima6 :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima6 =
  map snd
  . head
  . groupBy ((==) `on` fst)
  . sort
  . nodosOpSumas

import Data.List (groupBy, sort)

import Data.Function (on)

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2 :: Arbol Int

ej1 = N 1 [N 2 [], N 3 [N 4 []]]

ej2 = N 3 [N 5 [N 6 []],

N 4 [],

N 7 [N 2 [], N 8 [], N 6 []]]

-- 1ª solución

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

nodosSumaMaxima :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima a =

[x | (s,x) <- ns, s == m]

where ns = reverse (sort (nodosSumas a))

m = fst (head ns)

-- (nodosSumas x) es la lista de los pares (s,n) donde n es un nodo del

-- árbol x y s es la suma de sus hijos. Por ejemplo,

-- λ> nodosSumas ej1

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

-- λ> nodosSumas ej2

-- [(16,3),(6,5),(0,6),(0,4),(16,7),(0,2),(0,8),(0,6)]

nodosSumas :: Num t => Arbol t -> [(t,t)]

nodosSumas (N x []) = [(0,x)]

nodosSumas (N x as) = (sum (raices as),x) : concatMap nodosSumas as

-- (raices b) es la lista de las raíces del bosque b. Por ejemplo,

-- raices [ej1,ej2] == [1,3]

raices :: [Arbol t] -> [t]

raices = map raiz

-- (raiz a) es la raíz del árbol a. Por ejemplo,

-- raiz ej1 == 1

-- raiz ej2 == 3

raiz :: Arbol t -> t

raiz (N x _) = x

-- 2ª solución

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

nodosSumaMaxima2 :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima2 a =

[x | (s,x) <- ns, s == m]

where ns = sort (nodosOpSumas a)

m = fst (head ns)

-- (nodosOpSumas x) es la lista de los pares (s,n) donde n es un nodo del

-- árbol x y s es el opuesto de la suma de sus hijos. Por ejemplo,

-- λ> nodosOpSumas ej1

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

-- λ> nodosOpSumas ej2

-- [(-16,3),(-6,5),(0,6),(0,4),(-16,7),(0,2),(0,8),(0,6)]

nodosOpSumas :: Num t => Arbol t -> [(t,t)]

nodosOpSumas (N x []) = [(0,x)]

nodosOpSumas (N x as) = (-sum (raices as),x) : concatMap nodosOpSumas as

-- 3ª solución

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

nodosSumaMaxima3 :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima3 a =

[x | (s,x) <- ns, s == m]

where ns = sort (nodosOpSumas a)

m = fst (head ns)

-- 4ª solución

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

nodosSumaMaxima4 :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima4 a =

map snd (head (groupBy (\p q -> fst p == fst q)

(sort (nodosOpSumas a))))

-- 5ª solución

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

nodosSumaMaxima5 :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima5 a =

map snd (head (groupBy ((==) `on` fst)

(sort (nodosOpSumas a))))

-- 6ª solución

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

nodosSumaMaxima6 :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima6 =

map snd

. head

. groupBy ((==) `on` fst)

. sort

. nodosOpSumas

Generación de progresiones geométricas

PorJosé A. Alonso 26-febrero-20186-marzo-2018

Definir la función

   geometrica :: Int -> Int -> Int -> [Int]

1	geometrica :: Int -> Int -> Int -> [Int]

tal que (geometrica a b c) es la lista de los términos de la progresión geométrica cuyo primer término es a, su segundo término es b (que se supone que es múltiplo de a) y los términos son menores o iguales que c. Por ejemplo,

   geometrica 1 3  27   ==  [1,3,9,27]
   geometrica 2 6  100  ==  [2,6,18,54]
   geometrica 3 12 57   ==  [3,12,48]
   geometrica 4 20 253  ==  [4,20,100]
   geometrica 5 25 625  ==  [5,25,125,625]
   geometrica 6 42 42   ==  [6,42]

geometrica 1 3 27 == [1,3,9,27]

geometrica 2 6 100 == [2,6,18,54]

geometrica 3 12 57 == [3,12,48]

geometrica 4 20 253 == [4,20,100]

geometrica 5 25 625 == [5,25,125,625]

geometrica 6 42 42 == [6,42]

Soluciones

-- 1ª definición
geometrica :: Int -> Int -> Int -> [Int]
geometrica a b c =
  takeWhile (<=c) (iterate (*r) a)
  where r = b `div` a

-- 2ª definición
geometrica2 :: Int -> Int -> Int -> [Int]
geometrica2 a b c = aux a b 
  where aux a b 
          | a > c     = []
          | otherwise = a : aux b (b * r)
        r = b `div` a

-- 1ª definición

geometrica :: Int -> Int -> Int -> [Int]

geometrica a b c =

takeWhile (<=c) (iterate (*r) a)

where r = b `div` a

-- 2ª definición

geometrica2 :: Int -> Int -> Int -> [Int]

geometrica2 a b c = aux a b

where aux a b

| a > c = []

| otherwise = a : aux b (b * r)

r = b `div` a

Ceros con los n primeros números

PorJosé A. Alonso 23-febrero-20182-marzo-2018

Los números del 1 al 3 se pueden escribir de dos formas, con el signo más o menos entre ellos, tales que su suma sea 0:

    1+2-3 = 0
   -1-2+3 = 0

1 2	1+2-3 = 0 -1-2+3 = 0

Definir la función

   ceros :: Int -> [[Int]]

1	ceros :: Int -> [[Int]]

tal que (ceros n) son las posibles formas de obtener cero sumando los números del 1 al n, con el signo más o menos entre ellos. Por ejemplo,

   ceros 3           ==  [[1,2,-3],[-1,-2,3]]
   ceros 4           ==  [[1,-2,-3,4],[-1,2,3,-4]]
   ceros 5           ==  []
   length (ceros 7)  ==  8
   take 3 (ceros 7)  ==  [[1,2,-3,4,-5,-6,7],[1,2,-3,-4,5,6,-7],[1,-2,3,4,-5,6,-7]]

ceros 3 == [[1,2,-3],[-1,-2,3]]

ceros 4 == [[1,-2,-3,4],[-1,2,3,-4]]

ceros 5 == []

length (ceros 7) == 8

take 3 (ceros 7) == [[1,2,-3,4,-5,-6,7],[1,2,-3,-4,5,6,-7],[1,-2,3,4,-5,6,-7]]

Soluciones

-- 1ª solución
-- ===========

ceros :: Int -> [[Int]]
ceros n = [xs | xs <- candidatos n, sum xs == 0]

-- (candidatos n) es la lista de los números del 1 al n con los signos
-- más o menos. Por ejemplo,
--    λ> candidatos 1
--    [[1],[-1]]
--    λ> candidatos 2
--    [[1,2],[1,-2],[-1,2],[-1,-2]]
--    λ> candidatos 3
--    [[1,2,3],[1,2,-3],[1,-2,3],[1,-2,-3],[-1,2,3],[-1,2,-3],[-1,-2,3],[-1,-2,-3]]
candidatos :: Int -> [[Int]]
candidatos n = productoCartesiano [[i,-i] | i <- [1..n]]

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo, 
--    λ> productoCartesiano [[1,3],[2,5],[6,4]]
--    [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

-- 2ª solución
-- ===========

ceros2 :: Int -> [[Int]]
ceros2 n = [xs | xs <- candidatos2 n, sum xs == 0]

candidatos2 :: Int -> [[Int]]
candidatos2 n = mapM (\i -> [i,-i]) [1..n]

-- 3ª solución
-- ===========

ceros3 :: Int -> [[Int]]
ceros3 n = [xs | xs <- mapM (\i -> [i,-i]) [1..n], sum xs == 0]

-- 4ª solución
-- ===========

ceros4 :: Integer -> [[Integer]]
ceros4 = map fst
       . filter ((==0) . snd)
       . sumas

-- (sumas n) es la lista de las candidatos con los n primeros números y
-- sus sumas. Por ejemplo,
--    λ> sumas 2
--    [([1,2],3),([-1,2],1),([1,-2],-1),([-1,-2],-3)]
--    λ> sumas 3
--    [([1,2,3],6),([-1,2,3],4),([1,-2,3],2),([-1,-2,3],0),([1,2,-3],0),
--     ([-1,2,-3],-2),([1,-2,-3],-4),([-1,-2,-3],-6)]
sumas :: Integer -> [([Integer],Integer)]
sumas = foldr aux [([], 0)]
      . enumFromTo 1
  where
    aux n = concatMap (\(ns', s') -> [(n : ns', s' + n), (-n : ns', s' - n)])

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

--    λ> length (ceros 18)
--    0
--    (4.14 secs, 1,094,854,776 bytes)
--    λ> length (ceros2 18)
--    0
--    (1.16 secs, 375,541,680 bytes)
--    λ> length (ceros3 18)
--    0
--    (1.13 secs, 375,540,192 bytes)
--    λ> length (ceros4 18)
--    0
--    (0.69 secs, 157,316,688 bytes)

-- 1ª solución

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

ceros :: Int -> [[Int]]

ceros n = [xs | xs <- candidatos n, sum xs == 0]

-- (candidatos n) es la lista de los números del 1 al n con los signos

-- más o menos. Por ejemplo,

-- λ> candidatos 1

-- [[1],[-1]]

-- λ> candidatos 2

-- [[1,2],[1,-2],[-1,2],[-1,-2]]

-- λ> candidatos 3

-- [[1,2,3],[1,2,-3],[1,-2,3],[1,-2,-3],[-1,2,3],[-1,2,-3],[-1,-2,3],[-1,-2,-3]]

candidatos :: Int -> [[Int]]

candidatos n = productoCartesiano [[i,-i] | i <- [1..n]]

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> productoCartesiano [[1,3],[2,5],[6,4]]

-- [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 2ª solución

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

ceros2 :: Int -> [[Int]]

ceros2 n = [xs | xs <- candidatos2 n, sum xs == 0]

candidatos2 :: Int -> [[Int]]

candidatos2 n = mapM (\i -> [i,-i]) [1..n]

-- 3ª solución

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

ceros3 :: Int -> [[Int]]

ceros3 n = [xs | xs <- mapM (\i -> [i,-i]) [1..n], sum xs == 0]

-- 4ª solución

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

ceros4 :: Integer -> [[Integer]]

ceros4 = map fst

. filter ((==0) . snd)

. sumas

-- (sumas n) es la lista de las candidatos con los n primeros números y

-- sus sumas. Por ejemplo,

-- λ> sumas 2

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

-- λ> sumas 3

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

-- ([-1,2,-3],-2),([1,-2,-3],-4),([-1,-2,-3],-6)]

sumas :: Integer -> [([Integer],Integer)]

sumas = foldr aux [([], 0)]

. enumFromTo 1

where

aux n = concatMap (\(ns', s') -> [(n : ns', s' + n), (-n : ns', s' - n)])

-- Comparación de eficiencia

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

-- λ> length (ceros 18)

-- 0

-- (4.14 secs, 1,094,854,776 bytes)

-- λ> length (ceros2 18)

-- 0

-- (1.16 secs, 375,541,680 bytes)

-- λ> length (ceros3 18)

-- 0

-- (1.13 secs, 375,540,192 bytes)

-- λ> length (ceros4 18)

-- 0

-- (0.69 secs, 157,316,688 bytes)

Números que no son cuadrados

PorJosé A. Alonso 15-febrero-201822-febrero-2018

Definir las funciones

   noCuadrados :: [Integer]
   graficaNoCuadrados :: Integer -> IO ()

1 2	noCuadrados :: [Integer] graficaNoCuadrados :: Integer -> IO ()

tales que

noCuadrados es la lista de los números naturales que no son cuadrados. Por ejemplo,

     λ> take 25 noCuadrados
     [2,3,5,6,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,26,27,28,29,30]

1 2	λ> take 25 noCuadrados [2,3,5,6,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,26,27,28,29,30]

(graficaNoCuadrados n) dibuja las diferencias entre los n primeros elementos de noCuadrados y sus posiciones. Por ejemplo, (graficaNoCuadrados 300) dibuja

(graficaNoCuadrados 3000) dibuja

(graficaNoCuadrados 30000) dibuja

Comprobar con QuickCheck que el término de noCuadrados en la posición n-1 es (n + floor(1/2 + sqrt(n))).

Soluciones

import Data.List (genericIndex)
import Graphics.Gnuplot.Simple
import Test.QuickCheck

-- 1ª definición
-- =============

noCuadrados :: [Integer]
noCuadrados = aux [0..] cuadrados
  where aux xs (y:ys) = as ++ aux bs ys
          where (as,_:bs) = span (<y) xs

cuadrados :: [Integer]
cuadrados = [x^2 | x <- [0..]]

-- 2ª definición
-- =============

noCuadrados2 :: [Integer]
noCuadrados2 = aux 2 [1..]
  where aux n (_:xs) = ys ++ aux (n+2) zs
          where (ys,zs) = splitAt n xs

-- Definición de graficaNoCuadrados
-- ================================

graficaNoCuadrados :: Integer -> IO ()
graficaNoCuadrados n =
  plotList [ Key Nothing
           , PNG ("Numeros_que_no_son_cuadrados_" ++ show n ++ ".png")
           ]
           (zipWith (-) noCuadrados [0..n-1])

-- La propiedad es
prop_noCuadrados :: Positive Integer -> Bool
prop_noCuadrados (Positive n) =
  noCuadrados `genericIndex` (n-1) ==
  n + floor (1/2 + sqrt (fromIntegral n))

-- La comprobación es
--    λ> quickCheck prop_noCuadrados
--    +++ OK, passed 100 tests.

import Data.List (genericIndex)

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª definición

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

noCuadrados :: [Integer]

noCuadrados = aux [0..] cuadrados

where aux xs (y:ys) = as ++ aux bs ys

where (as,_:bs) = span (<y) xs

cuadrados :: [Integer]

cuadrados = [x^2 | x <- [0..]]

-- 2ª definición

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

noCuadrados2 :: [Integer]

noCuadrados2 = aux 2 [1..]

where aux n (_:xs) = ys ++ aux (n+2) zs

where (ys,zs) = splitAt n xs

-- Definición de graficaNoCuadrados

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

graficaNoCuadrados :: Integer -> IO ()

graficaNoCuadrados n =

plotList [ Key Nothing

, PNG ("Numeros_que_no_son_cuadrados_" ++ show n ++ ".png")

]

(zipWith (-) noCuadrados [0..n-1])

-- La propiedad es

prop_noCuadrados :: Positive Integer -> Bool

prop_noCuadrados (Positive n) =

noCuadrados `genericIndex` (n-1) ==

n + floor (1/2 + sqrt (fromIntegral n))

-- La comprobación es

-- λ> quickCheck prop_noCuadrados

-- +++ OK, passed 100 tests.

Árboles binarios completos

PorJosé A. Alonso 14-febrero-201821-febrero-2018

Un árbol binario completo es un árbol en el que cada nodo tiene cero o dos hijos. Por ejemplo, el primero de los siguientes árboles es un árbol binario completo pero los otros no lo son

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

1 1 1

/ \ / \ / | \

2 3 2 3 2 7 3

/ \ / / \

4 5 4 4 5

Los árboles se pueden representar mediante el siguiente tipo de datos

   data Arbol a = N a [Arbol a]
     deriving Show

1 2	data Arbol a = N a [Arbol a] deriving Show

Por ejemplo, los árboles los árboles anteriores se puede representar por

   ej1, ej2, ej3 :: Arbol Int
   ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]
   ej2 = N 1 [N 2 [N 4 []], N 3 []]
   ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]

ej2 = N 1 [N 2 [N 4 []], N 3 []]

ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]

Definir la función

   esBinarioCompleto :: Arbol t -> Bool

1	esBinarioCompleto :: Arbol t -> Bool

tal que (esBinarioCompleto a) se verifica si a es un árbol binario completo. Por ejemplo,

   esBinarioCompleto ej1  ==  True
   esBinarioCompleto ej2  ==  False
   esBinarioCompleto ej3  ==  False

esBinarioCompleto ej1 == True

esBinarioCompleto ej2 == False

esBinarioCompleto ej3 == False

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show

ej1, ej2, ej3 :: Arbol Int
ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]
ej2 = N 1 [N 2 [N 4 []], N 3 []]
ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]
          
esBinarioCompleto :: Arbol t -> Bool
esBinarioCompleto (N _ []) = True
esBinarioCompleto (N x as) = length as `elem` [0,2] 
                             && all esBinarioCompleto as

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]

ej2 = N 1 [N 2 [N 4 []], N 3 []]

ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]

esBinarioCompleto :: Arbol t -> Bool

esBinarioCompleto (N _ []) = True

esBinarioCompleto (N x as) = length as `elem` [0,2]

&& all esBinarioCompleto as

Períodos de Fibonacci

PorJosé A. Alonso 9-febrero-201819-febrero-2018

Los primeros términos de la sucesión de Fibonacci son

   0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610

1	0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610

Al calcular sus restos módulo 3 se obtiene

   0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1

1	0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1

Se observa que es periódica y su período es

   0,1,1,2,0,2,2,1

1	0,1,1,2,0,2,2,1

Definir las funciones

   fibsMod                   :: Integer -> [Integer]
   periodoFibMod             :: Integer -> [Integer]
   longPeriodosFibMod        :: [Int]
   graficaLongPeriodosFibMod :: Int -> IO ()

fibsMod :: Integer -> [Integer]

periodoFibMod :: Integer -> [Integer]

longPeriodosFibMod :: [Int]

graficaLongPeriodosFibMod :: Int -> IO ()

tales que

(fibsMod n) es la lista de los términos de la sucesión de Fibonacci módulo n. Por ejemplo,

     λ> take 24 (fibsMod 3)
     [0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1]
     λ> take 24 (fibsMod 4)
     [0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1]

λ> take 24 (fibsMod 3)

[0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1]

λ> take 24 (fibsMod 4)

[0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1]

(periodoFibMod n) es la parte perioica de la sucesión de Fibonacci módulo n. Por ejemplo,

     periodoFibMod 3  ==  [0,1,1,2,0,2,2,1]
     periodoFibMod 4  ==  [0,1,1,2,3,1]
     periodoFibMod 7  ==  [0,1,1,2,3,5,1,6,0,6,6,5,4,2,6,1]

periodoFibMod 3 == [0,1,1,2,0,2,2,1]

periodoFibMod 4 == [0,1,1,2,3,1]

periodoFibMod 7 == [0,1,1,2,3,5,1,6,0,6,6,5,4,2,6,1]

longPeriodosFibMod es la sucesión de las longitudes de los períodos de las sucesiones de Fibonacci módulo n, para n > 0. Por ejemplo,

     λ> take 20 longPeriodosFibMod
     [1,3,8,6,20,24,16,12,24,60,10,24,28,48,40,24,36,24,18,60]

1 2	λ> take 20 longPeriodosFibMod [1,3,8,6,20,24,16,12,24,60,10,24,28,48,40,24,36,24,18,60]

(graficaLongPeriodosFibMod n) dibuja la gráfica de los n primeros términos de la sucesión longPeriodosFibMod. Por ejemplo, (graficaLongPeriodosFibMod n) dibuja

Soluciones

import Graphics.Gnuplot.Simple

fibsMod :: Integer -> [Integer]
fibsMod n = map (`mod` n) fibs

-- fibs es la sucesión de Fibonacci. Por ejemplo,
--    λ> take 20 fibs
--    [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

periodoFibMod :: Integer -> [Integer]
periodoFibMod 1 = [0]
periodoFibMod n = 0 : 1 : aux (drop 2 (fibsMod n))
  where aux (0:1:xs) = []
        aux (a:b:xs) = a : aux (b:xs)

longPeriodosFibMod :: [Int]
longPeriodosFibMod =
  [length (periodoFibMod n) | n <- [1..]]

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

longPeriodosFibMod2 :: [Int]
longPeriodosFibMod2 = map longPeriodoFibMod [1..]

longPeriodoFibMod :: Integer -> Int
longPeriodoFibMod 1 = 1
longPeriodoFibMod n = aux 1 (tail (fibsMod n)) 0
  where aux 0 (1 : xs) k = k
        aux _ (x : xs) k = aux x xs (k + 1)

graficaLongPeriodosFibMod :: Int -> IO ()
graficaLongPeriodosFibMod n =
  plotList [ Key Nothing
           , Title ("graficaLongPeriodosFibMod " ++ show n)
           , PNG ("Periodos_de_Fibonacci " ++ show n ++ ".png")]
           (take n longPeriodosFibMod)

import Graphics.Gnuplot.Simple

fibsMod :: Integer -> [Integer]

fibsMod n = map (`mod` n) fibs

-- fibs es la sucesión de Fibonacci. Por ejemplo,

-- λ> take 20 fibs

-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

fibs :: [Integer]

fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

periodoFibMod :: Integer -> [Integer]

periodoFibMod 1 = [0]

periodoFibMod n = 0 : 1 : aux (drop 2 (fibsMod n))

where aux (0:1:xs) = []

aux (a:b:xs) = a : aux (b:xs)

longPeriodosFibMod :: [Int]

longPeriodosFibMod =

[length (periodoFibMod n) | n <- [1..]]

-- 2ª definición de longPeriodosFibMod

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

longPeriodosFibMod2 :: [Int]

longPeriodosFibMod2 = map longPeriodoFibMod [1..]

longPeriodoFibMod :: Integer -> Int

longPeriodoFibMod 1 = 1

longPeriodoFibMod n = aux 1 (tail (fibsMod n)) 0

where aux 0 (1 : xs) k = k

aux _ (x : xs) k = aux x xs (k + 1)

graficaLongPeriodosFibMod :: Int -> IO ()

graficaLongPeriodosFibMod n =

plotList [ Key Nothing

, Title ("graficaLongPeriodosFibMod " ++ show n)

, PNG ("Periodos_de_Fibonacci " ++ show n ++ ".png")]

(take n longPeriodosFibMod)

Recorrido de árboles en espiral

PorJosé A. Alonso 8-febrero-201825-abril-2021

Los árboles se pueden representar mediante el siguiente tipo de datos

   data Arbol a = N a [Arbol a]
     deriving Show

1 2	data Arbol a = N a [Arbol a] deriving Show

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

/ \ 8 3 8 3

2 3 /|\ /|\ |

/ \ / \ 4 5 6 4 5 6 7

4 5 6 7

se representan por

   ej1, ej2, ej3 :: Arbol Int
   ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 [N 6 [], N 7 []]]
   ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]
   ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 [N 6 [], N 7 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

Definir la función

   espiral :: Arbol a -> [a]

1	espiral :: Arbol a -> [a]

tal que (espiral x) es la lista de los nodos del árbol x recorridos en espiral; es decir, la raíz de x, los nodos del primer nivel de izquierda a derecha, los nodos del segundo nivel de derecha a izquierda y así sucesivamente. Por ejemplo,

   espiral ej1  ==  [1,2,3,7,6,5,4]
   espiral ej2  ==  [1,8,3,6,5,4]
   espiral ej3  ==  [1,8,3,7,6,5,4]

espiral ej1 == [1,2,3,7,6,5,4]

espiral ej2 == [1,8,3,6,5,4]

espiral ej3 == [1,8,3,7,6,5,4]

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show
           
ej1, ej2, ej3 :: Arbol Int
ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 [N 6 [], N 7 []]]
ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]
ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

-- 1ª solución
-- ===========

espiral :: Arbol a -> [a]
espiral x =
  concat [f xs | (f,xs) <- zip (cycle [reverse,id]) (niveles x)]

-- (niveles x) es la lista de los niveles del árbol x. Por ejemplo, 
--    niveles ej1 == [[1],[8,3],[4]]
--    niveles ej2 == [[1],[8,3],[4,5,6]]
--    niveles ej3 == [[1],[8,3],[4,5,6,7]]
niveles :: Arbol a -> [[a]]
niveles x = takeWhile (not . null) [nivel n x | n <- [0..]]

-- (nivel n x) es el nivel de nivel n del árbol x. Por ejemplo,
--    nivel 0 ej1  ==  [1]
--    nivel 1 ej1  ==  [8,3]
--    nivel 2 ej1  ==  [4]
--    nivel 4 ej1  ==  []
nivel :: Int -> Arbol a ->  [a]
nivel 0 (N x _)  = [x]
nivel n (N _ xs) = concatMap (nivel (n-1)) xs

-- 2ª solución
-- ===========

espiral2 :: Arbol a -> [a]
espiral2 = 
  concat . zipWith ($) (cycle [reverse,id]) . niveles

-- 3ª solución
-- ===========

espiral3 :: Arbol a -> [a]
espiral3 = concat . zipWith ($) (cycle [reverse,id]) . niveles3

niveles3 :: Arbol a -> [[a]]
niveles3 t = map (map raiz)
           . takeWhile (not . null)
           . iterate (concatMap subBosque) $ [t]

raiz :: Arbol a -> a
raiz (N x _) = x

subBosque :: Arbol a -> [Arbol a]
subBosque (N _ ts) = ts

-- 4ª solución
-- ===========

espiral4 :: Arbol a -> [a]
espiral4 = concat . zipWith ($) (cycle [reverse,id]) . niveles4

niveles4 :: Arbol a -> [[a]]
niveles4 = map (map raiz)
         . takeWhile (not . null)
         . iterate (concatMap subBosque)
         . return  

-- 5ª definición
-- =============

espiral5 :: Arbol a -> [a]
espiral5 x = concat $ zipWith ($) (cycle [reverse,id]) $ niveles5 [x]

niveles5 :: [Arbol a] -> [[a]]
niveles5 [] = []
niveles5 xs = a : niveles5 (concat b)
  where (a,b) = unzip $ map (\(N x y) -> (x,y)) xs

-- 6ª definición
-- =============

espiral6 :: Arbol a -> [a]
espiral6 = concat . zipWith ($) (cycle [reverse,id]) . niveles5 . return

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 [N 6 [], N 7 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

-- 1ª solución

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

espiral :: Arbol a -> [a]

espiral x =

concat [f xs | (f,xs) <- zip (cycle [reverse,id]) (niveles x)]

-- (niveles x) es la lista de los niveles del árbol x. Por ejemplo,

-- niveles ej1 == [[1],[8,3],[4]]

-- niveles ej2 == [[1],[8,3],[4,5,6]]

-- niveles ej3 == [[1],[8,3],[4,5,6,7]]

niveles :: Arbol a -> [[a]]

niveles x = takeWhile (not . null) [nivel n x | n <- [0..]]

-- (nivel n x) es el nivel de nivel n del árbol x. Por ejemplo,

-- nivel 0 ej1 == [1]

-- nivel 1 ej1 == [8,3]

-- nivel 2 ej1 == [4]

-- nivel 4 ej1 == []

nivel :: Int -> Arbol a -> [a]

nivel 0 (N x _) = [x]

nivel n (N _ xs) = concatMap (nivel (n-1)) xs

-- 2ª solución

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

espiral2 :: Arbol a -> [a]

espiral2 =

concat . zipWith ($) (cycle [reverse,id]) . niveles

-- 3ª solución

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

espiral3 :: Arbol a -> [a]

espiral3 = concat . zipWith ($) (cycle [reverse,id]) . niveles3

niveles3 :: Arbol a -> [[a]]

niveles3 t = map (map raiz)

. takeWhile (not . null)

. iterate (concatMap subBosque) $ [t]

raiz :: Arbol a -> a

raiz (N x _) = x

subBosque :: Arbol a -> [Arbol a]

subBosque (N _ ts) = ts

-- 4ª solución

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

espiral4 :: Arbol a -> [a]

espiral4 = concat . zipWith ($) (cycle [reverse,id]) . niveles4

niveles4 :: Arbol a -> [[a]]

niveles4 = map (map raiz)

. takeWhile (not . null)

. iterate (concatMap subBosque)

. return

-- 5ª definición

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

espiral5 :: Arbol a -> [a]

espiral5 x = concat $ zipWith ($) (cycle [reverse,id]) $ niveles5 [x]

niveles5 :: [Arbol a] -> [[a]]

niveles5 [] = []

niveles5 xs = a : niveles5 (concat b)

where (a,b) = unzip $ map (\(N x y) -> (x,y)) xs

-- 6ª definición

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

espiral6 :: Arbol a -> [a]

espiral6 = concat . zipWith ($) (cycle [reverse,id]) . niveles5 . return

Huecos binarios

PorJosé A. Alonso 7-febrero-201814-febrero-2018

Los huecos binarios de un número natural n son las listas de cer0 entre dos unos en la representación binaria de n. Por ejemplo, puesto que la representación binaria de 20 es 10100 tiene dos huecos binarios de longitudes 1 y 2. La longitud del mayor hueco binario de 529 es 4 ya que la representación binaria de 529 es 1000010001.

Definir las funciones

   longMayorHuecoBinario        :: Int -> Int
   graficaLongMayorHuecoBinario :: Int -> IO ()

1 2	longMayorHuecoBinario :: Int -> Int graficaLongMayorHuecoBinario :: Int -> IO ()

tales que

(longMayorHuecoBinario n) es la longitud del mayor hueco binario de n. Por ejemplo,

     longMayorHuecoBinario 20    ==  2
     longMayorHuecoBinario 529   ==  4
     longMayorHuecoBinario 2018  ==  3

longMayorHuecoBinario 20 == 2

longMayorHuecoBinario 529 == 4

longMayorHuecoBinario 2018 == 3

(graficaLongMayorHuecoBinario n) dibuja la gráfica de las longitudes de los mayores huecos binarios de los n primeros números naturales. Por ejemplo, (graficaLongMayorHuecoBinario 200) dibuja

Soluciones

import Data.List (group)
import Graphics.Gnuplot.Simple

-- 1ª solución
-- ===========

longMayorHuecoBinario :: Int -> Int
longMayorHuecoBinario n =
  maximum (0 : map length (huecosBinarios (decimalAbinario n)))

-- (decimalAbinario x) es la representación binaria del número c. Por
-- ejemplo, 
--    decimalAbinario 20   ==  [0,0,1,0,1]
--    decimalAbinario 529  ==  [1,0,0,0,1,0,0,0,0,1] 
decimalAbinario :: Int -> [Int]
decimalAbinario x
  | x < 2     = [x]
  | otherwise = x `mod` 2 : decimalAbinario (x `div` 2)

-- (huecosBinarios xs) es la lista de los ceros consecutivos de xs entre
-- dos elementos distintos de cero. Por ejemplo,
--    huecosBinarios [0,0,1,0,1]            ==  [[0,0],[0]]
--    huecosBinarios [1,0,0,0,1,0,0,0,0,1]  ==  [[0,0,0],[0,0,0,0]]
huecosBinarios :: [Int] -> [[Int]]
huecosBinarios xs =
  [ys | ys <- group xs, 0 `elem` ys]

-- 2ª solución
-- ===========

longMayorHuecoBinario2 :: Int -> Int
longMayorHuecoBinario2 =
  maximum . (0 :) . map length . huecosBinarios . decimalAbinario

-- 3ª solución
-- ===========

longMayorHuecoBinario3 :: Int -> Int
longMayorHuecoBinario3 = maximum . longHuecosBinarios

-- (longHuecosBinarios n) es la lista de las longitudes de los huecos
-- binarios de n. Por ejemplo,
--    longHuecosBinarios 20  ==  [2,1,0]
--    longHuecosBinarios 529  ==  [3,4,0]
longHuecosBinarios :: Int -> [Int]
longHuecosBinarios 1 = [0]
longHuecosBinarios n | mod n 2 == 1 = longHuecosBinarios (div n 2)
                     | mod n 4 == 2 = 1 : h : t
                     | otherwise = 1 + h : t
  where (h : t) = longHuecosBinarios (div n 2)

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

--    λ> maximum [longMayorHuecoBinario x | x <- [1..100000]]
--    16
--    (5.51 secs, 941,090,272 bytes)
--    λ> maximum [longMayorHuecoBinario2 x | x <- [1..100000]]
--    16
--    (5.54 secs, 933,093,168 bytes)
--    λ> maximum [longMayorHuecoBinario3 x | x <- [1..100000]]
--    16
--    (6.00 secs, 966,584,848 bytes)

graficaLongMayorHuecoBinario :: Int -> IO ()
graficaLongMayorHuecoBinario n =
  plotList [ Key Nothing
           , Title ("graficaLongMayorHuecoBinario " ++ show n)
           , PNG ("Huecos_binarios_" ++ show n ++ ".png")
           ]
           [longMayorHuecoBinario k | k <- [0..n-1]]

import Data.List (group)

import Graphics.Gnuplot.Simple

-- 1ª solución

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

longMayorHuecoBinario :: Int -> Int

longMayorHuecoBinario n =

maximum (0 : map length (huecosBinarios (decimalAbinario n)))

-- (decimalAbinario x) es la representación binaria del número c. Por

-- ejemplo,

-- decimalAbinario 20 == [0,0,1,0,1]

-- decimalAbinario 529 == [1,0,0,0,1,0,0,0,0,1]

decimalAbinario :: Int -> [Int]

decimalAbinario x

| x < 2 = [x]

| otherwise = x `mod` 2 : decimalAbinario (x `div` 2)

-- (huecosBinarios xs) es la lista de los ceros consecutivos de xs entre

-- dos elementos distintos de cero. Por ejemplo,

-- huecosBinarios [0,0,1,0,1] == [[0,0],[0]]

-- huecosBinarios [1,0,0,0,1,0,0,0,0,1] == [[0,0,0],[0,0,0,0]]

huecosBinarios :: [Int] -> [[Int]]

huecosBinarios xs =

[ys | ys <- group xs, 0 `elem` ys]

-- 2ª solución

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

longMayorHuecoBinario2 :: Int -> Int

longMayorHuecoBinario2 =

maximum . (0 :) . map length . huecosBinarios . decimalAbinario

-- 3ª solución

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

longMayorHuecoBinario3 :: Int -> Int

longMayorHuecoBinario3 = maximum . longHuecosBinarios

-- (longHuecosBinarios n) es la lista de las longitudes de los huecos

-- binarios de n. Por ejemplo,

-- longHuecosBinarios 20 == [2,1,0]

-- longHuecosBinarios 529 == [3,4,0]

longHuecosBinarios :: Int -> [Int]

longHuecosBinarios 1 = [0]

longHuecosBinarios n | mod n 2 == 1 = longHuecosBinarios (div n 2)

| mod n 4 == 2 = 1 : h : t

| otherwise = 1 + h : t

where (h : t) = longHuecosBinarios (div n 2)

-- Comparación de eficiencia

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

-- λ> maximum [longMayorHuecoBinario x | x <- [1..100000]]

-- 16

-- (5.51 secs, 941,090,272 bytes)

-- λ> maximum [longMayorHuecoBinario2 x | x <- [1..100000]]

-- 16

-- (5.54 secs, 933,093,168 bytes)

-- λ> maximum [longMayorHuecoBinario3 x | x <- [1..100000]]

-- 16

-- (6.00 secs, 966,584,848 bytes)

graficaLongMayorHuecoBinario :: Int -> IO ()

graficaLongMayorHuecoBinario n =

plotList [ Key Nothing

, Title ("graficaLongMayorHuecoBinario " ++ show n)

, PNG ("Huecos_binarios_" ++ show n ++ ".png")

]

[longMayorHuecoBinario k | k <- [0..n-1]]

Celdas interiores de una retícula

PorJosé A. Alonso 5-febrero-201812-febrero-2018

Las celdas de una retícula cuadrada se numeran consecutivamente. Por ejemplo, la numeración de la retícula cuadrada de lado 4 es

   1, 2, 3, 4
   5, 6, 7, 8
   9,10,11,12
  13,14,15,16

1, 2, 3, 4

5, 6, 7, 8

9,10,11,12

13,14,15,16

Los números de sus celdas interiores son 6,7,10,11.

Definir la función

   interiores :: Int -> [Int]

1	interiores :: Int -> [Int]

tal que (interiores n) es la lista de los números de las celdas interiores de la retícula cuadrada de lado n. Por ejemplo,

   interiores 4  == [6,7,10,11]
   interiores 5  == [7,8,9,12,13,14,17,18,19]
   interiores 6  == [8,9,10,11,14,15,16,17,20,21,22,23,26,27,28,29]
   interiores 2  == []
   length (interiores 2018)  == 4064256

interiores 4 == [6,7,10,11]

interiores 5 == [7,8,9,12,13,14,17,18,19]

interiores 6 == [8,9,10,11,14,15,16,17,20,21,22,23,26,27,28,29]

interiores 2 == []

length (interiores 2018) == 4064256

Comprobar con QuickCheck que el número de celdas interiores de la retícula cuadrada de lado n, con n > 1, es (n-2)^2.

Soluciones

import Test.QuickCheck
import Data.List.Split (divvy)

-- 1ª solución
interiores :: Int -> [Int]
interiores n = [i | i <- [n..n*n-n], i `mod` n > 1]

-- 2ª solución
interiores2 :: Int -> [Int]
interiores2 n = aux [n+1..n^2-n]
  where aux xss@(x:xs) = take (n-2) xs ++ aux (drop n xss)
        aux []         = []

-- 3ª solución 
interiores3 :: Int -> [Int]
interiores3 n = concat (divvy (n-2) n [n+2..n*(n-1)-1])

-- 4ª solución
interiores4 :: Int -> [Int]
interiores4 n = concat [map (+(n*k)) [2..n-1] | k <- [1..n-2]]

-- 5ª solución
interiores5 :: Int -> [Int]
interiores5 n = concat (take (n-2) (iterate (map (+n)) [n+2..2*n-1]))

-- La propiedad es
prop_interiores :: Int -> Property
prop_interiores n =
  n > 1 ==> length (interiores n) == (n-2)^2

-- La comprobación es
--    λ> quickCheck prop_interiores
--    +++ OK, passed 100 tests.

import Test.QuickCheck

import Data.List.Split (divvy)

-- 1ª solución

interiores :: Int -> [Int]

interiores n = [i | i <- [n..n*n-n], i `mod` n > 1]

-- 2ª solución

interiores2 :: Int -> [Int]

interiores2 n = aux [n+1..n^2-n]

where aux xss@(x:xs) = take (n-2) xs ++ aux (drop n xss)

aux [] = []

-- 3ª solución

interiores3 :: Int -> [Int]

interiores3 n = concat (divvy (n-2) n [n+2..n*(n-1)-1])

-- 4ª solución

interiores4 :: Int -> [Int]

interiores4 n = concat [map (+(n*k)) [2..n-1] | k <- [1..n-2]]

-- 5ª solución

interiores5 :: Int -> [Int]

interiores5 n = concat (take (n-2) (iterate (map (+n)) [n+2..2*n-1]))

-- La propiedad es

prop_interiores :: Int -> Property

prop_interiores n =

n > 1 ==> length (interiores n) == (n-2)^2

-- La comprobación es

-- λ> quickCheck prop_interiores

-- +++ OK, passed 100 tests.

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico