Inicial – Página 3

Mayor prefijo común

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

Definir la función

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

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

tal que (mayorPrefijoComun xs ys) calcula el mayor prefijo común a xs e ys. Por ejemplo,

   mayorPrefijoComun "masa" "madre"       == "ma"
   mayorPrefijoComun "masa" "padre"       == ""
   mayorPrefijoComun "hola" "hielo"       == "h"
   mayorPrefijoComun "helado" "heladeria" == "helad"

mayorPrefijoComun "masa" "madre" == "ma"

mayorPrefijoComun "masa" "padre" == ""

mayorPrefijoComun "hola" "hielo" == "h"

mayorPrefijoComun "helado" "heladeria" == "helad"

Soluciones

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

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

-- 1ª solución

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

mayorPrefijoComun _ [] = []

mayorPrefijoComun [] _ = []

mayorPrefijoComun (x:xs) (y:ys)

| x == y = x : mayorPrefijoComun xs ys

| otherwise = []

-- 2ª solución

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

mayorPrefijoComun2 xs ys =

[x | (x,_) <- takeWhile iguales (zip xs ys)]

where iguales (x,y) = x == y

Pensamiento

Los ojos por que suspiras,
sábelo bien,
los ojos en que te miras
son ojos porque te ven.

Antonio Machado

Listas decrecientes

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

Definir la función

   listasDecrecientesDesde :: Int -> [[Int]]

1	listasDecrecientesDesde :: Int -> [[Int]]

tal que (listasDecrecientesDesde n) es la lista de las sucesiones estrictamente decrecientes cuyo primer elemento es n. Por ejemplo,

   ghci> listasDecrecientesDesde 2
   [[2],[2,1],[2,1,0],[2,0]]
   ghci> listasDecrecientesDesde 3
   [[3],[3,2],[3,2,1],[3,2,1,0],[3,2,0],[3,1],[3,1,0],[3,0]]

ghci> listasDecrecientesDesde 2

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

ghci> listasDecrecientesDesde 3

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

Soluciones

-- 1ª solución
listasDecrecientesDesde :: Int -> [[Int]]
listasDecrecientesDesde 0 = [[0]]
listasDecrecientesDesde n =
  [n] : [n:ys | m <- [n-1,n-2..0], ys <- listasDecrecientesDesde m]

-- 2ª solución
listasDecrecientesDesde2 :: Int -> [[Int]]
listasDecrecientesDesde2 0 = [[0]]
listasDecrecientesDesde2 n =
  [n] : [n:xs | m <- [0..n-1], xs <- listasDecrecientesDesde2 m]

-- 1ª solución

listasDecrecientesDesde :: Int -> [[Int]]

listasDecrecientesDesde 0 = [[0]]

listasDecrecientesDesde n =

[n] : [n:ys | m <- [n-1,n-2..0], ys <- listasDecrecientesDesde m]

-- 2ª solución

listasDecrecientesDesde2 :: Int -> [[Int]]

listasDecrecientesDesde2 0 = [[0]]

listasDecrecientesDesde2 n =

[n] : [n:xs | m <- [0..n-1], xs <- listasDecrecientesDesde2 m]

Pensamiento

Viejo como el mundo es
-dijo un doctor-, olvidado,
por sabido, y enterrado
cuál la momia de Ramsés.

Mas el doctor no sabía
que hoy es siempre todavía.

Antonio Machado

Último dígito no nulo del factorial

PorJosé A. Alonso 12-noviembre-201920-noviembre-2019

El factorial de 7 es

   7! = 1 * 2 * 3 * 4 * 5 * 6 * 7 = 5040

1	7! = 1 * 2 * 3 * 4 * 5 * 6 * 7 = 5040

por tanto, el último dígito no nulo del factorial de 7 es 4.

Definir la función

   ultimoNoNuloFactorial :: Integer -> Integer

1	ultimoNoNuloFactorial :: Integer -> Integer

tal que (ultimoNoNuloFactorial n) es el último dígito no nulo del factorial de n. Por ejemplo,

   ultimoNoNuloFactorial  7  == 4
   ultimoNoNuloFactorial 10  == 8
   ultimoNoNuloFactorial 12  == 6
   ultimoNoNuloFactorial 97  == 2
   ultimoNoNuloFactorial  0  == 1

ultimoNoNuloFactorial 7 == 4

ultimoNoNuloFactorial 10 == 8

ultimoNoNuloFactorial 12 == 6

ultimoNoNuloFactorial 97 == 2

ultimoNoNuloFactorial 0 == 1

Comprobar con QuickCheck que si n es mayor que 4, entonces el último dígito no nulo del factorial de n es par.

Soluciones

import Data.Char (digitToInt)
import Test.QuickCheck

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

ultimoNoNuloFactorial :: Integer -> Integer
ultimoNoNuloFactorial = ultimoNoNulo . factorial

-- (factorial n) es el factorial de n. Por ejemplo,
--    factorial 7  ==  5040
factorial :: Integer -> Integer
factorial n = product [1..n]

-- (ultimoNoNulo n) es el último dígito no nulo de n. Por ejemplo,
--    ultimoNoNulo 5040  ==  4
ultimoNoNulo :: Integer -> Integer
ultimoNoNulo n | r /= 0    = r
               | otherwise = ultimoNoNulo q
  where (q,r) = n `quotRem` 10

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

ultimoNoNuloFactorial2 :: Integer -> Integer
ultimoNoNuloFactorial2 = last . filter (/= 0) . digitos . factorial

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

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

ultimoNoNuloFactorial3 :: Integer -> Integer
ultimoNoNuloFactorial3 = last . filter (/= 0) . digitos3 . factorial3

digitos3 :: Integer -> [Integer]
digitos3 = map (fromIntegral . digitToInt) . show

factorial3 :: Integer -> Integer
factorial3 = product . enumFromTo 1

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

ultimoNoNulo4 :: Integer -> Integer
ultimoNoNulo4 n = read [head (dropWhile (=='0') (reverse (show n)))]

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

ultimoNoNulo5 :: Integer -> Integer
ultimoNoNulo5 =
  read . return . head . dropWhile ('0' ==) . reverse . show

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

-- La propiedad es
prop_ultimoNoNuloFactorial :: Integer -> Property
prop_ultimoNoNuloFactorial n = 
  n > 4 ==> even (ultimoNoNuloFactorial n)
                  
-- La comprobación es
--    ghci> quickCheck prop_ultimoNoNuloFactorial
--    +++ OK, passed 100 tests.

import Data.Char (digitToInt)

import Test.QuickCheck

-- 1ª solución

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

ultimoNoNuloFactorial :: Integer -> Integer

ultimoNoNuloFactorial = ultimoNoNulo . factorial

-- (factorial n) es el factorial de n. Por ejemplo,

-- factorial 7 == 5040

factorial :: Integer -> Integer

factorial n = product [1..n]

-- (ultimoNoNulo n) es el último dígito no nulo de n. Por ejemplo,

-- ultimoNoNulo 5040 == 4

ultimoNoNulo :: Integer -> Integer

ultimoNoNulo n | r /= 0 = r

| otherwise = ultimoNoNulo q

where (q,r) = n `quotRem` 10

-- 2ª solución

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

ultimoNoNuloFactorial2 :: Integer -> Integer

ultimoNoNuloFactorial2 = last . filter (/= 0) . digitos . factorial

digitos :: Integer -> [Integer]

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

-- 3ª solución

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

ultimoNoNuloFactorial3 :: Integer -> Integer

ultimoNoNuloFactorial3 = last . filter (/= 0) . digitos3 . factorial3

digitos3 :: Integer -> [Integer]

digitos3 = map (fromIntegral . digitToInt) . show

factorial3 :: Integer -> Integer

factorial3 = product . enumFromTo 1

-- 4ª solución

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

ultimoNoNulo4 :: Integer -> Integer

ultimoNoNulo4 n = read [head (dropWhile (=='0') (reverse (show n)))]

-- 5ª solución

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

ultimoNoNulo5 :: Integer -> Integer

ultimoNoNulo5 =

read . return . head . dropWhile ('0' ==) . reverse . show

-- Propiedad

-- =========

-- La propiedad es

prop_ultimoNoNuloFactorial :: Integer -> Property

prop_ultimoNoNuloFactorial n =

n > 4 ==> even (ultimoNoNuloFactorial n)

-- La comprobación es

-- ghci> quickCheck prop_ultimoNoNuloFactorial

-- +++ OK, passed 100 tests.

Pensamiento

Busca el tu esencial,
que no está en ninguna parte
y en todas partes está.

Antonio Machado

Mayor producto de n dígitos consecutivos de un número

PorJosé A. Alonso 14-mayo-201925-abril-2021

Definir la función

   mayorProducto :: Int -> Integer -> Integer

1	mayorProducto :: Int -> Integer -> Integer

tal que (mayorProducto n x) es el mayor producto de n dígitos consecutivos del número x (suponiendo que x tiene al menos n dígitos). Por ejemplo,

   mayorProducto 2 325                  ==  10
   mayorProducto 5 11111                ==  1
   mayorProducto 5 113111               ==  3
   mayorProducto 5 110111               ==  0
   mayorProducto 5 10151112             ==  10
   mayorProducto 5 101511124            ==  10
   mayorProducto 5 (product [1..1000])  ==  41472

mayorProducto 2 325 == 10

mayorProducto 5 11111 == 1

mayorProducto 5 113111 == 3

mayorProducto 5 110111 == 0

mayorProducto 5 10151112 == 10

mayorProducto 5 101511124 == 10

mayorProducto 5 (product [1..1000]) == 41472

Soluciones

import Test.QuickCheck
import Data.List (inits, tails)
import Data.Char (digitToInt)

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

mayorProducto1 :: Int -> Integer -> Integer
mayorProducto1 n x =
  maximum [product xs | xs <- segmentos n (cifras x)]

-- (cifras x) es la lista de las cifras del número x. Por ejemplo, 
--    cifras 325  ==  [3,2,5]
cifras :: Integer -> [Integer]
cifras x = map (toInteger . digitToInt) (show x)

-- (segmentos n xs) es la lista de los segmentos de longitud n de la
-- lista xs. Por ejemplo,
--    segmentos 2 [3,5,4,6]  ==  [[3,5],[5,4],[4,6]]
segmentos :: Int -> [Integer] -> [[Integer]]
segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))

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

mayorProducto2 :: Int -> Integer -> Integer
mayorProducto2 n x = maximum (aux ns)
    where ns     = [read [d] | d <- show x]
          aux xs | length xs < n = []
                 | otherwise     = product (take n xs) : aux (tail xs)

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

mayorProducto3 :: Int -> Integer -> Integer
mayorProducto3 n = maximum
                 . map (product . take n)
                 . filter ((>=n) . length) 
                 . tails
                 . cifras

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

mayorProducto4 :: Int -> Integer -> Integer
mayorProducto4 n = maximum  
                 . map (product . map (fromIntegral . digitToInt)) 
                 . filter ((==n) . length) 
                 . concatMap inits
                 . tails 
                 . show

-- ---------------------------------------------------------------------
-- Comparación de soluciones                                          --
-- ---------------------------------------------------------------------

-- Tiempo (en segundos) del cálculo de (mayorProducto 5 (product [1..n]))
-- 
--    | Def | 500  | 1000 | 5000 | 10000 
--    | 1   | 0.01 | 0.02 | 0.06 | 0.11
--    | 2   | 0.01 | 0.03 | 0.80 | 3.98
--    | 3   | 0.01 | 0.03 | 0.82 | 4.13
--    | 4   | 2.77 |      |      |

import Test.QuickCheck

import Data.List (inits, tails)

import Data.Char (digitToInt)

-- 1ª solución

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

mayorProducto1 :: Int -> Integer -> Integer

mayorProducto1 n x =

maximum [product xs | xs <- segmentos n (cifras x)]

-- (cifras x) es la lista de las cifras del número x. Por ejemplo,

-- cifras 325 == [3,2,5]

cifras :: Integer -> [Integer]

cifras x = map (toInteger . digitToInt) (show x)

-- (segmentos n xs) es la lista de los segmentos de longitud n de la

-- lista xs. Por ejemplo,

-- segmentos 2 [3,5,4,6] == [[3,5],[5,4],[4,6]]

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

segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))

-- 2ª solución

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

mayorProducto2 :: Int -> Integer -> Integer

mayorProducto2 n x = maximum (aux ns)

where ns = [read [d] | d <- show x]

aux xs | length xs < n = []

| otherwise = product (take n xs) : aux (tail xs)

-- 3ª solución

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

mayorProducto3 :: Int -> Integer -> Integer

mayorProducto3 n = maximum

. map (product . take n)

. filter ((>=n) . length)

. tails

. cifras

-- 4ª solución

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

mayorProducto4 :: Int -> Integer -> Integer

mayorProducto4 n = maximum

. map (product . map (fromIntegral . digitToInt))

. filter ((==n) . length)

. concatMap inits

. tails

. show

-- ---------------------------------------------------------------------

-- Comparación de soluciones --

-- ---------------------------------------------------------------------

-- Tiempo (en segundos) del cálculo de (mayorProducto 5 (product [1..n]))

-- | Def | 500 | 1000 | 5000 | 10000

-- | 1 | 0.01 | 0.02 | 0.06 | 0.11

-- | 2 | 0.01 | 0.03 | 0.80 | 3.98

-- | 3 | 0.01 | 0.03 | 0.82 | 4.13

-- | 4 | 2.77 | | |

Pensamiento

A las palabras de amor
les sienta bien su poquito
de exageración.

Antonio Machado

Elementos no repetidos

PorJosé A. Alonso 22-abril-20191-mayo-2019

Definir la función

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

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

tal que (noRepetidos xs) es la lista de los elementos no repetidos de la lista xs. Por ejemplo,

   noRepetidos [3,2,5,2,4,7,3]  ==  [5,4,7]
   noRepetidos "noRepetidos"    ==  "nRptids"
   noRepetidos "Roma"           ==  "Roma"

noRepetidos [3,2,5,2,4,7,3] == [5,4,7]

noRepetidos "noRepetidos" == "nRptids"

noRepetidos "Roma" == "Roma"

Soluciones

import Test.QuickCheck

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

noRepetidos :: Eq a => [a] -> [a]
noRepetidos xs = 
  [x | x <- xs, ocurrencias x xs == 1]
  
-- (ocurrencias x ys) es el número de ocurrencias de x en ys. Por
-- ejemplo,
--    ocurrencias 3 [3,2,5,2,4,7,3]  ==  2
--    ocurrencias 5 [3,2,5,2,4,7,3]  ==  1
ocurrencias :: Eq a => a -> [a] -> Int
ocurrencias x ys = 
  length [y | y <- ys, y == x]

-- 2ª solución
-- ===========
noRepetidos2 :: Eq a => [a] -> [a]
noRepetidos2 [] = []
noRepetidos2 (x:xs) | elem x xs = noRepetidos2 [y | y <- xs, y /= x]
                    | otherwise = x : noRepetidos2 xs

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

-- La propiedad de equivalencia es
prop_equivalencia :: [Int] -> Bool
prop_equivalencia xs =
  noRepetidos xs == noRepetidos2 xs

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

import Test.QuickCheck

-- 1ª solución

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

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

noRepetidos xs =

[x | x <- xs, ocurrencias x xs == 1]

-- (ocurrencias x ys) es el número de ocurrencias de x en ys. Por

-- ejemplo,

-- ocurrencias 3 [3,2,5,2,4,7,3] == 2

-- ocurrencias 5 [3,2,5,2,4,7,3] == 1

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

ocurrencias x ys =

length [y | y <- ys, y == x]

-- 2ª solución

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

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

noRepetidos2 [] = []

noRepetidos2 (x:xs) | elem x xs = noRepetidos2 [y | y <- xs, y /= x]

| otherwise = x : noRepetidos2 xs

-- Equivalencia

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

-- La propiedad de equivalencia es

prop_equivalencia :: [Int] -> Bool

prop_equivalencia xs =

noRepetidos xs == noRepetidos2 xs

-- La comprobación es

-- ghci> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

Pensamiento

Y en perfecto rimo
— así a la vera del agua
el doble chopo del río.

Antonio Machado

La conjetura de Collatz

PorJosé A. Alonso 9-abril-201926-marzo-2022

La conjetura de Collatz, conocida también como conjetura 3n+1, fue enunciada por Lothar Collatz en 1937 y, hasta la fecha, no se ha resuelto.

La conjetura hace referencia a una propiedad de las sucesiones de Siracusa. La sucesión de Siracusa de un número entero positivo x es la sucesión cuyo primer término es x y el siguiente de un término se obtiene dividiéndolo entre 2, si es par o multiplicándolo por 3 y sumándole 1, si es impar. Por ejemplo, la sucesión de Siracusa de 12 es

   12, 6, 3, 10, 5, 16, 8, 4, 2, 1, 4, 2, 1, 4, 2, 1, 4, 2, 1, 4, ....

1	12, 6, 3, 10, 5, 16, 8, 4, 2, 1, 4, 2, 1, 4, 2, 1, 4, 2, 1, 4, ....

La conjetura de Collatz afirma que para todo número entero positivo x, el 1 pertenece a la sucesión de Siracusa de x.

Definir las funciones

   siracusa        :: Integer -> [Integer]
   graficaSiracusa :: Int -> [Integer] -> IO ()

1 2	siracusa :: Integer -> [Integer] graficaSiracusa :: Int -> [Integer] -> IO ()

tales que

(siracusa x) es la sucesión de Siracusa de x. Por ejemplo,

     λ> take 20 (siracusa 12)
     [12,6,3,10,5,16,8,4,2,1,4,2,1,4,2,1,4,2,1,4]
     λ> take 20 (siracusa 22)
     [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1,4,2,1,4]

λ> take 20 (siracusa 12)

[12,6,3,10,5,16,8,4,2,1,4,2,1,4,2,1,4,2,1,4]

λ> take 20 (siracusa 22)

[22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1,4,2,1,4]

(graficaSiracusa n xs) dibuja los n primeros términos de las sucesiones de Siracusas de los elementos de xs. Por ejemplo, (graficaSiracusa 100 [27]) dibuja

y (graficaSiracusa 150 [1..1000]) dibuja

Comprobar con QuickCheck la conjetura de Collatz.

Soluciones

import Test.QuickCheck
import Graphics.Gnuplot.Simple

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

siracusa :: Integer -> [Integer]
siracusa n | even n    = n : siracusa (n `div` 2)
           | otherwise = n : siracusa (3*n+1)

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

siracusa2 :: Integer -> [Integer]
siracusa2 = iterate siguiente 
  where siguiente x | even x    = x `div` 2
                    | otherwise = 3*x+1

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

-- La comparación es
--    λ> siracusa 12 !! (10^6)
--    4
--    (0.55 secs, 362,791,008 bytes)
--    λ> siracusa 12 !! (2*10^6)
--    2
--    (1.05 secs, 725,456,376 bytes)
--    λ> siracusa2 12 !! (10^6)
--    4
--    (1.66 secs, 647,189,664 bytes)
--    λ> siracusa2 12 !! (2*10^6)
--    2
--    (3.11 secs, 1,294,286,792 bytes)

-- Definición de graficaSiracusa
-- =============================

graficaSiracusa :: Int -> [Integer] -> IO ()
graficaSiracusa n xs =
  plotLists [ Key Nothing
            , PNG "La_conjetura_de_Collatz.png"
            ]
            [take n (siracusa x) | x <- xs]

-- Comprobación de la conjetura
-- ============================

-- La conjetura es
conjeturaCollatz :: Positive Integer -> Bool
conjeturaCollatz (Positive n) =
  1 `elem` siracusa n

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

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- 1ª definición de siracusa

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

siracusa :: Integer -> [Integer]

siracusa n | even n = n : siracusa (n `div` 2)

| otherwise = n : siracusa (3*n+1)

-- 2ª definición de siracusa

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

siracusa2 :: Integer -> [Integer]

siracusa2 = iterate siguiente

where siguiente x | even x = x `div` 2

| otherwise = 3*x+1

-- Comparación de eficiencia

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

-- La comparación es

-- λ> siracusa 12 !! (10^6)

-- 4

-- (0.55 secs, 362,791,008 bytes)

-- λ> siracusa 12 !! (2*10^6)

-- 2

-- (1.05 secs, 725,456,376 bytes)

-- λ> siracusa2 12 !! (10^6)

-- 4

-- (1.66 secs, 647,189,664 bytes)

-- λ> siracusa2 12 !! (2*10^6)

-- 2

-- (3.11 secs, 1,294,286,792 bytes)

-- Definición de graficaSiracusa

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

graficaSiracusa :: Int -> [Integer] -> IO ()

graficaSiracusa n xs =

plotLists [ Key Nothing

, PNG "La_conjetura_de_Collatz.png"

]

[take n (siracusa x) | x <- xs]

-- Comprobación de la conjetura

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

-- La conjetura es

conjeturaCollatz :: Positive Integer -> Bool

conjeturaCollatz (Positive n) =

1 `elem` siracusa n

-- La comprobación es

-- λ> quickCheck conjeturaCollatz

-- +++ OK, passed 100 tests.

Pensamiento

Que el caminante es suma del camino …

Antonio Machado

Números en una cadena

PorJosé A. Alonso 8-abril-201923-abril-2019

Definir la función

   numeros :: String -> [Int]

1	numeros :: String -> [Int]

tal que (numeros cs) es la lista de los números enteros no negativos de la cadena cs. Por ejemplo,

   λ> numeros "Esta cadena tiene 3 numeros: el 16 y el 2019 solamente." 
   [3,16,2019]
   λ> numeros "Esta cadena tiene 3 numeros naturales: -2 más 2 es 0" 
   [3,2,0]
   λ> numeros "Esta cadena tiene 1 numero natural: 2.5 no es entereo" 
   [1]

λ> numeros "Esta cadena tiene 3 numeros: el 16 y el 2019 solamente."

[3,16,2019]

λ> numeros "Esta cadena tiene 3 numeros naturales: -2 más 2 es 0"

[3,2,0]

λ> numeros "Esta cadena tiene 1 numero natural: 2.5 no es entereo"

[1]

Soluciones

import Data.Char  (isDigit)

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

numeros :: String -> [Int]
numeros cs = map read (filter esNumero (words cs))

-- (esNumero cs) se verifica si la cadena no vacía cs representa
-- un número entero. Por ejemplo,
--    esNumero "2019"  ==  True
--    esNumero "20.9"  ==  False
--    esNumero "201a"  ==  False
esNumero :: String -> Bool
esNumero = all (`elem` ['0'..'9'])

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

numeros2 :: String -> [Int]
numeros2 cs = map read (filter (all isDigit) (words cs))

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

numeros3 :: String -> [Int]
numeros3 = map read . filter (all isDigit) . words

import Data.Char (isDigit)

-- 1ª definición

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

numeros :: String -> [Int]

numeros cs = map read (filter esNumero (words cs))

-- (esNumero cs) se verifica si la cadena no vacía cs representa

-- un número entero. Por ejemplo,

-- esNumero "2019" == True

-- esNumero "20.9" == False

-- esNumero "201a" == False

esNumero :: String -> Bool

esNumero = all (`elem` ['0'..'9'])

-- 2ª solución

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

numeros2 :: String -> [Int]

numeros2 cs = map read (filter (all isDigit) (words cs))

-- 3ª solución

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

numeros3 :: String -> [Int]

numeros3 = map read . filter (all isDigit) . words

Pensamiento

Tu profecía, poeta.
— Mañana hablarán los mudos:
el corazón y la piedra.

Antonio Machado

Árbol binario de divisores

PorJosé A. Alonso 1-abril-201925-abril-2021

El árbol binario de los divisores de 90 es

2 45

3 15

3 5

Se puede representar por

   N 90 (H 2) (N 45 (H 3) (N 15 (H 3) (H 5)))

1	N 90 (H 2) (N 45 (H 3) (N 15 (H 3) (H 5)))

usando el tipo de dato definido por

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

data Arbol = H Int

| N Int Arbol Arbol

deriving (Eq, Show)

Análogamente se obtiene el árbol binario de cualquier número x: se comienza en x y en cada paso se tiene dos hijos (su menor divisor y su cociente) hasta obtener números primos en las hojas.

Definir las funciones

   arbolDivisores      :: Int -> Arbol
   hojasArbolDivisores :: Int -> [Int]

1 2	arbolDivisores :: Int -> Arbol hojasArbolDivisores :: Int -> [Int]

tales que

(arbolDivisores x) es el árbol binario de los divisores de x. Por ejemplo,

     λ> arbolDivisores 90
     N 90 (H 2) (N 45 (H 3) (N 15 (H 3) (H 5)))
     λ> arbolDivisores 24
     N 24 (H 2) (N 12 (H 2) (N 6 (H 2) (H 3)))
     λ> arbolDivisores 300
     N 300 (H 2) (N 150 (H 2) (N 75 (H 3) (N 25 (H 5) (H 5))))

λ> arbolDivisores 90

N 90 (H 2) (N 45 (H 3) (N 15 (H 3) (H 5)))

λ> arbolDivisores 24

N 24 (H 2) (N 12 (H 2) (N 6 (H 2) (H 3)))

λ> arbolDivisores 300

N 300 (H 2) (N 150 (H 2) (N 75 (H 3) (N 25 (H 5) (H 5))))

(hojasArbolDivisores x) es la lista de las hohas del árbol binario de los divisores de x. Por ejemplo

     hojasArbolDivisores 90   ==  [2,3,3,5]
     hojasArbolDivisores 24   ==  [2,2,2,3]
     hojasArbolDivisores 300  ==  [2,2,3,5,5]

hojasArbolDivisores 90 == [2,3,3,5]

hojasArbolDivisores 24 == [2,2,2,3]

hojasArbolDivisores 300 == [2,2,3,5,5]

Soluciones

import Data.Numbers.Primes (primeFactors)

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

-- Definición de arbolDivisores
-- ============================

arbolDivisores :: Int -> Arbol
arbolDivisores x
  | y == x    = H x
  | otherwise = N x (H y) (arbolDivisores (x `div` y))
  where y = menorDivisor x

-- (menorDivisor x) es el menor divisor primo de x. Por ejemplo,
--    menorDivisor 45  ==  3
--    menorDivisor 5   ==  5
menorDivisor :: Int -> Int
menorDivisor x =
  head [y | y <- [2..x], x `mod` y == 0]

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

hojasArbolDivisores :: Int -> [Int]
hojasArbolDivisores = hojas . arbolDivisores

-- (hojas a) es la lista de las hojas del árbol a. Por ejemplo,
--    hojas (N 3 (H 4) (N 5 (H 7) (H 2)))  ==  [4,7,2]
hojas :: Arbol -> [Int]
hojas (H x)     = [x]
hojas (N _ i d) = hojas i ++ hojas d

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

hojasArbolDivisores2 :: Int -> [Int]
hojasArbolDivisores2 = primeFactors

import Data.Numbers.Primes (primeFactors)

data Arbol = H Int

| N Int Arbol Arbol

deriving (Eq, Show)

-- Definición de arbolDivisores

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

arbolDivisores :: Int -> Arbol

arbolDivisores x

| y == x = H x

| otherwise = N x (H y) (arbolDivisores (x `div` y))

where y = menorDivisor x

-- (menorDivisor x) es el menor divisor primo de x. Por ejemplo,

-- menorDivisor 45 == 3

-- menorDivisor 5 == 5

menorDivisor :: Int -> Int

menorDivisor x =

head [y | y <- [2..x], x `mod` y == 0]

-- 1ª definición de hojasArbolDivisores

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

hojasArbolDivisores :: Int -> [Int]

hojasArbolDivisores = hojas . arbolDivisores

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

-- hojas (N 3 (H 4) (N 5 (H 7) (H 2))) == [4,7,2]

hojas :: Arbol -> [Int]

hojas (H x) = [x]

hojas (N _ i d) = hojas i ++ hojas d

-- 2ª definición de hojasArbolDivisores

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

hojasArbolDivisores2 :: Int -> [Int]

hojasArbolDivisores2 = primeFactors

Pensamiento

Entre las brevas soy blando;
entre las rocas, de piedra.
¡Malo!

Antonio Machado

El problema del número perdido

PorJosé A. Alonso 25-marzo-201926-marzo-2022

Sea xs una lista de números consecutivos (creciente o decreciente), en la que puede faltar algún número. El problema del número perdido en xs consiste en lo siguiente:

si falta un único número z, devolver Just z
si no falta ninguno, devolver Nothing

Definir la función

   numeroPerdido :: [Int] -> Maybe Int

1	numeroPerdido :: [Int] -> Maybe Int

tal que (numeroPerdido xs) es el resultado del problema del número perdidio en xs. Por ejemplo,

   numeroPerdido [7,6,4,3]                     == Just 5
   numeroPerdido [1,2,4,5,6]                   == Just 3
   numeroPerdido [6,5..3]                      == Nothing
   numeroPerdido [1..6]                        == Nothing
   numeroPerdido ([5..10^6] ++ [10^6+2..10^7]) == Just 1000001

numeroPerdido [7,6,4,3] == Just 5

numeroPerdido [1,2,4,5,6] == Just 3

numeroPerdido [6,5..3] == Nothing

numeroPerdido [1..6] == Nothing

numeroPerdido ([5..10^6] ++ [10^6+2..10^7]) == Just 1000001

Soluciones

import Data.List (tails, sort)
import Data.Maybe (listToMaybe)

-- 1ª solución
numeroPerdido :: [Int] -> Maybe Int
numeroPerdido (x:y:xs)
  | abs (y - x) == 1 = numeroPerdido (y:xs)
  | otherwise        = Just (div (x+y) 2)
numeroPerdido _      = Nothing

-- 2ª solución
numeroPerdido2 :: [Int] -> Maybe Int
numeroPerdido2 xs = aux z (z:zs) 
  where (z:zs) = sort xs
        aux _ [] = Nothing
        aux y (x:xs) | y == x    = aux (y+1) xs
                     | otherwise = Just y

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

numeroPerdido3 :: [Int] -> Maybe Int
numeroPerdido3 xs =
  listToMaybe [(a+b) `div` 2 | (a:b:_) <- tails xs, abs(a-b) /= 1]

import Data.List (tails, sort)

import Data.Maybe (listToMaybe)

-- 1ª solución

numeroPerdido :: [Int] -> Maybe Int

numeroPerdido (x:y:xs)

| abs (y - x) == 1 = numeroPerdido (y:xs)

| otherwise = Just (div (x+y) 2)

numeroPerdido _ = Nothing

-- 2ª solución

numeroPerdido2 :: [Int] -> Maybe Int

numeroPerdido2 xs = aux z (z:zs)

where (z:zs) = sort xs

aux _ [] = Nothing

aux y (x:xs) | y == x = aux (y+1) xs

| otherwise = Just y

-- 3ª solución

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

numeroPerdido3 :: [Int] -> Maybe Int

numeroPerdido3 xs =

listToMaybe [(a+b) `div` 2 | (a:b:_) <- tails xs, abs(a-b) /= 1]

Pensamiento

¡Reventó de risa!
¡Un hombre tan serio!
… Nadie lo diría.

Antonio Machado

Siguiente mayor

PorJosé A. Alonso 20-marzo-201926-marzo-2022

Definir la función

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

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

tal que (siguienteMayos xs) es la lista obtenida sustiyendo cada elemento de xs por el primer elemento de xs a la derechha de x que sea mayor que x, si existe y Nothing en caso contrario. Por ejemplo,

   λ> siguienteMayor [4,5,2,3,9]
   [Just 5,Just 9,Just 3,Just 9,Nothing]
   λ> siguienteMayor [9,5,2,3,4]
   [Nothing,Nothing,Just 3,Just 4,Nothing]
   λ> siguienteMayor [9,5,2,2,4]
   [Nothing,Nothing,Just 4,Just 4,Nothing]
   λ> siguienteMayor "betis"
   [Just 'e',Just 't',Nothing,Just 's',Nothing]
   λ> siguienteMayor "sevilla"
   [Just 'v',Just 'v',Nothing,Just 'l',Nothing,Nothing,Nothing]

λ> siguienteMayor [4,5,2,3,9]

[Just 5,Just 9,Just 3,Just 9,Nothing]

λ> siguienteMayor [9,5,2,3,4]

[Nothing,Nothing,Just 3,Just 4,Nothing]

λ> siguienteMayor [9,5,2,2,4]

[Nothing,Nothing,Just 4,Just 4,Nothing]

λ> siguienteMayor "betis"

[Just 'e',Just 't',Nothing,Just 's',Nothing]

λ> siguienteMayor "sevilla"

[Just 'v',Just 'v',Nothing,Just 'l',Nothing,Nothing,Nothing]

Soluciones

import Data.Maybe (listToMaybe)

-- 1ª solución
siguienteMayor :: Ord a => [a] -> [Maybe a]
siguienteMayor [] = []
siguienteMayor (x:xs)
  | null ys   = Nothing : siguienteMayor xs
  | otherwise = Just (head ys) : siguienteMayor xs
  where ys = [y | y <- xs, y > x]

-- 2ª solución
siguienteMayor2 :: Ord a => [a] -> [Maybe a]
siguienteMayor2 []     = []
siguienteMayor2 (x:xs) = listToMaybe [y | y <- xs, y > x] : siguienteMayor2 xs

-- 3ª solución
siguienteMayor3 :: Ord a => [a] -> [Maybe a]
siguienteMayor3 []     = []
siguienteMayor3 (x:xs) = listToMaybe (dropWhile (<=x) xs) : siguienteMayor3 xs

import Data.Maybe (listToMaybe)

-- 1ª solución

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

siguienteMayor [] = []

siguienteMayor (x:xs)

| null ys = Nothing : siguienteMayor xs

| otherwise = Just (head ys) : siguienteMayor xs

where ys = [y | y <- xs, y > x]

-- 2ª solución

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

siguienteMayor2 [] = []

siguienteMayor2 (x:xs) = listToMaybe [y | y <- xs, y > x] : siguienteMayor2 xs

-- 3ª solución

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

siguienteMayor3 [] = []

siguienteMayor3 (x:xs) = listToMaybe (dropWhile (<=x) xs) : siguienteMayor3 xs

Pensamiento

Si vivir es bueno
es mejor soñar,
y mejor que todo,
madre, despertar.

Antonio Machado

Permutación de elementos consecutivos

PorJosé A. Alonso 18-marzo-201925-marzo-2019

Definir la función

   permutaConsecutivos :: [a] -> [a]

1	permutaConsecutivos :: [a] -> [a]

tal que (permutaConsecutivos xs) es la lista obtenida permutando los elementos consecutivos de xs. Por ejemplo,

   permutaConsecutivos [1..8]         ==  [2,1,4,3,6,5,8,7]
   permutaConsecutivos [1..9]         ==  [2,1,4,3,6,5,8,7,9]
   permutaConsecutivos "simplemente"  ==  "ispmelemtne"

permutaConsecutivos [1..8] == [2,1,4,3,6,5,8,7]

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

permutaConsecutivos "simplemente" == "ispmelemtne"

Soluciones

import Data.Array

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

permutaConsecutivos :: [a] -> [a]
permutaConsecutivos (x:y:zs) = y : x : permutaConsecutivos zs
permutaConsecutivos xs       = xs

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

permutaConsecutivos2 :: [a] -> [a]
permutaConsecutivos2 xs 
  | even n    = elems (array (1,n) [(i,f i) | i <- [1..n]])
  | otherwise = elems (array (1,n) ((n,v!n) : [(i,f i) | i <- [1..n-1]]))
  where
    n = length xs
    v = listArray (1,n) xs
    f i | even i =    v ! (i - 1)
        | otherwise = v ! (i + 1)
    
-- Comparación de eficiencia
-- =========================

-- La comparación es
--    λ> length (permutaConsecutivos [1..(3*10^6)])
--    3000000
--    (2.21 secs, 504,102,648 bytes)
--    λ> length (permutaConsecutivos2 [1..(3*10^6)])
--    3000000
--    (6.18 secs, 1,248,127,688 bytes)

import Data.Array

-- 1ª solución

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

permutaConsecutivos :: [a] -> [a]

permutaConsecutivos (x:y:zs) = y : x : permutaConsecutivos zs

permutaConsecutivos xs = xs

-- 2ª solución

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

permutaConsecutivos2 :: [a] -> [a]

permutaConsecutivos2 xs

| even n = elems (array (1,n) [(i,f i) | i <- [1..n]])

| otherwise = elems (array (1,n) ((n,v!n) : [(i,f i) | i <- [1..n-1]]))

where

n = length xs

v = listArray (1,n) xs

f i | even i = v ! (i - 1)

| otherwise = v ! (i + 1)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (permutaConsecutivos [1..(3*10^6)])

-- 3000000

-- (2.21 secs, 504,102,648 bytes)

-- λ> length (permutaConsecutivos2 [1..(3*10^6)])

-- 3000000

-- (6.18 secs, 1,248,127,688 bytes)

Pensamiento

Entre el vivir y el soñar
hay una tercera cosa.
Adivínala.

Antonio Machado

Diagonales invertidas

PorJosé A. Alonso 13-marzo-201925-abril-2021

Definir la función

   diagonalesInvertidas :: Matrix a -> Matrix a

1	diagonalesInvertidas :: Matrix a -> Matrix a

tal que (diagonalesInvertidas q) es la matriz obtenida invirtiendo el
orden de los elementos de la diagonal principal y de la diagonal
secundaria de q. Por ejemplo,

   λ> fromList 5 5 [1..]
   ┌                ┐
   │  1  2  3  4  5 │
   │  6  7  8  9 10 │
   │ 11 12 13 14 15 │
   │ 16 17 18 19 20 │
   │ 21 22 23 24 25 │
   └                ┘
   λ> diagonalesInvertidas (fromList 5 5 [1..])
   ┌                ┐
   │ 25  2  3  4 21 │
   │  6 19  8 17 10 │
   │ 11 12 13 14 15 │
   │ 16  9 18  7 20 │
   │  5 22 23 24  1 │
   └                ┘
   λ> fromList 3 3 ['a','b'..]
   ┌             ┐
   │ 'a' 'b' 'c' │
   │ 'd' 'e' 'f' │
   │ 'g' 'h' 'i' │
   └             ┘
   λ> diagonalesInvertidas (fromList 3 3 ['a','b'..])
   ┌             ┐
   │ 'i' 'b' 'g' │
   │ 'd' 'e' 'f' │
   │ 'c' 'h' 'a' │
   └             ┘

λ> fromList 5 5 [1..]

┌ ┐

│ 1 2 3 4 5 │

│ 6 7 8 9 10 │

│ 11 12 13 14 15 │

│ 16 17 18 19 20 │

│ 21 22 23 24 25 │

└ ┘

λ> diagonalesInvertidas (fromList 5 5 [1..])

┌ ┐

│ 25 2 3 4 21 │

│ 6 19 8 17 10 │

│ 11 12 13 14 15 │

│ 16 9 18 7 20 │

│ 5 22 23 24 1 │

└ ┘

λ> fromList 3 3 ['a','b'..]

┌ ┐

│ 'a' 'b' 'c' │

│ 'd' 'e' 'f' │

│ 'g' 'h' 'i' │

└ ┘

λ> diagonalesInvertidas (fromList 3 3 ['a','b'..])

┌ ┐

│ 'i' 'b' 'g' │

│ 'd' 'e' 'f' │

│ 'c' 'h' 'a' │

└ ┘

Soluciones

import Data.Matrix

diagonalesInvertidas :: Matrix a -> Matrix a
diagonalesInvertidas q = matrix n n f
  where n = nrows q
        f (i,j) | i == j     = q ! (n + 1 - i, n + 1 - i)
                | i+j == n+1 = q ! (j,i)
                | otherwise  = q ! (i,j)

import Data.Matrix

diagonalesInvertidas :: Matrix a -> Matrix a

diagonalesInvertidas q = matrix n n f

where n = nrows q

f (i,j) | i == j = q ! (n + 1 - i, n + 1 - i)

| i+j == n+1 = q ! (j,i)

| otherwise = q ! (i,j)

Pensamiento

Despertad, cantores:
acaben los ecos,
empiecen las voces.

Antonio Machado

Suma de segmentos iniciales

PorJosé A. Alonso 7-marzo-201925-abril-2021

Los segmentos iniciales de [3,1,2,5] son [3], [3,1], [3,1,2] y [3,1,2,5]. Sus sumas son 3, 4, 6 y 9, respectivamente. La suma de dichas sumas es 24.

Definir la función

   sumaSegmentosIniciales :: [Integer] -> Integer

1	sumaSegmentosIniciales :: [Integer] -> Integer

tal que (sumaSegmentosIniciales xs) es la suma de las sumas de los segmentos iniciales de xs. Por ejemplo,

   sumaSegmentosIniciales [3,1,2,5]     ==  24
   sumaSegmentosIniciales3 [1..3*10^6]  ==  4500004500001000000

1 2	sumaSegmentosIniciales [3,1,2,5] == 24 sumaSegmentosIniciales3 [1..3*10^6] == 4500004500001000000

Comprobar con QuickCheck que la suma de las sumas de los segmentos iniciales de la lista formada por n veces el número uno es el n-ésimo número triangular; es decir que

   sumaSegmentosIniciales (genericReplicate n 1)

1	sumaSegmentosIniciales (genericReplicate n 1)

es igual a

   n * (n + 1) `div` 2

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

Soluciones

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

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

sumaSegmentosIniciales :: [Integer] -> Integer
sumaSegmentosIniciales xs =
  sum [sum (take k xs) | k <- [1.. length xs]]

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

sumaSegmentosIniciales2 :: [Integer] -> Integer
sumaSegmentosIniciales2 xs =
  sum (zipWith (*) [n,n-1..1] xs)
  where n = genericLength xs

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

sumaSegmentosIniciales3 :: [Integer] -> Integer
sumaSegmentosIniciales3 xs =
  sum (scanl1 (+) xs)

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

-- La propiedad es
prop_sumaSegmentosInicialesEquiv :: [Integer] -> Bool
prop_sumaSegmentosInicialesEquiv xs =
  all (== sumaSegmentosIniciales xs) [f xs | f <- [ sumaSegmentosIniciales2
                                                  , sumaSegmentosIniciales3]]

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

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

--   λ> sumaSegmentosIniciales [1..10^4]
--   166716670000
--   (2.42 secs, 7,377,926,824 bytes)
--   λ> sumaSegmentosIniciales2 [1..10^4]
--   166716670000
--   (0.01 secs, 4,855,176 bytes)
--   
--   λ> sumaSegmentosIniciales2 [1..3*10^6]
--   4500004500001000000
--   (2.68 secs, 1,424,404,168 bytes)
--   λ> sumaSegmentosIniciales3 [1..3*10^6]
--   4500004500001000000
--   (1.54 secs, 943,500,384 bytes)

-- Comprobación de la propiedad
-- ============================

-- La propiedad es
prop_sumaSegmentosIniciales :: Positive Integer -> Bool
prop_sumaSegmentosIniciales (Positive n) =
  sumaSegmentosIniciales3 (genericReplicate n 1) ==
  n * (n + 1) `div` 2

-- La compronación es
--   λ> quickCheck prop_sumaSegmentosIniciales
--   +++ OK, passed 100 tests.

import Data.List (genericLength, genericReplicate)

import Test.QuickCheck

-- 1ª solución

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

sumaSegmentosIniciales :: [Integer] -> Integer

sumaSegmentosIniciales xs =

sum [sum (take k xs) | k <- [1.. length xs]]

-- 2ª solución

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

sumaSegmentosIniciales2 :: [Integer] -> Integer

sumaSegmentosIniciales2 xs =

sum (zipWith (*) [n,n-1..1] xs)

where n = genericLength xs

-- 3ª solución

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

sumaSegmentosIniciales3 :: [Integer] -> Integer

sumaSegmentosIniciales3 xs =

sum (scanl1 (+) xs)

-- Comprobación de la equivalencia

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

-- La propiedad es

prop_sumaSegmentosInicialesEquiv :: [Integer] -> Bool

prop_sumaSegmentosInicialesEquiv xs =

all (== sumaSegmentosIniciales xs) [f xs | f <- [ sumaSegmentosIniciales2

, sumaSegmentosIniciales3]]

-- La comprobación es

-- λ> quickCheck prop_sumaSegmentosInicialesEquiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> sumaSegmentosIniciales [1..10^4]

-- 166716670000

-- (2.42 secs, 7,377,926,824 bytes)

-- λ> sumaSegmentosIniciales2 [1..10^4]

-- 166716670000

-- (0.01 secs, 4,855,176 bytes)

-- λ> sumaSegmentosIniciales2 [1..3*10^6]

-- 4500004500001000000

-- (2.68 secs, 1,424,404,168 bytes)

-- λ> sumaSegmentosIniciales3 [1..3*10^6]

-- 4500004500001000000

-- (1.54 secs, 943,500,384 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_sumaSegmentosIniciales :: Positive Integer -> Bool

prop_sumaSegmentosIniciales (Positive n) =

sumaSegmentosIniciales3 (genericReplicate n 1) ==

n * (n + 1) `div` 2

-- La compronación es

-- λ> quickCheck prop_sumaSegmentosIniciales

-- +++ OK, passed 100 tests.

Pensamiento

Al andar se hace camino,
y al volver la vista atrás
se ve la senda que nunca
se ha de volver a pisar.

Antonio Machado

Hojas con caminos no decrecientes

PorJosé A. Alonso 4-marzo-201925-abril-2021

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

   data Arbol = N Int [Arbol]
     deriving Show

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

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

/ \ 8 3 8 3

2 6 /|\ /|\ |

/ \ / \ 4 2 6 4 5 6 2

4 5 5 7

se representan por

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

ej1, ej2, ej3 :: Arbol

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

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

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

Definir la función

   hojasEnNoDecreciente :: Arbol -> [Int]

1	hojasEnNoDecreciente :: Arbol -> [Int]

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

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

hojasEnNoDecreciente ej1 == [4,5,7]

hojasEnNoDecreciente ej2 == [4,6,8]

hojasEnNoDecreciente ej3 == []

Soluciones

import Data.List (sort, nub)

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

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

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

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

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

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

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

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

import Data.List (sort, nub)

data Arbol = N Int [Arbol]

deriving Show

ej1, ej2, ej3 :: Arbol

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

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

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

-- 1ª solución

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

hojasEnNoDecreciente :: Arbol -> [Int]

hojasEnNoDecreciente a =

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

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

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

-- ramasNoDecrecientes ej3 == []

ramasNoDecrecientes :: Arbol -> [[Int]]

ramasNoDecrecientes a =

filter esNoDecreciente (ramas a)

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

-- λ> ramas ej1

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

-- λ> ramas ej2

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

-- λ> ramas ej3

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

ramas :: Arbol -> [[Int]]

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

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

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

-- decreciente. Por ejemplo,

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

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

esNoDecreciente :: [Int] -> Bool

esNoDecreciente xs =

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

-- 2ª solución

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

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

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

-- hojasEnNoDecreciente ej3 == []

hojasEnNoDecreciente2 :: Arbol -> [Int]

hojasEnNoDecreciente2 = sort . nub . aux

where

aux (N x []) = [x]

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

Pensamiento

Para dialogar,
preguntad, primero;
después … escuchad.

Antonio Machado

Inserciones en una lista de listas

PorJosé A. Alonso 25-febrero-20194-marzo-2019

Definir la función

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

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

tal que (inserta x yss) es la lista obtenida insertando x en cada uno de los elementos de yss. Por ejemplo,

   λ> inserta 1 [[2,3],[4],[5,6,7]]
   [[[1,2,3],[4],[5,6,7]],[[2,3],[1,4],[5,6,7]],[[2,3],[4],[1,5,6,7]]]
   λ> inserta 'a' ["hoy","es","lunes"]
   [["ahoy","es","lunes"],["hoy","aes","lunes"],["hoy","es","alunes"]]

λ> inserta 1 [[2,3],[4],[5,6,7]]

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

λ> inserta 'a' ["hoy","es","lunes"]

[["ahoy","es","lunes"],["hoy","aes","lunes"],["hoy","es","alunes"]]

Soluciones

-- 1ª solución
inserta :: a -> [[a]] -> [[[a]]]
inserta _ []       = []
inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss] 

-- 2ª solución
inserta2 :: a -> [[a]] -> [[[a]]]
inserta2 _ []       = []
inserta2 x (ys:yss) = ((x:ys):yss) : map (ys:) (inserta2 x yss)

-- 1ª solución

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

inserta _ [] = []

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

-- 2ª solución

inserta2 :: a -> [[a]] -> [[[a]]]

inserta2 _ [] = []

inserta2 x (ys:yss) = ((x:ys):yss) : map (ys:) (inserta2 x yss)

Pensamiento

… De la mar al percepto,
del percepto al concepto,
del concepto a la idea
— ¡oh, la linda tarea! —
de la idea a la mar.
¡Y otra vez al empezar!

Antonio Machado

Medias de dígitos de pi

PorJosé A. Alonso 5-febrero-201925-abril-2021

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 las funciones

   mediasDigitosDePi        :: IO [Double]
   graficaMediasDigitosDePi :: Int -> IO ()

1 2	mediasDigitosDePi :: IO [Double] graficaMediasDigitosDePi :: Int -> IO ()

tales que

mediasDigitosDePi es la sucesión cuyo n-ésimo elemento es la media de los n primeros dígitos de pi. Por ejemplo,

     λ> xs <- mediasDigitosDePi
     λ> take 5 xs
     [1.0,2.5,2.0,2.75,4.0]
     λ> take 10 xs
     [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]
     λ> take 10 <$> mediasDigitosDePi
     [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

λ> xs <- mediasDigitosDePi

λ> take 5 xs

[1.0,2.5,2.0,2.75,4.0]

λ> take 10 xs

[1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

λ> take 10 <$> mediasDigitosDePi

[1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

(graficaMediasDigitosDePi n) dibuja la gráfica de los n primeros términos de mediasDigitosDePi. Por ejemplo,
- (graficaMediasDigitosDePi 20) dibuja
- (graficaMediasDigitosDePi 200) dibuja
- (graficaMediasDigitosDePi 2000) dibuja

Soluciones

import Data.Char (digitToInt)
import Data.List (genericLength, inits, tails)
import Graphics.Gnuplot.Simple ( Attribute (Key, PNG)
                               , plotList )

-- Definición de mediasDigitosDePi
-- ===============================

mediasDigitosDePi :: IO [Double]
mediasDigitosDePi = do
  (_:_:ds) <- readFile "Digitos_de_pi.txt"
  return (medias (digitos ds))

-- (digitos cs) es la lista de los digitos de cs. Por ejempplo,
--    digitos "1415926535"  ==  [1,4,1,5,9,2,6,5,3,5]
digitos :: String -> [Int]
digitos = map digitToInt

-- (medias xs) es la lista de las medias de los segmentos iniciales de
-- xs. Por ejemplo,
--    λ> medias [1,4,1,5,9,2,6,5,3,5]
--    [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]
medias :: [Int] -> [Double]
medias xs = map media (tail (inits xs))

-- (media xs) es la media aritmética de xs. Por ejemplo,
--    media [1,4,1,5,9]  ==  4.0
media :: [Int] -> Double
media xs = fromIntegral (sum xs) / genericLength xs

-- Definición de graficaMediasDigitosDePi
-- ======================================

graficaMediasDigitosDePi :: Int -> IO ()
graficaMediasDigitosDePi n = do
  xs <- mediasDigitosDePi
  plotList [ Key Nothing
           , PNG ("Medias_de_digitos_de_pi_" ++ show n ++ ".png")
           ]
           (take n xs)

import Data.Char (digitToInt)

import Data.List (genericLength, inits, tails)

import Graphics.Gnuplot.Simple ( Attribute (Key, PNG)

, plotList )

-- Definición de mediasDigitosDePi

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

mediasDigitosDePi :: IO [Double]

mediasDigitosDePi = do

(_:_:ds) <- readFile "Digitos_de_pi.txt"

return (medias (digitos ds))

-- (digitos cs) es la lista de los digitos de cs. Por ejempplo,

-- digitos "1415926535" == [1,4,1,5,9,2,6,5,3,5]

digitos :: String -> [Int]

digitos = map digitToInt

-- (medias xs) es la lista de las medias de los segmentos iniciales de

-- xs. Por ejemplo,

-- λ> medias [1,4,1,5,9,2,6,5,3,5]

-- [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

medias :: [Int] -> [Double]

medias xs = map media (tail (inits xs))

-- (media xs) es la media aritmética de xs. Por ejemplo,

-- media [1,4,1,5,9] == 4.0

media :: [Int] -> Double

media xs = fromIntegral (sum xs) / genericLength xs

-- Definición de graficaMediasDigitosDePi

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

graficaMediasDigitosDePi :: Int -> IO ()

graficaMediasDigitosDePi n = do

xs <- mediasDigitosDePi

plotList [ Key Nothing

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

]

(take n xs)

Pensamiento

Es el mejor de los buenos
quien sabe que en esta vida
todo es cuestión de medida:
un poco más, algo menos.

Antonio Machado

Límites de sucesiones

PorJosé A. Alonso 4-febrero-201911-febrero-2019

El límite de una sucesión, con una aproximación a y una amplitud n, es el primer término x de la sucesión tal que el valor absoluto de x y cualquiera de sus n siguentes elementos es menor que a.

Definir la función

   limite :: [Double] -> Double -> Int -> Double

1	limite :: [Double] -> Double -> Int -> Double

tal que (limite xs a n) es el límite de xs xon aproximación a y amplitud n. Por ejemplo,

   λ> limite [(2*n+1)/(n+5) | n <- [1..]] 0.001 300
   1.993991989319092
   λ> limite [(2*n+1)/(n+5) | n <- [1..]] 1e-6 300
   1.9998260062637745
   λ> limite [(1+1/n)**n | n <- [1..]] 0.001 300
   2.7155953364173175

λ> limite [(2*n+1)/(n+5) | n <- [1..]] 0.001 300

1.993991989319092

λ> limite [(2*n+1)/(n+5) | n <- [1..]] 1e-6 300

1.9998260062637745

λ> limite [(1+1/n)**n | n <- [1..]] 0.001 300

2.7155953364173175

Soluciones

import Data.List (tails)

limite :: [Double] -> Double -> Int -> Double
limite xs a n = 
  head [ x | (x:ys) <- segmentos xs n
       , all (\y ->  abs (y - x) < a) ys]

-- (segmentos xs n) es la lista de los segmentos de la lista infinita xs
-- con n elementos. Por ejemplo,   
--    λ> take 5 (segmentos [1..] 3)
--    [[1,2,3],[2,3,4],[3,4,5],[4,5,6],[5,6,7]]
segmentos :: [a] -> Int -> [[a]]
segmentos xs n = map (take n) (tails xs)

import Data.List (tails)

limite :: [Double] -> Double -> Int -> Double

limite xs a n =

head [ x | (x:ys) <- segmentos xs n

, all (\y -> abs (y - x) < a) ys]

-- (segmentos xs n) es la lista de los segmentos de la lista infinita xs

-- con n elementos. Por ejemplo,

-- λ> take 5 (segmentos [1..] 3)

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

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

segmentos xs n = map (take n) (tails xs)

Pensamiento

De diez cabezas, nueve
embisten y una piensa.
Nunca extrañéis que un bruto
se descuerne luchando por la idea.

Antonio Machado

Números con dígitos 1 y 2

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

Definir las funciones

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

numerosCon1y2 :: Int -> [Int]

restosNumerosCon1y2 :: Int -> [Int]

grafica_restosNumerosCon1y2 :: Int -> IO ()

tales que

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

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

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

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

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

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

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

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

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

(graficaRestosNumerosCon1y2 4) dibuja

y (graficaRestosNumerosCon1y2 5) dibuja

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

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

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

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

Soluciones

import Test.QuickCheck
import Graphics.Gnuplot.Simple

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

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

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

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

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

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

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

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

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

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

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

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- Definición de numerosCon1y2

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

numerosCon1y2 :: Int -> [Int]

numerosCon1y2 = map digitosAnumero . digitos

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

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

-- λ> digitos 2

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

-- λ> digitos 3

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

digitos :: Int -> [[Int]]

digitos 0 = [[]]

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

where xss = digitos (n-1)

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

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

digitosAnumero :: [Int] -> Int

digitosAnumero = read . concatMap show

-- Definición de restosNumerosCon1y2

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

restosNumerosCon1y2 :: Int -> [Int]

restosNumerosCon1y2 n =

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

where m = 2^n

-- Definición de graficaRestosNumerosCon1y2

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

graficaRestosNumerosCon1y2 :: Int -> IO ()

graficaRestosNumerosCon1y2 n =

plotListStyle

[ Key Nothing

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

]

(defaultStyle {plotType = LinesPoints,

lineSpec = CustomStyle [PointType 7]})

(restosNumerosCon1y2 n)

-- Propiedad de restosNumerosCon1y2

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

-- La propiedad

prop_restosNumerosCon1y2 :: Positive Int -> Bool

prop_restosNumerosCon1y2 (Positive n) =

todosDistintos (restosNumerosCon1y2 n)

where todosDistintos xs = xs == nub xs

-- La comprobación es

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

-- +++ OK, passed 100 tests.

Pensamiento

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

Antonio Machado

Sucesión triangular

PorJosé A. Alonso 23-enero-201930-enero-2019

La sucesión triangular es la obtenida concatenando las listas [1], [1,2], [1,2,3], [1,2,3,4], …. Sus primeros términos son 1, 1, 2, 1, 2, 3, 1, 2, 3, 4, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 6, …

Definir las funciones

   sucTriangular        :: [Integer]
   terminoSucTriangular :: Int -> Integer
   graficaSucTriangular :: Int -> IO ()

sucTriangular :: [Integer]

terminoSucTriangular :: Int -> Integer

graficaSucTriangular :: Int -> IO ()

tales que

sucTriangular es la lista de los términos de la sucesión triangular. Por ejemplo,

     λ> take 30 sucTriangular
     [1,1,2,1,2,3,1,2,3,4,1,2,3,4,5,1,2,3,4,5,6,1,2,3,4,5,6,7,1,2]

1 2	λ> take 30 sucTriangular [1,1,2,1,2,3,1,2,3,4,1,2,3,4,5,1,2,3,4,5,6,1,2,3,4,5,6,7,1,2]

(terminoSucTriangular n) es el término n-ésimo de la sucesión triangular. Por ejemplo,

     terminoSucTriangular 5       ==  3
     terminoSucTriangular 10      ==  1
     terminoSucTriangular 20      ==  6
     terminoSucTriangular 100     ==  10
     terminoSucTriangular 1001    ==  12
     terminoSucTriangular (10^5)  ==  320

terminoSucTriangular 5 == 3

terminoSucTriangular 10 == 1

terminoSucTriangular 20 == 6

terminoSucTriangular 100 == 10

terminoSucTriangular 1001 == 12

terminoSucTriangular (10^5) == 320

(graficaSucTriangular n) dibuja la gráfica de los n primeros términos de la sucesión triangular. Por ejemplo, (graficaSucTriangular 300) dibuja

Soluciones

import Data.List (inits)
import Test.QuickCheck
import Graphics.Gnuplot.Simple

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

sucTriangular :: [Integer]
sucTriangular =
  concat [[1..n] | n <- [1..]]

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

sucTriangular2 :: [Integer]
sucTriangular2 =
  [x | n <- [1..], x <- [1..n]]

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

sucTriangular3 :: [Integer]
sucTriangular3 =
  concat (tail (inits [1..]))
  
-- 1ª definición de terminoSucTriangular
-- =====================================

terminoSucTriangular :: Int -> Integer
terminoSucTriangular k =
  sucTriangular !! k

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

terminoSucTriangular2 :: Int -> Integer
terminoSucTriangular2 k =
  sucTriangular2 !! k

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

terminoSucTriangular3 :: Int -> Integer
terminoSucTriangular3 k =
  sucTriangular3 !! k

-- Equivalencia de definiciones
-- ============================

-- La propiedad es
prop_terminoTriangular :: Positive Int -> Bool
prop_terminoTriangular (Positive n) =
  terminoSucTriangular n == terminoSucTriangular2 n &&
  terminoSucTriangular n == terminoSucTriangular3 n

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

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

--    λ> terminoSucTriangular (3*10^6)
--    2425
--    (2.07 secs, 384,707,936 bytes)
--    λ> terminoSucTriangular2 (3*10^6)
--    2425
--    (2.22 secs, 432,571,208 bytes)
--    λ> terminoSucTriangular3 (3*10^6)
--    2425
--    (0.69 secs, 311,259,504 bytes)

-- Definición de graficaSucTriangular
-- ==================================

graficaSucTriangular :: Int -> IO ()
graficaSucTriangular n =
  plotList [ Key Nothing
           , PNG "Sucesion_triangular.png"
           ]
           (take n sucTriangular)

import Data.List (inits)

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- 1ª definición de sucTriangular

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

sucTriangular :: [Integer]

sucTriangular =

concat [[1..n] | n <- [1..]]

-- 2ª definición de sucTriangular

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

sucTriangular2 :: [Integer]

sucTriangular2 =

[x | n <- [1..], x <- [1..n]]

-- 3ª definición de sucTriangular

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

sucTriangular3 :: [Integer]

sucTriangular3 =

concat (tail (inits [1..]))

-- 1ª definición de terminoSucTriangular

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

terminoSucTriangular :: Int -> Integer

terminoSucTriangular k =

sucTriangular !! k

-- 2ª definición de terminoSucTriangular

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

terminoSucTriangular2 :: Int -> Integer

terminoSucTriangular2 k =

sucTriangular2 !! k

-- 3ª definición de terminoSucTriangular

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

terminoSucTriangular3 :: Int -> Integer

terminoSucTriangular3 k =

sucTriangular3 !! k

-- Equivalencia de definiciones

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

-- La propiedad es

prop_terminoTriangular :: Positive Int -> Bool

prop_terminoTriangular (Positive n) =

terminoSucTriangular n == terminoSucTriangular2 n &&

terminoSucTriangular n == terminoSucTriangular3 n

-- La comprobación es

-- λ> quickCheck prop_terminoTriangular

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> terminoSucTriangular (3*10^6)

-- 2425

-- (2.07 secs, 384,707,936 bytes)

-- λ> terminoSucTriangular2 (3*10^6)

-- 2425

-- (2.22 secs, 432,571,208 bytes)

-- λ> terminoSucTriangular3 (3*10^6)

-- 2425

-- (0.69 secs, 311,259,504 bytes)

-- Definición de graficaSucTriangular

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

graficaSucTriangular :: Int -> IO ()

graficaSucTriangular n =

plotList [ Key Nothing

, PNG "Sucesion_triangular.png"

]

(take n sucTriangular)

Pensamiento

Nadie debe asustarse de lo que piensa, aunque su pensar aparezca en pugna con las leyes más elementales de la lógica. Porque todo ha de ser pensado por alguien, y el mayor desatino puede ser un punto de vista de lo real.

Antonio Machado

El 2019 es semiprimo

PorJosé A. Alonso 3-enero-201910-enero-2019

Un número semiprimo es un número natural que es producto de dos números primos no necesariamente distintos. Por ejemplo, 26 es semiprimo (porque 26 = 2×13) y 49 también lo es (porque 49 = 7×7).

Definir las funciones

   esSemiprimo :: Integer -> Bool
   semiprimos  :: [Integer]

1 2	esSemiprimo :: Integer -> Bool semiprimos :: [Integer]

tales que

(esSemiprimo n) se verifica si n es semiprimo. Por ejemplo,

     esSemiprimo 26          ==  True
     esSemiprimo 49          ==  True
     esSemiprimo 8           ==  False
     esSemiprimo 2019        ==  True
     esSemiprimo (21+10^14)  ==  True

esSemiprimo 26 == True

esSemiprimo 49 == True

esSemiprimo 8 == False

esSemiprimo 2019 == True

esSemiprimo (21+10^14) == True

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

     take 10 semiprimos   ==  [4,6,9,10,14,15,21,22,25,26]
     semiprimos !! 579    ==  2019
     semiprimos !! 10000  ==  40886

take 10 semiprimos == [4,6,9,10,14,15,21,22,25,26]

semiprimos !! 579 == 2019

semiprimos !! 10000 == 40886

Soluciones

import Data.Numbers.Primes 
import Test.QuickCheck

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

esSemiprimo :: Integer -> Bool
esSemiprimo n =
  not (null [x | x <- [n,n-1..2], 
                 primo x,
                 n `mod` x == 0,
                 primo (n `div` x)])

primo :: Integer -> Bool
primo n = [x | x <- [1..n], n `mod` x == 0] == [1,n] 

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

esSemiprimo2 :: Integer -> Bool
esSemiprimo2 n =
  not (null [x | x <- [n-1,n-2..2], 
                 isPrime x,
                 n `mod` x == 0,
                 isPrime (n `div` x)])

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

esSemiprimo3 :: Integer -> Bool
esSemiprimo3 n =
  not (null [x | x <- reverse (takeWhile (<n) primes),
                 n `mod` x == 0,
                 isPrime (n `div` x)])

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

esSemiprimo4 :: Integer -> Bool
esSemiprimo4 n =
  length (primeFactors n) == 2

-- Equivalencia de las definiciones de esSemiprimo
-- ===============================================

-- La propiedad es
prop_esSemiprimo :: Positive Integer -> Bool
prop_esSemiprimo (Positive n) =
  all (== esSemiprimo n) [f n | f <- [ esSemiprimo2
                                     , esSemiprimo3
                                     , esSemiprimo4
                                     ]]

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

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

--    λ> esSemiprimo 5001
--    True
--    (1.90 secs, 274,450,648 bytes)
--    λ> esSemiprimo2 5001
--    True
--    (0.07 secs, 29,377,016 bytes)
--    λ> esSemiprimo3 5001
--    True
--    (0.01 secs, 1,706,840 bytes)
--    λ> esSemiprimo4 5001
--    True
--    (0.01 secs, 142,840 bytes)
--    
--    λ> esSemiprimo2 100001
--    True
--    (2.74 secs, 1,473,519,064 bytes)
--    λ> esSemiprimo3 100001
--    True
--    (0.09 secs, 30,650,352 bytes)
--    λ> esSemiprimo4 100001
--    True
--    (0.01 secs, 155,200 bytes)
--    
--    λ> esSemiprimo3 10000001
--    True
--    (8.73 secs, 4,357,875,016 bytes)
--    λ> esSemiprimo4 10000001
--    True
--    (0.01 secs, 456,328 bytes)

-- Definición de semiprimos
-- ========================

semiprimos :: [Integer]
semiprimos = filter esSemiprimo4 [4..]

import Data.Numbers.Primes

import Test.QuickCheck

-- 1ª definición de esSemiprimo

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

esSemiprimo :: Integer -> Bool

esSemiprimo n =

not (null [x | x <- [n,n-1..2],

primo x,

n `mod` x == 0,

primo (n `div` x)])

primo :: Integer -> Bool

primo n = [x | x <- [1..n], n `mod` x == 0] == [1,n]

-- 2ª definición de esSemiprimo

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

esSemiprimo2 :: Integer -> Bool

esSemiprimo2 n =

not (null [x | x <- [n-1,n-2..2],

isPrime x,

n `mod` x == 0,

isPrime (n `div` x)])

-- 3ª definición de esSemiprimo

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

esSemiprimo3 :: Integer -> Bool

esSemiprimo3 n =

not (null [x | x <- reverse (takeWhile (<n) primes),

n `mod` x == 0,

isPrime (n `div` x)])

-- 4ª definición de esSemiprimo

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

esSemiprimo4 :: Integer -> Bool

esSemiprimo4 n =

length (primeFactors n) == 2

-- Equivalencia de las definiciones de esSemiprimo

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

-- La propiedad es

prop_esSemiprimo :: Positive Integer -> Bool

prop_esSemiprimo (Positive n) =

all (== esSemiprimo n) [f n | f <- [ esSemiprimo2

, esSemiprimo3

, esSemiprimo4

]]

-- La comprobación es

-- λ> quickCheck prop_esSemiprimo

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> esSemiprimo 5001

-- True

-- (1.90 secs, 274,450,648 bytes)

-- λ> esSemiprimo2 5001

-- True

-- (0.07 secs, 29,377,016 bytes)

-- λ> esSemiprimo3 5001

-- True

-- (0.01 secs, 1,706,840 bytes)

-- λ> esSemiprimo4 5001

-- True

-- (0.01 secs, 142,840 bytes)

-- λ> esSemiprimo2 100001

-- True

-- (2.74 secs, 1,473,519,064 bytes)

-- λ> esSemiprimo3 100001

-- True

-- (0.09 secs, 30,650,352 bytes)

-- λ> esSemiprimo4 100001

-- True

-- (0.01 secs, 155,200 bytes)

-- λ> esSemiprimo3 10000001

-- True

-- (8.73 secs, 4,357,875,016 bytes)

-- λ> esSemiprimo4 10000001

-- True

-- (0.01 secs, 456,328 bytes)

-- Definición de semiprimos

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

semiprimos :: [Integer]

semiprimos = filter esSemiprimo4 [4..]

Pensamiento

Porque toda visión requiere distancia, no hay manera de ver las cosas sin salirse de ellas.

Antonio Machado

El 2019 es malvado

PorJosé A. Alonso 2-enero-20199-enero-2019

Un número malvado es un número natural cuya expresión en base 2 contiene un número par de unos. Por ejemplo, 6 es malvado porque su expresión en base 2 es 110 que tiene dos unos.

Definir las funciones

   esMalvado       :: Integer -> Bool
   malvados        :: [Integer]
   posicionMalvada :: Integer -> Maybe Int

esMalvado :: Integer -> Bool

malvados :: [Integer]

posicionMalvada :: Integer -> Maybe Int

tales que

(esMalvado n) se verifica si n es un número malvado. Por ejemplo,

     esMalvado 6              ==  True
     esMalvado 7              ==  False
     esMalvado 2019           ==  True
     esMalvado (10^70000)     ==  True
     esMalvado (10^(3*10^7))  ==  True

esMalvado 6 == True

esMalvado 7 == False

esMalvado 2019 == True

esMalvado (10^70000) == True

esMalvado (10^(3*10^7)) == True

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

     λ> take 20 malvados
     [0,3,5,6,9,10,12,15,17,18,20,23,24,27,29,30,33,34,36,39]
     malvados !! 1009    ==  2019
     malvados !! 10      ==  20
     malvados !! (10^2)  ==  201
     malvados !! (10^3)  ==  2000
     malvados !! (10^4)  ==  20001
     malvados !! (10^5)  ==  200000
     malvados !! (10^6)  ==  2000001

λ> take 20 malvados

[0,3,5,6,9,10,12,15,17,18,20,23,24,27,29,30,33,34,36,39]

malvados !! 1009 == 2019

malvados !! 10 == 20

malvados !! (10^2) == 201

malvados !! (10^3) == 2000

malvados !! (10^4) == 20001

malvados !! (10^5) == 200000

malvados !! (10^6) == 2000001

(posicionMalvada n) es justo la posición de n en la sucesión de números malvados, si n es malvado o Nothing, en caso contrario. Por ejemplo,

     posicionMalvada 6        ==  Just 3
     posicionMalvada 2019     ==  Just 1009
     posicionMalvada 2018     ==  Nothing
     posicionMalvada 2000001  ==  Just 1000000
     posicionMalvada (10^7)   ==  Just 5000000

posicionMalvada 6 == Just 3

posicionMalvada 2019 == Just 1009

posicionMalvada 2018 == Nothing

posicionMalvada 2000001 == Just 1000000

posicionMalvada (10^7) == Just 5000000

Soluciones

import Data.List (genericLength, elemIndex)
import Data.Bits (popCount)

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

esMalvado :: Integer -> Bool
esMalvado n = even (numeroUnosBin n)

-- Sin argumentos
esMalvado' :: Integer -> Bool
esMalvado' = even . numeroUnosBin

-- (numeroUnosBin n) es el número de unos de la representación binaria
-- del número decimal n. Por ejemplo,
--   numeroUnosBin 11  ==  3
--   numeroUnosBin 12  ==  2
numeroUnosBin :: Integer -> Integer
numeroUnosBin n  = genericLength (filter (== 1) (binario n))

-- Sin argumentos
numeroUnosBin' :: Integer -> Integer
numeroUnosBin' = genericLength . filter (== 1) . binario

-- (binario n) es el número binario correspondiente al número decimal n.
-- Por ejemplo, 
--   binario 11  ==  [1,1,0,1]
--   binario 12  ==  [0,0,1,1]
binario :: Integer -> [Integer]
binario n | n < 2     = [n]
          | otherwise = n `mod` 2 : binario (n `div` 2)

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

esMalvado2 :: Integer -> Bool
esMalvado2 n = even (numeroUnosBin n)

-- (numeroIntBin n) es el número de unos que contiene la representación
-- binaria del número decimal n. Por ejemplo,
--   numeroIntBin 11  ==  3
--   numeroIntBin 12  ==  2
numeroIntBin :: Integer -> Integer
numeroIntBin n | n < 2     = n
               | otherwise = n `mod` 2 + numeroIntBin (n `div` 2)

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

esMalvado3 :: Integer -> Bool
esMalvado3 n = even (popCount n)

-- Sin argumentos
esMalvado3' :: Integer -> Bool
esMalvado3' = even . popCount 

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

--    λ> esMalvado (10^30000)
--    True
--    (1.79 secs, 664,627,936 bytes)
--    λ> esMalvado2 (10^30000)
--    True
--    (1.79 secs, 664,626,992 bytes)
--    λ> esMalvado3 (10^30000)
--    True
--    (0.03 secs, 141,432 bytes)
--    
--    λ> esMalvado (10^40000)
--    False
--    (2.95 secs, 1,162,091,464 bytes)
--    λ> esMalvado2 (10^40000)
--    False
--    (2.96 secs, 1,162,091,096 bytes)
--    λ> esMalvado3 (10^40000)
--    False
--    (0.04 secs, 155,248 bytes)

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

malvados :: [Integer]
malvados = [n | n <- [0..], esMalvado3 n]

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

malvados2 :: [Integer]
malvados2 = filter esMalvado3 [0..]

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

posicionMalvada :: Integer -> Maybe Int
posicionMalvada n
  | y == n    = Just (length xs)
  | otherwise = Nothing
  where (xs,(y:_)) = span (<n) malvados

-- 2ª definición de posicionMalvada
posicionMalvada2 :: Integer -> Maybe Int
posicionMalvada2 n
  | esMalvado n = elemIndex n malvados
  | otherwise        = Nothing

100

101

102

103

104

105

import Data.List (genericLength, elemIndex)

import Data.Bits (popCount)

-- 1ª definición de esMalvado

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

esMalvado :: Integer -> Bool

esMalvado n = even (numeroUnosBin n)

-- Sin argumentos

esMalvado' :: Integer -> Bool

esMalvado' = even . numeroUnosBin

-- (numeroUnosBin n) es el número de unos de la representación binaria

-- del número decimal n. Por ejemplo,

-- numeroUnosBin 11 == 3

-- numeroUnosBin 12 == 2

numeroUnosBin :: Integer -> Integer

numeroUnosBin n = genericLength (filter (== 1) (binario n))

-- Sin argumentos

numeroUnosBin' :: Integer -> Integer

numeroUnosBin' = genericLength . filter (== 1) . binario

-- (binario n) es el número binario correspondiente al número decimal n.

-- Por ejemplo,

-- binario 11 == [1,1,0,1]

-- binario 12 == [0,0,1,1]

binario :: Integer -> [Integer]

binario n | n < 2 = [n]

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

-- 2ª definición de esMalvado

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

esMalvado2 :: Integer -> Bool

esMalvado2 n = even (numeroUnosBin n)

-- (numeroIntBin n) es el número de unos que contiene la representación

-- binaria del número decimal n. Por ejemplo,

-- numeroIntBin 11 == 3

-- numeroIntBin 12 == 2

numeroIntBin :: Integer -> Integer

numeroIntBin n | n < 2 = n

| otherwise = n `mod` 2 + numeroIntBin (n `div` 2)

-- 3ª definición de esMalvado

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

esMalvado3 :: Integer -> Bool

esMalvado3 n = even (popCount n)

-- Sin argumentos

esMalvado3' :: Integer -> Bool

esMalvado3' = even . popCount

-- Comparación de eficiencia

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

-- λ> esMalvado (10^30000)

-- True

-- (1.79 secs, 664,627,936 bytes)

-- λ> esMalvado2 (10^30000)

-- True

-- (1.79 secs, 664,626,992 bytes)

-- λ> esMalvado3 (10^30000)

-- True

-- (0.03 secs, 141,432 bytes)

-- λ> esMalvado (10^40000)

-- False

-- (2.95 secs, 1,162,091,464 bytes)

-- λ> esMalvado2 (10^40000)

-- False

-- (2.96 secs, 1,162,091,096 bytes)

-- λ> esMalvado3 (10^40000)

-- False

-- (0.04 secs, 155,248 bytes)

-- 1ª definición de malvados

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

malvados :: [Integer]

malvados = [n | n <- [0..], esMalvado3 n]

-- 2ª definición de malvados

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

malvados2 :: [Integer]

malvados2 = filter esMalvado3 [0..]

-- 1ª definición de posicionMalvada

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

posicionMalvada :: Integer -> Maybe Int

posicionMalvada n

| y == n = Just (length xs)

| otherwise = Nothing

where (xs,(y:_)) = span (<n) malvados

-- 2ª definición de posicionMalvada

posicionMalvada2 :: Integer -> Maybe Int

posicionMalvada2 n

| esMalvado n = elemIndex n malvados

| otherwise = Nothing

Pensamiento

… Yo os enseño, o pretendo enseñaros a que dudéis de todo: de lo
humano y de lo divino, sin excluir vuestra propia existencia.

Antonio Machado

El 2019 es apocalíptico

PorJosé A. Alonso 1-enero-20198-enero-2019

Un número natural n es apocalíptico si 2^n contiene la secuencia 666. Por ejemplo, 157 es apocalíptico porque 2^157 es 182687704666362864775460604089535377456991567872 que contiene la secuencia 666.

Definir las funciones

   esApocaliptico       :: Integer -> Bool
   apocalipticos        :: [Integer]
   posicionApocaliptica :: Integer -> Maybe Int

esApocaliptico :: Integer -> Bool

apocalipticos :: [Integer]

posicionApocaliptica :: Integer -> Maybe Int

tales que

(esApocaliptico n) se verifica si n es un número apocalíptico. Por ejemplo,

     esApocaliptico 157   ==  True
     esApocaliptico 2019  ==  True
     esApocaliptico 2018  ==  False

esApocaliptico 157 == True

esApocaliptico 2019 == True

esApocaliptico 2018 == False

apocalipticos es la lista de los números apocalípticos. Por ejemplo,

     take 9 apocalipticos  ==  [157,192,218,220,222,224,226,243,245]
     apocalipticos !! 450  ==  2019

1 2	take 9 apocalipticos == [157,192,218,220,222,224,226,243,245] apocalipticos !! 450 == 2019

(posicionApocalitica n) es justo la posición de n en la sucesión de números apocalípticos, si n es apocalíptico o Nothing, en caso contrario. Por ejemplo,

     posicionApocaliptica 157   ==  Just 0
     posicionApocaliptica 2019  ==  Just 450
     posicionApocaliptica 2018  ==  Nothing

posicionApocaliptica 157 == Just 0

posicionApocaliptica 2019 == Just 450

posicionApocaliptica 2018 == Nothing

Soluciones

import Data.List (isInfixOf, elemIndex)

-- 1ª definición de esApocaliptico
esApocaliptico :: Integer -> Bool
esApocaliptico n = "666" `isInfixOf` show (2^n)

-- 2ª definición de esApocaliptico
esApocaliptico2 :: Integer -> Bool
esApocaliptico2 = isInfixOf "666" . show . (2^)

-- 1ª definición de apocalipticos
apocalipticos :: [Integer]
apocalipticos = [n | n <- [1..], esApocaliptico n]

-- 2ª definición de apocalipticos
apocalipticos2 :: [Integer]
apocalipticos2 = filter esApocaliptico [1..]

-- 1ª definición de posicionApocaliptica
posicionApocaliptica :: Integer -> Maybe Int
posicionApocaliptica n
  | y == n    = Just (length xs)
  | otherwise = Nothing
  where (xs,y:_) = span (<n) apocalipticos

-- 2ª definición de posicionApocaliptica
posicionApocaliptica2 :: Integer -> Maybe Int
posicionApocaliptica2 n
  | esApocaliptico n = elemIndex n apocalipticos
  | otherwise        = Nothing

import Data.List (isInfixOf, elemIndex)

-- 1ª definición de esApocaliptico

esApocaliptico :: Integer -> Bool

esApocaliptico n = "666" `isInfixOf` show (2^n)

-- 2ª definición de esApocaliptico

esApocaliptico2 :: Integer -> Bool

esApocaliptico2 = isInfixOf "666" . show . (2^)

-- 1ª definición de apocalipticos

apocalipticos :: [Integer]

apocalipticos = [n | n <- [1..], esApocaliptico n]

-- 2ª definición de apocalipticos

apocalipticos2 :: [Integer]

apocalipticos2 = filter esApocaliptico [1..]

-- 1ª definición de posicionApocaliptica

posicionApocaliptica :: Integer -> Maybe Int

posicionApocaliptica n

| y == n = Just (length xs)

| otherwise = Nothing

where (xs,y:_) = span (<n) apocalipticos

-- 2ª definición de posicionApocaliptica

posicionApocaliptica2 :: Integer -> Maybe Int

posicionApocaliptica2 n

| esApocaliptico n = elemIndex n apocalipticos

| otherwise = Nothing

Pensamiento

A vosotros no os importe pensar lo que habéis leído ochenta veces y oído
quinientas, porque no es lo mismo pensar que haber leído.

Antonio Machado

Reconocimiento de conmutatividad

PorJosé A. Alonso 27-diciembre-20183-enero-2019

Para representar las operaciones binarias en un conjunto finito A con n elementos se pueden numerar sus elementos desde el 0 al n-1. Entonces cada operación binaria en A se puede ver como una lista de listas xss tal que el valor de aplicar la operación a los elementos i y j es el j-ésimo elemento del i-ésimo elemento de xss. Por ejemplo, si A = {0,1,2} entonces las tabla de la suma y de la resta módulo 3 en A son

   0 1 2    0 2 1
   1 2 0    1 0 2
   2 0 1    2 1 0
   Suma     Resta

0 1 2 0 2 1

1 2 0 1 0 2

2 0 1 2 1 0

Suma Resta

Definir la función

   conmutativa :: [[Int]] -> Bool

1	conmutativa :: [[Int]] -> Bool

tal que (conmutativa xss) se verifica si la operación cuya tabla es xss es conmutativa. Por ejemplo,

   conmutativa [[0,1,2],[1,0,1],[2,1,0]]  ==  True
   conmutativa [[0,1,2],[1,0,0],[2,1,0]]  ==  False
   conmutativa [[i+j `mod` 2000 | j <- [0..1999]] | i <- [0..1999]] == True
   conmutativa [[i-j `mod` 2000 | j <- [0..1999]] | i <- [0..1999]] == False

conmutativa [[0,1,2],[1,0,1],[2,1,0]] == True

conmutativa [[0,1,2],[1,0,0],[2,1,0]] == False

conmutativa [[i+j `mod` 2000 | j <- [0..1999]] | i <- [0..1999]] == True

conmutativa [[i-j `mod` 2000 | j <- [0..1999]] | i <- [0..1999]] == False

Soluciones

import Data.List (transpose)
import Test.QuickCheck

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

conmutativa :: [[Int]] -> Bool
conmutativa xss =
  and [producto i j == producto j i | i <- [0..n-1], j <- [0..n-1]]
  where producto i j = (xss !! i) !! j
        n            = length xss

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

conmutativa2 :: [[Int]] -> Bool
conmutativa2 []         = True
conmutativa2 t@(xs:xss) = xs == map head t
                          && conmutativa2 (map tail xss)

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

conmutativa3 :: [[Int]] -> Bool
conmutativa3 xss = xss == transpose xss

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

conmutativa4 :: [[Int]] -> Bool
conmutativa4 = (==) <*> transpose 

-- Equivalencia de las definiciones
-- ================================

-- Para comprobar la equivalencia se define el tipo de tabla de
-- operciones binarias:
newtype Tabla = T [[Int]]
  deriving Show

-- genTabla es un generador de tablas de operciones binaria. Por ejemplo,
--    λ> sample genTabla
--    T [[2,0,0],[1,2,1],[1,0,2]]
--    T [[0,3,0,1],[0,1,2,1],[0,2,1,2],[3,0,0,2]]
--    T [[2,0,1],[1,0,0],[2,1,2]]
--    T [[1,0],[0,1]]
--    T [[1,1],[0,1]]
--    T [[1,1,2],[1,0,1],[2,1,0]]
--    T [[4,4,3,0,2],[2,2,0,1,2],[4,0,1,0,0],[0,4,4,3,3],[3,0,4,2,1]]
--    T [[3,4,1,4,1],[2,4,4,0,4],[1,2,1,4,3],[3,1,4,4,2],[4,1,3,2,3]]
--    T [[2,0,1],[2,1,0],[0,2,2]]
--    T [[3,2,0,3],[2,1,1,1],[0,2,1,0],[3,3,2,3]]
--    T [[2,0,2,0],[0,0,3,1],[1,2,3,2],[3,3,0,2]]
genTabla :: Gen Tabla
genTabla = do
  n  <- choose (2,20)
  xs <- vectorOf (n^2) (elements [0..n-1])
  return (T (separa n xs))

-- (separa n xs) es la lista obtenidaseparando los elementos de xs en
-- grupos de n elementos. Por ejemplo,
--    separa 3 [1..9]  ==  [[1,2,3],[4,5,6],[7,8,9]]
separa :: Int -> [a] -> [[a]]
separa _ [] = []
separa n xs = take n xs : separa n (drop n xs)

-- Generación arbitraria de tablas
instance Arbitrary Tabla where
  arbitrary = genTabla

-- La propiedad es
prop_conmutativa :: Tabla -> Bool
prop_conmutativa (T xss) =
  conmutativa xss  == conmutativa2 xss &&
  conmutativa2 xss == conmutativa3 xss &&
  conmutativa2 xss == conmutativa4 xss

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

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

-- Para las comparaciones se usará la función tablaSuma tal que
-- (tablaSuma n) es la tabla de la suma módulo n en [0..n-1]. Por
-- ejemplo, 
--    tablaSuma 3  ==  [[0,1,2],[1,2,3],[2,3,4]]
tablaSuma ::  Int -> [[Int]]
tablaSuma n =
  [[i + j `mod` n | j <- [0..n-1]] | i <- [0..n-1]]

-- La comparación es
--    λ> conmutativa (tablaSuma 400)
--    True
--    (1.92 secs, 147,608,696 bytes)
--    λ> conmutativa2 (tablaSuma 400)
--    True
--    (0.14 secs, 63,101,112 bytes)
--    λ> conmutativa3 (tablaSuma 400)
--    True
--    (0.10 secs, 64,302,608 bytes)
--    λ> conmutativa4 (tablaSuma 400)
--    True
--    (0.10 secs, 61,738,928 bytes)
--    
--    λ> conmutativa2 (tablaSuma 2000)
--    True
--    (1.81 secs, 1,569,390,480 bytes)
--    λ> conmutativa3 (tablaSuma 2000)
--    True
--    (3.07 secs, 1,601,006,840 bytes)
--    λ> conmutativa4 (tablaSuma 2000)
--    True
--    (3.14 secs, 1,536,971,288 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List (transpose)

import Test.QuickCheck

-- 1ª solución

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

conmutativa :: [[Int]] -> Bool

conmutativa xss =

and [producto i j == producto j i | i <- [0..n-1], j <- [0..n-1]]

where producto i j = (xss !! i) !! j

n = length xss

-- 2ª solución

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

conmutativa2 :: [[Int]] -> Bool

conmutativa2 [] = True

conmutativa2 t@(xs:xss) = xs == map head t

&& conmutativa2 (map tail xss)

-- 3ª solución

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

conmutativa3 :: [[Int]] -> Bool

conmutativa3 xss = xss == transpose xss

-- 4ª solución

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

conmutativa4 :: [[Int]] -> Bool

conmutativa4 = (==) <*> transpose

-- Equivalencia de las definiciones

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

-- Para comprobar la equivalencia se define el tipo de tabla de

-- operciones binarias:

newtype Tabla = T [[Int]]

deriving Show

-- genTabla es un generador de tablas de operciones binaria. Por ejemplo,

-- λ> sample genTabla

-- T [[2,0,0],[1,2,1],[1,0,2]]

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

-- T [[2,0,1],[1,0,0],[2,1,2]]

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

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

-- T [[1,1,2],[1,0,1],[2,1,0]]

-- T [[4,4,3,0,2],[2,2,0,1,2],[4,0,1,0,0],[0,4,4,3,3],[3,0,4,2,1]]

-- T [[3,4,1,4,1],[2,4,4,0,4],[1,2,1,4,3],[3,1,4,4,2],[4,1,3,2,3]]

-- T [[2,0,1],[2,1,0],[0,2,2]]

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

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

genTabla :: Gen Tabla

genTabla = do

n <- choose (2,20)

xs <- vectorOf (n^2) (elements [0..n-1])

return (T (separa n xs))

-- (separa n xs) es la lista obtenidaseparando los elementos de xs en

-- grupos de n elementos. Por ejemplo,

-- separa 3 [1..9] == [[1,2,3],[4,5,6],[7,8,9]]

separa :: Int -> [a] -> [[a]]

separa _ [] = []

separa n xs = take n xs : separa n (drop n xs)

-- Generación arbitraria de tablas

instance Arbitrary Tabla where

arbitrary = genTabla

-- La propiedad es

prop_conmutativa :: Tabla -> Bool

prop_conmutativa (T xss) =

conmutativa xss == conmutativa2 xss &&

conmutativa2 xss == conmutativa3 xss &&

conmutativa2 xss == conmutativa4 xss

-- La comprobación es

-- λ> quickCheck prop_conmutativa

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- Para las comparaciones se usará la función tablaSuma tal que

-- (tablaSuma n) es la tabla de la suma módulo n en [0..n-1]. Por

-- ejemplo,

-- tablaSuma 3 == [[0,1,2],[1,2,3],[2,3,4]]

tablaSuma :: Int -> [[Int]]

tablaSuma n =

[[i + j `mod` n | j <- [0..n-1]] | i <- [0..n-1]]

-- La comparación es

-- λ> conmutativa (tablaSuma 400)

-- True

-- (1.92 secs, 147,608,696 bytes)

-- λ> conmutativa2 (tablaSuma 400)

-- True

-- (0.14 secs, 63,101,112 bytes)

-- λ> conmutativa3 (tablaSuma 400)

-- True

-- (0.10 secs, 64,302,608 bytes)

-- λ> conmutativa4 (tablaSuma 400)

-- True

-- (0.10 secs, 61,738,928 bytes)

-- λ> conmutativa2 (tablaSuma 2000)

-- True

-- (1.81 secs, 1,569,390,480 bytes)

-- λ> conmutativa3 (tablaSuma 2000)

-- True

-- (3.07 secs, 1,601,006,840 bytes)

-- λ> conmutativa4 (tablaSuma 2000)

-- True

-- (3.14 secs, 1,536,971,288 bytes)

Pensamiento

«Nuestras horas son minutos cuando esperamos saber, y siglos cuando
sabemos lo que se puede aprender.»

Antonio Machado

Intercambio de la primera y última columna de una matriz

PorJosé A. Alonso 17-diciembre-201824-diciembre-2018

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

   8 9 7 6
   4 7 6 5
   3 2 1 8

8 9 7 6

4 7 6 5

3 2 1 8

se puede representar por la lista

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

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

Definir la función

   intercambia :: [[a]] -> [[a]]

1	intercambia :: [[a]] -> [[a]]

tal que (intercambia xss) es la matriz obtenida intercambiando la primera y la última columna de xss. Por ejemplo,

   λ> intercambia [[8,9,7,6],[4,7,6,5],[3,2,1,8]]
   [[6,9,7,8],[5,7,6,4],[8,2,1,3]]

1 2	λ> intercambia [[8,9,7,6],[4,7,6,5],[3,2,1,8]] [[6,9,7,8],[5,7,6,4],[8,2,1,3]]

Soluciones

intercambia :: [[a]] -> [[a]]
intercambia = map intercambiaL

-- (intercambiaL xs) es la lista obtenida intercambiando el primero y el
-- último elemento de xs. Por ejemplo,
--    intercambiaL [8,9,7,6]  ==  [6,9,7,8]
intercambiaL :: [a] -> [a]
intercambiaL xs =
  last xs : tail (init xs) ++ [head xs]

intercambia :: [[a]] -> [[a]]

intercambia = map intercambiaL

-- (intercambiaL xs) es la lista obtenida intercambiando el primero y el

-- último elemento de xs. Por ejemplo,

-- intercambiaL [8,9,7,6] == [6,9,7,8]

intercambiaL :: [a] -> [a]

intercambiaL xs =

last xs : tail (init xs) ++ [head xs]

Pensamiento

«¡Que difícil es,
cuando todo baja
no bajar también!»

Antonio Machado

Expresiones aritméticas generales

PorJosé A. Alonso 13-diciembre-201825-marzo-2022

Las expresiones aritméticas. generales se contruyen con las sumas generales (sumatorios) y productos generales (productorios). Su tipo es

   data Expresion = N Int
                  | S [Expresion]
                  | P [Expresion]
     deriving Show

data Expresion = N Int

| S [Expresion]

| P [Expresion]

deriving Show

Por ejemplo, la expresión (2 * (1 + 2 + 1) * (2 + 3)) + 1 se representa por S [P [N 2, S [N 1, N 2, N 1], S [N 2, N 3]], N 1]

Definir la función

   valor :: Expresion -> Int

1	valor :: Expresion -> Int

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

   λ> valor (S [P [N 2, S [N 1, N 2, N 1], S [N 2, N 3]], N 1])
   41

1 2	λ> valor (S [P [N 2, S [N 1, N 2, N 1], S [N 2, N 3]], N 1]) 41

Soluciones

data Expresion = N Int
               | S [Expresion]
               | P [Expresion]
  deriving Show

valor :: Expresion -> Int
valor (N x)  = x
valor (S es) = sum (map valor es)
valor (P es) = product (map valor es)

data Expresion = N Int

| S [Expresion]

| P [Expresion]

deriving Show

valor :: Expresion -> Int

valor (N x) = x

valor (S es) = sum (map valor es)

valor (P es) = product (map valor es)

Pensamiento

Vivir es devorar tiempo, esperar; y por muy trascendente que quiera ser nuestra espera, siempre será espera de seguir esperando.

Antonio Machado

Aproximación entre pi y e

PorJosé A. Alonso 7-diciembre-201817-enero-2019

El día 11 de noviembre, se publicó en la cuenta de Twitter de Fermat’s Library la siguiente curiosa identidad que relaciona los números e y pi:

Definir las siguientes funciones:

   sumaTerminos :: Int -> Double
   aproximacion :: Double -> Int

1 2	sumaTerminos :: Int -> Double aproximacion :: Double -> Int

tales que

(sumaTerminos n) es la suma de los primeros n términos de la serie 1/(π²+ 1) + 1/(4π²+1) + 1/(9π²+1) + 1/(16π²+ ) + … Por ejemplo,

     sumaTerminos 10     ==  0.14687821811081034
     sumaTerminos 100    ==  0.15550948345688423
     sumaTerminos 1000   ==  0.15641637221314514
     sumaTerminos 10000  ==  0.15650751113789382

sumaTerminos 10 == 0.14687821811081034

sumaTerminos 100 == 0.15550948345688423

sumaTerminos 1000 == 0.15641637221314514

sumaTerminos 10000 == 0.15650751113789382

(aproximación x) es el menor número de términos que hay que sumar de la serie anterior para que se diferencie (en valor absoluto) de 1/(e²-1) menos que x. Por ejemplo,

     aproximacion 0.1     ==  1
     aproximacion 0.01    ==  10
     aproximacion 0.001   ==  101
     aproximacion 0.0001  ==  1013

aproximacion 0.1 == 1

aproximacion 0.01 == 10

aproximacion 0.001 == 101

aproximacion 0.0001 == 1013

Soluciones

-- 1ª definición de sumaTerminos
sumaTerminos :: Int -> Double
sumaTerminos n =
  sum [1 / (((x ^ 2) * (pi ^ 2)) + 1) | x <- [1 .. fromIntegral n]]

-- 2ª definición de sumaTerminos
sumaTerminos2 :: Int -> Double
sumaTerminos2 0 = 0
sumaTerminos2 n = 1 / (m^2 * pi^2 + 1) + sumaTerminos2 (n-1)
  where m = fromIntegral n

-- Definición de aproximacion
aproximacion :: Double -> Int
aproximacion x =
  head [n | n <- [0..]
          , abs (sumaTerminos n - 1 / (e^2 - 1)) < x]
  where e = exp 1

-- 1ª definición de sumaTerminos

sumaTerminos :: Int -> Double

sumaTerminos n =

sum [1 / (((x ^ 2) * (pi ^ 2)) + 1) | x <- [1 .. fromIntegral n]]

-- 2ª definición de sumaTerminos

sumaTerminos2 :: Int -> Double

sumaTerminos2 0 = 0

sumaTerminos2 n = 1 / (m^2 * pi^2 + 1) + sumaTerminos2 (n-1)

where m = fromIntegral n

-- Definición de aproximacion

aproximacion :: Double -> Int

aproximacion x =

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

, abs (sumaTerminos n - 1 / (e^2 - 1)) < x]

where e = exp 1

Pensamiento

«Sólo sé que no se nada» contenía la jactancia de un excesivo saber, puesto que olvidó añadir: y aun de esto mismo no estoy completamente seguro.

Antonio Machado

Elemento solitario

PorJosé A. Alonso 28-noviembre-201819-enero-2019

Definir la función

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

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

tal que (solitario xs) es el único elemento que ocurre una vez en la lista xs (se supone que la lista xs tiene al menos 3 elementos y todos son iguales menos uno que es el solitario). Por ejemplo,

   solitario [2,2,7,2]  ==  7
   solitario [2,2,2,7]  ==  7
   solitario [7,2,2,2]  ==  7
   solitario (replicate (2*10^7) 1 ++ [2])  ==  2

solitario [2,2,7,2] == 7

solitario [2,2,2,7] == 7

solitario [7,2,2,2] == 7

solitario (replicate (2*10^7) 1 ++ [2]) == 2

Soluciones

import Test.QuickCheck 
import Data.List (group, nub, sort)

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

solitario :: Ord a => [a] -> a
solitario xs =
  head [x | x <- xs
          , cuenta xs x == 1]

cuenta :: Eq a => [a] -> a -> Int
cuenta xs x = length [y | y <- xs
                        , x == y]

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

solitario2 :: Ord a => [a] -> a
solitario2 xs = head (filter (\x -> cuenta2 xs x == 1) xs)

cuenta2 :: Eq a => [a] -> a -> Int
cuenta2 xs x = length (filter (==x) xs)

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

solitario3 :: Ord a => [a] -> a
solitario3 [x] = x
solitario3 (x1:x2:x3:xs)
  | x1 /= x2 && x2 == x3 = x1
  | x1 == x2 && x2 /= x3 = x3
  | otherwise            = solitario3 (x2:x3:xs)

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

solitario4 :: Ord a => [a] -> a
solitario4 xs 
  | y1 == y2  = last ys
  | otherwise = y1
  where (y1:y2:ys) = sort xs

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

solitario5 :: Ord a => [a] -> a
solitario5 xs | null ys   = y
              | otherwise = z
  where [y:ys,z:zs] = group (sort xs)

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

solitario6 :: Ord a => [a] -> a
solitario6 xs =
  head [x | x <- nub xs
          , cuenta xs x == 1]

-- 7ª definición
-- =============

solitario7 :: Ord a => [a] -> a
solitario7 (a:b:xs)
  | a == b        = solitario7 (b:xs)
  | elem a (b:xs) = b
  | elem b (a:xs) = a
solitario7 [a,b] = b

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

-- Propiedad de equivalencia
prop_solitario_equiv :: Property
prop_solitario_equiv =
  forAll listaSolitaria (\xs -> solitario xs == solitario2 xs &&
                                solitario xs == solitario3 xs &&
                                solitario xs == solitario4 xs &&
                                solitario xs == solitario5 xs &&
                                solitario xs == solitario6 xs &&
                                solitario xs == solitario7 xs)

-- Generador de listas con al menos 3 elementos y todos iguales menos
-- uno. Por ejemplo,
--    λ> sample listaSolitaria
--    [1,0,0,0,0]
--    [0,0,-1,0,0,0]
--    [4,1,1,1]
--    [6,6,4,6]
--    [8,8,8,8,8,-4,8,8,8,8,8,8]
--    ...
listaSolitaria :: Gen [Int]
listaSolitaria = do
  n <- arbitrary
  m <- arbitrary `suchThat` (\a -> n + a > 2)
  x <- arbitrary
  y <- arbitrary `suchThat` (\a -> a /= x)
  return (replicate n x ++ [y] ++ replicate m x)

-- Comprobación:
--    λ> quickCheck prop_solitario_equiv
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia:
--    λ> solitario (replicate (5*10^3) 1 ++ [2])
--    2
--    (5.47 secs, 3,202,688,152 bytes)
--    λ> solitario2 (replicate (5*10^3) 1 ++ [2])
--    2
--    (2.08 secs, 1,401,603,960 bytes)
--    λ> solitario3 (replicate (5*10^3) 1 ++ [2])
--    2
--    (0.04 secs, 3,842,240 bytes)
--    λ> solitario4 (replicate (5*10^3) 1 ++ [2])
--    2
--    (0.02 secs, 1,566,472 bytes)
--    λ> solitario5 (replicate (5*10^3) 1 ++ [2])
--    2
--    (0.01 secs, 927,064 bytes)
--    λ> solitario6 (replicate (5*10^3) 1 ++ [2])
--    2
--    (0.01 secs, 1,604,176 bytes)
--    λ> solitario7 (replicate (5*10^3) 1 ++ [2])
--    2
--    (0.01 secs, 1,923,440 bytes)
--    
--    λ> solitario3 (replicate (5*10^6) 1 ++ [2])
--    2
--    (4.62 secs, 3,720,123,560 bytes)
--    λ> solitario4 (replicate (5*10^6) 1 ++ [2])
--    2
--    (1.48 secs, 1,440,124,240 bytes)
--    λ> solitario5 (replicate (5*10^6) 1 ++ [2])
--    2
--    (1.40 secs, 1,440,125,936 bytes)
--    λ> solitario6 (replicate (5*10^6) 1 ++ [2])
--    2
--    (2.65 secs, 1,480,125,032 bytes)
--    λ> solitario7 (replicate (5*10^6) 1 ++ [2])
--    2
--    (2.21 secs, 1,800,126,224 bytes)
--    
--    λ> solitario5 (2 : replicate (5*10^6) 1)
--    2
--    (1.38 secs, 1,520,127,864 bytes)
--    λ> solitario6 (2 : replicate (5*10^6) 1)
--    2
--    (1.18 secs, 560,127,664 bytes)
--    λ> solitario7 (2 : replicate (5*10^6) 1)
--    2
--    (0.29 secs, 280,126,888 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

import Test.QuickCheck

import Data.List (group, nub, sort)

-- 1ª definición

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

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

solitario xs =

head [x | x <- xs

, cuenta xs x == 1]

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

cuenta xs x = length [y | y <- xs

, x == y]

-- 2ª definición

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

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

solitario2 xs = head (filter (\x -> cuenta2 xs x == 1) xs)

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

cuenta2 xs x = length (filter (==x) xs)

-- 3ª definición

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

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

solitario3 [x] = x

solitario3 (x1:x2:x3:xs)

| x1 /= x2 && x2 == x3 = x1

| x1 == x2 && x2 /= x3 = x3

| otherwise = solitario3 (x2:x3:xs)

-- 4ª definición

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

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

solitario4 xs

| y1 == y2 = last ys

| otherwise = y1

where (y1:y2:ys) = sort xs

-- 5ª definición

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

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

solitario5 xs | null ys = y

| otherwise = z

where [y:ys,z:zs] = group (sort xs)

-- 6ª definición

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

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

solitario6 xs =

head [x | x <- nub xs

, cuenta xs x == 1]

-- 7ª definición

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

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

solitario7 (a:b:xs)

| a == b = solitario7 (b:xs)

| elem a (b:xs) = b

| elem b (a:xs) = a

solitario7 [a,b] = b

-- Equivalencia

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

-- Propiedad de equivalencia

prop_solitario_equiv :: Property

prop_solitario_equiv =

forAll listaSolitaria (\xs -> solitario xs == solitario2 xs &&

solitario xs == solitario3 xs &&

solitario xs == solitario4 xs &&

solitario xs == solitario5 xs &&

solitario xs == solitario6 xs &&

solitario xs == solitario7 xs)

-- Generador de listas con al menos 3 elementos y todos iguales menos

-- uno. Por ejemplo,

-- λ> sample listaSolitaria

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

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

-- [4,1,1,1]

-- [6,6,4,6]

-- [8,8,8,8,8,-4,8,8,8,8,8,8]

-- ...

listaSolitaria :: Gen [Int]

listaSolitaria = do

n <- arbitrary

m <- arbitrary `suchThat` (\a -> n + a > 2)

x <- arbitrary

y <- arbitrary `suchThat` (\a -> a /= x)

return (replicate n x ++ [y] ++ replicate m x)

-- Comprobación:

-- λ> quickCheck prop_solitario_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia:

-- λ> solitario (replicate (5*10^3) 1 ++ [2])

-- 2

-- (5.47 secs, 3,202,688,152 bytes)

-- λ> solitario2 (replicate (5*10^3) 1 ++ [2])

-- 2

-- (2.08 secs, 1,401,603,960 bytes)

-- λ> solitario3 (replicate (5*10^3) 1 ++ [2])

-- 2

-- (0.04 secs, 3,842,240 bytes)

-- λ> solitario4 (replicate (5*10^3) 1 ++ [2])

-- 2

-- (0.02 secs, 1,566,472 bytes)

-- λ> solitario5 (replicate (5*10^3) 1 ++ [2])

-- 2

-- (0.01 secs, 927,064 bytes)

-- λ> solitario6 (replicate (5*10^3) 1 ++ [2])

-- 2

-- (0.01 secs, 1,604,176 bytes)

-- λ> solitario7 (replicate (5*10^3) 1 ++ [2])

-- 2

-- (0.01 secs, 1,923,440 bytes)

-- λ> solitario3 (replicate (5*10^6) 1 ++ [2])

-- 2

-- (4.62 secs, 3,720,123,560 bytes)

-- λ> solitario4 (replicate (5*10^6) 1 ++ [2])

-- 2

-- (1.48 secs, 1,440,124,240 bytes)

-- λ> solitario5 (replicate (5*10^6) 1 ++ [2])

-- 2

-- (1.40 secs, 1,440,125,936 bytes)

-- λ> solitario6 (replicate (5*10^6) 1 ++ [2])

-- 2

-- (2.65 secs, 1,480,125,032 bytes)

-- λ> solitario7 (replicate (5*10^6) 1 ++ [2])

-- 2

-- (2.21 secs, 1,800,126,224 bytes)

-- λ> solitario5 (2 : replicate (5*10^6) 1)

-- 2

-- (1.38 secs, 1,520,127,864 bytes)

-- λ> solitario6 (2 : replicate (5*10^6) 1)

-- 2

-- (1.18 secs, 560,127,664 bytes)

-- λ> solitario7 (2 : replicate (5*10^6) 1)

-- 2

-- (0.29 secs, 280,126,888 bytes)

Pensamiento

Sube y sube, pero ten
cuidado Nefelibata,
que entre las nubes también,
se puede meter la pata.

Antonio Machado

Suma de inversos de potencias de cuatro

PorJosé A. Alonso 27-noviembre-201819-enero-2019

Esta semana se ha publicado en Twitter una demostración visual de la suma de inversos de potencias de 4:

   1/4 + 1/4² + 1/4³ + ... = 1/3

1	1/4 + 1/4² + 1/4³ + ... = 1/3

Definir las funciones

   sumaInversosPotenciasDeCuatro :: [Double]
   aproximacion :: Double -> Int

1 2	sumaInversosPotenciasDeCuatro :: [Double] aproximacion :: Double -> Int

tales que

sumaInversosPotenciasDeCuatro es la lista de las suma de la serie de los inversos de las potencias de cuatro. Por ejemplo,

   λ> take 6 sumaInversosPotenciasDeCuatro
   [0.25,0.3125,0.328125,0.33203125,0.3330078125,0.333251953125]

1 2	λ> take 6 sumaInversosPotenciasDeCuatro [0.25,0.3125,0.328125,0.33203125,0.3330078125,0.333251953125]

(aproximacion e) es el menor número de términos de la serie anterior que hay que sumar para que el valor absoluto de su diferencia con 1/3 sea menor que e. Por ejemplo,

   aproximacion 0.001  ==  4
   aproximacion 1e-3   ==  4
   aproximacion 1e-6   ==  9
   aproximacion 1e-20  ==  26
   sumaInversosPotenciasDeCuatro !! 26  ==  0.3333333333333333

aproximacion 0.001 == 4

aproximacion 1e-3 == 4

aproximacion 1e-6 == 9

aproximacion 1e-20 == 26

sumaInversosPotenciasDeCuatro !! 26 == 0.3333333333333333

Soluciones

-- 1ª definición
sumaInversosPotenciasDeCuatro :: [Double]
sumaInversosPotenciasDeCuatro =
  [sum [1 / (4^k) | k <- [1..n]] | n <- [1..]]

-- 2ª definición
sumaInversosPotenciasDeCuatro2 :: [Double]
sumaInversosPotenciasDeCuatro2 =
  [1/4*((1/4)^n-1)/(1/4-1) | n <- [1..]]

-- 3ª definición
sumaInversosPotenciasDeCuatro3 :: [Double]
sumaInversosPotenciasDeCuatro3 =
  [(1 - 0.25^n)/3 | n <- [1..]]

-- 1ª solución  
aproximacion :: Double -> Int
aproximacion e =
  length (takeWhile (>=e) es)
  where es = [abs (1/3 - x) | x <- sumaInversosPotenciasDeCuatro3]

-- 2ª solución  
aproximacion2 :: Double -> Int
aproximacion2 e =
  head [n | (x,n) <- zip es [0..]
          , x < e]
  where es = [abs (1/3 - x) | x <- sumaInversosPotenciasDeCuatro2]

-- 1ª definición

sumaInversosPotenciasDeCuatro :: [Double]

sumaInversosPotenciasDeCuatro =

[sum [1 / (4^k) | k <- [1..n]] | n <- [1..]]

-- 2ª definición

sumaInversosPotenciasDeCuatro2 :: [Double]

sumaInversosPotenciasDeCuatro2 =

[1/4*((1/4)^n-1)/(1/4-1) | n <- [1..]]

-- 3ª definición

sumaInversosPotenciasDeCuatro3 :: [Double]

sumaInversosPotenciasDeCuatro3 =

[(1 - 0.25^n)/3 | n <- [1..]]

-- 1ª solución

aproximacion :: Double -> Int

aproximacion e =

length (takeWhile (>=e) es)

where es = [abs (1/3 - x) | x <- sumaInversosPotenciasDeCuatro3]

-- 2ª solución

aproximacion2 :: Double -> Int

aproximacion2 e =

head [n | (x,n) <- zip es [0..]

, x < e]

where es = [abs (1/3 - x) | x <- sumaInversosPotenciasDeCuatro2]

Pensamiento

Confiamos
en que no será verdad
nada de lo que pensamos.

Antonio Machado

Números primos sumas de dos primos

PorJosé A. Alonso 26-noviembre-201819-enero-2019

Definir las funciones

   esPrimoSumaDeDosPrimos :: Integer -> Bool

1	esPrimoSumaDeDosPrimos :: Integer -> Bool

primosSumaDeDosPrimos :: [Integer]
tales que

(esPrimoSumaDeDosPrimos x) se verifica si x es un número primo que se puede escribir como la suma de dos números primos. Por ejemplo,

     esPrimoSumaDeDosPrimos 19        ==  True
     esPrimoSumaDeDosPrimos 20        ==  False
     esPrimoSumaDeDosPrimos 23        ==  False
     esPrimoSumaDeDosPrimos 18409541  ==  False

esPrimoSumaDeDosPrimos 19 == True

esPrimoSumaDeDosPrimos 20 == False

esPrimoSumaDeDosPrimos 23 == False

esPrimoSumaDeDosPrimos 18409541 == False

primosSumaDeDosPrimos es la lista de los números primos que se pueden escribir como la suma de dos números primos. Por ejemplo,

     λ> take 17 primosSumaDeDosPrimos
     [5,7,13,19,31,43,61,73,103,109,139,151,181,193,199,229,241]
     λ> primosSumaDeDosPrimos !! (10^5)
     18409543

λ> take 17 primosSumaDeDosPrimos

[5,7,13,19,31,43,61,73,103,109,139,151,181,193,199,229,241]

λ> primosSumaDeDosPrimos !! (10^5)

18409543

Soluciones

import Data.Numbers.Primes (isPrime, primes)

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

esPrimoSumaDeDosPrimos :: Integer -> Bool
esPrimoSumaDeDosPrimos x =
  isPrime x && isPrime (x - 2)

primosSumaDeDosPrimos :: [Integer]
primosSumaDeDosPrimos =
  [x | x <- primes
     , isPrime (x - 2)]

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

primosSumaDeDosPrimos2 :: [Integer]
primosSumaDeDosPrimos2 =
  [y | (x,y) <- zip primes (tail primes)
     , y == x + 2]

esPrimoSumaDeDosPrimos2 :: Integer -> Bool
esPrimoSumaDeDosPrimos2 x = 
  x == head (dropWhile (<x) primosSumaDeDosPrimos2)

-- Equivalencias
-- =============

-- Equivalencia de esPrimoSumaDeDosPrimos
prop_esPrimoSumaDeDosPrimos_equiv :: Integer -> Property
prop_esPrimoSumaDeDosPrimos_equiv x =
  x > 0 ==>
  esPrimoSumaDeDosPrimos x == esPrimoSumaDeDosPrimos2 x

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

-- Equivalencia de primosSumaDeDosPrimos
prop_primosSumaDeDosPrimos_equiv :: Int -> Property
prop_primosSumaDeDosPrimos_equiv n =
  n >= 0 ==>
  primosSumaDeDosPrimos !! n == primosSumaDeDosPrimos2 !! n

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

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

--    λ> primosSumaDeDosPrimos !! (10^4)
--    1261081
--    (2.07 secs, 4,540,085,256 bytes)
--
-- Se recarga para evitar memorización    
--    λ> primosSumaDeDosPrimos2 !! (10^4)
--    1261081
--    (0.49 secs, 910,718,408 bytes)

import Data.Numbers.Primes (isPrime, primes)

-- 1ª solución

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

esPrimoSumaDeDosPrimos :: Integer -> Bool

esPrimoSumaDeDosPrimos x =

isPrime x && isPrime (x - 2)

primosSumaDeDosPrimos :: [Integer]

primosSumaDeDosPrimos =

[x | x <- primes

, isPrime (x - 2)]

-- 2ª solución

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

primosSumaDeDosPrimos2 :: [Integer]

primosSumaDeDosPrimos2 =

[y | (x,y) <- zip primes (tail primes)

, y == x + 2]

esPrimoSumaDeDosPrimos2 :: Integer -> Bool

esPrimoSumaDeDosPrimos2 x =

x == head (dropWhile (<x) primosSumaDeDosPrimos2)

-- Equivalencias

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

-- Equivalencia de esPrimoSumaDeDosPrimos

prop_esPrimoSumaDeDosPrimos_equiv :: Integer -> Property

prop_esPrimoSumaDeDosPrimos_equiv x =

x > 0 ==>

esPrimoSumaDeDosPrimos x == esPrimoSumaDeDosPrimos2 x

-- La comprobación es

-- λ> quickCheck prop_esPrimoSumaDeDosPrimos_equiv

-- +++ OK, passed 100 tests.

-- Equivalencia de primosSumaDeDosPrimos

prop_primosSumaDeDosPrimos_equiv :: Int -> Property

prop_primosSumaDeDosPrimos_equiv n =

n >= 0 ==>

primosSumaDeDosPrimos !! n == primosSumaDeDosPrimos2 !! n

-- La comprobación es

-- λ> quickCheck prop_primosSumaDeDosPrimos_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> primosSumaDeDosPrimos !! (10^4)

-- 1261081

-- (2.07 secs, 4,540,085,256 bytes)

-- Se recarga para evitar memorización

-- λ> primosSumaDeDosPrimos2 !! (10^4)

-- 1261081

-- (0.49 secs, 910,718,408 bytes)

Pensamiento

Sed incompresivos; yo os aconsejo la incomprensión, aunque sólo sea para destripar los chistes de los tontos.

Antonio Machado

Relación definida por una partición

PorJosé A. Alonso 22-noviembre-201819-enero-2019

Dos elementos están relacionados por una partición xss si pertenecen al mismo elemento de xss.

Definir la función

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

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

tal que (relacionados xss y z) se verifica si los elementos y y z están relacionados por la partición xss. Por ejemplo,

   relacionados [[1,3],[2],[9,5,7]] 7 9  ==  True
   relacionados [[1,3],[2],[9,5,7]] 3 9  ==  False
   relacionados [[1,3],[2],[9,5,7]] 4 9  ==  False

relacionados [[1,3],[2],[9,5,7]] 7 9 == True

relacionados [[1,3],[2],[9,5,7]] 3 9 == False

relacionados [[1,3],[2],[9,5,7]] 4 9 == False

Soluciones

import Data.List ((\\), intersect)

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

relacionados :: Eq a => [[a]] -> a -> a -> Bool
relacionados [] _ _ = False
relacionados (xs:xss) y z
  | y `elem` xs = z `elem` xs
  | otherwise   = relacionados xss y z

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

relacionados2 :: Eq a => [[a]] -> a -> a -> Bool
relacionados2 xss y z =
  or [elem y xs && elem z xs | xs <- xss]

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

relacionados3 :: Eq a => [[a]] -> a -> a -> Bool
relacionados3 xss y z =
  or [[y,z] `subconjunto` xs | xs <- xss]

-- (subconjunto xs ys) se verifica si xs es un subconjunto de ys; es
-- decir, si todos los elementos de xs pertenecen a ys. Por ejemplo,  
--    subconjunto [3,2,3] [2,5,3,5]  ==  True
--    subconjunto [3,2,3] [2,5,6,5]  ==  False
subconjunto :: Eq a => [a] -> [a] -> Bool
subconjunto xs ys = and [elem x ys | x <- xs]

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

relacionados4 :: Eq a => [[a]] -> a -> a -> Bool
relacionados4 xss y z =
  any ([y,z] `subconjunto`) xss

import Data.List ((\\), intersect)

-- 1ª definición

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

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

relacionados [] _ _ = False

relacionados (xs:xss) y z

| y `elem` xs = z `elem` xs

| otherwise = relacionados xss y z

-- 2ª definición

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

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

relacionados2 xss y z =

or [elem y xs && elem z xs | xs <- xss]

-- 3ª definición

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

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

relacionados3 xss y z =

or [[y,z] `subconjunto` xs | xs <- xss]

-- (subconjunto xs ys) se verifica si xs es un subconjunto de ys; es

-- decir, si todos los elementos de xs pertenecen a ys. Por ejemplo,

-- subconjunto [3,2,3] [2,5,3,5] == True

-- subconjunto [3,2,3] [2,5,6,5] == False

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

subconjunto xs ys = and [elem x ys | x <- xs]

-- 4ª definición

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

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

relacionados4 xss y z =

any ([y,z] `subconjunto`) xss

Pensamiento

No hay lío político que no sea un trueque, una confusión de máscaras, un mal ensayo de comedia, en que nadie sabe su papel.

Antonio Machado

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico