Recursión – Página 11

Sucesión de Cantor de números innombrables

PorJosé A. Alonso 3-febrero-201725-abril-2021

Un número es innombrable si es divisible por 7 o alguno de sus dígitos es un 7. Un juego infantil consiste en contar saltándose los números innombrables:

   1 2 3 4 5 6 ( ) 8 9 10 11 12 13 ( ) 15 16 ( ) 18 ...

1	1 2 3 4 5 6 ( ) 8 9 10 11 12 13 ( ) 15 16 ( ) 18 ...

La sucesión de Cantor se obtiene llenando los huecos de la sucesión anterior
como se indica a continuación:

  1 2 3 4 5 6 (1) 8 9 10 11 12 13 (2) 15 16 (3) 18 19 20 (4) 22 23
  24 25 26 (5) (6) 29 30 31 32 33 34 (1) 36 (8) 38 39 40 41  (9) 43
  44 45 46 (10) 48 (11) 50 51 52 53 54 55 (12) (13) 58 59 60 61 62
  (2) 64 65 66 (15) 68 69 (16) (3) (18) (19) (20) (4) (22) (23) (24)
  (25) 80 81 82 83 (26) 85 86 (5) 88 89 90 (6) 92 93 94 95 96 (29)
  (30) 99 100

1 2 3 4 5 6 (1) 8 9 10 11 12 13 (2) 15 16 (3) 18 19 20 (4) 22 23

24 25 26 (5) (6) 29 30 31 32 33 34 (1) 36 (8) 38 39 40 41 (9) 43

44 45 46 (10) 48 (11) 50 51 52 53 54 55 (12) (13) 58 59 60 61 62

(2) 64 65 66 (15) 68 69 (16) (3) (18) (19) (20) (4) (22) (23) (24)

(25) 80 81 82 83 (26) 85 86 (5) 88 89 90 (6) 92 93 94 95 96 (29)

(30) 99 100

Definir la sucesión

   sucCantor :: [Integer]

1	sucCantor :: [Integer]

cuyos elementos son los términos de la sucesión de Cantor. Por ejemplo,

   λ> take 100 sucCantor
   [1,2,3,4,5,6, 1 ,8,9,10,11,12,13, 2, 15,16, 3, 18,19,20, 4,
    22,23,24,25,26, 5 , 6 ,29,30,31,32,33,34, 1 ,36 , 8 ,38,39,
    40,41, 9 ,43,44,45,46, 10 ,48, 11 ,50,51,52,53,54,55 , 12 ,
    13, 58,59,60,61,62, 2 ,64,65,66, 15 ,68,69, 16 , 3 , 18, 19,
    20, 4, 22, 23, 24 ,25 ,80,81,82,83, 26 ,85,86, 5 ,88,89,90,
    6, 92,93,94,95,96, 29, 30 ,99,100]

   λ> sucCantor2 !! (5+10^6)
   544480

   λ> sucCantor2 !! (6+10^6)
   266086

λ> take 100 sucCantor

[1,2,3,4,5,6, 1 ,8,9,10,11,12,13, 2, 15,16, 3, 18,19,20, 4,

22,23,24,25,26, 5 , 6 ,29,30,31,32,33,34, 1 ,36 , 8 ,38,39,

40,41, 9 ,43,44,45,46, 10 ,48, 11 ,50,51,52,53,54,55 , 12 ,

13, 58,59,60,61,62, 2 ,64,65,66, 15 ,68,69, 16 , 3 , 18, 19,

20, 4, 22, 23, 24 ,25 ,80,81,82,83, 26 ,85,86, 5 ,88,89,90,

6, 92,93,94,95,96, 29, 30 ,99,100]

λ> sucCantor2 !! (5+10^6)

544480

λ> sucCantor2 !! (6+10^6)

266086

Soluciones

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

sucCantor1 :: [Integer]
sucCantor1 = map fst $ scanl f (1,0) [2..]
  where f (a,i) x
          | esInnombrable x = (sucCantor1 !! i, i+1)
          | otherwise       = (x,i)


esInnombrable :: Integer -> Bool
esInnombrable x =
  rem x 7 == 0 || '7' `elem` show x

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

sucCantor2 :: [Integer]
sucCantor2 = aux 0 1
  where aux i x
          | esInnombrable x = sucCantor2 !! i : aux (i+1) (x+1)
          | otherwise       = x : aux i (x+1)

-- 1ª solución

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

sucCantor1 :: [Integer]

sucCantor1 = map fst $ scanl f (1,0) [2..]

where f (a,i) x

| esInnombrable x = (sucCantor1 !! i, i+1)

| otherwise = (x,i)

esInnombrable :: Integer -> Bool

esInnombrable x =

rem x 7 == 0 || '7' `elem` show x

-- 2ª solución

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

sucCantor2 :: [Integer]

sucCantor2 = aux 0 1

where aux i x

| esInnombrable x = sucCantor2 !! i : aux (i+1) (x+1)

| otherwise = x : aux i (x+1)

Referencia

Basado en Cantor’s unspeakable numbers de
CodeGolf.

Particiones de una lista

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

Definir la función

   particiones :: [a] -> [[[a]]]

1	particiones :: [a] -> [[[a]]]

tal que (particiones xs) es la lista de las particiones de xs en segmentos de elementos consecutivos. Por ejemplo,

   λ> particiones [1..3]
   [[[1],[2],[3]],[[1],[2,3]],[[1,2],[3]],[[1,2,3]]]
   λ> mapM_ print (particiones "abcd")
   ["a","b","c","d"]
   ["a","b","cd"]
   ["a","bc","d"]
   ["a","bcd"]
   ["ab","c","d"]
   ["ab","cd"]
   ["abc","d"]
   ["abcd"]
   λ> length (particiones [1..22])
   2097152

λ> particiones [1..3]

[[[1],[2],[3]],[[1],[2,3]],[[1,2],[3]],[[1,2,3]]]

λ> mapM_ print (particiones "abcd")

["a","b","c","d"]

["a","b","cd"]

["a","bc","d"]

["a","bcd"]

["ab","c","d"]

["ab","cd"]

["abc","d"]

["abcd"]

λ> length (particiones [1..22])

2097152

Comprobar con QuickCheck que la concatenación de cada uno de los elementos de (particiones xs) es igual a xs.

Nota: En la comprobación usar ejemplos pequeños como se indica a continuación

   quickCheckWith (stdArgs {maxSize=10}) prop_particiones

1	quickCheckWith (stdArgs {maxSize=10}) prop_particiones

Soluciones

import Test.QuickCheck

particiones :: [a] -> [[[a]]]
particiones [] = [[]]
particiones xs =
  [(take k xs) : yss | k <- [1..n], yss <- particiones (drop k xs)]
  where n = length xs

-- La propiedad es
prop_particiones :: [Int] -> Bool
prop_particiones xs =
  all (\yss -> concat yss == xs) (particiones xs)

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

import Test.QuickCheck

particiones :: [a] -> [[[a]]]

particiones [] = [[]]

particiones xs =

[(take k xs) : yss | k <- [1..n], yss <- particiones (drop k xs)]

where n = length xs

-- La propiedad es

prop_particiones :: [Int] -> Bool

prop_particiones xs =

all (\yss -> concat yss == xs) (particiones xs)

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=10}) prop_particiones

-- +++ OK, passed 100 tests.

Eliminación de triplicados

PorJosé A. Alonso 31-enero-20178-febrero-2017

Definir la función

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

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

tal que (sinTriplicados xs) es la lista obtenida dejando en xs sólo las dos primeras ocurrencias de cada uno de sus elementos. Por ejemplo,

   sinTriplicados "aaabcbccdbabdcd"  ==  "aabcbcdd"
   sinTriplicados "xxxxx"            ==  "xx"
   sinTriplicados "abcabc"           ==  "abcabc"
   sinTriplicados "abcdabcaba"       ==  "abcdabc"
   sinTriplicados "abacbadcba"       ==  "abacbdc"
   sinTriplicados "aaabcbccdbabdcd"  ==  "aabcbcdd"
   sinTriplicados (show (5^4^3))     ==  "54210108624757363989"
   sinTriplicados (show (8^8^8))     ==  "60145207536139279488"

sinTriplicados "aaabcbccdbabdcd" == "aabcbcdd"

sinTriplicados "xxxxx" == "xx"

sinTriplicados "abcabc" == "abcabc"

sinTriplicados "abcdabcaba" == "abcdabc"

sinTriplicados "abacbadcba" == "abacbdc"

sinTriplicados "aaabcbccdbabdcd" == "aabcbcdd"

sinTriplicados (show (5^4^3)) == "54210108624757363989"

sinTriplicados (show (8^8^8)) == "60145207536139279488"

Soluciones

import Data.List (delete)

sinTriplicados :: Eq a => [a] -> [a]
sinTriplicados xs = aux xs [] []
  where aux [] _ _ = []
        aux (x:xs) ys zs
          | x `elem` zs = aux xs ys zs
          | x `elem` ys = x : aux xs (delete x ys) (x:zs)
          | otherwise   = x : aux xs (x:ys) zs

import Data.List (delete)

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

sinTriplicados xs = aux xs [] []

where aux [] _ _ = []

aux (x:xs) ys zs

| x `elem` zs = aux xs ys zs

| x `elem` ys = x : aux xs (delete x ys) (x:zs)

| otherwise = x : aux xs (x:ys) zs

Suma minimal de productos de pares de elementos consecutivos

PorJosé A. Alonso 27-enero-20173-febrero-2017

Al permutar los elementos de la lista [1,2,3,4] se obtienen los siguientes valores de la suma de pares de elementos consecutivos:

10, por ejemplo con [1,4,2,3] ya que 1×4+2×3 = 10
11, por ejemplo con [1,3,2,4] ya que 1×3+2×4 = 11
14, por ejemplo con [1,2,3,4] ya que 1×2+3×4 = 14

Por tanto, la mínima suma de los productos de elementos consecutivos en las permutaciones de [1,2,3,4] es 10 y una permutación con dicha suma es [1,4,2,3].

Definir las funciones

   minimaSumaProductos  :: (Num a, Ord a) => [a] -> a
   permutacionMinimal   :: (Num a, Ord a) => [a] -> [a]

1 2	minimaSumaProductos :: (Num a, Ord a) => [a] -> a permutacionMinimal :: (Num a, Ord a) => [a] -> [a]

tales que

(minimaSumaProductos xs) es la mínima suma de los productos de elementos consecutivos en las permutaciones de lista xs, suponiendo que xs tiene un número par de elementos. Por ejemplo,

     minimaSumaProductos [1..4]             ==  10
     minimaSumaProductos [3,2,5,7,1,6]      ==  34
     minimaSumaProductos [9,2,8,4,5,7,6,0]  ==  74
     minimaSumaProductos [1,2,1,4,0,5,6,0]  ==  6

minimaSumaProductos [1..4] == 10

minimaSumaProductos [3,2,5,7,1,6] == 34

minimaSumaProductos [9,2,8,4,5,7,6,0] == 74

minimaSumaProductos [1,2,1,4,0,5,6,0] == 6

(permutacionMinimal xs) es una permutación de xs cuya suma de productos de elementos consecutivos de xs es la mínima suma de los productos de elementos consecutivos en las permutaciones de lista xs, suponiendo que xs tiene un número par de elementos. Por ejemplo,

     permutacionMinimal [1..4]             ==  [1,4,3,2]
     permutacionMinimal [3,2,5,7,1,6]      ==  [1,7,2,6,3,5]
     permutacionMinimal [9,2,8,4,5,7,6,0]  ==  [0,9,2,8,4,7,5,6]
     permutacionMinimal [1,2,1,4,0,5,6,0]  ==  [0,6,0,5,1,4,1,2]

permutacionMinimal [1..4] == [1,4,3,2]

permutacionMinimal [3,2,5,7,1,6] == [1,7,2,6,3,5]

permutacionMinimal [9,2,8,4,5,7,6,0] == [0,9,2,8,4,7,5,6]

permutacionMinimal [1,2,1,4,0,5,6,0] == [0,6,0,5,1,4,1,2]

Soluciones

import Data.List (sort, permutations)
import Test.QuickCheck

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

minimaSumaProductos :: (Num a, Ord a) => [a] -> a
minimaSumaProductos xs =
  minimum [sumaProductos ys | ys <- permutations xs]

--    sumaProductos [3,2,1,4]  ==  10
--    sumaProductos [2,4,3,1]  ==  11
--    sumaProductos [1,2,3,4]  ==  14
sumaProductos :: (Num a, Ord a) => [a] -> a
sumaProductos []       = 0
sumaProductos [x]      = x
sumaProductos (x:y:zs) = x*y + sumaProductos zs

permutacionMinimal :: (Num a, Ord a) => [a] -> [a]
permutacionMinimal xs =
  head [ys | ys <- yss
           , sumaProductos ys == m]
  where yss = permutations xs
        m   = minimaSumaProductos xs

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

permutacionMinimal2 :: (Num a, Ord a) => [a] -> [a]
permutacionMinimal2 xs =
  intercala ys (reverse zs)
  where n = length xs
        (ys,zs) = splitAt (n `div` 2) (sort xs)

intercala :: [a] -> [a] -> [a]
intercala xs ys =
  concat [[x,y] | (x,y) <- zip xs ys]

minimaSumaProductos2 :: (Num a, Ord a) => [a] -> a
minimaSumaProductos2 =
  sumaProductos . permutacionMinimal2

-- Equivalencia
-- ============

prop_equivalencia :: [Int] -> Property
prop_equivalencia xs =
  even (length xs) ==>
  minimaSumaProductos xs == minimaSumaProductos2 xs

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

import Data.List (sort, permutations)

import Test.QuickCheck

-- 1ª definición

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

minimaSumaProductos :: (Num a, Ord a) => [a] -> a

minimaSumaProductos xs =

minimum [sumaProductos ys | ys <- permutations xs]

-- sumaProductos [3,2,1,4] == 10

-- sumaProductos [2,4,3,1] == 11

-- sumaProductos [1,2,3,4] == 14

sumaProductos :: (Num a, Ord a) => [a] -> a

sumaProductos [] = 0

sumaProductos [x] = x

sumaProductos (x:y:zs) = x*y + sumaProductos zs

permutacionMinimal :: (Num a, Ord a) => [a] -> [a]

permutacionMinimal xs =

head [ys | ys <- yss

, sumaProductos ys == m]

where yss = permutations xs

m = minimaSumaProductos xs

-- 2ª definición

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

permutacionMinimal2 :: (Num a, Ord a) => [a] -> [a]

permutacionMinimal2 xs =

intercala ys (reverse zs)

where n = length xs

(ys,zs) = splitAt (n `div` 2) (sort xs)

intercala :: [a] -> [a] -> [a]

intercala xs ys =

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

minimaSumaProductos2 :: (Num a, Ord a) => [a] -> a

minimaSumaProductos2 =

sumaProductos . permutacionMinimal2

-- Equivalencia

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

prop_equivalencia :: [Int] -> Property

prop_equivalencia xs =

even (length xs) ==>

minimaSumaProductos xs == minimaSumaProductos2 xs

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=10}) prop_equivalencia

-- +++ OK, passed 100 tests.

Máxima potencia que divide al factorial

PorJosé A. Alonso 26-enero-20172-febrero-2017

La máxima potencia de 2 que divide al factorial de 5 es 3, ya que 5! = 120, 120 es divisible por 2^3 y no lo es por 2^4.

Definir la función

   maxPotDivFact :: Integer -> Integer -> Integer

1	maxPotDivFact :: Integer -> Integer -> Integer

tal que (maxPotDivFact p n), para cada primo p, es el mayor k tal que p^k divide al factorial de n. Por ejemplo,

   maxPotDivFact 2 5       ==  3
   maxPotDivFact 3 6       ==  2
   maxPotDivFact 2 10      ==  8
   maxPotDivFact 3 10      ==  4
   maxPotDivFact 2 (10^2)  ==  97
   maxPotDivFact 2 (10^3)  ==  994
   maxPotDivFact 2 (10^4)  ==  9995
   maxPotDivFact 2 (10^5)  ==  99994
   maxPotDivFact 2 (10^6)  ==  999993
   maxPotDivFact 3 (10^5)  ==  49995
   maxPotDivFact 3 (10^6)  ==  499993
   maxPotDivFact 7 (10^5)  ==  16662
   maxPotDivFact 7 (10^6)  ==  166664
   length (show (maxPotDivFact 2 (10^20000)))  ==  20000

maxPotDivFact 2 5 == 3

maxPotDivFact 3 6 == 2

maxPotDivFact 2 10 == 8

maxPotDivFact 3 10 == 4

maxPotDivFact 2 (10^2) == 97

maxPotDivFact 2 (10^3) == 994

maxPotDivFact 2 (10^4) == 9995

maxPotDivFact 2 (10^5) == 99994

maxPotDivFact 2 (10^6) == 999993

maxPotDivFact 3 (10^5) == 49995

maxPotDivFact 3 (10^6) == 499993

maxPotDivFact 7 (10^5) == 16662

maxPotDivFact 7 (10^6) == 166664

length (show (maxPotDivFact 2 (10^20000))) == 20000

Soluciones

import Data.List (genericIndex, genericTake)
import Data.Numbers.Primes (primes)
import Test.QuickCheck

-- 1ª definición
maxPotDivFact :: Integer -> Integer -> Integer
maxPotDivFact p n =
  head [k | k <- [0..], f `mod` (p^k) /= 0] - 1
  where f = product [1..n]

-- 1ª definición
maxPotDivFact2 :: Integer -> Integer -> Integer
maxPotDivFact2 p n
  | n < p     = 0
  | otherwise = m + maxPotDivFact2 p m
  where m = n `div` p  
  
-- 3ª definición
maxPotDivFact3 :: Integer -> Integer -> Integer
maxPotDivFact3 p = sum . takeWhile (> 0) . tail . iterate (`div` p)

-- Comparación de eficiencia
--    λ> maxPotDivFact 2 (10^4)
--    9995
--    (5.47 secs, 161,040,624 bytes)
--    λ> maxPotDivFact2 2 (10^4)
--    9995
--    (0.01 secs, 0 bytes)
--    λ> maxPotDivFact2 2 (10^4)
--    9995
--    (0.01 secs, 0 bytes)
--
--    λ> length (show (maxPotDivFact2 2 (10^20000)))
--    20000
--    (1.93 secs, 592,168,544 bytes)
--    λ> length (show (maxPotDivFact3 2 (10^20000)))
--    20000
--    (2.93 secs, 861,791,504 bytes)

import Data.List (genericIndex, genericTake)

import Data.Numbers.Primes (primes)

import Test.QuickCheck

-- 1ª definición

maxPotDivFact :: Integer -> Integer -> Integer

maxPotDivFact p n =

head [k | k <- [0..], f `mod` (p^k) /= 0] - 1

where f = product [1..n]

-- 1ª definición

maxPotDivFact2 :: Integer -> Integer -> Integer

maxPotDivFact2 p n

| n < p = 0

| otherwise = m + maxPotDivFact2 p m

where m = n `div` p

-- 3ª definición

maxPotDivFact3 :: Integer -> Integer -> Integer

maxPotDivFact3 p = sum . takeWhile (> 0) . tail . iterate (`div` p)

-- Comparación de eficiencia

-- λ> maxPotDivFact 2 (10^4)

-- 9995

-- (5.47 secs, 161,040,624 bytes)

-- λ> maxPotDivFact2 2 (10^4)

-- 9995

-- (0.01 secs, 0 bytes)

-- λ> maxPotDivFact2 2 (10^4)

-- 9995

-- (0.01 secs, 0 bytes)

-- λ> length (show (maxPotDivFact2 2 (10^20000)))

-- 20000

-- (1.93 secs, 592,168,544 bytes)

-- λ> length (show (maxPotDivFact3 2 (10^20000)))

-- 20000

-- (2.93 secs, 861,791,504 bytes)

Árboles continuos

PorJosé A. Alonso 25-enero-20171-febrero-2017

Los árboles binarios se pueden representar con el de tipo de dato algebraico

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

data Arbol a = H

| N a (Arbol a) (Arbol a)

deriving Show

Por ejemplo, los árboles

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

3 7

/ \ / \

2 4 5 8

/ \ \ / \ \

1 3 5 6 4 10

se representan por

   ej1, ej2 :: Arbol Int
   ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))
   ej2 = N 7 (N 5 (N 6 H H) (N 4 H H)) (N 8 H (N 10 H H))

ej1, ej2 :: Arbol Int

ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))

ej2 = N 7 (N 5 (N 6 H H) (N 4 H H)) (N 8 H (N 10 H H))

Un árbol binario es continuo si el valor absoluto de la diferencia de los elementos adyacentes es 1. Por ejemplo, el árbol ej1 es continuo ya que el valor absoluto de sus pares de elementos adyacentes son

   |3-2| = |2-1| = |2-3| = |3-4| = |4-5| = 1

1	\|3-2\| = \|2-1\| = \|2-3\| = \|3-4\| = \|4-5\| = 1

En cambio, el ej2 no lo es ya que |8-10| ≠ 1.

Definir la función

   esContinuo :: (Num a, Eq a) => Arbol a -> Bool

1	esContinuo :: (Num a, Eq a) => Arbol a -> Bool

tal que (esContinuo x) se verifica si el árbol x es continuo. Por ejemplo,

   esContinuo ej1  ==  True
   esContinuo ej2  ==  False

1 2	esContinuo ej1 == True esContinuo ej2 == False

Soluciones

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

ej1, ej2 :: Arbol Int
ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))
ej2 = N 7 (N 5 (N 6 H H) (N 4 H H)) (N 8 H (N 10 H H))

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

esContinuo :: (Num a, Eq a) => Arbol a -> Bool
esContinuo H         = True
esContinuo (N _ H H) = True
esContinuo (N x i@(N y _ _) H) =
  abs (x - y) == 1 && esContinuo i
esContinuo (N x H d@(N y _ _)) =
  abs (x - y) == 1 && esContinuo d
esContinuo (N x i@(N y _ _) d@(N z _ _)) =
  abs (x - y) == 1 && esContinuo i && abs (x - z) == 1 && esContinuo d 

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

esContinuo2 :: (Num a, Eq a) => Arbol a -> Bool
esContinuo2 x =
  all esContinua (ramas x)

-- (ramas x) es la lista de las ramas del árbol x. Por ejemplo,
--    ramas ej1  ==  [[3,2,1],[3,2,3],[3,4,5]]
--    ramas ej2  ==  [[7,5,6],[7,5,4],[7,8,10]]
ramas :: Arbol a -> [[a]]
ramas H         = []
ramas (N x H H) = [[x]]
ramas (N x i d) = [x : xs | xs <- ramas i ++ ramas d]

-- (esContinua xs) se verifica si el valor absoluto de la diferencia de
-- los elementos adyacentes de xs es 1. Por ejemplo, 
--    esContinua [3,2,3]   ==  True
--    esContinua [7,8,10]  ==  False
esContinua :: (Num a, Eq a) => [a] -> Bool
esContinua xs =
  and [abs (x - y) == 1 | (x, y) <- zip xs (tail xs)]

data Arbol a = H

| N a (Arbol a) (Arbol a)

deriving Show

ej1, ej2 :: Arbol Int

ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))

ej2 = N 7 (N 5 (N 6 H H) (N 4 H H)) (N 8 H (N 10 H H))

-- 1ª solución

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

esContinuo :: (Num a, Eq a) => Arbol a -> Bool

esContinuo H = True

esContinuo (N _ H H) = True

esContinuo (N x i@(N y _ _) H) =

abs (x - y) == 1 && esContinuo i

esContinuo (N x H d@(N y _ _)) =

abs (x - y) == 1 && esContinuo d

esContinuo (N x i@(N y _ _) d@(N z _ _)) =

abs (x - y) == 1 && esContinuo i && abs (x - z) == 1 && esContinuo d

-- 2ª solución

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

esContinuo2 :: (Num a, Eq a) => Arbol a -> Bool

esContinuo2 x =

all esContinua (ramas x)

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

-- ramas ej1 == [[3,2,1],[3,2,3],[3,4,5]]

-- ramas ej2 == [[7,5,6],[7,5,4],[7,8,10]]

ramas :: Arbol a -> [[a]]

ramas H = []

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

ramas (N x i d) = [x : xs | xs <- ramas i ++ ramas d]

-- (esContinua xs) se verifica si el valor absoluto de la diferencia de

-- los elementos adyacentes de xs es 1. Por ejemplo,

-- esContinua [3,2,3] == True

-- esContinua [7,8,10] == False

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

esContinua xs =

and [abs (x - y) == 1 | (x, y) <- zip xs (tail xs)]

Referencias

Basado en Continuous tree de GeeksforGeeks.

Cadena de primos

PorJosé A. Alonso 23-enero-201730-enero-2017

La lista de los primeros números primos es

   [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71]

1	[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71]

Los primeros elementos de la cadena obtenida concatenado los números primos es

   "23571113171923293137414347535961677173798389971011"

1	"23571113171923293137414347535961677173798389971011"

Definir la función

   primoEnPosicion :: Int -> Integer

1	primoEnPosicion :: Int -> Integer

tal que (primoEnPosicion n) es el número primo que tiene algún dígito en la posición n de la cadena obtenida concatenado los números primos. Por ejemplo,

   primoEnPosicion 0       ==  2
   primoEnPosicion 1       ==  3
   primoEnPosicion 4       ==  11
   primoEnPosicion 5       ==  11
   primoEnPosicion 6       ==  13
   primoEnPosicion 1022    ==  2011
   primoEnPosicion 1023    ==  2017
   primoEnPosicion 1026    ==  2017
   primoEnPosicion 1027    ==  2027
   primoEnPosicion (10^7)  ==  21242357

primoEnPosicion 0 == 2

primoEnPosicion 1 == 3

primoEnPosicion 4 == 11

primoEnPosicion 5 == 11

primoEnPosicion 6 == 13

primoEnPosicion 1022 == 2011

primoEnPosicion 1023 == 2017

primoEnPosicion 1026 == 2017

primoEnPosicion 1027 == 2027

primoEnPosicion (10^7) == 21242357

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck

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

primoEnPosicion :: Int -> Integer
primoEnPosicion = aux primes
  where aux (x:xs) n | m > n     = x
                     | otherwise = aux xs (n-m)
          where m = length (show x)


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

primoEnPosicion2 :: Int -> Integer
primoEnPosicion2 n = p
  where (p,_) = head $ dropWhile (\(x,k) -> k < n) primosYfinales

-- primosYfinales es la sucesión de los pares de los números primos y
-- las posiciones de sus dígitos finales en la sucesión de la
-- concatenación de primos. Por ejemplo, 
--    λ> take 10 primosYfinales
--    [(2,0),(3,1),(5,2),(7,3),(11,5),(13,7),(17,9),(19,11),(23,13),(29,15)]
primosYfinales :: [(Integer, Int)]
primosYfinales = scanl f (2,0) (tail primes)
  where f (p,k) q = (q, k + length (show q))

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_equivalencia (Positive n) =
  primoEnPosicion n == primoEnPosicion2 n

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

import Data.Numbers.Primes

import Test.QuickCheck

-- 1ª definición

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

primoEnPosicion :: Int -> Integer

primoEnPosicion = aux primes

where aux (x:xs) n | m > n = x

| otherwise = aux xs (n-m)

where m = length (show x)

-- 2ª definición

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

primoEnPosicion2 :: Int -> Integer

primoEnPosicion2 n = p

where (p,_) = head $ dropWhile (\(x,k) -> k < n) primosYfinales

-- primosYfinales es la sucesión de los pares de los números primos y

-- las posiciones de sus dígitos finales en la sucesión de la

-- concatenación de primos. Por ejemplo,

-- λ> take 10 primosYfinales

-- [(2,0),(3,1),(5,2),(7,3),(11,5),(13,7),(17,9),(19,11),(23,13),(29,15)]

primosYfinales :: [(Integer, Int)]

primosYfinales = scanl f (2,0) (tail primes)

where f (p,k) q = (q, k + length (show q))

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equivalencia (Positive n) =

primoEnPosicion n == primoEnPosicion2 n

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

Notación polaca inversa

PorJosé A. Alonso 20-enero-201727-enero-2017

La notación polaca inversa (en inglés, Reverse Polish Notation, o RPN), es una forma alternativa de escribir expresiones matemáticas. Por ejemplo, la expresión "20 - (4 + 3) * 2" en RPN es "20 4 3 + 2 * -".

Para evaluar una expresión en RPN, usamos una lista auxiliar (inicialmente vacía) y recorremos la expresión de izquierda a derecha. Cada vez que encontramos un número, lo añadimos a la lista auxiliar. Cuando encontramos un operador, retiramos los dos números que hay al principio de la pila, utilizamos el operador con ellos y los quitamos de la lista y le añadimos el resultado. Cuando alcancemos el final de la expresión, debemos tener un solo número en la lista auxiliar si la expresión estaba bien formada, y éste representa el resultado de la expresión. Por ejemplo, la evaluación de RPN "20 4 3 + 2 * -" es la siguiente

   ""                 []
   "20"               [20]
   "20 4"             [4, 20]
   "20 4 3"           [3, 4, 20]
   "20 4 3 +"         [7, 20]
   "20 4 3 + 2"       [2, 7, 20]
   "20 4 3 + 2 *"     [14, 20]
   "20 4 3 + 2 * -"   [6]

"" []

"20" [20]

"20 4" [4, 20]

"20 4 3" [3, 4, 20]

"20 4 3 +" [7, 20]

"20 4 3 + 2" [2, 7, 20]

"20 4 3 + 2 *" [14, 20]

"20 4 3 + 2 * -" [6]

Definir la función

   valor :: String -> Float

1	valor :: String -> Float

tal que (valor cs) es el valor de la expresión RPN cs. Por ejemplo,

   valor "4"               ==  4.0
   valor "4 3 +"           ==  7.0
   valor "4 3 + 2 *"       ==  14.0
   valor "20 4 3 + 2 * -"  ==  6.0
   valor "3 7 + 2 /"       ==  5.0

valor "4" == 4.0

valor "4 3 +" == 7.0

valor "4 3 + 2 *" == 14.0

valor "20 4 3 + 2 * -" == 6.0

valor "3 7 + 2 /" == 5.0

Soluciones

valor :: String -> Float
valor = head . foldl aux [] . words
  where aux (x:y:ys) "+" = (x + y) : ys
        aux (x:y:ys) "-" = (y - x) : ys
        aux (x:y:ys) "*" = (x * y) : ys
        aux (x:y:ys) "/" = (y / x) : ys
        aux xs cs        = read cs : xs

valor :: String -> Float

valor = head . foldl aux [] . words

where aux (x:y:ys) "+" = (x + y) : ys

aux (x:y:ys) "-" = (y - x) : ys

aux (x:y:ys) "*" = (x * y) : ys

aux (x:y:ys) "/" = (y / x) : ys

aux xs cs = read cs : xs

La conjetura de Rodolfo

PorJosé A. Alonso 19-enero-201726-enero-2017

El pasado 1 de enero, Claudio Meller publicó el artículo La conjetura de Rodolfo que afirma que

Todos los números naturales se pueden números pueden expresarse como la suma de un capicúa y un capicúa especial (siendo los capicúas especiales los números que al quitarles los ceros finales son capicúas; por ejemplo, 32300, 50500 y 78987).

Definir las funciones

   descomposiciones               :: Integer -> [(Integer, Integer)]
   contraejemplosConjeturaRodolfo :: [Integer]

1 2	descomposiciones :: Integer -> [(Integer, Integer)] contraejemplosConjeturaRodolfo :: [Integer]

tales que

(descomposiciones x) es la lista de las descomposiciones de x como la suma de un capicúa y un capicúa especial. Por ejemplo,

     descomposiciones 1980  ==  [(99,1881),(979,1001)]
     descomposiciones 2016  ==  [(575,1441),(606,1410)]
     descomposiciones 1971  ==  [(161,1810),(1771,200),(1881,90)]

descomposiciones 1980 == [(99,1881),(979,1001)]

descomposiciones 2016 == [(575,1441),(606,1410)]

descomposiciones 1971 == [(161,1810),(1771,200),(1881,90)]

contraejemplosConjeturaRodolfo es la lista de contraejemplos de la conjetura de Rodolfo; es decir, de los números que no pueden expresarse com la suma de un capicúa y un capicúa especial. Por ejemplo,

     λ> take 12 contraejemplosConjeturaRodolfo
     [1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]
     λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)
     [3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]

λ> take 12 contraejemplosConjeturaRodolfo

[1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]

λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)

[3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]

Soluciones

import Data.List (nub)

descomposiciones :: Integer -> [(Integer, Integer)]
descomposiciones x =
  reducida [(y,z) | y <- takeWhile (<= x) capicuas
                  , let z = x - y
                  , esCapicuaG 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

esCapicuaG :: Integer -> Bool
esCapicuaG x =
  x == 0 || esCapicua (sinCerosFinales x)

--    sinCerosFinales 3405000  ==  3405
sinCerosFinales :: Integer -> Integer
sinCerosFinales x =
  read (reverse (dropWhile (== '0') (reverse (show x))))

reducida :: [(Integer, Integer)] -> [(Integer, Integer)]
reducida ps =
  nub [(x,y) | (x,y) <- ps
             , x <= y]

--    λ> take 12 contraejemplosConjeturaRodolfo
--    [1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]
--    λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)
--    [3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]
contraejemplosConjeturaRodolfo :: [Integer]
contraejemplosConjeturaRodolfo =
  [x | x <- [0..]
  , null (descomposiciones x)]

import Data.List (nub)

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

descomposiciones x =

reducida [(y,z) | y <- takeWhile (<= x) capicuas

, let z = x - y

, esCapicuaG 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

esCapicuaG :: Integer -> Bool

esCapicuaG x =

x == 0 || esCapicua (sinCerosFinales x)

-- sinCerosFinales 3405000 == 3405

sinCerosFinales :: Integer -> Integer

sinCerosFinales x =

read (reverse (dropWhile (== '0') (reverse (show x))))

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

reducida ps =

nub [(x,y) | (x,y) <- ps

, x <= y]

-- λ> take 12 contraejemplosConjeturaRodolfo

-- [1200,1220,1240,1250,1260,1270,1280,1290,1300,1330,1350,1360]

-- λ> take 12 (dropWhile (< 2000) contraejemplosConjeturaRodolfo)

-- [3020,3240,3350,3460,3570,3680,3920,4030,4250,4360,4470,4580]

contraejemplosConjeturaRodolfo :: [Integer]

contraejemplosConjeturaRodolfo =

[x | x <- [0..]

, null (descomposiciones x)]

Sustitución en una posición

PorJosé A. Alonso 18-enero-201725-marzo-2022

Los árboles binarios se pueden representar con el de dato algebraico

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

data Arbol a = H

| N a (Arbol a) (Arbol a)

deriving Show

Por ejemplo, los árboles

        9                9                
       / \              / 
      /   \            /  
     8     6          8  
    / \   / \        / \ 
   3   2 4   5      3   2

9 9

/ \ /

8 6 8

/ \ / \ / \

3 2 4 5 3 2

se pueden representar por

   ej1, ej2:: Arbol Int
   ej1 = N 9 (N 8 (N 3 H H) (N 2 H H)) (N 6 (N 4 H H) (N 5 H H))
   ej2 = N 9 (N 8 (N 3 H H) (N 2 H H)) H

ej1, ej2:: Arbol Int

ej1 = N 9 (N 8 (N 3 H H) (N 2 H H)) (N 6 (N 4 H H) (N 5 H H))

ej2 = N 9 (N 8 (N 3 H H) (N 2 H H)) H

Para indicar las posiciones del árbol se define el tipo

  type Posicion = [Direccion]

1	type Posicion = [Direccion]

donde

  data Direccion = D | I
    deriving Eq

1 2	data Direccion = D \| I deriving Eq

representa un movimiento hacia la derecha (D) o a la izquierda. Por ejemplo, las posiciones de los elementos del ej1 son

  9 [] 
  8 [I]
  3 [I,I]
  2 [I,D]
  6 [D]
  4 [D,I]
  5 [D,D]

9 []

8 [I]

3 [I,I]

2 [I,D]

6 [D]

4 [D,I]

5 [D,D]

Definir la función

   sustitucion :: Posicion -> a -> Arbol a -> Arbol a

1	sustitucion :: Posicion -> a -> Arbol a -> Arbol a

tal que (sustitucion ds z x) es el árbol obtenido sustituyendo el elemento de x en la posición ds por z. Por ejemplo,

  λ> sustitucion [I,D] 7 ej1
  N 9 (N 8 (N 3 H H) (N 7 H H)) (N 6 (N 4 H H) (N 5 H H))
  λ> sustitucion [D,D] 7 ej1
  N 9 (N 8 (N 3 H H) (N 2 H H)) (N 6 (N 4 H H) (N 7 H H))
  λ> sustitucion [I] 7 ej1
  N 9 (N 7 (N 3 H H) (N 2 H H)) (N 6 (N 4 H H) (N 5 H H))
  λ> sustitucion [] 7 ej1
  N 7 (N 8 (N 3 H H) (N 2 H H)) (N 6 (N 4 H H) (N 5 H H))

λ> sustitucion [I,D] 7 ej1

N 9 (N 8 (N 3 H H) (N 7 H H)) (N 6 (N 4 H H) (N 5 H H))

λ> sustitucion [D,D] 7 ej1

N 9 (N 8 (N 3 H H) (N 2 H H)) (N 6 (N 4 H H) (N 7 H H))

λ> sustitucion [I] 7 ej1

N 9 (N 7 (N 3 H H) (N 2 H H)) (N 6 (N 4 H H) (N 5 H H))

λ> sustitucion [] 7 ej1

N 7 (N 8 (N 3 H H) (N 2 H H)) (N 6 (N 4 H H) (N 5 H H))

Soluciones

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

ej1, ej2:: Arbol Int
ej1 = N 9 (N 8 (N 3 H H) (N 2 H H)) (N 6 (N 4 H H) (N 5 H H))
ej2 = N 9 (N 8 (N 3 H H) (N 2 H H)) H

data Direccion = D | I
  deriving Eq

type Posicion = [Direccion]

sustitucion :: Posicion  -> a -> Arbol a -> Arbol a
sustitucion (I:ds) z (N x i d) = N x (sustitucion ds z i) d
sustitucion (D:ds) z (N x i d) = N x i (sustitucion ds z d)
sustitucion []     z (N _ i d) = N z i d

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

deriving (Eq, Show)

ej1, ej2:: Arbol Int

ej1 = N 9 (N 8 (N 3 H H) (N 2 H H)) (N 6 (N 4 H H) (N 5 H H))

ej2 = N 9 (N 8 (N 3 H H) (N 2 H H)) H

data Direccion = D | I

deriving Eq

type Posicion = [Direccion]

sustitucion :: Posicion -> a -> Arbol a -> Arbol a

sustitucion (I:ds) z (N x i d) = N x (sustitucion ds z i) d

sustitucion (D:ds) z (N x i d) = N x i (sustitucion ds z d)

sustitucion [] z (N _ i d) = N z i d

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)

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)

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

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

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.

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

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)

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.

Listas engarzadas

PorJosé A. Alonso 5-diciembre-201612-diciembre-2016

Una lista de listas es engarzada si el último elemento de cada lista coincide con el primero de la siguiente.

Definir la función

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

1	engarzada :: Eq a => [[a]] -> Bool

tal que (engarzada xss) se verifica si xss es una lista engarzada. Por ejemplo,

   engarzada [[1,2,3], [3,5], [5,9,0]] == True
   engarzada [[1,4,5], [5,0], [1,0]]   == False
   engarzada [[1,4,5], [], [1,0]]      == False
   engarzada [[2]]                     == True

engarzada [[1,2,3], [3,5], [5,9,0]] == True

engarzada [[1,4,5], [5,0], [1,0]] == False

engarzada [[1,4,5], [], [1,0]] == False

engarzada [[2]] == True

Soluciones

-- 1ª solución:
engarzada :: Eq a => [[a]] -> Bool
engarzada (xs:ys:xss) =
     not (null xs) && not (null ys) && last xs == head ys
  && engarzada (ys:xss)
engarzada _ = True

-- 2ª solución:
engarzada2 :: Eq a => [[a]] -> Bool
engarzada2 (xs:ys:xss) =
  and [ not (null xs)
      , not (null ys)
      , last xs == head ys
      , engarzada2 (ys:xss) ]
engarzada2 _ = True

-- 3ª solución:
engarzada3 :: Eq a => [[a]] -> Bool
engarzada3 xss =
  and [ not (null xs) && not (null ys) && last xs == head ys
      | (xs,ys) <- zip xss (tail xss)]

-- 4ª solución:
engarzada4 :: Eq a => [[a]] -> Bool
engarzada4 xss =
  all engarzados (zip xss (tail xss))
  where engarzados (xs,ys) =
          not (null xs) && not (null ys) && last xs == head ys

-- 5ª solución:
engarzada5 :: Eq a => [[a]] -> Bool
engarzada5 xss =
  all engarzados (zip xss (tail xss))
  where engarzados ([],_)   = False
        engarzados (_,[])   = False
        engarzados (xs,y:_) = last xs == y

-- 6ª solución:
engarzada6 :: Eq a => [[a]] -> Bool
engarzada6 xss =
  and (zipWith engarzados xss (tail xss))
  where engarzados [] _     = False
        engarzados _  []    = False
        engarzados xs (y:_) = last xs == y

-- 1ª solución:

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

engarzada (xs:ys:xss) =

not (null xs) && not (null ys) && last xs == head ys

&& engarzada (ys:xss)

engarzada _ = True

-- 2ª solución:

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

engarzada2 (xs:ys:xss) =

and [ not (null xs)

, not (null ys)

, last xs == head ys

, engarzada2 (ys:xss) ]

engarzada2 _ = True

-- 3ª solución:

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

engarzada3 xss =

and [ not (null xs) && not (null ys) && last xs == head ys

| (xs,ys) <- zip xss (tail xss)]

-- 4ª solución:

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

engarzada4 xss =

all engarzados (zip xss (tail xss))

where engarzados (xs,ys) =

not (null xs) && not (null ys) && last xs == head ys

-- 5ª solución:

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

engarzada5 xss =

all engarzados (zip xss (tail xss))

where engarzados ([],_) = False

engarzados (_,[]) = False

engarzados (xs,y:_) = last xs == y

-- 6ª solución:

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

engarzada6 xss =

and (zipWith engarzados xss (tail xss))

where engarzados [] _ = False

engarzados _ [] = False

engarzados xs (y:_) = last xs == y

Listas alternadas

PorJosé A. Alonso 2-diciembre-20169-diciembre-2016

Una lista de números enteros se llama alternada si sus elementos son alternativamente par/impar o impar/par.

Definir la función

   alternada :: [Int] -> Bool

1	alternada :: [Int] -> Bool

tal que (alternada xs) se verifica si xs es una lista alternada. Por ejemplo,

   alternada [1,2,3]     == True
   alternada [1,4,6,5]   == False
   alternada [1,4,3,5]   == False
   alternada [8,1,2,3,4] == True
   alternada [8,1,2,3]   == True
   alternada [8]         == True
   alternada [7]         == True

alternada [1,2,3] == True

alternada [1,4,6,5] == False

alternada [1,4,3,5] == False

alternada [8,1,2,3,4] == True

alternada [8,1,2,3] == True

alternada [8] == True

alternada [7] == True

Soluciones

-- 1ª solución:
alternada1 :: [Int] -> Bool
alternada1 (x:y:xs)
  | even x    = odd y  && alternada1 (y:xs)
  | otherwise = even y && alternada1 (y:xs)
alternada1 _ = True

-- 2ª solución
alternada2 :: [Int] -> Bool
alternada2 xs = all odd (zipWith (+) xs (tail xs))

-- 1ª solución:

alternada1 :: [Int] -> Bool

alternada1 (x:y:xs)

| even x = odd y && alternada1 (y:xs)

| otherwise = even y && alternada1 (y:xs)

alternada1 _ = True

-- 2ª solución

alternada2 :: [Int] -> Bool

alternada2 xs = all odd (zipWith (+) xs (tail xs))

Sumas de posiciones pares e impares

PorJosé A. Alonso 1-diciembre-20168-diciembre-2016

Definir la función

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

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

tal que (sumasParesImpares) xs es el par formado por la suma de los elementos de xs en posiciones pares y por la suma de los elementos de xs en posiciones impares. Por ejemplo,

   sumasParesImpares []         ==  (0,0)
   sumasParesImpares [3]        ==  (3,0)
   sumasParesImpares [3,2]      ==  (3,2)
   sumasParesImpares [3,2,1]    ==  (4,2)
   sumasParesImpares [3,2,1,5]  ==  (4,7)
   sumasParesImpares [1..10^7]  ==  (25000000000000,25000005000000)

sumasParesImpares [] == (0,0)

sumasParesImpares [3] == (3,0)

sumasParesImpares [3,2] == (3,2)

sumasParesImpares [3,2,1] == (4,2)

sumasParesImpares [3,2,1,5] == (4,7)

sumasParesImpares [1..10^7] == (25000000000000,25000005000000)

Soluciones

-- 1ª solución
sumasParesImpares1 :: [Integer] -> (Integer,Integer)
sumasParesImpares1 xs =
  (sum [x | (x,n) <- xns, even n],
   sum [x | (x,n) <- xns, odd n])
  where xns = zip xs [0..]

-- 2ª solución
sumasParesImpares2 :: [Integer] -> (Integer,Integer)
sumasParesImpares2 xs = aux xs (0,0)
  where aux (x1:x2:xs) (a,b) = aux xs (x1+a,x2+b)
        aux [x]        (a,b) = (x+a,b)
        aux []         (a,b) = (a,b)
  
-- Comparación de eficiencia
--    λ> sumasParesImpares1 [1..10^6]
--    (250000000000,250000500000)
--    (4.48 secs, 731,994,904 bytes)
--    λ> sumasParesImpares2 [1..10^6]
--    (250000000000,250000500000)
--    (1.78 secs, 235,663,400 bytes)

-- 1ª solución

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

sumasParesImpares1 xs =

(sum [x | (x,n) <- xns, even n],

sum [x | (x,n) <- xns, odd n])

where xns = zip xs [0..]

-- 2ª solución

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

sumasParesImpares2 xs = aux xs (0,0)

where aux (x1:x2:xs) (a,b) = aux xs (x1+a,x2+b)

aux [x] (a,b) = (x+a,b)

aux [] (a,b) = (a,b)

-- Comparación de eficiencia

-- λ> sumasParesImpares1 [1..10^6]

-- (250000000000,250000500000)

-- (4.48 secs, 731,994,904 bytes)

-- λ> sumasParesImpares2 [1..10^6]

-- (250000000000,250000500000)

-- (1.78 secs, 235,663,400 bytes)

Soluciones

Referencia

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico