last

Representación de Zeckendorf

PorJosé A. Alonso 25-abril-20221-mayo-2022

Los primeros números de Fibonacci son

   1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, ...

1	1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, ...

tales que los dos primeros son iguales a 1 y los siguientes se obtienen sumando los dos anteriores.

El teorema de Zeckendorf establece que todo entero positivo n se puede representar, de manera única, como la suma de números de Fibonacci no consecutivos decrecientes. Dicha suma se llama la representación de Zeckendorf de n. Por ejemplo, la representación de Zeckendorf de 100 es

   100 = 89 + 8 + 3

1	100 = 89 + 8 + 3

Hay otras formas de representar 100 como sumas de números de Fibonacci; por ejemplo,

   100 = 89 +  8 + 2 + 1
   100 = 55 + 34 + 8 + 3

1 2	100 = 89 + 8 + 2 + 1 100 = 55 + 34 + 8 + 3

pero no son representaciones de Zeckendorf porque 1 y 2 son números de Fibonacci consecutivos, al igual que 34 y 55.

Definir la función

   zeckendorf :: Integer -> [Integer]

1	zeckendorf :: Integer -> [Integer]

tal que (zeckendorf n) es la representación de Zeckendorf de n. Por ejemplo,

   zeckendorf 100 == [89,8,3]
   zeckendorf 200 == [144,55,1]
   zeckendorf 300 == [233,55,8,3,1]
   length (zeckendorf (10^50000)) == 66097

zeckendorf 100 == [89,8,3]

zeckendorf 200 == [144,55,1]

zeckendorf 300 == [233,55,8,3,1]

length (zeckendorf (10^50000)) == 66097

Soluciones

module Representacion_de_Zeckendorf where

import Data.List (subsequences)
import Test.QuickCheck

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

zeckendorf1 :: Integer -> [Integer]
zeckendorf1 = head . zeckendorf1Aux

zeckendorf1Aux :: Integer -> [[Integer]]
zeckendorf1Aux n =
  [xs | xs <- subsequences (reverse (takeWhile (<= n) (tail fibs))),
        sum xs == n,
        sinFibonacciConsecutivos xs]

-- fibs es la la sucesión de los números de Fibonacci. Por ejemplo,
--    take 14 fibs  == [1,1,2,3,5,8,13,21,34,55,89,144,233,377]
fibs :: [Integer]
fibs = 1 : scanl (+) 1 fibs
-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión
-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por
-- ejemplo, 

-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión
-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por
-- ejemplo, 
--    sinFibonacciConsecutivos [89, 8, 3]      ==  True
--    sinFibonacciConsecutivos [55, 34, 8, 3]  ==  False
sinFibonacciConsecutivos :: [Integer] -> Bool
sinFibonacciConsecutivos xs =
  and [x /= siguienteFibonacci y | (x,y) <- zip xs (tail xs)]

-- (siguienteFibonacci n) es el menor número de Fibonacci mayor que
-- n. Por ejemplo, 
--    siguienteFibonacci 34  ==  55
siguienteFibonacci :: Integer -> Integer
siguienteFibonacci n =
  head (dropWhile (<= n) fibs)

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

zeckendorf2 :: Integer -> [Integer]
zeckendorf2 = head . zeckendorf2Aux

zeckendorf2Aux :: Integer -> [[Integer]]
zeckendorf2Aux n = map reverse (aux n (tail fibs))
  where aux 0 _ = [[]]
        aux m (x:y:zs)
            | x <= m     = [x:xs | xs <- aux (m-x) zs] ++ aux m (y:zs)
            | otherwise  = []

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

zeckendorf3 :: Integer -> [Integer]
zeckendorf3 0 = []
zeckendorf3 n = x : zeckendorf3 (n - x)
  where x = last (takeWhile (<= n) fibs)

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

zeckendorf4 :: Integer -> [Integer]
zeckendorf4 n = aux n (reverse (takeWhile (<= n) fibs))
  where aux 0 _      = []
        aux m (x:xs) = x : aux (m-x) (dropWhile (>m-x) xs)

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

-- La propiedad es
prop_zeckendorf :: Positive Integer -> Bool
prop_zeckendorf (Positive n) =
  all (== zeckendorf1 n)
      [zeckendorf2 n,
       zeckendorf3 n,
       zeckendorf4 n]

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

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

-- La comparación es
--    λ> zeckendorf1 (7*10^4)
--    [46368,17711,4181,1597,89,34,13,5,2]
--    (1.49 secs, 2,380,707,744 bytes)
--    λ> zeckendorf2 (7*10^4)
--    [46368,17711,4181,1597,89,34,13,5,2]
--    (0.07 secs, 21,532,008 bytes)
--
--    λ> zeckendorf2 (10^6)
--    [832040,121393,46368,144,55]
--    (1.40 secs, 762,413,432 bytes)
--    λ> zeckendorf3 (10^6)
--    [832040,121393,46368,144,55]
--    (0.01 secs, 542,488 bytes)
--    λ> zeckendorf4 (10^6)
--    [832040,121393,46368,144,55]
--    (0.01 secs, 536,424 bytes)
--
--    λ> length (zeckendorf3 (10^3000))
--    3947
--    (3.02 secs, 1,611,966,408 bytes)
--    λ> length (zeckendorf4 (10^2000))
--    2611
--    (0.02 secs, 10,434,336 bytes)
--
--    λ> length (zeckendorf4 (10^50000))
--    66097
--    (2.84 secs, 3,976,483,760 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

module Representacion_de_Zeckendorf where

import Data.List (subsequences)

import Test.QuickCheck

-- 1ª solución

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

zeckendorf1 :: Integer -> [Integer]

zeckendorf1 = head . zeckendorf1Aux

zeckendorf1Aux :: Integer -> [[Integer]]

zeckendorf1Aux n =

[xs | xs <- subsequences (reverse (takeWhile (<= n) (tail fibs))),

sum xs == n,

sinFibonacciConsecutivos xs]

-- fibs es la la sucesión de los números de Fibonacci. Por ejemplo,

-- take 14 fibs == [1,1,2,3,5,8,13,21,34,55,89,144,233,377]

fibs :: [Integer]

fibs = 1 : scanl (+) 1 fibs

-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión

-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por

-- ejemplo,

-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión

-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por

-- ejemplo,

-- sinFibonacciConsecutivos [89, 8, 3] == True

-- sinFibonacciConsecutivos [55, 34, 8, 3] == False

sinFibonacciConsecutivos :: [Integer] -> Bool

sinFibonacciConsecutivos xs =

and [x /= siguienteFibonacci y | (x,y) <- zip xs (tail xs)]

-- (siguienteFibonacci n) es el menor número de Fibonacci mayor que

-- n. Por ejemplo,

-- siguienteFibonacci 34 == 55

siguienteFibonacci :: Integer -> Integer

siguienteFibonacci n =

head (dropWhile (<= n) fibs)

-- 2ª solución

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

zeckendorf2 :: Integer -> [Integer]

zeckendorf2 = head . zeckendorf2Aux

zeckendorf2Aux :: Integer -> [[Integer]]

zeckendorf2Aux n = map reverse (aux n (tail fibs))

where aux 0 _ = [[]]

aux m (x:y:zs)

| x <= m = [x:xs | xs <- aux (m-x) zs] ++ aux m (y:zs)

| otherwise = []

-- 3ª solución

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

zeckendorf3 :: Integer -> [Integer]

zeckendorf3 0 = []

zeckendorf3 n = x : zeckendorf3 (n - x)

where x = last (takeWhile (<= n) fibs)

-- 4ª solución

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

zeckendorf4 :: Integer -> [Integer]

zeckendorf4 n = aux n (reverse (takeWhile (<= n) fibs))

where aux 0 _ = []

aux m (x:xs) = x : aux (m-x) (dropWhile (>m-x) xs)

-- Comprobación de equivalencia

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

-- La propiedad es

prop_zeckendorf :: Positive Integer -> Bool

prop_zeckendorf (Positive n) =

all (== zeckendorf1 n)

[zeckendorf2 n,

zeckendorf3 n,

zeckendorf4 n]

-- La comprobación es

-- λ> quickCheck prop_zeckendorf

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> zeckendorf1 (7*10^4)

-- [46368,17711,4181,1597,89,34,13,5,2]

-- (1.49 secs, 2,380,707,744 bytes)

-- λ> zeckendorf2 (7*10^4)

-- [46368,17711,4181,1597,89,34,13,5,2]

-- (0.07 secs, 21,532,008 bytes)

-- λ> zeckendorf2 (10^6)

-- [832040,121393,46368,144,55]

-- (1.40 secs, 762,413,432 bytes)

-- λ> zeckendorf3 (10^6)

-- [832040,121393,46368,144,55]

-- (0.01 secs, 542,488 bytes)

-- λ> zeckendorf4 (10^6)

-- [832040,121393,46368,144,55]

-- (0.01 secs, 536,424 bytes)

-- λ> length (zeckendorf3 (10^3000))

-- 3947

-- (3.02 secs, 1,611,966,408 bytes)

-- λ> length (zeckendorf4 (10^2000))

-- 2611

-- (0.02 secs, 10,434,336 bytes)

-- λ> length (zeckendorf4 (10^50000))

-- 66097

-- (2.84 secs, 3,976,483,760 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Separación por posición

PorJosé A. Alonso 15-abril-202230-abril-2022

Definir la función

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

1	particion :: [a] -> ([a],[a])

tal que (particion xs) es el par cuya primera componente son los elementos de xs en posiciones pares y su segunda componente son los restantes elementos. Por ejemplo,

   particion [3,5,6,2]    ==  ([3,6],[5,2])
   particion [3,5,6,2,7]  ==  ([3,6,7],[5,2])
   particion "particion"  ==  ("priin","atco")

particion [3,5,6,2] == ([3,6],[5,2])

particion [3,5,6,2,7] == ([3,6,7],[5,2])

particion "particion" == ("priin","atco")

Soluciones

module Separacion_por_posicion where

import Data.List (partition)
import qualified Data.Vector as V ((!), fromList, length)
import Test.QuickCheck (quickCheck)

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

particion1 :: [a] -> ([a],[a])
particion1 xs = ([x | (n,x) <- nxs, even n],
                 [x | (n,x) <- nxs, odd n])
  where nxs = enumeracion xs

--(numeracion xs) es la enumeración de xs. Por ejemplo,
--    enumeracion [7,9,6,8]  ==  [(0,7),(1,9),(2,6),(3,8)]
enumeracion :: [a] -> [(Int,a)]
enumeracion = zip [0..]

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

particion2 :: [a] -> ([a],[a])
particion2 []     = ([],[])
particion2 (x:xs) = (x:zs,ys)
  where (ys,zs) = particion2 xs

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

particion3 :: [a] -> ([a],[a])
particion3 = foldr f ([],[])
  where f x (ys,zs) = (x:zs,ys)

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

particion4 :: [a] -> ([a],[a])
particion4 = foldr (\x (ys,zs) -> (x:zs,ys)) ([],[])

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

particion5 :: [a] -> ([a],[a])
particion5 xs =
  ([xs!!k | k <- [0,2..n]],
   [xs!!k | k <- [1,3..n]])
  where n = length xs - 1

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

particion6 :: [a] -> ([a],[a])
particion6 xs = (pares xs, impares xs)

-- (pares xs) es la lista de los elementos de xs en posiciones
-- pares. Por ejemplo,
--    pares [3,5,6,2]  ==  [3,6]
pares :: [a] -> [a]
pares []     = []
pares (x:xs) = x : impares xs

-- (impares xs) es la lista de los elementos de xs en posiciones
-- impares. Por ejemplo,
--    impares [3,5,6,2]  ==  [5,2]
impares :: [a] -> [a]
impares []     = []
impares (_:xs) = pares xs

-- 7ª solución
-- ===========

particion7 :: [a] -> ([a],[a])
particion7 [] = ([],[])
particion7 xs =
  ([v V.! k | k <- [0,2..n-1]],
   [v V.! k | k <- [1,3..n-1]])
  where v = V.fromList xs
        n = V.length v

-- 8ª solución
-- ===========

particion8 :: [a] -> ([a],[a])
particion8 xs =
  (map snd ys, map snd zs)
  where (ys,zs) = partition posicionPar (zip [0..] xs)

posicionPar :: (Int,a) -> Bool
posicionPar = even . fst

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

-- La propiedad es
prop_particion :: [Int] -> Bool
prop_particion xs =
  all (== particion1 xs)
      [particion2 xs,
       particion3 xs,
       particion4 xs,
       particion5 xs,
       particion6 xs,
       particion7 xs,
       particion8 xs]

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

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

-- La comparación es
--    λ> last (snd (particion1 [1..6*10^6]))
--    6000000
--    (2.74 secs, 2,184,516,080 bytes)
--    λ> last (snd (particion2 [1..6*10^6]))
--    6000000
--    (2.02 secs, 1,992,515,880 bytes)
--    λ> last (snd (particion3 [1..6*10^6]))
--    6000000
--    (3.17 secs, 1,767,423,240 bytes)
--    λ> last (snd (particion4 [1..6*10^6]))
--    6000000
--    (3.23 secs, 1,767,423,240 bytes)
--    λ> last (snd (particion5 [1..6*10^6]))
--    6000000
--    (1.62 secs, 1,032,516,192 bytes)
--    λ> last (snd (particion5 [1..6*10^6]))
--    6000000
--    (1.33 secs, 1,032,516,192 bytes)
--    λ> last (snd (particion6 [1..6*10^6]))
--    6000000
--    (1.80 secs, 888,515,960 bytes)
--    λ> last (snd (particion7 [1..6*10^6]))
--    6000000
--    (1.29 secs, 1,166,865,672 bytes)
--    λ> last (snd (particion8 [1..6*10^6]))
--    6000000
--    (0.87 secs, 3,384,516,616 bytes)
--
--    λ> last (snd (particion5 [1..10^7]))
--    10000000
--    (1.94 secs, 1,720,516,872 bytes)
--    λ> last (snd (particion7 [1..10^7]))
--    10000000
--    (2.54 secs, 1,989,215,176 bytes)
--    λ> last (snd (particion8 [1..10^7]))
--    10000000
--    (1.33 secs, 5,640,516,960 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

module Separacion_por_posicion where

import Data.List (partition)

import qualified Data.Vector as V ((!), fromList, length)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

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

particion1 xs = ([x | (n,x) <- nxs, even n],

[x | (n,x) <- nxs, odd n])

where nxs = enumeracion xs

--(numeracion xs) es la enumeración de xs. Por ejemplo,

-- enumeracion [7,9,6,8] == [(0,7),(1,9),(2,6),(3,8)]

enumeracion :: [a] -> [(Int,a)]

enumeracion = zip [0..]

-- 2ª solución

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

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

particion2 [] = ([],[])

particion2 (x:xs) = (x:zs,ys)

where (ys,zs) = particion2 xs

-- 3ª solución

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

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

particion3 = foldr f ([],[])

where f x (ys,zs) = (x:zs,ys)

-- 4ª solución

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

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

particion4 = foldr (\x (ys,zs) -> (x:zs,ys)) ([],[])

-- 5ª solución

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

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

particion5 xs =

([xs!!k | k <- [0,2..n]],

[xs!!k | k <- [1,3..n]])

where n = length xs - 1

-- 6ª solución

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

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

particion6 xs = (pares xs, impares xs)

-- (pares xs) es la lista de los elementos de xs en posiciones

-- pares. Por ejemplo,

-- pares [3,5,6,2] == [3,6]

pares :: [a] -> [a]

pares [] = []

pares (x:xs) = x : impares xs

-- (impares xs) es la lista de los elementos de xs en posiciones

-- impares. Por ejemplo,

-- impares [3,5,6,2] == [5,2]

impares :: [a] -> [a]

impares [] = []

impares (_:xs) = pares xs

-- 7ª solución

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

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

particion7 [] = ([],[])

particion7 xs =

([v V.! k | k <- [0,2..n-1]],

[v V.! k | k <- [1,3..n-1]])

where v = V.fromList xs

n = V.length v

-- 8ª solución

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

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

particion8 xs =

(map snd ys, map snd zs)

where (ys,zs) = partition posicionPar (zip [0..] xs)

posicionPar :: (Int,a) -> Bool

posicionPar = even . fst

-- Comprobación de equivalencia

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

-- La propiedad es

prop_particion :: [Int] -> Bool

prop_particion xs =

all (== particion1 xs)

[particion2 xs,

particion3 xs,

particion4 xs,

particion5 xs,

particion6 xs,

particion7 xs,

particion8 xs]

-- La comprobación es

-- λ> quickCheck prop_particion

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (snd (particion1 [1..6*10^6]))

-- 6000000

-- (2.74 secs, 2,184,516,080 bytes)

-- λ> last (snd (particion2 [1..6*10^6]))

-- 6000000

-- (2.02 secs, 1,992,515,880 bytes)

-- λ> last (snd (particion3 [1..6*10^6]))

-- 6000000

-- (3.17 secs, 1,767,423,240 bytes)

-- λ> last (snd (particion4 [1..6*10^6]))

-- 6000000

-- (3.23 secs, 1,767,423,240 bytes)

-- λ> last (snd (particion5 [1..6*10^6]))

-- 6000000

-- (1.62 secs, 1,032,516,192 bytes)

-- λ> last (snd (particion5 [1..6*10^6]))

-- 6000000

-- (1.33 secs, 1,032,516,192 bytes)

-- λ> last (snd (particion6 [1..6*10^6]))

-- 6000000

-- (1.80 secs, 888,515,960 bytes)

-- λ> last (snd (particion7 [1..6*10^6]))

-- 6000000

-- (1.29 secs, 1,166,865,672 bytes)

-- λ> last (snd (particion8 [1..6*10^6]))

-- 6000000

-- (0.87 secs, 3,384,516,616 bytes)

-- λ> last (snd (particion5 [1..10^7]))

-- 10000000

-- (1.94 secs, 1,720,516,872 bytes)

-- λ> last (snd (particion7 [1..10^7]))

-- 10000000

-- (2.54 secs, 1,989,215,176 bytes)

-- λ> last (snd (particion8 [1..10^7]))

-- 10000000

-- (1.33 secs, 5,640,516,960 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Nuevas soluciones

En los comentarios se pueden escribir nuevas soluciones.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Hojas con caminos no decrecientes

PorJosé A. Alonso 17-abril-202029-abril-2020

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

   data Arbol = N Int [Arbol]
     deriving Show

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

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

/ \ 8 3 8 3

2 6 /|\ /|\ |

/ \ / \ 4 2 6 4 5 6 2

4 5 5 7

se representan por

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

ej1, ej2, ej3 :: Arbol

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 6 [N 5 [], N 7 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 2 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 2 []]]

Definir la función

   hojasEnNoDecreciente :: Arbol -> [Int]

1	hojasEnNoDecreciente :: Arbol -> [Int]

tal que (hojasEnNoDecreciente a) es el conjunto de las hojas de a que se encuentran en alguna rama no decreciente. Por ejemplo,

   hojasEnNoDecreciente ej1  ==  [4,5,7]
   hojasEnNoDecreciente ej2  ==  [4,6,8]
   hojasEnNoDecreciente ej3  ==  []

hojasEnNoDecreciente ej1 == [4,5,7]

hojasEnNoDecreciente ej2 == [4,6,8]

hojasEnNoDecreciente ej3 == []

Soluciones

import Data.List (sort, nub)

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

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

hojasEnNoDecreciente :: Arbol -> [Int]
hojasEnNoDecreciente a =
  sort (nub (map last (ramasNoDecrecientes a)))

--    ramasNoDecrecientes ej1  ==  [[1,2,4],[1,2,5],[1,6,7]]
--    ramasNoDecrecientes ej2  ==  [[1,8],[1,3,4],[1,3,6]]
--    ramasNoDecrecientes ej3  ==  []
ramasNoDecrecientes :: Arbol -> [[Int]]
ramasNoDecrecientes a =
  filter esNoDecreciente (ramas a)

-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,
--    λ> ramas ej1
--    [[1,2,4],[1,2,5],[1,6,5],[1,6,7]]
--    λ> ramas ej2
--    [[1,8],[1,3,4],[1,3,2],[1,3,6]]
--    λ> ramas ej3
--    [[1,8,4],[1,8,5],[1,8,6],[1,3,2]]
ramas :: Arbol -> [[Int]]
ramas (N x []) = [[x]]
ramas (N x as) = map (x:) (concatMap ramas as)

-- (esNoDecreciente xs) se verifica si la lista xs es no
-- decreciente. Por ejemplo, 
--    esNoDecreciente [1,3,3,5]  ==  True
--    esNoDecreciente [1,3,5,3]  ==  False
esNoDecreciente :: [Int] -> Bool
esNoDecreciente xs =
  and (zipWith (<=) xs (tail xs))

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

--    hojasEnNoDecreciente ej1  ==  [4,5,7]
--    hojasEnNoDecreciente ej2  ==  [4,6,8]
--    hojasEnNoDecreciente ej3  ==  []
hojasEnNoDecreciente2 :: Arbol -> [Int]
hojasEnNoDecreciente2 = sort . nub . aux
  where
    aux (N x []) = [x]
    aux (N x as) = concat [aux (N y bs) | (N y bs) <- as, x <= y]

import Data.List (sort, nub)

data Arbol = N Int [Arbol]

deriving Show

ej1, ej2, ej3 :: Arbol

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 6 [N 5 [], N 7 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 2 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 2 []]]

-- 1ª solución

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

hojasEnNoDecreciente :: Arbol -> [Int]

hojasEnNoDecreciente a =

sort (nub (map last (ramasNoDecrecientes a)))

-- ramasNoDecrecientes ej1 == [[1,2,4],[1,2,5],[1,6,7]]

-- ramasNoDecrecientes ej2 == [[1,8],[1,3,4],[1,3,6]]

-- ramasNoDecrecientes ej3 == []

ramasNoDecrecientes :: Arbol -> [[Int]]

ramasNoDecrecientes a =

filter esNoDecreciente (ramas a)

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

-- λ> ramas ej1

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

-- λ> ramas ej2

-- [[1,8],[1,3,4],[1,3,2],[1,3,6]]

-- λ> ramas ej3

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

ramas :: Arbol -> [[Int]]

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

ramas (N x as) = map (x:) (concatMap ramas as)

-- (esNoDecreciente xs) se verifica si la lista xs es no

-- decreciente. Por ejemplo,

-- esNoDecreciente [1,3,3,5] == True

-- esNoDecreciente [1,3,5,3] == False

esNoDecreciente :: [Int] -> Bool

esNoDecreciente xs =

and (zipWith (<=) xs (tail xs))

-- 2ª solución

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

-- hojasEnNoDecreciente ej1 == [4,5,7]

-- hojasEnNoDecreciente ej2 == [4,6,8]

-- hojasEnNoDecreciente ej3 == []

hojasEnNoDecreciente2 :: Arbol -> [Int]

hojasEnNoDecreciente2 = sort . nub . aux

where

aux (N x []) = [x]

aux (N x as) = concat [aux (N y bs) | (N y bs) <- as, x <= y]

Otras soluciones

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

La conjetura de Gilbreath

PorJosé A. Alonso 30-marzo-20206-abril-2020

Partiendo de los 5 primeros números primos y calculando el valor absoluto de la diferencia de cada dos números consecutivos hasta quedarse con un único número se obtiene la siguiente tabla:

   2, 3, 5, 7, 11
   1, 2, 2, 4 
   1, 0, 2
   1, 2 
   1

2, 3, 5, 7, 11

1, 2, 2, 4

1, 0, 2

1, 2

Se observa que todas las filas, salvo la inicial, comienzan con el número 1.

Repitiendo el proceso pero empezando con los 8 primeros números primos se obtiene la siguiente tabla:

   2, 3, 5, 7, 11, 13, 17, 19 
   1, 2, 2, 4,  2,  4,  2  
   1, 0, 2, 2,  2,  2 
   1, 2, 0, 0,  0 
   1, 2, 0, 0 
   1, 2, 0 
   1, 2 
   1

2, 3, 5, 7, 11, 13, 17, 19

1, 2, 2, 4, 2, 4, 2

1, 0, 2, 2, 2, 2

1, 2, 0, 0, 0

1, 2, 0, 0

1, 2, 0

1, 2

Se observa que, de nuevo, todas las filas, salvo la inicial, comienza con el número 1.

La conjetura de Gilbreath afirma que si escribimos la sucesión de números primos completa y después construimos las correspondientes sucesiones formadas por el valor absoluto de la resta de cada pareja de números consecutivos, entonces todas esas filas que obtenemos comienzan siempre por 1.

El objetivo de este ejercicio es comprobar experimentalmente dicha conjetura.

Para la representación, usaremos la simétrica de la que hemos comentado anteriormente; es decir,

    2
    3, 1
    5, 2, 1
    7, 2, 0, 1
   11, 4, 2, 2, 1
   13, 2, 2, 0, 2, 1
   17, 4, 2, 0, 0, 2, 1
   19, 2, 2, 0, 0, 0, 2, 1

3, 1

5, 2, 1

7, 2, 0, 1

11, 4, 2, 2, 1

13, 2, 2, 0, 2, 1

17, 4, 2, 0, 0, 2, 1

19, 2, 2, 0, 0, 0, 2, 1

en la que la primera columna son los números primos y el elemento de la fila i y columna j (con i, j > 1) es el valor absoluto de la diferencia de los elementos (i,j-1) e (i-1,j-1).

Definir las siguientes funciones

   siguiente           :: Integer -> [Integer] -> [Integer]
   triangulo           :: [[Integer]]
   conjeturaGilbreath  :: Int -> Bool

siguiente :: Integer -> [Integer] -> [Integer]

triangulo :: [[Integer]]

conjeturaGilbreath :: Int -> Bool

tales que

(siguiente x ys) es la línea siguiente de la ys que empieza por x en la tabla de Gilbreath; es decir, si ys es [y1,y2,…,yn], entonces (siguiente x ys) es [x,|y1-x|,|y2-|y1-x||,…]. Por ejemplo,

     siguiente  7 [5,2,1]               ==  [7,2,0,1]
     siguiente 29 [23,4,2,0,0,0,0,2,1]  ==  [29,6,2,0,0,0,0,0,2,1]

1 2	siguiente 7 [5,2,1] == [7,2,0,1] siguiente 29 [23,4,2,0,0,0,0,2,1] == [29,6,2,0,0,0,0,0,2,1]

triangulo es el triángulo de Gilbreath. Por ejemplo,

     λ> take 10 triangulo
     [[ 2],
      [ 3,1],
      [ 5,2,1],
      [ 7,2,0,1],
      [11,4,2,2,1],
      [13,2,2,0,2,1],
      [17,4,2,0,0,2,1],
      [19,2,2,0,0,0,2,1],
      [23,4,2,0,0,0,0,2,1],
      [29,6,2,0,0,0,0,0,2,1]]

λ> take 10 triangulo

[[ 2],

[ 3,1],

[ 5,2,1],

[ 7,2,0,1],

[11,4,2,2,1],

[13,2,2,0,2,1],

[17,4,2,0,0,2,1],

[19,2,2,0,0,0,2,1],

[23,4,2,0,0,0,0,2,1],

[29,6,2,0,0,0,0,0,2,1]]

(conjeturaGilbreath n) se verifica si se cumple la conjetura de Gilbreath para los n primeros números primos; es decir, en el triángulo de Gilbreath cuya primera columna son los n primeros números primos, todas las filas a partir de la segunda terminan en 1. Por ejemplo,

     λ> conjeturaGilbreath 1000
     True

1 2	λ> conjeturaGilbreath 1000 True

Soluciones

import Data.Numbers.Primes

siguiente :: Integer -> [Integer] -> [Integer]
siguiente x ys = scanl (\m n -> abs (m-n)) x ys 

triangulo :: [[Integer]]
triangulo = 
  [2] : [siguiente x ys | (x,ys) <- zip (tail primes) triangulo]

conjeturaGilbreath :: Int -> Bool
conjeturaGilbreath n = all p (tail (take n triangulo))
  where p xs = last xs == 1

import Data.Numbers.Primes

siguiente :: Integer -> [Integer] -> [Integer]

siguiente x ys = scanl (\m n -> abs (m-n)) x ys

triangulo :: [[Integer]]

triangulo =

[2] : [siguiente x ys | (x,ys) <- zip (tail primes) triangulo]

conjeturaGilbreath :: Int -> Bool

conjeturaGilbreath n = all p (tail (take n triangulo))

where p xs = last xs == 1

Otras soluciones

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

Pensamiento

«La simplicidad es la última sofisticación.»

Leonardo da Vinci.

Triángulo de Bell

PorJosé A. Alonso 6-febrero-202013-febrero-2020

El triágulo de Bell es el triángulo numérico, cuya primera fila es [1] y en cada fila, el primer elemento es el último de la fila anterior y el elemento en la posición j se obtiene sumando el elemento anterior de su misma fila y de la fila anterior. Sus primeras filas son

   1 
   1   2
   2   3   5
   5   7  10  15
   15 20  27  37  52
   52 67  87 114 151 203

1 2

2 3 5

5 7 10 15

15 20 27 37 52

52 67 87 114 151 203

Definir la función

   trianguloDeBell :: [[Integer]]

1	trianguloDeBell :: [[Integer]]

tal que trianguloDeBell es la lista con las filas de dicho triángulo. Por ejemplo

   λ> take 5 trianguloDeBell
   [[1],[1,2],[2,3,5],[5,7,10,15],[15,20,27,37,52]]

1 2	λ> take 5 trianguloDeBell [[1],[1,2],[2,3,5],[5,7,10,15],[15,20,27,37,52]]

Comprobar con QuickCheck que los números que aparecen en la primera columna del triángulo coinciden con los números de Bell; es decir, el primer elemento de la n-ésima fila es el n-ésimo número de Bell.

Soluciones

import Data.List (genericIndex, genericLength)
import Test.QuickCheck

trianguloDeBell :: [[Integer]]
trianguloDeBell = iterate siguiente [1]

-- (siguiente xs) es la fila siguiente de xs en el triángulo de
-- Bell. Por ejemplo,
--    siguiente [1]     ==  [1,2]
--    siguiente [1,2]   ==  [2,3,5]
--    siguiente [2,3,5] ==  [5,7,10,15]
siguiente :: [Integer] -> [Integer]
siguiente xs = last xs : zipWith (+) xs (siguiente xs)

-- Propiedad
-- =========

-- La propiedad es
prop_TrianguloDeBell :: Integer -> Property
prop_TrianguloDeBell n =
  n > 0 ==> head (trianguloDeBell `genericIndex` n) == bell n

-- (bell n) es el n-ésimo número de Bell definido en el ejercicio
-- anterior.  
bell :: Integer -> Integer
bell n = genericLength (particiones [1..n])

particiones :: [a] -> [[[a]]]
particiones [] = [[]]
particiones (x:xs) =
  concat [([x] : yss) : inserta x yss | yss <- ysss]
  where ysss = particiones xs

inserta :: a -> [[a]] -> [[[a]]]
inserta _ []       = []
inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss] 

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

import Data.List (genericIndex, genericLength)

import Test.QuickCheck

trianguloDeBell :: [[Integer]]

trianguloDeBell = iterate siguiente [1]

-- (siguiente xs) es la fila siguiente de xs en el triángulo de

-- Bell. Por ejemplo,

-- siguiente [1] == [1,2]

-- siguiente [1,2] == [2,3,5]

-- siguiente [2,3,5] == [5,7,10,15]

siguiente :: [Integer] -> [Integer]

siguiente xs = last xs : zipWith (+) xs (siguiente xs)

-- Propiedad

-- =========

-- La propiedad es

prop_TrianguloDeBell :: Integer -> Property

prop_TrianguloDeBell n =

n > 0 ==> head (trianguloDeBell `genericIndex` n) == bell n

-- (bell n) es el n-ésimo número de Bell definido en el ejercicio

-- anterior.

bell :: Integer -> Integer

bell n = genericLength (particiones [1..n])

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

particiones [] = [[]]

particiones (x:xs) =

concat [([x] : yss) : inserta x yss | yss <- ysss]

where ysss = particiones xs

inserta :: a -> [[a]] -> [[[a]]]

inserta _ [] = []

inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss]

-- La comprobación es

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

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

«La ciencia es lo que entendemos lo suficientemente bien como para explicarle a una computadora. El arte es todo lo demás.»

Donald Knuth.

Representación de Zeckendorf

Soluciones

Separación por posición

Soluciones

Nuevas soluciones

Hojas con caminos no decrecientes

Soluciones

Otras soluciones

La conjetura de Gilbreath

Soluciones

Otras soluciones

Pensamiento

Triángulo de Bell

Soluciones

Otras soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico