Recursión

Triángulo de Pascal binario

PorJosé A. Alonso 31-enero-20197-febrero-2019

Los triángulos binarios de Pascal se formas a partir de una lista de ceros y unos usando las reglas del triángulo de Pascal, donde cada uno de los números es suma módulo dos de los dos situados en diagonal por encima suyo. Por ejemplo, los triángulos binarios de Pascal correspondientes a [1,0,1,1,1] y [1,0,1,1,0] son

   1 0 1 1 1   1 0 1 1 0     
    1 1 0 0     1 1 0 1  
     0 1 0       0 1 1   
      1 1         1 0    
       0           1

1 0 1 1 1 1 0 1 1 0

1 1 0 0 1 1 0 1

0 1 0 0 1 1

1 1 1 0

0 1

Sus finales, desde el extremo inferior al extremos superior derecho, son [0,1,0,0,1] y [1,0,1,1,0], respectivamente.

Una lista es Pascal capicúa si es igual a los finales de su triángulo binario de Pascal. Por ejemplo, [1,0,1,1,0] es Pascal capicúa.

Definir las funciones

   trianguloPascalBinario :: [Int] -> [[Int]]
   pascalCapicuas         :: Int -> [[Int]]
   nPascalCapicuas        :: Int -> Integer

trianguloPascalBinario :: [Int] -> [[Int]]

pascalCapicuas :: Int -> [[Int]]

nPascalCapicuas :: Int -> Integer

tales que

(trianguloPascalBinario xs) es el triágulo binario de Pascal correspondiente a la lista xs. Por ejemplo,

     λ> trianguloPascalBinario [1,0,1,1,1]
     [[1,0,1,1,1],[1,1,0,0],[0,1,0],[1,1],[0]]
     λ> trianguloPascalBinario [1,0,1,1,0]
     [[1,0,1,1,0],[1,1,0,1],[0,1,1],[1,0],[1]]

λ> trianguloPascalBinario [1,0,1,1,1]

[[1,0,1,1,1],[1,1,0,0],[0,1,0],[1,1],[0]]

λ> trianguloPascalBinario [1,0,1,1,0]

[[1,0,1,1,0],[1,1,0,1],[0,1,1],[1,0],[1]]

(pascalCapicuas n) es la lista de listas de Pascal capicúas de n elementos. Por ejemplo,

     λ> pascalCapicuas 2
     [[0,0],[1,0]]
     λ> pascalCapicuas 3
     [[0,0,0],[0,1,0],[1,0,0],[1,1,0]]
     λ> pascalCapicuas 4
     [[0,0,0,0],[0,1,1,0],[1,0,0,0],[1,1,1,0]]

λ> pascalCapicuas 2

[[0,0],[1,0]]

λ> pascalCapicuas 3

[[0,0,0],[0,1,0],[1,0,0],[1,1,0]]

λ> pascalCapicuas 4

[[0,0,0,0],[0,1,1,0],[1,0,0,0],[1,1,1,0]]

(nPascalCapicuas n) es el número de listas de Pascal capicúas de n elementos. Por ejemplo,

     λ> nPascalCapicuas 2
     2
     λ> nPascalCapicuas 3
     4
     λ> nPascalCapicuas 4
     4
     λ> nPascalCapicuas 400
     1606938044258990275541962092341162602522202993782792835301376
     λ> length (show (nPascalCapicuas (10^5)))
     15052
     λ> length (show (nPascalCapicuas (10^6)))
     150515
     λ> length (show (nPascalCapicuas (10^7)))
     1505150

λ> nPascalCapicuas 2

λ> nPascalCapicuas 3

λ> nPascalCapicuas 4

λ> nPascalCapicuas 400

1606938044258990275541962092341162602522202993782792835301376

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

15052

λ> length (show (nPascalCapicuas (10^6)))

150515

λ> length (show (nPascalCapicuas (10^7)))

1505150

Soluciones

import Data.List (genericLength, unfoldr)

-- Definición de trianguloPascalBinario
-- ====================================

trianguloPascalBinario :: [Int] -> [[Int]]
trianguloPascalBinario xs =
  takeWhile (not . null) (iterate siguiente xs)

-- (siguiente xs) es la línea siguiente a la xs en el triángulo binario
-- de Pascal. Por ejemplo,
--    λ> siguiente [1,0,1,1,1]
--    [1,1,0,0]
--    λ> siguiente it
--    [0,1,0]
--    λ> siguiente it
--    [1,1]
--    λ> siguiente it
--    [0]
--    λ> siguiente it
--    []
--    λ> siguiente it
--    []
siguiente :: [Int] -> [Int]
siguiente xs = [(x + y) `mod` 2 | (x,y) <- zip xs (tail xs)]

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

trianguloPascalBinario2 :: [Int] -> [[Int]]
trianguloPascalBinario2 = unfoldr f 
  where f [] = Nothing
        f xs = Just (xs, siguiente xs)
 
-- Definición de pascalCapicuas
-- ============================

pascalCapicuas :: Int -> [[Int]]
pascalCapicuas n =
  [xs | xs <- inicios n
      , esPascalCapicua xs]

-- (inicios n) es la lista de longitud n formadas por ceros y unos. Por
-- ejemplo, 
--    λ> inicios 0
--    [[]]
--    λ> inicios 1
--    [[0],[1]]
--    λ> inicios 2
--    [[0,0],[0,1],[1,0],[1,1]]
--    λ> inicios 3
--    [[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]
inicios :: Int -> [[Int]]
inicios 0 = [[]]
inicios n = map (0:) xss ++ map (1:) xss
  where xss = inicios (n-1)

-- Otra forma de definir inicios es
inicios2 :: Int -> [[Int]]
inicios2 n = sucInicios !! n
  where sucInicios    = iterate siguiente [[]]
        siguiente xss = map (0:) xss ++ map (1:) xss

-- (esPascalCapicua xs) se verifica si xs es una lista de Pascal
-- capicúa. Por ejemplo, 
--    esPascalCapicua [1,0,1,1,0]  ==  True
--    esPascalCapicua [1,0,1,1,1]  ==  False
esPascalCapicua :: [Int] -> Bool
esPascalCapicua xs =
  xs == finalesTrianguloPascalBinario xs

-- (finalesTrianguloPascalBinario xs) es la inversa de la lista de los
-- finales del triángulo binarios de xs. Por ejemplo,
--    λ> finalesTrianguloPascalBinario [1,0,1,1,1]
--    [0,1,0,0,1]
finalesTrianguloPascalBinario :: [Int] -> [Int]
finalesTrianguloPascalBinario =
  reverse . map last . trianguloPascalBinario

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

nPascalCapicuas :: Int -> Integer
nPascalCapicuas =
  genericLength . pascalCapicuas

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

nPascalCapicuas2 :: Int -> Integer
nPascalCapicuas2 n =
  2 ^ ((n + 1) `div` 2)

import Data.List (genericLength, unfoldr)

-- Definición de trianguloPascalBinario

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

trianguloPascalBinario :: [Int] -> [[Int]]

trianguloPascalBinario xs =

takeWhile (not . null) (iterate siguiente xs)

-- (siguiente xs) es la línea siguiente a la xs en el triángulo binario

-- de Pascal. Por ejemplo,

-- λ> siguiente [1,0,1,1,1]

-- [1,1,0,0]

-- λ> siguiente it

-- [0,1,0]

-- λ> siguiente it

-- [1,1]

-- λ> siguiente it

-- [0]

-- λ> siguiente it

-- []

-- λ> siguiente it

-- []

siguiente :: [Int] -> [Int]

siguiente xs = [(x + y) `mod` 2 | (x,y) <- zip xs (tail xs)]

-- 2ª definición de trianguloPascalBinario

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

trianguloPascalBinario2 :: [Int] -> [[Int]]

trianguloPascalBinario2 = unfoldr f

where f [] = Nothing

f xs = Just (xs, siguiente xs)

-- Definición de pascalCapicuas

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

pascalCapicuas :: Int -> [[Int]]

pascalCapicuas n =

[xs | xs <- inicios n

, esPascalCapicua xs]

-- (inicios n) es la lista de longitud n formadas por ceros y unos. Por

-- ejemplo,

-- λ> inicios 0

-- [[]]

-- λ> inicios 1

-- [[0],[1]]

-- λ> inicios 2

-- [[0,0],[0,1],[1,0],[1,1]]

-- λ> inicios 3

-- [[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]

inicios :: Int -> [[Int]]

inicios 0 = [[]]

inicios n = map (0:) xss ++ map (1:) xss

where xss = inicios (n-1)

-- Otra forma de definir inicios es

inicios2 :: Int -> [[Int]]

inicios2 n = sucInicios !! n

where sucInicios = iterate siguiente [[]]

siguiente xss = map (0:) xss ++ map (1:) xss

-- (esPascalCapicua xs) se verifica si xs es una lista de Pascal

-- capicúa. Por ejemplo,

-- esPascalCapicua [1,0,1,1,0] == True

-- esPascalCapicua [1,0,1,1,1] == False

esPascalCapicua :: [Int] -> Bool

esPascalCapicua xs =

xs == finalesTrianguloPascalBinario xs

-- (finalesTrianguloPascalBinario xs) es la inversa de la lista de los

-- finales del triángulo binarios de xs. Por ejemplo,

-- λ> finalesTrianguloPascalBinario [1,0,1,1,1]

-- [0,1,0,0,1]

finalesTrianguloPascalBinario :: [Int] -> [Int]

finalesTrianguloPascalBinario =

reverse . map last . trianguloPascalBinario

-- 1ª definición de nPascalCapicuas

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

nPascalCapicuas :: Int -> Integer

nPascalCapicuas =

genericLength . pascalCapicuas

-- 2ª definición de nPascalCapicuas

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

nPascalCapicuas2 :: Int -> Integer

nPascalCapicuas2 n =

2 ^ ((n + 1) `div` 2)

Pensamiento

La envidia de la virtud
hizo a Caín criminal.
¡Gloria a Caín! Hoy el vicio
es lo que se envidia más.

Antonio Machado

Árboles con n elementos

PorJosé A. Alonso 29-enero-20195-febrero-2019

Los árboles binarios se pueden representar con

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

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Show, Eq)

Definir las funciones

   arboles  :: Integer -> a -> [Arbol a]
   nArboles :: [Integer]

1 2	arboles :: Integer -> a -> [Arbol a] nArboles :: [Integer]

tales que

(arboles n x) es la lista de todos los árboles binarios con n elementos iguales a x. Por ejemplo,

     λ> arboles 0 7
     []
     λ> arboles 1 7
     [H 7]
     λ> arboles 2 7
     []
     λ> arboles 3 7
     [N 7 (H 7) (H 7)]
     λ> arboles 4 7
     []
     λ> arboles 5 7
     [N 7 (H 7) (N 7 (H 7) (H 7)),N 7 (N 7 (H 7) (H 7)) (H 7)]
     λ> arboles 6 7
     []
     λ> arboles 7 7
     [N 7 (H 7) (N 7 (H 7) (N 7 (H 7) (H 7))),
      N 7 (H 7) (N 7 (N 7 (H 7) (H 7)) (H 7)),
      N 7 (N 7 (H 7) (H 7)) (N 7 (H 7) (H 7)),
      N 7 (N 7 (H 7) (N 7 (H 7) (H 7))) (H 7),
      N 7 (N 7 (N 7 (H 7) (H 7)) (H 7)) (H 7)]

λ> arboles 0 7

[]

λ> arboles 1 7

[H 7]

λ> arboles 2 7

[]

λ> arboles 3 7

[N 7 (H 7) (H 7)]

λ> arboles 4 7

[]

λ> arboles 5 7

[N 7 (H 7) (N 7 (H 7) (H 7)),N 7 (N 7 (H 7) (H 7)) (H 7)]

λ> arboles 6 7

[]

λ> arboles 7 7

[N 7 (H 7) (N 7 (H 7) (N 7 (H 7) (H 7))),

N 7 (H 7) (N 7 (N 7 (H 7) (H 7)) (H 7)),

N 7 (N 7 (H 7) (H 7)) (N 7 (H 7) (H 7)),

N 7 (N 7 (H 7) (N 7 (H 7) (H 7))) (H 7),

N 7 (N 7 (N 7 (H 7) (H 7)) (H 7)) (H 7)]

nArboles es la sucesión de los números de árboles con k elementos iguales a 7, con k ∈ {1,3,5,…}. Por ejemplo,

     λ> take 14 nArboles
     [1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900]
     λ> nArboles !! 100
     896519947090131496687170070074100632420837521538745909320
     λ> length (show (nArboles !! 1000))
     598

λ> take 14 nArboles

[1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900]

λ> nArboles !! 100

896519947090131496687170070074100632420837521538745909320

λ> length (show (nArboles !! 1000))

598

Soluciones

import Data.List (genericLength)

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

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

arboles :: Integer -> a -> [Arbol a]
arboles 0 _ = []
arboles 1 x = [H x]
arboles n x = [N x i d | k <- [0..n-1],
                         i <- arboles k x,
                         d <- arboles (n-1-k) x]

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

arboles2 :: Integer -> a -> [Arbol a]
arboles2 0 _ = []
arboles2 1 x = [H x]
arboles2 n x = [N x i d | k <- [1,3..n-1],
                          i <- arboles2 k x,
                          d <- arboles2 (n-1-k) x]
  
-- 1ª definición de nArboles
-- =========================

nArboles :: [Integer]
nArboles = [genericLength (arboles2 n 7) | n <- [1,3..]]

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

-- Con la definición anterior se observa que nArboles es
--    1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900
-- son los números de Catalan https://en.wikipedia.org/wiki/Catalan_number
-- Una forma de calcularlos (ver https://oeis.org/A000108) es
--     (2n)!/(n!(n+1)!)

nArboles2 :: [Integer]
nArboles2 =
  [factorial (2*n) `div` (factorial n * factorial (n+1)) | n <- [0..]]

factorial :: Integer -> Integer
factorial n = product [1..n]

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

-- 1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900

--  1
--  1 = 1*1
--  2 = 1*1  + 1*1
--  5 = 1*2  + 1*1 + 2*1
-- 14 = 1*5  + 1*2 + 2*1 + 5*1 
-- 42 = 1*14 + 1*5 + 2*2 + 5*1 + 14*1

nArboles3 :: [Integer]
nArboles3 = 1 : aux [1]
  where aux cs = c : aux (c:cs)
          where c = sum (zipWith (*) cs (reverse cs))  

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

--    λ> length (show (nArboles !! 12))
--    6
--    (6.50 secs, 1,060,563,128 bytes)
--    λ> length (show (nArboles2 !! 12))
--    6
--    (0.01 secs, 108,520 bytes)
--    λ> length (show (nArboles3 !! 12))
--    6
--    (0.01 secs, 119,096 bytes)
--
--    λ> length (show (nArboles2 !! 1000))
--    598
--    (0.01 secs, 4,796,440 bytes)
--    λ> length (show (nArboles3 !! 1000))
--    598
--    (1.66 secs, 321,771,704 bytes)

import Data.List (genericLength)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Show, Eq)

-- 1ª definición de arboles

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

arboles :: Integer -> a -> [Arbol a]

arboles 0 _ = []

arboles 1 x = [H x]

arboles n x = [N x i d | k <- [0..n-1],

i <- arboles k x,

d <- arboles (n-1-k) x]

-- 2ª definición de arboles

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

arboles2 :: Integer -> a -> [Arbol a]

arboles2 0 _ = []

arboles2 1 x = [H x]

arboles2 n x = [N x i d | k <- [1,3..n-1],

i <- arboles2 k x,

d <- arboles2 (n-1-k) x]

-- 1ª definición de nArboles

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

nArboles :: [Integer]

nArboles = [genericLength (arboles2 n 7) | n <- [1,3..]]

-- 2ª definición de nArboles

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

-- Con la definición anterior se observa que nArboles es

-- 1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900

-- son los números de Catalan https://en.wikipedia.org/wiki/Catalan_number

-- Una forma de calcularlos (ver https://oeis.org/A000108) es

-- (2n)!/(n!(n+1)!)

nArboles2 :: [Integer]

nArboles2 =

[factorial (2*n) `div` (factorial n * factorial (n+1)) | n <- [0..]]

factorial :: Integer -> Integer

factorial n = product [1..n]

-- 3ª definición de nArboles

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

-- 1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900

-- 1

-- 1 = 1*1

-- 2 = 1*1 + 1*1

-- 5 = 1*2 + 1*1 + 2*1

-- 14 = 1*5 + 1*2 + 2*1 + 5*1

-- 42 = 1*14 + 1*5 + 2*2 + 5*1 + 14*1

nArboles3 :: [Integer]

nArboles3 = 1 : aux [1]

where aux cs = c : aux (c:cs)

where c = sum (zipWith (*) cs (reverse cs))

-- Comparación de eficiencia

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

-- λ> length (show (nArboles !! 12))

-- 6

-- (6.50 secs, 1,060,563,128 bytes)

-- λ> length (show (nArboles2 !! 12))

-- 6

-- (0.01 secs, 108,520 bytes)

-- λ> length (show (nArboles3 !! 12))

-- 6

-- (0.01 secs, 119,096 bytes)

-- λ> length (show (nArboles2 !! 1000))

-- 598

-- (0.01 secs, 4,796,440 bytes)

-- λ> length (show (nArboles3 !! 1000))

-- 598

-- (1.66 secs, 321,771,704 bytes)

Pensamiento

Ni vale nada el fruto
cogido sin sazón …
Ni aunque te elogie un bruto
ha de tener razón.

Antonio Machado

Números con dígitos 1 y 2

PorJosé A. Alonso 28-enero-201926-marzo-2022

Definir las funciones

   numerosCon1y2               :: Int -> [Int]
   restosNumerosCon1y2         :: Int -> [Int]
   grafica_restosNumerosCon1y2 :: Int -> IO ()

numerosCon1y2 :: Int -> [Int]

restosNumerosCon1y2 :: Int -> [Int]

grafica_restosNumerosCon1y2 :: Int -> IO ()

tales que

(numerosCon1y2 n) es la lista ordenada de números de n dígitos que se pueden formar con los dígitos 1 y 2. Por ejemplo,

     numerosCon1y2 2  ==  [11,12,21,22] 
     numerosCon1y2 3  ==  [111,112,121,122,211,212,221,222]

1 2	numerosCon1y2 2 == [11,12,21,22] numerosCon1y2 3 == [111,112,121,122,211,212,221,222]

(restosNumerosCon1y2 n) es la lista de los restos de dividir los elementos de (restosNumerosCon1y2 n) entre 2^n. Por ejemplo,

     restosNumerosCon1y2 2 == [3,0,1,2]
     restosNumerosCon1y2 3 == [7,0,1,2,3,4,5,6]
     restosNumerosCon1y2 4 == [7,8,1,2,11,12,5,6,15,0,9,10,3,4,13,14]

restosNumerosCon1y2 2 == [3,0,1,2]

restosNumerosCon1y2 3 == [7,0,1,2,3,4,5,6]

restosNumerosCon1y2 4 == [7,8,1,2,11,12,5,6,15,0,9,10,3,4,13,14]

(graficaRestosNumerosCon1y2 n) dibuja la gráfica de los restos de dividir los elementos de (restosNumerosCon1y2 n) entre 2^n. Por ejemplo, (graficaRestosNumerosCon1y2 3) dibuja

(graficaRestosNumerosCon1y2 4) dibuja

y (graficaRestosNumerosCon1y2 5) dibuja

Nota: En la definición usar la función plotListStyle y como su segundo argumento (el PloStyle) usar

     (defaultStyle {plotType = LinesPoints,
                    lineSpec = CustomStyle [PointType 7]})

1 2	(defaultStyle {plotType = LinesPoints, lineSpec = CustomStyle [PointType 7]})

Comprobar con QuickCheck que todos los elementos de (restosNumerosCon1y2 n) son distintos.

Soluciones

import Test.QuickCheck
import Graphics.Gnuplot.Simple

-- Definición de numerosCon1y2
-- ===========================

numerosCon1y2 :: Int -> [Int]
numerosCon1y2 = map digitosAnumero . digitos

-- (dígitos n) es la lista ordenada de de listas de n elementos que
-- se pueden formar con los dígitos 1 y 2. Por ejemplo,
--    λ> digitos 2
--    [[1,1],[1,2],[2,1],[2,2]]
--    λ> digitos 3
--    [[1,1,1],[1,1,2],[1,2,1],[1,2,2],[2,1,1],[2,1,2],[2,2,1],[2,2,2]]
digitos :: Int -> [[Int]]
digitos 0 = [[]]
digitos n = map (1:) xss ++ map (2:) xss
  where xss = digitos (n-1)

-- (digitosAnumero ds) es el número cuyos dígitos son ds. Por ejemplo,
--    digitosAnumero [2,0,1,9]  ==  2019
digitosAnumero :: [Int] -> Int
digitosAnumero = read . concatMap show

-- Definición de restosNumerosCon1y2
-- =================================

restosNumerosCon1y2 :: Int -> [Int]
restosNumerosCon1y2 n =
  [x `mod` m | x <- numerosCon1y2 n]
  where m = 2^n

-- Definición de graficaRestosNumerosCon1y2
-- =========================================

graficaRestosNumerosCon1y2 :: Int -> IO ()
graficaRestosNumerosCon1y2 n =
  plotListStyle
    [ Key Nothing
    , PNG ("Numeros_con_digitos_1_y_2_" ++ show n ++ ".png")
    ]
    (defaultStyle {plotType = LinesPoints,
                   lineSpec = CustomStyle [PointType 7]})
    (restosNumerosCon1y2 n)

-- Propiedad de restosNumerosCon1y2
-- ================================

-- La propiedad
prop_restosNumerosCon1y2 :: Positive Int -> Bool
prop_restosNumerosCon1y2 (Positive n) =
  todosDistintos (restosNumerosCon1y2 n)
  where todosDistintos xs = xs == nub xs

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

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- Definición de numerosCon1y2

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

numerosCon1y2 :: Int -> [Int]

numerosCon1y2 = map digitosAnumero . digitos

-- (dígitos n) es la lista ordenada de de listas de n elementos que

-- se pueden formar con los dígitos 1 y 2. Por ejemplo,

-- λ> digitos 2

-- [[1,1],[1,2],[2,1],[2,2]]

-- λ> digitos 3

-- [[1,1,1],[1,1,2],[1,2,1],[1,2,2],[2,1,1],[2,1,2],[2,2,1],[2,2,2]]

digitos :: Int -> [[Int]]

digitos 0 = [[]]

digitos n = map (1:) xss ++ map (2:) xss

where xss = digitos (n-1)

-- (digitosAnumero ds) es el número cuyos dígitos son ds. Por ejemplo,

-- digitosAnumero [2,0,1,9] == 2019

digitosAnumero :: [Int] -> Int

digitosAnumero = read . concatMap show

-- Definición de restosNumerosCon1y2

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

restosNumerosCon1y2 :: Int -> [Int]

restosNumerosCon1y2 n =

[x `mod` m | x <- numerosCon1y2 n]

where m = 2^n

-- Definición de graficaRestosNumerosCon1y2

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

graficaRestosNumerosCon1y2 :: Int -> IO ()

graficaRestosNumerosCon1y2 n =

plotListStyle

[ Key Nothing

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

]

(defaultStyle {plotType = LinesPoints,

lineSpec = CustomStyle [PointType 7]})

(restosNumerosCon1y2 n)

-- Propiedad de restosNumerosCon1y2

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

-- La propiedad

prop_restosNumerosCon1y2 :: Positive Int -> Bool

prop_restosNumerosCon1y2 (Positive n) =

todosDistintos (restosNumerosCon1y2 n)

where todosDistintos xs = xs == nub xs

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=12}) prop_restosNumerosCon1y2

-- +++ OK, passed 100 tests.

Pensamiento

¿Para qué llamar caminos
a los surcos del azar? …
Todo el que camina anda,
como Jesús, sobre el mar.

Antonio Machado

Recorrido de árboles en espiral

PorJosé A. Alonso 25-enero-20191-febrero-2019

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

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

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

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

/ \ 8 3 8 3

2 3 /|\ /|\ |

/ \ / \ 4 5 6 4 5 6 7

4 5 6 7

se representan por

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

ej1, ej2, ej3 :: Arbol Int

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

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

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

Definir la función

   espiral :: Arbol a -> [a]

1	espiral :: Arbol a -> [a]

tal que (espiral x) es la lista de los nodos del árbol x recorridos en espiral; es decir, la raíz de x, los nodos del primer nivel de izquierda a derecha, los nodos del segundo nivel de derecha a izquierda y así sucesivamente. Por ejemplo,

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

espiral ej1 == [1,2,3,7,6,5,4]

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

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

Soluciones

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

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

espiral :: Arbol a -> [a]
espiral x =
  concat [f xs | (f,xs) <- zip (cycle [reverse,id]) (niveles x)]

-- (niveles x) es la lista de los niveles del árbol x. Por ejemplo, 
--    niveles ej1 == [[1],[8,3],[4]]
--    niveles ej2 == [[1],[8,3],[4,5,6]]
--    niveles ej3 == [[1],[8,3],[4,5,6,7]]
niveles :: Arbol a -> [[a]]
niveles x = takeWhile (not . null) [nivel n x | n <- [0..]]

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

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

espiral2 :: Arbol a -> [a]
espiral2 = 
  concat . zipWith ($) (cycle [reverse,id]) . niveles

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

espiral3 :: Arbol a -> [a]
espiral3 = concat . zipWith ($) (cycle [reverse,id]) . niveles3

niveles3 :: Arbol a -> [[a]]
niveles3 t = map (map raiz)
           . takeWhile (not . null)
           . iterate (concatMap subBosque) $ [t]

raiz :: Arbol a -> a
raiz (N x _) = x

subBosque :: Arbol a -> [Arbol a]
subBosque (N _ ts) = ts

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

espiral4 :: Arbol a -> [a]
espiral4 = concat . zipWith ($) (cycle [reverse,id]) . niveles4

niveles4 :: Arbol a -> [[a]]
niveles4 = map (map raiz)
         . takeWhile (not . null)
         . iterate (concatMap subBosque)
         . return  

-- 5ª definición
-- =============

espiral5 :: Arbol a -> [a]
espiral5 x = concat $ zipWith ($) (cycle [reverse,id]) $ niveles5 [x]

niveles5 :: [Arbol a] -> [[a]]
niveles5 [] = []
niveles5 xs = a : niveles5 (concat b)
  where (a,b) = unzip $ map (\(N x y) -> (x,y)) xs

-- 6ª definición
-- =============

espiral6 :: Arbol a -> [a]
espiral6 = concat . zipWith ($) (cycle [reverse,id]) . niveles5 . return

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

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

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

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

-- 1ª solución

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

espiral :: Arbol a -> [a]

espiral x =

concat [f xs | (f,xs) <- zip (cycle [reverse,id]) (niveles x)]

-- (niveles x) es la lista de los niveles del árbol x. Por ejemplo,

-- niveles ej1 == [[1],[8,3],[4]]

-- niveles ej2 == [[1],[8,3],[4,5,6]]

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

niveles :: Arbol a -> [[a]]

niveles x = takeWhile (not . null) [nivel n x | n <- [0..]]

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

-- nivel 0 ej1 == [1]

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

-- nivel 2 ej1 == [4]

-- nivel 4 ej1 == []

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

nivel 0 (N x _) = [x]

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

-- 2ª solución

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

espiral2 :: Arbol a -> [a]

espiral2 =

concat . zipWith ($) (cycle [reverse,id]) . niveles

-- 3ª solución

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

espiral3 :: Arbol a -> [a]

espiral3 = concat . zipWith ($) (cycle [reverse,id]) . niveles3

niveles3 :: Arbol a -> [[a]]

niveles3 t = map (map raiz)

. takeWhile (not . null)

. iterate (concatMap subBosque) $ [t]

raiz :: Arbol a -> a

raiz (N x _) = x

subBosque :: Arbol a -> [Arbol a]

subBosque (N _ ts) = ts

-- 4ª solución

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

espiral4 :: Arbol a -> [a]

espiral4 = concat . zipWith ($) (cycle [reverse,id]) . niveles4

niveles4 :: Arbol a -> [[a]]

niveles4 = map (map raiz)

. takeWhile (not . null)

. iterate (concatMap subBosque)

. return

-- 5ª definición

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

espiral5 :: Arbol a -> [a]

espiral5 x = concat $ zipWith ($) (cycle [reverse,id]) $ niveles5 [x]

niveles5 :: [Arbol a] -> [[a]]

niveles5 [] = []

niveles5 xs = a : niveles5 (concat b)

where (a,b) = unzip $ map (\(N x y) -> (x,y)) xs

-- 6ª definición

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

espiral6 :: Arbol a -> [a]

espiral6 = concat . zipWith ($) (cycle [reverse,id]) . niveles5 . return

Pensamiento

Dice la monotonía
del agua clara al caer:
un día es como otro día;
hoy es lo mismo que ayer.

Antonio Machado

Soluciones de x² = y³ = k

PorJosé A. Alonso 22-enero-201929-enero-2019

Definir la función

   soluciones :: [(Integer,Integer,Integer)]

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

tal que sus elementos son las ternas (x,y,k) de soluciones del sistema x² = y³ = k. Por ejemplo,

   λ> take 6 soluciones
   [(0,0,0),(-1,1,1),(1,1,1),(-8,4,64),(8,4,64),(-27,9,729)]
   λ> soluciones !! (6*10^5+6) 
   (27000810008100027,90001800009,729043741093514580109350437400729)

λ> take 6 soluciones

[(0,0,0),(-1,1,1),(1,1,1),(-8,4,64),(8,4,64),(-27,9,729)]

λ> soluciones !! (6*10^5+6)

(27000810008100027,90001800009,729043741093514580109350437400729)

Soluciones

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

soluciones :: [(Integer,Integer,Integer)]
soluciones = [(n^3, n^2, n^6) | n <- enteros]

-- enteros es la lista ordenada de los números enteros. Por ejemplo,
--    λ> take 20 enteros
--    [0,-1,1,-2,2,-3,3,-4,4,-5,5,-6,6,-7,7,-8,8,-9,9,-10]
enteros :: [Integer]
enteros = 0 : concat [[-x,x] | x <- [1..]]

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

soluciones2 :: [(Integer,Integer,Integer)]
soluciones2 = [(x^3,x^2,x^6) | x <- 0 : aux 1]
  where aux n  = -n : n : aux (n+1)

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

soluciones3 :: [(Integer,Integer,Integer)]
soluciones3 =
  (0,0,0) : [(x,y,k) | k <- [n^6 | n <- [1..]]  
                     , let Just x' = raiz 2 k
                     , let Just y  = raiz 3 k
                     , x <- [-x',x']]

-- (raiz n x) es es justo la raíz n-ésima del número natural x, si x es
-- una potencia n-ésima y Nothing en caso contrario. Por ejemplo,
--    raiz 2 16   ==  Just 4
--    raiz 3 216  ==  Just 6
--    raiz 5 216  ==  Nothing
raiz :: Int -> Integer -> Maybe Integer 
raiz _ 1 = Just 1
raiz n x = aux (0,x)
    where aux (a,b) | d == x    = Just c
                    | c == a    = Nothing
                    | d < x     = aux (c,b)
                    | otherwise = aux (a,c) 
              where c = (a+b) `div` 2
                    d = c^n

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

--    λ> soluciones !! (6*10^5+6)
--    (27000810008100027,90001800009,729043741093514580109350437400729)
--    (1.87 secs, 247,352,728 bytes)
--    λ> soluciones2 !! (6*10^5+6)
--    (27000810008100027,90001800009,729043741093514580109350437400729)
--    (1.44 secs, 243,012,936 bytes)
--    λ> soluciones3 !! (6*10^5+6)
--    (27000810008100027,90001800009,729043741093514580109350437400729)
--    (0.84 secs, 199,599,664 bytes)

-- 1ª solución

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

soluciones :: [(Integer,Integer,Integer)]

soluciones = [(n^3, n^2, n^6) | n <- enteros]

-- enteros es la lista ordenada de los números enteros. Por ejemplo,

-- λ> take 20 enteros

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

enteros :: [Integer]

enteros = 0 : concat [[-x,x] | x <- [1..]]

-- 2ª solución

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

soluciones2 :: [(Integer,Integer,Integer)]

soluciones2 = [(x^3,x^2,x^6) | x <- 0 : aux 1]

where aux n = -n : n : aux (n+1)

-- 3ª solución

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

soluciones3 :: [(Integer,Integer,Integer)]

soluciones3 =

(0,0,0) : [(x,y,k) | k <- [n^6 | n <- [1..]]

, let Just x' = raiz 2 k

, let Just y = raiz 3 k

, x <- [-x',x']]

-- (raiz n x) es es justo la raíz n-ésima del número natural x, si x es

-- una potencia n-ésima y Nothing en caso contrario. Por ejemplo,

-- raiz 2 16 == Just 4

-- raiz 3 216 == Just 6

-- raiz 5 216 == Nothing

raiz :: Int -> Integer -> Maybe Integer

raiz _ 1 = Just 1

raiz n x = aux (0,x)

where aux (a,b) | d == x = Just c

| c == a = Nothing

| d < x = aux (c,b)

| otherwise = aux (a,c)

where c = (a+b) `div` 2

d = c^n

-- Comparación de eficiencia

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

-- λ> soluciones !! (6*10^5+6)

-- (27000810008100027,90001800009,729043741093514580109350437400729)

-- (1.87 secs, 247,352,728 bytes)

-- λ> soluciones2 !! (6*10^5+6)

-- (27000810008100027,90001800009,729043741093514580109350437400729)

-- (1.44 secs, 243,012,936 bytes)

-- λ> soluciones3 !! (6*10^5+6)

-- (27000810008100027,90001800009,729043741093514580109350437400729)

-- (0.84 secs, 199,599,664 bytes)

Pensamiento

Leyendo a Cervantes me parece comprenderlo todo.

Antonio Machado

Intersección de listas infinitas crecientes

PorJosé A. Alonso 21-enero-201925-abril-2021

Definir la función

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

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

tal que (interseccion xss) es la intersección de la lista no vacía de listas infinitas crecientes xss; es decir, la lista de los elementos que pertenecen a todas las listas de xss. Por ejemplo,

   λ> take 10 (interseccion [[2,4..],[3,6..],[5,10..]])
   [30,60,90,120,150,180,210,240,270,300]
   λ> take 10 (interseccion [[2,5..],[3,5..],[5,7..]])
   [5,11,17,23,29,35,41,47,53,59]

λ> take 10 (interseccion [[2,4..],[3,6..],[5,10..]])

[30,60,90,120,150,180,210,240,270,300]

λ> take 10 (interseccion [[2,5..],[3,5..],[5,7..]])

[5,11,17,23,29,35,41,47,53,59]

Soluciones

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

interseccion :: Ord a => [[a]] -> [a]
interseccion [xs]        = xs
interseccion (xs:ys:zss) = interseccionDos xs (interseccion (ys:zss))

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

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

interseccion2 :: Ord a => [[a]] -> [a]
interseccion2 = foldl1 interseccionDos

-- 1ª solución

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

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

interseccion [xs] = xs

interseccion (xs:ys:zss) = interseccionDos xs (interseccion (ys:zss))

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

interseccionDos (x:xs) (y:ys)

| x == y = x : interseccionDos xs ys

| x < y = interseccionDos (dropWhile (<y) xs) (y:ys)

| otherwise = interseccionDos (x:xs) (dropWhile (<x) ys)

-- 2ª solución

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

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

interseccion2 = foldl1 interseccionDos

Pensamiento

Alguna vez he pensado
si el alma será la ausencia,
mientras más cerca más lejos;
mientras más lejos más cerca.

Antonio Machado

Mínimo número de operaciones para transformar un número en otro

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

Se considera el siguiente par de operaciones sobre los números:

multiplicar por dos
restar uno.

Dados dos números x e y se desea calcular el menor número de operaciones para transformar x en y. Por ejemplo, el menor número de operaciones para transformar el 4 en 7 es 2:

   4 ------> 8 ------> 7
      (*2)      (-1)

1 2	4 ------> 8 ------> 7 (*2) (-1)

y el menor número de operaciones para transformar 2 en 5 es 4

   2 ------> 4 ------> 3 ------> 6 ------> 5
      (*2)      (-1)      (*2)      (-1)

1 2	2 ------> 4 ------> 3 ------> 6 ------> 5 (2) (-1) (2) (-1)

Definir las siguientes funciones

   arbolOp :: Int -> Int -> Arbol
   minNOp  :: Int -> Int -> Int

1 2	arbolOp :: Int -> Int -> Arbol minNOp :: Int -> Int -> Int

tales que

(arbolOp x n) es el árbol de profundidad n obtenido aplicándole a x las dos operaciones. Por ejemplo,

    λ> arbolOp 4 1
    N 4 (H 8) (H 3)
    λ> arbolOp 4 2
    N 4 (N 8 (H 16) (H 7))
        (N 3 (H 6) (H 2))
    λ> arbolOp 2 3
    N 2 (N 4
           (N 8 (H 16) (H 7))
           (N 3 (H 6) (H 2)))
        (N 1
           (N 2 (H 4) (H 1))
           (H 0))
    λ> arbolOp 2 4
    N 2 (N 4 (N 8
                (N 16 (H 32) (H 15))
                (N 7 (H 14) (H 6)))
             (N 3
                (N 6 (H 12) (H 5))
                (N 2 (H 4) (H 1))))
        (N 1 (N 2
                (N 4 (H 8) (H 3))
                (N 1 (H 2) (H 0)))
             (H 0))

λ> arbolOp 4 1

N 4 (H 8) (H 3)

λ> arbolOp 4 2

N 4 (N 8 (H 16) (H 7))

(N 3 (H 6) (H 2))

λ> arbolOp 2 3

N 2 (N 4

(N 8 (H 16) (H 7))

(N 3 (H 6) (H 2)))

(N 1

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

(H 0))

λ> arbolOp 2 4

N 2 (N 4 (N 8

(N 16 (H 32) (H 15))

(N 7 (H 14) (H 6)))

(N 3

(N 6 (H 12) (H 5))

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

(N 1 (N 2

(N 4 (H 8) (H 3))

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

(H 0))

(minNOp x y) es el menor número de operaciones necesarias para transformar x en y. Por ejemplo,

     minNOp 4 7  ==  2
     minNOp 2 5  ==  4

1 2	minNOp 4 7 == 2 minNOp 2 5 == 4

Soluciones

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

arbolOp :: Int -> Int -> Arbol
arbolOp 0 _ = H 0
arbolOp x 0 = H x
arbolOp x n = N x (arbolOp (2 * x) (n - 1)) (arbolOp (x - 1) (n - 1))

ocurre :: Int -> Arbol -> Bool
ocurre x (H y)     = x == y
ocurre x (N y i d) = x == y || ocurre x i || ocurre x d

minNOp :: Int -> Int -> Int
minNOp x y =
  head [n | n <- [0..]
          , ocurre y (arbolOp x n)]

data Arbol = H Int

| N Int Arbol Arbol

deriving (Show, Eq)

arbolOp :: Int -> Int -> Arbol

arbolOp 0 _ = H 0

arbolOp x 0 = H x

arbolOp x n = N x (arbolOp (2 * x) (n - 1)) (arbolOp (x - 1) (n - 1))

ocurre :: Int -> Arbol -> Bool

ocurre x (H y) = x == y

ocurre x (N y i d) = x == y || ocurre x i || ocurre x d

minNOp :: Int -> Int -> Int

minNOp x y =

head [n | n <- [0..]

, ocurre y (arbolOp x n)]

Pensamiento

¿Dijiste media verdad?
Dirán que mientes dos veces
si dices la otra mitad.

Antonio Machado

Posiciones del 2019 en el número pi

PorJosé A. Alonso 17-enero-201924-enero-2019

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

   3.1415926535897932384626433832 ... 83996346460422090106105779458151

1	3.1415926535897932384626433832 ... 83996346460422090106105779458151

Definir la función

   posiciones :: String -> Int -> IO [Int]

1	posiciones :: String -> Int -> IO [Int]

tal que (posicion cs k) es es la lista de las posiciones iniciales de cs en la sucesión formada por los k primeros dígitos decimales del número pi. Por ejemplo,

   λ> posiciones "141" 1000
   [0,294]
   λ> posiciones "4159" 10000
   [1,5797,6955,9599]

λ> posiciones "141" 1000

[0,294]

λ> posiciones "4159" 10000

[1,5797,6955,9599]

Calcular la primera posición de 2019 en los decimales de pi y el número de veces que aparece 2019 en en el primer millón de decimales de pi.

Soluciones

import Data.List ( isPrefixOf
                 , findIndices
                 , tails  
                 )

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

posiciones :: String -> Int -> IO [Int]
posiciones cs k = do
  ds <- readFile "Digitos_de_pi.txt"
  return (posicionesEnLista cs (take (k-1) (drop 2 ds)))

--    posicionesEnLista "23" "234235523"  ==  [0,3,7]
posicionesEnLista :: Eq a => [a] -> [a] -> [Int]
posicionesEnLista xs ys = reverse (aux ys 0 [])
  where aux []      _ ns = ns
        aux (y:ys') n ns | xs `isPrefixOf` (y:ys') = aux ys' (n+1) (n:ns)
                         | otherwise               = aux ys' (n+1) ns

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

posiciones2 :: String -> Int -> IO [Int]
posiciones2 cs k = do
  ds <- readFile "Digitos_de_pi.txt"
  return (findIndices (cs `isPrefixOf`) (tails (take (k-1) (drop 2 ds))))

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

--    λ> length <$> posiciones "2019" (10^6)
--    112
--    (1.73 secs, 352,481,272 bytes)
--    λ> length <$> posiciones2 "2019" (10^6)
--    112
--    (0.16 secs, 144,476,384 bytes)

-- El cálculo es
--    λ> ps <- posiciones "2019" (10^6)
--    λ> head ps
--    243
--    λ> length ps
--    112
-- Por tanto, la posición de la primera ocurrencia es 243 y hay 112
-- ocurrencias. Otra forma de hacer los cálculos anteriores es
--    λ> head <$> posiciones "2019" (10^6)
--    243
--    λ> length <$> posiciones "2019" (10^6)
--    112

import Data.List ( isPrefixOf

, findIndices

, tails

)

-- 1ª definición

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

posiciones :: String -> Int -> IO [Int]

posiciones cs k = do

ds <- readFile "Digitos_de_pi.txt"

return (posicionesEnLista cs (take (k-1) (drop 2 ds)))

-- posicionesEnLista "23" "234235523" == [0,3,7]

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

posicionesEnLista xs ys = reverse (aux ys 0 [])

where aux [] _ ns = ns

aux (y:ys') n ns | xs `isPrefixOf` (y:ys') = aux ys' (n+1) (n:ns)

| otherwise = aux ys' (n+1) ns

-- 2ª definición

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

posiciones2 :: String -> Int -> IO [Int]

posiciones2 cs k = do

ds <- readFile "Digitos_de_pi.txt"

return (findIndices (cs `isPrefixOf`) (tails (take (k-1) (drop 2 ds))))

-- Comparación de eficiencia

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

-- λ> length <$> posiciones "2019" (10^6)

-- 112

-- (1.73 secs, 352,481,272 bytes)

-- λ> length <$> posiciones2 "2019" (10^6)

-- 112

-- (0.16 secs, 144,476,384 bytes)

-- El cálculo es

-- λ> ps <- posiciones "2019" (10^6)

-- λ> head ps

-- 243

-- λ> length ps

-- 112

-- Por tanto, la posición de la primera ocurrencia es 243 y hay 112

-- ocurrencias. Otra forma de hacer los cálculos anteriores es

-- λ> head <$> posiciones "2019" (10^6)

-- 243

-- λ> length <$> posiciones "2019" (10^6)

-- 112

Pensamiento

Aprendió tantas cosas, que no tuvo tiempo para pensar en ninguna de ellas.

Antonio Machado

Representación de conjuntos mediante intervalos

PorJosé A. Alonso 15-enero-201922-enero-2019

Un conjunto de números enteros se pueden representar mediante una lista ordenada de intervalos tales que la diferencia entre el menor elemento de un intervalo y el mayor elemento de su intervalo anterior es mayor que uno.

Por ejemplo, el conjunto {2, 7, 4, 3, 9, 6} se puede representar mediante la lista de intervalos [(2,4),(6,7),(9,9)] de forma que en el primer intervalo se agrupan los números 2, 3 y 4; en el segundo, los números 6 y 7 y el tercero, el número 9.

Definir la función

   intervalos :: [Int] -> [(Int,Int)]

1	intervalos :: [Int] -> [(Int,Int)]

tal que (intervalos xs) es lista ordenada de intervalos que representa
al conjunto xs. Por ejemplo,

   λ> intervalos [2,7,4,3,9,6]
   [(2,4),(6,7),(9,9)]
   λ> intervalos [180,141,174,143,142,175]
   [(141,143),(174,175),(180,180)]

λ> intervalos [2,7,4,3,9,6]

[(2,4),(6,7),(9,9)]

λ> intervalos [180,141,174,143,142,175]

[(141,143),(174,175),(180,180)]

Soluciones

import Data.List (sort)

intervalos :: [Int] -> [(Int,Int)]
intervalos = map intervalo . segmentos

-- (segmentos xs) es la lista de segmentos formados por elementos
-- consecutivos de xs. Por ejemplo,
--    segmentos [2,7,4,3,9,6]  ==  [[2,3,4],[6,7],[9]]
segmentos :: [Int] -> [[Int]]
segmentos xs = aux as [[a]]
  where aux [] zs = zs
        aux (y:ys) ((a:as):zs) | y == a-1  = aux ys ((y:a:as):zs)
                               | otherwise = aux ys ([y]:(a:as):zs)
        (a:as) = reverse (sort xs)

-- (intervalo xs) es el intervalo correspondiente al segmento xs. Por
-- ejemplo, 
--    intervalo [2,3,4]  ==  (2,4)
--    intervalo [6,7]    ==  (6,7)
--    intervalo [9]      ==  (9,9)
intervalo :: [Int] -> (Int,Int)
intervalo xs = (head xs, last xs)

import Data.List (sort)

intervalos :: [Int] -> [(Int,Int)]

intervalos = map intervalo . segmentos

-- (segmentos xs) es la lista de segmentos formados por elementos

-- consecutivos de xs. Por ejemplo,

-- segmentos [2,7,4,3,9,6] == [[2,3,4],[6,7],[9]]

segmentos :: [Int] -> [[Int]]

segmentos xs = aux as [[a]]

where aux [] zs = zs

aux (y:ys) ((a:as):zs) | y == a-1 = aux ys ((y:a:as):zs)

| otherwise = aux ys ([y]:(a:as):zs)

(a:as) = reverse (sort xs)

-- (intervalo xs) es el intervalo correspondiente al segmento xs. Por

-- ejemplo,

-- intervalo [2,3,4] == (2,4)

-- intervalo [6,7] == (6,7)

-- intervalo [9] == (9,9)

intervalo :: [Int] -> (Int,Int)

intervalo xs = (head xs, last xs)

Pensamiento

Cuando el saber se especializa, crece el volumen total de la cultura. Esta es la ilusión y el consuelo de los especialistas. ¡Lo que sabemos entre todos! ¡Oh, eso es lo que no sabe nadie!

Antonio Machado

Ofertas 3 por 2

PorJosé A. Alonso 14-enero-201921-enero-2019

En una tienda tiene la «oferta 3 por 2» de forma que cada cliente que elige 3 artículos obtiene el más barato de forma gratuita. Por ejemplo, si los precios de los artículos elegidos por un cliente son 10, 2, 4, 5 euros pagará 19 euros si agrupa los artículos en (10,2,4) y (5) o pagará 17 si lo agupa en (5,10,4) y (2).

Definir la función

   minimoConOferta :: [Int] -> Int

1	minimoConOferta :: [Int] -> Int

tal que (minimoConOferta xs) es lo mínimo que pagará el cliente si los precios de la compra son xs; es decir, lo que pagará agrupando los artículos de forma óptima para aplicar la oferta 3 por 2. Por ejemplo,

   minimoConOferta [10,2,4,5]     ==  17
   minimoConOferta [3,2,3,2]      ==  8
   minimoConOferta [6,4,5,5,5,5]  ==  21

minimoConOferta [10,2,4,5] == 17

minimoConOferta [3,2,3,2] == 8

minimoConOferta [6,4,5,5,5,5] == 21

Soluciones

import Data.List ( sort
                 , sortOn)
import Data.Ord  ( Down(..))

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

minimoConOferta :: [Int] -> Int
minimoConOferta xs = sum (sinTerceros (reverse (sort xs)))

sinTerceros :: [a] -> [a]
sinTerceros []         = []
sinTerceros [x]        = [x]
sinTerceros [x,y]      = [x,y]
sinTerceros (x:y:_:zs) = x : y : sinTerceros zs

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

minimoConOferta2 :: [Int] -> Int
minimoConOferta2 = sum . sinTerceros . reverse . sort

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

minimoConOferta3 :: [Int] -> Int
minimoConOferta3 = sum . sinTerceros . sortOn Down

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

minimoConOferta4 :: [Int] -> Int
minimoConOferta4 xs = aux (reverse (sort xs)) 0
  where aux (a:b:_:ds) n = aux ds (a+b+n)
        aux as         n = n + sum as 

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

minimoConOferta5 :: [Int] -> Int
minimoConOferta5 xs = aux (sortOn Down xs) 0
  where aux (a:b:_:ds) n = aux ds (a+b+n)
        aux as         n = n + sum as

import Data.List ( sort

, sortOn)

import Data.Ord ( Down(..))

-- 1ª solución

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

minimoConOferta :: [Int] -> Int

minimoConOferta xs = sum (sinTerceros (reverse (sort xs)))

sinTerceros :: [a] -> [a]

sinTerceros [] = []

sinTerceros [x] = [x]

sinTerceros [x,y] = [x,y]

sinTerceros (x:y:_:zs) = x : y : sinTerceros zs

-- 2ª solución

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

minimoConOferta2 :: [Int] -> Int

minimoConOferta2 = sum . sinTerceros . reverse . sort

-- 3ª solución

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

minimoConOferta3 :: [Int] -> Int

minimoConOferta3 = sum . sinTerceros . sortOn Down

-- 4ª solución

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

minimoConOferta4 :: [Int] -> Int

minimoConOferta4 xs = aux (reverse (sort xs)) 0

where aux (a:b:_:ds) n = aux ds (a+b+n)

aux as n = n + sum as

-- 5ª solución

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

minimoConOferta5 :: [Int] -> Int

minimoConOferta5 xs = aux (sortOn Down xs) 0

where aux (a:b:_:ds) n = aux ds (a+b+n)

aux as n = n + sum as

Pensamiento

Despacito y buena letra:
el hacer las cosas bien
importa más que el hacerlas.

Antonio Machado

Triángulo de Pascal binario

Soluciones

Pensamiento

Árboles con n elementos

Soluciones

Pensamiento

Números con dígitos 1 y 2

Soluciones

Pensamiento

Recorrido de árboles en espiral

Soluciones

Pensamiento

Soluciones de x² = y³ = k

Soluciones

Pensamiento

Intersección de listas infinitas crecientes

Soluciones

Pensamiento

Mínimo número de operaciones para transformar un número en otro

Soluciones

Pensamiento

Posiciones del 2019 en el número pi

Soluciones

Pensamiento

Representación de conjuntos mediante intervalos

Soluciones

Pensamiento

Ofertas 3 por 2

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico