José A. Alonso

Sumas de dos capicúas

PorJosé A. Alonso 17-enero-201724-enero-2017

Definir las funciones

   sumas2Capicuas  :: Integer -> [(Integer, Integer)]
   noSuma2Capicuas :: [Integer]

1 2	sumas2Capicuas :: Integer -> [(Integer, Integer)] noSuma2Capicuas :: [Integer]

tales que

(sumas2Capicuas x) es la lista de las descomposiciones de x como suma de dos capicúas (con el primer sumando menor o igual que el segundo). Por ejemplo,

      sumas2Capicuas 17  == [(6,11),(8,9)]
      sumas2Capicuas 187 == [(6,181),(66,121),(88,99)]
      sumas2Capicuas 165 == [(4,161),(44,121),(66,99),(77,88)]
      sumas2Capicuas 382 == [(9,373),(191,191)]
      sumas2Capicuas 151 == [(0,151)]
      sumas2Capicuas 201 == []

sumas2Capicuas 17 == [(6,11),(8,9)]

sumas2Capicuas 187 == [(6,181),(66,121),(88,99)]

sumas2Capicuas 165 == [(4,161),(44,121),(66,99),(77,88)]

sumas2Capicuas 382 == [(9,373),(191,191)]

sumas2Capicuas 151 == [(0,151)]

sumas2Capicuas 201 == []

noSuma2Capicuas es la sucesión de los números que no se pueden escribir como suma de dos capicúas. Por ejemplo,

      λ> take 15 noSuma2Capicuas
      [21,32,43,54,65,76,87,98,201,1031,1041,1042,1051,1052,1053]
      λ> noSuma2Capicuas !! 3000
      19941

λ> take 15 noSuma2Capicuas

[21,32,43,54,65,76,87,98,201,1031,1041,1042,1051,1052,1053]

λ> noSuma2Capicuas !! 3000

19941

Soluciones

sumas2Capicuas :: Integer -> [(Integer, Integer)]
sumas2Capicuas x =
  [(y,z) | y <- takeWhile (<= (x `div` 2)) capicuas
         , let z = x - y
         , esCapicua z]

-- capicuas es la sucesión de los números capicúas. Por ejemplo,
--    λ> take 45 capicuas
--    [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,
--     141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,
--     303,313,323,333,343,353]
-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".
capicuas :: [Integer]
capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número
-- par de dígitos. Por ejemplo,  
--    λ> take 17 capicuasPares
--    [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]
capicuasPares :: [Integer]
capicuasPares =
  [read (ns ++ reverse ns) | n <- [0..]
                           , let ns = show n]   

-- capicuasImpares es la sucesión de las capicúas con un número
-- impar de dígitos a partir de 1. Por ejemplo,  
--    λ> take 20 capicuasImpares
--    [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]
capicuasImpares :: [Integer]
capicuasImpares =
  [1..9] ++ [read (ns ++ [z] ++ reverse ns)
            | n <- [1..]
            , let ns = show n
            , z <- "0123456789"]   

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas
-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos
-- distintos. Por ejemplo,
--    take 10 (mezcla [2,12..] [5,15..])  ==  [2,5,12,15,22,25,32,35,42,45]
--    take 10 (mezcla [2,22..] [5,15..])  ==  [2,5,15,22,25,35,42,45,55,62]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla us@(x:xs) vs@(y:ys)
  | x < y     = x : mezcla xs vs
  | otherwise = y : mezcla us ys

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353   ==  True
--    esCapicua 3553  ==  True
--    esCapicua 3535  ==  False
esCapicua :: Integer -> Bool
esCapicua x =
  xs == reverse xs
  where xs = show x

noSuma2Capicuas :: [Integer]
noSuma2Capicuas =
  [x | x <- [0..]
     , null (sumas2Capicuas x)]

sumas2Capicuas :: Integer -> [(Integer, Integer)]

sumas2Capicuas x =

[(y,z) | y <- takeWhile (<= (x `div` 2)) capicuas

, let z = x - y

, esCapicua z]

-- capicuas es la sucesión de los números capicúas. Por ejemplo,

-- λ> take 45 capicuas

-- [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,

-- 141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,

-- 303,313,323,333,343,353]

-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".

capicuas :: [Integer]

capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número

-- par de dígitos. Por ejemplo,

-- λ> take 17 capicuasPares

-- [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]

capicuasPares :: [Integer]

capicuasPares =

[read (ns ++ reverse ns) | n <- [0..]

, let ns = show n]

-- capicuasImpares es la sucesión de las capicúas con un número

-- impar de dígitos a partir de 1. Por ejemplo,

-- λ> take 20 capicuasImpares

-- [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]

capicuasImpares :: [Integer]

capicuasImpares =

[1..9] ++ [read (ns ++ [z] ++ reverse ns)

| n <- [1..]

, let ns = show n

, z <- "0123456789"]

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas

-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos

-- distintos. Por ejemplo,

-- take 10 (mezcla [2,12..] [5,15..]) == [2,5,12,15,22,25,32,35,42,45]

-- take 10 (mezcla [2,22..] [5,15..]) == [2,5,15,22,25,35,42,45,55,62]

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

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

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,

-- esCapicua 353 == True

-- esCapicua 3553 == True

-- esCapicua 3535 == False

esCapicua :: Integer -> Bool

esCapicua x =

xs == reverse xs

where xs = show x

noSuma2Capicuas :: [Integer]

noSuma2Capicuas =

[x | x <- [0..]

, null (sumas2Capicuas x)]

Inversa del factorial

PorJosé A. Alonso 16-enero-201726-marzo-2022

Definir la función

   inversaFactorial :: Integer -> Maybe Integer

1	inversaFactorial :: Integer -> Maybe Integer

tal que (inversaFactorial x) es (Just n) si el factorial de n es x y es Nothing si no existe ningún número n tal que el factorial de n es x. Por ejemplo,

   inversaFactorial 24  ==  Just 4
   inversaFactorial 25  ==  Nothing

1 2	inversaFactorial 24 == Just 4 inversaFactorial 25 == Nothing

Soluciones

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

inversaFactorial :: Integer -> Maybe Integer
inversaFactorial 1 = Just 1
inversaFactorial x = aux 2 x
  where aux n 1 = Just (n-1)
        aux n y | y `mod` n == 0 = aux (n+1) (y `div` n)
                | otherwise      = Nothing

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

inversaFactorial2 :: Integer -> Maybe Integer
inversaFactorial2 x
  | y == x   = Just n
  |otherwise = Nothing  
  where ((n,y):_) = dropWhile (\(k,z) -> z < x) factorialesAnotados

-- factorialesAnotados es la lista de los factoriales anotados con sus
-- posiciones. Por ejemplo, 
--    take 5 factorialesAnotados  ==  [(0,1),(1,1),(2,2),(3,6),(4,24)]
factorialesAnotados :: [(Integer, Integer)]
factorialesAnotados = zip [0..] factoriales
    
-- factoriales es la lista de los factoriales. Por ejemplo,
--    take 5 factoriales  ==  [1,1,2,6,24]
factoriales :: [Integer]
factoriales =
  1 : scanl1 (*) [1..]

-- Comparación de eficiencia
--    λ> inversaFactorial (product [1..4*10^4])
--    Just 40000
--    (2.76 secs, 3,105,158,528 bytes)
--    λ> inversaFactorial2 (product [1..4*10^4])
--    Just 40000
--    (2.60 secs, 3,261,722,960 bytes)
--
--    λ> inversaFactorial (1 + product [1..4*10^4])
--    Nothing
--    (1.80 secs, 1,626,433,432 bytes)
--    λ> inversaFactorial2 (1 + product [1..4*10^4])
--    Nothing
--    (2.56 secs, 3,257,388,296 bytes)

-- 1ª definición

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

inversaFactorial :: Integer -> Maybe Integer

inversaFactorial 1 = Just 1

inversaFactorial x = aux 2 x

where aux n 1 = Just (n-1)

aux n y | y `mod` n == 0 = aux (n+1) (y `div` n)

| otherwise = Nothing

-- 2ª definición

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

inversaFactorial2 :: Integer -> Maybe Integer

inversaFactorial2 x

| y == x = Just n

|otherwise = Nothing

where ((n,y):_) = dropWhile (\(k,z) -> z < x) factorialesAnotados

-- factorialesAnotados es la lista de los factoriales anotados con sus

-- posiciones. Por ejemplo,

-- take 5 factorialesAnotados == [(0,1),(1,1),(2,2),(3,6),(4,24)]

factorialesAnotados :: [(Integer, Integer)]

factorialesAnotados = zip [0..] factoriales

-- factoriales es la lista de los factoriales. Por ejemplo,

-- take 5 factoriales == [1,1,2,6,24]

factoriales :: [Integer]

factoriales =

1 : scanl1 (*) [1..]

-- Comparación de eficiencia

-- λ> inversaFactorial (product [1..4*10^4])

-- Just 40000

-- (2.76 secs, 3,105,158,528 bytes)

-- λ> inversaFactorial2 (product [1..4*10^4])

-- Just 40000

-- (2.60 secs, 3,261,722,960 bytes)

-- λ> inversaFactorial (1 + product [1..4*10^4])

-- Nothing

-- (1.80 secs, 1,626,433,432 bytes)

-- λ> inversaFactorial2 (1 + product [1..4*10^4])

-- Nothing

-- (2.56 secs, 3,257,388,296 bytes)

Suma ordenada de listas infinitas ordenadas

PorJosé A. Alonso 13-enero-201720-enero-2017

Definir la función

   sumaOrdenada :: [Integer] -> [Integer] -> [Integer]

1	sumaOrdenada :: [Integer] -> [Integer] -> [Integer]

tal que (sumaOrdenada xs ys) es la suma ordenada de las listas infinitas crecientes xs e ys. Por ejemplo,

   λ> take 15 (sumaOrdenada [5,10..] [7,14..])
   [12,17,19,22,24,26,27,29,31,32,33,34,36,37,38]
   λ> take 15 (sumaOrdenada [2^n | n <- [0..]] [3^n | n <- [0..]])
   [2,3,4,5,7,9,10,11,13,17,19,25,28,29,31]

λ> take 15 (sumaOrdenada [5,10..] [7,14..])

[12,17,19,22,24,26,27,29,31,32,33,34,36,37,38]

λ> take 15 (sumaOrdenada [2^n | n <- [0..]] [3^n | n <- [0..]])

[2,3,4,5,7,9,10,11,13,17,19,25,28,29,31]

Soluciones

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

sumaOrdenada1 :: [Integer] -> [Integer] -> [Integer]
sumaOrdenada1 (x:xs) (y:ys) =
  x+y : map (+x) ys `mezcla` map (+y) xs `mezcla` sumaOrdenada1 ys xs

mezcla :: Ord a => [a] -> [a] -> [a]
mezcla (x:xs) (y:ys) | x < y  = x : mezcla xs (y:ys)
                     | x == y = x : mezcla xs ys
                     | x > y  = y : mezcla (x:xs) ys

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

sumaOrdenada2 :: [Integer] -> [Integer] -> [Integer]
sumaOrdenada2 xs ys = mezclaTodas [map (+x) ys | x <- xs]

mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys

-- 1ª definición

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

sumaOrdenada1 :: [Integer] -> [Integer] -> [Integer]

sumaOrdenada1 (x:xs) (y:ys) =

x+y : map (+x) ys `mezcla` map (+y) xs `mezcla` sumaOrdenada1 ys xs

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

mezcla (x:xs) (y:ys) | x < y = x : mezcla xs (y:ys)

| x == y = x : mezcla xs ys

| x > y = y : mezcla (x:xs) ys

-- 2ª definición

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

sumaOrdenada2 :: [Integer] -> [Integer] -> [Integer]

sumaOrdenada2 xs ys = mezclaTodas [map (+x) ys | x <- xs]

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

mezclaTodas = foldr1 xmezcla

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

Sumas de tres capicúas

PorJosé A. Alonso 12-enero-201719-enero-2017

Definir la función

   sumas3Capicuas  :: Integer -> [(Integer, Integer, Integer)]

1	sumas3Capicuas :: Integer -> [(Integer, Integer, Integer)]

tales que (sumas3Capicuas x) es la lista de las descomposiciones de x como suma de tres capicúas (con los sumandos no decrecientes). Por ejemplo,

   sumas3Capicuas 0  ==  [(0,0,0)]
   sumas3Capicuas 1  ==  [(0,0,1)]
   sumas3Capicuas 2  ==  [(0,0,2),(0,1,1)]
   sumas3Capicuas 3  ==  [(0,0,3),(0,1,2),(1,1,1)]
   sumas3Capicuas 4  ==  [(0,0,4),(0,1,3),(0,2,2),(1,1,2)]
   length (sumas3Capicuas 17)      ==  17
   length (sumas3Capicuas 2017)    ==  47
   length (sumas3Capicuas 999999)  ==  15266

sumas3Capicuas 0 == [(0,0,0)]

sumas3Capicuas 1 == [(0,0,1)]

sumas3Capicuas 2 == [(0,0,2),(0,1,1)]

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

sumas3Capicuas 4 == [(0,0,4),(0,1,3),(0,2,2),(1,1,2)]

length (sumas3Capicuas 17) == 17

length (sumas3Capicuas 2017) == 47

length (sumas3Capicuas 999999) == 15266

Comprobar con QuickCheck que todo número natural se puede escribir como suma de tres capicúas.

Soluciones

import Test.QuickCheck

sumas3Capicuas :: Integer -> [(Integer, Integer, Integer)]
sumas3Capicuas x =
  [(a,b,c) | a <- as
           , b <- dropWhile (< a) as
           , let c = x - a - b
           , b <= c 
           , esCapicua c]
  where as = takeWhile (<= x) capicuas

-- capicuas es la sucesión de los números capicúas. Por ejemplo,
--    λ> take 45 capicuas
--    [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,
--     141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,
--     303,313,323,333,343,353]
-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".
capicuas :: [Integer]
capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número
-- par de dígitos. Por ejemplo,  
--    λ> take 17 capicuasPares
--    [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]
capicuasPares :: [Integer]
capicuasPares =
  [read (ns ++ reverse ns) | n <- [0..]
                           , let ns = show n]   

-- capicuasImpares es la sucesión de las capicúas con un número
-- impar de dígitos a partir de 1. Por ejemplo,  
--    λ> take 20 capicuasImpares
--    [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]
capicuasImpares :: [Integer]
capicuasImpares =
  [1..9] ++ [read (ns ++ [z] ++ reverse ns)
            | n <- [1..]
            , let ns = show n
            , z <- "0123456789"]   

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas
-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos
-- distintos. Por ejemplo,
--    take 10 (mezcla [2,12..] [5,15..])  ==  [2,5,12,15,22,25,32,35,42,45]
--    take 10 (mezcla [2,22..] [5,15..])  ==  [2,5,15,22,25,35,42,45,55,62]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla us@(x:xs) vs@(y:ys)
  | x < y     = x : mezcla xs vs
  | otherwise = y : mezcla us ys

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353   ==  True
--    esCapicua 3553  ==  True
--    esCapicua 3535  ==  False
esCapicua :: Integer -> Bool
esCapicua x =
  xs == reverse xs
  where xs = show x

-- La propiedad es
prop_sumas3Capicuas :: Integer -> Property
prop_sumas3Capicuas x =
  x >= 0 ==> not (null (sumas3Capicuas x))

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

import Test.QuickCheck

sumas3Capicuas :: Integer -> [(Integer, Integer, Integer)]

sumas3Capicuas x =

[(a,b,c) | a <- as

, b <- dropWhile (< a) as

, let c = x - a - b

, b <= c

, esCapicua c]

where as = takeWhile (<= x) capicuas

-- capicuas es la sucesión de los números capicúas. Por ejemplo,

-- λ> take 45 capicuas

-- [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,

-- 141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,

-- 303,313,323,333,343,353]

-- Se usará la 2ª definición del ejercicio "Sucesión de capicúas".

capicuas :: [Integer]

capicuas = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número

-- par de dígitos. Por ejemplo,

-- λ> take 17 capicuasPares

-- [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]

capicuasPares :: [Integer]

capicuasPares =

[read (ns ++ reverse ns) | n <- [0..]

, let ns = show n]

-- capicuasImpares es la sucesión de las capicúas con un número

-- impar de dígitos a partir de 1. Por ejemplo,

-- λ> take 20 capicuasImpares

-- [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]

capicuasImpares :: [Integer]

capicuasImpares =

[1..9] ++ [read (ns ++ [z] ++ reverse ns)

| n <- [1..]

, let ns = show n

, z <- "0123456789"]

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas

-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos

-- distintos. Por ejemplo,

-- take 10 (mezcla [2,12..] [5,15..]) == [2,5,12,15,22,25,32,35,42,45]

-- take 10 (mezcla [2,22..] [5,15..]) == [2,5,15,22,25,35,42,45,55,62]

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

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

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,

-- esCapicua 353 == True

-- esCapicua 3553 == True

-- esCapicua 3535 == False

esCapicua :: Integer -> Bool

esCapicua x =

xs == reverse xs

where xs = show x

-- La propiedad es

prop_sumas3Capicuas :: Integer -> Property

prop_sumas3Capicuas x =

x >= 0 ==> not (null (sumas3Capicuas x))

-- La comprobación es

-- λ> quickCheck prop_sumas3Capicuas

-- +++ OK, passed 100 tests.

Sucesión de capicúas

PorJosé A. Alonso 11-enero-201718-enero-2017

Definir las funciones

   capicuas        :: [Integer] 
   posicionCapicua :: Integer -> Integer

1 2	capicuas :: [Integer] posicionCapicua :: Integer -> Integer

tales que

capicuas es la sucesión de los números capicúas. Por ejemplo,

   λ> take 45 capicuas
   [0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,
    141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,
    303,313,323,333,343,353]
   λ> capicuas !! (10^5)  
   900010009

λ> take 45 capicuas

[0,1,2,3,4,5,6,7,8,9,11,22,33,44,55,66,77,88,99,101,111,121,131,

141,151,161,171,181,191,202,212,222,232,242,252,262,272,282,292,

303,313,323,333,343,353]

λ> capicuas !! (10^5)

900010009

(posicionCapicua x) es la posición del número capicúa x en la sucesión de los capicúas. Por ejemplo,

   λ> posicionCapicua 353
   44
   λ> posicionCapicua 900010009
   100000
   λ> let xs = show (123^30)
   λ> posicionCapicua (read (xs ++ reverse xs))
   1497912859868342793044999075260564303046944727069807798026337448
   λ> posicionCapicua (read (xs ++ "7" ++ reverse xs))
   5979128598683427930449990752605643030469447270698077980263374496

λ> posicionCapicua 353

λ> posicionCapicua 900010009

100000

λ> let xs = show (123^30)

λ> posicionCapicua (read (xs ++ reverse xs))

1497912859868342793044999075260564303046944727069807798026337448

λ> posicionCapicua (read (xs ++ "7" ++ reverse xs))

5979128598683427930449990752605643030469447270698077980263374496

Soluciones

import Data.List (genericLength)

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

capicuas1 :: [Integer]
capicuas1 = [n | n <- [0..]
               , esCapicua n]

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353   ==  True
--    esCapicua 3553  ==  True
--    esCapicua 3535  ==  False
esCapicua :: Integer -> Bool
esCapicua x =
  xs == reverse xs
  where xs = show x


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

capicuas2 :: [Integer]
capicuas2 = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número
-- par de dígitos. Por ejemplo,  
--    λ> take 17 capicuasPares
--    [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]
capicuasPares :: [Integer]
capicuasPares =
  [read (ns ++ reverse ns) | n <- [0..]
                           , let ns = show n]   

-- capicuasImpares es la sucesión de las capicúas con un número
-- impar de dígitos a partir de 1. Por ejemplo,  
--    λ> take 20 capicuasImpares
--    [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]
capicuasImpares :: [Integer]
capicuasImpares =
  [1..9] ++ [read (ns ++ [z] ++ reverse ns)
            | n <- [1..]
            , let ns = show n
            , z <- "0123456789"]   

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas
-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos
-- distintos. Por ejemplo,
--    take 10 (mezcla [2,12..] [5,15..])  ==  [2,5,12,15,22,25,32,35,42,45]
--    take 10 (mezcla [2,22..] [5,15..])  ==  [2,5,15,22,25,35,42,45,55,62]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla us@(x:xs) vs@(y:ys)
  | x < y     = x : mezcla xs vs
  | otherwise = y : mezcla us ys

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

capicuas3 :: [Integer]
capicuas3 = iterate sigCapicua 0

-- (sigCapicua x) es el capicúa siguiente del número x. Por ejemplo,
--    sigCapicua 12321           == 12421
--    sigCapicua 1298921         == 1299921
--    sigCapicua 999             == 1001
--    sigCapicua 9999            == 10001
--    sigCapicua 898             == 909
--    sigCapicua 123456777654321 == 123456787654321
sigCapicua :: Integer -> Integer
sigCapicua n = read cs
    where l  = length (show (n+1))
          k  = l `div` 2
          xs = show ((n `div` (10^k)) + 1) 
          cs = xs ++ drop (l `rem` 2) (reverse xs)

-- 4ª definición de capicuas
-- =========================

capicuas4 :: [Integer]
capicuas4 =
  concatMap generaCapicuas4 [1..]

generaCapicuas4 :: Integer -> [Integer]
generaCapicuas4 1 = [0..9]
generaCapicuas4 n
  | even n    = [read (xs ++ reverse xs)
                | xs <- map show [10^(m-1)..10^m-1]]
  | otherwise = [read (xs ++ (y : reverse xs))
                | xs <- map show [10^(m-1)..10^m-1]
                , y <- "0123456789"]
  where m = n `div` 2

-- 5ª definición de capicuas
-- =========================

capicuas5 :: [Integer]
capicuas5 = 0 : aux 1
  where aux n =    [read (show x ++ tail (reverse (show x)))
                   | x <- [10^(n-1)..10^n-1]]
                ++ [read (show x ++ reverse (show x))
                   | x <- [10^(n-1)..10^n-1]]
                ++ aux (n+1)

-- 6ª definición de capicuas
-- =========================

capicuas6 :: [Integer]
capicuas6 = 0 : map read (capicuas6Aux [1..9])
 
capicuas6Aux :: [Integer] -> [String]
capicuas6Aux xs =  map duplica1 ys
                ++ map duplica2 ys
                ++ capicuas6Aux [head xs * 10 .. last xs * 10 + 9]
  where
    ys          = map show xs
    duplica1 cs = cs ++ tail (reverse cs)
    duplica2 cs = cs ++ reverse cs

-- 7ª definición de capicuas
-- =========================

capicuas7 :: [Integer]
capicuas7 = 0 : map read (capicuas7Aux [1..9])
 
capicuas7Aux :: [Integer] -> [String]
capicuas7Aux xs =  map duplica1 ys
                ++ map duplica2 ys
                ++ capicuas7Aux [head xs * 10 .. last xs * 10 + 9]
  where
    ys       = map show xs
    duplica1 = (++) <$> id <*> tail . reverse
    duplica2 = (++) <$> id <*> reverse

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

--    λ> capicuas1 !! 2000
--    1001001
--    (2.25 secs, 598,879,552 bytes)
--    λ> capicuas2 !! 2000
--    1001001
--    (0.05 secs, 28,630,552 bytes)
--    λ> capicuas3 !! 2000
--    1001001
--    (0.06 secs, 14,721,360 bytes)
--    λ> capicuas4 !! 2000
--    1001001
--    (0.01 secs, 0 bytes)
--    λ> capicuas5 !! 2000
--    1001001
--    (0.01 secs, 0 bytes)
--    λ> capicuas6 !! 2000
--    1001001
--    (0.01 secs, 0 bytes)
--    λ> capicuas7 !! 2000
--    1001001
--    (0.01 secs, 0 bytes)
--    
--    λ> capicuas2 !! (10^5)
--    900010009
--    (2.03 secs, 1,190,503,952 bytes)
--    λ> capicuas3 !! (10^5)
--    900010009
--    (5.12 secs, 1,408,876,328 bytes)
--    λ> capicuas4 !! (10^5)
--    900010009
--    (0.21 secs, 8,249,296 bytes)
--    λ> capicuas5 !! (10^5)
--    900010009
--    (0.10 secs, 31,134,176 bytes)
--    λ> capicuas6 !! (10^5)
--    900010009
--    (0.14 secs, 55,211,272 bytes)
--    λ> capicuas7 !! (10^5)
--    900010009
--    (0.03 secs, 0 bytes)

-- 1ª definición de posicionCapicua
posicionCapicua1 :: Integer -> Integer
posicionCapicua1 x =
  genericLength (takeWhile (< x) capicuas7)

-- 2ª definición
posicionCapicua2 :: Integer -> Integer
posicionCapicua2 x
  | even n    = read ('1' : take (n `div` 2) xs) - 1
  | otherwise = read (show (1 + read [y]) ++ take (n `div` 2) ys) - 1
  where xs@(y:ys) = show x
        n         = genericLength xs

-- Comparación de eficiencia
--    λ> posicionCapicua1 (10^9 - 1)
--    109998
--    (1.98 secs, 1,112,991,520 bytes)
--    λ> posicionCapicua2 (10^9 - 1)
--    109998
--    (0.01 secs, 0 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

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

import Data.List (genericLength)

-- 1ª definición de capicuas

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

capicuas1 :: [Integer]

capicuas1 = [n | n <- [0..]

, esCapicua n]

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,

-- esCapicua 353 == True

-- esCapicua 3553 == True

-- esCapicua 3535 == False

esCapicua :: Integer -> Bool

esCapicua x =

xs == reverse xs

where xs = show x

-- 2ª definición de capicuas

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

capicuas2 :: [Integer]

capicuas2 = capicuasImpares `mezcla` capicuasPares

-- capicuasPares es la sucesión del cero y las capicúas con un número

-- par de dígitos. Por ejemplo,

-- λ> take 17 capicuasPares

-- [0,11,22,33,44,55,66,77,88,99,1001,1111,1221,1331,1441,1551,1661]

capicuasPares :: [Integer]

capicuasPares =

[read (ns ++ reverse ns) | n <- [0..]

, let ns = show n]

-- capicuasImpares es la sucesión de las capicúas con un número

-- impar de dígitos a partir de 1. Por ejemplo,

-- λ> take 20 capicuasImpares

-- [1,2,3,4,5,6,7,8,9,101,111,121,131,141,151,161,171,181,191,202]

capicuasImpares :: [Integer]

capicuasImpares =

[1..9] ++ [read (ns ++ [z] ++ reverse ns)

| n <- [1..]

, let ns = show n

, z <- "0123456789"]

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas

-- ordenadas xs e ys, suponiendo que ambas son infinitas y con elementos

-- distintos. Por ejemplo,

-- take 10 (mezcla [2,12..] [5,15..]) == [2,5,12,15,22,25,32,35,42,45]

-- take 10 (mezcla [2,22..] [5,15..]) == [2,5,15,22,25,35,42,45,55,62]

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

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

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

-- 3ª definición de capicuas

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

capicuas3 :: [Integer]

capicuas3 = iterate sigCapicua 0

-- (sigCapicua x) es el capicúa siguiente del número x. Por ejemplo,

-- sigCapicua 12321 == 12421

-- sigCapicua 1298921 == 1299921

-- sigCapicua 999 == 1001

-- sigCapicua 9999 == 10001

-- sigCapicua 898 == 909

-- sigCapicua 123456777654321 == 123456787654321

sigCapicua :: Integer -> Integer

sigCapicua n = read cs

where l = length (show (n+1))

k = l `div` 2

xs = show ((n `div` (10^k)) + 1)

cs = xs ++ drop (l `rem` 2) (reverse xs)

-- 4ª definición de capicuas

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

capicuas4 :: [Integer]

capicuas4 =

concatMap generaCapicuas4 [1..]

generaCapicuas4 :: Integer -> [Integer]

generaCapicuas4 1 = [0..9]

generaCapicuas4 n

| even n = [read (xs ++ reverse xs)

| xs <- map show [10^(m-1)..10^m-1]]

| otherwise = [read (xs ++ (y : reverse xs))

| xs <- map show [10^(m-1)..10^m-1]

, y <- "0123456789"]

where m = n `div` 2

-- 5ª definición de capicuas

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

capicuas5 :: [Integer]

capicuas5 = 0 : aux 1

where aux n = [read (show x ++ tail (reverse (show x)))

| x <- [10^(n-1)..10^n-1]]

++ [read (show x ++ reverse (show x))

| x <- [10^(n-1)..10^n-1]]

++ aux (n+1)

-- 6ª definición de capicuas

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

capicuas6 :: [Integer]

capicuas6 = 0 : map read (capicuas6Aux [1..9])

capicuas6Aux :: [Integer] -> [String]

capicuas6Aux xs = map duplica1 ys

++ map duplica2 ys

++ capicuas6Aux [head xs * 10 .. last xs * 10 + 9]

where

ys = map show xs

duplica1 cs = cs ++ tail (reverse cs)

duplica2 cs = cs ++ reverse cs

-- 7ª definición de capicuas

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

capicuas7 :: [Integer]

capicuas7 = 0 : map read (capicuas7Aux [1..9])

capicuas7Aux :: [Integer] -> [String]

capicuas7Aux xs = map duplica1 ys

++ map duplica2 ys

++ capicuas7Aux [head xs * 10 .. last xs * 10 + 9]

where

ys = map show xs

duplica1 = (++) <$> id <*> tail . reverse

duplica2 = (++) <$> id <*> reverse

-- Comparación de eficiencia

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

-- λ> capicuas1 !! 2000

-- 1001001

-- (2.25 secs, 598,879,552 bytes)

-- λ> capicuas2 !! 2000

-- 1001001

-- (0.05 secs, 28,630,552 bytes)

-- λ> capicuas3 !! 2000

-- 1001001

-- (0.06 secs, 14,721,360 bytes)

-- λ> capicuas4 !! 2000

-- 1001001

-- (0.01 secs, 0 bytes)

-- λ> capicuas5 !! 2000

-- 1001001

-- (0.01 secs, 0 bytes)

-- λ> capicuas6 !! 2000

-- 1001001

-- (0.01 secs, 0 bytes)

-- λ> capicuas7 !! 2000

-- 1001001

-- (0.01 secs, 0 bytes)

-- λ> capicuas2 !! (10^5)

-- 900010009

-- (2.03 secs, 1,190,503,952 bytes)

-- λ> capicuas3 !! (10^5)

-- 900010009

-- (5.12 secs, 1,408,876,328 bytes)

-- λ> capicuas4 !! (10^5)

-- 900010009

-- (0.21 secs, 8,249,296 bytes)

-- λ> capicuas5 !! (10^5)

-- 900010009

-- (0.10 secs, 31,134,176 bytes)

-- λ> capicuas6 !! (10^5)

-- 900010009

-- (0.14 secs, 55,211,272 bytes)

-- λ> capicuas7 !! (10^5)

-- 900010009

-- (0.03 secs, 0 bytes)

-- 1ª definición de posicionCapicua

posicionCapicua1 :: Integer -> Integer

posicionCapicua1 x =

genericLength (takeWhile (< x) capicuas7)

-- 2ª definición

posicionCapicua2 :: Integer -> Integer

posicionCapicua2 x

| even n = read ('1' : take (n `div` 2) xs) - 1

| otherwise = read (show (1 + read [y]) ++ take (n `div` 2) ys) - 1

where xs@(y:ys) = show x

n = genericLength xs

-- Comparación de eficiencia

-- λ> posicionCapicua1 (10^9 - 1)

-- 109998

-- (1.98 secs, 1,112,991,520 bytes)

-- λ> posicionCapicua2 (10^9 - 1)

-- 109998

-- (0.01 secs, 0 bytes)

Nodos con k sucesores

PorJosé A. Alonso 10-enero-201717-enero-2017

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         8   3  
       |        /|\       /|\  |   
       4       4 5 6     4 5 6 7

1 1 1

/ \ / \ / \

8 3 8 3 8 3

| /|\ /|\ |

4 4 5 6 4 5 6 7

se representan por

   ej1, ej2, ej3 :: Arbol Int
   ej1 = N 1 [N 8 [],N 3 [N 4 []]]
   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 8 [],N 3 [N 4 []]]

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

   nodos :: Int -> Arbol a -> [a]

1	nodos :: Int -> Arbol a -> [a]

tal que (nodos k x) es la lista de los nodos del árbol x que tienen k sucesores. Por ejemplo,

   nodos 0 ej1  ==  [8,4]
   nodos 1 ej1  ==  [3]
   nodos 2 ej1  ==  [1]
   nodos 3 ej1  ==  []
   nodos 3 ej2  ==  [3]

nodos 0 ej1 == [8,4]

nodos 1 ej1 == [3]

nodos 2 ej1 == [1]

nodos 3 ej1 == []

nodos 3 ej2 == [3]

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show
           
ej1, ej2, ej3 :: Arbol Int
ej1 = N 1 [N 8 [],N 3 [N 4 []]]
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 []]]

nodos :: Int -> Arbol a -> [a]
nodos k (N x ys)
  | k == length ys = x : concatMap (nodos k) ys
  | otherwise      = concatMap (nodos k) ys

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

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

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

nodos :: Int -> Arbol a -> [a]

nodos k (N x ys)

| k == length ys = x : concatMap (nodos k) ys

| otherwise = concatMap (nodos k) ys

Sumas y restas alternativas

PorJosé A. Alonso 9-enero-201716-enero-2017

Definir la función

   sumasYrestas :: Num a => [a] -> a

1	sumasYrestas :: Num a => [a] -> a

tal que (sumasYrestas xs) es el resultado de alternativamente los elementos de xs. Por ejemplo,

   sumasYrestas [3,2,4,1,7] = 3 - 2 + 4 - 1 + 7
                            = 11

1 2	sumasYrestas [3,2,4,1,7] = 3 - 2 + 4 - 1 + 7 = 11

Otros ejemplos,

   sumasYrestas [3,2,4]              ==  5
   sumasYrestas [3,2,4,1]            ==  4
   sumasYrestas [3,2,4,1,7]          ==  11
   sumasYrestas (replicate (10^6) 1) ==  0

sumasYrestas [3,2,4] == 5

sumasYrestas [3,2,4,1] == 4

sumasYrestas [3,2,4,1,7] == 11

sumasYrestas (replicate (10^6) 1) == 0

Soluciones

-- 1ª definición
sumasYrestas1 :: Num a => [a] -> a
sumasYrestas1 []       = 0
sumasYrestas1 [x]      = x
sumasYrestas1 (x:y:xs) = x - y + sumasYrestas1 xs

-- 2ª definición
sumasYrestas2 :: Num a => [a] -> a
sumasYrestas2 xs = aux 1 xs
  where aux _ []     = 0
        aux n (y:ys) = n * y + aux (-n) ys

-- 3ª definición
sumasYrestas3 :: Num a => [a] -> a
sumasYrestas3 xs = auxS 0 xs
  where auxS v []       = v
        auxS v [x]      = v + x
        auxS v (x:y:xs) = auxS (v+x-y) xs

-- 4ª definición
sumasYrestas4 :: Num a => [a] -> a
sumasYrestas4 xs =
  sum (zipWith (*) xs [(-1)^n | n <- [0..]])

-- 5ª definición
sumasYrestas5 :: Num a => [a] -> a
sumasYrestas5 = sum . zipWith (*) (cycle [1,-1])

-- 6ª definición
sumasYrestas6 :: Num a => [a] -> a
sumasYrestas6 = foldr (-) 0

-- Comparación de eficiencia
--    λ> sumasYrestas1 (replicate (10^6) 1)
--    0
--    (1.50 secs, 171,623,648 bytes)
--    λ> sumasYrestas2 (replicate (10^6) 1)
--    0
--    (3.78 secs, 382,691,856 bytes)
--    λ> sumasYrestas3 (replicate (10^6) 1)
--    0
--    (1.39 secs, 204,404,024 bytes)
--    λ> sumasYrestas4 (replicate (10^6) 1)
--    0
--    (16.04 secs, 5,727,351,024 bytes)
--    λ> sumasYrestas5 (replicate (10^6) 1)
--    0
--    (1.39 secs, 235,770,344 bytes)
--    λ> sumasYrestas6 (replicate (10^6) 1)
--    0
--    (0.53 secs, 142,802,656 bytes)

-- 1ª definición

sumasYrestas1 :: Num a => [a] -> a

sumasYrestas1 [] = 0

sumasYrestas1 [x] = x

sumasYrestas1 (x:y:xs) = x - y + sumasYrestas1 xs

-- 2ª definición

sumasYrestas2 :: Num a => [a] -> a

sumasYrestas2 xs = aux 1 xs

where aux _ [] = 0

aux n (y:ys) = n * y + aux (-n) ys

-- 3ª definición

sumasYrestas3 :: Num a => [a] -> a

sumasYrestas3 xs = auxS 0 xs

where auxS v [] = v

auxS v [x] = v + x

auxS v (x:y:xs) = auxS (v+x-y) xs

-- 4ª definición

sumasYrestas4 :: Num a => [a] -> a

sumasYrestas4 xs =

sum (zipWith (*) xs [(-1)^n | n <- [0..]])

-- 5ª definición

sumasYrestas5 :: Num a => [a] -> a

sumasYrestas5 = sum . zipWith (*) (cycle [1,-1])

-- 6ª definición

sumasYrestas6 :: Num a => [a] -> a

sumasYrestas6 = foldr (-) 0

-- Comparación de eficiencia

-- λ> sumasYrestas1 (replicate (10^6) 1)

-- 0

-- (1.50 secs, 171,623,648 bytes)

-- λ> sumasYrestas2 (replicate (10^6) 1)

-- 0

-- (3.78 secs, 382,691,856 bytes)

-- λ> sumasYrestas3 (replicate (10^6) 1)

-- 0

-- (1.39 secs, 204,404,024 bytes)

-- λ> sumasYrestas4 (replicate (10^6) 1)

-- 0

-- (16.04 secs, 5,727,351,024 bytes)

-- λ> sumasYrestas5 (replicate (10^6) 1)

-- 0

-- (1.39 secs, 235,770,344 bytes)

-- λ> sumasYrestas6 (replicate (10^6) 1)

-- 0

-- (0.53 secs, 142,802,656 bytes)

Números dorados

PorJosé A. Alonso 6-enero-201713-enero-2017

Los dígitos del número 2375 se pueden separar en dos grupos de igual tamaño ([7,2] y [5,3]) tales que para los correspondientes números (72 y 53) se verifique que la diferencia de sus cuadrados sea el número original (es decir, 72^2 – 53^2 = 2375).

Un número x es dorado si sus dígitos se pueden separar en dos grupos de igual tamaño tales que para los correspondientes números (a y b) se verifique que la diferencia de sus cuadrados sea el número original (es decir, b^2 – a^2 = x).

Definir la función

   esDorado :: Integer -> Bool

1	esDorado :: Integer -> Bool

tales que (esDorado x) se verifica si x es un número dorado. Por
ejemplo,

   λ> esDorado 2375
   True
   λ> take 5 [x | x <- [1..], esDorado x]
   [48,1023,1404,2325,2375]

λ> esDorado 2375

True

λ> take 5 [x | x <- [1..], esDorado x]

[48,1023,1404,2325,2375]

Soluciones

import Data.List (permutations)

esDorado :: Integer -> Bool
esDorado x =
  even (length (show x)) &&
  or [b^2 - a^2 == x | (a,b) <- particionesNumero x]

-- (particiones xs) es la lista de las formas de dividir xs en dos
-- partes de igual longitud (se supone que xs tiene un número par de
-- elementos). Por ejemplo,
--    λ> particiones "abcd"
--    [("ab","cd"),("ba","cd"),("cb","ad"),("bc","ad"),("ca","bd"),
--     ("ac","bd"),("dc","ba"),("cd","ba"),("cb","da"),("db","ca"),
--     ("bd","ca"),("bc","da"),("da","bc"),("ad","bc"),("ab","dc"),
--     ("db","ac"),("bd","ac"),("ba","dc"),("da","cb"),("ad","cb"),
--     ("ac","db"),("dc","ab"),("cd","ab"),("ca","db")]
particiones :: [a] -> [([a],[a])]
particiones xs =
  [splitAt m ys | ys <- permutations xs]
  where m = length xs `div` 2

-- (particionesNumero n) es la lista de las formas de dividir n en dos
-- partes de igual longitud (se supone que n tiene un número par de
-- dígitos). Por ejemplo,
--    λ> particionesNumero 1234
--    [(12,34),(21,34),(32,14),(23,14),(31,24),(13,24),(43,21),(34,21),
--     (32,41),(42,31),(24,31),(23,41),(41,23),(14,23),(12,43),(42,13),
--     (24,13),(21,43),(41,32),(14,32),(13,42),(43,12),(34,12),(31,42)]
particionesNumero :: Integer -> [(Integer,Integer)]
particionesNumero n =
  [(read xs,read ys) | (xs,ys) <- particiones (show n)]

import Data.List (permutations)

esDorado :: Integer -> Bool

esDorado x =

even (length (show x)) &&

or [b^2 - a^2 == x | (a,b) <- particionesNumero x]

-- (particiones xs) es la lista de las formas de dividir xs en dos

-- partes de igual longitud (se supone que xs tiene un número par de

-- elementos). Por ejemplo,

-- λ> particiones "abcd"

-- [("ab","cd"),("ba","cd"),("cb","ad"),("bc","ad"),("ca","bd"),

-- ("ac","bd"),("dc","ba"),("cd","ba"),("cb","da"),("db","ca"),

-- ("bd","ca"),("bc","da"),("da","bc"),("ad","bc"),("ab","dc"),

-- ("db","ac"),("bd","ac"),("ba","dc"),("da","cb"),("ad","cb"),

-- ("ac","db"),("dc","ab"),("cd","ab"),("ca","db")]

particiones :: [a] -> [([a],[a])]

particiones xs =

[splitAt m ys | ys <- permutations xs]

where m = length xs `div` 2

-- (particionesNumero n) es la lista de las formas de dividir n en dos

-- partes de igual longitud (se supone que n tiene un número par de

-- dígitos). Por ejemplo,

-- λ> particionesNumero 1234

-- [(12,34),(21,34),(32,14),(23,14),(31,24),(13,24),(43,21),(34,21),

-- (32,41),(42,31),(24,31),(23,41),(41,23),(14,23),(12,43),(42,13),

-- (24,13),(21,43),(41,32),(14,32),(13,42),(43,12),(34,12),(31,42)]

particionesNumero :: Integer -> [(Integer,Integer)]

particionesNumero n =

[(read xs,read ys) | (xs,ys) <- particiones (show n)]

Sucesión de cuadrados reducidos

PorJosé A. Alonso 5-enero-201712-enero-2017

La sucesión de cuadrados de orden n definida a partir de un número x se forma iniciándola en x y, para cada término z el siguiente es el número formado por los n primeros dígitos del cuadrado de z. Por ejemplo, para n = 4 y x = 1111, el primer término de la sucesión es 1111, el segundo es 1234 (ya que 1111^2 = 1234321) y el tercero es 1522 (ya que 1234^2 = 1522756).

Definir la función

   sucCuadrados :: Int -> Integer -> [Integer]

1	sucCuadrados :: Int -> Integer -> [Integer]

tal que (sucCuadrados n x) es la sucesión de cuadrados de orden n definida a partir de x. Por ejemplo,

   λ> take 10 (sucCuadrados 4 1111)
   [1111,1234,1522,2316,5363,2876,8271,6840,4678,2188]
   λ> take 10 (sucCuadrados 3 457)
   [457,208,432,186,345,119,141,198,392,153]
   λ> take 20 (sucCuadrados 2 55)
   [55,30,90,81,65,42,17,28,78,60,36,12,14,19,36,12,14,19,36,12]

λ> take 10 (sucCuadrados 4 1111)

[1111,1234,1522,2316,5363,2876,8271,6840,4678,2188]

λ> take 10 (sucCuadrados 3 457)

[457,208,432,186,345,119,141,198,392,153]

λ> take 20 (sucCuadrados 2 55)

[55,30,90,81,65,42,17,28,78,60,36,12,14,19,36,12,14,19,36,12]

Soluciones

sucCuadrados :: Int -> Integer -> [Integer]
sucCuadrados n x = iterate (siguiente n) x

siguiente :: Int -> Integer -> Integer
siguiente n x = read (take n (show (x^2)))

sucCuadrados :: Int -> Integer -> [Integer]

sucCuadrados n x = iterate (siguiente n) x

siguiente :: Int -> Integer -> Integer

siguiente n x = read (take n (show (x^2)))

Estratificación de un árbol

PorJosé A. Alonso 3-enero-201710-enero-2017

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         8   3  
       |        /|\       /|\  |   
       4       4 5 6     4 5 6 7

1 1 1

/ \ / \ / \

8 3 8 3 8 3

| /|\ /|\ |

4 4 5 6 4 5 6 7

se representan por

   ej1, ej2, ej3 :: Arbol Int
   ej1 = N 1 [N 8 [],N 3 [N 4 []]]
   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 8 [],N 3 [N 4 []]]

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

Un estrato de un árbol es la lista de nodos que se encuentran al mismo nivel de profundidad. Por ejemplo, los estratos del árbol ej1 son [1], [8,3] y [4].

Definir la función

   estratos :: Arbol a -> [[a]]

1	estratos :: Arbol a -> [[a]]

tal que (estratos x) es la lista de los estratos del árbol x. Por ejemplo,

   estratos ej1 == [[1],[8,3],[4]]
   estratos ej2 == [[1],[8,3],[4,5,6]]
   estratos ej3 == [[1],[8,3],[4,5,6,7]]

estratos ej1 == [[1],[8,3],[4]]

estratos ej2 == [[1],[8,3],[4,5,6]]

estratos ej3 == [[1],[8,3],[4,5,6,7]]

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show
           
ej1, ej2, ej3 :: Arbol Int
ej1 = N 1 [N 8 [],N 3 [N 4 []]]
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 []]]

estratos :: Arbol a -> [[a]]
estratos x = takeWhile (not . null) [estrato n x | n <- [0..]]

-- (estrato n x) es el estrato de nivel n del árbol x. Por ejemplo,
--    estrato 0 ej1  ==  [1]
--    estrato 1 ej1  ==  [8,3]
--    estrato 2 ej1  ==  [4]
--    estrato 4 ej1  ==  []
estrato :: Int -> Arbol a ->  [a]
estrato 0 (N x _)  = [x]
estrato n (N _ xs) = concatMap (estrato (n-1)) xs

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

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

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

estratos :: Arbol a -> [[a]]

estratos x = takeWhile (not . null) [estrato n x | n <- [0..]]

-- (estrato n x) es el estrato de nivel n del árbol x. Por ejemplo,

-- estrato 0 ej1 == [1]

-- estrato 1 ej1 == [8,3]

-- estrato 2 ej1 == [4]

-- estrato 4 ej1 == []

estrato :: Int -> Arbol a -> [a]

estrato 0 (N x _) = [x]

estrato n (N _ xs) = concatMap (estrato (n-1)) xs

Terminaciones de Fibonacci

PorJosé A. Alonso 2-enero-20179-enero-2017

Definir la sucesión

   sucFinalesFib :: [(Integer,Integer)]

1	sucFinalesFib :: [(Integer,Integer)]

cuyos elementos son los pares (n,x), donde x es el n-ésimo término de la sucesión de Fibonacci, tales que la terminación de x es n. Por ejemplo,

   λ> take 6 sucFinalesFib
   [(0,0),(1,1),(5,5),(25,75025),(29,514229),(41,165580141)]
   λ> head [(n,x) | (n,x) <- sucFinalesFib, n > 200]
   (245,712011255569818855923257924200496343807632829750245)
   λ> head [n | (n,_) <- sucFinalesFib, n > 10^4]
   10945

λ> take 6 sucFinalesFib

[(0,0),(1,1),(5,5),(25,75025),(29,514229),(41,165580141)]

λ> head [(n,x) | (n,x) <- sucFinalesFib, n > 200]

(245,712011255569818855923257924200496343807632829750245)

λ> head [n | (n,_) <- sucFinalesFib, n > 10^4]

10945

Soluciones

import Data.List (genericIndex, isSuffixOf)

sucFinalesFib :: [(Integer, Integer)]
sucFinalesFib =
  [(n, fib n) | n <- [0..]
              , show n `isSuffixOf` show (fib n)]

sucFib :: [Integer]
sucFib = 0 : 1 : zipWith (+) sucFib (tail sucFib)

-- (fib n) es el n-ésimo término de la sucesión de Fibonacci.
fib :: Integer -> Integer
fib n = sucFib `genericIndex` n

import Data.List (genericIndex, isSuffixOf)

sucFinalesFib :: [(Integer, Integer)]

sucFinalesFib =

[(n, fib n) | n <- [0..]

, show n `isSuffixOf` show (fib n)]

sucFib :: [Integer]

sucFib = 0 : 1 : zipWith (+) sucFib (tail sucFib)

-- (fib n) es el n-ésimo término de la sucesión de Fibonacci.

fib :: Integer -> Integer

fib n = sucFib `genericIndex` n

Segmentos comunes maximales

PorJosé A. Alonso 30-diciembre-20167-enero-2017

Los segmentos de «abcd» son

   ["","a","ab","abc","abcd","b","bc","bcd","c","cd","d"]

1	["","a","ab","abc","abcd","b","bc","bcd","c","cd","d"]

Los segmentos comunes de «abcd» y «axbce» son

   ["","a","b","bc","c"]

1	["","a","b","bc","c"]

Los segmentos comunes maximales (es decir, no contenidos en otros segmentos) de «abcd» y «axbce» son

   ["a","bc"]

1	["a","bc"]

Definir la función

   segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]

1	segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]

tal que (segmentosComunesMaximales xs ys) es la lista de los segmentos comunes maximales de xs e ys. Por ejemplo,

   segmentosComunesMaximales "abcd" "axbce"  ==  ["a","bc"]
   segmentosComunesMaximales [8,8] [8]       ==  [[8]]

1 2	segmentosComunesMaximales "abcd" "axbce" == ["a","bc"] segmentosComunesMaximales [8,8] [8] == [[8]]

Soluciones

import Data.List (inits, tails, isInfixOf)

segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]
segmentosComunesMaximales xs ys =
  nub [zs | zs <- zss
          , null [us | us <- zss, zs `isInfixOf` us, us /= zs]]
  where zss = segmentosComunes xs ys

segmentosComunes :: Eq a => [a] -> [a] -> [[a]]
segmentosComunes xs ys =
  [zs | zs <- segmentos xs
      , zs `isInfixOf` ys]

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,
--    segmentos "abc"  ==  ["","a","ab","abc","b","bc","c"]
segmentos :: [a] -> [[a]]
segmentos xs =
  [] : concatMap (tail . inits) (init (tails xs))

import Data.List (inits, tails, isInfixOf)

segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]

segmentosComunesMaximales xs ys =

nub [zs | zs <- zss

, null [us | us <- zss, zs `isInfixOf` us, us /= zs]]

where zss = segmentosComunes xs ys

segmentosComunes :: Eq a => [a] -> [a] -> [[a]]

segmentosComunes xs ys =

[zs | zs <- segmentos xs

, zs `isInfixOf` ys]

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,

-- segmentos "abc" == ["","a","ab","abc","b","bc","c"]

segmentos :: [a] -> [[a]]

segmentos xs =

[] : concatMap (tail . inits) (init (tails xs))

Números de Perrin

PorJosé A. Alonso 29-diciembre-201625-abril-2021

Los números de Perrin se definen por la relación de recurrencia

   P(n) = P(n - 2) + P(n - 3) si n > 2,

1	P(n) = P(n - 2) + P(n - 3) si n > 2,

con los valores iniciales

   P(0) = 3, P(1) = 0 y P(2) = 2.

1	P(0) = 3, P(1) = 0 y P(2) = 2.

Definir la sucesión

   sucPerrin :: [Integer]

1	sucPerrin :: [Integer]

cuyos elementos son los números de Perrin. Por ejemplo,

   λ> take 15 sucPerrin
   [3,0,2,3,2,5,5,7,10,12,17,22,29,39,51]
   λ> length (show (sucPerrin !! (2*10^5)))
   24425

λ> take 15 sucPerrin

[3,0,2,3,2,5,5,7,10,12,17,22,29,39,51]

λ> length (show (sucPerrin !! (2*10^5)))

24425

Comprobar con QuickCheck si se verifica la siguiente propiedad: para todo entero n > 1, el n-ésimo término de la sucesión de Perrin es divisible por n si y sólo si n es primo.

Soluciones

import Data.List (genericIndex, unfoldr)
import Data.Numbers.Primes (isPrime)
import Test.QuickCheck

-- 1ª definición
sucPerrin1 :: [Integer]
sucPerrin1 = 3 : 0 : 2 : zipWith (+) sucPerrin1 (tail sucPerrin1)

-- 2ª definición
sucPerrin2 :: [Integer]
sucPerrin2 = [x | (x,_,_) <- iterate op (3,0,2)]
  where op (a,b,c) = (b,c,a+b)
 
-- 3ª definición
sucPerrin3 :: [Integer]
sucPerrin3 =
  unfoldr (\(a, (b,c)) -> Just (a, (b,(c,a+b)))) (3,(0,2))

-- Comparación de eficiencia
--    λ> length (show (sucPerrin1 !! (10^5)))
--    12213
--    (1.44 secs, 295,373,680 bytes)
--    λ> length (show (sucPerrin2 !! (10^5)))
--    12213
--    (1.22 secs, 301,493,408 bytes)
--    λ> length (show (sucPerrin3 !! (10^5)))
--    12213
--    (0.86 secs, 296,911,304 bytes)

-- Usaremos la 3ª
sucPerrin :: [Integer]
sucPerrin = sucPerrin3

-- La propiedad es  
conjeturaPerrin :: Integer -> Property
conjeturaPerrin n =
  n > 1 ==>
  (perrin n `mod` n == 0) == isPrime n

-- (perrin n) es el n-ésimo término de la sucesión de Perrin. Por
-- ejemplo,
--    perrin 4  ==  2
--    perrin 5  ==  5
--    perrin 6  ==  5
perrin :: Integer -> Integer
perrin n = sucPerrin `genericIndex` n

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

import Data.List (genericIndex, unfoldr)

import Data.Numbers.Primes (isPrime)

import Test.QuickCheck

-- 1ª definición

sucPerrin1 :: [Integer]

sucPerrin1 = 3 : 0 : 2 : zipWith (+) sucPerrin1 (tail sucPerrin1)

-- 2ª definición

sucPerrin2 :: [Integer]

sucPerrin2 = [x | (x,_,_) <- iterate op (3,0,2)]

where op (a,b,c) = (b,c,a+b)

-- 3ª definición

sucPerrin3 :: [Integer]

sucPerrin3 =

unfoldr (\(a, (b,c)) -> Just (a, (b,(c,a+b)))) (3,(0,2))

-- Comparación de eficiencia

-- λ> length (show (sucPerrin1 !! (10^5)))

-- 12213

-- (1.44 secs, 295,373,680 bytes)

-- λ> length (show (sucPerrin2 !! (10^5)))

-- 12213

-- (1.22 secs, 301,493,408 bytes)

-- λ> length (show (sucPerrin3 !! (10^5)))

-- 12213

-- (0.86 secs, 296,911,304 bytes)

-- Usaremos la 3ª

sucPerrin :: [Integer]

sucPerrin = sucPerrin3

-- La propiedad es

conjeturaPerrin :: Integer -> Property

conjeturaPerrin n =

n > 1 ==>

(perrin n `mod` n == 0) == isPrime n

-- (perrin n) es el n-ésimo término de la sucesión de Perrin. Por

-- ejemplo,

-- perrin 4 == 2

-- perrin 5 == 5

-- perrin 6 == 5

perrin :: Integer -> Integer

perrin n = sucPerrin `genericIndex` n

-- La comprobación es

-- λ> quickCheck conjeturaPerrin

-- +++ OK, passed 100 tests.

Nota: Aunque QuickCheck no haya encontrado contraejemplos, la propiedad no es cierta. Sólo lo es una de las implicaciones: si n es primo, entonces el n-ésimo término de la sucesión de Perrin es divisible por n. La otra es falsa y los primeros contraejemplos son

   271441, 904631, 16532714, 24658561, 27422714, 27664033, 46672291

1	271441, 904631, 16532714, 24658561, 27422714, 27664033, 46672291

Mínima suma de las ramas de un árbol

PorJosé A. Alonso 28-diciembre-201625-marzo-2022

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     5   3         5   3  
       |        /|\       /|\  |   
       4       4 7 6     4 7 6 7

1 1 1

/ \ / \ / \

8 3 5 3 5 3

| /|\ /|\ |

4 4 7 6 4 7 6 7

se representan por

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

ej1, ej2, ej3 :: Arbol Int

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

ej2 = N 1 [N 5 [], N 3 [N 4 [], N 7 [], N 6 []]]

ej3 = N 1 [N 5 [N 4 [], N 7 [], N 6 []], N 3 [N 7 []]]

Definir la función

   minimaSuma :: Arbol Int -> Int

1	minimaSuma :: Arbol Int -> Int

tal que (minimaSuma a) es el mínimo de las sumas de las ramas del árbol a. Por ejemplo,

   minimaSuma ej1  ==  8
   minimaSuma ej2  ==  6
   minimaSuma ej3  ==  10

minimaSuma ej1 == 8

minimaSuma ej2 == 6

minimaSuma ej3 == 10

Soluciones

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

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


-- 1ª definición
-- =============
minimaSuma :: (Ord a, Num a) => Arbol a -> a
minimaSuma a = minimum [sum xs | xs <- ramas a]

-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,
--    ghci> ramas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])
--    [[3,5,6],[3,4],[3,7,2],[3,7,1]]
ramas :: Arbol b -> [[b]]
ramas (N x []) = [[x]]
ramas (N x as) = [x : xs | a <- as, xs <- ramas a]

-- 2ª definición
-- =============
  
minimaSuma2 :: Arbol Int -> Int
minimaSuma2 (N x []) = x
minimaSuma2 (N x as) = x + minimum (map minimaSuma2 as)

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

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

ej2 = N 1 [N 5 [], N 3 [N 4 [], N 7 [], N 6 []]]

ej3 = N 1 [N 5 [N 4 [], N 7 [], N 6 []], N 3 [N 7 []]]

-- 1ª definición

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

minimaSuma :: (Ord a, Num a) => Arbol a -> a

minimaSuma a = minimum [sum xs | xs <- ramas a]

-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,

-- ghci> ramas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])

-- [[3,5,6],[3,4],[3,7,2],[3,7,1]]

ramas :: Arbol b -> [[b]]

ramas (N x []) = [[x]]

ramas (N x as) = [x : xs | a <- as, xs <- ramas a]

-- 2ª definición

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

minimaSuma2 :: Arbol Int -> Int

minimaSuma2 (N x []) = x

minimaSuma2 (N x as) = x + minimum (map minimaSuma2 as)

Números super pandigitales

PorJosé A. Alonso 27-diciembre-20163-enero-2017

Un entero positivo n es pandigital en base b si su expresión en base b contiene todos los dígitos de 0 a b-1 al menos una vez. Por ejemplo,

el 2 es pandigital en base 2 porque 2 en base 2 es 10,
el 11 es pandigital en base 3 porque 11 en base 3 es 102 y
el 75 es pandigital en base 4 porque 75 en base 4 es 1023.

Un número n es super pandigital de orden m si es pandigital en todas las bases
desde 2 hasta m. Por ejemplo, 978 es super pandigital de orden 5 pues

en base 2 es: 1111010010
en base 3 es: 1100020
en base 4 es: 33102
en base 5 es: 12403

Definir la función

   superPandigitales :: Integer -> [Integer]

1	superPandigitales :: Integer -> [Integer]

tal que (superPandigitales m) es la lista de los números super pandigitales de orden m. Por ejemplo,

   take 3 (superPandigitales 3) == [11,19,21]
   take 3 (superPandigitales 4) == [75,99,114]
   take 3 (superPandigitales 5) == [978,1070,1138]

take 3 (superPandigitales 3) == [11,19,21]

take 3 (superPandigitales 4) == [75,99,114]

take 3 (superPandigitales 5) == [978,1070,1138]

Soluciones

superPandigitales :: Integer -> [Integer]
superPandigitales m =
  [n | n <- [1..]
     , and [pandigitalBase b n | b <- [2..m]]]

-- (pandigitalBase b n) se verifica si n es pandigital en base la base
-- b. Por ejemplo,
--    pandigitalBase 4 75  ==  True
--    pandigitalBase 4 76  ==  False
pandigitalBase :: Integer -> Integer -> Bool
pandigitalBase b n = [0..b-1] `esSubconjunto` enBase b n

-- (enBase b n) es la lista de los dígitos de n en base b. Por ejemplo,
--    enBase 4 75  ==  [3,2,0,1]
--    enBase 4 76  ==  [0,3,0,1]
enBase :: Integer -> Integer -> [Integer]
enBase b n | n < b     = [n]
           | otherwise = n `mod` b : enBase b (n `div` b)

-- (esSubconjunto xs ys) se verifica si xs es un subconjunto de ys. Por
-- ejemplo,
--    esSubconjunto [1,5] [5,2,1]  ==  True
--    esSubconjunto [1,5] [5,2,3]  ==  False
esSubconjunto :: Eq a => [a] -> [a] -> Bool
esSubconjunto xs ys = all (`elem` ys) xs

superPandigitales :: Integer -> [Integer]

superPandigitales m =

[n | n <- [1..]

, and [pandigitalBase b n | b <- [2..m]]]

-- (pandigitalBase b n) se verifica si n es pandigital en base la base

-- b. Por ejemplo,

-- pandigitalBase 4 75 == True

-- pandigitalBase 4 76 == False

pandigitalBase :: Integer -> Integer -> Bool

pandigitalBase b n = [0..b-1] `esSubconjunto` enBase b n

-- (enBase b n) es la lista de los dígitos de n en base b. Por ejemplo,

-- enBase 4 75 == [3,2,0,1]

-- enBase 4 76 == [0,3,0,1]

enBase :: Integer -> Integer -> [Integer]

enBase b n | n < b = [n]

| otherwise = n `mod` b : enBase b (n `div` b)

-- (esSubconjunto xs ys) se verifica si xs es un subconjunto de ys. Por

-- ejemplo,

-- esSubconjunto [1,5] [5,2,1] == True

-- esSubconjunto [1,5] [5,2,3] == False

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

esSubconjunto xs ys = all (`elem` ys) xs

Ternas coprimas

PorJosé A. Alonso 26-diciembre-20162-enero-2017

Definir la lista

   ternasCoprimas :: [(Integer,Integer,Integer)]

1	ternasCoprimas :: [(Integer,Integer,Integer)]

cuyos elementos son ternas de primos relativos (a,b,c) tales que a < b y a + b = c. Por ejemplo,

   λ> take 7 ternasCoprimas
   [(1,2,3),(1,3,4),(2,3,5),(1,4,5),(3,4,7),(1,5,6),(2,5,7)]
   λ> ternasCoprimas !! 300000
   (830,993,1823)

λ> take 7 ternasCoprimas

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

λ> ternasCoprimas !! 300000

(830,993,1823)

Soluciones

ternasCoprimas :: [(Integer,Integer,Integer)]
ternasCoprimas =
  [(a,b,a+b) | b <- [1..]
             , a <- [1..b-1]
             , gcd a b == 1]

-- Nota: Si a y b son coprimos, entonces también lo son a con a+b y b
-- con a+b.

ternasCoprimas :: [(Integer,Integer,Integer)]

ternasCoprimas =

[(a,b,a+b) | b <- [1..]

, a <- [1..b-1]

, gcd a b == 1]

-- Nota: Si a y b son coprimos, entonces también lo son a con a+b y b

-- con a+b.

Listas duplicadas

PorJosé A. Alonso 23-diciembre-201630-diciembre-2016

Se observa que en la cadena «aabbccddeffgg» todos los caracteres están duplicados excepto el ‘e’. Al añadirlo obtenemos la lista «aabbccddeeffgg» y se dice que esta última está duplicada.

También se observa que «aaaabbbccccdd» no está duplicada (porque hay un número impar de ‘b’ consecutivas). Añadiendo una ‘b’ se obtiene «aaaabbbbccccdd» que está duplicada.

Definir las funciones

   esDuplicada :: Eq a => [a] -> Bool
   duplica     :: Eq a => [a] -> [a]

1 2	esDuplicada :: Eq a => [a] -> Bool duplica :: Eq a => [a] -> [a]

tales que

(esDuplicada xs) se verifica si xs es una lista duplicada. Por ejemplo,

     esDuplicada "aabbccddeffgg"   ==  False
     esDuplicada "aabbccddeeffgg"  ==  True
     esDuplicada "aaaabbbccccdd"   ==  False
     esDuplicada "aaaabbbbccccdd"  ==  True

esDuplicada "aabbccddeffgg" == False

esDuplicada "aabbccddeeffgg" == True

esDuplicada "aaaabbbccccdd" == False

esDuplicada "aaaabbbbccccdd" == True

(duplica xs) es la lista obtenida duplicando los elementos de xs que no lo están. Por ejemplo,

     duplica "b"        ==  "bb"
     duplica "abba"     ==  "aabbaa"
     duplica "Betis"    ==  "BBeettiiss"
     duplica [1,1,1]    ==  [1,1,1,1]
     duplica [1,1,1,1]  ==  [1,1,1,1]

duplica "b" == "bb"

duplica "abba" == "aabbaa"

duplica "Betis" == "BBeettiiss"

duplica [1,1,1] == [1,1,1,1]

duplica [1,1,1,1] == [1,1,1,1]

Comprobar con QuickCheck que, para cualquier lista de enteros xs, se verifica la siguiente propiedad:

  esDuplicada (duplica xs)

1	esDuplicada (duplica xs)

Soluciones

import Data.List (group)
import Test.QuickCheck

-- 1ª definición de esDuplicada
esDuplicada :: Eq a => [a] -> Bool
esDuplicada []       = True
esDuplicada [_]      = False
esDuplicada (x:y:zs) = x == y && esDuplicada zs

-- 2ª definición de esDuplicada
esDuplicada2 :: Eq a => [a] -> Bool
esDuplicada2 = all (even . length) . group

-- 1ª definición de duplica
duplica :: Eq a => [a] -> [a]
duplica []       = []
duplica [x]      = [x,x]
duplica (x:y:zs) | x == y    = x : x : duplica zs
                 | otherwise = x : x : duplica (y:zs)

-- 2ª definición de duplica
duplica2 :: Eq a => [a] -> [a]
duplica2 xs = concatMap dupl (group xs)
  where dupl ys@(y:_) | (even.length) ys = ys
                      | otherwise        = y : ys

-- Propiedad
prop_duplica_esDuplicada :: [Int] -> Bool
prop_duplica_esDuplicada xs =
  esDuplicada (duplica xs)

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

import Data.List (group)

import Test.QuickCheck

-- 1ª definición de esDuplicada

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

esDuplicada [] = True

esDuplicada [_] = False

esDuplicada (x:y:zs) = x == y && esDuplicada zs

-- 2ª definición de esDuplicada

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

esDuplicada2 = all (even . length) . group

-- 1ª definición de duplica

duplica :: Eq a => [a] -> [a]

duplica [] = []

duplica [x] = [x,x]

duplica (x:y:zs) | x == y = x : x : duplica zs

| otherwise = x : x : duplica (y:zs)

-- 2ª definición de duplica

duplica2 :: Eq a => [a] -> [a]

duplica2 xs = concatMap dupl (group xs)

where dupl ys@(y:_) | (even.length) ys = ys

| otherwise = y : ys

-- Propiedad

prop_duplica_esDuplicada :: [Int] -> Bool

prop_duplica_esDuplicada xs =

esDuplicada (duplica xs)

-- La comprobación es

-- λ> quickCheck prop_duplica_esDuplicada

-- +++ OK, passed 100 tests.

Ordenación por una fila

PorJosé A. Alonso 22-diciembre-201629-diciembre-2016

Las matrices se pueden representar por listas de lista. Por ejemplo, la matriz

|1 2 5|

|3 0 7|

|9 1 6|

|6 4 2|

se puede representar por

   ej :: [[Int]]
   ej = [[1,2,5],
         [3,0,7],
         [9,1,6],
         [6,4,2]]

ej :: [[Int]]

ej = [[1,2,5],

[3,0,7],

[9,1,6],

[6,4,2]]

Definir la función

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

1	ordenaPorFila :: Ord a => [[a]] -> Int -> [[a]]

tal que (ordenaPorFila xss k) es la matriz obtenida ordenando xs por los elementos de la fila k. Por ejemplo,

   ordenaPorFila ej 1  ==  [[2,1,5],[0,3,7],[1,9,6],[4,6,2]]
   ordenaPorFila ej 2  ==  [[2,5,1],[0,7,3],[1,6,9],[4,2,6]]
   ordenaPorFila ej 3  ==  [[5,2,1],[7,0,3],[6,1,9],[2,4,6]]

ordenaPorFila ej 1 == [[2,1,5],[0,3,7],[1,9,6],[4,6,2]]

ordenaPorFila ej 2 == [[2,5,1],[0,7,3],[1,6,9],[4,2,6]]

ordenaPorFila ej 3 == [[5,2,1],[7,0,3],[6,1,9],[2,4,6]]

Soluciones

import Data.List (sort, transpose)

ej :: [[Int]]
ej = [[1,2,5],
      [3,0,7],
      [9,1,6],
      [6,4,2]]

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

ordenaPorFila :: Ord a => [[a]] -> Int -> [[a]]
ordenaPorFila xss k =
  transpose (ordenaPorColumna (transpose xss) k)

ordenaPorColumna :: Ord a => [[a]] -> Int -> [[a]]
ordenaPorColumna xss k =
  map snd (sort [(xs!!k,xs) | xs <- xss])

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

ordenaPorFila2 :: Ord a => [[a]] -> Int -> [[a]]
ordenaPorFila2 xss k =
  [[x | (_,x) <- sort $ zip (xss!!k) xs ] | xs <- xss]

import Data.List (sort, transpose)

ej :: [[Int]]

ej = [[1,2,5],

[3,0,7],

[9,1,6],

[6,4,2]]

-- 1ª solución

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

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

ordenaPorFila xss k =

transpose (ordenaPorColumna (transpose xss) k)

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

ordenaPorColumna xss k =

map snd (sort [(xs!!k,xs) | xs <- xss])

-- 2ª solución

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

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

ordenaPorFila2 xss k =

[[x | (_,x) <- sort $ zip (xss!!k) xs ] | xs <- xss]

Día de la semana

PorJosé A. Alonso 21-diciembre-201628-diciembre-2016

Definir la función

   dia :: Int -> Int -> Int -> String

1	dia :: Int -> Int -> Int -> String

tal que (dia d m a) es el día de la semana correspondiente al día d del mes m del año a. Por ejemplo,

   dia 21 12 2016  ==  "Miercoles"
   dia 14  4 1936  ==  "Martes"

1 2	dia 21 12 2016 == "Miercoles" dia 14 4 1936 == "Martes"

Nota: Este ejercicio ha sido propuesto por Miguel Ibáñez.

Soluciones

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

-- Comentario: usar que el 1-1-2007 cayó en lunes

dSem :: [(String,Int)]
dSem = [("Lunes",0),("Martes",1),("Miercoles",2),("Jueves",3),
        ("Viernes",4),("Sabado",5),("Domingo",6)]

dMes :: [(Int,Int)]
dMes = [(1,31),(2,28),(3,31),( 4,30),( 5,31),( 6,30),
        (7,31),(8,31),(9,30),(10,31),(11,30),(12,31)]

busca :: a -> [(a1,a2)] -> (a -> a1 -> Bool) -> [(a1,a2)]
busca x xs p  =  [(x',y) | (x',y) <- xs, p x x']

diaAno :: (Int,Int,Int) -> Int
diaAno (d,m,a)  =  d + sum [y | (x,y) <- busca m dMes (>)]

dia :: Int -> Int -> Int -> String
dia d m a = head [fst (x,y') | (x,y') <- dSem, n == y']
  where  n = mod ((diaAno (d,m,a) + (a - 2007)*365) + x) 7
         x | d <= 29 && m <= 2  =  div (a - 2007) 4 - 1
           | otherwise          =  div (a - 2007) 4


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

-- Usando la congruencia de Zeller http://bit.ly/2gYxHym

dia2 :: Int -> Int -> Int -> String
dia2 d m a = diasSemana !! h
  where m1 = if   (m < 3)
             then m + 12
             else m

        a1 = if   (m1 > 12)
             then a - 1
             else a

        k  = a1 `mod` 100
        j  = a1 `div` 100

        h  = ( d
             + ((13 * (m1 + 1)) `div` 5)
             + k
             + (k `div` 4)
             + (j `div` 4)
             - (2 * j)
             ) `mod` 7

diasSemana :: [String]
diasSemana = [ "Sabado" 
             , "Domingo"
             , "Lunes" 
             , "Martes"
             , "Miercoles"
             , "Jueves"
             , "Viernes"]

-- 1ª solución

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

-- Comentario: usar que el 1-1-2007 cayó en lunes

dSem :: [(String,Int)]

dSem = [("Lunes",0),("Martes",1),("Miercoles",2),("Jueves",3),

("Viernes",4),("Sabado",5),("Domingo",6)]

dMes :: [(Int,Int)]

dMes = [(1,31),(2,28),(3,31),( 4,30),( 5,31),( 6,30),

(7,31),(8,31),(9,30),(10,31),(11,30),(12,31)]

busca :: a -> [(a1,a2)] -> (a -> a1 -> Bool) -> [(a1,a2)]

busca x xs p = [(x',y) | (x',y) <- xs, p x x']

diaAno :: (Int,Int,Int) -> Int

diaAno (d,m,a) = d + sum [y | (x,y) <- busca m dMes (>)]

dia :: Int -> Int -> Int -> String

dia d m a = head [fst (x,y') | (x,y') <- dSem, n == y']

where n = mod ((diaAno (d,m,a) + (a - 2007)*365) + x) 7

x | d <= 29 && m <= 2 = div (a - 2007) 4 - 1

| otherwise = div (a - 2007) 4

-- 2ª solución

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

-- Usando la congruencia de Zeller http://bit.ly/2gYxHym

dia2 :: Int -> Int -> Int -> String

dia2 d m a = diasSemana !! h

where m1 = if (m < 3)

then m + 12

else m

a1 = if (m1 > 12)

then a - 1

else a

k = a1 `mod` 100

j = a1 `div` 100

h = ( d

+ ((13 * (m1 + 1)) `div` 5)

+ k

+ (k `div` 4)

+ (j `div` 4)

- (2 * j)

) `mod` 7

diasSemana :: [String]

diasSemana = [ "Sabado"

, "Domingo"

, "Lunes"

, "Martes"

, "Miercoles"

, "Jueves"

, "Viernes"]

Ordenación por una columna

PorJosé A. Alonso 20-diciembre-201627-diciembre-2016

Las matrices se pueden representar por listas de lista. Por ejemplo, la matriz

|1 2 5|

|3 0 7|

|9 1 6|

|6 4 2|

se puede representar por

   ej :: [[Int]]
   ej = [[1,2,5],
         [3,0,7],
         [9,1,6],
         [6,4,2]]

ej :: [[Int]]

ej = [[1,2,5],

[3,0,7],

[9,1,6],

[6,4,2]]

Definir la función

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

1	ordenaPor :: Ord a => [[a]] -> Int -> [[a]]

tal que (ordenaPor xss k) es la matriz obtenida ordenando xs por los elementos de la columna k. Por ejemplo,

   ordenaPor ej 0  ==  [[1,2,5],[3,0,7],[6,4,2],[9,1,6]]
   ordenaPor ej 1  ==  [[3,0,7],[9,1,6],[1,2,5],[6,4,2]]
   ordenaPor ej 2  ==  [[6,4,2],[1,2,5],[9,1,6],[3,0,7]]

ordenaPor ej 0 == [[1,2,5],[3,0,7],[6,4,2],[9,1,6]]

ordenaPor ej 1 == [[3,0,7],[9,1,6],[1,2,5],[6,4,2]]

ordenaPor ej 2 == [[6,4,2],[1,2,5],[9,1,6],[3,0,7]]

Soluciones

import Data.List (sort)

ej :: [[Int]]
ej = [[1,2,5],
      [3,0,7],
      [9,1,6],
      [6,4,2]]

-- 1ª definición
ordenaPor :: Ord a => [[a]] -> Int -> [[a]]
ordenaPor xss k =
  map snd (sort [(xs!!k,xs) | xs <- xss])

-- 2ª definición
ordenaPor2 :: Ord a => [[a]] -> Int -> [[a]]
ordenaPor2 xss k =
  map snd (sort (map (\xs -> (xs!!k, xs)) xss))

-- 3ª definición
ordenaPor3 :: Ord a => [[a]] -> Int -> [[a]]
ordenaPor3 xss k =
  map snd (sort [p | p <- zip (map (!!k) xss) xss])

import Data.List (sort)

ej :: [[Int]]

ej = [[1,2,5],

[3,0,7],

[9,1,6],

[6,4,2]]

-- 1ª definición

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

ordenaPor xss k =

map snd (sort [(xs!!k,xs) | xs <- xss])

-- 2ª definición

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

ordenaPor2 xss k =

map snd (sort (map (\xs -> (xs!!k, xs)) xss))

-- 3ª definición

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

ordenaPor3 xss k =

map snd (sort [p | p <- zip (map (!!k) xss) xss])

Selección por posición

PorJosé A. Alonso 19-diciembre-201627-diciembre-2016

Definir la función

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

1	seleccion :: Ord a => [a] -> [Int] -> [a]

tal que (seleccion xs ps) es la lista ordenada de los elementos que ocupan las posiciones indicadas en la lista ps. Por ejemplo,

   seleccion [6,2,4,7] [2,0]      ==  [4,6]
   seleccion ['a'..'z'] [0,2..10] ==  "acegik"

1 2	seleccion [6,2,4,7] [2,0] == [4,6] seleccion ['a'..'z'] [0,2..10] == "acegik"

Soluciones

import Data.List (sort)

-- 1ª definición
seleccion :: Ord a => [a] -> [Int] -> [a]
seleccion xs ps =
  sort [x | (x,n) <- zip xs [0..]
          , n `elem` ps]

-- 2ª definición
seleccion2 :: Ord a => [a] -> [Int] -> [a]
seleccion2 xs = sort . map (xs!!)

import Data.List (sort)

-- 1ª definición

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

seleccion xs ps =

sort [x | (x,n) <- zip xs [0..]

, n `elem` ps]

-- 2ª definición

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

seleccion2 xs = sort . map (xs!!)

Números de la suerte

PorJosé A. Alonso 16-diciembre-201625-marzo-2022

Un número de la suerte es un número natural que se genera por una criba, similar a la criba de Eratóstenes, como se indica a continuación:

Se comienza con la lista de los números enteros a partir de 1:

   1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25...

1	1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25...

Se eliminan los números de dos en dos

   1,  3,  5,  7,  9,   11,   13,   15,   17,   19,   21,   23,   25...

1	1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25...

Como el segundo número que ha quedado es 3, se eliminan los números
restantes de tres en tres:

   1,  3,      7,  9,         13,   15,         19,   21,         25...

1	1, 3, 7, 9, 13, 15, 19, 21, 25...

Como el tercer número que ha quedado es 7, se eliminan los números restantes de
siete en siete:

   1,  3,      7,  9,         13,   15,               21,         25...

1	1, 3, 7, 9, 13, 15, 21, 25...

Este procedimiento se repite indefinidamente y los supervivientes son
los números de la suerte:

   1,3,7,9,13,15,21,25,31,33,37,43,49,51,63,67,69,73,75,79

1	1,3,7,9,13,15,21,25,31,33,37,43,49,51,63,67,69,73,75,79

Definir la sucesión

   numerosDeLaSuerte :: [Int]

1	numerosDeLaSuerte :: [Int]

cuyos elementos son los números de la suerte. Por ejemplo,

   λ> take 20 numerosDeLaSuerte
   [1,3,7,9,13,15,21,25,31,33,37,43,49,51,63,67,69,73,75,79]
   λ> numerosDeLaSuerte !! 1500
   13995

λ> take 20 numerosDeLaSuerte

[1,3,7,9,13,15,21,25,31,33,37,43,49,51,63,67,69,73,75,79]

λ> numerosDeLaSuerte !! 1500

13995

Soluciones

-- 1ª definición
numerosDeLaSuerte :: [Int]
numerosDeLaSuerte = criba 3 [1,3..]
  where
    criba i (n:s:xs) =
      n : criba (i + 1) (s : [x | (n, x) <- zip [i..] xs
                                , rem n s /= 0])

-- 2ª definición
numerosDeLaSuerte2 :: [Int]
numerosDeLaSuerte2 =  1 : criba 2 [1, 3..]
  where criba k xs = z : criba (k + 1) (aux xs)
          where z = xs !! (k - 1 )
                aux ws = us ++ aux vs
                  where (us, _:vs) = splitAt (z - 1) ws

-- 1ª definición

numerosDeLaSuerte :: [Int]

numerosDeLaSuerte = criba 3 [1,3..]

where

criba i (n:s:xs) =

n : criba (i + 1) (s : [x | (n, x) <- zip [i..] xs

, rem n s /= 0])

-- 2ª definición

numerosDeLaSuerte2 :: [Int]

numerosDeLaSuerte2 = 1 : criba 2 [1, 3..]

where criba k xs = z : criba (k + 1) (aux xs)

where z = xs !! (k - 1 )

aux ws = us ++ aux vs

where (us, _:vs) = splitAt (z - 1) ws

Posiciones de equilibrio

PorJosé A. Alonso 15-diciembre-201622-diciembre-2016

Se dice que k es una posición de equilibrio de una lista xs si la suma de los elementos de xs en las posiciones menores que k es igual a la suma de los elementos de xs en las posiciones mayores que k. Por ejemplo, en la lista [-7,1,5,2,-4,3,0] el 3 es una posición de equilibrio ya que -7+1+5 = -4+3+0; también lo es el 6 ya que -7+1+5+2+(-4)+3 = 0.

Definir la función,

   equilibrios :: (Num a, Eq a) => [a] -> [Int]

1	equilibrios :: (Num a, Eq a) => [a] -> [Int]

tal que (equilibrios xs) es la lista de las posiciones de equilibrio de xs. Por ejemplo,

   equilibrios [-7,1,5,2,-4,3,0]  ==  [3,6]
   equilibrios [1..10^6]          ==  []

1 2	equilibrios [-7,1,5,2,-4,3,0] == [3,6] equilibrios [1..10^6] == []

Soluciones

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

equilibrios1 :: (Num a, Eq a) => [a] -> [Int]
equilibrios1 xs =
  [n | n <- [0..length xs - 1]
     , sum (take n xs) == sum (drop (n+1) xs)]

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

equilibrios2 :: (Num a, Eq a) => [a] -> [Int]
equilibrios2 xs =
  [n | (n,x,y) <- zip3 [0..] (sumasI xs) (sumasD xs)
     , x == y]

sumasI :: (Num a, Eq a) => [a] -> [a]
sumasI xs = [sum (take n xs) | n <- [0..length xs - 1]] 

sumasD :: (Num a, Eq a) => [a] -> [a]
sumasD xs = [sum (drop (n+1) xs) | n <- [0..length xs - 1]] 

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

equilibrios3 :: (Num a, Eq a) => [a] -> [Int]
equilibrios3 xs =
  [n | (n,x,y) <- zip3 [0..] (sumasI' xs) (sumasD' xs)
     , x == y]

sumasI' :: (Num a, Eq a) => [a] -> [a]
sumasI'  = init . scanl (+) 0 

sumasD' :: (Num a, Eq a) => [a] -> [a]
sumasD' = tail . scanr (+) 0

-- 4ª definición
-- =============

equilibrios4 :: (Num a, Eq a) => [a] -> [Int]
equilibrios4 xs =
  [n | (n,x,y) <- zip3 [0..] (scanl1 (+) xs) (scanr1 (+) xs)
     , x == y]

-- Comparación de eficiencia
--    λ> let xs = [1..10^4] in equilibrios1 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (20.92 secs, 46,240,541,256 bytes)
--    λ> let xs = [1..10^4] in equilibrios2 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (21.12 secs, 46,249,562,520 bytes)
--    λ> let xs = [1..10^4] in equilibrios3 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (0.02 secs, 11,858,768 bytes)
--    λ> let xs = [1..10^4] in equilibrios4 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (0.02 secs, 13,963,952 bytes)

-- 1ª definición

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

equilibrios1 :: (Num a, Eq a) => [a] -> [Int]

equilibrios1 xs =

[n | n <- [0..length xs - 1]

, sum (take n xs) == sum (drop (n+1) xs)]

-- 2ª definición

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

equilibrios2 :: (Num a, Eq a) => [a] -> [Int]

equilibrios2 xs =

[n | (n,x,y) <- zip3 [0..] (sumasI xs) (sumasD xs)

, x == y]

sumasI :: (Num a, Eq a) => [a] -> [a]

sumasI xs = [sum (take n xs) | n <- [0..length xs - 1]]

sumasD :: (Num a, Eq a) => [a] -> [a]

sumasD xs = [sum (drop (n+1) xs) | n <- [0..length xs - 1]]

-- 3ª definición

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

equilibrios3 :: (Num a, Eq a) => [a] -> [Int]

equilibrios3 xs =

[n | (n,x,y) <- zip3 [0..] (sumasI' xs) (sumasD' xs)

, x == y]

sumasI' :: (Num a, Eq a) => [a] -> [a]

sumasI' = init . scanl (+) 0

sumasD' :: (Num a, Eq a) => [a] -> [a]

sumasD' = tail . scanr (+) 0

-- 4ª definición

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

equilibrios4 :: (Num a, Eq a) => [a] -> [Int]

equilibrios4 xs =

[n | (n,x,y) <- zip3 [0..] (scanl1 (+) xs) (scanr1 (+) xs)

, x == y]

-- Comparación de eficiencia

-- λ> let xs = [1..10^4] in equilibrios1 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (20.92 secs, 46,240,541,256 bytes)

-- λ> let xs = [1..10^4] in equilibrios2 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (21.12 secs, 46,249,562,520 bytes)

-- λ> let xs = [1..10^4] in equilibrios3 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (0.02 secs, 11,858,768 bytes)

-- λ> let xs = [1..10^4] in equilibrios4 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (0.02 secs, 13,963,952 bytes)

Distancia a Erdős

PorJosé A. Alonso 14-diciembre-201621-diciembre-2016

Una de las razones por la que el matemático húngaro Paul Erdős es conocido es por la multitud de colaboraciones que realizó durante toda su carrera, un total de 511. Tal es así que se establece la distancia a Erdős como la distancia que has estado de coautoría con Erdős. Por ejemplo, si eres Paul Erdős tu distancia a Erdős es 0, si has escrito un artículo con Erdős tu distancia es 1, si has escrito un artículo con alguien que ha escrito un artículo con Erdős tu distancia es 2, etc. El objetivo de este problema es definir una función que a partir de una lista de pares de coautores y un número natural n calcular la lista de los matemáticos a una distancia n de Erdős.

Para el problema se considerará la siguiente lista de coautores

   coautores :: [(String,String)]
   coautores =
     [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
      ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
      ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
      ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
      ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
      ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
      ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
      ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
      ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
      ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

coautores :: [(String,String)]

coautores =

[("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),

("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),

("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),

("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),

("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),

("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),

("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),

("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),

("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),

("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

La lista anterior es real y se ha obtenido del artículo Famous trails to Paul Erdős.

Definir la función

   numeroDeErdos :: [(String, String)] -> Int -> [String]

1	numeroDeErdos :: [(String, String)] -> Int -> [String]

tal que (numeroDeErdos xs n) es la lista de lista de los matemáticos de la
lista de coautores xs que se encuentran a una distancia n de Erdős. Por ejemplo,

   λ> numeroDeErdos coautores 0
   ["Paul Erdos"]
   λ> numeroDeErdos coautores 1
   ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway","A. J. Granville"]
   λ> numeroDeErdos coautores 2
   ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle","B. Mazur"]

λ> numeroDeErdos coautores 0

["Paul Erdos"]

λ> numeroDeErdos coautores 1

["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway","A. J. Granville"]

λ> numeroDeErdos coautores 2

["Albert Einstein","John von Newmann","S. Glashow","P. Doyle","B. Mazur"]

Nota: Este ejercicio ha sido propuesto por Enrique Naranjo.

Soluciones

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

coautores :: [(String,String)]
coautores =
  [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
   ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
   ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
   ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
   ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
   ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
   ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
   ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
   ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
   ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

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

numeroDeErdos :: [(String, String)] -> Int -> [String]
numeroDeErdos xs n = nivel n (arbolDeErdos xs "Paul Erdos")

-- (arbolDeErdos xs a) es el árbol de coautores de a según la lista de
-- coautores xs. Por ejemplo,
--    λ> arbolDeErdos coautores "Paul Erdos"
--    N "Paul Erdos"
--      [N "Ernst Straus"
--         [N "Albert Einstein"
--           [N "Wolfgang Pauli" [],
--            N "Otto Stern" []]],
--          N "Pascual Jordan"
--            [N "John von Newmann"
--               [N "David Hilbert" []]],
--          N "D. Kleitman"
--            [N "S. Glashow"
--               [N "M. Gell-Mann"
--                  [N "Richar Feynman" [],
--                   N "David Pines"
--                     [N "A. Bohr" [],
--                      N "D. Bohm"
--                        [N "L. De Broglie" []]]]]],
--          N "J. Conway"
--            [N "P. Doyle" []],
--             N "A. J. Granville"
--               [N "B. Mazur"
--                  [N "Andrew Wiles" []]]]
arbolDeErdos :: [(String, String)] -> String -> Arbol String
arbolDeErdos xs a =
  N a [arbolDeErdos noColaboradores n | n <- colaboradores]
  where
    colaboradores   = [filtra a (x,y) | (x,y) <- xs, x == a || y == a]
    filtra a (x,y) | a == x    = y
                   | otherwise = x
    noColaboradores = [(x,y) | (x,y) <- xs, x /= a, y /= a]

-- (nivel n a) es la lista de los elementos del árbol a en el nivel
-- n. Por ejemplo,      
--    nivel 0 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [3]
--    nivel 1 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [5,7]
--    nivel 2 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [6,9]
nivel :: Int -> Arbol a -> [a]
nivel 0 (N a xs) = [a]
nivel n (N a xs) = concatMap (nivel (n-1)) xs

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

numeroDeErdos2 :: [(String, String)] -> Int -> [String]
numeroDeErdos2 = auxC ["Paul Erdos"] 
  where
    auxC v xs 0 = v
    auxC v xs x = auxC  (n v) (m v xs) (x-1)
      where n v =     [a | (a,b) <- xs, elem b v] ++
                      [b | (a,b) <- xs, elem a v]
            m ys xs = [(a,b) | (a,b) <- xs
                             , notElem a ys && notElem b ys]

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

numeroDeErdos3 :: [(String, String)] -> Int -> [String]
numeroDeErdos3 ps n = (sucCoautores "Paul Erdos" ps) !! n

-- (sucCoautores a ps) es la sucesión de coautores de a en ps ordenados
-- por diatancia. Por ejemplo, 
--    λ> take 3 (sucCoautores "Paul Erdos" coautores)
--    [["Paul Erdos"],
--     ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway",
--      "A. J. Granville"],
--     ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle",
--      "B. Mazur"]]
--    λ> sucCoautores "Albert Einstein" coautores
--    [["Albert Einstein"],
--     ["Ernst Straus","Otto Stern","Wolfgang Pauli"],
--     ["Paul Erdos"],
--     ["Pascual Jordan","D. Kleitman","J. Conway", "A. J. Granville"],
--     ["John von Newmann","S. Glashow","P. Doyle","B. Mazur"],
--     ["David Hilbert","M. Gell-Mann","Andrew Wiles"],
--     ["David Pines","Richar Feynman"],
--     ["D. Bohm","A. Bohr"],
--     ["L. De Broglie"]]
sucCoautores :: String -> [(String, String)] -> [[String]]
sucCoautores a ps =
  takeWhile (not . null) (map fst (iterate sig ([a], as \\ [a])))
  where as = elementos ps
        sig (xs,ys) = (zs,ys \\ zs)
          where zs = [y | y <- ys
                        , or [elem (x,y) ps || elem (y,x) ps | x <- xs]]

-- (elementos ps) es la lista de los elementos de los pares ps. Por
-- ejemplo,
--    elementos [(1,3),(3,2),(1,5)]  ==  [1,3,2,5]
elementos :: Eq a => [(a, a)] -> [a]
elementos = nub . (concatMap (\(x,y) -> [x,y]))

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

data Arbol a = N a [Arbol a]

deriving Show

coautores :: [(String,String)]

coautores =

[("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),

("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),

("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),

("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),

("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),

("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),

("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),

("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),

("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),

("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

-- 1ª solución

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

numeroDeErdos :: [(String, String)] -> Int -> [String]

numeroDeErdos xs n = nivel n (arbolDeErdos xs "Paul Erdos")

-- (arbolDeErdos xs a) es el árbol de coautores de a según la lista de

-- coautores xs. Por ejemplo,

-- λ> arbolDeErdos coautores "Paul Erdos"

-- N "Paul Erdos"

-- [N "Ernst Straus"

-- [N "Albert Einstein"

-- [N "Wolfgang Pauli" [],

-- N "Otto Stern" []]],

-- N "Pascual Jordan"

-- [N "John von Newmann"

-- [N "David Hilbert" []]],

-- N "D. Kleitman"

-- [N "S. Glashow"

-- [N "M. Gell-Mann"

-- [N "Richar Feynman" [],

-- N "David Pines"

-- [N "A. Bohr" [],

-- N "D. Bohm"

-- [N "L. De Broglie" []]]]]],

-- N "J. Conway"

-- [N "P. Doyle" []],

-- N "A. J. Granville"

-- [N "B. Mazur"

-- [N "Andrew Wiles" []]]]

arbolDeErdos :: [(String, String)] -> String -> Arbol String

arbolDeErdos xs a =

N a [arbolDeErdos noColaboradores n | n <- colaboradores]

where

colaboradores = [filtra a (x,y) | (x,y) <- xs, x == a || y == a]

filtra a (x,y) | a == x = y

| otherwise = x

noColaboradores = [(x,y) | (x,y) <- xs, x /= a, y /= a]

-- (nivel n a) es la lista de los elementos del árbol a en el nivel

-- n. Por ejemplo,

-- nivel 0 (N 3 [N 5 [N 6 []], N 7 [N 9 []]]) == [3]

-- nivel 1 (N 3 [N 5 [N 6 []], N 7 [N 9 []]]) == [5,7]

-- nivel 2 (N 3 [N 5 [N 6 []], N 7 [N 9 []]]) == [6,9]

nivel :: Int -> Arbol a -> [a]

nivel 0 (N a xs) = [a]

nivel n (N a xs) = concatMap (nivel (n-1)) xs

-- 2ª solución

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

numeroDeErdos2 :: [(String, String)] -> Int -> [String]

numeroDeErdos2 = auxC ["Paul Erdos"]

where

auxC v xs 0 = v

auxC v xs x = auxC (n v) (m v xs) (x-1)

where n v = [a | (a,b) <- xs, elem b v] ++

[b | (a,b) <- xs, elem a v]

m ys xs = [(a,b) | (a,b) <- xs

, notElem a ys && notElem b ys]

-- 3ª solución

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

numeroDeErdos3 :: [(String, String)] -> Int -> [String]

numeroDeErdos3 ps n = (sucCoautores "Paul Erdos" ps) !! n

-- (sucCoautores a ps) es la sucesión de coautores de a en ps ordenados

-- por diatancia. Por ejemplo,

-- λ> take 3 (sucCoautores "Paul Erdos" coautores)

-- [["Paul Erdos"],

-- ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway",

-- "A. J. Granville"],

-- ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle",

-- "B. Mazur"]]

-- λ> sucCoautores "Albert Einstein" coautores

-- [["Albert Einstein"],

-- ["Ernst Straus","Otto Stern","Wolfgang Pauli"],

-- ["Paul Erdos"],

-- ["Pascual Jordan","D. Kleitman","J. Conway", "A. J. Granville"],

-- ["John von Newmann","S. Glashow","P. Doyle","B. Mazur"],

-- ["David Hilbert","M. Gell-Mann","Andrew Wiles"],

-- ["David Pines","Richar Feynman"],

-- ["D. Bohm","A. Bohr"],

-- ["L. De Broglie"]]

sucCoautores :: String -> [(String, String)] -> [[String]]

sucCoautores a ps =

takeWhile (not . null) (map fst (iterate sig ([a], as \\ [a])))

where as = elementos ps

sig (xs,ys) = (zs,ys \\ zs)

where zs = [y | y <- ys

, or [elem (x,y) ps || elem (y,x) ps | x <- xs]]

-- (elementos ps) es la lista de los elementos de los pares ps. Por

-- ejemplo,

-- elementos [(1,3),(3,2),(1,5)] == [1,3,2,5]

elementos :: Eq a => [(a, a)] -> [a]

elementos = nub . (concatMap (\(x,y) -> [x,y]))

Agrupación por orden de aparición

PorJosé A. Alonso 13-diciembre-201620-diciembre-2016

Definir la función

   agrupacion :: Eq a => [a] -> [a]

1	agrupacion :: Eq a => [a] -> [a]

tal que (agrupacion xs) es la lista obtenida agrupando los elementos de xs según su primera aparición. Por ejemplo,

   agrupacion [3,1,5,1,7,1,5,3]  ==  [3,3,1,1,1,5,5,7]
   agrupacion "babcacb"          ==  "bbbaacc"

1 2	agrupacion [3,1,5,1,7,1,5,3] == [3,3,1,1,1,5,5,7] agrupacion "babcacb" == "bbbaacc"

Soluciones

import Data.List (nub, partition)

-- 1ª definición
agrupacion :: Eq a => [a] -> [a]
agrupacion [] = []
agrupacion (x:xs) =
  x : filter (==x) xs ++ agrupacion (filter (/=x) xs)

-- 2ª definición
agrupacion2 :: Eq a => [a] -> [a]
agrupacion2 xs = concat [filter (x==) xs | x <- nub xs]

-- 3ª definición
agrupacion3 :: Eq a => [a] -> [a]
agrupacion3 []     = []
agrupacion3 (x:xs) = x : ys ++ agrupacion3 zs
  where (ys,zs) = partition (==x) xs

-- Comparación de eficiencia
--    λ> import Data.List (cycle)
--    λ> :set +s
--    λ> sum (agrupacion (take (10^7) (cycle [0,1,2,3])))
--    15000000
--    (24.40 secs, 3,173,123,368 bytes)
--    λ> sum (agrupacion2 (take (10^7) (cycle [0,1,2,3])))
--    15000000
--    (13.71 secs, 2,333,129,416 bytes)
--    λ> sum (agrupacion3 (take (10^7) (cycle [0,1,2,3])))
--    15000000
--    (22.33 secs, 5,080,127,944 bytes)

import Data.List (nub, partition)

-- 1ª definición

agrupacion :: Eq a => [a] -> [a]

agrupacion [] = []

agrupacion (x:xs) =

x : filter (==x) xs ++ agrupacion (filter (/=x) xs)

-- 2ª definición

agrupacion2 :: Eq a => [a] -> [a]

agrupacion2 xs = concat [filter (x==) xs | x <- nub xs]

-- 3ª definición

agrupacion3 :: Eq a => [a] -> [a]

agrupacion3 [] = []

agrupacion3 (x:xs) = x : ys ++ agrupacion3 zs

where (ys,zs) = partition (==x) xs

-- Comparación de eficiencia

-- λ> import Data.List (cycle)

-- λ> :set +s

-- λ> sum (agrupacion (take (10^7) (cycle [0,1,2,3])))

-- 15000000

-- (24.40 secs, 3,173,123,368 bytes)

-- λ> sum (agrupacion2 (take (10^7) (cycle [0,1,2,3])))

-- 15000000

-- (13.71 secs, 2,333,129,416 bytes)

-- λ> sum (agrupacion3 (take (10^7) (cycle [0,1,2,3])))

-- 15000000

-- (22.33 secs, 5,080,127,944 bytes)

Mayores que la mitad

PorJosé A. Alonso 12-diciembre-201619-diciembre-2016

Definir la función

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

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

tal que (mayoresMitad xs) es la lista de los elementos de xs que son mayores que la mitad de los elementos de xs, suponiendo que los elementos de xs son distintos. Por ejemplo,

   sort (mayoresMitad [1,6,3,4])    ==  [4,6]
   sort (mayoresMitad [1,6,3,4,7])  ==  [4,6,7]
   sort (mayoresMitad [1,6,3,4,2])  ==  [3,4,6]
   length (mayoresMitad3 [1..10^6]) ==  500000

sort (mayoresMitad [1,6,3,4]) == [4,6]

sort (mayoresMitad [1,6,3,4,7]) == [4,6,7]

sort (mayoresMitad [1,6,3,4,2]) == [3,4,6]

length (mayoresMitad3 [1..10^6]) == 500000

Nota: Se considera que si la lista tiene 2n+1 elementos, su mitad tiene n elementos.

Soluciones

import Data.List (sort)

-- 1ª solución:
mayoresMitad1 :: Ord a => [a] -> [a]
mayoresMitad1 xs =
  [x | x <- xs
     , length (filter (<=x) xs) > k]
  where k = length xs `div` 2 

-- 2ª solución
mayoresMitad2 :: Ord a => [a] -> [a]
mayoresMitad2 xs = aux xs
  where aux [] = []
        aux (y:ys) | length [x | x <- xs, x <= y] > k = y : aux ys
                   | otherwise                        = aux ys
        k = length xs `div` 2 

-- 3ª solución
mayoresMitad3 :: Ord a => [a] -> [a]
mayoresMitad3 xs = drop k (sort xs)
  where k = length xs `div` 2 

-- Comprobación de eficiencia
--    λ> length (mayoresMitad1 [1..4*10^3])
--    2000
--    (3.79 secs, 442,631,712 bytes)
--    λ> length (mayoresMitad2 [1..4*10^3])
--    2000
--    (11.82 secs, 1,463,762,192 bytes)
--    λ> length (mayoresMitad3 [1..4*10^3])
--    2000
--    (0.02 secs, 0 bytes)

import Data.List (sort)

-- 1ª solución:

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

mayoresMitad1 xs =

[x | x <- xs

, length (filter (<=x) xs) > k]

where k = length xs `div` 2

-- 2ª solución

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

mayoresMitad2 xs = aux xs

where aux [] = []

aux (y:ys) | length [x | x <- xs, x <= y] > k = y : aux ys

| otherwise = aux ys

k = length xs `div` 2

-- 3ª solución

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

mayoresMitad3 xs = drop k (sort xs)

where k = length xs `div` 2

-- Comprobación de eficiencia

-- λ> length (mayoresMitad1 [1..4*10^3])

-- 2000

-- (3.79 secs, 442,631,712 bytes)

-- λ> length (mayoresMitad2 [1..4*10^3])

-- 2000

-- (11.82 secs, 1,463,762,192 bytes)

-- λ> length (mayoresMitad3 [1..4*10^3])

-- 2000

-- (0.02 secs, 0 bytes)

Caracteres en la misma posición que en el alfabeto

PorJosé A. Alonso 9-diciembre-201617-diciembre-2016

Un carácter c de una cadena cs está bien colocado si la posición de c en cs es la misma que en el abecedario (sin distinguir entre mayúsculas y minúsculas). Por ejemplo, los elementos bien colocados de la cadena «aBaCEria» son ‘a’, ‘B’ y ‘E’.

Definir la función

   nBienColocados :: String -> Int

1	nBienColocados :: String -> Int

tal que (nBienColocados cs) es el número de elementos bien colocados de la cadena cs. Por ejemplo,

   nBienColocados "aBaCEria"                    ==  3
   nBienColocados "xBxxExxxIxxxxNxxxxxTxxxXYZ"  ==  8

1 2	nBienColocados "aBaCEria" == 3 nBienColocados "xBxxExxxIxxxxNxxxxxTxxxXYZ" == 8

Soluciones

import Data.Char (toLower)

nBienColocados :: String -> Int
nBienColocados = length . bienColocados

bienColocados :: String -> [Char]
bienColocados cs =
  [c | (c,d) <- zip (map toLower cs) ['a'..'z']
     , c == d]

import Data.Char (toLower)

nBienColocados :: String -> Int

nBienColocados = length . bienColocados

bienColocados :: String -> [Char]

bienColocados cs =

[c | (c,d) <- zip (map toLower cs) ['a'..'z']

, c == d]

Referencias

Basado en el problema Count characters at same position as in English alphabets de Sahil Chhabra en GeeksforGeeks.

Suma de los máximos de los subconjuntos

PorJosé A. Alonso 8-diciembre-201615-diciembre-2016

Los subconjuntos distinto del vacío del conjunto {3, 2, 5}, junto con sus máximos elementos, son

   {3}       su máximo es 3
   {2}       su máximo es 2
   {5}       su máximo es 5
   {3, 2}    su máximo es 3
   {3, 5}    su máximo es 5
   {2, 5}    su máximo es 5
   {3, 2, 5} su máximo es 5

{3} su máximo es 3

{2} su máximo es 2

{5} su máximo es 5

{3, 2} su máximo es 3

{3, 5} su máximo es 5

{2, 5} su máximo es 5

{3, 2, 5} su máximo es 5

Por tanto, la suma de los máximos elementos de los subconjuntos de {3, 2, 5} es 3 + 2 + 5 + 3 + 5 + 5 + 5 = 28.

Definir la función

   sumaMaximos :: [Integer] -> Integer

1	sumaMaximos :: [Integer] -> Integer

tal que (sumaMaximos xs) es la suma de los máximos elementos de los subconjuntos de xs. Por ejemplo,

   sumaMaximos [3,2,5]    ==  28
   sumaMaximos [4,1,6,3]  ==  71
   sumaMaximos [1..100]   ==  125497409422594710748173617332225
   length (show (sumaMaximos [1..10^5]))  ==  30108
   sumaMaximos [1..10^5] `mod` (10^7)     ==  4490625

sumaMaximos [3,2,5] == 28

sumaMaximos [4,1,6,3] == 71

sumaMaximos [1..100] == 125497409422594710748173617332225

length (show (sumaMaximos [1..10^5])) == 30108

sumaMaximos [1..10^5] `mod` (10^7) == 4490625

Soluciones

import Data.List (sort, subsequences)

-- 1ª definición
sumaMaximos :: [Integer] -> Integer
sumaMaximos xs =
  sum [maximum ys | ys <- tail (subsequences xs)]

-- 2ª definición
sumaMaximos2 :: [Integer] -> Integer
sumaMaximos2 =
  sum . map maximum . tail . subsequences

-- 3ª definición
sumaMaximos3 :: [Integer] -> Integer
sumaMaximos3 xs =
  sum (zipWith (*) (sort xs) potenciasDeDos)

potenciasDeDos :: [Integer]
potenciasDeDos = iterate (*2) 1

-- Comparación de eficiencia
--    λ> sumaMaximos [1..20]
--    19922945
--    (2.74 secs, 703,957,848 bytes)
--    λ> sumaMaximos2 [1..20]
--    19922945
--    (2.06 secs, 680,728,696 bytes)
--    λ> sumaMaximos3 [1..20]
--    19922945
--    (0.01 secs, 0 bytes)

import Data.List (sort, subsequences)

-- 1ª definición

sumaMaximos :: [Integer] -> Integer

sumaMaximos xs =

sum [maximum ys | ys <- tail (subsequences xs)]

-- 2ª definición

sumaMaximos2 :: [Integer] -> Integer

sumaMaximos2 =

sum . map maximum . tail . subsequences

-- 3ª definición

sumaMaximos3 :: [Integer] -> Integer

sumaMaximos3 xs =

sum (zipWith (*) (sort xs) potenciasDeDos)

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- Comparación de eficiencia

-- λ> sumaMaximos [1..20]

-- 19922945

-- (2.74 secs, 703,957,848 bytes)

-- λ> sumaMaximos2 [1..20]

-- 19922945

-- (2.06 secs, 680,728,696 bytes)

-- λ> sumaMaximos3 [1..20]

-- 19922945

-- (0.01 secs, 0 bytes)

Basado en el artículo
Sum of maximum elements of all subsets
de Utkarsh Trivedi en GeeksforGeeks.

Elementos que respetan la ordenación

PorJosé A. Alonso 7-diciembre-201614-diciembre-2016

Se dice que un elemento x de una lista xs respeta la ordenación si x es mayor o igual que todos lo que tiene delante en xs y es menor o igual que todos lo que tiene detrás en xs. Por ejemplo, en la lista lista [3,2,1,4,6,5,7,9,8] el número 4 respeta la ordenación pero el número 5 no la respeta (porque es mayor que el 6 que está delante).

Definir la función

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

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

tal que (respetuosos xs) es la lista de los elementos de xs que respetan la ordenación. Por ejemplo,

   respetuosos [3,2,1,4,6,4,7,9,8]  ==  [4,7]
   respetuosos [2,1,3,4,6,4,7,8,9]  ==  [3,4,7,8,9]
   respetuosos "abaco"              ==  "aco"
   respetuosos "amor"               ==  "amor"
   respetuosos "romanos"            ==  "s"
   respetuosos [1..9]               ==  [1,2,3,4,5,6,7,8,9]
   respetuosos [9,8..1]             ==  []

respetuosos [3,2,1,4,6,4,7,9,8] == [4,7]

respetuosos [2,1,3,4,6,4,7,8,9] == [3,4,7,8,9]

respetuosos "abaco" == "aco"

respetuosos "amor" == "amor"

respetuosos "romanos" == "s"

respetuosos [1..9] == [1,2,3,4,5,6,7,8,9]

respetuosos [9,8..1] == []

Comprobar con QuickCheck que para cualquier lista de enteros xs se verifican las siguientes propiedades:

todos los elementos de (sort xs) respetan la ordenación y
en la lista (nub (reverse (sort xs))) hay como máximo un elemento que respeta la ordenación.

Soluciones

import Data.List (inits, nub, sort, tails)
import Test.QuickCheck

-- 1ª definición (por comprensión):
respetuosos :: Ord a => [a] -> [a]
respetuosos xs =
  [z | k <- [0..n-1]
     , let (ys,z:zs) = splitAt k xs
     , all (<=z) ys
     , all (>=z) zs]
  where n = length xs

-- 2ª definición (por recursión):
respetuosos2 :: Ord a => [a] -> [a]
respetuosos2 xs = aux [] [] xs
  where aux zs _  []      = reverse zs
        aux zs ys (x:xs)
          | all (<=x) ys && all (>=x) xs = aux (x:zs) (x:ys) xs
          | otherwise                    = aux zs     (x:ys) xs

-- 3ª definición
respetuosos3 :: Ord a => [a] -> [a]
respetuosos3 xs = [ x | (ys,x,zs) <- zip3 (inits xs) xs (tails xs)
                      , all (<=x) ys
                      , all (x<=) zs ]

-- 4ª solución
respetuosos4 :: Ord a =>[a] ->[a]
respetuosos4 xs =
  [x | (a, x, b) <- zip3 (scanl1 max xs) xs (scanr1 min xs)
     , a <= x && x <= b]

-- Comparación de eficiencia
--    λ> length (respetuosos [1..3000])
--    3000
--    (3.31 secs, 1,140,407,224 bytes)
--    λ> length (respetuosos2 [1..3000])
--    3000
--    (2.85 secs, 587,082,160 bytes)
--    λ> length (respetuosos3 [1..3000])
--    3000
--    (2.12 secs, 785,446,880 bytes)
--    λ> length (respetuosos4 [1..3000])
--    3000
--    (0.02 secs, 0 bytes)

-- 1ª propiedad
prop_respetuosos1 :: [Int] -> Bool
prop_respetuosos1 xs =
  respetuosos (sort xs) == sort xs

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

-- La 2ª propiedad
prop_respetuosos2 :: [Int] -> Bool
prop_respetuosos2 xs =
  length (respetuosos (nub (reverse (sort xs)))) <= 1

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

import Data.List (inits, nub, sort, tails)

import Test.QuickCheck

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

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

respetuosos xs =

[z | k <- [0..n-1]

, let (ys,z:zs) = splitAt k xs

, all (<=z) ys

, all (>=z) zs]

where n = length xs

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

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

respetuosos2 xs = aux [] [] xs

where aux zs _ [] = reverse zs

aux zs ys (x:xs)

| all (<=x) ys && all (>=x) xs = aux (x:zs) (x:ys) xs

| otherwise = aux zs (x:ys) xs

-- 3ª definición

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

respetuosos3 xs = [ x | (ys,x,zs) <- zip3 (inits xs) xs (tails xs)

, all (<=x) ys

, all (x<=) zs ]

-- 4ª solución

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

respetuosos4 xs =

[x | (a, x, b) <- zip3 (scanl1 max xs) xs (scanr1 min xs)

, a <= x && x <= b]

-- Comparación de eficiencia

-- λ> length (respetuosos [1..3000])

-- 3000

-- (3.31 secs, 1,140,407,224 bytes)

-- λ> length (respetuosos2 [1..3000])

-- 3000

-- (2.85 secs, 587,082,160 bytes)

-- λ> length (respetuosos3 [1..3000])

-- 3000

-- (2.12 secs, 785,446,880 bytes)

-- λ> length (respetuosos4 [1..3000])

-- 3000

-- (0.02 secs, 0 bytes)

-- 1ª propiedad

prop_respetuosos1 :: [Int] -> Bool

prop_respetuosos1 xs =

respetuosos (sort xs) == sort xs

-- La comprobación es

-- λ> quickCheck prop_respetuosos1

-- +++ OK, passed 100 tests.

-- La 2ª propiedad

prop_respetuosos2 :: [Int] -> Bool

prop_respetuosos2 xs =

length (respetuosos (nub (reverse (sort xs)))) <= 1

-- La comprobación es

-- λ> quickCheck prop_respetuosos2

-- +++ OK, passed 100 tests.

Sin ceros finales

PorJosé A. Alonso 6-diciembre-201613-diciembre-2016

Definir la función

   sinCerosFinales :: Int -> Int

1	sinCerosFinales :: Int -> Int

tal que (sinCerosFinales n) es el número obtenido eliminando los ceros finales de n. Por ejemplo,

   sinCerosFinales 104050     == 10405
   sinCerosFinales 960000     == 96
   sinCerosFinales 100050     == 10005
   sinCerosFinales (-10050)   == -1005
   sinCerosFinales 12         == 12
   sinCerosFinales 0          == 0

sinCerosFinales 104050 == 10405

sinCerosFinales 960000 == 96

sinCerosFinales 100050 == 10005

sinCerosFinales (-10050) == -1005

sinCerosFinales 12 == 12

sinCerosFinales 0 == 0

Comprobar con QuickCheck que, para cualquier número entero n,

   sinCerosFinales (sinCerosFinales n) == sinCerosFinales n

1	sinCerosFinales (sinCerosFinales n) == sinCerosFinales n

Soluciones

import Test.QuickCheck

-- 1ª solución
sinCerosFinales :: Int -> Int
sinCerosFinales 0 = 0
sinCerosFinales n
  | r /= 0    = n
  | otherwise = sinCerosFinales q  
  where (q,r) = quotRem n 10

-- 2ª solución
sinCerosFinales2 :: Int -> Int
sinCerosFinales2 0 = 0
sinCerosFinales2 n =
  read (reverse (dropWhile (=='0') (reverse (show n))))

-- 3ª solución
sinCerosFinales3 :: Int -> Int
sinCerosFinales3 0 = 0
sinCerosFinales3 n =
  (read . reverse . dropWhile (== '0') . reverse . show) n

-- 4ª solución
sinCerosFinales4 :: Int -> Int
sinCerosFinales4 0 = 0
sinCerosFinales4 n =
  read . reverse . dropWhile (== '0') . reverse . show $ n

-- La propiedad es
prop_sinCerosFinales :: Int -> Bool
prop_sinCerosFinales n =
  sinCerosFinales (sinCerosFinales n) == sinCerosFinales n

-- 5ª solución
sinCerosFinales5 :: Int -> Int
sinCerosFinales5 0 = 0
sinCerosFinales5 n = until (\x -> mod x 10 /= 0) (`div` 10) n

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

import Test.QuickCheck

-- 1ª solución

sinCerosFinales :: Int -> Int

sinCerosFinales 0 = 0

sinCerosFinales n

| r /= 0 = n

| otherwise = sinCerosFinales q

where (q,r) = quotRem n 10

-- 2ª solución

sinCerosFinales2 :: Int -> Int

sinCerosFinales2 0 = 0

sinCerosFinales2 n =

read (reverse (dropWhile (=='0') (reverse (show n))))

-- 3ª solución

sinCerosFinales3 :: Int -> Int

sinCerosFinales3 0 = 0

sinCerosFinales3 n =

(read . reverse . dropWhile (== '0') . reverse . show) n

-- 4ª solución

sinCerosFinales4 :: Int -> Int

sinCerosFinales4 0 = 0

sinCerosFinales4 n =

read . reverse . dropWhile (== '0') . reverse . show $ n

-- La propiedad es

prop_sinCerosFinales :: Int -> Bool

prop_sinCerosFinales n =

sinCerosFinales (sinCerosFinales n) == sinCerosFinales n

-- 5ª solución

sinCerosFinales5 :: Int -> Int

sinCerosFinales5 0 = 0

sinCerosFinales5 n = until (\x -> mod x 10 /= 0) (`div` 10) n

-- La comprobación es

-- λ> quickCheck prop_sinCerosFinales

-- +++ 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

Referencias

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico