Recursión – Página 10

Punto de inflexión

PorJosé A. Alonso 21-noviembre-201726-marzo-2022

Definir la función

   inflexion :: Ord a => [a] -> Maybe a

1	inflexion :: Ord a => [a] -> Maybe a

tal que (inflexion xs) es el primer elemento de la lista en donde se cambia de creciente a decreciente o de decreciente a creciente y Nothing si no se cambia. Por ejemplo,

   inflexion [2,2,3,5,4,6]    ==  Just 4
   inflexion [9,8,6,7,10,10]  ==  Just 7
   inflexion [2,2,3,5]        ==  Nothing
   inflexion [5,3,2,2]        ==  Nothing

inflexion [2,2,3,5,4,6] == Just 4

inflexion [9,8,6,7,10,10] == Just 7

inflexion [2,2,3,5] == Nothing

inflexion [5,3,2,2] == Nothing

Soluciones

import Data.List (find)       
import Data.Maybe (isJust, fromJust)  

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

inflexion :: Ord a => [a] -> Maybe a
inflexion (x:y:zs) 
  | x == y    = inflexion (y:zs)
  | x <  y    = decreciente (y:zs)
  | otherwise = creciente (y:zs)
inflexion _   = Nothing

-- (creciente xs) es el segundo elemento de la primera parte creciente
-- de xs y Nothing, en caso contrario. Por ejemplo,
--    creciente [4,3,5,6]    ==  Just 5
--    creciente [4,3,5,2,7]  ==  Just 5
--    creciente [4,3,2]      ==  Nothing
creciente (x:y:zs) 
  | x >= y    = creciente (y:zs)
  | otherwise = Just y
creciente _   = Nothing

-- (decreciente xs) es el segundo elemento de la primera parte
-- decreciente de xs y Nothing, en caso contrario. Por ejemplo,
--    decreciente [4,2,3,1,0]  ==  Just 2
--    decreciente [4,5,3,1,0]  ==  Just 3
--    decreciente [4,5,7]      ==  Nothing
decreciente (x:y:zs) 
  | x <= y    = decreciente (y:zs)
  | otherwise = Just y
decreciente _ = Nothing

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

inflexion2 :: Ord a => [a] -> Maybe a
inflexion2 = aux . signos 
  where aux [] = Nothing
        aux ((s,_):ys) | null zs   = Nothing
                       | otherwise = Just (snd (head zs))
          where zs = dropWhile (\(p,_) -> p == s) ys

-- (signos xs) es la lista de los pares dormado por el signo de
-- crecimiento o decrecimiento de cada elemento de xs respecto de su
-- anterior. Por ejemplo,                 
--    λ> signos [2,2,2,3,5,5,4,5,2]
--    [(1,3),(1,5),(-1,4),(1,5),(-1,2)]
signos :: Ord a => [a] -> [(Int,a)]
signos xs = [(signo x y,y) | (x,y) <- zip xs (tail xs), x /= y] 

-- (signo x y) es el signo de crecimiento o decrecimiento de y respecto
-- de x. 
signo :: Ord a => a -> a -> Int
signo x y | x > y     = 1
          | x < y     = -1
          | otherwise = 0

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

inflexion3 :: Ord  a => [a] -> Maybe a
inflexion3 (x:y:xs)
  | x == y    = inflexion3 $ y:xs
  | x < y     = buscaMenor $ y:xs
  | otherwise = buscaMayor $ y:xs
inflexion3 _  = Nothing
 
buscaMenor :: Ord a => [a] -> Maybe a
buscaMenor (y:xs)
  | isJust busca = Just (snd (fromJust busca))
  | otherwise    = Nothing
  where busca = find parDecreciente (zip (y:xs) xs)
 
buscaMayor :: Ord a => [a] -> Maybe a
buscaMayor (y:xs)
  | isJust busca = Just (snd (fromJust busca))
  | otherwise    = Nothing
  where busca = find parCreciente (zip (y:xs) xs)
 
parCreciente :: Ord a => (a,a) -> Bool
parCreciente (a,b) = a < b
 
parDecreciente :: Ord a => (a,a) -> Bool
parDecreciente (a,b) = a > b

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

--    λ> inflexion (replicate (10^7) 5 ++ [0,1])
--    Just 1
--    (4.73 secs, 3,360,141,912 bytes)
--    λ> inflexion2 (replicate (10^7) 5 ++ [0,1])
--    Just 1
--    (2.71 secs, 2,480,144,352 bytes)
--    λ> inflexion3 (replicate (10^7) 5 ++ [0,1])
--    Just 1
--    (5.06 secs, 3,360,143,680 bytes)
--    
--    λ> inflexion ([1..10^7] ++ [0,1])
--    Just 0
--    (3.60 secs, 3,120,146,728 bytes)
--    λ> inflexion2 ([1..10^7] ++ [0,1])
--    Just 0
--    (11.33 secs, 6,480,143,376 bytes)
--    λ> inflexion3 ([1..10^7] ++ [0,1])
--    Just 0
--    (3.28 secs, 3,280,140,784 bytes)
--    
--    λ> inflexion ([10^7,10^7-1..1] ++ [2,1])
--    Just 2
--    (3.62 secs, 3,200,141,784 bytes)
--    λ> inflexion2 ([10^7,10^7-1..1] ++ [2,1])
--    Just 2
--    (10.01 secs, 5,840,144,200 bytes)
--    λ> inflexion3 ([10^7,10^7-1..1] ++ [2,1])
--    Just 2
--    (3.56 secs, 3,360,145,728 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

import Data.List (find)

import Data.Maybe (isJust, fromJust)

-- 1ª solución

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

inflexion :: Ord a => [a] -> Maybe a

inflexion (x:y:zs)

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

| x < y = decreciente (y:zs)

| otherwise = creciente (y:zs)

inflexion _ = Nothing

-- (creciente xs) es el segundo elemento de la primera parte creciente

-- de xs y Nothing, en caso contrario. Por ejemplo,

-- creciente [4,3,5,6] == Just 5

-- creciente [4,3,5,2,7] == Just 5

-- creciente [4,3,2] == Nothing

creciente (x:y:zs)

| x >= y = creciente (y:zs)

| otherwise = Just y

creciente _ = Nothing

-- (decreciente xs) es el segundo elemento de la primera parte

-- decreciente de xs y Nothing, en caso contrario. Por ejemplo,

-- decreciente [4,2,3,1,0] == Just 2

-- decreciente [4,5,3,1,0] == Just 3

-- decreciente [4,5,7] == Nothing

decreciente (x:y:zs)

| x <= y = decreciente (y:zs)

| otherwise = Just y

decreciente _ = Nothing

-- 2ª solución

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

inflexion2 :: Ord a => [a] -> Maybe a

inflexion2 = aux . signos

where aux [] = Nothing

aux ((s,_):ys) | null zs = Nothing

| otherwise = Just (snd (head zs))

where zs = dropWhile (\(p,_) -> p == s) ys

-- (signos xs) es la lista de los pares dormado por el signo de

-- crecimiento o decrecimiento de cada elemento de xs respecto de su

-- anterior. Por ejemplo,

-- λ> signos [2,2,2,3,5,5,4,5,2]

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

signos :: Ord a => [a] -> [(Int,a)]

signos xs = [(signo x y,y) | (x,y) <- zip xs (tail xs), x /= y]

-- (signo x y) es el signo de crecimiento o decrecimiento de y respecto

-- de x.

signo :: Ord a => a -> a -> Int

signo x y | x > y = 1

| x < y = -1

| otherwise = 0

-- 3ª solución

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

inflexion3 :: Ord a => [a] -> Maybe a

inflexion3 (x:y:xs)

| x == y = inflexion3 $ y:xs

| x < y = buscaMenor $ y:xs

| otherwise = buscaMayor $ y:xs

inflexion3 _ = Nothing

buscaMenor :: Ord a => [a] -> Maybe a

buscaMenor (y:xs)

| isJust busca = Just (snd (fromJust busca))

| otherwise = Nothing

where busca = find parDecreciente (zip (y:xs) xs)

buscaMayor :: Ord a => [a] -> Maybe a

buscaMayor (y:xs)

| isJust busca = Just (snd (fromJust busca))

| otherwise = Nothing

where busca = find parCreciente (zip (y:xs) xs)

parCreciente :: Ord a => (a,a) -> Bool

parCreciente (a,b) = a < b

parDecreciente :: Ord a => (a,a) -> Bool

parDecreciente (a,b) = a > b

-- Comparación de eficiencia

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

-- λ> inflexion (replicate (10^7) 5 ++ [0,1])

-- Just 1

-- (4.73 secs, 3,360,141,912 bytes)

-- λ> inflexion2 (replicate (10^7) 5 ++ [0,1])

-- Just 1

-- (2.71 secs, 2,480,144,352 bytes)

-- λ> inflexion3 (replicate (10^7) 5 ++ [0,1])

-- Just 1

-- (5.06 secs, 3,360,143,680 bytes)

-- λ> inflexion ([1..10^7] ++ [0,1])

-- Just 0

-- (3.60 secs, 3,120,146,728 bytes)

-- λ> inflexion2 ([1..10^7] ++ [0,1])

-- Just 0

-- (11.33 secs, 6,480,143,376 bytes)

-- λ> inflexion3 ([1..10^7] ++ [0,1])

-- Just 0

-- (3.28 secs, 3,280,140,784 bytes)

-- λ> inflexion ([10^7,10^7-1..1] ++ [2,1])

-- Just 2

-- (3.62 secs, 3,200,141,784 bytes)

-- λ> inflexion2 ([10^7,10^7-1..1] ++ [2,1])

-- Just 2

-- (10.01 secs, 5,840,144,200 bytes)

-- λ> inflexion3 ([10^7,10^7-1..1] ++ [2,1])

-- Just 2

-- (3.56 secs, 3,360,145,728 bytes)

Cadenas de sumas de factoriales de los dígitos

PorJosé A. Alonso 17-noviembre-201725-noviembre-2017

Dado un número n se considera la sucesión cuyo primer término es n y los restantes se obtienen sumando los factoriales de los dígitos del anterior. Por ejemplo, la sucesión que empieza en 69 es

         69
     363600  (porque 6! + 9! = 363600)  
       1454  (porque 3! + 6! + 3! + 6! + 0! + 0! = 1454)
        169  (porque 1! + 4! + 5! + 4! = 169)
     363601  (porque 1! + 6! + 9! = 363601)
       1454  (porque 3! + 6! + 3! + 6! + 0! + 1! = 1454)
     ......

363600 (porque 6! + 9! = 363600)

1454 (porque 3! + 6! + 3! + 6! + 0! + 0! = 1454)

169 (porque 1! + 4! + 5! + 4! = 169)

363601 (porque 1! + 6! + 9! = 363601)

1454 (porque 3! + 6! + 3! + 6! + 0! + 1! = 1454)

......

La cadena correspondiente a un número n son los términos de la sucesión que empieza en n hasta la primera repetición de un elemento en la sucesión. Por ejemplo, la cadena de 69 es

   [69,363600,1454,169,363601,1454]

1	[69,363600,1454,169,363601,1454]

Consta de una parte no periódica ([69,363600]) y de una periódica ([1454,169,363601]).

Definir las funciones

   cadena  :: Integer -> [Integer]
   periodo :: Integer -> [Integer]

1 2	cadena :: Integer -> [Integer] periodo :: Integer -> [Integer]

tales que

(cadena n es la cadena correspondiente al número n. Por ejemplo,

      cadena 69    ==  [69,363600,1454,169,363601,1454]
      cadena 145   ==  [145,145]
      cadena 78    ==  [78,45360,871,45361,871]
      cadena 569   ==  [569,363720,5775,10320,11,2,2]
      cadena 3888  ==  [3888,120966,364324,782,45362,872,45362]
      maximum [length (cadena n) | n <- [1..5000]]  ==  61
      length (cadena 1479)                          ==  61

cadena 69 == [69,363600,1454,169,363601,1454]

cadena 145 == [145,145]

cadena 78 == [78,45360,871,45361,871]

cadena 569 == [569,363720,5775,10320,11,2,2]

cadena 3888 == [3888,120966,364324,782,45362,872,45362]

maximum [length (cadena n) | n <- [1..5000]] == 61

length (cadena 1479) == 61

(periodo n) es la parte periódica de la cadena de n. Por ejemplo,

      periodo 69    ==  [169,363601,1454]
      periodo 145   ==  [145]
      periodo 78    ==  [45361,871]
      periodo 569   ==  [2]
      periodo 3888  ==  [872,45362]
      maximum [length (periodo n) | n <- [1..5000]]  ==  3
      length (periodo 1479)                          ==  3

periodo 69 == [169,363601,1454]

periodo 145 == [145]

periodo 78 == [45361,871]

periodo 569 == [2]

periodo 3888 == [872,45362]

maximum [length (periodo n) | n <- [1..5000]] == 3

length (periodo 1479) == 3

Soluciones

-- Definición de cadena
-- ====================

cadena :: Integer -> [Integer]
cadena n = reverse (extension [n])

extension :: [Integer] -> [Integer]
extension (n:ns)
  | m `elem` (n:ns) = m : n : ns
  | otherwise       = extension (m : n : ns)
  where m = siguiente n

siguiente :: Integer -> Integer
siguiente n =
  sum [factorial d | d <- digitos n]

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

digitos :: Integer -> [Integer]
digitos n =
  [read [c] | c <- show n]

-- Definición de periodo
-- =====================

periodo :: Integer -> [Integer]
periodo n =
  reverse (x : takeWhile (/= x) xs)
  where (x:xs) = reverse (cadena n)

-- Definición de cadena

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

cadena :: Integer -> [Integer]

cadena n = reverse (extension [n])

extension :: [Integer] -> [Integer]

extension (n:ns)

| m `elem` (n:ns) = m : n : ns

| otherwise = extension (m : n : ns)

where m = siguiente n

siguiente :: Integer -> Integer

siguiente n =

sum [factorial d | d <- digitos n]

factorial :: Integer -> Integer

factorial n =

product [1..n]

digitos :: Integer -> [Integer]

digitos n =

[read [c] | c <- show n]

-- Definición de periodo

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

periodo :: Integer -> [Integer]

periodo n =

reverse (x : takeWhile (/= x) xs)

where (x:xs) = reverse (cadena n)

Problema de las 3 jarras

PorJosé A. Alonso 28-abril-201725-abril-2021

En el problema de las tres jarras (A,B,C) se dispone de tres jarras de capacidades A, B y C litros con A > B > C y A par. Inicialmente la jarra mayor está llena y las otras dos vacías. Queremos, trasvasando adecuadamente el líquido entre las jarras, repartir por igual el contenido inicial entre las dos jarras mayores. Por ejemplo, para el problema (8,5,3) el contenido inicial es (8,0,0) y el final es (4,4,0).

Definir las funciones

   solucionesTresJarras :: Problema -> [[Estado]]
   tresJarras :: Problema -> Maybe [Estado]

1 2	solucionesTresJarras :: Problema -> [[Estado]] tresJarras :: Problema -> Maybe [Estado]

tales que

(solucionesTresJarras p) es la lista de soluciones del problema de las tres jarras p. Por ejemplo,

     λ> mapM_ print (solucionesTresJarras (4,2,1))
     [(4,0,0),(2,2,0)]
     [(4,0,0),(3,0,1),(1,2,1),(2,2,0)]
     [(4,0,0),(3,0,1),(3,1,0),(2,2,0)]
     [(4,0,0),(3,0,1),(3,1,0),(2,1,1),(2,2,0)]
     [(4,0,0),(3,0,1),(3,1,0),(2,1,1),(1,2,1),(2,2,0)]
     λ> mapM_ print (solucionesTresJarras (8,6,2))
     [(8,0,0),(2,6,0),(2,4,2),(4,4,0)]
     [(8,0,0),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(6,0,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]
     [(8,0,0),(6,0,2),(6,2,0),(2,6,0),(2,4,2),(4,4,0)]
     [(8,0,0),(2,6,0),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(2,6,0),(2,4,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(2,6,0),(2,4,2),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(6,0,2),(6,2,0),(4,2,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]
     λ> length (solucionesTresJarras (8,5,3))
     16
     λ> head (solucionesTresJarras (8,5,3))
     [(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]
     λ> length (solucionesTresJarras (8,6,5))
     0

λ> mapM_ print (solucionesTresJarras (4,2,1))

[(4,0,0),(2,2,0)]

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

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

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

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

λ> mapM_ print (solucionesTresJarras (8,6,2))

[(8,0,0),(2,6,0),(2,4,2),(4,4,0)]

[(8,0,0),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(6,0,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]

[(8,0,0),(6,0,2),(6,2,0),(2,6,0),(2,4,2),(4,4,0)]

[(8,0,0),(2,6,0),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(2,6,0),(2,4,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(2,6,0),(2,4,2),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(6,0,2),(6,2,0),(4,2,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]

λ> length (solucionesTresJarras (8,5,3))

λ> head (solucionesTresJarras (8,5,3))

[(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]

λ> length (solucionesTresJarras (8,6,5))

(tresJarras p) es una solución del problema de las tres jarras p con el mínimo mínimo número de trasvase, si p tiene solución y Nothing, en caso contrario. Por ejemplo,

     λ> tresJarras (4,2,1)
     Just [(4,0,0),(2,2,0)]
     λ> tresJarras (8,6,2)
     Just [(8,0,0),(2,6,0),(2,4,2),(4,4,0)]
     λ> tresJarras (8,5,3)
     Just [(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]
     λ> tresJarras (8,6,5)
     Nothing

λ> tresJarras (4,2,1)

Just [(4,0,0),(2,2,0)]

λ> tresJarras (8,6,2)

Just [(8,0,0),(2,6,0),(2,4,2),(4,4,0)]

λ> tresJarras (8,5,3)

Just [(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]

λ> tresJarras (8,6,5)

Nothing

Soluciones

import Data.Maybe (listToMaybe)

-- Para simplificar la notación se definen los tipos Problema y Estado
-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la
-- primera jarra, el segundo el de la segunda y el tercero el de la
-- tercera.
type Problema = (Int,Int,Int)

-- Un estado es una terna de números. El primero es el contenido de la
-- jarra de A litros, el segundo el de la de B litros y el tercero el de
-- la de C litros.
type Estado = (Int,Int,Int)

solucionesTresJarras :: Problema -> [[Estado]]
solucionesTresJarras p = busca [[inicial p]]
  where
    busca []        = []
    busca ((e:es):ns)  
      | esFinal p e = reverse (e:es) : busca ns
      | otherwise   = busca (ns ++ [e1:e:es | e1 <- sucesores p e
                                            , e1 `notElem` es])

-- (inicial p) es el estado inicial del problema p. Por ejemplo, 
--    inicial (8,5,3)  ==  (8,0,0)
inicial :: Problema -> Estado
inicial (a,_,_) = (a,0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las
-- tres jarras p. Por ejemplo,
--    esFinal (8,5,3) (4,4,0)  ==  True
--    esFinal (8,5,3) (4,0,4)  ==  False
esFinal :: Problema -> Estado -> Bool
esFinal (a,_,_) (x,y,z) =
  x == y && x + y == a

-- (sucesores p e) es la lista de los sucesores del estado e en el
-- problema de las tres jarras p. Por ejemplo, 
--    sucesores (8,5,3) (8,0,0)  ==  [(3,5,0),(5,0,3)]
--    sucesores (8,5,3) (3,5,0)  ==  [(0,5,3),(8,0,0),(3,2,3)]
sucesores :: Problema -> Estado -> [Estado]
sucesores (a,b,c) (x,y,z) =
     [(x-ab,y+ab,z)    | let ab = min x (b-y), ab > 0]
  ++ [(x-ac,y   ,z+ac) | let ac = min x (c-z), ac > 0]
  ++ [(x+ba,y-ba,z)    | let ba = min y (a-x), ba > 0]
  ++ [(x   ,y-bc,z+bc) | let bc = min y (c-z), bc > 0]
  ++ [(x+ca,y   ,z-ca) | let ca = min z (a-x), ca > 0]
  ++ [(x   ,y+cb,z-cb) | let cb = min z (b-y), cb > 0]
  
tresJarras :: Problema -> Maybe [Estado]
tresJarras p = listToMaybe (solucionesTresJarras p)

import Data.Maybe (listToMaybe)

-- Para simplificar la notación se definen los tipos Problema y Estado

-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la

-- primera jarra, el segundo el de la segunda y el tercero el de la

-- tercera.

type Problema = (Int,Int,Int)

-- Un estado es una terna de números. El primero es el contenido de la

-- jarra de A litros, el segundo el de la de B litros y el tercero el de

-- la de C litros.

type Estado = (Int,Int,Int)

solucionesTresJarras :: Problema -> [[Estado]]

solucionesTresJarras p = busca [[inicial p]]

where

busca [] = []

busca ((e:es):ns)

| esFinal p e = reverse (e:es) : busca ns

| otherwise = busca (ns ++ [e1:e:es | e1 <- sucesores p e

, e1 `notElem` es])

-- (inicial p) es el estado inicial del problema p. Por ejemplo,

-- inicial (8,5,3) == (8,0,0)

inicial :: Problema -> Estado

inicial (a,_,_) = (a,0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las

-- tres jarras p. Por ejemplo,

-- esFinal (8,5,3) (4,4,0) == True

-- esFinal (8,5,3) (4,0,4) == False

esFinal :: Problema -> Estado -> Bool

esFinal (a,_,_) (x,y,z) =

x == y && x + y == a

-- (sucesores p e) es la lista de los sucesores del estado e en el

-- problema de las tres jarras p. Por ejemplo,

-- sucesores (8,5,3) (8,0,0) == [(3,5,0),(5,0,3)]

-- sucesores (8,5,3) (3,5,0) == [(0,5,3),(8,0,0),(3,2,3)]

sucesores :: Problema -> Estado -> [Estado]

sucesores (a,b,c) (x,y,z) =

[(x-ab,y+ab,z) | let ab = min x (b-y), ab > 0]

++ [(x-ac,y ,z+ac) | let ac = min x (c-z), ac > 0]

++ [(x+ba,y-ba,z) | let ba = min y (a-x), ba > 0]

++ [(x ,y-bc,z+bc) | let bc = min y (c-z), bc > 0]

++ [(x+ca,y ,z-ca) | let ca = min z (a-x), ca > 0]

++ [(x ,y+cb,z-cb) | let cb = min z (b-y), cb > 0]

tresJarras :: Problema -> Maybe [Estado]

tresJarras p = listToMaybe (solucionesTresJarras p)

Suma de árboles por niveles

PorJosé A. Alonso 27-abril-201711-mayo-2017

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

   data Arbol = H
              | N a Arbol Arbol

1 2	data Arbol = H \| N a Arbol Arbol

Por ejemplo, los árboles

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

3 7

/ \ / \

2 4 5 8

/ \ \ / \ \

1 3 5 6 4 10

/ /

9 1

se representan por

   ej1, ej2 :: Arbol 
   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 (N 9 H H) H)) (N 8 H (N 10 (N 1 H H) H))

ej1, ej2 :: Arbol

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 (N 9 H H) H)) (N 8 H (N 10 (N 1 H H) H))

Definir la función

   suma :: Arbol -> Int

1	suma :: Arbol -> Int

tal que (suma a) es la suma de todos los nodos a una distancia par de la raíz del árbol a menos la suma de todos los nodos a una distancia impar de la raíz. Por ejemplo,

   suma ej1  ==  6
   suma ej2  ==  4

1 2	suma ej1 == 6 suma ej2 == 4

ya que

    (3 + 1+3+5) - (2+4)        = 6
    (7 + 6+4+10) - (5+8 + 9+1) = 4

1 2	(3 + 1+3+5) - (2+4) = 6 (7 + 6+4+10) - (5+8 + 9+1) = 4

Soluciones

data Arbol = H
           | N Int Arbol Arbol

ej1, ej2 :: Arbol 
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 (N 9 H H) H)) (N 8 H (N 10 (N 1 H H) H))

suma :: Arbol -> Int
suma H         = 0
suma (N x i d) = x - suma i - suma d

data Arbol = H

| N Int Arbol Arbol

ej1, ej2 :: Arbol

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 (N 9 H H) H)) (N 8 H (N 10 (N 1 H H) H))

suma :: Arbol -> Int

suma H = 0

suma (N x i d) = x - suma i - suma d

Normalización de expresiones aritméticas

PorJosé A. Alonso 26-abril-201710-mayo-2017

El siguiente tipo de dato representa expresiones construidas con variables, sumas y productos

   data Expr = Var String
             | S Expr Expr
             | P Expr Expre
             deriving (Eq, Show)

data Expr = Var String

| S Expr Expr

| P Expr Expre

deriving (Eq, Show)

Por ejemplo, x*(y+z) se representa por (P (V "x") (S (V "y") (V "z")))

Una expresión es un término si es un producto de variables. Por ejemplo, x*(y*z) es un término pero x+(y*z) ni x*(y+z) lo son.

Una expresión está en forma normal si es una suma de términos. Por ejemplo, x*(y*z) y x+(y*z) están en forma normal; pero x*(y+z) y (x+y)*(x+z) no lo están.

Definir la función

   esTermino :: Expr -> Bool
   esTermino :: Expr -> Bool
   normal    :: Expr -> Expr

esTermino :: Expr -> Bool

normal :: Expr -> Expr

tales que

(esTermino a) se verifica si a es un término. Por ejemplo,

     esTermino (V "x")                         == True
     esTermino (P (V "x") (P (V "y") (V "z"))) == True
     esTermino (P (V "x") (S (V "y") (V "z"))) == False
     esTermino (S (V "x") (P (V "y") (V "z"))) == False

esTermino (V "x") == True

esTermino (P (V "x") (P (V "y") (V "z"))) == True

esTermino (P (V "x") (S (V "y") (V "z"))) == False

esTermino (S (V "x") (P (V "y") (V "z"))) == False

(esNormal a) se verifica si a está en forma normal. Por ejemplo,

     esNormal (V "x")                                     == True
     esNormal (P (V "x") (P (V "y") (V "z")))             == True
     esNormal (S (V "x") (P (V "y") (V "z")))             == True
     esNormal (P (V "x") (S (V "y") (V "z")))             == False
     esNormal (P (S (V "x") (V "y")) (S (V "y") (V "z"))) == False
     esNormal (S (P (V "x") (V "y")) (S (V "z") (V "x"))) == True

esNormal (V "x") == True

esNormal (P (V "x") (P (V "y") (V "z"))) == True

esNormal (S (V "x") (P (V "y") (V "z"))) == True

esNormal (P (V "x") (S (V "y") (V "z"))) == False

esNormal (P (S (V "x") (V "y")) (S (V "y") (V "z"))) == False

esNormal (S (P (V "x") (V "y")) (S (V "z") (V "x"))) == True

(normal e) es la forma normal de la expresión e obtenida aplicando, mientras que sea posible, las propiedades distributivas:

     (a+b)*c = a*c+b*c
     c*(a+b) = c*a+c*b

1 2	(a+b)c = ac+bc c(a+b) = ca+cb

Por ejemplo,

     λ> normal (P (S (V "x") (V "y")) (V "z"))
     S (P (V "x") (V "z")) (P (V "y") (V "z"))
     λ> normal (P (V "z") (S (V "x") (V "y")))
     S (P (V "z") (V "x")) (P (V "z") (V "y"))
     λ> normal (P (S (V "x") (V "y")) (S (V "u") (V "v")))
     S (S (P (V "x") (V "u")) (P (V "x") (V "v"))) 
       (S (P (V "y") (V "u")) (P (V "y") (V "v")))
     λ> normal (S (P (V "x") (V "y")) (V "z"))
     S (P (V "x") (V "y")) (V "z")
     λ> normal (V "x")
     V "x"

λ> normal (P (S (V "x") (V "y")) (V "z"))

S (P (V "x") (V "z")) (P (V "y") (V "z"))

λ> normal (P (V "z") (S (V "x") (V "y")))

S (P (V "z") (V "x")) (P (V "z") (V "y"))

λ> normal (P (S (V "x") (V "y")) (S (V "u") (V "v")))

S (S (P (V "x") (V "u")) (P (V "x") (V "v")))

(S (P (V "y") (V "u")) (P (V "y") (V "v")))

λ> normal (S (P (V "x") (V "y")) (V "z"))

S (P (V "x") (V "y")) (V "z")

λ> normal (V "x")

V "x"

Comprobar con QuickCheck que para cualquier expresión e, (normal e) está en forma normal y que (normal (normal e)) es igual a (normal e).

Nota. Para la comprobación se usará el siguiente generador de expresiones aritméticas

   import Test.QuickCheck
   import Control.Monad
   
   instance Arbitrary Expr where
     arbitrary = sized arb 
       where
         arb 0         = liftM V arbitrary
         arb n | n > 0 = oneof [liftM V arbitrary,
                                liftM2 S sub sub, 
                                liftM2 P sub sub] 
           where sub = arb (n `div` 2)

import Test.QuickCheck

import Control.Monad

instance Arbitrary Expr where

arbitrary = sized arb

where

arb 0 = liftM V arbitrary

arb n | n > 0 = oneof [liftM V arbitrary,

liftM2 S sub sub,

liftM2 P sub sub]

where sub = arb (n `div` 2)

Soluciones

import Test.QuickCheck
import Control.Monad

data Expr = V String
          | S Expr Expr
          | P Expr Expr
          deriving (Eq, Show)

esTermino :: Expr -> Bool
esTermino (V _)   = True
esTermino (S _ _) = False
esTermino (P a b) = esTermino a && esTermino b

esNormal :: Expr -> Bool
esNormal (S a b) = esNormal a && esNormal b
esNormal a       = esTermino a

normal :: Expr -> Expr
normal (V v)   = V v
normal (S a b) = S (normal a) (normal b)
normal (P a b) = p (normal a) (normal b)
  where p (S a b) c = S (p a c) (p b c)
        p a (S b c) = S (p a b) (p a c)
        p a b       = P a b

prop_normal :: Expr -> Bool
prop_normal e = 
     esNormal (normal e)
  && normal (normal e) == normal e

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

instance Arbitrary Expr where
  arbitrary = sized arb 
    where
      arb 0         = liftM V arbitrary
      arb n | n > 0 = oneof [liftM V arbitrary,
                             liftM2 S sub sub, 
                             liftM2 P sub sub] 
        where sub = arb (n `div` 2)

import Test.QuickCheck

import Control.Monad

data Expr = V String

| S Expr Expr

| P Expr Expr

deriving (Eq, Show)

esTermino :: Expr -> Bool

esTermino (V _) = True

esTermino (S _ _) = False

esTermino (P a b) = esTermino a && esTermino b

esNormal :: Expr -> Bool

esNormal (S a b) = esNormal a && esNormal b

esNormal a = esTermino a

normal :: Expr -> Expr

normal (V v) = V v

normal (S a b) = S (normal a) (normal b)

normal (P a b) = p (normal a) (normal b)

where p (S a b) c = S (p a c) (p b c)

p a (S b c) = S (p a b) (p a c)

p a b = P a b

prop_normal :: Expr -> Bool

prop_normal e =

esNormal (normal e)

&& normal (normal e) == normal e

-- La comprobación es

-- λ> quickCheck prop_normal

-- +++ OK, passed 100 tests.

instance Arbitrary Expr where

arbitrary = sized arb

where

arb 0 = liftM V arbitrary

arb n | n > 0 = oneof [liftM V arbitrary,

liftM2 S sub sub,

liftM2 P sub sub]

where sub = arb (n `div` 2)

Sucesión de Recamán

PorJosé A. Alonso 24-abril-201726-marzo-2022

La sucesión de Recamán está definida como sigue:

   a(0) = 0
   a(n) = a(n-1) - n, si a(n-1) > n y no figura ya en la sucesión
   a(n) = a(n-1) + n, en caso contrario.

a(0) = 0

a(n) = a(n-1) - n, si a(n-1) > n y no figura ya en la sucesión

a(n) = a(n-1) + n, en caso contrario.

Definir las funciones

   sucRecaman :: [Int]
   invRecaman :: Int -> Int
   graficaSucRecaman :: Int -> IO ()
   graficaInvRecaman :: Int -> IO ()

sucRecaman :: [Int]

invRecaman :: Int -> Int

graficaSucRecaman :: Int -> IO ()

graficaInvRecaman :: Int -> IO ()

tales que

sucRecaman es la lista de los términos de la sucesión de Recamám. Por ejemplo,

      λ> take 25 sucRecaman3
      [0,1,3,6,2,7,13,20,12,21,11,22,10,23,9,24,8,25,43,62,42,63,41,18,42]
      λ> sucRecaman !! 1000
      3686
      λ> sucRecaman !! 1000001
      1057163

λ> take 25 sucRecaman3

[0,1,3,6,2,7,13,20,12,21,11,22,10,23,9,24,8,25,43,62,42,63,41,18,42]

λ> sucRecaman !! 1000

3686

λ> sucRecaman !! 1000001

1057163

(invRecaman n) es la primera posición de n en la sucesión de Recamán. Por ejemplo,

      invRecaman 10       ==  12
      invRecaman 3686     ==  1000
      invRecaman 1057163  ==  1000001

invRecaman 10 == 12

invRecaman 3686 == 1000

invRecaman 1057163 == 1000001

(graficaSucRecaman n) dibuja los n primeros términos de la sucesión de Recamán. Por ejemplo, (graficaSucRecaman 300) dibuja
(graficaInvRecaman n) dibuja los valores de (invRecaman k) para k entre 0 y n. Por ejemplo, (graficaInvRecaman 17) dibuja

y (graficaInvRecaman 100) dibuja

Soluciones

import qualified Data.Set as S

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

sucRecaman1 :: [Int]
sucRecaman1 = map suc1 [0..]

suc1 :: Int -> Int
suc1 0 = 0
suc1 n | y > n && y - n `notElem` ys = y - n
       | otherwise                   = y + n
  where y  = suc1 (n - 1)
        ys = [suc1 k | k <- [0..n - 1]]

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

sucRecaman2 :: [Int]
sucRecaman2 = 0:zipWith3 f sucRecaman2 [1..] (repeat sucRecaman2)
  where f y n ys | y > n && y - n `notElem` take n ys = y - n
                 | otherwise                          = y + n

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

sucRecaman3 :: [Int]
sucRecaman3 = 0 : recaman (S.singleton 0) 1 0

recaman :: S.Set Int -> Int -> Int -> [Int]
recaman s n x
  | x > n && (x-n) `S.notMember` s =
    (x-n) : recaman (S.insert (x-n) s) (n+1) (x-n)
  | otherwise =
    (x+n):recaman (S.insert (x+n) s) (n+1) (x+n) 

-- Comparación de eficiencia:
--    λ> sucRecaman1 !! 25
--    17
--    (3.76 secs, 2,394,593,952 bytes)
--    λ> sucRecaman2 !! 25
--    17
--    (0.00 secs, 0 bytes)
--    λ> sucRecaman3 !! 25
--    17
--    (0.00 secs, 0 bytes)
--
--    λ> sucRecaman2 !! (2*10^4)
--    14358
--    (2.69 secs, 6,927,559,784 bytes)
--    λ> sucRecaman3 !! (2*10^4)
--    14358
--    (0.04 secs, 0 bytes)

-- Definición de invRecaman
invRecaman :: Int -> Int
invRecaman n =
  length (takeWhile (/=n) sucRecaman3)

graficaSucRecaman :: Int -> IO ()
graficaSucRecaman n =
  plotList [Key Nothing]
           (take n sucRecaman3)

graficaInvRecaman :: Int -> IO ()
graficaInvRecaman n =
  plotList [Key Nothing]
           [invRecaman k | k <- [0..n]]

import qualified Data.Set as S

-- 1ª solución

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

sucRecaman1 :: [Int]

sucRecaman1 = map suc1 [0..]

suc1 :: Int -> Int

suc1 0 = 0

suc1 n | y > n && y - n `notElem` ys = y - n

| otherwise = y + n

where y = suc1 (n - 1)

ys = [suc1 k | k <- [0..n - 1]]

-- 2ª solución

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

sucRecaman2 :: [Int]

sucRecaman2 = 0:zipWith3 f sucRecaman2 [1..] (repeat sucRecaman2)

where f y n ys | y > n && y - n `notElem` take n ys = y - n

| otherwise = y + n

-- 3ª solución

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

sucRecaman3 :: [Int]

sucRecaman3 = 0 : recaman (S.singleton 0) 1 0

recaman :: S.Set Int -> Int -> Int -> [Int]

recaman s n x

| x > n && (x-n) `S.notMember` s =

(x-n) : recaman (S.insert (x-n) s) (n+1) (x-n)

| otherwise =

(x+n):recaman (S.insert (x+n) s) (n+1) (x+n)

-- Comparación de eficiencia:

-- λ> sucRecaman1 !! 25

-- 17

-- (3.76 secs, 2,394,593,952 bytes)

-- λ> sucRecaman2 !! 25

-- 17

-- (0.00 secs, 0 bytes)

-- λ> sucRecaman3 !! 25

-- 17

-- (0.00 secs, 0 bytes)

-- λ> sucRecaman2 !! (2*10^4)

-- 14358

-- (2.69 secs, 6,927,559,784 bytes)

-- λ> sucRecaman3 !! (2*10^4)

-- 14358

-- (0.04 secs, 0 bytes)

-- Definición de invRecaman

invRecaman :: Int -> Int

invRecaman n =

length (takeWhile (/=n) sucRecaman3)

graficaSucRecaman :: Int -> IO ()

graficaSucRecaman n =

plotList [Key Nothing]

(take n sucRecaman3)

graficaInvRecaman :: Int -> IO ()

graficaInvRecaman n =

plotList [Key Nothing]

[invRecaman k | k <- [0..n]]

Elementos con su doble en el conjunto

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

Definir la función

   conDoble :: [Int] -> [Int]

1	conDoble :: [Int] -> [Int]

tal que (conDoble xs) es la lista de los elementos del conjunto xs (representado como una lista sin elementos repetidos) cuyo doble pertenece a xs. Por ejemplo,

   conDoble [1, 4, 3, 2, 9, 7, 18, 22]  ==  [1,2,9]
   conDoble [2, 4, 8, 10]               ==  [2,4]
   conDoble [7, 5, 11, 13, 1, 3]        ==  []
   length (conDoble4 [1..10^6])         ==  500000

conDoble [1, 4, 3, 2, 9, 7, 18, 22] == [1,2,9]

conDoble [2, 4, 8, 10] == [2,4]

conDoble [7, 5, 11, 13, 1, 3] == []

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

Referencia: Basado en el problema Doubles de POJ (Peking University Online Judge System).

Soluciones

import Data.List (intersect, sort)
import qualified Data.Set as S

-- 1ª Definición
conDoble :: [Int] -> [Int]
conDoble xs =
  [x | x <- xs, 2 * x `elem` xs]

-- 2ª Definición
conDoble2 :: [Int] -> [Int]
conDoble2 xs = aux (sort xs)
  where aux [] = []
        aux (y:ys) | 2 * y `elem` xs = y : aux ys
                   | otherwise       = aux ys

-- 3ª definición
conDoble3 :: [Int] -> [Int]
conDoble3 xs =
  sort (map (`div` 2) (xs `intersect` (map (*2) xs)))

-- 4ª definición
conDoble4 :: [Int] -> [Int]
conDoble4 xs =
  S.toList (S.map (`div` 2) (ys `S.intersection` (S.map (*2) ys)))
  where ys = S.fromList xs

-- Comparación de eficiencia
--    λ> length (conDoble [1..10^4])
--    5000
--    (3.27 secs, 0 bytes)
--    λ> length (conDoble2 [1..10^4])
--    5000
--    (3.42 secs, 0 bytes)
--    λ> length (conDoble3 [1..10^4])
--    5000
--    (4.78 secs, 0 bytes)
--    λ> length (conDoble4 [1..10^4])
--    5000
--    (0.02 secs, 0 bytes)

import Data.List (intersect, sort)

import qualified Data.Set as S

-- 1ª Definición

conDoble :: [Int] -> [Int]

conDoble xs =

[x | x <- xs, 2 * x `elem` xs]

-- 2ª Definición

conDoble2 :: [Int] -> [Int]

conDoble2 xs = aux (sort xs)

where aux [] = []

aux (y:ys) | 2 * y `elem` xs = y : aux ys

| otherwise = aux ys

-- 3ª definición

conDoble3 :: [Int] -> [Int]

conDoble3 xs =

sort (map (`div` 2) (xs `intersect` (map (*2) xs)))

-- 4ª definición

conDoble4 :: [Int] -> [Int]

conDoble4 xs =

S.toList (S.map (`div` 2) (ys `S.intersection` (S.map (*2) ys)))

where ys = S.fromList xs

-- Comparación de eficiencia

-- λ> length (conDoble [1..10^4])

-- 5000

-- (3.27 secs, 0 bytes)

-- λ> length (conDoble2 [1..10^4])

-- 5000

-- (3.42 secs, 0 bytes)

-- λ> length (conDoble3 [1..10^4])

-- 5000

-- (4.78 secs, 0 bytes)

-- λ> length (conDoble4 [1..10^4])

-- 5000

-- (0.02 secs, 0 bytes)

Clases de equivalencia

PorJosé A. Alonso 13-abril-201725-abril-2021

Definir la función

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

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

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

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

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

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

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

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

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

Soluciones

import Data.Set as S

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

import Data.Set as S

clasesEquivalencia :: Ord a =>

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

clasesEquivalencia xs r

| S.null xs = empty

| otherwise = us `insert` clasesEquivalencia vs r

where (y,ys) = deleteFindMin xs

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

Agrupamiento según valores

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

Definir la función

   agrupa :: Ord c => (a -> c) -> [a] -> Map c [a]

1	agrupa :: Ord c => (a -> c) -> [a] -> Map c [a]

tal que (agrupa f xs) es el diccionario obtenido agrupando los elementos de xs según sus valores mediante la función f. Por ejemplo,

   ghci> agrupa length ["hoy", "ayer", "ana", "cosa"]
   fromList [(3,["hoy","ana"]),(4,["ayer","cosa"])]
   ghci> agrupa head ["claro", "ayer", "ana", "cosa"]
   fromList [('a',["ayer","ana"]),('c',["claro","cosa"])]

ghci> agrupa length ["hoy", "ayer", "ana", "cosa"]

fromList [(3,["hoy","ana"]),(4,["ayer","cosa"])]

ghci> agrupa head ["claro", "ayer", "ana", "cosa"]

fromList [('a',["ayer","ana"]),('c',["claro","cosa"])]

Soluciones

import qualified Data.List as L
import Data.Map

-- 1ª definición (por recursión)
agrupa1 :: Ord c => (a -> c) -> [a] -> Map c [a]
agrupa1 _ []     = empty
agrupa1 f (x:xs) = insertWith (++) (f x) [x] (agrupa1 f xs)

-- 2ª definición (por plegado)
agrupa2 :: Ord c => (a -> c) -> [a] -> Map c [a]
agrupa2 f = L.foldr (\x -> insertWith (++) (f x) [x]) empty

import qualified Data.List as L

import Data.Map

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

agrupa1 :: Ord c => (a -> c) -> [a] -> Map c [a]

agrupa1 _ [] = empty

agrupa1 f (x:xs) = insertWith (++) (f x) [x] (agrupa1 f xs)

-- 2ª definición (por plegado)

agrupa2 :: Ord c => (a -> c) -> [a] -> Map c [a]

agrupa2 f = L.foldr (\x -> insertWith (++) (f x) [x]) empty

Sumas con sumandos distintos o con sumandos impares

PorJosé A. Alonso 30-marzo-20176-abril-2017

El número 6 se puede descomponer de 4 formas distintas como suma con sumandos distintos:

   6 = 1 + 2 + 3
   6 = 1 + 5
   6 = 2 + 4
   6 = 6

6 = 1 + 2 + 3

6 = 1 + 5

6 = 2 + 4

6 = 6

y también se puede descomponer de 4 formas distintas como suma con sumandos impares:

   6 = 1 + 1 + 1 + 1 + 1 + 1
   6 = 1 + 1 + 1 + 3
   6 = 1 + 5
   6 = 3 + 3

6 = 1 + 1 + 1 + 1 + 1 + 1

6 = 1 + 1 + 1 + 3

6 = 1 + 5

6 = 3 + 3

Definir las siguientes funciones

   sumasSumandosDistintos  :: Integer -> [[Integer]]
   nSumasSumandosDistintos :: Integer -> Int
   sumasSumandosImpares    :: Integer -> [[Integer]]
   nSumasSumandosImpares   :: Integer -> Int
   igualdadDeSumas         :: Integer -> Bool

sumasSumandosDistintos :: Integer -> [[Integer]]

nSumasSumandosDistintos :: Integer -> Int

sumasSumandosImpares :: Integer -> [[Integer]]

nSumasSumandosImpares :: Integer -> Int

igualdadDeSumas :: Integer -> Bool

tales que

(sumasSumandosDistintos n) es la lista de las descomposiciones de n como sumas con sumandos distintos. Por ejemplo,

     sumasSumandosDistintos 5  ==  [[1,4],[2,3],[5]]
     sumasSumandosDistintos 6  ==  [[1,2,3],[1,5],[2,4],[6]]

1 2	sumasSumandosDistintos 5 == [[1,4],[2,3],[5]] sumasSumandosDistintos 6 == [[1,2,3],[1,5],[2,4],[6]]

(nSumasSumandosDistintos n) es el número de descomposiciones de n como sumas con sumandos distintos. Por ejemplo,

     nSumasSumandosDistintos 6  ==  4
     nSumasSumandosDistintos 7  ==  5

1 2	nSumasSumandosDistintos 6 == 4 nSumasSumandosDistintos 7 == 5

(sumasSumandosImpares n) es la lista de las descomposiones de n como sumas con sumandos impares. Por ejemplo,

     sumasSumandosImpares 5  ==  [[1,1,1,1,1],[1,1,3],[5]]
     sumasSumandosImpares 6  ==  [[1,1,1,1,1,1],[1,1,1,3],[1,5],[3,3]]

1 2	sumasSumandosImpares 5 == [[1,1,1,1,1],[1,1,3],[5]] sumasSumandosImpares 6 == [[1,1,1,1,1,1],[1,1,1,3],[1,5],[3,3]]

(nSumasSumandosImpares n) es el número de descomposiciones de n como sumas con sumandos impares. Por ejemplo,

     nSumasSumandosImpares 6  ==  4
     nSumasSumandosImpares 7  ==  5

1 2	nSumasSumandosImpares 6 == 4 nSumasSumandosImpares 7 == 5

(igualdadDeSumas n) se verifica si, para todo k entre 1 y n, las funciones nSumasSumandosDistintos y nSumasSumandosImpares son iguales. Por ejemplo,

     igualdadDeSumas 40  ==  True

1	igualdadDeSumas 40 == True

Soluciones

import Data.List (delete, nub)

-- Definiciones de sumasSumandosDistintos
-- ======================================

-- 1ª definición sumasSumandosDistintos
sumasSumandosDistintos :: Integer -> [[Integer]]
sumasSumandosDistintos n = aux n [1..n]
  where aux 0 _ = [[]]
        aux _ [] = []
        aux x ys@(y:_)
          | x < y     = []
          | x == y    = [[x]]
          | otherwise = [z : zs | z <- ys
                                , zs <- aux (x - z) (dropWhile (<=z) ys)]

-- 2ª definición de sumasSumandosDistintos
sumasSumandosDistintos2 :: Integer ->[[Integer]]
sumasSumandosDistintos2 = aux 0
  where aux i z
          | z < 0  = []
          | z == 0 = [[]]
          | z > 0  = concat [map (j:) (aux j (z-j)) | j <- [i+1..z]]

-- Definición de nSumasSumandosDistintos
-- =====================================

nSumasSumandosDistintos :: Integer -> Int
nSumasSumandosDistintos =
  length . sumasSumandosDistintos

-- Definiciones de sumasSumandosImpares
-- ====================================

-- 1ª definición de sumasSumandosImpares
sumasSumandosImpares :: Integer -> [[Integer]]
sumasSumandosImpares n = aux n [1,3..n]
  where aux n _ | n < 0 = []
        aux 0 _  = [[]]
        aux _ [] = []
        aux x zs@(y:ys) = [y:zs | zs <- aux (x-y) zs] ++ aux x ys 

-- 2ª definición de sumasSumandosImpares
sumasSumandosImpares2 :: Integer ->[[Integer]]
sumasSumandosImpares2 = aux 1
  where aux i z
          | z < 0  = []
          | z == 0 = [[]]
          | z > 0  = concat [map (j:) (aux j (z-j)) | j <-[i,i+2..z]]

-- Definición de nSumasSumandosImpares
-- ===================================

nSumasSumandosImpares :: Integer -> Int
nSumasSumandosImpares =
  length . sumasSumandosImpares

-- Definición conjunta (de josejuan)
-- =================================

-- podemos definir una gran familia de generadores de la siguiente forma
sumas :: Integer ->Integer ->Integer ->Integer ->Integer ->[[Integer]]
sumas u a b k n = s u n where
  s i z | z < 0 = []
        | z == 0 = [[]]
        | z > 0 = concat [map (j:) (s j (z - j)) | j <-[k*i+a,k*i+b..z]]
 
-- así, si queremos los distintos
sumasSumandosDistintos3 :: Integer ->[[Integer]]
sumasSumandosDistintos3 = sumas 0 1 2 1
 
-- o queremos los impares repetidos
sumasSumandosImpares3 :: Integer ->[[Integer]]
sumasSumandosImpares3 = sumas 1 0 2 1

-- Igualdad de las sumas
-- =====================

igualdadDeSumas :: Integer -> Bool
igualdadDeSumas n =
  and [nSumasSumandosDistintos k == nSumasSumandosImpares k | k <- [1..n]]

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

--    λ> length (sumasSumandosDistintos2 70)
--    29927
--    (0.57 secs, 374,604,848 bytes)
--    λ> length (sumasSumandosDistintos3 70)
--    29927
--    (0.57 secs, 352,658,200 bytes)
--    λ> length (sumasSumandosImpares 70)
--    29927
--    (8.87 secs, 5,221,638,688 bytes)
--    λ> length (sumasSumandosImpares2 70)
--    29927
--    (0.61 secs, 422,132,696 bytes)
--    λ> length (sumasSumandosImpares3 70)
--    29927
--    (0.56 secs, 412,289,336 bytes)

100

import Data.List (delete, nub)

-- Definiciones de sumasSumandosDistintos

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

-- 1ª definición sumasSumandosDistintos

sumasSumandosDistintos :: Integer -> [[Integer]]

sumasSumandosDistintos n = aux n [1..n]

where aux 0 _ = [[]]

aux _ [] = []

aux x ys@(y:_)

| x < y = []

| x == y = [[x]]

| otherwise = [z : zs | z <- ys

, zs <- aux (x - z) (dropWhile (<=z) ys)]

-- 2ª definición de sumasSumandosDistintos

sumasSumandosDistintos2 :: Integer ->[[Integer]]

sumasSumandosDistintos2 = aux 0

where aux i z

| z < 0 = []

| z == 0 = [[]]

| z > 0 = concat [map (j:) (aux j (z-j)) | j <- [i+1..z]]

-- Definición de nSumasSumandosDistintos

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

nSumasSumandosDistintos :: Integer -> Int

nSumasSumandosDistintos =

length . sumasSumandosDistintos

-- Definiciones de sumasSumandosImpares

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

-- 1ª definición de sumasSumandosImpares

sumasSumandosImpares :: Integer -> [[Integer]]

sumasSumandosImpares n = aux n [1,3..n]

where aux n _ | n < 0 = []

aux 0 _ = [[]]

aux _ [] = []

aux x zs@(y:ys) = [y:zs | zs <- aux (x-y) zs] ++ aux x ys

-- 2ª definición de sumasSumandosImpares

sumasSumandosImpares2 :: Integer ->[[Integer]]

sumasSumandosImpares2 = aux 1

where aux i z

| z < 0 = []

| z == 0 = [[]]

| z > 0 = concat [map (j:) (aux j (z-j)) | j <-[i,i+2..z]]

-- Definición de nSumasSumandosImpares

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

nSumasSumandosImpares :: Integer -> Int

nSumasSumandosImpares =

length . sumasSumandosImpares

-- Definición conjunta (de josejuan)

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

-- podemos definir una gran familia de generadores de la siguiente forma

sumas :: Integer ->Integer ->Integer ->Integer ->Integer ->[[Integer]]

sumas u a b k n = s u n where

s i z | z < 0 = []

| z == 0 = [[]]

| z > 0 = concat [map (j:) (s j (z - j)) | j <-[k*i+a,k*i+b..z]]

-- así, si queremos los distintos

sumasSumandosDistintos3 :: Integer ->[[Integer]]

sumasSumandosDistintos3 = sumas 0 1 2 1

-- o queremos los impares repetidos

sumasSumandosImpares3 :: Integer ->[[Integer]]

sumasSumandosImpares3 = sumas 1 0 2 1

-- Igualdad de las sumas

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

igualdadDeSumas :: Integer -> Bool

igualdadDeSumas n =

and [nSumasSumandosDistintos k == nSumasSumandosImpares k | k <- [1..n]]

-- Comparación de eficiencia

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

-- λ> length (sumasSumandosDistintos2 70)

-- 29927

-- (0.57 secs, 374,604,848 bytes)

-- λ> length (sumasSumandosDistintos3 70)

-- 29927

-- (0.57 secs, 352,658,200 bytes)

-- λ> length (sumasSumandosImpares 70)

-- 29927

-- (8.87 secs, 5,221,638,688 bytes)

-- λ> length (sumasSumandosImpares2 70)

-- 29927

-- (0.61 secs, 422,132,696 bytes)

-- λ> length (sumasSumandosImpares3 70)

-- 29927

-- (0.56 secs, 412,289,336 bytes)

El problema del reciclado

PorJosé A. Alonso 28-marzo-20174-abril-2017

El problema del reciclado N P consiste en lo siguiente: un grupo de personas disponen de N botellas de refresco vacía y las llevan a reciclar obteniendo una botella llena por cada P vacías; se beben inmediatamente el contenido de las botellas obtenidas y sus botellas vacías, junto con las no recicladas anteriormente, las canjean por botellas llenas. El proceso continúa hasta que no tienen suficientes botellas para canjear. El objetivo del problema es calcular el número de botellas que se han bebido.

Por ejemplo, si disponen de 10 botellas y por cada 2 obtienen 1, se producen cuatro canjeos:

en el primer canjeo entregan las 10 y obtienen 5;
en el segundo, entregan 4, le quedan 1 y obtienen 2;
en el tercero, entregan 2, le queda 1 y obtienen 1;
en el cuarto, entregan 2 y obtienen 1.

Por tanto, se han bebido 9 y le quedan 1 que no pueden canjear.

Definir la función

   reciclado :: Int -> Int -> Int

1	reciclado :: Int -> Int -> Int

tal que (reciclado n p) es el número de botellas que se beben en el reciclado comenzado con n botellas y canjeando p botellas vacías por una llena. Por ejemplo,

   reciclado  9 3  ==  4
   reciclado 10 2  ==  9

1 2	reciclado 9 3 == 4 reciclado 10 2 == 9

Referencia: Este ejercicio está basado en el problema Soda surpler de Kattis.

Soluciones

reciclado :: Int -> Int -> Int
reciclado n p = aux n 0
  where aux x k | x < p     = k
                | otherwise = aux (a+b) (k+a) 
          where (a,b) = divMod x p

reciclado :: Int -> Int -> Int

reciclado n p = aux n 0

where aux x k | x < p = k

| otherwise = aux (a+b) (k+a)

where (a,b) = divMod x p

Orden simétrico

PorJosé A. Alonso 27-marzo-20173-abril-2017

Dada una lista de cadenas ordenadas por longitud, se puede ordenar de manera simétrica colocando la primera cadena en primer lugar, la segunda en el último, la tercera en el segundo, la cuarta en el penúltimo y así sucesivamente.

Por ejemplo, dada la lista

   Pi
   Eva
   Luis
   Paula
   Alberto
   Francisco

Eva

Luis

Paula

Alberto

Francisco

su ordenación simétrica es

   Pi
   Luis
   Alberto
   Francisco
   Paula
   Eva

Luis

Alberto

Francisco

Paula

Eva

Definir la función

   simetrica :: [String] -> [String]

1	simetrica :: [String] -> [String]

tal que (simetrica xs) es la ordenación simétrica de la lista de cadenas (ordenada por longitud) xs. Por ejemplo,

   λ> simetrica ["Pi","Eva","Luis","Paula","Alberto","Francisco"]
   ["Pi","Luis","Alberto","Francisco","Paula","Eva"]
   λ> minimum $ simetrica2 [replicate k 'a' | k <- [1..2*10^6]]
   "a"

λ> simetrica ["Pi","Eva","Luis","Paula","Alberto","Francisco"]

["Pi","Luis","Alberto","Francisco","Paula","Eva"]

λ> minimum $ simetrica2 [replicate k 'a' | k <- [1..2*10^6]]

"a"

Nota: Este ejercicio está basado en el problema Symmetric order de Kattis.

Soluciones

-- 1ª definición
simetrica1 :: [String] -> [String]
simetrica1 []       = []
simetrica1 [x]      = [x]
simetrica1 (x:y:xs) = x : simetrica1 xs ++ [y]

-- 2ª definición
simetrica2 :: [String] -> [String]
simetrica2 xs = aux xs []
  where aux (x:y:xs) ys = x : aux xs (y:ys)
        aux (x:xs) ys   = x : aux xs ys
        aux [] ys       = ys


-- 3ª definición
simetrica3 :: [String] -> [String]
simetrica3 xs = aux xs []
  where aux (x:y:xs) ys = x : aux xs (y:ys)
        aux xs ys       = xs ++ ys

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

--    λ> minimum $ simetrica1 [replicate k 'a' | k <- [1..2*10^4]]
--    "a"
--    (11.30 secs, 8,600,879,688 bytes)
--    λ> minimum $ simetrica2 [replicate k 'a' | k <- [1..2*10^4]]
--    "a"
--    (0.06 secs, 12,419,568 bytes)
--    λ> minimum $ simetrica3 [replicate k 'a' | k <- [1..2*10^4]]
--    "a"
--    (0.06 secs, 11,320,264 bytes)

-- 1ª definición

simetrica1 :: [String] -> [String]

simetrica1 [] = []

simetrica1 [x] = [x]

simetrica1 (x:y:xs) = x : simetrica1 xs ++ [y]

-- 2ª definición

simetrica2 :: [String] -> [String]

simetrica2 xs = aux xs []

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

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

aux [] ys = ys

-- 3ª definición

simetrica3 :: [String] -> [String]

simetrica3 xs = aux xs []

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

aux xs ys = xs ++ ys

-- Comparación de eficiencia

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

-- λ> minimum $ simetrica1 [replicate k 'a' | k <- [1..2*10^4]]

-- "a"

-- (11.30 secs, 8,600,879,688 bytes)

-- λ> minimum $ simetrica2 [replicate k 'a' | k <- [1..2*10^4]]

-- "a"

-- (0.06 secs, 12,419,568 bytes)

-- λ> minimum $ simetrica3 [replicate k 'a' | k <- [1..2*10^4]]

-- "a"

-- (0.06 secs, 11,320,264 bytes)

Puntos alcanzables en un mapa

PorJosé A. Alonso 24-marzo-201725-abril-2021

Un mapa con dos tipos de regiones (por ejemplo, tierra y mar) se puede representar mediante una matriz de ceros y unos.

Para los ejemplos usaremos los mapas definidos por

   type Punto = (Int,Int) 
   type Mapa  = Array Punto Int
   
   mapa1, mapa2 :: Mapa
   mapa1 = listArray ((1,1),(3,4))
                     [1,1,0,0,
                      0,1,0,0,
                      1,0,0,0]
   mapa2 = listArray ((1,1),(10,20))
                     [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                      1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,
                      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
                      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
                      1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,
                      0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                      0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                      1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,
                      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]

type Punto = (Int,Int)

type Mapa = Array Punto Int

mapa1, mapa2 :: Mapa

mapa1 = listArray ((1,1),(3,4))

[1,1,0,0,

0,1,0,0,

1,0,0,0]

mapa2 = listArray ((1,1),(10,20))

[1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,

1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,

0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]

Definir las funciones

   alcanzables :: Mapa -> Punto -> [Punto]
   esAlcanzable :: Mapa -> Punto -> Punto -> Bool

1 2	alcanzables :: Mapa -> Punto -> [Punto] esAlcanzable :: Mapa -> Punto -> Punto -> Bool

tales que

(alcanzables p) es la lista de los puntos de mapa m que se pueden alcanzar a partir del punto p moviéndose en la misma región que p (es decir, a través de ceros si el elemento de m en p es un cero o a través de unos, en caso contrario) y los movimientos permitidos son ir hacia el norte, sur este u oeste (pero no en diagonal). Por ejemplo,

     alcanzables mapa1 (1,1)  ==  [(2,2),(1,2),(1,1)]
     alcanzables mapa1 (1,2)  ==  [(2,2),(1,1),(1,2)]
     alcanzables mapa1 (1,3)  ==  [(3,2),(3,4),(3,3),(2,3),(2,4),(1,4),(1,3)]
     alcanzables mapa1 (3,1)  ==  [(3,1)]

alcanzables mapa1 (1,1) == [(2,2),(1,2),(1,1)]

alcanzables mapa1 (1,2) == [(2,2),(1,1),(1,2)]

alcanzables mapa1 (1,3) == [(3,2),(3,4),(3,3),(2,3),(2,4),(1,4),(1,3)]

alcanzables mapa1 (3,1) == [(3,1)]

(esAlcanzable m p1 p2) se verifica si el punto p1 es alcanzable desde el p1 en el mapa m. Por ejemplo,

     esAlcanzable mapa1 (1,4) (3,2)    ==  True
     esAlcanzable mapa1 (1,4) (3,1)    ==  False
     esAlcanzable mapa2 (2,3) (8,16)   ==  True
     esAlcanzable mapa2 (8,1) (7,3)    ==  True
     esAlcanzable mapa2 (1,1) (10,20)  ==  False

esAlcanzable mapa1 (1,4) (3,2) == True

esAlcanzable mapa1 (1,4) (3,1) == False

esAlcanzable mapa2 (2,3) (8,16) == True

esAlcanzable mapa2 (8,1) (7,3) == True

esAlcanzable mapa2 (1,1) (10,20) == False

Nota: Este ejercicio está basado en el problema 10 kinds of people de Kattis.

Soluciones

import Data.Array

type Punto = (Int,Int) 
type Mapa  = Array Punto Int

mapa1, mapa2 :: Mapa
mapa1 = listArray ((1,1),(3,4))
                  [1,1,0,0,
                   0,1,0,0,
                   1,0,0,0]
mapa2 = listArray ((1,1),(10,20))
                  [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                   1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,
                   1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
                   1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
                   1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,
                   0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                   0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                   1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,
                   1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
                   1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]

alcanzables :: Mapa -> Punto -> [Punto]
alcanzables mapa p = aux [p] []
  where region = mapa ! p
        (_,(m,n)) = bounds mapa
        vecinos (i,j) = [(a,b) | (a,b) <- [(i,j+1),(i,j-1),(i+1,j),(i-1,j)]
                               , 1 <= a && a <= m
                               , 1 <= b && b <= n  
                               , mapa ! (a,b) == region]
        aux [] ys = ys
        aux (x:xs) ys
          | x `elem` ys = aux xs ys
          | otherwise   = aux (vecinos x ++ xs) (x:ys)    

esAlcanzable :: Mapa -> Punto -> Punto -> Bool
esAlcanzable m p1 p2 =
  p2 `elem` alcanzables m p1

import Data.Array

type Punto = (Int,Int)

type Mapa = Array Punto Int

mapa1, mapa2 :: Mapa

mapa1 = listArray ((1,1),(3,4))

[1,1,0,0,

0,1,0,0,

1,0,0,0]

mapa2 = listArray ((1,1),(10,20))

[1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,

1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,

0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]

alcanzables :: Mapa -> Punto -> [Punto]

alcanzables mapa p = aux [p] []

where region = mapa ! p

(_,(m,n)) = bounds mapa

vecinos (i,j) = [(a,b) | (a,b) <- [(i,j+1),(i,j-1),(i+1,j),(i-1,j)]

, 1 <= a && a <= m

, 1 <= b && b <= n

, mapa ! (a,b) == region]

aux [] ys = ys

aux (x:xs) ys

| x `elem` ys = aux xs ys

| otherwise = aux (vecinos x ++ xs) (x:ys)

esAlcanzable :: Mapa -> Punto -> Punto -> Bool

esAlcanzable m p1 p2 =

p2 `elem` alcanzables m p1

Representación de conjuntos mediante intervalos

PorJosé A. Alonso 22-marzo-201725-abril-2021

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

1	intervalos [2,7,4,3,9,6] == [(2,4),(6,7),(9,9)]

Nota: Este ejercicio está basado en el problema Bus numbers de Kattis

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)

Reducción de repeticiones consecutivas

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

Definir la función

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

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

tal que (reducida xs) es la lista obtenida a partir de xs de forma que si hay dos o más elementos idénticos consecutivos, borra las repeticiones y deja sólo el primer elemento. Por ejemplo,

   ghci> reducida "eesssooo essss   toodddooo"
   "eso es todo"

1 2	ghci> reducida "eesssooo essss toodddooo" "eso es todo"

Nota: Basado en el ejercicio Apaxiaaaaaaaaaaaans! de Kattis.

Soluciones

import Data.List (group)

-- 1ª solución (por recursión):
reducida1 :: Eq a => [a] -> [a]
reducida1 []     = []
reducida1 (x:xs) = x : reducida1 (dropWhile (==x) xs)

-- 2ª solución (por comprensión):
reducida2 :: Eq a => [a] -> [a]
reducida2 xs = [x | (x:_) <- group xs]

-- 3ª solución (sin argumentos):
reducida3 :: Eq a => [a] -> [a]
reducida3 = map head . group

import Data.List (group)

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

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

reducida1 [] = []

reducida1 (x:xs) = x : reducida1 (dropWhile (==x) xs)

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

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

reducida2 xs = [x | (x:_) <- group xs]

-- 3ª solución (sin argumentos):

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

reducida3 = map head . group

Por 3 o más 5

PorJosé A. Alonso 16-marzo-201720-enero-2019

El enunciado del problema Por 3 o más 5 de ¡Acepta el reto! es el siguiente

Cuenta la leyenda que un famoso matemático, tras aprender a sumar y multiplicar a la tierna edad de 3 años en apenas 5 días, se dio cuenta de que, empezando por 1, podía generar un montón de números sin más que multiplicar por 3 o sumar 5 a alguno de los que ya hubiera generado antes.

Por ejemplo, el 23 (edad a la que se casaría) lo obtuvo así: ((1 + 5) × 3) + 5
Por su parte el 77 (edad a la que tendría su primer bisnieto) lo consiguió: (((1 × 3 + 5) × 3) × 3) + 5

Por mucho que lo intentó, algunos números, sin embargo, resultaron ser imposibles de obtener, como por ejemplo el 5, el 7 o el 15.

Se dice que un número es generable si se puede escribir como una sucesión (quizá vacía) de multiplicaciones por 3 y sumas de 5 al número 1.

Definir las siguientes funciones

   generables     :: [Integer]
   generable      :: Integer -> Bool
   arbolGenerable :: Integer -> Tree Integer

generables :: [Integer]

generable :: Integer -> Bool

arbolGenerable :: Integer -> Tree Integer

tales que

generables es la sucesión de los números generables. Por ejemplo,

     λ> take 20 generables
     [1,3,6,8,9,11,13,14,16,18,19,21,23,24,26,27,28,29,31,32]
     λ> generables !! (10^6)
     1250008

λ> take 20 generables

[1,3,6,8,9,11,13,14,16,18,19,21,23,24,26,27,28,29,31,32]

λ> generables !! (10^6)

1250008

(generable x) se verifica si x es generable. Por ejemplo,

     generable 23       ==  True
     generable 77       ==  True
     generable 15       ==  False
     generable 1250008  ==  True
     generable 1250010  ==  False

generable 23 == True

generable 77 == True

generable 15 == False

generable 1250008 == True

generable 1250010 == False

(arbolGenerable x) es el árbol de los números generables menores o iguales a x. Por ejemplo,

     λ> putStrLn (drawTree (fmap show (arbolGenerable 11)))
     1
     |
     +- 3
     |  |
     |  +- 9
     |  |
     |  `- 8
     |
     `- 6
        |
        `- 11

λ> putStrLn (drawTree (fmap show (arbolGenerable 11)))

+- 3

| |

| +- 9

| |

| `- 8

`- 6

`- 11

Soluciones

import Graphics.Gnuplot.Simple

generables :: [Integer]
generables = 1 : mezcla [3 * x | x <- generables]
                        [5 + x | x <- generables]

-- (mezcla xs ys) es la lista ordenada obtenida mezclando las dos listas
-- ordenadas xs e ys, suponiendo que ambas son infinitas. 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
  | x == y    = x : mezcla xs ys
  | otherwise = y : mezcla us ys

generable :: Integer -> Bool
generable x =
  x == head (dropWhile (<x) generables)

-- 2ª definición
generable2 :: Integer -> Bool
generable2 1 = True
generable2 x =    (x `mod` 3 == 0 && generable2 (x `div` 3))
               || (x > 5 && generable2 (x - 5))

generables2 :: [Integer] 
generables2 = filter generable2 [1..]

arbolGenerable :: Integer -> Tree Integer
arbolGenerable n = aux 1
  where aux x
          | 3*x <= n && 5+x <= n = Node x [aux (3*x), aux (5+x)] 
          | 3*x <= n             = Node x [aux (3*x)]
          | 5+x <= n             = Node x [aux (5+x)]
          | otherwise            = Node x [] 

-- 3ª definición
generable3 :: Integer -> Bool
generable3 x =
  x `elem` arbolGenerable x

import Graphics.Gnuplot.Simple

generables :: [Integer]

generables = 1 : mezcla [3 * x | x <- generables]

[5 + x | x <- generables]

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

-- ordenadas xs e ys, suponiendo que ambas son infinitas. 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

| x == y = x : mezcla xs ys

| otherwise = y : mezcla us ys

generable :: Integer -> Bool

generable x =

x == head (dropWhile (<x) generables)

-- 2ª definición

generable2 :: Integer -> Bool

generable2 1 = True

generable2 x = (x `mod` 3 == 0 && generable2 (x `div` 3))

|| (x > 5 && generable2 (x - 5))

generables2 :: [Integer]

generables2 = filter generable2 [1..]

arbolGenerable :: Integer -> Tree Integer

arbolGenerable n = aux 1

where aux x

| 3*x <= n && 5+x <= n = Node x [aux (3*x), aux (5+x)]

| 3*x <= n = Node x [aux (3*x)]

| 5+x <= n = Node x [aux (5+x)]

| otherwise = Node x []

-- 3ª definición

generable3 :: Integer -> Bool

generable3 x =

x `elem` arbolGenerable x

Números cubifinitos

PorJosé A. Alonso 15-marzo-201721-enero-2020

El enunciado del problema Números cubifinitos de ¡Acepta el reto! es el siguiente

Se dice que un número es cubifinito cuando al elevar todos sus dígitos al cubo y sumarlos el resultado o bien es 1 o bien es un número cubifinito.

Por ejemplo, el número 1243 es cubifinito, pues al elevar todos sus dígitos al cubo obtenemos 100 que es cubifinito.

Por su parte, el 513 no es cubifinito, pues al elevar al cubo sus dígitos conseguimos el 153 que nunca podrá ser cubifinito, pues la suma de los cubos de sus dígitos vuelve a dar 153.

Definir las funciones

   esCubifinito :: Int -> Bool
   grafica :: Int -> IO ()

1 2	esCubifinito :: Int -> Bool grafica :: Int -> IO ()

tales que

(esCubifinito n) se verifica si n es un número cubifinito. Por ejemplo,

     esCubifinito 1      ==  True
     esCubifinito 10     ==  True
     esCubifinito 1243   ==  True
     esCubifinito 87418  ==  True
     esCubifinito 513    ==  False

esCubifinito 1 == True

esCubifinito 10 == True

esCubifinito 1243 == True

esCubifinito 87418 == True

esCubifinito 513 == False

(grafica n) dibuja la gráfica de la sucesión de los primeros n números cubifinitos. Por ejemplo, al evaluar (grafica 50) se dibuja

Soluciones

import Graphics.Gnuplot.Simple

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

esCubifinito :: Int -> Bool
esCubifinito n = aux [n]
  where aux (n:ns) | n == 1      = True
                   | n `elem` ns = False
                   | otherwise   = aux (sumaCubosDigitos n : n : ns)

-- (sumaCubosDigitos b) es la suma de los cubos de los dígitos de n. Por
-- ejemplo, 
--    sumaCubosDigitos 513  ==  153
sumaCubosDigitos :: Int -> Int
sumaCubosDigitos = sum . map (^3) . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 513  ==  [5,1,3]
digitos :: Int -> [Int]
digitos n = [read [c] | c <- show n]

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

esCubifinito2 :: Int -> Bool
esCubifinito2 n = primerRepetido (orbita n) == 1

-- (orbita n) es la lista cuyo primer elemento es n y los siguientes se
-- obtienen sumando los cubos de los digitos del elemento anterior. Por
-- ejemplo,  
--    take 9 (orbita 2)  ==  [2,8,512,134,92,737,713,371,371]
orbita :: Int -> [Int]
orbita n = iterate sumaCubosDigitos n

-- (primerRepetido xs) es el primer elemento repetido de la lista
--  xs. Por ejemplo, 
--    primerRepetido [3,7,5,7,2]  ==  7
primerRepetido :: Eq a => [a] -> a
primerRepetido xs = aux xs []
  where
    aux (x:xs') ys | x `elem` ys = x
                   | otherwise   = aux xs' (x:ys) 

grafica :: Int -> IO ()
grafica n = 
    plotList [Key Nothing, PNG "Numeros_cubifinitos.png"]
             (zip [1..n] [x | x <- [1..], esCubifinito x])

import Graphics.Gnuplot.Simple

-- 1ª solución

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

esCubifinito :: Int -> Bool

esCubifinito n = aux [n]

where aux (n:ns) | n == 1 = True

| n `elem` ns = False

| otherwise = aux (sumaCubosDigitos n : n : ns)

-- (sumaCubosDigitos b) es la suma de los cubos de los dígitos de n. Por

-- ejemplo,

-- sumaCubosDigitos 513 == 153

sumaCubosDigitos :: Int -> Int

sumaCubosDigitos = sum . map (^3) . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,

-- digitos 513 == [5,1,3]

digitos :: Int -> [Int]

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

-- 2ª solución

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

esCubifinito2 :: Int -> Bool

esCubifinito2 n = primerRepetido (orbita n) == 1

-- (orbita n) es la lista cuyo primer elemento es n y los siguientes se

-- obtienen sumando los cubos de los digitos del elemento anterior. Por

-- ejemplo,

-- take 9 (orbita 2) == [2,8,512,134,92,737,713,371,371]

orbita :: Int -> [Int]

orbita n = iterate sumaCubosDigitos n

-- (primerRepetido xs) es el primer elemento repetido de la lista

-- xs. Por ejemplo,

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

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

primerRepetido xs = aux xs []

where

aux (x:xs') ys | x `elem` ys = x

| otherwise = aux xs' (x:ys)

grafica :: Int -> IO ()

grafica n =

plotList [Key Nothing, PNG "Numeros_cubifinitos.png"]

(zip [1..n] [x | x <- [1..], esCubifinito x])

Caminos minimales en un arbol numérico

PorJosé A. Alonso 10-marzo-201725-abril-2021

En la librería Data.Tree se definen los árboles y los bosques como sigue

   data Tree a   = Node a (Forest a)
   type Forest a = [Tree a]

1 2	data Tree a = Node a (Forest a) type Forest a = [Tree a]

Se pueden definir árboles. Por ejemplo,

   ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

1	ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

Y se pueden dibujar con la función drawTree. Por ejemplo,

   λ> putStrLn (drawTree (fmap show ej))
   3
   |
   +- 5
   |  |
   |  `- 9
   |
   `- 7

λ> putStrLn (drawTree (fmap show ej))

+- 5

| |

| `- 9

`- 7

Los mayores divisores de un número x son los divisores u tales que u > 1 y existe un v tal que 1 < v < u y u*v = x. Por ejemplo, los mayores divisores de 24 son 12, 8 y 6.

El árbol de los predecesores y mayores divisores de un número x es el árbol cuya raíz es x y los sucesores de cada nodo y > 1 es el conjunto formado por y-1 junto con los mayores divisores de y. Los nodos con valor 1 no tienen sucesores. Por ejemplo, el árbol de los predecesores y mayores divisores del número 6 es

/ \

5 3

| |

4 2

/ \ |

3 2 1

| |

2 1

Definir las siguientes funciones

   mayoresDivisores :: Int -> [Int]
   arbol            :: Int -> Tree Int
   caminos          :: Int -> [[Int]]
   caminosMinimales :: Int -> [[Int]]

mayoresDivisores :: Int -> [Int]

arbol :: Int -> Tree Int

caminos :: Int -> [[Int]]

caminosMinimales :: Int -> [[Int]]

tales que

(mayoresDivisores x) es la lista de los mayores divisores de x. Por ejemplo,

     mayoresDivisores 24  ==  [12,8,6]
     mayoresDivisores 16  ==  [8,4]
     mayoresDivisores 10  ==  [5]
     mayoresDivisores 17  ==  []

mayoresDivisores 24 == [12,8,6]

mayoresDivisores 16 == [8,4]

mayoresDivisores 10 == [5]

mayoresDivisores 17 == []

(arbol x) es el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> putStrLn (drawTree (fmap show (arbol 6)))
     6
     |
     +- 5
     |  |
     |  `- 4
     |     |
     |     +- 3
     |     |  |
     |     |  `- 2
     |     |     |
     |     |     `- 1
     |     |
     |     `- 2
     |        |
     |        `- 1
     |
     `- 3
        |
        `- 2
           |
           `- 1

λ> putStrLn (drawTree (fmap show (arbol 6)))

+- 5

| |

| `- 4

| |

| +- 3

| | |

| | `- 2

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 3

`- 2

`- 1

(caminos x) es la lista de los caminos en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

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

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

(caminosMinimales x) es la lista de los caminos en de menor longitud en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> caminosMinimales 6
     [[6,3,2,1]]
     λ> caminosMinimales 17
     [[17,16,4,2,1]]
     λ> caminosMinimales 50
     [[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

λ> caminosMinimales 6

[[6,3,2,1]]

λ> caminosMinimales 17

[[17,16,4,2,1]]

λ> caminosMinimales 50

[[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

Soluciones

import Data.Tree

mayoresDivisores :: Int -> [Int]
mayoresDivisores x =
  [max u v | u <- [2..floor (sqrt (fromIntegral x))]
           , x `mod` u == 0
           , let v = x `div` u]  

arbol :: Int -> Tree Int
arbol 1 = Node 1 []
arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]
caminos = caminosArbol . arbol

--    λ> caminosArbol (arbol 6)
--    [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]
caminosArbol :: Tree a -> [[a]]
caminosArbol (Node x []) = [[x]]
caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]
caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]
caminosMinimales x = [ys | ys <- yss, length ys == m]
  where yss = caminos x
        m   = minimum (map length yss)

import Data.Tree

mayoresDivisores :: Int -> [Int]

mayoresDivisores x =

[max u v | u <- [2..floor (sqrt (fromIntegral x))]

, x `mod` u == 0

, let v = x `div` u]

arbol :: Int -> Tree Int

arbol 1 = Node 1 []

arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]

caminos = caminosArbol . arbol

-- λ> caminosArbol (arbol 6)

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

caminosArbol :: Tree a -> [[a]]

caminosArbol (Node x []) = [[x]]

caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]

caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]

caminosMinimales x = [ys | ys <- yss, length ys == m]

where yss = caminos x

m = minimum (map length yss)

Generadores de números de Gabonacci

PorJosé A. Alonso 9-marzo-201720-marzo-2017

Los números de Gabonacci generados por (a,b) son los elementos de la sucesión de Gabonacci definida por

   G(0) = a
   G(1) = b
   G(n) = G(n-2) + G(n-1), si n > 1

G(0) = a

G(1) = b

G(n) = G(n-2) + G(n-1), si n > 1

Por ejemplo, la sucesión de Gabonacci generada por (2,5) es 2, 5, 7, 12, 19, 31, 50, 81, 131, 212, …

Un número pertenece a distintas sucesiones de Gabonacci. Por ejemplo, el 9 pertenece a las sucesiones de Gabonacci generados por (3,3), (1,4) y (4,5).

El menor generador de Gabonacci de un número x es el par (a,b), con 1 ≤ a ≤ b, tal que (a,b) es un generador de Gabonacci de x y no existe ningún generador de Gabonacci de x (a’,b’) tal que b’ < b ó b’ = b y a’ < a. Por ejemplo, el menor generador de Gabonacci de 9 es (3,3).

Definir la función

   menorGenerador :: Integer -> (Integer,Integer)

1	menorGenerador :: Integer -> (Integer,Integer)

tal que (menorGenerador x) es el menor generador de Gabonacci de x. Por ejemplo,

   menorGenerador 9          ==  (3,3)
   menorGenerador 7          ==  (1,3)
   menorGenerador 5          ==  (1,1)
   menorGenerador 27         ==  (3,7)
   menorGenerador 57         ==  (4,9)
   menorGenerador 218        ==  (10,21)
   menorGenerador 1121       ==  (20,41)
   menorGenerador 89         ==  (1,1)
   menorGenerador 123        ==  (1,3)
   menorGenerador 1000       ==  (2,10)
   menorGenerador 842831057  ==  (2,7)
   menorGenerador 1573655    ==  (985,1971)

menorGenerador 9 == (3,3)

menorGenerador 7 == (1,3)

menorGenerador 5 == (1,1)

menorGenerador 27 == (3,7)

menorGenerador 57 == (4,9)

menorGenerador 218 == (10,21)

menorGenerador 1121 == (20,41)

menorGenerador 89 == (1,1)

menorGenerador 123 == (1,3)

menorGenerador 1000 == (2,10)

menorGenerador 842831057 == (2,7)

menorGenerador 1573655 == (985,1971)

Soluciones

menorGenerador :: Integer -> (Integer,Integer)
menorGenerador = head . generadores

generadores :: Integer -> [(Integer,Integer)]
generadores x = [(a,b) | b <- [1..x]
                       , a <- [1..b]
                       , pertenece x (gabonacci a b)]

gabonacci :: Integer -> Integer -> [Integer]
gabonacci a b = aux
  where aux = a : scanl (+) b aux

pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)

menorGenerador :: Integer -> (Integer,Integer)

menorGenerador = head . generadores

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

generadores x = [(a,b) | b <- [1..x]

, a <- [1..b]

, pertenece x (gabonacci a b)]

gabonacci :: Integer -> Integer -> [Integer]

gabonacci a b = aux

where aux = a : scanl (+) b aux

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys =

x == head (dropWhile (<x) ys)

Números binarios invertidos

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

La representación binaria de 13 es 1101, que al invertirlo da 1011 cuya representación decimal es el número 11.

Definir la función

   transformado :: Integer -> Integer

1	transformado :: Integer -> Integer

tal que (transformado x) es la representación decimal del número obtenido invirtiendo la representación binaria de x. Por ejemplo,

   transformado 13  ==  11
   transformado 47  ==  61

1 2	transformado 13 == 11 transformado 47 == 61

Nota: El ejercicio está basado en el problema Reversed Binary Numbers de Kattis.

Soluciones

transformado :: Integer -> Integer 
transformado = bin2int . reverse . int2bin

-- (int2bin x) es la representación binaria de x. Por ejemplo,
--    int2bin 13  ==  [1,0,1,1]
int2bin :: Integer -> [Integer]
int2bin n | n < 2     = [n]
          | otherwise = n `mod` 2 : int2bin (n `div` 2)

-- (bin2int x) es la representación decimal del número binario x. Por
-- ejemplo, 
--    bin2int [1,0,1,1]           ==  13
--    bin2int (reverse [1,0,1,1]) ==  11
bin2int :: [Integer] -> Integer
bin2int =  foldr (\x y -> x + 2*y) 0

transformado :: Integer -> Integer

transformado = bin2int . reverse . int2bin

-- (int2bin x) es la representación binaria de x. Por ejemplo,

-- int2bin 13 == [1,0,1,1]

int2bin :: Integer -> [Integer]

int2bin n | n < 2 = [n]

| otherwise = n `mod` 2 : int2bin (n `div` 2)

-- (bin2int x) es la representación decimal del número binario x. Por

-- ejemplo,

-- bin2int [1,0,1,1] == 13

-- bin2int (reverse [1,0,1,1]) == 11

bin2int :: [Integer] -> Integer

bin2int = foldr (\x y -> x + 2*y) 0

Números construibles como sumas de dos dados

PorJosé A. Alonso 3-marzo-201725-marzo-2022

Un número x es construible a partir de de los números enteros positivos a y b si se puede escribir como una suma cuyos sumandos son a o b. Por ejemplo, 7 y 9 son construibles a partir de 2 y 3 ya que 7 = 2+2+3 y 9 = 3+3+3.

Definir las funciones

   construibles  :: Integer -> Integer -> [Integer]
   esConstruible :: Integer -> Integer -> Integer -> Bool

1 2	construibles :: Integer -> Integer -> [Integer] esConstruible :: Integer -> Integer -> Integer -> Bool

tales que

(construibles a b) es la lista de los números construibles a partir de a y b. Por ejemplo,

     take 5 (construibles 2 9)  ==  [2,4,6,8,9]
     take 5 (construibles 6 4)  ==  [4,6,8,10,12]
     take 5 (construibles 9 7)  ==  [7,9,14,16,18]

take 5 (construibles 2 9) == [2,4,6,8,9]

take 5 (construibles 6 4) == [4,6,8,10,12]

take 5 (construibles 9 7) == [7,9,14,16,18]

(esConstruible a b x) se verifica si x es construible a partir de a y b. Por ejemplo,

     esConstruible 2 3 7   ==  True
     esConstruible 9 7 15  ==  False

1 2	esConstruible 2 3 7 == True esConstruible 9 7 15 == False

Soluciones

import Data.List (nub)

construibles :: Integer -> Integer -> [Integer]
construibles a b = tail aux
  where aux = 0 : mezcla [a + x | x <- aux]
                         [b + x | x <- aux]

mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla p@(x:xs) q@(y:ys) | x < y     = x : mezcla xs q
                         | x > y     = y : mezcla p  ys  
                         | otherwise = x : mezcla xs ys
mezcla []       ys                   = ys
mezcla xs       []                   = xs
              
esConstruible :: Integer -> Integer -> Integer -> Bool
esConstruible a b x = x == y
  where (y:_) = dropWhile (<x) (construibles a b)

import Data.List (nub)

construibles :: Integer -> Integer -> [Integer]

construibles a b = tail aux

where aux = 0 : mezcla [a + x | x <- aux]

[b + x | x <- aux]

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

mezcla p@(x:xs) q@(y:ys) | x < y = x : mezcla xs q

| x > y = y : mezcla p ys

| otherwise = x : mezcla xs ys

mezcla [] ys = ys

mezcla xs [] = xs

esConstruible :: Integer -> Integer -> Integer -> Bool

esConstruible a b x = x == y

where (y:_) = dropWhile (<x) (construibles a b)

Sucesiones alícuotas

PorJosé A. Alonso 28-febrero-20177-marzo-2017

La sucesión alícuota de un número x es la sucesión cuyo primer término es x y cada otro término es la suma de los divisores propios del término anterior. Por ejemplo, la sucesión alícuota de 10 es [10,8,7,1,0,0,0] ya que

   la suma de los divisores propios de 10 es 5 + 2 + 1 = 8
   la suma de los divisores propios de  8 es 4 + 2 + 1 = 7
   la suma de los divisores propios de  7 es 1
   la suma de los divisores propios de  1 es 0

la suma de los divisores propios de 10 es 5 + 2 + 1 = 8

la suma de los divisores propios de 8 es 4 + 2 + 1 = 7

la suma de los divisores propios de 7 es 1

la suma de los divisores propios de 1 es 0

Definir la función

   sucAlicuota :: Integer -> [Integer]

1	sucAlicuota :: Integer -> [Integer]

tal que (sucAlicuota x) es la sucesión alícuota de x. Por ejemplo,

   take 6 (sucAlicuota 10)       ==  [10,8,7,1,0,0]
   take 6 (sucAlicuota 95)       ==  [95,25,6,6,6,6]
   take 6 (sucAlicuota 220)      ==  [220,284,220,284,220,284]
   sucAlicuota 1184 !! (1+10^7)  ==  1210
   sucAlicuota 276 !! 200        ==  2790456740340877466506

take 6 (sucAlicuota 10) == [10,8,7,1,0,0]

take 6 (sucAlicuota 95) == [95,25,6,6,6,6]

take 6 (sucAlicuota 220) == [220,284,220,284,220,284]

sucAlicuota 1184 !! (1+10^7) == 1210

sucAlicuota 276 !! 200 == 2790456740340877466506

Soluciones

import Math.NumberTheory.ArithmeticFunctions (sigma)

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

sucAlicuota :: Integer -> [Integer]
sucAlicuota x = x : sucAlicuota (sumaDivisoresPropios x)

sumaDivisoresPropios :: Integer -> Integer
sumaDivisoresPropios x =
  sum [y | y <- [1..x-1], x `mod` y == 0]

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

sucAlicuota2 :: Integer -> [Integer]
sucAlicuota2 = iterate (sum . divisoresPropios)

divisoresPropios :: Integer -> [Integer]
divisoresPropios x = [y | y <- [1..x-1], x `mod` y == 0]

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

sucAlicuota3 :: Integer -> [Integer]
sucAlicuota3 x = aux x []
  where aux y ys | y `elem` ys = us ++ cycle zs
                 | otherwise   = aux (sumaDivisoresPropios y) (y:ys)
          where us = reverse ys
                zs = dropWhile (/=y) us

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

sucAlicuota4 :: Integer -> [Integer]
sucAlicuota4 x = x : sucAlicuota4 (sumaDivisoresPropios4 x)

sumaDivisoresPropios4 :: Integer -> Integer
sumaDivisoresPropios4 x =
  sigma 1 x - x

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

--    λ> sucAlicuota 1184 !! (1+10^3)
--    1210
--    (2.02 secs, 261,081,688 bytes)
--    λ> sucAlicuota2 1184 !! (1+10^3)
--    1210
--    (2.02 secs, 245,485,568 bytes)
--    λ> sucAlicuota3 1184 !! (1+10^3)
--    1210
--    (0.02 secs, 0 bytes)
--    λ> sucAlicuota4 1184 !! (1+10^3)
--    1210
--    (0.05 secs, 0 bytes)

import Math.NumberTheory.ArithmeticFunctions (sigma)

-- 1ª definición

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

sucAlicuota :: Integer -> [Integer]

sucAlicuota x = x : sucAlicuota (sumaDivisoresPropios x)

sumaDivisoresPropios :: Integer -> Integer

sumaDivisoresPropios x =

sum [y | y <- [1..x-1], x `mod` y == 0]

-- 2ª definición

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

sucAlicuota2 :: Integer -> [Integer]

sucAlicuota2 = iterate (sum . divisoresPropios)

divisoresPropios :: Integer -> [Integer]

divisoresPropios x = [y | y <- [1..x-1], x `mod` y == 0]

-- 3ª definición

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

sucAlicuota3 :: Integer -> [Integer]

sucAlicuota3 x = aux x []

where aux y ys | y `elem` ys = us ++ cycle zs

| otherwise = aux (sumaDivisoresPropios y) (y:ys)

where us = reverse ys

zs = dropWhile (/=y) us

-- 4ª definición

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

sucAlicuota4 :: Integer -> [Integer]

sucAlicuota4 x = x : sucAlicuota4 (sumaDivisoresPropios4 x)

sumaDivisoresPropios4 :: Integer -> Integer

sumaDivisoresPropios4 x =

sigma 1 x - x

-- Comparación de eficiencia

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

-- λ> sucAlicuota 1184 !! (1+10^3)

-- 1210

-- (2.02 secs, 261,081,688 bytes)

-- λ> sucAlicuota2 1184 !! (1+10^3)

-- 1210

-- (2.02 secs, 245,485,568 bytes)

-- λ> sucAlicuota3 1184 !! (1+10^3)

-- 1210

-- (0.02 secs, 0 bytes)

-- λ> sucAlicuota4 1184 !! (1+10^3)

-- 1210

-- (0.05 secs, 0 bytes)

Precisión de aproximaciones de pi

PorJosé A. Alonso 27-febrero-20176-marzo-2017

La precisión de una aproximación x de pi es el número de dígitos comunes entre el inicio de x y de pi. Por ejemplo, puesto que 355/113 es 3.1415929203539825 y pi es 3.141592653589793, la precisión de 355/113 es 7.

Definir las siguientes funciones

   mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]
   precisionPi       :: Double -> Int
   precisionPiCR     :: CReal -> Int

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

precisionPi :: Double -> Int

precisionPiCR :: CReal -> Int

tales que

(mayorPrefijoComun xs ys) es el mayor prefijo común de xs e ys. Por ejemplo,

     mayorPrefijoComun []      [2,3,4,5]  ==  []
     mayorPrefijoComun [2,3,5] []         ==  []
     mayorPrefijoComun [2,3,5] [2,3,4,5]  ==  [2,3]
     mayorPrefijoComun [2,3,5] [2,5,3,4]  ==  [2]
     mayorPrefijoComun [2,3,5] [5,2,3,4]  ==  []

mayorPrefijoComun [] [2,3,4,5] == []

mayorPrefijoComun [2,3,5] [] == []

mayorPrefijoComun [2,3,5] [2,3,4,5] == [2,3]

mayorPrefijoComun [2,3,5] [2,5,3,4] == [2]

mayorPrefijoComun [2,3,5] [5,2,3,4] == []

(precisionPi x) es la precisión de la aproximación de pi x. Por ejemplo,

     precisionPi (25/8)              ==  2
     precisionPi (22/7)              ==  3
     precisionPi (sqrt 2 + sqrt 3)   ==  3
     precisionPi (377/120)           ==  4
     precisionPi (31**(1/3))         ==  4
     precisionPi (7^7/4^9)           ==  5
     precisionPi (355/113)           ==  7
     precisionPi ((2143/22)**(1/4))  ==  9

precisionPi (25/8) == 2

precisionPi (22/7) == 3

precisionPi (sqrt 2 + sqrt 3) == 3

precisionPi (377/120) == 4

precisionPi (31**(1/3)) == 4

precisionPi (7^7/4^9) == 5

precisionPi (355/113) == 7

precisionPi ((2143/22)**(1/4)) == 9

(precisionPiCR x) es la precisión de la aproximación de pi x, como números reales. Por ejemplo,

     precisionPiCR (log (640320^3+744)/(sqrt 163))                        == 31
     precisionPiCR (log (5280^3*(236674+30303*sqrt 61)^3+744)/(sqrt 427)) == 53

1 2	precisionPiCR (log (640320^3+744)/(sqrt 163)) == 31 precisionPiCR (log (5280^3(236674+30303sqrt 61)^3+744)/(sqrt 427)) == 53

Nota: Para la definición precisionPiCR se usa la librería Data.Number.CReal que se instala con

   cabal install numbers

1	cabal install numbers

Soluciones

import Data.Number.CReal

-- mayorPrefijoComún
-- =================

-- 1ª definición
mayorPrefijoComun :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun [] _ = []
mayorPrefijoComun _ [] = []
mayorPrefijoComun (x:xs) (y:ys)
  | x == y    = x : mayorPrefijoComun xs ys
  | otherwise = []

-- 2ª definición
mayorPrefijoComun2 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun2 xs ys =
  [x | (x,y) <- takeWhile (\(x,y) -> x == y) (zip xs ys)] 

-- 3ª definición
mayorPrefijoComun3 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun3 xs ys =
  [x | (x,y) <- takeWhile (uncurry (==)) (zip xs ys)] 

-- 4ª definición
mayorPrefijoComun4 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun4 xs =
  map fst . takeWhile (uncurry (==)) . zip xs

-- 5ª definición
mayorPrefijoComun5 :: Eq a => [a] -> [a] -> [a]
mayorPrefijoComun5 =
  ((map fst . takeWhile (uncurry (==))) .) . zip

-- precisionPi
-- ===========

-- 1ª definición
precisionPi :: Double -> Int
precisionPi x =
  length (mayorPrefijoComun xs ys) - 1
  where xs = show x
        ys = show pi

-- 2ª definición
precisionPi2 :: Double -> Int
precisionPi2 =
  pred . length . mayorPrefijoComun (show pi) . show

-- precisionPiCR
-- =============

precisionPiCR :: CReal -> Int
precisionPiCR = aux 50
  where aux n x | p < n-1   = p
                | otherwise = aux (n+50) x
          where p = precisionPiCRHasta n x

-- (precisionPiCRHasta n x) es la precisión de pi acotada por n. Por
-- ejemplo,
--    precisionPiCRHasta 1 3.14   ==  2
--    precisionPiCRHasta 5 3.14   ==  3
--    precisionPiCRHasta 5 3.142  ==  3
--    precisionPiCRHasta 5 3.141  ==  4
precisionPiCRHasta :: Int -> CReal -> Int
precisionPiCRHasta n x =
  length (mayorPrefijoComun xs ys) - 1
  where xs = showCReal n x
        ys = showCReal n pi

import Data.Number.CReal

-- mayorPrefijoComún

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

-- 1ª definición

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

mayorPrefijoComun [] _ = []

mayorPrefijoComun _ [] = []

mayorPrefijoComun (x:xs) (y:ys)

| x == y = x : mayorPrefijoComun xs ys

| otherwise = []

-- 2ª definición

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

mayorPrefijoComun2 xs ys =

[x | (x,y) <- takeWhile (\(x,y) -> x == y) (zip xs ys)]

-- 3ª definición

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

mayorPrefijoComun3 xs ys =

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

-- 4ª definición

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

mayorPrefijoComun4 xs =

map fst . takeWhile (uncurry (==)) . zip xs

-- 5ª definición

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

mayorPrefijoComun5 =

((map fst . takeWhile (uncurry (==))) .) . zip

-- precisionPi

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

-- 1ª definición

precisionPi :: Double -> Int

precisionPi x =

length (mayorPrefijoComun xs ys) - 1

where xs = show x

ys = show pi

-- 2ª definición

precisionPi2 :: Double -> Int

precisionPi2 =

pred . length . mayorPrefijoComun (show pi) . show

-- precisionPiCR

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

precisionPiCR :: CReal -> Int

precisionPiCR = aux 50

where aux n x | p < n-1 = p

| otherwise = aux (n+50) x

where p = precisionPiCRHasta n x

-- (precisionPiCRHasta n x) es la precisión de pi acotada por n. Por

-- ejemplo,

-- precisionPiCRHasta 1 3.14 == 2

-- precisionPiCRHasta 5 3.14 == 3

-- precisionPiCRHasta 5 3.142 == 3

-- precisionPiCRHasta 5 3.141 == 4

precisionPiCRHasta :: Int -> CReal -> Int

precisionPiCRHasta n x =

length (mayorPrefijoComun xs ys) - 1

where xs = showCReal n x

ys = showCReal n pi

Cálculo de pi mediante el método de Newton

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

El método de Newton para el cálculo de pi se basa en la relación

y en el desarrollo del arco seno

de donde se obtiene la fórmula

La primeras aproximaciones son

   a(0) = 6*(1/2)                               = 3.0
   a(1) = 6*(1/2+1/(2*3*2^3))                   = 3.125
   a(2) = 6*(1/2+1/(2*3*2^3)+(1*3)/(2*4*5*2^5)) = 3.1390625

a(0) = 6*(1/2) = 3.0

a(1) = 6*(1/2+1/(2*3*2^3)) = 3.125

a(2) = 6*(1/2+1/(2*3*2^3)+(1*3)/(2*4*5*2^5)) = 3.1390625

Definir las funciones

   aproximacionPi :: Int -> Double
   grafica        :: [Int] -> IO ()

1 2	aproximacionPi :: Int -> Double grafica :: [Int] -> IO ()

tales que

(aproximacionPi n) es la n-ésima aproximación de pi con la fórmula de Newton. Por ejemplo,

     aproximacionPi 0   ==  3.0
     aproximacionPi 1   ==  3.125
     aproximacionPi 2   ==  3.1390625
     aproximacionPi 10  ==  3.1415926468755613
     aproximacionPi 21  ==  3.141592653589793
     pi                 ==  3.141592653589793

aproximacionPi 0 == 3.0

aproximacionPi 1 == 3.125

aproximacionPi 2 == 3.1390625

aproximacionPi 10 == 3.1415926468755613

aproximacionPi 21 == 3.141592653589793

pi == 3.141592653589793

(grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi donde k toma los valores de la lista xs. Por ejemplo, (grafica [1..30]) dibuja

Nota: Este ejercicio ha sido propuesto por Manuel Herrera.

Soluciones

import Graphics.Gnuplot.Simple

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

aproximacionPi :: Int -> Double
aproximacionPi n = 6 * arcsinX
  where arcsinX = 0.5 + sum (take n factoresN)

factoresN :: [Double]
factoresN = zipWith (*) (potenciasK 3) fraccionesPI

potenciasK :: Double -> [Double]
potenciasK k = (0.5**k)/k : potenciasK (k+2)

fraccionesPI :: [Double]
fraccionesPI =
  scanl (*) (1/2) (tail (zipWith (/) [1,3..] [2,4..]))

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

aproximacionPi2 :: Int -> Double
aproximacionPi2 n = 6 * (serie !! n)

serie :: [Double]
serie = scanl1 (+) (zipWith (/)
                            (map fromIntegral numeradores)
                            (map fromIntegral denominadores))
  where numeradores    = 1 : scanl1 (*) [1,3..]
        denominadores  = zipWith (*) denominadores1 denominadores2
        denominadores1 = 2 : scanl1 (*) [2,4..]
        denominadores2 = 1 : [n * 2^n | n <- [3,5..]]

grafica :: [Int] -> IO ()
grafica xs = 
    plotList [Key Nothing]
             [(k,aproximacionPi k) | k <- xs]

import Graphics.Gnuplot.Simple

-- 1ª definición

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

aproximacionPi :: Int -> Double

aproximacionPi n = 6 * arcsinX

where arcsinX = 0.5 + sum (take n factoresN)

factoresN :: [Double]

factoresN = zipWith (*) (potenciasK 3) fraccionesPI

potenciasK :: Double -> [Double]

potenciasK k = (0.5**k)/k : potenciasK (k+2)

fraccionesPI :: [Double]

fraccionesPI =

scanl (*) (1/2) (tail (zipWith (/) [1,3..] [2,4..]))

-- 2ª definición

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

aproximacionPi2 :: Int -> Double

aproximacionPi2 n = 6 * (serie !! n)

serie :: [Double]

serie = scanl1 (+) (zipWith (/)

(map fromIntegral numeradores)

(map fromIntegral denominadores))

where numeradores = 1 : scanl1 (*) [1,3..]

denominadores = zipWith (*) denominadores1 denominadores2

denominadores1 = 2 : scanl1 (*) [2,4..]

denominadores2 = 1 : [n * 2^n | n <- [3,5..]]

grafica :: [Int] -> IO ()

grafica xs =

plotList [Key Nothing]

[(k,aproximacionPi k) | k <- xs]

Cálculo de pi mediante los métodos de Gregory-Leibniz y de Beeler

PorJosé A. Alonso 23-febrero-201726-marzo-2022

La fórmula de Gregory-Leibniz para calcular pi es

y la de Beeler es

Definir las funciones

   aproximaPiGL     :: Int -> Double
   aproximaPiBeeler :: Int -> Double
   graficas         :: [Int] -> IO ()

aproximaPiGL :: Int -> Double

aproximaPiBeeler :: Int -> Double

graficas :: [Int] -> IO ()

tales que

(aproximaPiGL n) es la aproximación de pi con los primeros n términos de la fórmula de Gregory-Leibniz. Por ejemplo,

     aproximaPiGL 1       ==  4.0
     aproximaPiGL 2       ==  2.666666666666667
     aproximaPiGL 3       ==  3.466666666666667
     aproximaPiGL 10      ==  3.0418396189294032
     aproximaPiGL 100     ==  3.1315929035585537
     aproximaPiGL 1000    ==  3.140592653839794
     aproximaPiGL 10000   ==  3.1414926535900345
     aproximaPiGL 100000  ==  3.1415826535897198

aproximaPiGL 1 == 4.0

aproximaPiGL 2 == 2.666666666666667

aproximaPiGL 3 == 3.466666666666667

aproximaPiGL 10 == 3.0418396189294032

aproximaPiGL 100 == 3.1315929035585537

aproximaPiGL 1000 == 3.140592653839794

aproximaPiGL 10000 == 3.1414926535900345

aproximaPiGL 100000 == 3.1415826535897198

(aproximaPiBeeler n) es la aproximación de pi con los primeros n términos de la fórmula de Beeler. Por ejemplo,

     aproximaPiBeeler 1   ==  2.0
     aproximaPiBeeler 2   ==  2.6666666666666665
     aproximaPiBeeler 3   ==  2.933333333333333
     aproximaPiBeeler 10  ==  3.140578169680337
     aproximaPiBeeler 60  ==  3.141592653589793
     pi                   ==  3.141592653589793

aproximaPiBeeler 1 == 2.0

aproximaPiBeeler 2 == 2.6666666666666665

aproximaPiBeeler 3 == 2.933333333333333

aproximaPiBeeler 10 == 3.140578169680337

aproximaPiBeeler 60 == 3.141592653589793

pi == 3.141592653589793

(graficas xs) dibuja la gráfica de las k-ésimas aproximaciones de pi, donde k toma los valores de la lista xs, con las fórmulas de Gregory-Leibniz y de Beeler. Por ejemplo, (graficas [1..25]) dibuja

donde la línea morada corresponde a la aproximación de Gregory-Leibniz y la verde a la de Beeler.

Nota: Este ejercicio ha sido propuesto por Enrique Naranjo.

Soluciones

import Graphics.Gnuplot.Simple

-- Definiciones de aproximaPiGL
-- ============================

-- 1ª definición de aproximaPiGL
aproximaPiGL :: Int -> Double
aproximaPiGL n = 4 * (sum . take n . sumaA . zipWith (/) [1,1..]) [1,3..]
  where sumaA (x:y:xs) = x:(-y):sumaA xs

-- 2ª definición de aproximaPiGL
aproximaPiGL2 :: Int -> Double
aproximaPiGL2 n =
  4 * (sum (take n (zipWith (/) (cycle [1,-1]) [1,3..])))

-- 3ª definición de aproximaPiGL
aproximaPiGL3 :: Int -> Double
aproximaPiGL3 n =
  4 * (sum . take n . zipWith (/) (cycle [1,-1])) [1,3..]

-- 4ª definición de aproximaPiGL
aproximaPiGL4 :: Int -> Double
aproximaPiGL4 n = serieGL !! (n-1)

serieGL :: [Double]
serieGL = scanl1 (+) (zipWith (/) numeradores denominadores)
  where numeradores   = cycle [4,-4]
        denominadores = [1,3..]

-- Definición de aproximaPiBeeler
aproximaPiBeeler :: Int -> Double
aproximaPiBeeler n = 2 * aux (fromIntegral n) 1
  where
    aux :: Double -> Double -> Double 
    aux n k | n == k    = 1
            | otherwise = 1 + (k/(2*k+1)) * aux n (1+k)

-- Definición de graficas
graficas :: [Int] -> IO ()
graficas xs = 
    plotLists [Key Nothing]
             [[(k,aproximaPiGL k)     | k <- xs],
              [(k,aproximaPiBeeler k) | k <- xs]]

import Graphics.Gnuplot.Simple

-- Definiciones de aproximaPiGL

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

-- 1ª definición de aproximaPiGL

aproximaPiGL :: Int -> Double

aproximaPiGL n = 4 * (sum . take n . sumaA . zipWith (/) [1,1..]) [1,3..]

where sumaA (x:y:xs) = x:(-y):sumaA xs

-- 2ª definición de aproximaPiGL

aproximaPiGL2 :: Int -> Double

aproximaPiGL2 n =

4 * (sum (take n (zipWith (/) (cycle [1,-1]) [1,3..])))

-- 3ª definición de aproximaPiGL

aproximaPiGL3 :: Int -> Double

aproximaPiGL3 n =

4 * (sum . take n . zipWith (/) (cycle [1,-1])) [1,3..]

-- 4ª definición de aproximaPiGL

aproximaPiGL4 :: Int -> Double

aproximaPiGL4 n = serieGL !! (n-1)

serieGL :: [Double]

serieGL = scanl1 (+) (zipWith (/) numeradores denominadores)

where numeradores = cycle [4,-4]

denominadores = [1,3..]

-- Definición de aproximaPiBeeler

aproximaPiBeeler :: Int -> Double

aproximaPiBeeler n = 2 * aux (fromIntegral n) 1

where

aux :: Double -> Double -> Double

aux n k | n == k = 1

| otherwise = 1 + (k/(2*k+1)) * aux n (1+k)

-- Definición de graficas

graficas :: [Int] -> IO ()

graficas xs =

plotLists [Key Nothing]

[[(k,aproximaPiGL k) | k <- xs],

[(k,aproximaPiBeeler k) | k <- xs]]

Búsqueda en los dígitos de pi

PorJosé A. Alonso 15-febrero-201726-marzo-2022

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

   3.1415926535897932384626433832 ... 83996346460422090106105779458151

1	3.1415926535897932384626433832 ... 83996346460422090106105779458151

Definir la función

   posicion :: String -> IO (Maybe Int)

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

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

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

λ> posicion "15"

Just 3

λ> posicion "2017"

Just 8897

λ> posicion "022017"

Just 382052

λ> posicion "14022017"

Nothing

λ> posicion "999999"

Just 762

λ> posicion "458151"

Just 999995

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

Soluciones

import Data.List (isPrefixOf)

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

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

import Data.List (isPrefixOf)

posicion :: String -> IO (Maybe Int)

posicion ns = do

ds <- readFile "Digitos_de_pi.txt"

return (posicionEnLista (drop 2 ds) ns)

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

posicionEnLista xs ys = aux xs 1

where aux [] _ = Nothing

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

| otherwise = aux xs (n+1)

Cálculo de pi usando la fórmula de Vieta

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

La fórmula de Vieta para el cálculo de pi es la siguiente

Definir las funciones

   aproximacionPi :: Int -> Double
   errorPi :: Double -> Int

1 2	aproximacionPi :: Int -> Double errorPi :: Double -> Int

tales que

(aproximacionPi n) es la aproximación de pi usando n factores de la fórmula de Vieta. Por ejemplo,

     aproximacionPi  5  ==  3.140331156954753
     aproximacionPi 10  ==  3.1415914215112
     aproximacionPi 15  ==  3.141592652386592
     aproximacionPi 20  ==  3.1415926535886207
     aproximacionPi 25  ==  3.141592653589795

aproximacionPi 5 == 3.140331156954753

aproximacionPi 10 == 3.1415914215112

aproximacionPi 15 == 3.141592652386592

aproximacionPi 20 == 3.1415926535886207

aproximacionPi 25 == 3.141592653589795

(errorPi x) es el menor número de factores de la fórmula de Vieta necesarios para obtener pi con un error menor que x. Por ejemplo,

     errorPi 0.1        ==  2
     errorPi 0.01       ==  4
     errorPi 0.001      ==  6
     errorPi 0.0001     ==  7
     errorPi 1e-4       ==  7
     errorPi 1e-14      ==  24
     pi                 ==  3.141592653589793
     aproximacionPi 24  ==  3.1415926535897913

errorPi 0.1 == 2

errorPi 0.01 == 4

errorPi 0.001 == 6

errorPi 0.0001 == 7

errorPi 1e-4 == 7

errorPi 1e-14 == 24

pi == 3.141592653589793

aproximacionPi 24 == 3.1415926535897913

Soluciones

-- 1ª definición de aproximacionPi
aproximacionPi :: Int -> Double
aproximacionPi n = product [2 / aux x | x <- [0..n]]
  where
    aux 0 = 1
    aux 1 = sqrt 2
    aux n = sqrt (2 + aux (n-1))

-- 2ª definición de aproximacionPi
aproximacionPi2 :: Int -> Double
aproximacionPi2 n = product [2/x | x <- 1 : xs] 
  where xs = take n $ iterate (\x -> sqrt (2+x)) (sqrt 2)

-- 3ª definición de aproximaxionPi
aproximacionPi3 :: Int -> Double
aproximacionPi3 n =  product (2 : take n (map (2/) xs))
  where xs = sqrt 2 : [sqrt (2 + x) | x <- xs]

-- 1ª definición de errorPi
errorPi :: Double -> Int
errorPi x = head [n | n <- [1..]
                    , abs (pi - aproximacionPi n) < x]

-- 2ª definición de errorPi
errorPi2 :: Double -> Int
errorPi2 x = until aceptable (+1) 1
  where aceptable n = abs (pi - aproximacionPi n) < x

-- 1ª definición de aproximacionPi

aproximacionPi :: Int -> Double

aproximacionPi n = product [2 / aux x | x <- [0..n]]

where

aux 0 = 1

aux 1 = sqrt 2

aux n = sqrt (2 + aux (n-1))

-- 2ª definición de aproximacionPi

aproximacionPi2 :: Int -> Double

aproximacionPi2 n = product [2/x | x <- 1 : xs]

where xs = take n $ iterate (\x -> sqrt (2+x)) (sqrt 2)

-- 3ª definición de aproximaxionPi

aproximacionPi3 :: Int -> Double

aproximacionPi3 n = product (2 : take n (map (2/) xs))

where xs = sqrt 2 : [sqrt (2 + x) | x <- xs]

-- 1ª definición de errorPi

errorPi :: Double -> Int

errorPi x = head [n | n <- [1..]

, abs (pi - aproximacionPi n) < x]

-- 2ª definición de errorPi

errorPi2 :: Double -> Int

errorPi2 x = until aceptable (+1) 1

where aceptable n = abs (pi - aproximacionPi n) < x

Caminos en un árbol binario con suma dada

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

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

   data Arbol = H
              | N Int Arbol Arbol
     deriving Show

data Arbol = H

| N Int Arbol Arbol

deriving Show

Por ejemplo, los árboles

       3                7                 1
      / \              / \               /  \
     2   4            5   8             /    \
    / \   \          /   / \           /      \
   1   7   5        6   4   9         3       -1
                                     / \     /  \
                                    2   1   4    5                        
                                       /   / \    \                    
                                      1   1   2    6

3 7 1

/ \ / \ / \

2 4 5 8 / \

/ \ \ / / \ / \

1 7 5 6 4 9 3 -1

/ \ / \

2 1 4 5

/ / \ \

1 1 2 6

se representan por

   ej1, ej2, ej3 :: Arbol
   ej1 = N 3 (N 2 (N 1 H H) (N 7 H H)) (N 4 H (N 5 H H))
   ej2 = N 7 (N 5 (N 6 H H) H) (N 8 (N 4 H H) (N 9 H H))
   ej3 = N 1 (N 3 (N 2 H H) (N 1 (N 1 H H) H))
             (N (-1) (N 4 (N 1 H H) (N 2 H H)) (N 5 H (N 6 H H)))

ej1, ej2, ej3 :: Arbol

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

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

ej3 = N 1 (N 3 (N 2 H H) (N 1 (N 1 H H) H))

(N (-1) (N 4 (N 1 H H) (N 2 H H)) (N 5 H (N 6 H H)))

Definir las funciones

   caminos     :: Arbol -> [[Int]]
   caminosSuma :: Arbol -> Int -> [[Int]]

1 2	caminos :: Arbol -> [[Int]] caminosSuma :: Arbol -> Int -> [[Int]]

tales que

(caminos a) es la lista de los caminos entre dos nodos cualesquiera del árbol a. Por ejemplo,

     λ> caminos ej1
     [[3],[3,2],[3,2,1],[3,2,7],[3,4],[3,4,5],
      [2],[2,1],[2,7],[1],[7],[4],[4,5],[5]]
     λ> caminos ej2
     [[7],[7,5],[7,5,6],[7,8],[7,8,4],[7,8,9],
      [5],[5,6],[6],[8],[8,4],[8,9],[4],[9]]
     λ> length (caminos ej3)
     33

λ> caminos ej1

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

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

λ> caminos ej2

[[7],[7,5],[7,5,6],[7,8],[7,8,4],[7,8,9],

[5],[5,6],[6],[8],[8,4],[8,9],[4],[9]]

λ> length (caminos ej3)

(caminosSuma a k) es la lista de los caminos entre dos nodos cualesquiera del árbol a cuya suma es k. Por ejemplo,

     λ> caminosSuma ej1 3
     [[3],[2,1]]
     λ> caminosSuma ej3 3
     [[3],[-1,4]]
     λ> caminosSuma ej3 4
     [[1,3],[1,-1,4],[3,1],[-1,4,1],[-1,5],[4]]
     λ> caminosSuma ej3 5
     [[1,3,1],[1,-1,4,1],[1,-1,5],[3,2],[3,1,1],[-1,4,2],[4,1],[5]]
     λ> caminosSuma ej3 6
     [[1,3,2],[1,3,1,1],[1,-1,4,2],[4,2],[6]]
     λ> caminosSuma ej3 7
     []

λ> caminosSuma ej1 3

[[3],[2,1]]

λ> caminosSuma ej3 3

[[3],[-1,4]]

λ> caminosSuma ej3 4

[[1,3],[1,-1,4],[3,1],[-1,4,1],[-1,5],[4]]

λ> caminosSuma ej3 5

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

λ> caminosSuma ej3 6

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

λ> caminosSuma ej3 7

[]

Soluciones

data Arbol = H
           | N Int Arbol Arbol
  deriving Show

ej1, ej2, ej3 :: Arbol
ej1 = N 3 (N 2 (N 1 H H) (N 7 H H)) (N 4 H (N 5 H H))
ej2 = N 7 (N 5 (N 6 H H) H) (N 8 (N 4 H H) (N 9 H H))
ej3 = N 1 (N 3 (N 2 H H) (N 1 (N 1 H H) H))
          (N (-1) (N 4 (N 1 H H) (N 2 H H)) (N 5 H (N 6 H H)))
  
caminos :: Arbol -> [[Int]]
caminos H           = []
caminos a@(N r i d) = caminosDesdeRaiz a ++ caminos i ++ caminos d

-- (caminosDesdeRaiz a) es la lista de las caminosDesdeRaiz desde la
-- raíz de a hasta cualquiera de sus nodos. Por ejemplo.
--    λ> caminosDesdeRaiz ej1
--    [[3],[3,2],[3,2,1],[3,2,7],[3,4],[3,4,5]]
--    λ> caminosDesdeRaiz ej2
--    [[7],[7,5],[7,5,6],[7,8],[7,8,4],[7,8,9]]
caminosDesdeRaiz :: Arbol -> [[Int]]
caminosDesdeRaiz H = []
caminosDesdeRaiz (N x i d) =
  [x] : [x:ys | ys <- caminosDesdeRaiz i ++ caminosDesdeRaiz d]

caminosSuma :: Arbol -> Int -> [[Int]]
caminosSuma a k =
  [ys | ys <- caminos a
      , sum ys == k]

data Arbol = H

| N Int Arbol Arbol

deriving Show

ej1, ej2, ej3 :: Arbol

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

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

ej3 = N 1 (N 3 (N 2 H H) (N 1 (N 1 H H) H))

(N (-1) (N 4 (N 1 H H) (N 2 H H)) (N 5 H (N 6 H H)))

caminos :: Arbol -> [[Int]]

caminos H = []

caminos a@(N r i d) = caminosDesdeRaiz a ++ caminos i ++ caminos d

-- (caminosDesdeRaiz a) es la lista de las caminosDesdeRaiz desde la

-- raíz de a hasta cualquiera de sus nodos. Por ejemplo.

-- λ> caminosDesdeRaiz ej1

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

-- λ> caminosDesdeRaiz ej2

-- [[7],[7,5],[7,5,6],[7,8],[7,8,4],[7,8,9]]

caminosDesdeRaiz :: Arbol -> [[Int]]

caminosDesdeRaiz H = []

caminosDesdeRaiz (N x i d) =

[x] : [x:ys | ys <- caminosDesdeRaiz i ++ caminosDesdeRaiz d]

caminosSuma :: Arbol -> Int -> [[Int]]

caminosSuma a k =

[ys | ys <- caminos a

, sum ys == k]

Referencia

Basado en Print all k-sum paths in a binary tree de GeeksforGeeks.

Caminos desde la raíz en un árbol binario

PorJosé A. Alonso 8-febrero-201715-febrero-2017

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

   data Arbol = H
              | N Int Arbol Arbol
     deriving Show

data Arbol = H

| N Int Arbol Arbol

deriving Show

Por ejemplo, los árboles

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

3 7

/ \ / \

2 4 5 8

/ \ \ / / \

1 7 5 6 4 9

se representan por

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

ej1, ej2 :: Arbol

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

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

Definir la función

   caminosDesdeRaiz :: Arbol -> [[Int]]

1	caminosDesdeRaiz :: Arbol -> [[Int]]

tal que (caminosDesdeRaiz a) es la lista de las caminosDesdeRaiz desde la raíz de a hasta cualquiera de sus nodos. Por ejemplo.

   λ> caminosDesdeRaiz ej1
   [[3],[3,2],[3,2,1],[3,2,7],[3,4],[3,4,5]]
   λ> caminosDesdeRaiz ej2
   [[7],[7,5],[7,5,6],[7,8],[7,8,4],[7,8,9]]

λ> caminosDesdeRaiz ej1

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

λ> caminosDesdeRaiz ej2

[[7],[7,5],[7,5,6],[7,8],[7,8,4],[7,8,9]]

Soluciones

data Arbol = H
           | N Int Arbol Arbol
  deriving Show

ej1, ej2 :: Arbol
ej1 = N 3 (N 2 (N 1 H H) (N 7 H H)) (N 4 H (N 5 H H))
ej2 = N 7 (N 5 (N 6 H H) H) (N 8 (N 4 H H) (N 9 H H))
  
caminosDesdeRaiz :: Arbol -> [[Int]]
caminosDesdeRaiz H = []
caminosDesdeRaiz (N x i d) =
  [x] : [x:ys | ys <- caminosDesdeRaiz i ++ caminosDesdeRaiz d]

data Arbol = H

| N Int Arbol Arbol

deriving Show

ej1, ej2 :: Arbol

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

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

caminosDesdeRaiz :: Arbol -> [[Int]]

caminosDesdeRaiz H = []

caminosDesdeRaiz (N x i d) =

[x] : [x:ys | ys <- caminosDesdeRaiz i ++ caminosDesdeRaiz d]

Prefijo con suma acotada

PorJosé A. Alonso 7-febrero-201714-febrero-2017

Definir la función

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

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

tal que (prefijoAcotado x ys) es el mayor prefijo de ys cuya suma es menor que x. Por ejemplo,

   prefijoAcotado 10 [3,2,5,7]  ==  [3,2]
   prefijoAcotado 10 [1..]      ==  [1,2,3]

1 2	prefijoAcotado 10 [3,2,5,7] == [3,2] prefijoAcotado 10 [1..] == [1,2,3]

Soluciones

-- 1ª definición (por recursión):
prefijoAcotado :: (Num a, Ord a) => a -> [a] -> [a]
prefijoAcotado x [] = []
prefijoAcotado x (y:ys)
  | y < x     = y : prefijoAcotado (x-y) ys
  | otherwise = []

-- 2ª definición (con scanl1 y takeWhile):
prefijoAcotado2 :: (Num a, Ord a) => a -> [a] -> [a]
prefijoAcotado2 x ys = map fst conSumasAcotadas
  where 
    sumas            = scanl1 (+) ys 
    conSumas         = zip ys sumas
    conSumasAcotadas = takeWhile (\(a,b) -> b < x) conSumas

-- 3ª definición (con (.)):
prefijoAcotado3 :: (Num a, Ord a) => a -> [a] -> [a]
prefijoAcotado3 x ys = map fst conSumasAcotadas
  where 
    sumas            = scanl1 (+) ys 
    conSumas         = zip ys sumas
    conSumasAcotadas = takeWhile ((<x) . snd) conSumas

-- 4ª definición:
prefijoAcotado4 :: (Num a, Ord a) => a -> [a] -> [a]
prefijoAcotado4 x ys = 
    map fst (takeWhile ((<x) . snd) (zip ys (scanl1 (+) ys)))

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

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

prefijoAcotado x [] = []

prefijoAcotado x (y:ys)

| y < x = y : prefijoAcotado (x-y) ys

| otherwise = []

-- 2ª definición (con scanl1 y takeWhile):

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

prefijoAcotado2 x ys = map fst conSumasAcotadas

where

sumas = scanl1 (+) ys

conSumas = zip ys sumas

conSumasAcotadas = takeWhile (\(a,b) -> b < x) conSumas

-- 3ª definición (con (.)):

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

prefijoAcotado3 x ys = map fst conSumasAcotadas

where

sumas = scanl1 (+) ys

conSumas = zip ys sumas

conSumasAcotadas = takeWhile ((<x) . snd) conSumas

-- 4ª definición:

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

prefijoAcotado4 x ys =

map fst (takeWhile ((<x) . snd) (zip ys (scanl1 (+) ys)))

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencia

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico