Orden superior – Página 4

Conjetura de Goldbach

PorJosé A. Alonso 1-abril-202026-marzo-2022

Una forma de la conjetura de Golbach afirma que todo entero mayor que 1 se puede escribir como la suma de uno, dos o tres números primos.

Si se define el índice de Goldbach de n > 1 como la mínima cantidad de primos necesarios para que su suma sea n, entonces la conjetura de Goldbach afirma que todos los índices de Goldbach de los enteros mayores que 1 son menores que 4.

Definir las siguientes funciones

   indiceGoldbach  :: Int -> Int
   graficaGoldbach :: Int -> IO ()

1 2	indiceGoldbach :: Int -> Int graficaGoldbach :: Int -> IO ()

tales que

(indiceGoldbach n) es el índice de Goldbach de n. Por ejemplo,

     indiceGoldbach 2                        ==  1
     indiceGoldbach 4                        ==  2
     indiceGoldbach 27                       ==  3
     sum (map indiceGoldbach [2..5000])      ==  10619
     maximum (map indiceGoldbach [2..5000])  ==  3

indiceGoldbach 2 == 1

indiceGoldbach 4 == 2

indiceGoldbach 27 == 3

sum (map indiceGoldbach [2..5000]) == 10619

maximum (map indiceGoldbach [2..5000]) == 3

(graficaGoldbach n) dibuja la gráfica de los índices de Goldbach de los números entre 2 y n. Por ejemplo, (graficaGoldbach 150) dibuja

Comprobar con QuickCheck la conjetura de Goldbach anterior.

Soluciones

import Data.Array
import Data.Numbers.Primes
import Graphics.Gnuplot.Simple
import Test.QuickCheck


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

indiceGoldbach :: Int -> Int
indiceGoldbach n =
  minimum (map length (particiones n))

particiones :: Int -> [[Int]]
particiones n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
    where f 0 = [[]]
          f m = [x:y | x <- xs, 
                       y <- v ! (m-x), 
                       [x] >= take 1 y]
            where xs = reverse (takeWhile (<= m) primes)

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

indiceGoldbach2 :: Int -> Int
indiceGoldbach2 x =
  head [n | n <- [1..], esSumaDe x n]

-- (esSumaDe x n) se verifica si x se puede escribir como la suma de n
-- primos. Por ejemplo,
--    esSumaDe 2  1  ==  True
--    esSumaDe 4  1  ==  False
--    esSumaDe 4  2  ==  True
--    esSumaDe 27 2  ==  False
--    esSumaDe 27 3  ==  True
esSumaDe :: Int -> Int -> Bool
esSumaDe x 1 = isPrime x
esSumaDe x n = or [esSumaDe (x-p) (n-1) | p <- takeWhile (<= x) primes]

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

indiceGoldbach3 :: Int -> Int
indiceGoldbach3 x =
  head [n | n <- [1..], esSumaDe3 x n]

esSumaDe3 :: Int -> Int -> Bool
esSumaDe3 x n = a ! (x,n) where
  a = array ((2,1),(x,9)) [((i,j),f i j) | i <- [2..x], j <- [1..9]]
  f i 1 = isPrime i
  f i j = or [a!(i-k,j-1) | k <- takeWhile (<= i) primes]

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

indiceGoldbach4 :: Int -> Int
indiceGoldbach4 n = v ! n where
  v = array (2,n) [(i,f i) | i <- [2..n]]
  f i | isPrime i = 1
      | otherwise = 1 + minimum [v!(i-p) | p <- takeWhile (< (i-1)) primes]

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

--    λ> sum (map indiceGoldbach [2..80])
--    142
--    (2.66 secs, 1,194,330,496 bytes)
--    λ> sum (map indiceGoldbach2 [2..80])
--    142
--    (0.01 secs, 1,689,944 bytes)
--    λ> sum (map indiceGoldbach3 [2..80])
--    142
--    (0.03 secs, 27,319,296 bytes)
--    λ> sum (map indiceGoldbach4 [2..80])
--    142
--    (0.03 secs, 47,823,656 bytes)
--    
--    λ> sum (map indiceGoldbach2 [2..1000])
--    2030
--    (0.10 secs, 200,140,264 bytes)
--    λ> sum (map indiceGoldbach3 [2..1000])
--    2030
--    (3.10 secs, 4,687,467,664 bytes)

-- Gráfica
-- =======

graficaGoldbach :: Int -> IO ()
graficaGoldbach n =
  plotList [ Key Nothing
           , XRange (2,fromIntegral n)
           , PNG ("Conjetura_de_Goldbach_" ++ show n ++ ".png")
           ]
           [indiceGoldbach2 k | k <- [2..n]]

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

-- La propiedad es
prop_Goldbach :: Int -> Property
prop_Goldbach x =
  x >= 2 ==> indiceGoldbach2 x < 4

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

100

101

102

103

104

105

106

107

import Data.Array

import Data.Numbers.Primes

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª definición

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

indiceGoldbach :: Int -> Int

indiceGoldbach n =

minimum (map length (particiones n))

particiones :: Int -> [[Int]]

particiones n = v ! n where

v = array (0,n) [(i,f i) | i <- [0..n]]

where f 0 = [[]]

f m = [x:y | x <- xs,

y <- v ! (m-x),

[x] >= take 1 y]

where xs = reverse (takeWhile (<= m) primes)

-- 2ª definición

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

indiceGoldbach2 :: Int -> Int

indiceGoldbach2 x =

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

-- (esSumaDe x n) se verifica si x se puede escribir como la suma de n

-- primos. Por ejemplo,

-- esSumaDe 2 1 == True

-- esSumaDe 4 1 == False

-- esSumaDe 4 2 == True

-- esSumaDe 27 2 == False

-- esSumaDe 27 3 == True

esSumaDe :: Int -> Int -> Bool

esSumaDe x 1 = isPrime x

esSumaDe x n = or [esSumaDe (x-p) (n-1) | p <- takeWhile (<= x) primes]

-- 3ª definición

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

indiceGoldbach3 :: Int -> Int

indiceGoldbach3 x =

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

esSumaDe3 :: Int -> Int -> Bool

esSumaDe3 x n = a ! (x,n) where

a = array ((2,1),(x,9)) [((i,j),f i j) | i <- [2..x], j <- [1..9]]

f i 1 = isPrime i

f i j = or [a!(i-k,j-1) | k <- takeWhile (<= i) primes]

-- 4ª definición

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

indiceGoldbach4 :: Int -> Int

indiceGoldbach4 n = v ! n where

v = array (2,n) [(i,f i) | i <- [2..n]]

f i | isPrime i = 1

| otherwise = 1 + minimum [v!(i-p) | p <- takeWhile (< (i-1)) primes]

-- Comparación de eficiencia

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

-- λ> sum (map indiceGoldbach [2..80])

-- 142

-- (2.66 secs, 1,194,330,496 bytes)

-- λ> sum (map indiceGoldbach2 [2..80])

-- 142

-- (0.01 secs, 1,689,944 bytes)

-- λ> sum (map indiceGoldbach3 [2..80])

-- 142

-- (0.03 secs, 27,319,296 bytes)

-- λ> sum (map indiceGoldbach4 [2..80])

-- 142

-- (0.03 secs, 47,823,656 bytes)

-- λ> sum (map indiceGoldbach2 [2..1000])

-- 2030

-- (0.10 secs, 200,140,264 bytes)

-- λ> sum (map indiceGoldbach3 [2..1000])

-- 2030

-- (3.10 secs, 4,687,467,664 bytes)

-- Gráfica

-- =======

graficaGoldbach :: Int -> IO ()

graficaGoldbach n =

plotList [ Key Nothing

, XRange (2,fromIntegral n)

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

]

[indiceGoldbach2 k | k <- [2..n]]

-- Comprobación de la conjetura de Goldbach

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

-- La propiedad es

prop_Goldbach :: Int -> Property

prop_Goldbach x =

x >= 2 ==> indiceGoldbach2 x < 4

-- La comprobación es

-- λ> quickCheck prop_Goldbach

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

«La diferencia entre los matemáticos y los físicos es que después de que los físicos prueban un gran resultado piensan que es fantástico, pero después de que los matemáticos prueban un gran resultado piensan que es trivial.»

Lucien Szpiro.

La conjetura de Levy

PorJosé A. Alonso 31-marzo-20208-abril-2020

Hyman Levy observó que

    7 = 3 + 2 x 2
    9 = 3 + 2 x 3 =  5 + 2 x 2
   11 = 5 + 2 x 3 =  7 + 2 x 2
   13 = 3 + 2 x 5 =  7 + 2 x 3
   15 = 3 + 2 x 5 = 11 + 2 x 2
   17 = 3 + 2 x 7 =  7 + 2 x 5 = 11 + 2 x 3 = 13 + 2 x 2
   19 = 5 + 2 x 7 = 13 + 2 x 3

7 = 3 + 2 x 2

9 = 3 + 2 x 3 = 5 + 2 x 2

11 = 5 + 2 x 3 = 7 + 2 x 2

13 = 3 + 2 x 5 = 7 + 2 x 3

15 = 3 + 2 x 5 = 11 + 2 x 2

17 = 3 + 2 x 7 = 7 + 2 x 5 = 11 + 2 x 3 = 13 + 2 x 2

19 = 5 + 2 x 7 = 13 + 2 x 3

y conjeturó que todos los número impares mayores o iguales que 7 se pueden escribir como la suma de un primo y el doble de un primo. El objetivo de los siguientes ejercicios es comprobar la conjetura de Levy.

Definir las siguientes funciones

   descomposicionesLevy :: Integer -> [(Integer,Integer)]
   graficaLevy          :: Integer -> IO ()

1 2	descomposicionesLevy :: Integer -> [(Integer,Integer)] graficaLevy :: Integer -> IO ()

tales que

(descomposicionesLevy x) es la lista de pares de primos (p,q) tales que x = p + 2q. Por ejemplo,

     descomposicionesLevy  7  ==  [(3,2)]
     descomposicionesLevy  9  ==  [(3,3),(5,2)]
     descomposicionesLevy 17  ==  [(3,7),(7,5),(11,3),(13,2)]

descomposicionesLevy 7 == [(3,2)]

descomposicionesLevy 9 == [(3,3),(5,2)]

descomposicionesLevy 17 == [(3,7),(7,5),(11,3),(13,2)]

(graficaLevy n) dibuja los puntos (x,y) tales que x pertenece a [7,9..7+2x(n-1)] e y es el número de descomposiciones de Levy de x. Por ejemplo, (graficaLevy 200) dibuja

Comprobar con QuickCheck la conjetura de Levy.

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck
import Graphics.Gnuplot.Simple

descomposicionesLevy :: Integer -> [(Integer,Integer)]
descomposicionesLevy x =
  [(p,q) | p <- takeWhile (< x) (tail primes)
         , let q = (x - p) `div` 2
         , isPrime q]

graficaLevy :: Integer -> IO ()
graficaLevy n =
  plotList [ Key Nothing
           , XRange (7,fromIntegral (7+2*(n-1)))
           , PNG ("La_conjetura_de_Levy-" ++ show n ++ ".png")
           ]
           [(x, length (descomposicionesLevy x)) | x <- [7,9..7+2*(n-1)]] 

-- La propiedad es
prop_Levy :: Integer -> Bool
prop_Levy x =
  not (null (descomposicionesLevy (7 + 2 * abs x)))

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

import Data.Numbers.Primes

import Test.QuickCheck

import Graphics.Gnuplot.Simple

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

descomposicionesLevy x =

[(p,q) | p <- takeWhile (< x) (tail primes)

, let q = (x - p) `div` 2

, isPrime q]

graficaLevy :: Integer -> IO ()

graficaLevy n =

plotList [ Key Nothing

, XRange (7,fromIntegral (7+2*(n-1)))

, PNG ("La_conjetura_de_Levy-" ++ show n ++ ".png")

]

[(x, length (descomposicionesLevy x)) | x <- [7,9..7+2*(n-1)]]

-- La propiedad es

prop_Levy :: Integer -> Bool

prop_Levy x =

not (null (descomposicionesLevy (7 + 2 * abs x)))

-- La comprobación es

-- λ> quickCheck prop_Levy

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

«Dios creó el número natural, y todo el resto es obra del hombre.»

Leopold Kronecker

La conjetura de Gilbreath

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

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

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

2, 3, 5, 7, 11

1, 2, 2, 4

1, 0, 2

1, 2

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

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

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

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

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

1, 0, 2, 2, 2, 2

1, 2, 0, 0, 0

1, 2, 0, 0

1, 2, 0

1, 2

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

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

El objetivo de este ejercicio es comprobar experimentalmente dicha conjetura.

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

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

3, 1

5, 2, 1

7, 2, 0, 1

11, 4, 2, 2, 1

13, 2, 2, 0, 2, 1

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

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

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

Definir las siguientes funciones

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

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

triangulo :: [[Integer]]

conjeturaGilbreath :: Int -> Bool

tales que

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

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

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

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

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

λ> take 10 triangulo

[[ 2],

[ 3,1],

[ 5,2,1],

[ 7,2,0,1],

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

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

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

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

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

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

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

     λ> conjeturaGilbreath 1000
     True

1 2	λ> conjeturaGilbreath 1000 True

Soluciones

import Data.Numbers.Primes

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

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

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

import Data.Numbers.Primes

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

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

triangulo :: [[Integer]]

triangulo =

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

conjeturaGilbreath :: Int -> Bool

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

where p xs = last xs == 1

Otras soluciones

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

Pensamiento

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

Leonardo da Vinci.

Números como sumas de primos consecutivos

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

En el artículo Integers as a sum of consecutive primes in 2,3,4,.. ways se presentan números que se pueden escribir como sumas de primos consecutivos de varias formas. Por ejemplo, el 41 se puede escribir de dos formas distintas

   41 =  2 +  3 +  5 + 7 + 11 + 13
   41 = 11 + 13 + 17

1 2	41 = 2 + 3 + 5 + 7 + 11 + 13 41 = 11 + 13 + 17

el 240 se puede escribir de tres formas

   240 =  17 +  19 + 23 + 29 + 31 + 37 + 41 + 43
   240 =  53 +  59 + 61 + 67
   240 = 113 + 127

240 = 17 + 19 + 23 + 29 + 31 + 37 + 41 + 43

240 = 53 + 59 + 61 + 67

240 = 113 + 127

y el 311 se puede escribir de 4 formas

   311 =  11 +  13 +  17 + 19 + 23 + 29 + 31 + 37 + 41 + 43 + 47
   311 =  31 +  37 +  41 + 43 + 47 + 53 + 59
   311 =  53 +  59 +  61 + 67 + 71
   311 = 101 + 103 + 107

311 = 11 + 13 + 17 + 19 + 23 + 29 + 31 + 37 + 41 + 43 + 47

311 = 31 + 37 + 41 + 43 + 47 + 53 + 59

311 = 53 + 59 + 61 + 67 + 71

311 = 101 + 103 + 107

Definir la función

   sumas :: Integer -> [[Integer]]

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

tal que (sumas x) es la lista de las formas de escribir x como suma de dos o más números primos consecutivos. Por ejemplo,

   ghci> sumas 41
   [[2,3,5,7,11,13],[11,13,17]]
   ghci> sumas 240
   [[17,19,23,29,31,37,41,43],[53,59,61,67],[113,127]]
   ghci> sumas 311
   [[11,13,17,19,23,29,31,37,41,43,47],[31,37,41,43,47,53,59],
    [53,59,61,67,71],[101,103,107]]
   ghci> maximum [length (sumas n) | n <- [1..600]]
   4

ghci> sumas 41

[[2,3,5,7,11,13],[11,13,17]]

ghci> sumas 240

[[17,19,23,29,31,37,41,43],[53,59,61,67],[113,127]]

ghci> sumas 311

[[11,13,17,19,23,29,31,37,41,43,47],[31,37,41,43,47,53,59],

[53,59,61,67,71],[101,103,107]]

ghci> maximum [length (sumas n) | n <- [1..600]]

Soluciones

import Data.Numbers.Primes (primes)

sumas :: Integer -> [[Integer]]
sumas x = [ys | n <- takeWhile (< x) primes, 
                let ys = sumaDesde x n,
                not (null ys)]

-- (sumaDesde x n) es la lista de al menos dos números primos
-- consecutivos a partir del número primo n cuya suma es x, si existen y
-- la lista vacía en caso contrario. Por ejemplo,
--    sumaDesde 15 3  ==  [3,5,7]
--    sumaDesde  7 3  ==  []
sumaDesde :: Integer -> Integer -> [Integer]
sumaDesde x n | x == y    = take (1 + length us) ys
              | otherwise = []
    where ys       = dropWhile (<n) primes
          (us,y:_) = span (<x) (scanl1 (+) ys)

import Data.Numbers.Primes (primes)

sumas :: Integer -> [[Integer]]

sumas x = [ys | n <- takeWhile (< x) primes,

let ys = sumaDesde x n,

not (null ys)]

-- (sumaDesde x n) es la lista de al menos dos números primos

-- consecutivos a partir del número primo n cuya suma es x, si existen y

-- la lista vacía en caso contrario. Por ejemplo,

-- sumaDesde 15 3 == [3,5,7]

-- sumaDesde 7 3 == []

sumaDesde :: Integer -> Integer -> [Integer]

sumaDesde x n | x == y = take (1 + length us) ys

| otherwise = []

where ys = dropWhile (<n) primes

(us,y:_) = span (<x) (scanl1 (+) ys)

Otras soluciones

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

Pensamiento

«El desarrollo de las matemáticas hacia una mayor precisión ha llevado, como es bien sabido, a la formalización de grandes partes de las mismas, de modo que se puede probar cualquier teorema usando nada más que unas pocas reglas mecánicas.»

Kurt Gödel.

Búsqueda de la mina

PorJosé A. Alonso 24-marzo-202031-marzo-2020

En este ejercicio, se representa un mapa mediante una lista de listas de la misma longitud donde todos sus elementos son 0 menos uno (que es un 1) que es donde se encuentra la mina. Por ejemplo, en el mapa

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

0 0 0 0

0 1 0 0

la posición de la mina es (2,1).

Definir la función

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

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

tal que (posicionMina m) es la posición de la mina en el mapa m, Por ejemplo,

   posicionMina [[0,0,0,0],[0,0,0,0],[0,1,0,0]]  ==  (2,1)

1	posicionMina [[0,0,0,0],[0,0,0,0],[0,1,0,0]] == (2,1)

Soluciones

import Data.List (elemIndex)
import Data.Array (assocs, listArray)

-- 1ª solución
posicionMina :: [[Int]] -> (Int,Int)
posicionMina xss = (length yss, length ys)
  where (yss,xs:_) = break (1 `elem`) xss
        ys         = takeWhile (/= 1) xs

-- 2ª solución
posicionMina2 :: [[Int]] -> (Int,Int)
posicionMina2 xss = divMod p (length (head xss))
  where Just p = elemIndex 1 (concat xss)
  
-- 3ª solución
posicionMina3 :: [[Int]] -> (Int,Int)
posicionMina3 xss =
  (fst . head . filter ((1 ==) . snd) . assocs) a
  where m = length xss - 1
        n = length (head xss) - 1
        a = listArray ((0,0),(m,n)) (concat xss)

import Data.List (elemIndex)

import Data.Array (assocs, listArray)

-- 1ª solución

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

posicionMina xss = (length yss, length ys)

where (yss,xs:_) = break (1 `elem`) xss

ys = takeWhile (/= 1) xs

-- 2ª solución

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

posicionMina2 xss = divMod p (length (head xss))

where Just p = elemIndex 1 (concat xss)

-- 3ª solución

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

posicionMina3 xss =

(fst . head . filter ((1 ==) . snd) . assocs) a

where m = length xss - 1

n = length (head xss) - 1

a = listArray ((0,0),(m,n)) (concat xss)

Otras soluciones

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

Pensamiento

«La vida de un matemático está dominada por una insaciable curiosidad, un deseo que raya en la pasión por resolver los problemas que estudia.»

Jean Dieudonné.

Primos magnánimos

PorJosé A. Alonso 20-marzo-202027-marzo-2020

Un número magnánimo es un número tal que las sumas obtenidas insertando un «+» entre sus dígitos en cualquier posición son números primos. Por ejemplo, 4001 es un número magnánimo porque los números 4+001=5, 40+01=41 y 400+1=401 son primos.

Definir las funciones

   esMagnanimo :: Integer -> Bool
   primosMagnanimos :: [Integer]

1 2	esMagnanimo :: Integer -> Bool primosMagnanimos :: [Integer]

tales que

(esMagnanimo n) se verifica si n es un número magnánimo. Por ejemplo,

     esMagnanimo 4001  ==  True
     esMagnanimo 2019  ==  False

1 2	esMagnanimo 4001 == True esMagnanimo 2019 == False

primosMagnanimos es la lista de los números primos magnánimos. Por ejemplo,

     λ> take 20 primosMagnanimos
     [2,3,5,7,11,23,29,41,43,47,61,67,83,89,101,227,229,281,401,443]

1 2	λ> take 20 primosMagnanimos [2,3,5,7,11,23,29,41,43,47,61,67,83,89,101,227,229,281,401,443]

Soluciones

import Data.Numbers.Primes (isPrime, primes)

esMagnanimo :: Integer -> Bool
esMagnanimo n =
  all isPrime [x + y | (x, y) <- divisionesNumero n]

-- (divisionesNumero n) es la lista de las divisiones de n en dos
-- números. Por ejemplo,
--    divisionesNumero 1234  ==  [(1,234),(12,34),(123,4)]
--    divisionesNumero 234   ==  [(2,34),(23,4)]
--    divisionesNumero 34    ==  [(3,4)]
--    divisionesNumero 4     ==  []
divisionesNumero :: Integer -> [(Integer,Integer)]
divisionesNumero n =
  [(read xs, read ys) | (xs,ys) <- divisiones (show n)]

-- (divisiones xs) es la lista de las divisiones de xs en dos listas no
-- vacías. Por ejemplo,
--    divisiones "abcd"  ==  [("a","bcd"),("ab","cd"),("abc","d")]
--    divisiones "bcd"   ==  [("b","cd"),("bc","d")]
--    divisiones "cd"    ==  [("c","d")]
--    divisiones "d"     ==  []
--    divisiones ""      ==  []
divisiones :: [a] -> [([a],[a])]
divisiones []     = []
divisiones [_]    = []
divisiones (x:xs) = ([x],xs) : [(x:is,ds) | (is,ds) <- divisiones xs]

primosMagnanimos :: [Integer]
primosMagnanimos = filter esMagnanimo primes

import Data.Numbers.Primes (isPrime, primes)

esMagnanimo :: Integer -> Bool

esMagnanimo n =

all isPrime [x + y | (x, y) <- divisionesNumero n]

-- (divisionesNumero n) es la lista de las divisiones de n en dos

-- números. Por ejemplo,

-- divisionesNumero 1234 == [(1,234),(12,34),(123,4)]

-- divisionesNumero 234 == [(2,34),(23,4)]

-- divisionesNumero 34 == [(3,4)]

-- divisionesNumero 4 == []

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

divisionesNumero n =

[(read xs, read ys) | (xs,ys) <- divisiones (show n)]

-- (divisiones xs) es la lista de las divisiones de xs en dos listas no

-- vacías. Por ejemplo,

-- divisiones "abcd" == [("a","bcd"),("ab","cd"),("abc","d")]

-- divisiones "bcd" == [("b","cd"),("bc","d")]

-- divisiones "cd" == [("c","d")]

-- divisiones "d" == []

-- divisiones "" == []

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

divisiones [] = []

divisiones [_] = []

divisiones (x:xs) = ([x],xs) : [(x:is,ds) | (is,ds) <- divisiones xs]

primosMagnanimos :: [Integer]

primosMagnanimos = filter esMagnanimo primes

Otras soluciones

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

Pensamiento

«Existe una distinción entre lo que se puede llamar un problema y lo que puede considerar un ejercicio. Este último sirve para entrenar al en alguna técnica o procedimiento, y requiere poco o ningún original. A diferencia de un ejercicio, un problema, si es apropiado para nivel, debe requerir pensamiento por parte del estudiante. Es imposible exagerar la importancia de los problemas en las matemáticas. Es por medio de los problemas que las matemáticas se desarrollan y se levantan por sí mismas. Cada nuevo descubrimiento en matemáticas es el resultado de un intento de resolver algún problema.»

Howard Eves.

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

PorJosé A. Alonso 18-marzo-202025-marzo-2020

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

y en el desarrollo del arco seno

de donde se obtiene la fórmula

La primeras aproximaciones son

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

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

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

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

Definir las funciones

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

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

tales que

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

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

aproximacionPi 0 == 3.0

aproximacionPi 1 == 3.125

aproximacionPi 2 == 3.1390625

aproximacionPi 10 == 3.1415926468755613

aproximacionPi 21 == 3.141592653589793

pi == 3.141592653589793

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

Soluciones

import Graphics.Gnuplot.Simple

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

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

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

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

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

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

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

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

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

import Graphics.Gnuplot.Simple

-- 1ª definición

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

aproximacionPi :: Int -> Double

aproximacionPi n = 6 * arcsinX

where arcsinX = 0.5 + sum (take n factoresN)

factoresN :: [Double]

factoresN = zipWith (*) (potenciasK 3) fraccionesPI

potenciasK :: Double -> [Double]

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

fraccionesPI :: [Double]

fraccionesPI =

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

-- 2ª definición

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

aproximacionPi2 :: Int -> Double

aproximacionPi2 n = 6 * (serie !! n)

serie :: [Double]

serie = scanl1 (+) (zipWith (/)

(map fromIntegral numeradores)

(map fromIntegral denominadores))

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

denominadores = zipWith (*) denominadores1 denominadores2

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

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

grafica :: [Int] -> IO ()

grafica xs =

plotList [Key Nothing]

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

Otras soluciones

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

Pensamiento

«Mi trabajo siempre trató de unir lo verdadero con lo bello; pero cuando tuve que elegir uno u otro, generalmente elegí lo bello.»

Hermann Weyl.

Repeticiones consecutivas

PorJosé A. Alonso 17-marzo-202024-marzo-2020

Se dice que una palabra tiene una repetición en una frase si es igual a una, o más, de las palabras consecutivas sin distinguir mayúsculas de minúsculas.

Definir la función

   nRepeticionesConsecutivas :: String ->Int

1	nRepeticionesConsecutivas :: String ->Int

tal que (nRepeticionesConsecutivas cs) es el número de repeticiones de palabras consecutivas de la cadena cs. Por ejemplo,

   nRepeticionesConsecutivas "oso rana"                    == 0      
   nRepeticionesConsecutivas "oso rana oso"                == 0
   nRepeticionesConsecutivas "oso oSo rana"                == 1
   nRepeticionesConsecutivas "oso oso oso rana"            == 1
   nRepeticionesConsecutivas "coronavirus virus oso rana"  == 0
   nRepeticionesConsecutivas "virus     virus oso rana"    == 1
   nRepeticionesConsecutivas "virus oso virus oso rana"    == 0
   nRepeticionesConsecutivas "oso oso oso oso oso oso"     == 1
   nRepeticionesConsecutivas "oso oso oso oso rana rana"   == 2
   nRepeticionesConsecutivas "rana rana oso oso rana rana" == 3

nRepeticionesConsecutivas "oso rana" == 0

nRepeticionesConsecutivas "oso rana oso" == 0

nRepeticionesConsecutivas "oso oSo rana" == 1

nRepeticionesConsecutivas "oso oso oso rana" == 1

nRepeticionesConsecutivas "coronavirus virus oso rana" == 0

nRepeticionesConsecutivas "virus virus oso rana" == 1

nRepeticionesConsecutivas "virus oso virus oso rana" == 0

nRepeticionesConsecutivas "oso oso oso oso oso oso" == 1

nRepeticionesConsecutivas "oso oso oso oso rana rana" == 2

nRepeticionesConsecutivas "rana rana oso oso rana rana" == 3

Soluciones

import Data.List (group)
import Data.Char (toUpper)

-- 1ª solución
nRepeticionesConsecutivas :: String ->Int
nRepeticionesConsecutivas = aux . words . map toUpper 
  where aux (x:y:zs) | x == y    = 1 + aux (dropWhile (== x) zs)
                     | otherwise = aux (y:zs)
        aux _ = 0

-- 2ª solución
nRepeticionesConsecutivas2 :: String ->Int
nRepeticionesConsecutivas2 cs =
  length [xs | xs <- group (words (map toUpper cs)), length xs > 1]

-- 3ª solución
nRepeticionesConsecutivas3 :: String ->Int
nRepeticionesConsecutivas3 =
  length . filter ((>1) . length) . group . words . map toUpper

import Data.List (group)

import Data.Char (toUpper)

-- 1ª solución

nRepeticionesConsecutivas :: String ->Int

nRepeticionesConsecutivas = aux . words . map toUpper

where aux (x:y:zs) | x == y = 1 + aux (dropWhile (== x) zs)

| otherwise = aux (y:zs)

aux _ = 0

-- 2ª solución

nRepeticionesConsecutivas2 :: String ->Int

nRepeticionesConsecutivas2 cs =

length [xs | xs <- group (words (map toUpper cs)), length xs > 1]

-- 3ª solución

nRepeticionesConsecutivas3 :: String ->Int

nRepeticionesConsecutivas3 =

length . filter ((>1) . length) . group . words . map toUpper

Otras soluciones

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

Pensamiento

«En el campo de la computación, el momento de la verdad es la ejecución de un programa; todo lo demás es profecía.»

Herbert A. Simon.

Medias de dígitos de pi

PorJosé A. Alonso 16-marzo-202023-marzo-2020

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)

Otras soluciones

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

Pensamiento

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

Cálculo de pi mediante la serie de Nilakantha

PorJosé A. Alonso 12-marzo-202025-marzo-2022

Una serie infinita para el cálculo de pi, publicada por Nilakantha en el siglo XV, es

Definir las funciones

   aproximacionPi :: Int -> Double
   tabla          :: FilePath -> [Int] -> IO ()

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

tales que

(aproximacionPi n) es la n-ésima aproximación de pi obtenido sumando los n primeros términos de la serie de Nilakantha. Por ejemplo,

     aproximacionPi 0        ==  3.0
     aproximacionPi 1        ==  3.1666666666666665
     aproximacionPi 2        ==  3.1333333333333333
     aproximacionPi 3        ==  3.145238095238095
     aproximacionPi 4        ==  3.1396825396825396
     aproximacionPi 5        ==  3.1427128427128426
     aproximacionPi 10       ==  3.1414067184965018
     aproximacionPi 100      ==  3.1415924109719824
     aproximacionPi 1000     ==  3.141592653340544
     aproximacionPi 10000    ==  3.141592653589538
     aproximacionPi 100000   ==  3.1415926535897865
     aproximacionPi 1000000  ==  3.141592653589787
     pi                      ==  3.141592653589793

aproximacionPi 0 == 3.0

aproximacionPi 1 == 3.1666666666666665

aproximacionPi 2 == 3.1333333333333333

aproximacionPi 3 == 3.145238095238095

aproximacionPi 4 == 3.1396825396825396

aproximacionPi 5 == 3.1427128427128426

aproximacionPi 10 == 3.1414067184965018

aproximacionPi 100 == 3.1415924109719824

aproximacionPi 1000 == 3.141592653340544

aproximacionPi 10000 == 3.141592653589538

aproximacionPi 100000 == 3.1415926535897865

aproximacionPi 1000000 == 3.141592653589787

pi == 3.141592653589793

(tabla f ns) escribe en el fichero f las n-ésimas aproximaciones de pi, donde n toma los valores de la lista ns, junto con sus errores. Por ejemplo, al evaluar la expresión

     tabla "AproximacionesPi.txt" [0,10..100]

1	tabla "AproximacionesPi.txt" [0,10..100]

hace que el contenido del fichero «AproximacionesPi.txt» sea

+------+----------------+----------------+
| n    | Aproximación   | Error          |
+------+----------------+----------------+
|    0 | 3.000000000000 | 0.141592653590 |
|   10 | 3.141406718497 | 0.000185935093 |
|   20 | 3.141565734659 | 0.000026918931 |
|   30 | 3.141584272675 | 0.000008380915 |
|   40 | 3.141589028941 | 0.000003624649 |
|   50 | 3.141590769850 | 0.000001883740 |
|   60 | 3.141591552546 | 0.000001101044 |
|   70 | 3.141591955265 | 0.000000698325 |
|   80 | 3.141592183260 | 0.000000470330 |
|   90 | 3.141592321886 | 0.000000331704 |
|  100 | 3.141592410972 | 0.000000242618 |
+------+----------------+----------------+

+------+----------------+----------------+

| n | Aproximación | Error |

+------+----------------+----------------+

| 0 | 3.000000000000 | 0.141592653590 |

| 10 | 3.141406718497 | 0.000185935093 |

| 20 | 3.141565734659 | 0.000026918931 |

| 30 | 3.141584272675 | 0.000008380915 |

| 40 | 3.141589028941 | 0.000003624649 |

| 50 | 3.141590769850 | 0.000001883740 |

| 60 | 3.141591552546 | 0.000001101044 |

| 70 | 3.141591955265 | 0.000000698325 |

| 80 | 3.141592183260 | 0.000000470330 |

| 90 | 3.141592321886 | 0.000000331704 |

| 100 | 3.141592410972 | 0.000000242618 |

+------+----------------+----------------+

al evaluar la expresión

     tabla "AproximacionesPi.txt" [0,500..5000]

1	tabla "AproximacionesPi.txt" [0,500..5000]

hace que el contenido del fichero «AproximacionesPi.txt» sea

+------+----------------+----------------+
| n    | Aproximación   | Error          |
+------+----------------+----------------+
|    0 | 3.000000000000 | 0.141592653590 |
|  500 | 3.141592651602 | 0.000000001988 |
| 1000 | 3.141592653341 | 0.000000000249 |
| 1500 | 3.141592653516 | 0.000000000074 |
| 2000 | 3.141592653559 | 0.000000000031 |
| 2500 | 3.141592653574 | 0.000000000016 |
| 3000 | 3.141592653581 | 0.000000000009 |
| 3500 | 3.141592653584 | 0.000000000006 |
| 4000 | 3.141592653586 | 0.000000000004 |
| 4500 | 3.141592653587 | 0.000000000003 |
| 5000 | 3.141592653588 | 0.000000000002 |
+------+----------------+----------------+

+------+----------------+----------------+

| n | Aproximación | Error |

+------+----------------+----------------+

| 0 | 3.000000000000 | 0.141592653590 |

| 500 | 3.141592651602 | 0.000000001988 |

| 1000 | 3.141592653341 | 0.000000000249 |

| 1500 | 3.141592653516 | 0.000000000074 |

| 2000 | 3.141592653559 | 0.000000000031 |

| 2500 | 3.141592653574 | 0.000000000016 |

| 3000 | 3.141592653581 | 0.000000000009 |

| 3500 | 3.141592653584 | 0.000000000006 |

| 4000 | 3.141592653586 | 0.000000000004 |

| 4500 | 3.141592653587 | 0.000000000003 |

| 5000 | 3.141592653588 | 0.000000000002 |

+------+----------------+----------------+

Soluciones

import Text.Printf

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

aproximacionPi :: Int -> Double
aproximacionPi n = serieNilakantha !! n

serieNilakantha :: [Double]
serieNilakantha = scanl1 (+) terminosNilakantha

terminosNilakantha :: [Double]
terminosNilakantha = zipWith (/) numeradores denominadores
  where numeradores   = 3 : cycle [4,-4]
        denominadores = 1 : [n*(n+1)*(n+2) | n <- [2,4..]]

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

aproximacionPi2 :: Int -> Double
aproximacionPi2 = aux 3 2 1
  where aux x _ _ 0 = x
        aux x y z m =
          aux (x+4/product[y..y+2]*z) (y+2) (negate z) (m-1)

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

--    λ> aproximacionPi (2*10^5)
--    3.141592653589787
--    (0.82 secs, 145,964,728 bytes)
--    λ> aproximacionPi2 (2*10^5)
--    3.141592653589787
--    (2.27 secs, 432,463,496 bytes)
--    λ> aproximacionPi (3*10^5)
--    3.141592653589787
--    (0.34 secs, 73,056,488 bytes)
--    λ> aproximacionPi2 (3*10^5)
--    3.141592653589787
--    (3.24 secs, 648,603,824 bytes)

-- Definicioń de tabla
-- ===================

tabla :: FilePath -> [Int] -> IO ()
tabla f ns = do
  writeFile f (tablaAux ns)

tablaAux :: [Int] -> String
tablaAux ns =
     linea
  ++ cabecera
  ++ linea
  ++ concat [printf "| %4d | %.12f | %.12f |\n" n a e
            | n <- ns
            , let a = aproximacionPi n
            , let e = abs (pi - a)]
  ++ linea

linea :: String
linea = "+------+----------------+----------------+\n"

cabecera :: String
cabecera = "| n    | Aproximación   | Error          |\n"

import Text.Printf

-- 1ª solución

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

aproximacionPi :: Int -> Double

aproximacionPi n = serieNilakantha !! n

serieNilakantha :: [Double]

serieNilakantha = scanl1 (+) terminosNilakantha

terminosNilakantha :: [Double]

terminosNilakantha = zipWith (/) numeradores denominadores

where numeradores = 3 : cycle [4,-4]

denominadores = 1 : [n*(n+1)*(n+2) | n <- [2,4..]]

-- 2ª solución

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

aproximacionPi2 :: Int -> Double

aproximacionPi2 = aux 3 2 1

where aux x _ _ 0 = x

aux x y z m =

aux (x+4/product[y..y+2]*z) (y+2) (negate z) (m-1)

-- Comparación de eficiencia

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

-- λ> aproximacionPi (2*10^5)

-- 3.141592653589787

-- (0.82 secs, 145,964,728 bytes)

-- λ> aproximacionPi2 (2*10^5)

-- 3.141592653589787

-- (2.27 secs, 432,463,496 bytes)

-- λ> aproximacionPi (3*10^5)

-- 3.141592653589787

-- (0.34 secs, 73,056,488 bytes)

-- λ> aproximacionPi2 (3*10^5)

-- 3.141592653589787

-- (3.24 secs, 648,603,824 bytes)

-- Definicioń de tabla

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

tabla :: FilePath -> [Int] -> IO ()

tabla f ns = do

writeFile f (tablaAux ns)

tablaAux :: [Int] -> String

tablaAux ns =

linea

++ cabecera

++ linea

++ concat [printf "| %4d | %.12f | %.12f |\n" n a e

| n <- ns

, let a = aproximacionPi n

, let e = abs (pi - a)]

++ linea

linea :: String

linea = "+------+----------------+----------------+\n"

cabecera :: String

cabecera = "| n | Aproximación | Error |\n"

División de cadenas

PorJosé A. Alonso 11-marzo-202018-marzo-2020

Definir la función

   division :: String -> [String]

1	division :: String -> [String]

tal que (division cs) es la lista de las palabras formadas por dos elementos consecutivos de cs y, en el caso de que la longitud de cs sea impar, el último elemento de la última palabra es el carácter de subrayado. Por ejemplo,

   division "pandemia"    ==  ["pa","nd","em","ia"]
   division "covid2019"   ==  ["co","vi","d2","01","9_"]
   division "covid 2019"  ==  ["co","vi","d ","20","19"]

division "pandemia" == ["pa","nd","em","ia"]

division "covid2019" == ["co","vi","d2","01","9_"]

division "covid 2019" == ["co","vi","d ","20","19"]

Soluciones

import Data.List.Split

-- 1ª solución
division :: String -> [String]
division []       = []
division [x]      = [[x,'_']]
division (x:y:zs) = [x,y] : division zs

-- 2ª solución
division2 :: String -> [String]
division2 cs =
  [[ds!!i,ds!!(i+1)] | i <- [0,2.. length cs - 1]]
  where ds = cs ++ "_"

-- 3ª solución
division3 :: String -> [String]
division3 = takeWhile ((2 ==) . length) . chunksOf 2 . (++ "_")

-- 4ª solución
division4 :: String -> [String]
division4 = init . chunksOf 2 . (++ "_")

import Data.List.Split

-- 1ª solución

division :: String -> [String]

division [] = []

division [x] = [[x,'_']]

division (x:y:zs) = [x,y] : division zs

-- 2ª solución

division2 :: String -> [String]

division2 cs =

[[ds!!i,ds!!(i+1)] | i <- [0,2.. length cs - 1]]

where ds = cs ++ "_"

-- 3ª solución

division3 :: String -> [String]

division3 = takeWhile ((2 ==) . length) . chunksOf 2 . (++ "_")

-- 4ª solución

division4 :: String -> [String]

division4 = init . chunksOf 2 . (++ "_")

Otras soluciones

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

Pensamiento

«Las matemáticas tienen un triple objetivo. Debe proporcionar un instrumento para el estudio de la naturaleza. Pero esto no es todo: tiene un objetivo filosófico y, me atrevo a decir, un objetivo estético.»

Henri Poincaré.

Producto de Fibonaccis consecutivos

PorJosé A. Alonso 6-marzo-202017-marzo-2020

Los números de Fibonacci son los números F(n) de la siguiente sucesión

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

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

que comienza con 0 y 1 y los siguientes términos son las sumas de los dos anteriores.

Un número x es el producto de dos números de Fibonacci consecutivos si existe un n tal que

   F(n) * F(n+1) = x

1	F(n) * F(n+1) = x

y su prueba es (F(n),F(n+1),True). Por ejemplo, 714 es el producto de dos números de Fibonacci consecutivos ya que

F(8) = 21, F(9) = 34 y 714 = 21 * 34.

1	F(8) = 21, F(9) = 34 y 714 = 21 * 34.

Su prueba es (21, 34, True).

Un número x no es el producto de dos números de Fibonacci consecutivos si no existe un n tal que

   F(n) * F(n+1) = x

1	F(n) * F(n+1) = x

y su prueba es (F(m),F(m+1),False) donde m es el menor número tal que

   F(m) * F(m+1) > x

1	F(m) * F(m+1) > x

Por ejemplo, 800 no es el producto de dos números de Fibonacci consecutivos, ya que

 F(8) = 21, F(9) = 34, F(10) = 55 y 21 * 34 < 800 < 34 * 55.

1	F(8) = 21, F(9) = 34, F(10) = 55 y 21 * 34 < 800 < 34 * 55.

Su prueba es (34, 55, False),

Definir la función

   productoFib :: Integer -> (Integer, Integer, Bool)

1	productoFib :: Integer -> (Integer, Integer, Bool)

tal que (productoFib x) es la prueba de que es, o no es, el producto de dos números de Fibonacci consecutivos. Por ejemplo,

   productoFib 714  == (21,  34, True)
   productoFib 800  == (34,  55, False)
   productoFib 4895 == (55,  89, True)
   productoFib 5895 == (89, 144, False)

productoFib 714 == (21, 34, True)

productoFib 800 == (34, 55, False)

productoFib 4895 == (55, 89, True)

productoFib 5895 == (89, 144, False)

Soluciones

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

productoFib :: Integer -> (Integer, Integer, Bool)
productoFib n
  | c == n    = (a,b,True)
  | otherwise = (a,b,False)
  where (a,b,c) = head (dropWhile (\(x,y,z) -> z < n) productos) 

-- fibs es la sucesión de números de Fibonacci. Por ejemplo,
--    take 14 fibs  ==  [0,1,1,2,3,5,8,13,21,34,55,89,144,233]
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

-- productos es la lista de las ternas (a,b,c) tales que a y b son dos
-- números de Fibonacci consecutivos y c es su producto. Por ejemplo,
--    λ> take 7 productos
--    [(0,1,0),(1,1,1),(1,2,2),(2,3,6),(3,5,15),(5,8,40),(8,13,104)]
productos :: [(Integer,Integer,Integer)]
productos = [(x,y,x*y) | (x,y) <- zip fibs (tail fibs)] 

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

productoFib2 :: Integer -> (Integer, Integer, Bool)
productoFib2 n = aux 0 1 n
  where
    aux a b c
        | a * b >= c = (a, b, a * b == c)
        | otherwise  = aux b (a + b) c
           
-- 3ª solución
-- ===========

productoFib3 :: Integer -> (Integer, Integer, Bool)
productoFib3 x = aux 0 1
  where
    aux a b | a * b >= x = (a, b, x == a * b)
            | otherwise  = aux b (a + b)

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

-- La comparación es
--    λ> let (x,_,_) = productoFib (10^20000) in length (show x)
--    10000
--    (1.15 secs, 323,396,360 bytes)
--    λ> let (x,_,_) = productoFib2 (10^20000) in length (show x)
--    10000
--    (1.10 secs, 317,268,672 bytes)
--    λ> let (x,_,_) = productoFib3 (10^20000) in length (show x)
--    10000
--    (1.08 secs, 314,972,440 bytes)

-- 1ª solución

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

productoFib :: Integer -> (Integer, Integer, Bool)

productoFib n

| c == n = (a,b,True)

| otherwise = (a,b,False)

where (a,b,c) = head (dropWhile (\(x,y,z) -> z < n) productos)

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

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

fibs :: [Integer]

fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

-- productos es la lista de las ternas (a,b,c) tales que a y b son dos

-- números de Fibonacci consecutivos y c es su producto. Por ejemplo,

-- λ> take 7 productos

-- [(0,1,0),(1,1,1),(1,2,2),(2,3,6),(3,5,15),(5,8,40),(8,13,104)]

productos :: [(Integer,Integer,Integer)]

productos = [(x,y,x*y) | (x,y) <- zip fibs (tail fibs)]

-- 2ª solución

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

productoFib2 :: Integer -> (Integer, Integer, Bool)

productoFib2 n = aux 0 1 n

where

aux a b c

| a * b >= c = (a, b, a * b == c)

| otherwise = aux b (a + b) c

-- 3ª solución

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

productoFib3 :: Integer -> (Integer, Integer, Bool)

productoFib3 x = aux 0 1

where

aux a b | a * b >= x = (a, b, x == a * b)

| otherwise = aux b (a + b)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> let (x,_,_) = productoFib (10^20000) in length (show x)

-- 10000

-- (1.15 secs, 323,396,360 bytes)

-- λ> let (x,_,_) = productoFib2 (10^20000) in length (show x)

-- 10000

-- (1.10 secs, 317,268,672 bytes)

-- λ> let (x,_,_) = productoFib3 (10^20000) in length (show x)

-- 10000

-- (1.08 secs, 314,972,440 bytes)

Otras soluciones

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

Pensamiento

«El placer que obtenemos de la música proviene de contar, pero contando inconscientemente. La música no es más que aritmética inconsciente.»

Gottfried Wilhelm Leibniz.

Avistamientos de la pelota

PorJosé A. Alonso 4-marzo-202017-marzo-2020

Un niño está jugando con una pelota en el noveno piso de un edificio alto. La altura de este piso, h, es conocida. Deja caer la pelota por la ventana. La pelota rebota una r-ésima parte de su altura (por ejemplo, dos tercios de su altura). Su madre mira por una ventana a w metros del suelo (por ejemplo, a 1.5 metros). ¿Cuántas veces verá la madre a la pelota pasar frente a su ventana incluyendo cuando está cayendo y rebotando?

Se deben cumplir tres condiciones para que el experimento sea válido:

La altura «h» debe ser mayor que 0
El rebote «r» debe ser mayor que 0 y menor que 1
La altura de la ventana debe ser mayor que 0 y menor que h.

Definir la función

   numeroAvistamientos :: Double -> Double -> Double -> Integer

1	numeroAvistamientos :: Double -> Double -> Double -> Integer

tal que (numeroAvistamientos h r v) es el número de avistamientos de la pelota si se cumplen las tres condiciones anteriores y es -1 en caso contrario. Por ejemplo,

   numeroAvistamientos 3    0.66 1.5  ==  3
   numeroAvistamientos 30   0.66 1.5  ==  15
   numeroAvistamientos (-3) 0.66 1.5  ==  -1
   numeroAvistamientos 3    (-1) 1.5  ==  -1
   numeroAvistamientos 3    2    1.5  ==  -1
   numeroAvistamientos 3    0.5  (-1) ==  -1
   numeroAvistamientos 3    0.5  4    ==  -1

numeroAvistamientos 3 0.66 1.5 == 3

numeroAvistamientos 30 0.66 1.5 == 15

numeroAvistamientos (-3) 0.66 1.5 == -1

numeroAvistamientos 3 (-1) 1.5 == -1

numeroAvistamientos 3 2 1.5 == -1

numeroAvistamientos 3 0.5 (-1) == -1

numeroAvistamientos 3 0.5 4 == -1

Soluciones

import Data.List (genericLength)

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

numeroAvistamientos :: Double -> Double -> Double -> Integer
numeroAvistamientos h r v
  | adecuados h r v = 2 * n - 1 
  | otherwise      = -1
  where n = genericLength (takeWhile (>=v) (iterate (*r) h))

-- (adecuados h r v) se verifica si los datos cumplen las condiciones
-- para que el experimento sea válido.
adecuados :: Double -> Double -> Double -> Bool
adecuados h r v =
  h > 0 && 0 < r && r < 1 && 0 < v && v < h

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

numeroAvistamientos2 :: Double -> Double -> Double -> Integer
numeroAvistamientos2 h r v 
  | adecuados h r v = 2 + numeroAvistamientos2 (h * r) r v
  | otherwise       = -1

-- 3ª solución
numeroAvistamientos3 :: Double -> Double -> Double -> Integer
numeroAvistamientos3 h r v
  | adecuados h r v = 1 + 2 * floor (logBase r (v / h))
  | otherwise       = -1

import Data.List (genericLength)

-- 1ª solución

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

numeroAvistamientos :: Double -> Double -> Double -> Integer

numeroAvistamientos h r v

| adecuados h r v = 2 * n - 1

| otherwise = -1

where n = genericLength (takeWhile (>=v) (iterate (*r) h))

-- (adecuados h r v) se verifica si los datos cumplen las condiciones

-- para que el experimento sea válido.

adecuados :: Double -> Double -> Double -> Bool

adecuados h r v =

h > 0 && 0 < r && r < 1 && 0 < v && v < h

-- 2ª solución

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

numeroAvistamientos2 :: Double -> Double -> Double -> Integer

numeroAvistamientos2 h r v

| adecuados h r v = 2 + numeroAvistamientos2 (h * r) r v

| otherwise = -1

-- 3ª solución

numeroAvistamientos3 :: Double -> Double -> Double -> Integer

numeroAvistamientos3 h r v

| adecuados h r v = 1 + 2 * floor (logBase r (v / h))

| otherwise = -1

Otras soluciones

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

Pensamiento

«Los patrones del matemático, como los del pintor o el poeta deben ser hermosos; las ideas, como los colores o las palabras deben encajar de manera armoniosa. La belleza es la primera prueba: no hay lugar permanente en este mundo para las matemáticas feas.»

G. H. Hardy.

Mayor equidigital

PorJosé A. Alonso 3-marzo-202010-marzo-2020

Definir la función

   mayorEquidigital :: Integer -> Integer

1	mayorEquidigital :: Integer -> Integer

tal que (mayorEquidigital n) es el mayor número que se puede formar con los dígitos de n. Por ejemplo,

   mayorEquidigital 325271  ==  753221

1	mayorEquidigital 325271 == 753221

Soluciones

import Data.List (sort)

mayorEquidigital :: Integer -> Integer
mayorEquidigital = read . reverse . sort . show

import Data.List (sort)

mayorEquidigital :: Integer -> Integer

mayorEquidigital = read . reverse . sort . show

Otras soluciones

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

Pensamiento

«Un matemático, como un pintor o un poeta, es un creador de patrones. Si sus patrones son más permanentes que los de ellos, es porque están hechos con ideas.»

G. H. Hardy.

Pandemia

PorJosé A. Alonso 2-marzo-20209-marzo-2020

¡El mundo está en cuarentena! Hay una nueva pandemia que lucha contra la humanidad. Cada continente está aislado de los demás, pero las personas infectadas se han propagado antes de la advertencia.

En este problema se representará el mundo por una cadena como la siguiente

   "01000000X000X011X0X"

1	"01000000X000X011X0X"

donde 0 representa no infectado, 1 representa infectado y X representa un océano

Las reglas de propagación son:

El virus no puede propagarse al otro lado de un océano.
Si una persona se infecta, todas las personas de este continente se infectan también.
El primer y el último continente no están conectados.

El problema consiste en encontrar el porcentaje de la población humana que se infectó al final. Por ejemplo,

   inicio:     "01000000X000X011X0X"
   final:      "11111111X000X111X0X"
   total:      15
   infectados: 11
   porcentaje: 100*11/15 = 73.33333333333333

inicio: "01000000X000X011X0X"

final: "11111111X000X111X0X"

total: 15

infectados: 11

porcentaje: 100*11/15 = 73.33333333333333

Definir la función

   porcentajeInfectados :: String -> Double

1	porcentajeInfectados :: String -> Double

tal que (porcentajeInfectados xs) es el porcentaje final de infectados para el mapa inicial xs. Por ejemplo,

   porcentajeInfectados "01000000X000X011X0X"  == 73.33333333333333
   porcentajeInfectados "01X000X010X011XX"     == 72.72727272727273
   porcentajeInfectados "XXXXX"                == 0.0
   porcentajeInfectados "0000000010"           == 100.0
   porcentajeInfectados "X00X000000X10X0100"   == 42.857142857142854

porcentajeInfectados "01000000X000X011X0X" == 73.33333333333333

porcentajeInfectados "01X000X010X011XX" == 72.72727272727273

porcentajeInfectados "XXXXX" == 0.0

porcentajeInfectados "0000000010" == 100.0

porcentajeInfectados "X00X000000X10X0100" == 42.857142857142854

Soluciones

import Data.List (genericLength)
import Data.List.Split (splitOn)

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

porcentajeInfectados :: String -> Double
porcentajeInfectados xs
  | nh == 0   = 0
  | otherwise = 100 * ni / nh
  where ni = fromIntegral (numeroInfectados xs)
        nh = fromIntegral (numeroHabitantes xs)

-- (continentes xs) es la lista de las poblaciones de los continentes
-- del mapa xs. Por ejemplo,
--    continentes "01000000X000X011X0X" == ["01000000","000","011","0"]
--    continentes "01X000X010X011XX"    == ["01","000","010","011"]
--    continentes "XXXXX"               == [""]
--    continentes "0000000010"          == ["0000000010"]
--    continentes "X00X000000X10X0100"  == ["","00","000000","10","0100"]
continentes :: String -> [String]
continentes [] = []
continentes xs = as : continentes (dropWhile (=='X') bs)
  where (as,bs) = break (=='X') xs

-- (numeroInfectados xs) es el número final de infectados a partir del
-- mapa xs. Por ejemplo,
--    numeroInfectados "01000000X000X011X0X"  ==  11
numeroInfectados :: String -> Int
numeroInfectados xs =
  sum [length ys | ys <- continentes xs
                 , '1' `elem` ys]
  
-- (numeroHabitantes xs) es el número final de habitantes del mapa
-- xs. Por ejemplo, 
--    numeroHabitantes "01000000X000X011X0X"  ==  15
numeroHabitantes :: String -> Int
numeroHabitantes xs = length (filter (/='X') xs)

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

porcentajeInfectados2 :: String -> Double
porcentajeInfectados2 xs
  | nh == 0   = 0
  | otherwise = 100 * ni / nh
  where ni = sum [genericLength ys | ys <- splitOn "X" xs, '1' `elem` ys]
        nh = genericLength (filter (/='X') xs)

import Data.List (genericLength)

import Data.List.Split (splitOn)

-- 1ª solución

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

porcentajeInfectados :: String -> Double

porcentajeInfectados xs

| nh == 0 = 0

| otherwise = 100 * ni / nh

where ni = fromIntegral (numeroInfectados xs)

nh = fromIntegral (numeroHabitantes xs)

-- (continentes xs) es la lista de las poblaciones de los continentes

-- del mapa xs. Por ejemplo,

-- continentes "01000000X000X011X0X" == ["01000000","000","011","0"]

-- continentes "01X000X010X011XX" == ["01","000","010","011"]

-- continentes "XXXXX" == [""]

-- continentes "0000000010" == ["0000000010"]

-- continentes "X00X000000X10X0100" == ["","00","000000","10","0100"]

continentes :: String -> [String]

continentes [] = []

continentes xs = as : continentes (dropWhile (=='X') bs)

where (as,bs) = break (=='X') xs

-- (numeroInfectados xs) es el número final de infectados a partir del

-- mapa xs. Por ejemplo,

-- numeroInfectados "01000000X000X011X0X" == 11

numeroInfectados :: String -> Int

numeroInfectados xs =

sum [length ys | ys <- continentes xs

, '1' `elem` ys]

-- (numeroHabitantes xs) es el número final de habitantes del mapa

-- xs. Por ejemplo,

-- numeroHabitantes "01000000X000X011X0X" == 15

numeroHabitantes :: String -> Int

numeroHabitantes xs = length (filter (/='X') xs)

-- 2ª solución

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

porcentajeInfectados2 :: String -> Double

porcentajeInfectados2 xs

| nh == 0 = 0

| otherwise = 100 * ni / nh

where ni = sum [genericLength ys | ys <- splitOn "X" xs, '1' `elem` ys]

nh = genericLength (filter (/='X') xs)

Otras soluciones

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

Pensamiento

«El avance de las matemáticas puede ser visto como un progreso de lo infinito a lo finito.»

Gian-Carlo Rota.

Producto de Kronecker

PorJosé A. Alonso 28-febrero-20207-marzo-2020

Si $A$ es una matriz $m \times n$ y $B$ es una matriz $p \times q$ , entonces el producto de Kronecker $A \otimes B$ es la matriz bloque $mp \times nq$

Más explícitamente, tenemos

Por ejemplo,

Definir la función

   kronecker :: Num t => Matrix t -> Matrix t -> Matrix t

1	kronecker :: Num t => Matrix t -> Matrix t -> Matrix t

tal que (kronecker a b) es el producto de Kronecker de las matrices a y b. Por ejemplo,

   λ> kronecker (fromLists [[1,2],[3,1]]) (fromLists [[0,3],[2,1]])
   ┌         ┐
   │ 0 3 0 6 │
   │ 2 1 4 2 │
   │ 0 9 0 3 │
   │ 6 3 2 1 │
   └         ┘
   λ> kronecker (fromLists [[1,2],[3,4]]) (fromLists [[2,1],[-1,0],[3,2]])
   ┌             ┐
   │  2  1  4  2 │
   │ -1  0 -2  0 │
   │  3  2  6  4 │
   │  6  3  8  4 │
   │ -3  0 -4  0 │
   │  9  6 12  8 │
   └             ┘
   λ> kronecker (fromLists [[2,1],[-1,0],[3,2]]) (fromLists [[1,2],[3,4]])
   ┌             ┐
   │  2  4  1  2 │
   │  6  8  3  4 │
   │ -1 -2  0  0 │
   │ -3 -4  0  0 │
   │  3  6  2  4 │
   │  9 12  6  8 │
   └             ┘

λ> kronecker (fromLists [[1,2],[3,1]]) (fromLists [[0,3],[2,1]])

┌ ┐

│ 0 3 0 6 │

│ 2 1 4 2 │

│ 0 9 0 3 │

│ 6 3 2 1 │

└ ┘

λ> kronecker (fromLists [[1,2],[3,4]]) (fromLists [[2,1],[-1,0],[3,2]])

┌ ┐

│ 2 1 4 2 │

│ -1 0 -2 0 │

│ 3 2 6 4 │

│ 6 3 8 4 │

│ -3 0 -4 0 │

│ 9 6 12 8 │

└ ┘

λ> kronecker (fromLists [[2,1],[-1,0],[3,2]]) (fromLists [[1,2],[3,4]])

┌ ┐

│ 2 4 1 2 │

│ 6 8 3 4 │

│ -1 -2 0 0 │

│ -3 -4 0 0 │

│ 3 6 2 4 │

│ 9 12 6 8 │

└ ┘

Soluciones

import Data.Matrix

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

kronecker :: Num t => Matrix t -> Matrix t -> Matrix t
kronecker a b =
  matrix (m*p) (n*q) f
  where m = nrows a
        n = ncols a
        p = nrows b
        q = ncols b
        f (i,j) = a !(k+1,r+1) * b!(l+1,s+1)
          where (k,l) = quotRem (i-1) p
                (r,s) = quotRem (j-1) q

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

kronecker2 a b = bloqueFila a b (ncols a)
  where
    bloque (i,j) a b = scaleMatrix (a!(i,j)) b
    bloqueFila a b 1 = bloqueColumna 1 a b
    bloqueFila a b n = bloqueFila a b (n-1) <|> bloqueColumna n a b
    bloqueColumna j a b = aux a b (nrows a)
      where aux a b 1 = bloque (1,j) a b
            aux a b n = aux a b (n-1) <-> bloque (n,j) a b

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

kronecker3 :: Num t => Matrix t -> Matrix t -> Matrix t
kronecker3 a b =
  foldl1 (<->) [foldl1 (<|>) [scaleMatrix (a!(i,j)) b
                             | j <- [1..ncols b]]
                             | i <- [1..nrows a]]

import Data.Matrix

-- 1ª solución

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

kronecker :: Num t => Matrix t -> Matrix t -> Matrix t

kronecker a b =

matrix (m*p) (n*q) f

where m = nrows a

n = ncols a

p = nrows b

q = ncols b

f (i,j) = a !(k+1,r+1) * b!(l+1,s+1)

where (k,l) = quotRem (i-1) p

(r,s) = quotRem (j-1) q

-- 2ª solución

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

kronecker2 a b = bloqueFila a b (ncols a)

where

bloque (i,j) a b = scaleMatrix (a!(i,j)) b

bloqueFila a b 1 = bloqueColumna 1 a b

bloqueFila a b n = bloqueFila a b (n-1) <|> bloqueColumna n a b

bloqueColumna j a b = aux a b (nrows a)

where aux a b 1 = bloque (1,j) a b

aux a b n = aux a b (n-1) <-> bloque (n,j) a b

-- 3ª solución

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

kronecker3 :: Num t => Matrix t -> Matrix t -> Matrix t

kronecker3 a b =

foldl1 (<->) [foldl1 (<|>) [scaleMatrix (a!(i,j)) b

| j <- [1..ncols b]]

| i <- [1..nrows a]]

Otras soluciones

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

Pensamiento

«La resolución de problemas es una habilidad práctica como, digamos, la natación. Adquirimos cualquier habilidad práctica por imitación y práctica. Tratando de nadar, imitas lo que otras personas hacen con sus manos y pies para mantener sus cabezas sobre el agua, y, finalmente, aprendes a nadar practicando la natación. Al intentar resolver problemas, hay que observar e imitar lo que hacen otras personas al resolver problemas y, finalmente, se aprende a resolver problemas haciéndolos.»

George Pólya.

Reducción de SAT a Clique

PorJosé A. Alonso 27-febrero-20205-marzo-2020

Nota: En este ejercicio se usa la misma notación que en los anteriores importando los módulos

+ Evaluacion_de_FNC
+ Modelos_de_FNC
+ Problema_SAT_para_FNC
+ Cliques
+ KCliques
+ Grafo_FNC

+ Evaluacion_de_FNC

+ Modelos_de_FNC

+ Problema_SAT_para_FNC

+ Cliques

+ KCliques

+ Grafo_FNC

Definir las funciones

   cliquesFNC :: FNC -> [[(Int,Literal)]]
   cliquesCompletos :: FNC -> [[(Int,Literal)]]
   esSatisfaciblePorClique :: FNC -> Bool

cliquesFNC :: FNC -> [[(Int,Literal)]]

cliquesCompletos :: FNC -> [[(Int,Literal)]]

esSatisfaciblePorClique :: FNC -> Bool

tales que

(cliquesFNCf) es la lista de los cliques del grafo de f. Por ejemplo,

     λ> cliquesFNC [[1,-2,3],[-1,2],[-2,3]]
     [[], [(0,1)], [(1,2)], [(0,1),(1,2)], [(2,-2)],
      [(0,1),(2,-2)], [(2,3)], [(0,1),(2,3)], [(1,2),(2,3)],
      [(0,1),(1,2),(2,3)], [(0,-2)], [(2,-2),(0,-2)], [(2,3),(0,-2)],
      [(1,-1)], [(2,-2),(1,-1)], [(2,3),(1,-1)], [(0,-2),(1,-1)],
      [(2,-2),(0,-2),(1,-1)], [(2,3),(0,-2),(1,-1)], [(0,3)],
      [(1,2),(0,3)], [(2,-2),(0,3)], [(2,3),(0,3)],
      [(1,2),(2,3),(0,3)], [(1,-1),(0,3)],
      [(2,-2),(1,-1),(0,3)], [(2,3),(1,-1),(0,3)]]

λ> cliquesFNC [[1,-2,3],[-1,2],[-2,3]]

[[], [(0,1)], [(1,2)], [(0,1),(1,2)], [(2,-2)],

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

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

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

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

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

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

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

(cliquesCompletos f) es la lista de los cliques del grafo de f que tiene tantos elementos como cláusulas tiene f. Por ejemplo,

     λ> cliquesCompletos [[1,-2,3],[-1,2],[-2,3]]
     [[(0,1),(1,2),(2,3)],   [(2,-2),(0,-2),(1,-1)],
      [(2,3),(0,-2),(1,-1)], [(1,2),(2,3),(0,3)],
      [(2,-2),(1,-1),(0,3)], [(2,3),(1,-1),(0,3)]]
     λ> cliquesCompletos [[1,2],[1,-2],[-1,2],[-1,-2]]
     []

λ> cliquesCompletos [[1,-2,3],[-1,2],[-2,3]]

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

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

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

λ> cliquesCompletos [[1,2],[1,-2],[-1,2],[-1,-2]]

[]

(esSatisfaciblePorClique f) se verifica si f no contiene la cláusula vacía, tiene más de una cláusula y posee algún clique completo. Por ejemplo,

     λ> esSatisfaciblePorClique [[1,-2,3],[-1,2],[-2,3]]
     True
     λ> esSatisfaciblePorClique [[1,2],[1,-2],[-1,2],[-1,-2]]
     False

λ> esSatisfaciblePorClique [[1,-2,3],[-1,2],[-2,3]]

True

λ> esSatisfaciblePorClique [[1,2],[1,-2],[-1,2],[-1,-2]]

False

Comprobar con QuickCheck que toda fórmula en FNC es satisfacible si, y solo si, es satisfacible por Clique.

Soluciones

module Reduccion_de_SAT_a_Clique where

import Evaluacion_de_FNC
import Modelos_de_FNC
import Problema_SAT_para_FNC
import Cliques
import KCliques
import Grafo_FNC
import Data.List (nub, sort)
import Test.QuickCheck

cliquesFNC :: FNC -> [[(Int,Literal)]]
cliquesFNC f = cliques (grafoFNC f)

cliquesCompletos :: FNC -> [[(Int,Literal)]]
cliquesCompletos cs = kCliques (grafoFNC cs) (length cs)

esSatisfaciblePorClique :: FNC -> Bool
esSatisfaciblePorClique f =
     [] `notElem` f'
  && (length f' <= 1 || not (null (cliquesCompletos f')))
  where f' = nub (map (nub . sort) f) 

-- La propiedad es
prop_esSatisfaciblePorClique :: FNC -> Bool
prop_esSatisfaciblePorClique f =
  esSatisfacible f == esSatisfaciblePorClique f

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

module Reduccion_de_SAT_a_Clique where

import Evaluacion_de_FNC

import Modelos_de_FNC

import Problema_SAT_para_FNC

import Cliques

import KCliques

import Grafo_FNC

import Data.List (nub, sort)

import Test.QuickCheck

cliquesFNC :: FNC -> [[(Int,Literal)]]

cliquesFNC f = cliques (grafoFNC f)

cliquesCompletos :: FNC -> [[(Int,Literal)]]

cliquesCompletos cs = kCliques (grafoFNC cs) (length cs)

esSatisfaciblePorClique :: FNC -> Bool

esSatisfaciblePorClique f =

[] `notElem` f'

&& (length f' <= 1 || not (null (cliquesCompletos f')))

where f' = nub (map (nub . sort) f)

-- La propiedad es

prop_esSatisfaciblePorClique :: FNC -> Bool

prop_esSatisfaciblePorClique f =

esSatisfacible f == esSatisfaciblePorClique f

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=7}) prop_esSatisfaciblePorClique

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

«La resolución de problemas es una habilidad práctica como, digamos, la natación. Adquirimos cualquier habilidad práctica por imitación y práctica. Tratando de nadar, imitas lo que otras personas hacen con sus manos y pies para mantener sus cabezas sobre el agua, y, finalmente, aprendes a nadar practicando la natación. Al intentar resolver problemas, hay que observar e imitar lo que hacen otras personas al resolver problemas y, finalmente, se aprende a resolver problemas haciéndolos.»

George Pólya.

Problema SAT para FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 18-febrero-202025-febrero-2020

Nota: En este ejercicio usaremos las mismas notaciones que en los anteriores importando los módulos import Modelos_de_FNC y Evaluacion_de_FNC

Una FNC (fórmula en forma normal conjuntiva) es satisfacible, si tiene algún modelo. Por ejemplo,

Definir la función

   esSatisfacible :: FNC -> Bool

1	esSatisfacible :: FNC -> Bool

tal que (esSatisfacible f) se verifica si la FNC f es satistacible. Por ejemplo,

   esSatisfacible [[-1,2],[-2,1]]    ==  True
   esSatisfacible [[-1,2],[-2],[1]]  ==  False
   esSatisfacible [[1,2],[]]         ==  False
   esSatisfacible []                 ==  True

esSatisfacible [[-1,2],[-2,1]] == True

esSatisfacible [[-1,2],[-2],[1]] == False

esSatisfacible [[1,2],[]] == False

esSatisfacible [] == True

Nota: Escribir la solución en el módulo Problema_de_SAT_para_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Problema_SAT_para_FNC where

import Modelos_de_FNC  
import Evaluacion_de_FNC

esSatisfacible :: FNC -> Bool
esSatisfacible = not . null . modelos

module Problema_SAT_para_FNC where

import Modelos_de_FNC

import Evaluacion_de_FNC

esSatisfacible :: FNC -> Bool

esSatisfacible = not . null . modelos

Otras soluciones

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

Pensamiento

«Un gran descubrimiento resuelve un gran problema, pero hay un grano de descubrimiento en cualquier problema.»

George Pólya.

Modelos de FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 17-febrero-202024-febrero-2020

Nota: En este ejercicio usaremos las mismas notaciones que en anterior importando los módulos Interpretaciones_de_FNC y Evaluacion_de_FNC

Una interpretación I es un modelo de un literal L si el valor de L en I es verdadero. Por ejemplo, la interpretación [2,5]

es modelo del literal x(2) (porque 2 ∈ [2,5])
no es modelo del literal x(3) (porque 3 ∉ [2,5])
es modelo del literal -x(4) (porque 4 ∉ [2,5])

Una interpretación I es un modelo de una cláusula C si el valor de C en I es verdadero. Por ejemplo, la interpretación [2,5]

es modelo de la cláusula (x(2) v x(3)) (porque x(2) es verdadero)
no es modelo de la cláusula (x(3) v x(4)) (porque x(3) y x(4) son falsos)

Una interpretación I es un modelo de una FNC F si el valor de F en I es verdadero. Por ejemplo, la interpretación [2,5]

es modelo de la FNC ((x(2) v x(5)) & (-x(4) v x(3)) porque lo es de sus dos cláusulas.

Definir las siguientes funciones

   esModeloLiteral  :: Interpretacion -> Literal -> Bool
   esModeloClausula :: Interpretacion -> Clausula -> Bool
   esModelo         :: Interpretacion -> FNC -> Bool
   modelosClausula  :: Clausula -> [Interpretacion]
   modelos          :: FNC -> [Interpretacion]

esModeloLiteral :: Interpretacion -> Literal -> Bool

esModeloClausula :: Interpretacion -> Clausula -> Bool

esModelo :: Interpretacion -> FNC -> Bool

modelosClausula :: Clausula -> [Interpretacion]

modelos :: FNC -> [Interpretacion]

tales que

(esModeloLiteral i l) se verifica si i es modelo del literal l. Por ejemplo,

     esModeloLiteral [3,5] 3     ==  True
     esModeloLiteral [3,5] 4     ==  False
     esModeloLiteral [3,5] (-3)  ==  False
     esModeloLiteral [3,5] (-4)  ==  True

esModeloLiteral [3,5] 3 == True

esModeloLiteral [3,5] 4 == False

esModeloLiteral [3,5] (-3) == False

esModeloLiteral [3,5] (-4) == True

(esModeloClausula i c) se verifica si i es modelo de la cláusula c. Por ejemplo,

     esModeloClausula [3,5] [2,3,-5]  ==  True
     esModeloClausula [3,5] [2,4,-1]  ==  True
     esModeloClausula [3,5] [2,4,1]   ==  False

esModeloClausula [3,5] [2,3,-5] == True

esModeloClausula [3,5] [2,4,-1] == True

esModeloClausula [3,5] [2,4,1] == False

(esModelo i f) se verifica si i es modelo de la fórmula f. Por ejemplo,

     esModelo [1,3] [[1,-2],[3]]  ==  True
     esModelo [1]   [[1,-2],[3]]  ==  False
     esModelo [1]   []            ==  True

esModelo [1,3] [[1,-2],[3]] == True

esModelo [1] [[1,-2],[3]] == False

esModelo [1] [] == True

(modelosClausula c) es la lista de los modelos de la cláusula c. Por ejemplo,

     modelosClausula [-1,2]  ==  [[],[2],[1,2]]
     modelosClausula [-1,1]  ==  [[],[1]]
     modelosClausula []      ==  []

modelosClausula [-1,2] == [[],[2],[1,2]]

modelosClausula [-1,1] == [[],[1]]

modelosClausula [] == []

(modelos f) es la lista de los modelos de la fórmula f. Por ejemplo,

     modelos [[-1,2],[-2,1]]    ==  [[],[1,2]]
     modelos [[-1,2],[-2],[1]]  ==  []
     modelos [[1,-1,2]]         ==  [[],[1],[2],[1,2]]

modelos [[-1,2],[-2,1]] == [[],[1,2]]

modelos [[-1,2],[-2],[1]] == []

modelos [[1,-1,2]] == [[],[1],[2],[1,2]]

Nota: Escribir la solución en el módulo Modelos_de_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Modelos_de_FNC where

import Interpretaciones_de_FNC 
import Evaluacion_de_FNC

esModeloLiteral :: Interpretacion -> Literal -> Bool
esModeloLiteral i l
  | l > 0     = l `elem` i
  | otherwise = negate l `notElem` i

esModeloClausula :: Interpretacion -> Clausula -> Bool
esModeloClausula i = any (esModeloLiteral i)

esModelo :: Interpretacion -> FNC -> Bool
esModelo i = all (esModeloClausula i)

modelosClausula :: Clausula -> [Interpretacion]
modelosClausula c =
  [i | i <- interpretacionesClausula c,
       esModeloClausula i c]

modelos :: FNC -> [Interpretacion]
modelos f =
  [i | i <- interpretaciones f,
       esModelo i f]

module Modelos_de_FNC where

import Interpretaciones_de_FNC

import Evaluacion_de_FNC

esModeloLiteral :: Interpretacion -> Literal -> Bool

esModeloLiteral i l

| l > 0 = l `elem` i

| otherwise = negate l `notElem` i

esModeloClausula :: Interpretacion -> Clausula -> Bool

esModeloClausula i = any (esModeloLiteral i)

esModelo :: Interpretacion -> FNC -> Bool

esModelo i = all (esModeloClausula i)

modelosClausula :: Clausula -> [Interpretacion]

modelosClausula c =

[i | i <- interpretacionesClausula c,

esModeloClausula i c]

modelos :: FNC -> [Interpretacion]

modelos f =

[i | i <- interpretaciones f,

esModelo i f]

Otras soluciones

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

Pensamiento

«Por muy correcto que parezca un teorema matemático, nunca hay que conformarse con que no haya algo imperfecto en él hasta obtener la impresión de qie es bello.»

George Boole.

Interpretaciones de FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 14-febrero-202022-febrero-2020

Nota: En este ejercicio usaremos las mismas notaciones que en el anterior importando los módulos Evaluacion_de_FNC y Atomos_de_FNC.

Definir las siguientes funciones

   interpretacionesClausula :: Clausula -> [Interpretacion]
   interpretaciones         :: FNC -> [Interpretacion]

1 2	interpretacionesClausula :: Clausula -> [Interpretacion] interpretaciones :: FNC -> [Interpretacion]

tales que

(interpretacionesClausula c) es el conjunto de interpretaciones de la cláusula c. Por ejemplo,

     interpretacionesClausula [1,2,-1]  ==  [[],[1],[2],[1,2]]
     interpretacionesClausula []        ==  [[]]

1 2	interpretacionesClausula [1,2,-1] == [[],[1],[2],[1,2]] interpretacionesClausula [] == [[]]

(interpretaciones f) es el conjunto de interpretaciones de la fórmula f. Por ejemplo,

     interpretaciones [[1,-2],[-1,2]] == [[],[1],[2],[1,2]] 
     interpretaciones []              == [[]]

1 2	interpretaciones [[1,-2],[-1,2]] == [[],[1],[2],[1,2]] interpretaciones [] == [[]]

Nota: Escribir la solución en el módulo Interpretaciones_de_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Interpretaciones_de_FNC where

import Evaluacion_de_FNC
import Atomos_de_FNC
import Data.List (subsequences)

interpretacionesClausula :: Clausula -> [Interpretacion]
interpretacionesClausula = subsequences . atomosClausula 

interpretaciones :: FNC -> [Interpretacion]
interpretaciones = subsequences . atomosFNC

module Interpretaciones_de_FNC where

import Evaluacion_de_FNC

import Atomos_de_FNC

import Data.List (subsequences)

interpretacionesClausula :: Clausula -> [Interpretacion]

interpretacionesClausula = subsequences . atomosClausula

interpretaciones :: FNC -> [Interpretacion]

interpretaciones = subsequences . atomosFNC

Otras soluciones

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

Pensamiento

«En matemáticas, el arte de hacer preguntas es más valioso que la resolución de problemas.»

Georg Cantor.

Átomos de FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 13-febrero-202020-febrero-2020

Nota: En este ejercicio usaremos las mismas notaciones que en el anterior importando el módulo Evaluacion_de_FNC.

Definir las siguientes funciones

    atomosClausula :: Clausula -> [Atomo]
    atomosFNC      :: FNC -> [Atomo]

1 2	atomosClausula :: Clausula -> [Atomo] atomosFNC :: FNC -> [Atomo]

tales que

(atomosClausula c) es el conjunto de los átomos de la cláusula c. Por ejemplo,

     atomosClausula [3,1,-3] == [1,3]

1	atomosClausula [3,1,-3] == [1,3]

(atomosFNC f) es el conjunto de los átomos de la FNC f. Por ejemplo,

   atomosFNC [[4,5],[1,-2],[-4,-1,-5]]  ==  [1,2,4,5]

1	atomosFNC [[4,5],[1,-2],[-4,-1,-5]] == [1,2,4,5]

Nota: Escribir la solución en el módulo Atomos_de_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Atomos_de_FNC where
  
import Evaluacion_de_FNC
import Data.List (sort, nub)

-- 1ª definición de atomosClausula
atomosClausula :: Clausula -> [Atomo]
atomosClausula c = sort (nub (map abs c))

-- 2ª definición de atomosClausula
atomosClausula2 :: Clausula -> [Atomo]
atomosClausula2 = sort . nub . map abs

-- 1ª definición de atomosFNC
atomosFNC :: FNC -> [Atomo]
atomosFNC f = sort (nub (concat [atomosClausula c | c <- f]))

-- 2ª definición
atomosFNC2 :: FNC -> [Atomo]
atomosFNC2 f = sort (nub (concatMap atomosClausula f))

-- 3ª definición
atomosFNC3 :: FNC -> [Atomo]
atomosFNC3 = sort . nub . concatMap atomosClausula

module Atomos_de_FNC where

import Evaluacion_de_FNC

import Data.List (sort, nub)

-- 1ª definición de atomosClausula

atomosClausula :: Clausula -> [Atomo]

atomosClausula c = sort (nub (map abs c))

-- 2ª definición de atomosClausula

atomosClausula2 :: Clausula -> [Atomo]

atomosClausula2 = sort . nub . map abs

-- 1ª definición de atomosFNC

atomosFNC :: FNC -> [Atomo]

atomosFNC f = sort (nub (concat [atomosClausula c | c <- f]))

-- 2ª definición

atomosFNC2 :: FNC -> [Atomo]

atomosFNC2 f = sort (nub (concatMap atomosClausula f))

-- 3ª definición

atomosFNC3 :: FNC -> [Atomo]

atomosFNC3 = sort . nub . concatMap atomosClausula

Otras soluciones

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

Pensamiento

«La esencia de las matemáticas es su libertad.»

Georg Cantor.

Evaluación de FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 12-febrero-202019-febrero-2020

Una FNC (fórmula en forma normal conjuntiva) es una conjunción de cláusulas, donde una cláusula es una disyunción de literales y un literal es un átomo o su negación. Por ejemplo,

   (x(1) v -x(3)) & x(2) & (-x(2) v x(3) v x(1))

1	(x(1) v -x(3)) & x(2) & (-x(2) v x(3) v x(1))

es una FNC con tres clásulas tales que la primera cláusula tiene 2 literales (x(1) y -x(3)), la segunda tiene 1 (x(2)) y la tercera tiene 3 (-x(2), x(3) y x(1)).

Usaremos las siguientes representaciones:

Los átomos se representan por enteros positivos. Por ejemplo, 3 representa x(3).
Los literales se representan por enteros. Por ejemplo, 3 representa el literal positivo x(3) y -5 el literal negativo -x(5).
Una cláusula es una lista de literales que representa la disyunción se sus literales. Por ejemplo, [3,2,-4] representa a (x(3) v x(2) v -x(4)).
Una fórmula en forma normal conjuntiva (FNC) es una lista de cláusulas que representa la conjunción de sus cláusulas. Por ejemplo, [[3,2],[-1,2,5]] representa a ((x(3) v x(2)) & (-x(1) v x(2) v x(5))).

Una interpretación I es un conjunto de átomos. Se supone que los átomos de I son verdaderos y los restantes son falsos. Por ejemplo, en la interpretación [2,5]

el literal x(2) es verdadero (porque 2 ∈ [2,5])
el literal x(3) es falso (porque 3 ∉ [2,5])
el literal -x(4) es verdadero (porque 4 ∉ [2,5])
la cláusula (x(2) v x(3)) es verdadera (porque x(2) es verdadero)
la cláusula (x(3) v x(4)) es falsa (porque x(3) y x(4) son falsos)
la FNC ((x(2) v x(5)) & (-x(4) v x(3)) es verdadera porque lo son sus dos cláusulas

En el ejercicio se usarán los siguientes tipos de datos

   type Atomo          = Int
   type Literal        = Int
   type Clausula       = [Literal]
   type FNC            = [Clausula]
   type Interpretacion = [Atomo]

type Atomo = Int

type Literal = Int

type Clausula = [Literal]

type FNC = [Clausula]

type Interpretacion = [Atomo]

Definir las siguientes funciones

   valorLiteral  :: Interpretacion -> Literal -> Bool
   valorClausula :: Interpretacion -> Clausula -> Bool
   valor         :: Interpretacion -> FNC -> Bool

valorLiteral :: Interpretacion -> Literal -> Bool

valorClausula :: Interpretacion -> Clausula -> Bool

valor :: Interpretacion -> FNC -> Bool

tales que

(valorLiteral i l) es el valor del literal l en la interpretación i. Por ejemplo,

     valorLiteral [3,5] 3     ==  True
     valorLiteral [3,5] 4     ==  False
     valorLiteral [3,5] (-3)  ==  False
     valorLiteral [3,5] (-4)  ==  True

valorLiteral [3,5] 3 == True

valorLiteral [3,5] 4 == False

valorLiteral [3,5] (-3) == False

valorLiteral [3,5] (-4) == True

(valorClausula i c) es el valor de la cláusula c en la interpretación i. Por ejemplo,

     valorClausula [3,5] [2,3,-5]  ==  True
     valorClausula [3,5] [2,4,-1]  ==  True
     valorClausula [3,5] [2,4,1]   ==  False

valorClausula [3,5] [2,3,-5] == True

valorClausula [3,5] [2,4,-1] == True

valorClausula [3,5] [2,4,1] == False

(valor i f) es el valor de la fórmula en FNC f en la interpretación i. Por ejemplo,

     valor [1,3] [[1,-2],[3]]  ==  True
     valor [1]   [[1,-2],[3]]  ==  False
     valor [1]   []            ==  True

valor [1,3] [[1,-2],[3]] == True

valor [1] [[1,-2],[3]] == False

valor [1] [] == True

Nota: Escribir la solución en el módulo Evaluacion_de_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Evaluacion_de_FNC where

type Atomo          = Int
type Literal        = Int
type Clausula       = [Literal]
type FNC            = [Clausula]
type Interpretacion = [Atomo]

-- Definición de valorLiteral
-- ==========================

valorLiteral :: Interpretacion -> Literal -> Bool
valorLiteral i l
  | l > 0     = l `elem` i
  | otherwise = negate l `notElem` i

-- Definiciones de valorClausula
-- =============================

-- 1ª definición
valorClausula :: Interpretacion -> Clausula -> Bool
valorClausula i c = or [valorLiteral i l | l <- c]

-- 2ª definición
valorClausula2 :: Interpretacion -> Clausula -> Bool
valorClausula2 i = any (valorLiteral i)

-- Definiciones de valor de FNC
-- ============================

-- 1ª definición
valor :: Interpretacion -> FNC -> Bool
valor i f = and [valorClausula i c | c <- f]

-- 2ª definición
valor2 :: Interpretacion -> FNC -> Bool
valor2 i = all (valorClausula i)

module Evaluacion_de_FNC where

type Atomo = Int

type Literal = Int

type Clausula = [Literal]

type FNC = [Clausula]

type Interpretacion = [Atomo]

-- Definición de valorLiteral

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

valorLiteral :: Interpretacion -> Literal -> Bool

valorLiteral i l

| l > 0 = l `elem` i

| otherwise = negate l `notElem` i

-- Definiciones de valorClausula

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

-- 1ª definición

valorClausula :: Interpretacion -> Clausula -> Bool

valorClausula i c = or [valorLiteral i l | l <- c]

-- 2ª definición

valorClausula2 :: Interpretacion -> Clausula -> Bool

valorClausula2 i = any (valorLiteral i)

-- Definiciones de valor de FNC

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

-- 1ª definición

valor :: Interpretacion -> FNC -> Bool

valor i f = and [valorClausula i c | c <- f]

-- 2ª definición

valor2 :: Interpretacion -> FNC -> Bool

valor2 i = all (valorClausula i)

Otras soluciones

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

Pensamiento

«Todo buen matemático es al menos medio filósofo, y todo buen filósofo es al menos medio matemático.»

Gottlob Frege.

Conjetura de Lemoine

PorJosé A. Alonso 11-febrero-202026-marzo-2022

La conjetura de Lemoine afirma que

Todos los números impares mayores que 5 se pueden escribir de la forma p + 2q donde p y q son números primos. Por ejemplo, 47 = 13 + 2 x 17

Definir las funciones

   descomposicionesLemoine :: Integer -> [(Integer,Integer)]
   graficaLemoine :: Integer -> IO ()

1 2	descomposicionesLemoine :: Integer -> [(Integer,Integer)] graficaLemoine :: Integer -> IO ()

tales que

(descomposicionesLemoine n) es la lista de pares de primos (p,q) tales que n = p + 2q. Por ejemplo,

     descomposicionesLemoine 5   ==  []
     descomposicionesLemoine 7   ==  [(3,2)]
     descomposicionesLemoine 9   ==  [(5,2),(3,3)]
     descomposicionesLemoine 21  ==  [(17,2),(11,5),(7,7)]
     descomposicionesLemoine 47  ==  [(43,2),(41,3),(37,5),(13,17)]
     descomposicionesLemoine 33  ==  [(29,2),(23,5),(19,7),(11,11),(7,13)]
     length (descomposicionesLemoine 2625)  ==  133

descomposicionesLemoine 5 == []

descomposicionesLemoine 7 == [(3,2)]

descomposicionesLemoine 9 == [(5,2),(3,3)]

descomposicionesLemoine 21 == [(17,2),(11,5),(7,7)]

descomposicionesLemoine 47 == [(43,2),(41,3),(37,5),(13,17)]

descomposicionesLemoine 33 == [(29,2),(23,5),(19,7),(11,11),(7,13)]

length (descomposicionesLemoine 2625) == 133

(graficaLemoine n) dibuja la gráfica de los números de descomposiciones de Lemoine para los números impares menores o iguales que n. Por ejemplo, (graficaLemoine n 400) dibuja

Comprobar con QuickCheck la conjetura de Lemoine.

Nota: Basado en Lemoine’s conjecture

Soluciones

import Data.Numbers.Primes (isPrime, primes)
import Graphics.Gnuplot.Simple
import Test.QuickCheck

descomposicionesLemoine :: Integer -> [(Integer,Integer)]
descomposicionesLemoine n =
  [(p,q) | q <- takeWhile (<=(n-2) `div` 2) primes
         , let p = n - 2 * q
         , isPrime p]

graficaLemoine :: Integer -> IO ()
graficaLemoine n = do
  plotList [ Key Nothing
           , Title "Conjetura de Lemoine"
           , PNG "Conjetura_de_Lemoine.png"
           ]
           [(k,length (descomposicionesLemoine k)) | k <- [1,3..n]]

-- La conjetura es
prop_conjeturaLemoine :: Integer -> Bool
prop_conjeturaLemoine n =
  not (null (descomposicionesLemoine n'))
  where n' = 7 + 2 * abs n

-- Su comprobación es
--    λ> quickCheck prop_conjeturaLemoine
--    +++ OK, passed 100 tests.

import Data.Numbers.Primes (isPrime, primes)

import Graphics.Gnuplot.Simple

import Test.QuickCheck

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

descomposicionesLemoine n =

[(p,q) | q <- takeWhile (<=(n-2) `div` 2) primes

, let p = n - 2 * q

, isPrime p]

graficaLemoine :: Integer -> IO ()

graficaLemoine n = do

plotList [ Key Nothing

, Title "Conjetura de Lemoine"

, PNG "Conjetura_de_Lemoine.png"

]

[(k,length (descomposicionesLemoine k)) | k <- [1,3..n]]

-- La conjetura es

prop_conjeturaLemoine :: Integer -> Bool

prop_conjeturaLemoine n =

not (null (descomposicionesLemoine n'))

where n' = 7 + 2 * abs n

-- Su comprobación es

-- λ> quickCheck prop_conjeturaLemoine

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

«Todo el mundo sabe lo que es una curva, hasta que ha estudiado suficientes matemáticas para confundirse a través del incontable número de posibles excepciones.»

Felix Klein.

Conjetura de Collatz generalizada

PorJosé A. Alonso 10-febrero-202017-febrero-2020

Sea p un número primo. Toma un número natural positivo, si es divisible entre un número primo menor que p divídelo entre el menor de dicho divisores, y en otro caso multiplícalo por p y súmale uno; si el resultado no es igual a uno, repite el proceso. Por ejemplo, para p = 7 y empezando en 42 el proceso es

   42
   -> 21   [= 42/2]
   -> 7    [= 21/3]
   -> 50   [= 7*7+1]
   -> 25   [= 50/5]
   -> 5    [= 25/5]
   -> 1    [= 5/5]

-> 21 [= 42/2]

-> 7 [= 21/3]

-> 50 [= 7*7+1]

-> 25 [= 50/5]

-> 5 [= 25/5]

-> 1 [= 5/5]

La conjetura de Collatz generalizada afirma que este proceso siempre acaba en un número finito de pasos.

Definir la función

   collatzGeneral :: Integer -> Integer -> [Integer]

1	collatzGeneral :: Integer -> Integer -> [Integer]

tal que (collatzGeneral p x) es la sucesión de los elementos obtenidos en el proceso anterior para el primo p enpezando en x. Por ejemplo,

   take 15 (collatzGeneral 7 42) == [42,21,7,50,25,5,1,8,4,2,1,8,4,2,1]
   take 15 (collatzGeneral 3  6) == [6,3,10,5,16,8,4,2,1,4,2,1,4,2,1]
   take 15 (collatzGeneral 5  6) == [6,3,1,6,3,1,6,3,1,6,3,1,6,3,1]
   take 15 (collatzGeneral 7  6) == [6,3,1,8,4,2,1,8,4,2,1,8,4,2,1]
   take 15 (collatzGeneral 9  6) == [6,3,1,10,5,1,10,5,1,10,5,1,10,5,1]

take 15 (collatzGeneral 7 42) == [42,21,7,50,25,5,1,8,4,2,1,8,4,2,1]

take 15 (collatzGeneral 3 6) == [6,3,10,5,16,8,4,2,1,4,2,1,4,2,1]

take 15 (collatzGeneral 5 6) == [6,3,1,6,3,1,6,3,1,6,3,1,6,3,1]

take 15 (collatzGeneral 7 6) == [6,3,1,8,4,2,1,8,4,2,1,8,4,2,1]

take 15 (collatzGeneral 9 6) == [6,3,1,10,5,1,10,5,1,10,5,1,10,5,1]

Comprobar con QuickCheck que se verifica la conjetura de Collatz generalizada; es decir, para todos enteros positivos n, x si p es el primo n-ésimo entonces 1 pertenece a (collatzGeneral p x).

Nota: El ejercicio etá basado en el artículo Los primos de la conjetura de Collatz publicado la semana pasada por Francisco R. Villatoro en su blog La Ciencia de la Mula Francis.

Soluciones

import Data.Numbers.Primes (primeFactors, primes)
import Test.QuickCheck

collatzGeneral :: Integer -> Integer -> [Integer]
collatzGeneral p x =
  iterate (siguiente p) x

siguiente :: Integer -> Integer -> Integer
siguiente p x 
  | null xs   = p * x + 1
  | otherwise = x `div` head xs
  where xs = takeWhile (<p) (primeFactors x)

prop_collatzGeneral :: Int -> Integer -> Property
prop_collatzGeneral n x =
  n > 0 && x > 0 ==>
  1 `elem` collatzGeneral p x
  where p = primes !! n 

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

import Data.Numbers.Primes (primeFactors, primes)

import Test.QuickCheck

collatzGeneral :: Integer -> Integer -> [Integer]

collatzGeneral p x =

iterate (siguiente p) x

siguiente :: Integer -> Integer -> Integer

siguiente p x

| null xs = p * x + 1

| otherwise = x `div` head xs

where xs = takeWhile (<p) (primeFactors x)

prop_collatzGeneral :: Int -> Integer -> Property

prop_collatzGeneral n x =

n > 0 && x > 0 ==>

1 `elem` collatzGeneral p x

where p = primes !! n

-- La comprobación es

-- λ> quickCheck prop_collatzGeneral

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

«Las matemáticas son la ciencia que utiliza palabras fáciles para ideas difíciles.»

Edward Kasner y James R. Newman

La menos conocida de las conjeturas de Goldbach

PorJosé A. Alonso 7-febrero-202017-febrero-2020

Goldbach, el de la famosa conjetura, hizo por lo menos otra conjetura que finalmente resultó ser falsa.

Esta última decía que todo número compuesto impar puede expresarse como la suma de un número primo más dos veces la suma de un cuadrado. Así por ejemplo,

    9 =  7 + 2×1^2
   15 =  7 + 2×2^2
   21 =  3 + 2×3^2
   25 =  7 + 2×3^2
   27 = 19 + 2×2^2
   33 = 31 + 2×1^2

9 = 7 + 2×1^2

15 = 7 + 2×2^2

21 = 3 + 2×3^2

25 = 7 + 2×3^2

27 = 19 + 2×2^2

33 = 31 + 2×1^2

Definir las sucesiones

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

imparesCompuestos :: [Integer]

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

contraejemplosGoldbach :: [Integer]

tales que

imparesCompuestos es la lista de los números impares compuestos. Por ejemplo,

     take 9 imparesCompuestos  ==  [9,15,21,25,27,33,35,39,45]

1	take 9 imparesCompuestos == [9,15,21,25,27,33,35,39,45]

(descomposiciones n) es la lista de las descomposiciones de n de n como la suma de un número primo más dos veces la suma de un cuadrado. Por ejemplo,

     descomposiciones 9     ==  [(7,1)]
     descomposiciones 21    ==  [(3,9),(13,4),(19,1)]
     descomposiciones 5777  ==  []

descomposiciones 9 == [(7,1)]

descomposiciones 21 == [(3,9),(13,4),(19,1)]

descomposiciones 5777 == []

Las 3 descomposiciones de 21 son

     21 =  3 + 2*9 = 21 + 2*3^2
     21 = 13 + 2*4 = 13 + 2*3^2
     21 = 19 + 2*1 = 19 + 2*1^2

21 = 3 + 2*9 = 21 + 2*3^2

21 = 13 + 2*4 = 13 + 2*3^2

21 = 19 + 2*1 = 19 + 2*1^2

contraejemplosGoldbach es la lista de los contraejemplos de la anterior conjetura de Goldbach; es decir, los números impares compuestos que no pueden expresarse como la suma de un número primo más dos veces la suma de un cuadrado. Por ejemplo,

   take 2 contraejemplosGoldbach  ==  [5777,5993]

1	take 2 contraejemplosGoldbach == [5777,5993]

Comprobar con QuickCheck que la conjetura de Golbach se verifica a partir de 5993; es decir, todo número compuesto impar mayor que 5993 puede expresarse como la suma de un número primo más dos veces la suma de un cuadrado.

Nota: Basado en el artículo La menos conocida de las conjeturas de Goldbach de Claudio Meller en el blog Números y algo más.

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck

imparesCompuestos :: [Integer]
imparesCompuestos = filter esCompuesto [3,5..]

-- (esCompuesto x) se verifica si x es un número compuesto. Por ejemplo,
--    esCompuesto 6  ==  True
--    esCompuesto 7  ==  False
esCompuesto :: Integer -> Bool
esCompuesto = not . isPrime

contraejemplosGoldbach :: [Integer]
contraejemplosGoldbach = filter esContraejemplo imparesCompuestos

-- (esContraejemplo x) es verifica si el número impar compuesto x es un
-- contraejemplo de la conjetura de Goldbach. Por ejemplo,
--    esContraejemplo 5777  ==  True
--    esContraejemplo 15    ==  False
esContraejemplo :: Integer -> Bool
esContraejemplo = null . descomposiciones

descomposiciones :: Integer -> [(Integer,Integer)]
descomposiciones n =
  [(p,x) | p <- takeWhile (<=n) primes
         , (n - p) `mod` 2 == 0
         , let x = (n - p) `div` 2
         , esCuadrado x]

-- (esCuadrado x) es verifica si x es un cuadrado perfecto. Por ejemplo, 
--    esCuadrado 16  ==  True
--    esCuadrado 27  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x = y^2 == x
  where y = ceiling (sqrt (fromIntegral x))

-- La propiedad es
prop_conjetura :: Int -> Property
prop_conjetura n =
  n >= 0 ==> not (esContraejemplo (imparesCompuestosMayore5993 !! n))
  where imparesCompuestosMayore5993 = dropWhile (<=5993) imparesCompuestos

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

import Data.Numbers.Primes

import Test.QuickCheck

imparesCompuestos :: [Integer]

imparesCompuestos = filter esCompuesto [3,5..]

-- (esCompuesto x) se verifica si x es un número compuesto. Por ejemplo,

-- esCompuesto 6 == True

-- esCompuesto 7 == False

esCompuesto :: Integer -> Bool

esCompuesto = not . isPrime

contraejemplosGoldbach :: [Integer]

contraejemplosGoldbach = filter esContraejemplo imparesCompuestos

-- (esContraejemplo x) es verifica si el número impar compuesto x es un

-- contraejemplo de la conjetura de Goldbach. Por ejemplo,

-- esContraejemplo 5777 == True

-- esContraejemplo 15 == False

esContraejemplo :: Integer -> Bool

esContraejemplo = null . descomposiciones

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

descomposiciones n =

[(p,x) | p <- takeWhile (<=n) primes

, (n - p) `mod` 2 == 0

, let x = (n - p) `div` 2

, esCuadrado x]

-- (esCuadrado x) es verifica si x es un cuadrado perfecto. Por ejemplo,

-- esCuadrado 16 == True

-- esCuadrado 27 == False

esCuadrado :: Integer -> Bool

esCuadrado x = y^2 == x

where y = ceiling (sqrt (fromIntegral x))

-- La propiedad es

prop_conjetura :: Int -> Property

prop_conjetura n =

n >= 0 ==> not (esContraejemplo (imparesCompuestosMayore5993 !! n))

where imparesCompuestosMayore5993 = dropWhile (<=5993) imparesCompuestos

-- La comprobación es

-- λ> quickCheck prop_conjetura

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

«Obvio es la palabra más peligrosa de las matemáticas.»

Eric Temple Bell

Triángulo de Bell

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

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

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

1 2

2 3 5

5 7 10 15

15 20 27 37 52

52 67 87 114 151 203

Definir la función

   trianguloDeBell :: [[Integer]]

1	trianguloDeBell :: [[Integer]]

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

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

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

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

Soluciones

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

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

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

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

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

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

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

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

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

import Data.List (genericIndex, genericLength)

import Test.QuickCheck

trianguloDeBell :: [[Integer]]

trianguloDeBell = iterate siguiente [1]

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

-- Bell. Por ejemplo,

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

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

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

siguiente :: [Integer] -> [Integer]

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

-- Propiedad

-- =========

-- La propiedad es

prop_TrianguloDeBell :: Integer -> Property

prop_TrianguloDeBell n =

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

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

-- anterior.

bell :: Integer -> Integer

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

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

particiones [] = [[]]

particiones (x:xs) =

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

where ysss = particiones xs

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

inserta _ [] = []

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

-- La comprobación es

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

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

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

Donald Knuth.

Máximo número de consecutivos iguales al dado

PorJosé A. Alonso 4-febrero-202011-febrero-2020

Definir la función

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

1	maximoConsecutivosIguales :: Eq a => a -> [a] -> Int

tal que (maximoConsecutivosIguales x xs) es el mayor número de elementos consecutivos en xs iguales a x. Por ejemplo,

   maximoConsecutivosIguales 'b' "abbcccbbbd"    ==  3
   maximoConsecutivosIguales 'b' "abbbbcccbbbd"  ==  4
   maximoConsecutivosIguales 'e' "abbcccbbbd"    ==  0

maximoConsecutivosIguales 'b' "abbcccbbbd" == 3

maximoConsecutivosIguales 'b' "abbbbcccbbbd" == 4

maximoConsecutivosIguales 'e' "abbcccbbbd" == 0

Soluciones

import Data.List (group)

maximoConsecutivosIguales :: Eq a => a -> [a] -> Int
maximoConsecutivosIguales x = maximum
                            . (0:)
                            . map length
                            . filter ((== x) . head)
                            . group

import Data.List (group)

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

maximoConsecutivosIguales x = maximum

. (0:)

. map length

. filter ((== x) . head)

. group

Otras soluciones

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

Pensamiento

«La programación de computadoras es un arte, porque aplica el conocimiento
acumulado al mundo, porque requiere habilidad e ingenio, y especialmente
porque produce belleza. Un programador que subconscientemente se ve
a sí mismo como un artista disfrutará con lo que hace y lo hará mejor.»

Donald Knuth.

Acotación del primorial

PorJosé A. Alonso 31-enero-20207-febrero-2020

El primorial de un número natural n es el producto de todos los números primos menores o iguales a n. Por ejemplo, el primorial de 5 es 30 porque el producto de los primos menores o iguales que 5 es

   2 * 3 * 5 = 30

1	2 * 3 * 5 = 30

La propiedad de Erdös de acotación de los primoriales afirma que

Para todo número natural n, su primorial es menor o igual que 4ⁿ.

Definir las funciones

   primorial :: Integer -> Integer
   primoriales :: [Integer]

1 2	primorial :: Integer -> Integer primoriales :: [Integer]

tales que

(primorial n) es el primorial de n. Por ejemplo,

     primorial 3  ==  6
     primorial 5  ==  30
     primorial 8  ==  210

primorial 3 == 6

primorial 5 == 30

primorial 8 == 210

primoriales es la sucesión de los primoriales. Por ejemplo,

   λ> take 15 primoriales
   [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]

1 2	λ> take 15 primoriales [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]

Comprobar con QuickCheck la propiedad de Erdös de acotación de los primoriales.

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck

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

primorial :: Integer -> Integer
primorial n = product (takeWhile (<= n) primes)

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

primorial2 :: Integer -> Integer
primorial2 0 = 1
primorial2 n | gcd n x == 1 = n*x
             | otherwise    = x
  where x = primorial2 (n-1)

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

--    λ> length (show (primorial (5*10^5)))
--    216852
--    (1.65 secs, 2,472,977,584 bytes)
--    λ> length (show (primorial2 (5*10^5)))
--    216852
--    (3.56 secs, 2,719,162,272 bytes)

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

--    λ> take 15 primoriales
--    [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]
primoriales :: [Integer]
primoriales = map primorial [0..]

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

--    λ> take 15 primoriales2
--    [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]
primoriales2 :: [Integer]
primoriales2 = map primorial2 [0..]

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

--    λ> take 15 primoriales3
--    [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]
primoriales3 :: [Integer]
primoriales3 = scanl1 f [1..]
  where f x n | gcd n x == 1 = n*x
              | otherwise    = x

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

--    λ> minimum (take 5000 primoriales)
--    1
--    (1.56 secs, 4,857,760,464 bytes)
--    λ> minimum (take 5000 primoriales2)
--    1
--    (9.39 secs, 10,942,848,240 bytes)
--    λ> minimum (take 5000 primoriales3)
--    1
--    (0.01 secs, 5,575,024 bytes)
--    
--    λ> minimum (take 6000 primoriales)
--    1
--    (2.22 secs, 7,013,937,248 bytes)
--    λ> minimum (take 6000 primoriales3)
--    1
--    (0.01 secs, 6,737,328 bytes)

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

prop_primorial :: Integer -> Property
prop_primorial n =
  n >= 0 ==> primorial n <= 4^n

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

import Data.Numbers.Primes

import Test.QuickCheck

-- 1ª definición de primorial

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

primorial :: Integer -> Integer

primorial n = product (takeWhile (<= n) primes)

-- 2ª definición de primorial

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

primorial2 :: Integer -> Integer

primorial2 0 = 1

primorial2 n | gcd n x == 1 = n*x

| otherwise = x

where x = primorial2 (n-1)

-- Comparación de eficiencia

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

-- λ> length (show (primorial (5*10^5)))

-- 216852

-- (1.65 secs, 2,472,977,584 bytes)

-- λ> length (show (primorial2 (5*10^5)))

-- 216852

-- (3.56 secs, 2,719,162,272 bytes)

-- 1ª definición de primoriales

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

-- λ> take 15 primoriales

-- [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]

primoriales :: [Integer]

primoriales = map primorial [0..]

-- 2ª definición de primoriales

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

-- λ> take 15 primoriales2

-- [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]

primoriales2 :: [Integer]

primoriales2 = map primorial2 [0..]

-- 3ª definición de primoriales

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

-- λ> take 15 primoriales3

-- [1,1,2,6,6,30,30,210,210,210,210,2310,2310,30030,30030]

primoriales3 :: [Integer]

primoriales3 = scanl1 f [1..]

where f x n | gcd n x == 1 = n*x

| otherwise = x

-- Comparación de eficiencia

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

-- λ> minimum (take 5000 primoriales)

-- 1

-- (1.56 secs, 4,857,760,464 bytes)

-- λ> minimum (take 5000 primoriales2)

-- 1

-- (9.39 secs, 10,942,848,240 bytes)

-- λ> minimum (take 5000 primoriales3)

-- 1

-- (0.01 secs, 5,575,024 bytes)

-- λ> minimum (take 6000 primoriales)

-- 1

-- (2.22 secs, 7,013,937,248 bytes)

-- λ> minimum (take 6000 primoriales3)

-- 1

-- (0.01 secs, 6,737,328 bytes)

-- Propiedad

-- =========

prop_primorial :: Integer -> Property

prop_primorial n =

n >= 0 ==> primorial n <= 4^n

-- La comprobación es

-- λ> quickCheck prop_primorial

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

«Las matemáticas son la reina de las ciencias y la teoría de los números es la reina de las matemáticas.»

Carl Friedrich Gauss.

Longitud de la parte periódica

PorJosé A. Alonso 30-enero-202026-marzo-2022

La propiedad de la longitud de la parte periódica afirma que

Si p es un número primo distinto de 2 y de 5, entonces la longitud del período de 1/p es el menor entero positivo n tal que p divide a $10^n - 1$ .

El objetivo de este ejercicio es la verificación de dicha propiedad.

Las fracciones se representan por un par de enteros. Por ejemplo, el número 2/3 se representa por (2,3). Su tipo es

   type Fraccion = (Integer,Integer)

1	type Fraccion = (Integer,Integer)

Los números decimales se representan por ternas, donde el primer elemento es la parte entera, el segundo es el anteperíodo y el tercero es el período. Por ejemplo,

 6/2  = 3                  se representa por (3,[],[])
 1/2  = 0.5                se representa por (0,[5],[])
 1/3  = 0.333333...        se representa por (0,[],[3])  
23/14 = 1.6428571428571... se representa por (1,[6],[4,2,8,5,7,1])

6/2 = 3 se representa por (3,[],[])

1/2 = 0.5 se representa por (0,[5],[])

1/3 = 0.333333... se representa por (0,[],[3])

23/14 = 1.6428571428571... se representa por (1,[6],[4,2,8,5,7,1])

Su tipo es

   type Decimal = (Integer,[Integer],[Integer])

1	type Decimal = (Integer,[Integer],[Integer])

Definir, usando las funciones cocientesRestos y primerRepetido de los ejercicios anteriores, las funciones

   decimal :: Fraccion -> Decimal
   longitudPeriodo :: Fraccion -> Integer

1 2	decimal :: Fraccion -> Decimal longitudPeriodo :: Fraccion -> Integer

tales que

(decimal f) es la representación decimal de la fracción f. Por ejemplo,

     decimal (6,2)          ==  (3,[],[])
     decimal (3,4)          ==  (0,[7,5],[])
     decimal (1,3)          ==  (0,[],[3])
     decimal (23,14)        ==  (1,[6],[4,2,8,5,7,1])
     decimal (247813,19980) ==  (12,[4,0],[3,0,5])
     decimal (1,101)        ==  (0,[],[0,0,9,9])

decimal (6,2) == (3,[],[])

decimal (3,4) == (0,[7,5],[])

decimal (1,3) == (0,[],[3])

decimal (23,14) == (1,[6],[4,2,8,5,7,1])

decimal (247813,19980) == (12,[4,0],[3,0,5])

decimal (1,101) == (0,[],[0,0,9,9])

(longitudPeriodo f) es la longitud de la parte periódica de la representación decimal de la fracción f. Por ejemplo,

     longitudPeriodo (6,2)           ==  0
     longitudPeriodo (3,4)           ==  0
     longitudPeriodo (1,3)           ==  1
     longitudPeriodo (23,14)         ==  6
     longitudPeriodo (247813,19980)  ==  3
     longitudPeriodo (1,101)         ==  4
     longitudPeriodo (1,1229)        ==  1228

longitudPeriodo (6,2) == 0

longitudPeriodo (3,4) == 0

longitudPeriodo (1,3) == 1

longitudPeriodo (23,14) == 6

longitudPeriodo (247813,19980) == 3

longitudPeriodo (1,101) == 4

longitudPeriodo (1,1229) == 1228

Comprobar con QuickCheck la propiedad de la longitud de la parte periódica; es decir, k es un número natural distinto de 0 y 2 y p es el primo k-ésimo, entonces la longitud del período de 1/p es el menor entero positivo n tal que p divide a $10^n - 1$ ..

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck

type Fraccion = (Integer,Integer)
type Decimal = (Integer,[Integer],[Integer])

decimal :: Fraccion -> Decimal
decimal (n,d) 
  | snd y == 0 = (fst x, map fst xs, [])
  | otherwise  = (fst x, map fst xs, map fst (y:zs))
  where
    qrs         = cocientesRestos (n,d)
    Just (q,r)  = primerRepetido qrs
    (x:xs,y:ys) = break (==(q,r)) qrs
    zs          = takeWhile (/=(q,r)) ys

cocientesRestos :: Fraccion -> [(Integer,Integer)]
cocientesRestos (n,d) =
  (q,r) : cocientesRestos (10*r, d)
  where (q,r) = quotRem n d

primerRepetido :: Eq a => [a] -> Maybe a
primerRepetido xs = aux xs []
  where
    aux [] _                     = Nothing
    aux (x:xs') ys | x `elem` ys = Just x
                   | otherwise   = aux xs' (x:ys) 

longitudPeriodo :: Fraccion -> Int
longitudPeriodo (n,d) = length xs
  where (_,_,xs) = decimal (n,d)

-- La propiedad es
prop_LongitudPeriodo :: Int -> Property
prop_LongitudPeriodo k =
  k > 0 && k /= 2 
  ==>
  longitudPeriodo (1,p) ==
  head [n | n <- [1..], (10^n-1) `mod` p == 0]
  where p = primes !! k

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

import Data.Numbers.Primes

import Test.QuickCheck

type Fraccion = (Integer,Integer)

type Decimal = (Integer,[Integer],[Integer])

decimal :: Fraccion -> Decimal

decimal (n,d)

| snd y == 0 = (fst x, map fst xs, [])

| otherwise = (fst x, map fst xs, map fst (y:zs))

where

qrs = cocientesRestos (n,d)

Just (q,r) = primerRepetido qrs

(x:xs,y:ys) = break (==(q,r)) qrs

zs = takeWhile (/=(q,r)) ys

cocientesRestos :: Fraccion -> [(Integer,Integer)]

cocientesRestos (n,d) =

(q,r) : cocientesRestos (10*r, d)

where (q,r) = quotRem n d

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

primerRepetido xs = aux xs []

where

aux [] _ = Nothing

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

| otherwise = aux xs' (x:ys)

longitudPeriodo :: Fraccion -> Int

longitudPeriodo (n,d) = length xs

where (_,_,xs) = decimal (n,d)

-- La propiedad es

prop_LongitudPeriodo :: Int -> Property

prop_LongitudPeriodo k =

k > 0 && k /= 2

==>

longitudPeriodo (1,p) ==

head [n | n <- [1..], (10^n-1) `mod` p == 0]

where p = primes !! k

-- La comprobación es

-- λ> quickCheck prop_LongitudPeriodo

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

«En el desarrollo de la comprensión de los fenómenos complejos, la herramienta más poderosa de que dispone el intelecto humano es la abstracción. La abstracción surge del reconocimiento de las similitudes entre ciertos objetos, situaciones o procesos en el mundo real y de la decisión de concentrarse en estas similitudes e ignorar, por el momento, sus diferencias.»

Tony Hoare

La conjetura de Mertens

PorJosé A. Alonso 27-enero-20203-febrero-2020

Un número entero n es libre de cuadrados si no existe un número primo p tal que p² divide a n; es decir, los factores primos de n son todos distintos.

La función de Möbius μ(n) está definida para todos los enteros positivos como sigue:

μ(n) = 1 si n es libre de cuadrados y tiene un número par de factores primos.
μ(n) = -1 si n es libre de cuadrados y tiene un número impar de factores primos.
μ(n) = 0 si n no es libre de cuadrados.

Sus primeros valores son 1, -1, -1, 0, -1, 1, -1, 0, 0, 1, …

La función de Mertens M(n) está definida para todos los enteros positivos como la suma de μ(k) para 1 ≤ k ≤ n. Sus primeros valores son 1, 0, -1, -1, -2, -1, -2, -2, …

La conjetura de Mertens afirma que

Para todo entero x mayor que 1, el valor absoluto de la función de Mertens en x es menor que la raíz cuadrada de x.

La conjetura fue planteada por Franz Mertens en 1897. Riele Odlyzko, demostraronen 1985 que la conjetura de Mertens deja de ser cierta más o menos a partir de $10^{10^{64}}$ , cifra que luego de algunos refinamientos se redujo a $10^{10^{40}}$ .

Definir las funciones

   mobius :: Integer -> Integer
   mertens :: Integer -> Integer
   graficaMertens :: Integer -> IO ()

mobius :: Integer -> Integer

mertens :: Integer -> Integer

graficaMertens :: Integer -> IO ()

tales que

(mobius n) es el valor de la función de Möbius en n. Por ejemplo,

     mobius 6   ==  1
     mobius 30  ==  -1
     mobius 12  ==  0

mobius 6 == 1

mobius 30 == -1

mobius 12 == 0

(mertens n) es el valor de la función de Mertens en n. Por ejemplo,

     mertens 1     ==  1
     mertens 2     ==  0
     mertens 3     ==  -1
     mertens 5     ==  -2
     mertens 661   ==  -11
     mertens 1403  ==  11

mertens 1 == 1

mertens 2 == 0

mertens 3 == -1

mertens 5 == -2

mertens 661 == -11

mertens 1403 == 11

(graficaMertens n) dibuja la gráfica de la función de Mertens, la raíz cuadrada y el opuestos de la raíz cuadrada para los n primeros n enteros positivos. Por ejemplo, (graficaMertens 1000) dibuja

Comprobar con QuickCheck la conjetura de Mertens.

Nota: El ejercicio está basado en La conjetura de Merterns y su relación con un número tan raro como extremada y colosalmente grande publicado por @Alvy la semana pasada en Microsiervos.

Soluciones

import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck
import Graphics.Gnuplot.Simple

mobius :: Integer -> Integer
mobius n | tieneRepetidos xs = 0
         | otherwise         = (-1)^(length xs)
  where xs = primeFactors n

tieneRepetidos :: [Integer] -> Bool
tieneRepetidos xs =
  or [x == y | (x,y) <- zip xs (tail xs)]
        
mertens :: Integer -> Integer
mertens n = sum (map mobius [1..n])

-- Definición de graficaMertens
-- ============================

graficaMertens :: Integer -> IO ()
graficaMertens n = do
  plotLists [ Key Nothing
            , Title "Conjetura de Mertens"
            , PNG "La_conjetura_de_Mertens.png"
            ]
            [ [mertens k | k <- [1..n]]
            , raices
            , map negate raices
            ]
    
  where
    raices = [ceiling (sqrt k) | k <- [1..fromIntegral n]]

-- Conjetura de Mertens
-- ====================

-- La conjetura es
conjeturaDeMertens :: Integer -> Property
conjeturaDeMertens n =
  n > 1
  ==>
  abs (mertens n) < ceiling (sqrt n')
  where n' = fromIntegral n

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

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

import Graphics.Gnuplot.Simple

mobius :: Integer -> Integer

mobius n | tieneRepetidos xs = 0

| otherwise = (-1)^(length xs)

where xs = primeFactors n

tieneRepetidos :: [Integer] -> Bool

tieneRepetidos xs =

or [x == y | (x,y) <- zip xs (tail xs)]

mertens :: Integer -> Integer

mertens n = sum (map mobius [1..n])

-- Definición de graficaMertens

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

graficaMertens :: Integer -> IO ()

graficaMertens n = do

plotLists [ Key Nothing

, Title "Conjetura de Mertens"

, PNG "La_conjetura_de_Mertens.png"

]

[ [mertens k | k <- [1..n]]

, raices

, map negate raices

]

where

raices = [ceiling (sqrt k) | k <- [1..fromIntegral n]]

-- Conjetura de Mertens

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

-- La conjetura es

conjeturaDeMertens :: Integer -> Property

conjeturaDeMertens n =

n > 1

==>

abs (mertens n) < ceiling (sqrt n')

where n' = fromIntegral n

-- La comprobación es

-- λ> quickCheck conjeturaDeMertens

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

«El control de la complejidad es la esencia de la programación informática.»

Brian Kernighan.