Medio – Página 4 – Exercitium

Combinaciones divisibles

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

Definir la función

   tieneCombinacionDivisible :: [Int] -> Int -> Bool

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

tal que (tieneCombinacionDivisible xs m) se verifica si existe alguna forma de combinar todos los elementos de la lista (con las operaciones suma o resta) de forma que el resultado sea divisible por m. Por ejemplo,

   tieneCombinacionDivisible [1,3,4,6] 4  ==  True
   tieneCombinacionDivisible [1,3,9]   2  ==  False

1 2	tieneCombinacionDivisible [1,3,4,6] 4 == True tieneCombinacionDivisible [1,3,9] 2 == False

En el primer ejemplo, 1 – 2 + 3 + 4 + 6 = 12 es una combinación divisible por 4. En el segundo ejemplo, las combinaciones de [1,3,9] son

   1 + 3 + 9 =  13
  -1 + 3 + 9 =  11
   1 - 3 + 9 =   7
  -1 - 3 + 9 =   5
   1 + 3 - 9 =  -5
  -1 + 3 - 9 =  -7
   1 - 3 - 9 = -11
  -1 - 3 - 9 = -13

1 + 3 + 9 = 13

-1 + 3 + 9 = 11

1 - 3 + 9 = 7

-1 - 3 + 9 = 5

1 + 3 - 9 = -5

-1 + 3 - 9 = -7

1 - 3 - 9 = -11

-1 - 3 - 9 = -13

y ninguna de las 4 es divisible por 2.

Soluciones

import Test.QuickCheck

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

tieneCombinacionDivisible :: [Int] -> Int -> Bool
tieneCombinacionDivisible xs m =
  any esDivisible (valoresCombinaciones xs)
  where esDivisible x = x `mod` m == 0

-- (valoresCombinaciones xs) es la lista de los valores de todas las
-- combinaciones de todos los elementos de la lista con las operaciones
-- suma o resta. Por ejemplo,
--    λ> valoresCombinaciones [1,3,4,6]
--    [14,12,8,6,6,4,0,-2,2,0,-4,-6,-6,-8,-12,-14]
--    λ> valoresCombinaciones [1,3,-4,6]
--    [6,4,0,-2,14,12,8,6,-6,-8,-12,-14,2,0,-4,-6]
valoresCombinaciones :: [Int] -> [Int]
valoresCombinaciones []     = []
valoresCombinaciones [x]    = [x,-x]
valoresCombinaciones (x:xs) = concat [[y + x, y - x] | y <- ys]
  where ys = valoresCombinaciones xs

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

tieneCombinacionDivisible2 :: [Int] -> Int -> Bool
tieneCombinacionDivisible2 xs m =
  tieneCombinacionCongruente xs m 0

-- (tieneCombinacionCongruente xs m a) se verifica si existe alguna
-- forma de combinar todos los elementos de la lista xs (con las
-- operaciones suma o resta) de forma que el resultado sea congruente
-- con a módulo m. Por ejemplo,
--    tieneCombinacionCongruente [1,3,4,6] 4 0  ==  True
--    tieneCombinacionCongruente [1,3,4,6] 4 1  ==  False
--    tieneCombinacionCongruente [1,3,9] 2 0    ==  False
--    tieneCombinacionCongruente [1,3,9] 2 1    ==  True
tieneCombinacionCongruente :: [Int] -> Int -> Int -> Bool
tieneCombinacionCongruente []  _  _ = False
tieneCombinacionCongruente [x] m  a = (x - a) `mod` m == 0
tieneCombinacionCongruente (x:xs) m a =
  tieneCombinacionCongruente xs m (a-x) ||
  tieneCombinacionCongruente xs m (a+x)

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

-- La propiedad es
prop_tieneCombinacionDivisible :: [Int] -> Positive Int -> Bool
prop_tieneCombinacionDivisible xs (Positive m) =
  tieneCombinacionDivisible xs m == tieneCombinacionDivisible2 xs m

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

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

--    λ> (n,xs,m) = (200,[-n..n],sum [1..n]) 
--    (0.00 secs, 0 bytes)
--    λ> and [tieneCombinacionDivisible xs a | a <- [1..m]]
--    True
--    (4.74 secs, 6,536,494,976 bytes)
--    λ> and [tieneCombinacionDivisible2 xs a | a <- [1..m]]
--    True
--    (2.97 secs, 3,381,932,664 bytes)

import Test.QuickCheck

-- 1ª solución

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

tieneCombinacionDivisible :: [Int] -> Int -> Bool

tieneCombinacionDivisible xs m =

any esDivisible (valoresCombinaciones xs)

where esDivisible x = x `mod` m == 0

-- (valoresCombinaciones xs) es la lista de los valores de todas las

-- combinaciones de todos los elementos de la lista con las operaciones

-- suma o resta. Por ejemplo,

-- λ> valoresCombinaciones [1,3,4,6]

-- [14,12,8,6,6,4,0,-2,2,0,-4,-6,-6,-8,-12,-14]

-- λ> valoresCombinaciones [1,3,-4,6]

-- [6,4,0,-2,14,12,8,6,-6,-8,-12,-14,2,0,-4,-6]

valoresCombinaciones :: [Int] -> [Int]

valoresCombinaciones [] = []

valoresCombinaciones [x] = [x,-x]

valoresCombinaciones (x:xs) = concat [[y + x, y - x] | y <- ys]

where ys = valoresCombinaciones xs

-- 2ª solución

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

tieneCombinacionDivisible2 :: [Int] -> Int -> Bool

tieneCombinacionDivisible2 xs m =

tieneCombinacionCongruente xs m 0

-- (tieneCombinacionCongruente xs m a) se verifica si existe alguna

-- forma de combinar todos los elementos de la lista xs (con las

-- operaciones suma o resta) de forma que el resultado sea congruente

-- con a módulo m. Por ejemplo,

-- tieneCombinacionCongruente [1,3,4,6] 4 0 == True

-- tieneCombinacionCongruente [1,3,4,6] 4 1 == False

-- tieneCombinacionCongruente [1,3,9] 2 0 == False

-- tieneCombinacionCongruente [1,3,9] 2 1 == True

tieneCombinacionCongruente :: [Int] -> Int -> Int -> Bool

tieneCombinacionCongruente [] _ _ = False

tieneCombinacionCongruente [x] m a = (x - a) `mod` m == 0

tieneCombinacionCongruente (x:xs) m a =

tieneCombinacionCongruente xs m (a-x) ||

tieneCombinacionCongruente xs m (a+x)

-- Equivalencia

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

-- La propiedad es

prop_tieneCombinacionDivisible :: [Int] -> Positive Int -> Bool

prop_tieneCombinacionDivisible xs (Positive m) =

tieneCombinacionDivisible xs m == tieneCombinacionDivisible2 xs m

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=25}) prop_tieneCombinacionDivisible

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> (n,xs,m) = (200,[-n..n],sum [1..n])

-- (0.00 secs, 0 bytes)

-- λ> and [tieneCombinacionDivisible xs a | a <- [1..m]]

-- True

-- (4.74 secs, 6,536,494,976 bytes)

-- λ> and [tieneCombinacionDivisible2 xs a | a <- [1..m]]

-- True

-- (2.97 secs, 3,381,932,664 bytes)

Pensamiento

El que espera desespera,
dice la voz popular.
¡Qué verdad tan verdadera!
La verdad es lo que es,
y sigue siendo verdad
aunque se piense al revés.

Antonio Machado

Número de particiones de un conjunto

PorJosé A. Alonso 27-febrero-20196-marzo-2019

Una partición de un conjunto A es un conjunto de subconjuntos no vacíos de A, disjuntos dos a dos y cuya unión es A. Por ejemplo, el conjunto {1, 2, 3} tiene exactamente 5 particiones:

   {{1}, {2}, {3}}
   {{1,2}, {3}}
   {{1,3}, {2}}
   {{1}, {2,3}}
   {{1,2,3}}

{{1}, {2}, {3}}

{{1,2}, {3}}

{{1,3}, {2}}

{{1}, {2,3}}

Definir la función

   nParticiones :: [a] -> Integer

1	nParticiones :: [a] -> Integer

tal que (nParticiones xs) es el número de particiones de xs. Por ejemplo,

   nParticiones [1,2]                     ==  2
   nParticiones [1,2,3]                   ==  5
   nParticiones "abcd"                    ==  15
   length (show (nParticiones [1..500]))  ==  844

nParticiones [1,2] == 2

nParticiones [1,2,3] == 5

nParticiones "abcd" == 15

length (show (nParticiones [1..500])) == 844

Soluciones

import Data.List  ( genericLength
                  )
import Data.Array ( Array
                  , (!)
                  , array
                  )

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

nParticiones :: [a] -> Integer
nParticiones xs =
  genericLength (particiones xs)

-- (particiones xs) es el conjunto de las particiones de xs. Por
-- ejemplo, 
--    λ> particiones [1,2]
--    [[[1,2]],[[1],[2]]]
--    λ> particiones [1,2,3]
--    [[[1,2,3]],[[1],[2,3]],[[1,2],[3]],[[2],[1,3]],[[1],[2],[3]]]
particiones :: [a] -> [[[a]]]
particiones [] = [[]]
particiones xs =
  concat [particionesFijas xs k | k <- [0..length xs]]

-- (particionesFijas xs k) es el conjunto de las particiones de xs en k
-- subconjuntos. Por ejemplo,
--    particionesFijas [1,2,3] 0  ==  []
--    particionesFijas [1,2,3] 1  ==  [[[1,2,3]]]
--    particionesFijas [1,2,3] 2  ==  [[[1],[2,3]],[[1,2],[3]],[[2],[1,3]]]
--    particionesFijas [1,2,3] 3  ==  [[[1],[2],[3]]]
--    particionesFijas [1,2,3] 4  ==  []
particionesFijas :: [a] -> Int -> [[[a]]]
particionesFijas [] _ = []
particionesFijas xs 1 = [[xs]]
particionesFijas (x:xs) k =
   [[x]:ys | ys <- particionesFijas xs (k-1)] ++
   concat [inserta x ys | ys <- particionesFijas xs k]

-- (inserta x yss) es la lista obtenida insertando x en cada uno de los
-- elementos de yss. Por ejemplo, 
--    λ> inserta 1 [[2,3],[4],[5,6,7]]
--    [[[1,2,3],[4],[5,6,7]],[[2,3],[1,4],[5,6,7]],[[2,3],[4],[1,5,6,7]]]
inserta :: a -> [[a]] -> [[[a]]]
inserta _ []       = []
inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss] 

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

nParticiones2 :: [a] -> Integer
nParticiones2 xs = sum [nParticionesFijas n k | k <- [0..n]]
  where n = genericLength xs

-- nPparticionesFijas n k) es el número de las particiones de un
-- conjunto con n elementos en k subconjuntos. Por ejemplo,
--    nParticionesFijas 3 0  ==  0
--    nParticionesFijas 3 1  ==  1
--    nParticionesFijas 3 2  ==  3
--    nParticionesFijas 3 3  ==  1
--    nParticionesFijas 3 4  ==  0
nParticionesFijas :: Integer -> Integer -> Integer
nParticionesFijas 0 0 = 1
nParticionesFijas 0 _ = 0
nParticionesFijas n 1 = 1
nParticionesFijas n k = nParticionesFijas (n-1) (k-1) + k * nParticionesFijas (n-1) k

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

nParticiones3 :: [a] -> Integer
nParticiones3 xs = sum [a ! (n,k) | k <- [0..n]]
  where n = genericLength xs
        a = matrizNParticiones n

-- (matrizNParticiones n) es la matriz de dimensión ((0,0),(n,n)) que en
-- la posición (i,j) tiene el número de particiones de un conjunto de i
-- elementos en j subconjuntos. Por ejemplo,
--    λ> matrizNParticiones 3
--    array ((0,0),(3,3))
--          [((0,0),0),((0,1),0),((0,2),0),((0,3),0),
--           ((1,0),0),((1,1),1),((1,2),0),((1,3),0),
--           ((2,0),0),((2,1),1),((2,2),1),((2,3),0),
--           ((3,0),0),((3,1),1),((3,2),3),((3,3),1)]
--    λ> matrizNParticiones 4
--    array ((0,0),(4,4))
--          [((0,0),0),((0,1),0),((0,2),0),((0,3),0),((0,4),0),
--           ((1,0),0),((1,1),1),((1,2),0),((1,3),0),((1,4),0),
--           ((2,0),0),((2,1),1),((2,2),1),((2,3),0),((2,4),0),
--           ((3,0),0),((3,1),1),((3,2),3),((3,3),1),((3,4),0),
--           ((4,0),0),((4,1),1),((4,2),7),((4,3),6),((4,4),1)]
matrizNParticiones :: Integer -> Array (Integer,Integer) Integer
matrizNParticiones n = a 
  where
    a = array ((0,0),(n,n)) [((i,j), f i j) | i <- [0..n], j <- [0..n]]
    f 0 0 = 1
    f 0 _ = 0
    f _ 0 = 0
    f _ 1 = 1
    f i j = a ! (i-1,j-1) + j * a ! (i-1,j)

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

nParticiones4 :: [a] -> Integer
nParticiones4 xs = sum [a ! (n,k) | k <- [0..n]]
  where
    n = genericLength xs
    a = array ((0,0),(n,n)) [((i,j), f i j) | i <- [0..n], j <- [0..n]]
    f 0 0 = 1
    f 0 _ = 0
    f _ 0 = 0
    f _ 1 = 1
    f i j = a ! (i-1,j-1) + j * a ! (i-1,j)

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

--    λ> nParticiones [1..11]
--    678570
--    (3.77 secs, 705,537,480 bytes)
--    λ> nParticiones2 [1..11]
--    678570
--    (0.07 secs, 6,656,584 bytes)
--    λ> nParticiones3 [1..11]
--    678570
--    (0.01 secs, 262,176 bytes)
--    λ> nParticiones4 [1..11]
--    678570
--    (0.01 secs, 262,264 bytes)
--    
--    λ> nParticiones2 [1..16]
--    10480142147
--    (2.24 secs, 289,774,408 bytes)
--    λ> nParticiones3 [1..16]
--    10480142147
--    (0.01 secs, 437,688 bytes)
--    λ> nParticiones4 [1..16]
--    10480142147
--    (0.01 secs, 437,688 bytes)
--    
--    λ> length (show (nParticiones3 [1..500]))
--    844
--    (2.23 secs, 357,169,528 bytes)
--    λ> length (show (nParticiones4 [1..500]))
--    844
--    (2.20 secs, 357,172,680 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

import Data.List ( genericLength

)

import Data.Array ( Array

, (!)

, array

)

-- 1ª definición

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

nParticiones :: [a] -> Integer

nParticiones xs =

genericLength (particiones xs)

-- (particiones xs) es el conjunto de las particiones de xs. Por

-- ejemplo,

-- λ> particiones [1,2]

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

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

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

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

particiones [] = [[]]

particiones xs =

concat [particionesFijas xs k | k <- [0..length xs]]

-- (particionesFijas xs k) es el conjunto de las particiones de xs en k

-- subconjuntos. Por ejemplo,

-- particionesFijas [1,2,3] 0 == []

-- particionesFijas [1,2,3] 1 == [[[1,2,3]]]

-- particionesFijas [1,2,3] 2 == [[[1],[2,3]],[[1,2],[3]],[[2],[1,3]]]

-- particionesFijas [1,2,3] 3 == [[[1],[2],[3]]]

-- particionesFijas [1,2,3] 4 == []

particionesFijas :: [a] -> Int -> [[[a]]]

particionesFijas [] _ = []

particionesFijas xs 1 = [[xs]]

particionesFijas (x:xs) k =

[[x]:ys | ys <- particionesFijas xs (k-1)] ++

concat [inserta x ys | ys <- particionesFijas xs k]

-- (inserta x yss) es la lista obtenida insertando x en cada uno de los

-- elementos de yss. Por ejemplo,

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

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

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

inserta _ [] = []

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

-- 2ª definición

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

nParticiones2 :: [a] -> Integer

nParticiones2 xs = sum [nParticionesFijas n k | k <- [0..n]]

where n = genericLength xs

-- nPparticionesFijas n k) es el número de las particiones de un

-- conjunto con n elementos en k subconjuntos. Por ejemplo,

-- nParticionesFijas 3 0 == 0

-- nParticionesFijas 3 1 == 1

-- nParticionesFijas 3 2 == 3

-- nParticionesFijas 3 3 == 1

-- nParticionesFijas 3 4 == 0

nParticionesFijas :: Integer -> Integer -> Integer

nParticionesFijas 0 0 = 1

nParticionesFijas 0 _ = 0

nParticionesFijas n 1 = 1

nParticionesFijas n k = nParticionesFijas (n-1) (k-1) + k * nParticionesFijas (n-1) k

-- 3ª definición

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

nParticiones3 :: [a] -> Integer

nParticiones3 xs = sum [a ! (n,k) | k <- [0..n]]

where n = genericLength xs

a = matrizNParticiones n

-- (matrizNParticiones n) es la matriz de dimensión ((0,0),(n,n)) que en

-- la posición (i,j) tiene el número de particiones de un conjunto de i

-- elementos en j subconjuntos. Por ejemplo,

-- λ> matrizNParticiones 3

-- array ((0,0),(3,3))

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

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

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

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

-- λ> matrizNParticiones 4

-- array ((0,0),(4,4))

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

-- ((1,0),0),((1,1),1),((1,2),0),((1,3),0),((1,4),0),

-- ((2,0),0),((2,1),1),((2,2),1),((2,3),0),((2,4),0),

-- ((3,0),0),((3,1),1),((3,2),3),((3,3),1),((3,4),0),

-- ((4,0),0),((4,1),1),((4,2),7),((4,3),6),((4,4),1)]

matrizNParticiones :: Integer -> Array (Integer,Integer) Integer

matrizNParticiones n = a

where

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

f 0 0 = 1

f 0 _ = 0

f _ 0 = 0

f _ 1 = 1

f i j = a ! (i-1,j-1) + j * a ! (i-1,j)

-- 4ª definición

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

nParticiones4 :: [a] -> Integer

nParticiones4 xs = sum [a ! (n,k) | k <- [0..n]]

where

n = genericLength xs

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

f 0 0 = 1

f 0 _ = 0

f _ 0 = 0

f _ 1 = 1

f i j = a ! (i-1,j-1) + j * a ! (i-1,j)

-- Comparación de eficiencia

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

-- λ> nParticiones [1..11]

-- 678570

-- (3.77 secs, 705,537,480 bytes)

-- λ> nParticiones2 [1..11]

-- 678570

-- (0.07 secs, 6,656,584 bytes)

-- λ> nParticiones3 [1..11]

-- 678570

-- (0.01 secs, 262,176 bytes)

-- λ> nParticiones4 [1..11]

-- 678570

-- (0.01 secs, 262,264 bytes)

-- λ> nParticiones2 [1..16]

-- 10480142147

-- (2.24 secs, 289,774,408 bytes)

-- λ> nParticiones3 [1..16]

-- 10480142147

-- (0.01 secs, 437,688 bytes)

-- λ> nParticiones4 [1..16]

-- 10480142147

-- (0.01 secs, 437,688 bytes)

-- λ> length (show (nParticiones3 [1..500]))

-- 844

-- (2.23 secs, 357,169,528 bytes)

-- λ> length (show (nParticiones4 [1..500]))

-- 844

-- (2.20 secs, 357,172,680 bytes)

Pensamiento

Yo he visto garras fieras en las pulidas manos;
conozco grajos mélicos y líricos marranos …
El más truhán se lleva la mano al corazón,
y el bruto más espeso se carga de razón.

Antonio Machado

Mayor exponente

PorJosé A. Alonso 20-febrero-201927-febrero-2019

Definir las funciones

   mayorExponente        :: Integer -> Integer
   graficaMayorExponente :: Integer -> IO ()

1 2	mayorExponente :: Integer -> Integer graficaMayorExponente :: Integer -> IO ()

tales que

(mayorExponente n) es el mayor número b para el que existe un a tal que n = a^b. Se supone que n > 1. Por ejemplo,

     mayorExponente 9   ==  2
     mayorExponente 8   ==  3
     mayorExponente 7   ==  1
     mayorExponente 18  ==  1
     mayorExponente 36  ==  2
     mayorExponente (10^(10^5))  ==  100000

mayorExponente 9 == 2

mayorExponente 8 == 3

mayorExponente 7 == 1

mayorExponente 18 == 1

mayorExponente 36 == 2

mayorExponente (10^(10^5)) == 100000

(graficaMayorExponente n) dibuja la gráfica de los mayores exponentes de los números entre 2 y n. Por ejemplo, (graficaMayorExponente 50) dibuja

Soluciones

import Data.List (genericLength, group)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck
import Graphics.Gnuplot.Simple


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

mayorExponente :: Integer -> Integer
mayorExponente x =
  last [b | b <- [1..x]
          , a <- [1..x]
          , a^b == x]

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

mayorExponente2 :: Integer -> Integer
mayorExponente2 x =
  head [b | b <- [x,x-1..1]
          , a <- [1..x]
          , a^b == x]

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

mayorExponente3 :: Integer -> Integer
mayorExponente3 x = aux x
  where aux 1 = 1
        aux b | any (\a -> a^b == x) [1..x] = b
              | otherwise                   = aux (b-1)

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

mayorExponente4 :: Integer -> Integer
mayorExponente4 x =
  mcd (exponentes x)

-- (exponentes x) es la lista de los exponentes en la factorizacioń de
-- x. por ejemplo.
--    exponentes 720  ==  [4,2,1]
exponentes :: Integer -> [Integer]
exponentes x =
  map genericLength (group (primeFactors x))

-- (mcd xs) es el máximo común divisor de xs. Por ejemplo,
--    mcd [4,6,10]  ==  2
mcd :: [Integer] -> Integer
mcd = foldr1 gcd

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

-- La propiedad es
prop_mayorExponente :: Integer -> Property
prop_mayorExponente n =
  n >= 0 ==>
  mayorExponente  n == mayorExponente2 n &&
  mayorExponente2 n == mayorExponente3 n

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

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

--    λ> mayorExponente (10^3)
--    3
--    (3.96 secs, 4,671,928,464 bytes)
--    λ> mayorExponente2 (10^3)
--    3
--    (3.99 secs, 4,670,107,024 bytes)
--    λ> mayorExponente3 (10^3)
--    3
--    (3.90 secs, 4,686,383,952 bytes)
--    λ> mayorExponente4 (10^3)
--    3
--    (0.02 secs, 131,272 bytes)

-- Definición de graficaMayorExponente
-- ======================================

graficaMayorExponente :: Integer -> IO ()
graficaMayorExponente n = 
  plotList [ Key Nothing
           , PNG ("MayorExponente.png")
           ]
           (map mayorExponente3 [2..n])

import Data.List (genericLength, group)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- 1ª solución

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

mayorExponente :: Integer -> Integer

mayorExponente x =

last [b | b <- [1..x]

, a <- [1..x]

, a^b == x]

-- 2ª solución

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

mayorExponente2 :: Integer -> Integer

mayorExponente2 x =

head [b | b <- [x,x-1..1]

, a <- [1..x]

, a^b == x]

-- 3ª solución

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

mayorExponente3 :: Integer -> Integer

mayorExponente3 x = aux x

where aux 1 = 1

aux b | any (\a -> a^b == x) [1..x] = b

| otherwise = aux (b-1)

-- 4ª solución

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

mayorExponente4 :: Integer -> Integer

mayorExponente4 x =

mcd (exponentes x)

-- (exponentes x) es la lista de los exponentes en la factorizacioń de

-- x. por ejemplo.

-- exponentes 720 == [4,2,1]

exponentes :: Integer -> [Integer]

exponentes x =

map genericLength (group (primeFactors x))

-- (mcd xs) es el máximo común divisor de xs. Por ejemplo,

-- mcd [4,6,10] == 2

mcd :: [Integer] -> Integer

mcd = foldr1 gcd

-- Comprobación de equivalencia

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

-- La propiedad es

prop_mayorExponente :: Integer -> Property

prop_mayorExponente n =

n >= 0 ==>

mayorExponente n == mayorExponente2 n &&

mayorExponente2 n == mayorExponente3 n

-- La comprobación es

-- λ> quickCheck prop_mayorExponente

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> mayorExponente (10^3)

-- 3

-- (3.96 secs, 4,671,928,464 bytes)

-- λ> mayorExponente2 (10^3)

-- 3

-- (3.99 secs, 4,670,107,024 bytes)

-- λ> mayorExponente3 (10^3)

-- 3

-- (3.90 secs, 4,686,383,952 bytes)

-- λ> mayorExponente4 (10^3)

-- 3

-- (0.02 secs, 131,272 bytes)

-- Definición de graficaMayorExponente

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

graficaMayorExponente :: Integer -> IO ()

graficaMayorExponente n =

plotList [ Key Nothing

, PNG ("MayorExponente.png")

]

(map mayorExponente3 [2..n])

Pensamiento

Mirando mi calavera
un nuevo Hamlet dirá:
He aquí un lindo fósil de una
careta de carnaval.

Antonio Machado

Mezcla de listas

PorJosé A. Alonso 19-febrero-201926-febrero-2019

Definir la función

   mezcla :: [[a]] -> [a]

1	mezcla :: [[a]] -> [a]

tal que (mezcla xss) es la lista tomando sucesivamente los elementos de xss en la misma posición. Cuando una de las listas de xss es vacía, se continua con las restantes. por ejemplo,

   mezcla [[1,2],[3..7],[8..10]]            ==  [1,3,8,2,4,9,5,10,6,7]
   mezcla ["Estamos","en","2019"]           ==  "Ee2sn0t1a9mos"
   take 9 (mezcla [[3,6..],[5,7..],[0,1]])  ==  [3,5,0,6,7,1,9,9,12]

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

mezcla ["Estamos","en","2019"] == "Ee2sn0t1a9mos"

take 9 (mezcla [[3,6..],[5,7..],[0,1]]) == [3,5,0,6,7,1,9,9,12]

Soluciones

import Data.List (transpose)

-- 1ª solución
mezcla :: [[a]] -> [a]
mezcla xss = aux (filter (not . null) xss)
  where
    aux []  = []
    aux yss = map head yss ++ mezcla (map tail yss)

-- 2ª solución
mezcla2 :: [[a]] -> [a]
mezcla2 = aux . filter (not . null)
  where
    aux []  = []
    aux yss = map head yss ++ mezcla (map tail yss)

-- 3ª solución
mezcla3 :: [[a]] -> [a]
mezcla3 = concatMap primeros . takeWhile (not . null) . iterate restos
  where primeros = map head . filter (not . null)
        restos   = map tail . filter (not . null)

-- 4ª solución
mezcla4 :: [[a]] -> [a]
mezcla4 = concat . transpose

import Data.List (transpose)

-- 1ª solución

mezcla :: [[a]] -> [a]

mezcla xss = aux (filter (not . null) xss)

where

aux [] = []

aux yss = map head yss ++ mezcla (map tail yss)

-- 2ª solución

mezcla2 :: [[a]] -> [a]

mezcla2 = aux . filter (not . null)

where

aux [] = []

aux yss = map head yss ++ mezcla (map tail yss)

-- 3ª solución

mezcla3 :: [[a]] -> [a]

mezcla3 = concatMap primeros . takeWhile (not . null) . iterate restos

where primeros = map head . filter (not . null)

restos = map tail . filter (not . null)

-- 4ª solución

mezcla4 :: [[a]] -> [a]

mezcla4 = concat . transpose

Pensamiento

Cuatro cosas tiene el hombre
que no sirven en la mar:
ancla, gobernalle y remos,
y miedo de naufragar.

Antonio Machado

Ternas euclídeas

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

Uno de los problemas planteados por Euclides en los Elementos consiste en encontrar tres números tales que cada uno de sus productos, dos a dos, aumentados en la unidad sea un cuadrado perfecto.

Diremos que (x,y,z) es una terna euclídea si es una solución del problema; es decir, si x <= y <= z y xy+1, yz+1 y zx+1 son cuadrados. Por ejemplo, (4,6,20) es una terna euclídea ya que

   4x6+1 = 5^2, 6x20+1 = 11^2 y 20*4+1 = 9^2

1	4x6+1 = 5^2, 6x20+1 = 11^2 y 20*4+1 = 9^2

Definir la funciones

   ternasEuclideas        :: [(Integer,Integer,Integer)]
   esMayorDeTernaEuclidea :: Integer -> Bool

1 2	ternasEuclideas :: [(Integer,Integer,Integer)] esMayorDeTernaEuclidea :: Integer -> Bool

tales que

ternasEuclideas es la lista de las ternas euclídeas. Por ejemplo,

     λ> take 7 ternasEuclideas
     [(1,3,8),(2,4,12),(1,8,15),(3,5,16),(4,6,20),(3,8,21),(5,7,24)]

1 2	λ> take 7 ternasEuclideas [(1,3,8),(2,4,12),(1,8,15),(3,5,16),(4,6,20),(3,8,21),(5,7,24)]

(esMayorDeTernaEuclidea z) se verifica si existen x, y tales que (x,y,z) es una terna euclídea. Por ejemplo,

     esMayorDeTernaEuclidea 20  ==  True
     esMayorDeTernaEuclidea 22  ==  False

1 2	esMayorDeTernaEuclidea 20 == True esMayorDeTernaEuclidea 22 == False

Comprobar con QuickCheck que z es el mayor de una terna euclídea si, y sólo si, existe un número natural x tal que 1 < x < z – 1 y x^2 es congruente con 1 módulo z.

Soluciones

import Test.QuickCheck

ternasEuclideas :: [(Integer,Integer,Integer)]
ternasEuclideas =
  [(x,y,z) | z <- [1..]
           , y <- [1..z]
           , esCuadrado (y * z + 1)
           , x <- [1..y]
           , esCuadrado (x * y + 1)
           , esCuadrado (z * x + 1)]

-- (esCuadrado x) se verifica si x es un número al cuadrado. Por
-- ejemplo,
--    esCuadrado 25  ==  True
--    esCuadrado 26  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x = (raizEntera x)^2 == x
  where raizEntera :: Integer -> Integer
        raizEntera = floor . sqrt . fromIntegral 

esMayorDeTernaEuclidea :: Integer -> Bool
esMayorDeTernaEuclidea z =
  not (null [(x,y) | y <- [1..z]
                   , esCuadrado (y * z + 1)
                   , x <- [1..y]
                   , esCuadrado (x * y + 1)
                   , esCuadrado (z * x + 1)])


-- La propiedad es
prop_esMayorDeTernaEuclidea :: Positive Integer -> Bool
prop_esMayorDeTernaEuclidea (Positive z) =
  esMayorDeTernaEuclidea z == any (\x -> (x^2) `mod` z == 1) [2..z-2]

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

import Test.QuickCheck

ternasEuclideas :: [(Integer,Integer,Integer)]

ternasEuclideas =

[(x,y,z) | z <- [1..]

, y <- [1..z]

, esCuadrado (y * z + 1)

, x <- [1..y]

, esCuadrado (x * y + 1)

, esCuadrado (z * x + 1)]

-- (esCuadrado x) se verifica si x es un número al cuadrado. Por

-- ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 26 == False

esCuadrado :: Integer -> Bool

esCuadrado x = (raizEntera x)^2 == x

where raizEntera :: Integer -> Integer

raizEntera = floor . sqrt . fromIntegral

esMayorDeTernaEuclidea :: Integer -> Bool

esMayorDeTernaEuclidea z =

not (null [(x,y) | y <- [1..z]

, esCuadrado (y * z + 1)

, x <- [1..y]

, esCuadrado (x * y + 1)

, esCuadrado (z * x + 1)])

-- La propiedad es

prop_esMayorDeTernaEuclidea :: Positive Integer -> Bool

prop_esMayorDeTernaEuclidea (Positive z) =

esMayorDeTernaEuclidea z == any (\x -> (x^2) `mod` z == 1) [2..z-2]

-- La comprobación es

-- λ> quickCheck prop_esMayorDeTernaEuclidea

-- +++ OK, passed 100 tests.

Pensamiento

Todo pasa y todo queda,
pero lo nuestro es pasar,
pasar haciendo caminos,
caminos sobre la mar.

Antonio Machado

Sucesión de Cantor de números innombrables

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

Un número es innombrable si es divisible por 7 o alguno de sus dígitos es un 7. Un juego infantil consiste en contar saltándose los números innombrables:

   1 2 3 4 5 6 ( ) 8 9 10 11 12 13 ( ) 15 16 ( ) 18 ...

1	1 2 3 4 5 6 ( ) 8 9 10 11 12 13 ( ) 15 16 ( ) 18 ...

La sucesión de Cantor se obtiene llenando los huecos de la sucesión anterior:

  1 2 3 4 5 6 (1) 8 9 10 11 12 13 (2) 15 16 (3) 18 19 20 (4) 22 23
  24 25 26 (5) (6) 29 30 31 32 33 34 (1) 36 (8) 38 39 40 41  (9) 43
  44 45 46 (10) 48 (11) 50 51 52 53 54 55 (12) (13) 58 59 60 61 62
  (2) 64 65 66 (15) 68 69 (16) (3) (18) (19) (20) (4) (22) (23) (24)
  (25) 80 81 82 83 (26) 85 86 (5) 88 89 90 (6) 92 93 94 95 96 (29)
  (30) 99 100

1 2 3 4 5 6 (1) 8 9 10 11 12 13 (2) 15 16 (3) 18 19 20 (4) 22 23

24 25 26 (5) (6) 29 30 31 32 33 34 (1) 36 (8) 38 39 40 41 (9) 43

44 45 46 (10) 48 (11) 50 51 52 53 54 55 (12) (13) 58 59 60 61 62

(2) 64 65 66 (15) 68 69 (16) (3) (18) (19) (20) (4) (22) (23) (24)

(25) 80 81 82 83 (26) 85 86 (5) 88 89 90 (6) 92 93 94 95 96 (29)

(30) 99 100

Definir las funciones

   sucCantor        :: [Integer]
   graficaSucCantor :: Int -> IO ()

1 2	sucCantor :: [Integer] graficaSucCantor :: Int -> IO ()

tales que

sucCantor es la lista cuyos elementos son los términos de la sucesión de Cantor. Por ejemplo,

     λ> take 100 sucCantor
     [1,2,3,4,5,6, 1 ,8,9,10,11,12,13, 2, 15,16, 3, 18,19,20, 4,
      22,23,24,25,26, 5 , 6 ,29,30,31,32,33,34, 1 ,36 , 8 ,38,39,
      40,41, 9 ,43,44,45,46, 10 ,48, 11 ,50,51,52,53,54,55 , 12 ,
      13, 58,59,60,61,62, 2 ,64,65,66, 15 ,68,69, 16 , 3 , 18, 19,
      20, 4, 22, 23, 24 ,25 ,80,81,82,83, 26 ,85,86, 5 ,88,89,90,
      6, 92,93,94,95,96, 29, 30 ,99,100]
     λ> sucCantor2 !! (5+10^6)
     544480
     λ> sucCantor2 !! (6+10^6)
     266086

λ> take 100 sucCantor

[1,2,3,4,5,6, 1 ,8,9,10,11,12,13, 2, 15,16, 3, 18,19,20, 4,

22,23,24,25,26, 5 , 6 ,29,30,31,32,33,34, 1 ,36 , 8 ,38,39,

40,41, 9 ,43,44,45,46, 10 ,48, 11 ,50,51,52,53,54,55 , 12 ,

13, 58,59,60,61,62, 2 ,64,65,66, 15 ,68,69, 16 , 3 , 18, 19,

20, 4, 22, 23, 24 ,25 ,80,81,82,83, 26 ,85,86, 5 ,88,89,90,

6, 92,93,94,95,96, 29, 30 ,99,100]

λ> sucCantor2 !! (5+10^6)

544480

λ> sucCantor2 !! (6+10^6)

266086

(graficaSucCantor n) es la gráfica de los n primeros términos de la sucesión de Cantor. Por ejemplo, (graficaSucCantor 200) dibuja

Soluciones

import Graphics.Gnuplot.Simple

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

sucCantor1 :: [Integer]
sucCantor1 = map fst $ scanl f (1,0) [2..]
  where f (a,i) x
          | esInnombrable x = (sucCantor1 !! i, i+1)
          | otherwise       = (x,i)

esInnombrable :: Integer -> Bool
esInnombrable x =
  rem x 7 == 0 || '7' `elem` show x

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

sucCantor2 :: [Integer]
sucCantor2 = aux 0 1
  where aux i x
          | esInnombrable x = sucCantor2 !! i : aux (i+1) (x+1)
          | otherwise       = x : aux i (x+1) 

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

sucCantor3 :: [Integer]
sucCantor3 = 1 : aux [2..] sucCantor3
  where aux [] _ = []
        aux (x:xs) a@(y:ys)
          | esInnombrable x = y : aux xs ys
          | otherwise       = x : aux xs a

-- Definición de graficaSucCantor
-- ========================================

graficaSucCantor :: Int -> IO ()
graficaSucCantor n =
  plotList [ Key Nothing
           , PNG ("Sucesion_de_Cantor_de_numeros_innombrables.png")
           ]
           (take n sucCantor3)

import Graphics.Gnuplot.Simple

-- 1ª solución

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

sucCantor1 :: [Integer]

sucCantor1 = map fst $ scanl f (1,0) [2..]

where f (a,i) x

| esInnombrable x = (sucCantor1 !! i, i+1)

| otherwise = (x,i)

esInnombrable :: Integer -> Bool

esInnombrable x =

rem x 7 == 0 || '7' `elem` show x

-- 2ª solución

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

sucCantor2 :: [Integer]

sucCantor2 = aux 0 1

where aux i x

| esInnombrable x = sucCantor2 !! i : aux (i+1) (x+1)

| otherwise = x : aux i (x+1)

-- 3ª solución

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

sucCantor3 :: [Integer]

sucCantor3 = 1 : aux [2..] sucCantor3

where aux [] _ = []

aux (x:xs) a@(y:ys)

| esInnombrable x = y : aux xs ys

| otherwise = x : aux xs a

-- Definición de graficaSucCantor

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

graficaSucCantor :: Int -> IO ()

graficaSucCantor n =

plotList [ Key Nothing

, PNG ("Sucesion_de_Cantor_de_numeros_innombrables.png")

]

(take n sucCantor3)

Pensamiento

Dices que nada se pierde
y acaso dices verdad;
pero todo lo perdemos
y todo nos perderá.

Antonio Machado

Cálculo de pi mediante la serie de Nilakantha

PorJosé A. Alonso 13-febrero-201925-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)

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

aproximacionPi3 :: Int -> Double
aproximacionPi3 x =
  3 + sum [(((-1)**(n+1))*4)/(2*n*(2*n+1)*(2*n+2))
          | n <- [1..fromIntegral x]]


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

--    λ> aproximacionPi (10^6)
--    3.141592653589787
--    (1.35 secs, 729,373,160 bytes)
--    λ> aproximacionPi2 (10^6)
--    3.141592653589787
--    (2.96 secs, 2,161,766,096 bytes)
--    λ> aproximacionPi3 (10^6)
--    3.1415926535897913
--    (2.02 secs, 1,121,372,536 bytes)

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

tabla :: FilePath -> [Int] -> IO ()
tabla f ns = 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)

-- 3ª solución

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

aproximacionPi3 :: Int -> Double

aproximacionPi3 x =

3 + sum [(((-1)**(n+1))*4)/(2*n*(2*n+1)*(2*n+2))

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

-- Comparación de eficiencia

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

-- λ> aproximacionPi (10^6)

-- 3.141592653589787

-- (1.35 secs, 729,373,160 bytes)

-- λ> aproximacionPi2 (10^6)

-- 3.141592653589787

-- (2.96 secs, 2,161,766,096 bytes)

-- λ> aproximacionPi3 (10^6)

-- 3.1415926535897913

-- (2.02 secs, 1,121,372,536 bytes)

-- Definicioń de tabla

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

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

tabla f ns = 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"

Pensamiento

Bueno es saber que los vasos
nos sirven para beber;
lo malo es que no sabemos
para que sirve la sed.

Antonio Machado

Aritmética lunar

PorJosé A. Alonso 7-febrero-201914-febrero-2019

En la aritmética lunar la suma y el producto se hace como en la terrícola salvo que sus tablas de sumar y de multiplicar son distintas. La suma lunar de dos dígitos es su máximo (por ejemplo, 1 + 3 = 3 y 7 + 4 = 7) y el producto lunar de dos dígitos es su mínimo (por ejemplo, 1 x 3 = 1 y 7 x 4 = 4). Por tanto,

     3 5 7        3 5 7
   +   6 4      x   6 4
   -------      -------
     3 6 7        3 4 4
                3 5 6
                -------
                3 5 6 4

3 5 7 3 5 7

+ 6 4 x 6 4

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

3 6 7 3 4 4

3 5 6

-------

3 5 6 4

Definir las funciones

   suma     :: Integer -> Integer -> Integer
   producto :: Integer -> Integer -> Integer

1 2	suma :: Integer -> Integer -> Integer producto :: Integer -> Integer -> Integer

tales que

(suma x y) es la suma lunar de x e y. Por ejemplo,

     suma 357 64  ==  367
     suma 64 357  ==  367
     suma 1 3     ==  3
     suma 7 4     ==  7

suma 357 64 == 367

suma 64 357 == 367

suma 1 3 == 3

suma 7 4 == 7

(producto x y) es el producto lunar de x e y. Por ejemplo,

     producto 357 64  ==  3564
     producto 64 357  ==  3564
     producto 1 3     ==  1
     producto 7 4     ==  4

producto 357 64 == 3564

producto 64 357 == 3564

producto 1 3 == 1

producto 7 4 == 4

Comprobar con QuickCheck que la suma y el producto lunar son conmutativos.

Soluciones

import Test.QuickCheck

suma :: Integer -> Integer -> Integer
suma 0 0 = 0
suma x y = max x2 y2 + 10 * suma x1 y1
  where (x1,x2) = x `divMod` 10
        (y1,y2) = y `divMod` 10

producto :: Integer -> Integer -> Integer
producto 0 _ = 0
producto x y = productoDigitoNumero x2 y `suma` (10 * producto x1 y)
  where (x1, x2) = x `divMod` 10

-- (productoDigitoNumero d x) es el producto del dígito d por el número
-- x. Por ejemplo,
--    productoDigitoNumero 4 357  ==  344
--    productoDigitoNumero 6 357  ==  356
productoDigitoNumero :: Integer -> Integer -> Integer
productoDigitoNumero _ 0 = 0
productoDigitoNumero d x = min d x2 + 10 * productoDigitoNumero d x1
  where (x1, x2) = x `divMod` 10

-- La propiedad es
prop_conmutativa :: Positive Integer -> Positive Integer -> Bool
prop_conmutativa (Positive x) (Positive y) =
  suma x y == suma y x &&
  producto x y == producto y x

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

import Test.QuickCheck

suma :: Integer -> Integer -> Integer

suma 0 0 = 0

suma x y = max x2 y2 + 10 * suma x1 y1

where (x1,x2) = x `divMod` 10

(y1,y2) = y `divMod` 10

producto :: Integer -> Integer -> Integer

producto 0 _ = 0

producto x y = productoDigitoNumero x2 y `suma` (10 * producto x1 y)

where (x1, x2) = x `divMod` 10

-- (productoDigitoNumero d x) es el producto del dígito d por el número

-- x. Por ejemplo,

-- productoDigitoNumero 4 357 == 344

-- productoDigitoNumero 6 357 == 356

productoDigitoNumero :: Integer -> Integer -> Integer

productoDigitoNumero _ 0 = 0

productoDigitoNumero d x = min d x2 + 10 * productoDigitoNumero d x1

where (x1, x2) = x `divMod` 10

-- La propiedad es

prop_conmutativa :: Positive Integer -> Positive Integer -> Bool

prop_conmutativa (Positive x) (Positive y) =

suma x y == suma y x &&

producto x y == producto y x

-- La comprobación es

-- λ> quickCheck prop_conmutativa

-- +++ OK, passed 100 tests.

Pensamiento

Cantad conmigo en coro: saber, nada sabemos,
de arcano mar vinimos, a ignota mar iremos …
La luz nada ilumina y el sabio nada enseña.
¿Qué dice la palabra? ¿Qué el agua de la peña?

Antonio Machado

Exterior de árboles

PorJosé A. Alonso 6-febrero-20196-marzo-2019

Los árboles binarios con datos en las hojas y los nodos se definen por

   data Arbol = H Int
              | N Int Arbol Arbol 
     deriving Show

data Arbol = H Int

| N Int Arbol Arbol

deriving Show

Por ejemplo, los árboles

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

3 3 3

/ \ / \ / \

2 8 2 8 2 8

/ \ / \ / \ / \ / \ / \

5 7 6 9 5 7 6 9 5 7 6 9

/ \ / \ / \

1 4 1 4 1 4

se representan por

   ejArbol1, ejArbol2, ejArbol3 :: Arbol 
   ejArbol1 = N 3
                (N 2 
                   (N 5 (H 1) (H 4))
                   (H 7))
                (N 8 (H 6) (H 9))
   ejArbol2 = N 3
                (N 2 (H 5) (H 7))
                (N 8 (N 6 (H 1) (H 4))
                     (H 9))
   ejArbol3 = N 3
                (N 2 (H 5) (H 7))
                (N 8 (H 6)
                     (N 9 (H 1) (H 4)))

ejArbol1, ejArbol2, ejArbol3 :: Arbol

ejArbol1 = N 3

(N 2

(N 5 (H 1) (H 4))

(H 7))

(N 8 (H 6) (H 9))

ejArbol2 = N 3

(N 2 (H 5) (H 7))

(N 8 (N 6 (H 1) (H 4))

(H 9))

ejArbol3 = N 3

(N 2 (H 5) (H 7))

(N 8 (H 6)

(N 9 (H 1) (H 4)))

Definir la función

   exterior :: Arbol -> [Int]

1	exterior :: Arbol -> [Int]

tal que (exterior a) es la lista de los elementos exteriores del árbol a. Por ejemplo,

   exterior ejArbol1  ==  [3,2,5,1,4,7,6,9,8]
   exterior ejArbol2  ==  [3,2,5,7,1,4,9,8]
   exterior ejArbol3  ==  [3,2,5,7,6,1,4,9,8]

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

exterior ejArbol2 == [3,2,5,7,1,4,9,8]

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

El orden de los elementos es desde la raíz hasta el extremo inferior izquierdo desde él hasta el inferior derecho y desde él hasta la raíz.

Soluciones

data Arbol = H Int
           | N Int Arbol Arbol 
  deriving Show

ejArbol1, ejArbol2, ejArbol3 :: Arbol 
ejArbol1 = N 3
             (N 2 
                (N 5 (H 1) (H 4))
                (H 7))
             (N 8 (H 6) (H 9))
ejArbol2 = N 3
             (N 2 (H 5) (H 7))
             (N 8 (N 6 (H 1) (H 4))
                  (H 9))
ejArbol3 = N 3
             (N 2 (H 5) (H 7))
             (N 8 (H 6)
                  (N 9 (H 1) (H 4)))

exterior :: Arbol -> [Int]
exterior a =
  ramaIzquierda a ++ hojas a ++ reverse (tail (ramaDerecha a))

-- (ramaIzquierda a) es la rama izquierda del árbol a. Por ejemplo,
--    ramaIzquierda ejArbol1  ==  [3,2,5]
--    ramaIzquierda ejArbol3  ==  [3,2]
ramaIzquierda :: Arbol -> [Int]
ramaIzquierda (H _)     = []
ramaIzquierda (N x i _) = x : ramaIzquierda i

-- (ramaDerecha a) es la rama derecha del árbol a. Por ejemplo,
--    ramaDerecha ejArbol1  ==  [3,8]
--    ramaDerecha ejArbol3  ==  [3,8,9]
ramaDerecha :: Arbol -> [Int]
ramaDerecha (H _)     = []
ramaDerecha (N x _ d) = x : ramaDerecha d

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

data Arbol = H Int

| N Int Arbol Arbol

deriving Show

ejArbol1, ejArbol2, ejArbol3 :: Arbol

ejArbol1 = N 3

(N 2

(N 5 (H 1) (H 4))

(H 7))

(N 8 (H 6) (H 9))

ejArbol2 = N 3

(N 2 (H 5) (H 7))

(N 8 (N 6 (H 1) (H 4))

(H 9))

ejArbol3 = N 3

(N 2 (H 5) (H 7))

(N 8 (H 6)

(N 9 (H 1) (H 4)))

exterior :: Arbol -> [Int]

exterior a =

ramaIzquierda a ++ hojas a ++ reverse (tail (ramaDerecha a))

-- (ramaIzquierda a) es la rama izquierda del árbol a. Por ejemplo,

-- ramaIzquierda ejArbol1 == [3,2,5]

-- ramaIzquierda ejArbol3 == [3,2]

ramaIzquierda :: Arbol -> [Int]

ramaIzquierda (H _) = []

ramaIzquierda (N x i _) = x : ramaIzquierda i

-- (ramaDerecha a) es la rama derecha del árbol a. Por ejemplo,

-- ramaDerecha ejArbol1 == [3,8]

-- ramaDerecha ejArbol3 == [3,8,9]

ramaDerecha :: Arbol -> [Int]

ramaDerecha (H _) = []

ramaDerecha (N x _ d) = x : ramaDerecha d

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

-- hojas ejArbol1 == [1,4,7,6,9]

-- hojas ejArbol3 == [5,7,6,1,4]

hojas :: Arbol -> [Int]

hojas (H x) = [x]

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

Pensamiento

¿Dónde está la utilidad
de nuestras utilidades?
Volvamos a la verdad:
vanidad de vanidades.

Antonio Machado

Dígitos en las posiciones pares de cuadrados

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

Definir las funciones

   digitosPosParesCuadrado    :: Integer -> ([Integer],Int)
   invDigitosPosParesCuadrado :: ([Integer],Int) -> [Integer]

1 2	digitosPosParesCuadrado :: Integer -> ([Integer],Int) invDigitosPosParesCuadrado :: ([Integer],Int) -> [Integer]

tales que

(digitosPosParesCuadrado n) es el par formados por los dígitos de n² en la posiciones pares y por el número de dígitos de n². Por ejemplo,

     digitosPosParesCuadrado 8     ==  ([6],2)
     digitosPosParesCuadrado 14    ==  ([1,6],3)
     digitosPosParesCuadrado 36    ==  ([1,9],4)
     digitosPosParesCuadrado 116   ==  ([1,4,6],5)
     digitosPosParesCuadrado 2019  ==  ([4,7,3,1],7)

digitosPosParesCuadrado 8 == ([6],2)

digitosPosParesCuadrado 14 == ([1,6],3)

digitosPosParesCuadrado 36 == ([1,9],4)

digitosPosParesCuadrado 116 == ([1,4,6],5)

digitosPosParesCuadrado 2019 == ([4,7,3,1],7)

(invDigitosPosParesCuadrado (xs,k)) es la lista de los números n tales que xs es la lista de los dígitos de n² en la posiciones pares y k es el número de dígitos de n². Por ejemplo,

     invDigitosPosParesCuadrado ([6],2)             ==  [8]
     invDigitosPosParesCuadrado ([1,6],3)           ==  [14]
     invDigitosPosParesCuadrado ([1,9],4)           ==  [36]
     invDigitosPosParesCuadrado ([1,4,6],5)         ==  [116,136]
     invDigitosPosParesCuadrado ([4,7,3,1],7)       ==  [2019,2139,2231]
     invDigitosPosParesCuadrado ([1,2],3)           ==  []
     invDigitosPosParesCuadrado ([1,2],4)           ==  [32,35,39]
     invDigitosPosParesCuadrado ([1,2,3,4,5,6],11)  ==  [115256,127334,135254]

invDigitosPosParesCuadrado ([6],2) == [8]

invDigitosPosParesCuadrado ([1,6],3) == [14]

invDigitosPosParesCuadrado ([1,9],4) == [36]

invDigitosPosParesCuadrado ([1,4,6],5) == [116,136]

invDigitosPosParesCuadrado ([4,7,3,1],7) == [2019,2139,2231]

invDigitosPosParesCuadrado ([1,2],3) == []

invDigitosPosParesCuadrado ([1,2],4) == [32,35,39]

invDigitosPosParesCuadrado ([1,2,3,4,5,6],11) == [115256,127334,135254]

Comprobar con QuickCheck que para todo entero positivo n se verifica que para todo entero positivo m, m pertenece a (invDigitosPosParesCuadrado (digitosPosParesCuadrado n)) si, y sólo si, (digitosPosParesCuadrado m) es igual a (digitosPosParesCuadrado n)

Soluciones

import Test.QuickCheck

-- Definición de digitosPosParesCuadrado
-- =====================================

digitosPosParesCuadrado :: Integer -> ([Integer],Int)
digitosPosParesCuadrado n =
  (digitosPosPares (n^2),length (show (n^2)))

-- (digitosPosPares n) es la lista de los dígitos de n en posiciones
-- pares. Por ejemplo,
--    digitosPosPares 24012019  ==  [2,0,2,1]
digitosPosPares :: Integer -> [Integer]
digitosPosPares n = elementosPosPares (digitos n)

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

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

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

invDigitosPosParesCuadrado :: ([Integer],Int) -> [Integer]
invDigitosPosParesCuadrado (xs, a) =
  [x | x <- [ceiling (sqrt 10^(a-1))..ceiling (sqrt 10^a)]
     , digitosPosParesCuadrado x == (xs,a)]

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

invDigitosPosParesCuadrado2 :: ([Integer],Int) -> [Integer]
invDigitosPosParesCuadrado2 x =
  [n | n <- [a..b], digitosPosParesCuadrado n == x]
  where a = floor (sqrt (fromIntegral (completaNum x 0)))
        b = ceiling (sqrt (fromIntegral (completaNum x 9)))

-- (completaNum (xs,k) n) es el número cuyos dígitos en las posiciones
-- pares son los de xs y los de las posiciones impares son iguales a n
-- (se supone que k es igual al doble de la longitud de xs o un
-- menos). Por ejemplo, 
--    completaNum ([1,3,8],5) 4  ==  14348
--    completaNum ([1,3,8],6) 4  ==  143484
completaNum :: ([Integer],Int) -> Integer -> Integer
completaNum x n = digitosAnumero (completa x n)

-- (completa (xs,k) n) es la lista cuyos elementos en las posiciones
-- pares son los de xs y los de las posiciones impares son iguales a n
-- (se supone que k es igual al doble de la longitud de xs o un
-- menos). Por ejemplo, 
--    completa ([1,3,8],5) 4  ==  [1,4,3,4,8]
--    completa ([1,3,8],6) 4  ==  [1,4,3,4,8,4]
completa :: ([Integer],Int) -> Integer -> [Integer]
completa (xs,k) n
  | even k    = ys
  | otherwise = init ys
  where ys = concat [[x,n] | x <- xs]

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

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

--    λ> invDigitosPosParesCuadrado ([1,2,1,5,7,4,9],13)
--    [1106393,1234567,1314597]
--    (7.55 secs, 13,764,850,536 bytes)
--    λ> invDigitosPosParesCuadrado2 ([1,2,1,5,7,4,9],13)
--    [1106393,1234567,1314597]
--    (1.96 secs, 3,780,368,816 bytes)

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

-- La propiedad es  
prop_digitosPosParesCuadrado :: Positive Integer -> Positive Integer -> Bool
prop_digitosPosParesCuadrado (Positive n) (Positive m) =
  (digitosPosParesCuadrado m == x)
  == (m `elem` invDigitosPosParesCuadrado x)
  where x = digitosPosParesCuadrado n

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

import Test.QuickCheck

-- Definición de digitosPosParesCuadrado

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

digitosPosParesCuadrado :: Integer -> ([Integer],Int)

digitosPosParesCuadrado n =

(digitosPosPares (n^2),length (show (n^2)))

-- (digitosPosPares n) es la lista de los dígitos de n en posiciones

-- pares. Por ejemplo,

-- digitosPosPares 24012019 == [2,0,2,1]

digitosPosPares :: Integer -> [Integer]

digitosPosPares n = elementosPosPares (digitos n)

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

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

digitos :: Integer -> [Integer]

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

-- (elementosPosPares xs) es la lista de los elementos de xs en

-- posiciones pares. Por ejemplo,

-- elementosPosPares [3,2,5,7,6,4] == [3,5,6]

elementosPosPares :: [a] -> [a]

elementosPosPares [] = []

elementosPosPares [x] = [x]

elementosPosPares (x:_:zs) = x : elementosPosPares zs

-- 1ª definición de invDigitosPosParesCuadrado

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

invDigitosPosParesCuadrado :: ([Integer],Int) -> [Integer]

invDigitosPosParesCuadrado (xs, a) =

[x | x <- [ceiling (sqrt 10^(a-1))..ceiling (sqrt 10^a)]

, digitosPosParesCuadrado x == (xs,a)]

-- 2ª definición de invDigitosPosParesCuadrado

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

invDigitosPosParesCuadrado2 :: ([Integer],Int) -> [Integer]

invDigitosPosParesCuadrado2 x =

[n | n <- [a..b], digitosPosParesCuadrado n == x]

where a = floor (sqrt (fromIntegral (completaNum x 0)))

b = ceiling (sqrt (fromIntegral (completaNum x 9)))

-- (completaNum (xs,k) n) es el número cuyos dígitos en las posiciones

-- pares son los de xs y los de las posiciones impares son iguales a n

-- (se supone que k es igual al doble de la longitud de xs o un

-- menos). Por ejemplo,

-- completaNum ([1,3,8],5) 4 == 14348

-- completaNum ([1,3,8],6) 4 == 143484

completaNum :: ([Integer],Int) -> Integer -> Integer

completaNum x n = digitosAnumero (completa x n)

-- (completa (xs,k) n) es la lista cuyos elementos en las posiciones

-- pares son los de xs y los de las posiciones impares son iguales a n

-- (se supone que k es igual al doble de la longitud de xs o un

-- menos). Por ejemplo,

-- completa ([1,3,8],5) 4 == [1,4,3,4,8]

-- completa ([1,3,8],6) 4 == [1,4,3,4,8,4]

completa :: ([Integer],Int) -> Integer -> [Integer]

completa (xs,k) n

| even k = ys

| otherwise = init ys

where ys = concat [[x,n] | x <- xs]

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

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

digitosAnumero :: [Integer] -> Integer

digitosAnumero = read . concatMap show

-- Comparación de eficiencia

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

-- λ> invDigitosPosParesCuadrado ([1,2,1,5,7,4,9],13)

-- [1106393,1234567,1314597]

-- (7.55 secs, 13,764,850,536 bytes)

-- λ> invDigitosPosParesCuadrado2 ([1,2,1,5,7,4,9],13)

-- [1106393,1234567,1314597]

-- (1.96 secs, 3,780,368,816 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_digitosPosParesCuadrado :: Positive Integer -> Positive Integer -> Bool

prop_digitosPosParesCuadrado (Positive n) (Positive m) =

(digitosPosParesCuadrado m == x)

== (m `elem` invDigitosPosParesCuadrado x)

where x = digitosPosParesCuadrado n

-- La comprobación es

-- λ> quickCheck prop_digitosPosParesCuadrado

-- +++ OK, passed 100 tests.

Pensamiento

¡Ojos que a la luz se abrieron
un día para, después,
ciegos tornar a la tierra,
hartos de mirar sin ver.

Antonio Machado

Triángulo de Pascal binario

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

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

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

1 0 1 1 1 1 0 1 1 0

1 1 0 0 1 1 0 1

0 1 0 0 1 1

1 1 1 0

0 1

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

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

Definir las funciones

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

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

pascalCapicuas :: Int -> [[Int]]

nPascalCapicuas :: Int -> Integer

tales que

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

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

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

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

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

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

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

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

λ> pascalCapicuas 2

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

λ> pascalCapicuas 3

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

λ> pascalCapicuas 4

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

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

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

λ> nPascalCapicuas 2

λ> nPascalCapicuas 3

λ> nPascalCapicuas 4

λ> nPascalCapicuas 400

1606938044258990275541962092341162602522202993782792835301376

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

15052

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

150515

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

1505150

Soluciones

import Data.List (genericLength, unfoldr)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Data.List (genericLength, unfoldr)

-- Definición de trianguloPascalBinario

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

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

trianguloPascalBinario xs =

takeWhile (not . null) (iterate siguiente xs)

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

-- de Pascal. Por ejemplo,

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

-- [1,1,0,0]

-- λ> siguiente it

-- [0,1,0]

-- λ> siguiente it

-- [1,1]

-- λ> siguiente it

-- [0]

-- λ> siguiente it

-- []

-- λ> siguiente it

-- []

siguiente :: [Int] -> [Int]

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

-- 2ª definición de trianguloPascalBinario

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

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

trianguloPascalBinario2 = unfoldr f

where f [] = Nothing

f xs = Just (xs, siguiente xs)

-- Definición de pascalCapicuas

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

pascalCapicuas :: Int -> [[Int]]

pascalCapicuas n =

[xs | xs <- inicios n

, esPascalCapicua xs]

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

-- ejemplo,

-- λ> inicios 0

-- [[]]

-- λ> inicios 1

-- [[0],[1]]

-- λ> inicios 2

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

-- λ> inicios 3

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

inicios :: Int -> [[Int]]

inicios 0 = [[]]

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

where xss = inicios (n-1)

-- Otra forma de definir inicios es

inicios2 :: Int -> [[Int]]

inicios2 n = sucInicios !! n

where sucInicios = iterate siguiente [[]]

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

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

-- capicúa. Por ejemplo,

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

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

esPascalCapicua :: [Int] -> Bool

esPascalCapicua xs =

xs == finalesTrianguloPascalBinario xs

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

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

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

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

finalesTrianguloPascalBinario :: [Int] -> [Int]

finalesTrianguloPascalBinario =

reverse . map last . trianguloPascalBinario

-- 1ª definición de nPascalCapicuas

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

nPascalCapicuas :: Int -> Integer

nPascalCapicuas =

genericLength . pascalCapicuas

-- 2ª definición de nPascalCapicuas

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

nPascalCapicuas2 :: Int -> Integer

nPascalCapicuas2 n =

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

Pensamiento

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

Antonio Machado

Impares en filas del triángulo de Pascal

PorJosé A. Alonso 30-enero-20196-febrero-2019

El triángulo de Pascal es un triángulo de números

         1
        1 1
       1 2 1
     1  3 3  1
    1 4  6  4 1
   1 5 10 10 5 1
  ...............

1 1

1 2 1

1 3 3 1

1 4 6 4 1

1 5 10 10 5 1

...............

construido de la siguiente forma

la primera fila está formada por el número 1;
las filas siguientes se construyen sumando los números adyacentes de la fila superior y añadiendo un 1 al principio y al final de la fila.

Definir las funciones

   imparesPascal          :: [[Integer]]
   nImparesPascal         :: [Int]
   grafica_nImparesPascal :: Int -> IO ()

imparesPascal :: [[Integer]]

nImparesPascal :: [Int]

grafica_nImparesPascal :: Int -> IO ()

tales que

imparesPascal es la lista de los elementos impares en cada una de las filas del triángulo de Pascal. Por ejemplo,

     λ> take 8 imparesPascal
     [[1],[1,1],[1,1],[1,3,3,1],[1,1],[1,5,5,1],[1,15,15,1],[1,7,21,35,35,21,7,1]]

1 2	λ> take 8 imparesPascal [[1],[1,1],[1,1],[1,3,3,1],[1,1],[1,5,5,1],[1,15,15,1],[1,7,21,35,35,21,7,1]]

nImparesPascal es la lista del número de elementos impares en cada una de las filas del triángulo de Pascal. Por ejemplo,

     λ> take 32 nImparesPascal
     [1,2,2,4,2,4,4,8,2,4,4,8,4,8,8,16,2,4,4,8,4,8,8,16,4,8,8,16,8,16,16,32]
     λ> maximum (take (10^6) nImparesPascal3)
     524288

λ> take 32 nImparesPascal

[1,2,2,4,2,4,4,8,2,4,4,8,4,8,8,16,2,4,4,8,4,8,8,16,4,8,8,16,8,16,16,32]

λ> maximum (take (10^6) nImparesPascal3)

524288

(grafica_nImparesPascal n) dibuja la gráfica de los n primeros términos de nImparesPascal. Por ejemplo, (grafica_nImparesPascal 50) dibuja

y (grafica_nImparesPascal 100) dibuja

Comprobar con QuickCheck que todos los elementos de nImparesPascal son potencias de dos.

Soluciones

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

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

imparesPascal :: [[Integer]]
imparesPascal =
  map (filter odd) pascal

-- pascal es la lista de las filas del triángulo de Pascal. Por ejemplo,
--    λ> take 7 pascal
--    [[1],[1,1],[1,2,1],[1,3,3,1],[1,4,6,4,1],[1,5,10,10,5,1],[1,6,15,20,15,6,1]]
pascal :: [[Integer]]
pascal = [1] : map f pascal
  where f xs = zipWith (+) (0:xs) (xs++[0])

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

imparesPascal2 :: [[Integer]]
imparesPascal2 =
  map (filter odd) pascal

pascal2 :: [[Integer]]
pascal2 = iterate f [1]
  where f xs = zipWith (+) (0:xs) (xs++[0])

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

nImparesPascal :: [Int]
nImparesPascal =
  map length imparesPascal

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

nImparesPascal2 :: [Int]
nImparesPascal2 =
  map (length . filter odd) imparesPascal

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

--    λ> take 32 nImparesPascal2
--    [1,2,
--     2,4,
--     2,4,4,8,
--     2,4,4,8,4,8,8,16,
--     2,4,4,8,4,8,8,16,4,8,8,16,8,16,16,32]
nImparesPascal3 :: [Int]
nImparesPascal3 = 1 : zs
  where zs = 2 : concat (transpose [zs, map (*2) zs])

-- Definición de grafica_nImparesPascal
-- =========================================

grafica_nImparesPascal :: Int -> IO ()
grafica_nImparesPascal n =
  plotListStyle
    [ Key Nothing
    , PNG ("Impares_en_filas_del_triangulo_de_Pascal_" ++ show n ++ ".png")
    ]
    (defaultStyle {plotType = LinesPoints})
    (take n nImparesPascal3)

-- Propiedad de nImparesPascal
-- ===========================

-- La propiedad es
prop_nImparesPascal :: Positive Int -> Bool
prop_nImparesPascal (Positive n) =
  esPotenciaDeDos (nImparesPascal3 !! n)

-- (esPotenciaDeDos n) se verifica si n es una potencia de dos. Por
-- ejemplo,
--    esPotenciaDeDos 16  ==  True
--    esPotenciaDeDos 18  ==  False
esPotenciaDeDos :: Int -> Bool
esPotenciaDeDos 1 = True
esPotenciaDeDos n = even n && esPotenciaDeDos (n `div` 2)

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

import Data.List (transpose)

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- 1ª definición de imparesPascal

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

imparesPascal :: [[Integer]]

imparesPascal =

map (filter odd) pascal

-- pascal es la lista de las filas del triángulo de Pascal. Por ejemplo,

-- λ> take 7 pascal

-- [[1],[1,1],[1,2,1],[1,3,3,1],[1,4,6,4,1],[1,5,10,10,5,1],[1,6,15,20,15,6,1]]

pascal :: [[Integer]]

pascal = [1] : map f pascal

where f xs = zipWith (+) (0:xs) (xs++[0])

-- 2ª definición de imparesPascal

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

imparesPascal2 :: [[Integer]]

imparesPascal2 =

map (filter odd) pascal

pascal2 :: [[Integer]]

pascal2 = iterate f [1]

where f xs = zipWith (+) (0:xs) (xs++[0])

-- 1ª definición de nImparesPascal

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

nImparesPascal :: [Int]

nImparesPascal =

map length imparesPascal

-- 2ª definición de nImparesPascal

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

nImparesPascal2 :: [Int]

nImparesPascal2 =

map (length . filter odd) imparesPascal

-- 3ª definición de nImparesPascal

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

-- λ> take 32 nImparesPascal2

-- [1,2,

-- 2,4,

-- 2,4,4,8,

-- 2,4,4,8,4,8,8,16,

-- 2,4,4,8,4,8,8,16,4,8,8,16,8,16,16,32]

nImparesPascal3 :: [Int]

nImparesPascal3 = 1 : zs

where zs = 2 : concat (transpose [zs, map (*2) zs])

-- Definición de grafica_nImparesPascal

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

grafica_nImparesPascal :: Int -> IO ()

grafica_nImparesPascal n =

plotListStyle

[ Key Nothing

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

]

(defaultStyle {plotType = LinesPoints})

(take n nImparesPascal3)

-- Propiedad de nImparesPascal

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

-- La propiedad es

prop_nImparesPascal :: Positive Int -> Bool

prop_nImparesPascal (Positive n) =

esPotenciaDeDos (nImparesPascal3 !! n)

-- (esPotenciaDeDos n) se verifica si n es una potencia de dos. Por

-- ejemplo,

-- esPotenciaDeDos 16 == True

-- esPotenciaDeDos 18 == False

esPotenciaDeDos :: Int -> Bool

esPotenciaDeDos 1 = True

esPotenciaDeDos n = even n && esPotenciaDeDos (n `div` 2)

-- La comprobación es

-- λ> quickCheck prop_nImparesPascal

-- +++ OK, passed 100 tests.

Pensamiento

De lo que llaman los hombres
virtud, justicia y bondad,
una mitad es envidia,
y la otra no es caridad.

Antonio Machado

Números primos en pi

PorJosé A. Alonso 24-enero-201931-enero-2019

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

   3.1415926535897932384626433832 ... 83996346460422090106105779458151

1	3.1415926535897932384626433832 ... 83996346460422090106105779458151

Definir las funciones

   nOcurrenciasPrimosEnPi :: Int -> Int -> IO [Int]
   graficaPrimosEnPi      :: Int -> Int -> IO ()

1 2	nOcurrenciasPrimosEnPi :: Int -> Int -> IO [Int] graficaPrimosEnPi :: Int -> Int -> IO ()

tales que

(nOcurrenciasPrimosEnPi n k) es la lista de longitud n cuyo i-ésimo elemento es el número de ocurrencias del i-ésimo número primo en los k primeros decimales del número pi. Por ejemplo,

   nOcurrenciasPrimosEnPi 4 20 == [2,3,3,1]

1	nOcurrenciasPrimosEnPi 4 20 == [2,3,3,1]

ya que los 20 primeros decimales de pi son 14159265358979323846 y en ellos ocurre el 2 dos veces, el 3 ocurre 3 veces, el 5 ocurre 3 veces y el 7 ocurre 1 vez. Otros ejemplos son

     λ> nOcurrenciasPrimosEnPi 10 100
     [12,11,8,8,1,0,1,1,2,0]
     λ> nOcurrenciasPrimosEnPi 10 (10^4)
     [1021,974,1046,970,99,102,90,113,99,95]
     λ> nOcurrenciasPrimosEnPi 10 (10^6)
     [100026,100229,100359,99800,10064,10012,9944,10148,9951,9912]

λ> nOcurrenciasPrimosEnPi 10 100

[12,11,8,8,1,0,1,1,2,0]

λ> nOcurrenciasPrimosEnPi 10 (10^4)

[1021,974,1046,970,99,102,90,113,99,95]

λ> nOcurrenciasPrimosEnPi 10 (10^6)

[100026,100229,100359,99800,10064,10012,9944,10148,9951,9912]

(graficaPrimosEnPi n k) dibuja la gráfica del número de ocurrencias de los n primeros números primos en los k primeros dígitos de pi. Por ejemplo, (graficaPrimosEnPi 10 (10^4)) dibuja

(graficaPrimosEnPi 10 (10^6)) dibuja

y (graficaPrimosEnPi 50 (10^5)) dibuja

Soluciones

import Data.List               ( isPrefixOf
                               , findIndices
                               , tails )
import Data.Numbers.Primes     ( primes)
import Graphics.Gnuplot.Simple ( Attribute (Key, PNG)
                               , plotList )

-- Definición de nOcurrenciasPrimosEnPi
-- ====================================

nOcurrenciasPrimosEnPi :: Int -> Int -> IO [Int]
nOcurrenciasPrimosEnPi n k = do
  (_:_:ds) <- readFile "Digitos_de_pi.txt"
  let ps = take n primes
  let es = take k ds
  return [nOcurrencias (show x) es | x <- ps]

-- (nOcurrencias xs yss) es el número de ocurrencias de xs en yss. Por
-- ejemplo,
--    nOcurrencias "ac" "acbadcacaac"  ==  3
nOcurrencias :: Eq a => [a] -> [a] -> Int
nOcurrencias xs yss = length (ocurrencias xs yss)

-- (ocurrencias xs yss) es el índice de las posiciones del primer
-- elemento de xs en las ocurrencias de xs en yss. Por ejemplo,
--    ocurrencias "ac" "acbadcacaac"  ==  [0,6,9]
ocurrencias :: Eq a => [a] -> [a] -> [Int]
ocurrencias xs yss =
  findIndices (xs `isPrefixOf`) (tails yss)

-- Definición de graficaPrimosEnPi
-- ===============================

graficaPrimosEnPi :: Int -> Int -> IO ()
graficaPrimosEnPi n k = do
  xs <- nOcurrenciasPrimosEnPi n k
  plotList [ Key Nothing
           , PNG ("Numeros_primos_en_pi_" ++ show (n,k) ++ ".png")  
           ]
           xs

import Data.List ( isPrefixOf

, findIndices

, tails )

import Data.Numbers.Primes ( primes)

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

, plotList )

-- Definición de nOcurrenciasPrimosEnPi

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

nOcurrenciasPrimosEnPi :: Int -> Int -> IO [Int]

nOcurrenciasPrimosEnPi n k = do

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

let ps = take n primes

let es = take k ds

return [nOcurrencias (show x) es | x <- ps]

-- (nOcurrencias xs yss) es el número de ocurrencias de xs en yss. Por

-- ejemplo,

-- nOcurrencias "ac" "acbadcacaac" == 3

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

nOcurrencias xs yss = length (ocurrencias xs yss)

-- (ocurrencias xs yss) es el índice de las posiciones del primer

-- elemento de xs en las ocurrencias de xs en yss. Por ejemplo,

-- ocurrencias "ac" "acbadcacaac" == [0,6,9]

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

ocurrencias xs yss =

findIndices (xs `isPrefixOf`) (tails yss)

-- Definición de graficaPrimosEnPi

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

graficaPrimosEnPi :: Int -> Int -> IO ()

graficaPrimosEnPi n k = do

xs <- nOcurrenciasPrimosEnPi n k

plotList [ Key Nothing

, PNG ("Numeros_primos_en_pi_" ++ show (n,k) ++ ".png")

]

Pensamiento

Al borde del sendero un día nos sentamos.
Ya nuestra vida es tiempo, y nuestra sola cuita
son las desesperantes posturas que tomamos
para aguardar … Mas ella no faltará a la cita.

Antonio Machado

Soluciones de x² = y³ = k

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

Definir la función

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

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

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

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

λ> take 6 soluciones

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

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

(27000810008100027,90001800009,729043741093514580109350437400729)

Soluciones

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

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

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

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

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

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

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

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

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

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

-- 1ª solución

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

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

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

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

-- λ> take 20 enteros

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

enteros :: [Integer]

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

-- 2ª solución

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

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

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

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

-- 3ª solución

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

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

soluciones3 =

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

, let Just x' = raiz 2 k

, let Just y = raiz 3 k

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

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

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

-- raiz 2 16 == Just 4

-- raiz 3 216 == Just 6

-- raiz 5 216 == Nothing

raiz :: Int -> Integer -> Maybe Integer

raiz _ 1 = Just 1

raiz n x = aux (0,x)

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

| c == a = Nothing

| d < x = aux (c,b)

| otherwise = aux (a,c)

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

d = c^n

-- Comparación de eficiencia

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

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

-- (27000810008100027,90001800009,729043741093514580109350437400729)

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

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

-- (27000810008100027,90001800009,729043741093514580109350437400729)

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

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

-- (27000810008100027,90001800009,729043741093514580109350437400729)

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

Pensamiento

Leyendo a Cervantes me parece comprenderlo todo.

Antonio Machado

Intersección de listas infinitas crecientes

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

Definir la función

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

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

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

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

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

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

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

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

Soluciones

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

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

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

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

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

-- 1ª solución

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

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

interseccion [xs] = xs

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

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

interseccionDos (x:xs) (y:ys)

| x == y = x : interseccionDos xs ys

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

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

-- 2ª solución

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

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

interseccion2 = foldl1 interseccionDos

Pensamiento

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

Antonio Machado

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

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

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

multiplicar por dos
restar uno.

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

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

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

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

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

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

Definir las siguientes funciones

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

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

tales que

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

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

λ> arbolOp 4 1

N 4 (H 8) (H 3)

λ> arbolOp 4 2

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

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

λ> arbolOp 2 3

N 2 (N 4

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

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

(N 1

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

(H 0))

λ> arbolOp 2 4

N 2 (N 4 (N 8

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

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

(N 3

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

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

(N 1 (N 2

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

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

(H 0))

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

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

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

Soluciones

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

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

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

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

data Arbol = H Int

| N Int Arbol Arbol

deriving (Show, Eq)

arbolOp :: Int -> Int -> Arbol

arbolOp 0 _ = H 0

arbolOp x 0 = H x

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

ocurre :: Int -> Arbol -> Bool

ocurre x (H y) = x == y

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

minNOp :: Int -> Int -> Int

minNOp x y =

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

, ocurre y (arbolOp x n)]

Pensamiento

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

Antonio Machado

Números altamente compuestos

PorJosé A. Alonso 16-enero-201923-enero-2019

Un número altamente compuesto es un entero positivo con más divisores que cualquier entero positivo más pequeño. Por ejemplo,

4 es un número altamente compuesto porque es el menor con 3 divisores,
5 no es altamente compuesto porque tiene menos divisores que 4 y
6 es un número altamente compuesto porque es el menor con 4 divisores,

Los primeros números altamente compuestos son

   1, 2, 4, 6, 12, 24, 36, 48, 60, 120, 180, 240, 360, ...

1	1, 2, 4, 6, 12, 24, 36, 48, 60, 120, 180, 240, 360, ...

Definir las funciones

   esAltamenteCompuesto       :: Int -> Bool
   altamenteCompuestos        :: [Int]
   graficaAltamenteCompuestos :: Int -> IO ()

esAltamenteCompuesto :: Int -> Bool

altamenteCompuestos :: [Int]

graficaAltamenteCompuestos :: Int -> IO ()

tales que

(esAltamanteCompuesto x) se verifica si x es altamente compuesto. Por ejemplo,

     esAltamenteCompuesto 4      ==  True
     esAltamenteCompuesto 5      ==  False
     esAltamenteCompuesto 6      ==  True
     esAltamenteCompuesto 1260   ==  True
     esAltamenteCompuesto 2520   ==  True
     esAltamenteCompuesto 27720  ==  True

esAltamenteCompuesto 4 == True

esAltamenteCompuesto 5 == False

esAltamenteCompuesto 6 == True

esAltamenteCompuesto 1260 == True

esAltamenteCompuesto 2520 == True

esAltamenteCompuesto 27720 == True

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

     λ> take 20 altamenteCompuestos
     [1,2,4,6,12,24,36,48,60,120,180,240,360,720,840,1260,1680,2520,5040,7560]

1 2	λ> take 20 altamenteCompuestos [1,2,4,6,12,24,36,48,60,120,180,240,360,720,840,1260,1680,2520,5040,7560]

(graficaAltamenteCompuestos n) dibuja la gráfica de los n primeros números altamente compuestos. Por ejemplo, (graficaAltamenteCompuestos 25) dibuja

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primeFactors)
import Graphics.Gnuplot.Simple

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

esAltamenteCompuesto :: Int -> Bool
esAltamenteCompuesto x =
  and [nDivisores x > nDivisores y | y <- [1..x-1]]

-- (nDivisores x) es el número de divisores de x. Por ejemplo,
--    nDivisores 30  ==  8
nDivisores :: Int -> Int
nDivisores x = length (divisores x)

-- (divisores x) es la lista de los divisores de x. Por ejemplo,
--    divisores 30  ==  [1,2,3,5,6,10,15,30]
divisores :: Int -> [Int]
divisores x =
  [y | y <- [1..x]
     , x `mod` y == 0]

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

esAltamenteCompuesto2 :: Int -> Bool
esAltamenteCompuesto2 x =
  all (nDivisores2 x >) [nDivisores2 y | y <- [1..x-1]]

-- (nDivisores2 x) es el número de divisores de x. Por ejemplo,
--    nDivisores2 30  ==  8
nDivisores2 :: Int -> Int
nDivisores2 = succ . length . divisoresPropios

-- (divisoresPropios x) es la lista de los divisores de x menores que
-- x. Por ejemplo, 
--    divisoresPropios 30  ==  [1,2,3,5,6,10,15]
divisoresPropios :: Int -> [Int]
divisoresPropios x =
  [y | y <- [1..x `div` 2]
     , x `mod` y == 0]

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

esAltamenteCompuesto3 :: Int -> Bool
esAltamenteCompuesto3 x =
  all (nDivisores3 x >) [nDivisores3 y | y <- [1..x-1]]

-- (nDivisores3 x) es el número de divisores de x. Por ejemplo,
--    nDivisores3 30  ==  8
nDivisores3 :: Int -> Int
nDivisores3 x =
  product [1 + length xs | xs <- group (primeFactors x)]

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

esAltamenteCompuesto4 :: Int -> Bool
esAltamenteCompuesto4 x =
  x `pertenece` altamenteCompuestos2

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

altamenteCompuestos :: [Int]
altamenteCompuestos =
  filter esAltamenteCompuesto4 [1..]

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

altamenteCompuestos2 :: [Int]
altamenteCompuestos2 =
  1 : [y | ((x,n),(y,m)) <- zip sucMaxDivisores (tail sucMaxDivisores)
         , m > n]

-- sucMaxDivisores es la sucesión formada por los números enteros
-- positivos y el máximo número de divisores hasta cada número. Por
-- ejemplo,
--    λ> take 12 sucMaxDivisores
--    [(1,1),(2,2),(3,2),(4,3),(5,3),(6,4),(7,4),(8,4),(9,4),(10,4),(11,4),(12,6)]
sucMaxDivisores :: [(Int,Int)]
sucMaxDivisores =
  zip [1..] (scanl1 max (map nDivisores3 [1..]))

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

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

--    λ> esAltamenteCompuesto 1260
--    True
--    (2.99 secs, 499,820,296 bytes)
--    λ> esAltamenteCompuesto2 1260
--    True
--    (0.51 secs, 83,902,744 bytes)
--    λ> esAltamenteCompuesto3 1260
--    True
--    (0.04 secs, 15,294,192 bytes)
--    λ> esAltamenteCompuesto4 1260
--    True
--    (0.04 secs, 15,594,392 bytes)
--    
--    λ> esAltamenteCompuesto2 2520
--    True
--    (2.10 secs, 332,940,168 bytes)
--    λ> esAltamenteCompuesto3 2520
--    True
--    (0.09 secs, 37,896,168 bytes)
--    λ> esAltamenteCompuesto4 2520
--    True
--    (0.06 secs, 23,087,456 bytes)
--
--    λ> esAltamenteCompuesto3 27720
--    True
--    (1.32 secs, 841,010,624 bytes)
--    λ> esAltamenteCompuesto4 27720
--    True
--    (1.33 secs, 810,870,384 bytes)

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

--    λ> altamenteCompuestos !! 25
--    45360
--    (2.84 secs, 1,612,045,976 bytes)
--    λ> altamenteCompuestos2 !! 25
--    45360
--    (0.01 secs, 102,176 bytes)

-- Definición de graficaAltamenteCompuestos
-- ========================================

graficaAltamenteCompuestos :: Int -> IO ()
graficaAltamenteCompuestos n =
  plotList [ Key Nothing
           , PNG ("Numeros_altamente_compuestos.png")
           ]
           (take n altamenteCompuestos2)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

import Data.List (group)

import Data.Numbers.Primes (primeFactors)

import Graphics.Gnuplot.Simple

-- 1ª definición de esAltamenteCompuesto

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

esAltamenteCompuesto :: Int -> Bool

esAltamenteCompuesto x =

and [nDivisores x > nDivisores y | y <- [1..x-1]]

-- (nDivisores x) es el número de divisores de x. Por ejemplo,

-- nDivisores 30 == 8

nDivisores :: Int -> Int

nDivisores x = length (divisores x)

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

-- divisores 30 == [1,2,3,5,6,10,15,30]

divisores :: Int -> [Int]

divisores x =

[y | y <- [1..x]

, x `mod` y == 0]

-- 2ª definición de esAltamenteCompuesto

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

esAltamenteCompuesto2 :: Int -> Bool

esAltamenteCompuesto2 x =

all (nDivisores2 x >) [nDivisores2 y | y <- [1..x-1]]

-- (nDivisores2 x) es el número de divisores de x. Por ejemplo,

-- nDivisores2 30 == 8

nDivisores2 :: Int -> Int

nDivisores2 = succ . length . divisoresPropios

-- (divisoresPropios x) es la lista de los divisores de x menores que

-- x. Por ejemplo,

-- divisoresPropios 30 == [1,2,3,5,6,10,15]

divisoresPropios :: Int -> [Int]

divisoresPropios x =

[y | y <- [1..x `div` 2]

, x `mod` y == 0]

-- 3ª definición de esAltamenteCompuesto

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

esAltamenteCompuesto3 :: Int -> Bool

esAltamenteCompuesto3 x =

all (nDivisores3 x >) [nDivisores3 y | y <- [1..x-1]]

-- (nDivisores3 x) es el número de divisores de x. Por ejemplo,

-- nDivisores3 30 == 8

nDivisores3 :: Int -> Int

nDivisores3 x =

product [1 + length xs | xs <- group (primeFactors x)]

-- 4ª definición de esAltamenteCompuesto

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

esAltamenteCompuesto4 :: Int -> Bool

esAltamenteCompuesto4 x =

x `pertenece` altamenteCompuestos2

-- 1ª definición de altamenteCompuestos

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

altamenteCompuestos :: [Int]

altamenteCompuestos =

filter esAltamenteCompuesto4 [1..]

-- 2ª definición de altamenteCompuestos

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

altamenteCompuestos2 :: [Int]

altamenteCompuestos2 =

1 : [y | ((x,n),(y,m)) <- zip sucMaxDivisores (tail sucMaxDivisores)

, m > n]

-- sucMaxDivisores es la sucesión formada por los números enteros

-- positivos y el máximo número de divisores hasta cada número. Por

-- ejemplo,

-- λ> take 12 sucMaxDivisores

-- [(1,1),(2,2),(3,2),(4,3),(5,3),(6,4),(7,4),(8,4),(9,4),(10,4),(11,4),(12,6)]

sucMaxDivisores :: [(Int,Int)]

sucMaxDivisores =

zip [1..] (scanl1 max (map nDivisores3 [1..]))

pertenece :: Int -> [Int] -> Bool

pertenece x ys =

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

-- Comparación de eficiencia de esAltamenteCompuesto

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

-- λ> esAltamenteCompuesto 1260

-- True

-- (2.99 secs, 499,820,296 bytes)

-- λ> esAltamenteCompuesto2 1260

-- True

-- (0.51 secs, 83,902,744 bytes)

-- λ> esAltamenteCompuesto3 1260

-- True

-- (0.04 secs, 15,294,192 bytes)

-- λ> esAltamenteCompuesto4 1260

-- True

-- (0.04 secs, 15,594,392 bytes)

-- λ> esAltamenteCompuesto2 2520

-- True

-- (2.10 secs, 332,940,168 bytes)

-- λ> esAltamenteCompuesto3 2520

-- True

-- (0.09 secs, 37,896,168 bytes)

-- λ> esAltamenteCompuesto4 2520

-- True

-- (0.06 secs, 23,087,456 bytes)

-- λ> esAltamenteCompuesto3 27720

-- True

-- (1.32 secs, 841,010,624 bytes)

-- λ> esAltamenteCompuesto4 27720

-- True

-- (1.33 secs, 810,870,384 bytes)

-- Comparación de eficiencia de altamenteCompuestos

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

-- λ> altamenteCompuestos !! 25

-- 45360

-- (2.84 secs, 1,612,045,976 bytes)

-- λ> altamenteCompuestos2 !! 25

-- 45360

-- (0.01 secs, 102,176 bytes)

-- Definición de graficaAltamenteCompuestos

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

graficaAltamenteCompuestos :: Int -> IO ()

graficaAltamenteCompuestos n =

plotList [ Key Nothing

, PNG ("Numeros_altamente_compuestos.png")

]

(take n altamenteCompuestos2)

Pensamiento

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

Antonio Machado

Ofertas 3 por 2

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

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

Definir la función

   minimoConOferta :: [Int] -> Int

1	minimoConOferta :: [Int] -> Int

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

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

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

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

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

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

import Data.List ( sort

, sortOn)

import Data.Ord ( Down(..))

-- 1ª solución

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

minimoConOferta :: [Int] -> Int

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

sinTerceros :: [a] -> [a]

sinTerceros [] = []

sinTerceros [x] = [x]

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

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

-- 2ª solución

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

minimoConOferta2 :: [Int] -> Int

minimoConOferta2 = sum . sinTerceros . reverse . sort

-- 3ª solución

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

minimoConOferta3 :: [Int] -> Int

minimoConOferta3 = sum . sinTerceros . sortOn Down

-- 4ª solución

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

minimoConOferta4 :: [Int] -> Int

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

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

aux as n = n + sum as

-- 5ª solución

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

minimoConOferta5 :: [Int] -> Int

minimoConOferta5 xs = aux (sortOn Down xs) 0

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

aux as n = n + sum as

Pensamiento

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

Antonio Machado

Mayor prefijo con suma acotada

PorJosé A. Alonso 11-enero-201918-enero-2019

Definir la función

   mayorPrefijoAcotado :: [Int] -> Int -> [Int]

1	mayorPrefijoAcotado :: [Int] -> Int -> [Int]

tal que (mayorPrefijoAcotado xs y) es el mayor prefijo de la lista de los números enteros positivos xs cuya suma es menor o igual que y. Por ejemplo,

   mayorPrefijoAcotado [45,30,55,20,80,20] 75   ==  [45,30]
   mayorPrefijoAcotado [45,30,55,20,80,20] 140  ==  [45,30,55]
   mayorPrefijoAcotado [45,30,55,20,80,20] 180  ==  [45,30,55,20]
   length (mayorPrefijoAcotado (repeat 1) (8*10^6)) == 8000000

mayorPrefijoAcotado [45,30,55,20,80,20] 75 == [45,30]

mayorPrefijoAcotado [45,30,55,20,80,20] 140 == [45,30,55]

mayorPrefijoAcotado [45,30,55,20,80,20] 180 == [45,30,55,20]

length (mayorPrefijoAcotado (repeat 1) (8*10^6)) == 8000000

Soluciones

import Data.List (inits)

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

mayorPrefijoAcotado :: [Int] -> Int -> [Int]
mayorPrefijoAcotado [] _     = []
mayorPrefijoAcotado (x:xs) y
  | x > y     = []
  | otherwise = x : mayorPrefijoAcotado xs (y-x)

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

mayorPrefijoAcotado2 :: [Int] -> Int -> [Int]
mayorPrefijoAcotado2 xs y =
  take (longitudMayorPrefijoAcotado2 xs y) xs

longitudMayorPrefijoAcotado2 :: [Int] -> Int -> Int
longitudMayorPrefijoAcotado2 xs y =
  length (takeWhile (<=y) (map sum (inits xs))) - 1

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

mayorPrefijoAcotado3 :: [Int] -> Int -> [Int]
mayorPrefijoAcotado3 xs y =
  take (longitudMayorPrefijoAcotado3 xs y) xs

longitudMayorPrefijoAcotado3 :: [Int] -> Int -> Int
longitudMayorPrefijoAcotado3 xs y =
  length (takeWhile (<= y) (scanl1 (+) xs))

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

-- La propiedad es
prop_equiv :: [Int] -> Int -> Bool
prop_equiv xs y =
  mayorPrefijoAcotado xs' y' == mayorPrefijoAcotado2 xs' y' &&
  mayorPrefijoAcotado xs' y' == mayorPrefijoAcotado3 xs' y' 
  where xs' = map abs xs
        y'  = abs y

-- La comprobación es
--    λ> quickCheck prop_equiv
--    +++ OK, passed 100 tests.
--    (0.01 secs, 2,463,688 bytes)

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

--    λ> length (mayorPrefijoAcotado (repeat 1) (2*10^4))
--    20000
--    (0.04 secs, 5,086,544 bytes)
--    λ> length (mayorPrefijoAcotado2 (repeat 1) (2*10^4))
--    20000
--    (11.22 secs, 27,083,980,168 bytes)
--    λ> length (mayorPrefijoAcotado3 (repeat 1) (2*10^4))
--    20000
--    (0.02 secs, 4,768,992 bytes)
--    
--    λ> length (mayorPrefijoAcotado (repeat 1) (8*10^6))
--    8000000
--    (3.19 secs, 1,984,129,832 bytes)
--    λ> length (mayorPrefijoAcotado3 (repeat 1) (8*10^6))
--    8000000
--    (1.02 secs, 1,856,130,936 bytes)

import Data.List (inits)

-- 1ª solución

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

mayorPrefijoAcotado :: [Int] -> Int -> [Int]

mayorPrefijoAcotado [] _ = []

mayorPrefijoAcotado (x:xs) y

| x > y = []

| otherwise = x : mayorPrefijoAcotado xs (y-x)

-- 2ª solución

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

mayorPrefijoAcotado2 :: [Int] -> Int -> [Int]

mayorPrefijoAcotado2 xs y =

take (longitudMayorPrefijoAcotado2 xs y) xs

longitudMayorPrefijoAcotado2 :: [Int] -> Int -> Int

longitudMayorPrefijoAcotado2 xs y =

length (takeWhile (<=y) (map sum (inits xs))) - 1

-- 3ª solución

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

mayorPrefijoAcotado3 :: [Int] -> Int -> [Int]

mayorPrefijoAcotado3 xs y =

take (longitudMayorPrefijoAcotado3 xs y) xs

longitudMayorPrefijoAcotado3 :: [Int] -> Int -> Int

longitudMayorPrefijoAcotado3 xs y =

length (takeWhile (<= y) (scanl1 (+) xs))

-- Equivalencia

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

-- La propiedad es

prop_equiv :: [Int] -> Int -> Bool

prop_equiv xs y =

mayorPrefijoAcotado xs' y' == mayorPrefijoAcotado2 xs' y' &&

mayorPrefijoAcotado xs' y' == mayorPrefijoAcotado3 xs' y'

where xs' = map abs xs

y' = abs y

-- La comprobación es

-- λ> quickCheck prop_equiv

-- +++ OK, passed 100 tests.

-- (0.01 secs, 2,463,688 bytes)

-- Comparación de eficiencia

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

-- λ> length (mayorPrefijoAcotado (repeat 1) (2*10^4))

-- 20000

-- (0.04 secs, 5,086,544 bytes)

-- λ> length (mayorPrefijoAcotado2 (repeat 1) (2*10^4))

-- 20000

-- (11.22 secs, 27,083,980,168 bytes)

-- λ> length (mayorPrefijoAcotado3 (repeat 1) (2*10^4))

-- 20000

-- (0.02 secs, 4,768,992 bytes)

-- λ> length (mayorPrefijoAcotado (repeat 1) (8*10^6))

-- 8000000

-- (3.19 secs, 1,984,129,832 bytes)

-- λ> length (mayorPrefijoAcotado3 (repeat 1) (8*10^6))

-- 8000000

-- (1.02 secs, 1,856,130,936 bytes)

Pensamiento

Sed hombres de mal gusto. Yo os aconsejo el mal gusto para combatir los excesos de la moda.

Antonio Machado

Subárboles monovalorados

PorJosé A. Alonso 10-enero-201917-enero-2019

Los árboles binarios con valores enteros se pueden representar mediante el tipo Arbol definido por

   data Arbol = H Int 
              | N Int Arbol Arbol
              deriving Show

data Arbol = H Int

| N Int Arbol Arbol

deriving Show

Por ejemplo, el árbol

         7
        / \ 
       /   \
      /     \
     4       9
    / \     / \
   1   3   5   6

/ \

4 9

/ \ / \

1 3 5 6

se puede representar por

   N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))

1	N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))

Un árbol es monovalorado si todos sus elementos son iguales. Por ejemplo, de los siguientes árboles sólo son monovalorados los dos primeros

    5          9           5          9    
   / \        / \         / \        / \   
  5   5      9   9       5   6      9   7  
                / \                    / \ 
               9   9                  9   9

5 9 5 9

/ \ / \ / \ / \

5 5 9 9 5 6 9 7

/ \ / \

9 9 9 9

Definir la función

   monovalorados :: Arbol -> [Arbol]

1	monovalorados :: Arbol -> [Arbol]

tal que (monovalorados a) es la lista de los subárboles monovalorados de a. Por ejemplo,

   λ> monovalorados (N 5 (H 5) (H 5))
   [N 5 (H 5) (H 5),H 5,H 5]
   λ> monovalorados (N 5 (H 5) (H 6))
   [H 5,H 6]
   λ> monovalorados (N 9 (H 9) (N 9 (H 9) (H 9)))
   [N 9 (H 9) (N 9 (H 9) (H 9)),H 9,N 9 (H 9) (H 9),H 9,H 9]
   λ> monovalorados (N 9 (H 9) (N 7 (H 9) (H 9)))
   [H 9,H 9,H 9]
   λ> monovalorados (N 9 (H 9) (N 9 (H 7) (H 9)))
   [H 9,H 7,H 9]

λ> monovalorados (N 5 (H 5) (H 5))

[N 5 (H 5) (H 5),H 5,H 5]

λ> monovalorados (N 5 (H 5) (H 6))

[H 5,H 6]

λ> monovalorados (N 9 (H 9) (N 9 (H 9) (H 9)))

[N 9 (H 9) (N 9 (H 9) (H 9)),H 9,N 9 (H 9) (H 9),H 9,H 9]

λ> monovalorados (N 9 (H 9) (N 7 (H 9) (H 9)))

[H 9,H 9,H 9]

λ> monovalorados (N 9 (H 9) (N 9 (H 7) (H 9)))

[H 9,H 7,H 9]

Soluciones

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

monovalorados :: Arbol -> [Arbol]
monovalorados (H x) = [H x]
monovalorados (N x i d) 
    | todosIguales i x && todosIguales d x =
        (N x i d) : (subarboles i ++ subarboles d)
    | otherwise = monovalorados i ++ monovalorados d

-- (todosIguales a x) se verifica si todos los valores de los nodos y
-- las hojas del árbol a son iguales a x.
todosIguales :: Arbol -> Int -> Bool
todosIguales (H y) x     = y == x
todosIguales (N y i d) x = y == x && todosIguales i x && todosIguales d x

-- (subarboles a) es la lista de los subárboles de a.
subarboles :: Arbol -> [Arbol]
subarboles (H x)     = [H x]
subarboles (N x i d) = (N x i d) : (subarboles i ++ subarboles d)

data Arbol = H Int

| N Int Arbol Arbol

deriving (Show, Eq)

monovalorados :: Arbol -> [Arbol]

monovalorados (H x) = [H x]

monovalorados (N x i d)

| todosIguales i x && todosIguales d x =

(N x i d) : (subarboles i ++ subarboles d)

| otherwise = monovalorados i ++ monovalorados d

-- (todosIguales a x) se verifica si todos los valores de los nodos y

-- las hojas del árbol a son iguales a x.

todosIguales :: Arbol -> Int -> Bool

todosIguales (H y) x = y == x

todosIguales (N y i d) x = y == x && todosIguales i x && todosIguales d x

-- (subarboles a) es la lista de los subárboles de a.

subarboles :: Arbol -> [Arbol]

subarboles (H x) = [H x]

subarboles (N x i d) = (N x i d) : (subarboles i ++ subarboles d)

Pensamiento

Y nadie pregunta
ni nadie contesta,
todos hablan solos.

Antonio Machado

El teorema de Navidad de Fermat

PorJosé A. Alonso 31-diciembre-201825-abril-2021

El 25 de diciembre de 1640, en una carta a Mersenne, Fermat demostró la conjetura de Girard: todo primo de la forma 4n+1 puede expresarse de manera única como suma de dos cuadrados. Por eso es conocido como el teorema de Navidad de Fermat.

Definir las funciones

   representaciones :: Integer -> [(Integer,Integer)]
   primosImparesConRepresentacionUnica :: [Integer]
   primos4nM1 :: [Integer]

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

primosImparesConRepresentacionUnica :: [Integer]

primos4nM1 :: [Integer]

tales que

(representaciones n) es la lista de pares de números naturales (x,y) tales que n = x^2 + y^2 con x <= y. Por ejemplo.

     representaciones  20           ==  [(2,4)]
     representaciones  25           ==  [(0,5),(3,4)]
     representaciones 325           ==  [(1,18),(6,17),(10,15)]
     representaciones 100000147984  ==  [(0,316228)]
     length (representaciones (10^10))    ==  6
     length (representaciones (4*10^12))  ==  7

representaciones 20 == [(2,4)]

representaciones 25 == [(0,5),(3,4)]

representaciones 325 == [(1,18),(6,17),(10,15)]

representaciones 100000147984 == [(0,316228)]

length (representaciones (10^10)) == 6

length (representaciones (4*10^12)) == 7

primosImparesConRepresentacionUnica es la lista de los números primos impares que se pueden escribir exactamente de una manera como suma de cuadrados de pares de números naturales (x,y) con x <= y. Por ejemplo,

     λ> take 20 primosImparesConRepresentacionUnica
     [5,13,17,29,37,41,53,61,73,89,97,101,109,113,137,149,157,173,181,193]

1 2	λ> take 20 primosImparesConRepresentacionUnica [5,13,17,29,37,41,53,61,73,89,97,101,109,113,137,149,157,173,181,193]

primos4nM1 es la lista de los números primos que se pueden escribir como uno más un múltiplo de 4 (es decir, que son congruentes con 1 módulo 4). Por ejemplo,

     λ> take 20 primos4nM1
     [5,13,17,29,37,41,53,61,73,89,97,101,109,113,137,149,157,173,181,193]

1 2	λ> take 20 primos4nM1 [5,13,17,29,37,41,53,61,73,89,97,101,109,113,137,149,157,173,181,193]

Comprobar con QuickCheck el torema de Navidad de Fermat; es decir, que para todo número n, los n-ésimos elementos de primosImparesConRepresentacionUnica y de primos4nM1 son iguales.

Soluciones

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

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

representaciones :: Integer -> [(Integer,Integer)]
representaciones n =
  [(x,y) | x <- [0..n], y <- [x..n], n == x*x + y*y]

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

representaciones2 :: Integer -> [(Integer,Integer)]
representaciones2 n =
  [(x,raiz z) | x <- [0..raiz (n `div` 2)] 
              , let z = n - x*x
              , esCuadrado z]

-- (esCuadrado x) se verifica si x es un número al cuadrado. Por
-- ejemplo,
--    esCuadrado 25  ==  True
--    esCuadrado 26  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x = x == y * y
  where y = raiz x

-- (raiz x) es la raíz cuadrada entera de x. Por ejemplo,
--    raiz 25  ==  5
--    raiz 24  ==  4
--    raiz 26  ==  5
raiz :: Integer -> Integer 
raiz 0 = 0
raiz 1 = 1
raiz x = aux (0,x)
    where aux (a,b) | d == x    = c
                    | c == a    = a
                    | d < x     = aux (c,b)
                    | otherwise = aux (a,c) 
              where c = (a+b) `div` 2
                    d = c^2

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

representaciones3 :: Integer -> [(Integer,Integer)]
representaciones3 n =
  [(x,raiz3 z) | x <- [0..raiz3 (n `div` 2)] 
               , let z = n - x*x
               , esCuadrado3 z]

-- (esCuadrado x) se verifica si x es un número al cuadrado. Por
-- ejemplo,
--    esCuadrado3 25  ==  True
--    esCuadrado3 26  ==  False
esCuadrado3 :: Integer -> Bool
esCuadrado3 x = x == y * y
  where y = raiz3 x

-- (raiz3 x) es la raíz cuadrada entera de x. Por ejemplo,
--    raiz3 25  ==  5
--    raiz3 24  ==  4
--    raiz3 26  ==  5
raiz3 :: Integer -> Integer
raiz3 x = floor (sqrt (fromIntegral x))
          
-- 4ª definición de representaciones
-- =================================
 
representaciones4 :: Integer -> [(Integer, Integer)]
representaciones4 n = aux 0 (floor (sqrt (fromIntegral n)))
  where aux x y
          | x > y     = [] 
          | otherwise = case compare (x*x + y*y) n of
                          LT -> aux (x + 1) y
                          EQ -> (x, y) : aux (x + 1) (y - 1)
                          GT -> aux x (y - 1)

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

-- La propiedad es
prop_representaciones_equiv :: (Positive Integer) -> Bool
prop_representaciones_equiv (Positive n) =
  representaciones  n == representaciones2 n &&
  representaciones2 n == representaciones3 n &&
  representaciones3 n == representaciones4 n

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

-- Comparación de eficiencia de las definiciones de representaciones
-- =================================================================

--    λ> representaciones 3025
--    [(0,55),(33,44)]
--    (2.86 secs, 1,393,133,528 bytes)
--    λ> representaciones2 3025
--    [(0,55),(33,44)]
--    (0.00 secs, 867,944 bytes)
--    λ> representaciones3 3025
--    [(0,55),(33,44)]
--    (0.00 secs, 173,512 bytes)
--    λ> representaciones4 3025
--    [(0,55),(33,44)]
--    (0.00 secs, 423,424 bytes)
--    
--    λ> length (representaciones2 (10^10))
--    6
--    (3.38 secs, 2,188,903,544 bytes)
--    λ> length (representaciones3 (10^10))
--    6
--    (0.10 secs, 62,349,048 bytes)
--    λ> length (representaciones4 (10^10))
--    6
--    (0.11 secs, 48,052,360 bytes)
--
--    λ> length (representaciones3 (4*10^12))
--    7
--    (1.85 secs, 1,222,007,176 bytes)
--    λ> length (representaciones4 (4*10^12))
--    7
--    (1.79 secs, 953,497,480 bytes)

-- Definición de primosImparesConRepresentacionUnica
-- =================================================

primosImparesConRepresentacionUnica :: [Integer]
primosImparesConRepresentacionUnica =
  [x | x <- tail primes
     , length (representaciones4 x) == 1]

-- Definición de primos4nM1
-- ========================

primos4nM1 :: [Integer]
primos4nM1 = [x | x <- primes
                , x `mod` 4 == 1]

-- Teorema de Navidad de Fermat
-- ============================

-- La propiedad es
prop_teoremaDeNavidadDeFermat :: Positive Int -> Bool
prop_teoremaDeNavidadDeFermat (Positive n) =
  primosImparesConRepresentacionUnica !! n == primos4nM1 !! n
             
-- La comprobación es
--    λ> quickCheck prop_teoremaDeNavidadDeFermat
--    +++ OK, passed 100 tests.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

import Data.Numbers.Primes (primes)

import Test.QuickCheck

-- 1ª definición de representaciones

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

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

representaciones n =

[(x,y) | x <- [0..n], y <- [x..n], n == x*x + y*y]

-- 2ª definición de representaciones

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

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

representaciones2 n =

[(x,raiz z) | x <- [0..raiz (n `div` 2)]

, let z = n - x*x

, esCuadrado z]

-- (esCuadrado x) se verifica si x es un número al cuadrado. Por

-- ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 26 == False

esCuadrado :: Integer -> Bool

esCuadrado x = x == y * y

where y = raiz x

-- (raiz x) es la raíz cuadrada entera de x. Por ejemplo,

-- raiz 25 == 5

-- raiz 24 == 4

-- raiz 26 == 5

raiz :: Integer -> Integer

raiz 0 = 0

raiz 1 = 1

raiz x = aux (0,x)

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

| c == a = a

| d < x = aux (c,b)

| otherwise = aux (a,c)

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

d = c^2

-- 3ª definición de representaciones

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

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

representaciones3 n =

[(x,raiz3 z) | x <- [0..raiz3 (n `div` 2)]

, let z = n - x*x

, esCuadrado3 z]

-- (esCuadrado x) se verifica si x es un número al cuadrado. Por

-- ejemplo,

-- esCuadrado3 25 == True

-- esCuadrado3 26 == False

esCuadrado3 :: Integer -> Bool

esCuadrado3 x = x == y * y

where y = raiz3 x

-- (raiz3 x) es la raíz cuadrada entera de x. Por ejemplo,

-- raiz3 25 == 5

-- raiz3 24 == 4

-- raiz3 26 == 5

raiz3 :: Integer -> Integer

raiz3 x = floor (sqrt (fromIntegral x))

-- 4ª definición de representaciones

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

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

representaciones4 n = aux 0 (floor (sqrt (fromIntegral n)))

where aux x y

| x > y = []

| otherwise = case compare (x*x + y*y) n of

LT -> aux (x + 1) y

EQ -> (x, y) : aux (x + 1) (y - 1)

GT -> aux x (y - 1)

-- Equivalencia de las definiciones de representaciones

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

-- La propiedad es

prop_representaciones_equiv :: (Positive Integer) -> Bool

prop_representaciones_equiv (Positive n) =

representaciones n == representaciones2 n &&

representaciones2 n == representaciones3 n &&

representaciones3 n == representaciones4 n

-- La comprobación es

-- λ> quickCheck prop_representaciones_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia de las definiciones de representaciones

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

-- λ> representaciones 3025

-- [(0,55),(33,44)]

-- (2.86 secs, 1,393,133,528 bytes)

-- λ> representaciones2 3025

-- [(0,55),(33,44)]

-- (0.00 secs, 867,944 bytes)

-- λ> representaciones3 3025

-- [(0,55),(33,44)]

-- (0.00 secs, 173,512 bytes)

-- λ> representaciones4 3025

-- [(0,55),(33,44)]

-- (0.00 secs, 423,424 bytes)

-- λ> length (representaciones2 (10^10))

-- 6

-- (3.38 secs, 2,188,903,544 bytes)

-- λ> length (representaciones3 (10^10))

-- 6

-- (0.10 secs, 62,349,048 bytes)

-- λ> length (representaciones4 (10^10))

-- 6

-- (0.11 secs, 48,052,360 bytes)

-- λ> length (representaciones3 (4*10^12))

-- 7

-- (1.85 secs, 1,222,007,176 bytes)

-- λ> length (representaciones4 (4*10^12))

-- 7

-- (1.79 secs, 953,497,480 bytes)

-- Definición de primosImparesConRepresentacionUnica

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

primosImparesConRepresentacionUnica :: [Integer]

primosImparesConRepresentacionUnica =

[x | x <- tail primes

, length (representaciones4 x) == 1]

-- Definición de primos4nM1

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

primos4nM1 :: [Integer]

primos4nM1 = [x | x <- primes

, x `mod` 4 == 1]

-- Teorema de Navidad de Fermat

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

-- La propiedad es

prop_teoremaDeNavidadDeFermat :: Positive Int -> Bool

prop_teoremaDeNavidadDeFermat (Positive n) =

primosImparesConRepresentacionUnica !! n == primos4nM1 !! n

-- La comprobación es

-- λ> quickCheck prop_teoremaDeNavidadDeFermat

-- +++ OK, passed 100 tests.

Pensamiento

– ¡Cuándo llegará otro día!
– Hoy es siempre todavía.

Antonio Machado

Árbol de subconjuntos

PorJosé A. Alonso 28-diciembre-20184-enero-2019

Se dice que A es un subconjunto maximal de B si A ⊂ B y no existe ningún C tal que A ⊂ C y C ⊂ B. Por ejemplo, {2,5} es un subconjunto maximal de {2,3,5], pero {3] no lo es.

El árbol de los subconjuntos de un conjunto A es el árbol que tiene como raíz el conjunto A y cada nodo tiene como hijos sus subconjuntos maximales. Por ejemplo, el árbol de subconjuntos de [2,3,5] es

          [2, 3, 5]
          /   |  \
         /    |   \  
        /     |    \   
       /      |     \
      /       |      \
    [5,3]   [2,3]   [2,5]  
    /  \    /  \    /  \  
   [3] [5] [3] [2] [5] [2]
    |   |   |   |   |   | 
   [ ] [ ] [ ] [ ] [ ] [ ]

[2, 3, 5]

/ | \

[5,3] [2,3] [2,5]

/ \ / \ / \

[3] [5] [3] [2] [5] [2]

| | | | | |

[ ] [ ] [ ] [ ] [ ] [ ]

Usando el tipo de dato

   data Arbol = N [Integer] [Arbol]
     deriving (Eq, Show)

1 2	data Arbol = N [Integer] [Arbol] deriving (Eq, Show)

el árbol anterior se representa por

   N [2,5,3]
     [N [5,3]
        [N [3]
           [N [] []],
         N [5]
           [N [] []]],
      N [2,3]
        [N [3]
           [N [] []],
         N [2]
           [N [] []]],
      N [2,5]
        [N [5]
           [N [] []],
         N [2]
           [N [] []]]]

N [2,5,3]

[N [5,3]

[N [3]

[N [] []],

N [5]

[N [] []]],

N [2,3]

[N [3]

[N [] []],

N [2]

[N [] []]],

N [2,5]

[N [5]

[N [] []],

N [2]

[N [] []]]]

Definir las funciones

   arbolSubconjuntos :: [Int] -> Arbol 
   nOcurrenciasArbolSubconjuntos :: [Int] -> [Int] -> Int

1 2	arbolSubconjuntos :: [Int] -> Arbol nOcurrenciasArbolSubconjuntos :: [Int] -> [Int] -> Int

tales que

(arbolSubconjuntos x) es el árbol de los subconjuntos de xs. Por ejemplo,

     λ> arbolSubconjuntos [2,5,3]
     N [2,5,3] [N [5,3] [N [3] [N [] []],N [5] [N [] []]],
                N [2,3] [N [3] [N [] []],N [2] [N [] []]],
                N [2,5] [N [5] [N [] []],N [2] [N [] []]]]

λ> arbolSubconjuntos [2,5,3]

N [2,5,3] [N [5,3] [N [3] [N [] []],N [5] [N [] []]],

N [2,3] [N [3] [N [] []],N [2] [N [] []]],

N [2,5] [N [5] [N [] []],N [2] [N [] []]]]

(nOcurrenciasArbolSubconjuntos xs ys) es el número de veces que aparece el conjunto xs en el árbol de los subconjuntos de ys. Por ejemplo,

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

nOcurrenciasArbolSubconjuntos [] [2,5,3] == 6

nOcurrenciasArbolSubconjuntos [3] [2,5,3] == 2

nOcurrenciasArbolSubconjuntos [3,5] [2,5,3] == 1

nOcurrenciasArbolSubconjuntos [3,5,2] [2,5,3] == 1

Comprobar con QuickChek que, para todo entero positivo n, el número de ocurrencia de un subconjunto xs de [1..n] en el árbol de los subconjuntos de [1..n] es el factorial de n-k (donde k es el número de elementos de xs).

Soluciones

import Data.List (delete, nub, sort, subsequences)
import Test.QuickCheck

data Arbol = N [Int] [Arbol]
  deriving (Eq, Show)

arbolSubconjuntos :: [Int] -> Arbol 
arbolSubconjuntos xs =
  N xs (map arbolSubconjuntos (subconjuntosMaximales xs))

-- (subconjuntosMaximales xs) es la lista de los subconjuntos maximales
-- de xs. Por ejemplo,
--    subconjuntosMaximales [2,5,3]  ==  [[5,3],[2,3],[2,5]]
subconjuntosMaximales :: [Int] -> [[Int]]
subconjuntosMaximales xs =
  [delete x xs | x <- xs]

-- Definición de nOcurrenciasArbolSubconjuntos
-- ===========================================

nOcurrenciasArbolSubconjuntos :: [Int] -> [Int] -> Int
nOcurrenciasArbolSubconjuntos xs ys =
  nOcurrencias xs (arbolSubconjuntos ys)

-- (nOcurrencias x a) es el número de veces que aparece x en el árbol
-- a. Por ejemplo,
--    nOcurrencias 3 (arbolSubconjuntos 30)  ==  2
nOcurrencias :: [Int] -> Arbol -> Int
nOcurrencias xs (N ys [])
  | conjunto xs == conjunto ys  = 1
  | otherwise                   = 0
nOcurrencias xs (N ys zs)
  | conjunto xs == conjunto ys = 1 + sum [nOcurrencias xs z | z <- zs]
  | otherwise                  = sum [nOcurrencias xs z | z <- zs]

-- (conjunto xs) es el conjunto ordenado correspondiente a xs. Por
-- ejemplo, 
--    conjunto [3,2,5,2,3,7,2]  ==  [2,3,5,7]
conjunto :: [Int] -> [Int]
conjunto = nub . sort

-- La propiedad es
prop_nOcurrencias :: (Positive Int) -> [Int] -> Bool
prop_nOcurrencias (Positive n) xs =
  nOcurrenciasArbolSubconjuntos ys [1..n] == factorial (n-k)
  where ys = nub [1 + x `mod` n | x <- xs]
        k  = length ys
        factorial m = product [1..m]

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

import Data.List (delete, nub, sort, subsequences)

import Test.QuickCheck

data Arbol = N [Int] [Arbol]

deriving (Eq, Show)

arbolSubconjuntos :: [Int] -> Arbol

arbolSubconjuntos xs =

N xs (map arbolSubconjuntos (subconjuntosMaximales xs))

-- (subconjuntosMaximales xs) es la lista de los subconjuntos maximales

-- de xs. Por ejemplo,

-- subconjuntosMaximales [2,5,3] == [[5,3],[2,3],[2,5]]

subconjuntosMaximales :: [Int] -> [[Int]]

subconjuntosMaximales xs =

[delete x xs | x <- xs]

-- Definición de nOcurrenciasArbolSubconjuntos

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

nOcurrenciasArbolSubconjuntos :: [Int] -> [Int] -> Int

nOcurrenciasArbolSubconjuntos xs ys =

nOcurrencias xs (arbolSubconjuntos ys)

-- (nOcurrencias x a) es el número de veces que aparece x en el árbol

-- a. Por ejemplo,

-- nOcurrencias 3 (arbolSubconjuntos 30) == 2

nOcurrencias :: [Int] -> Arbol -> Int

nOcurrencias xs (N ys [])

| conjunto xs == conjunto ys = 1

| otherwise = 0

nOcurrencias xs (N ys zs)

| conjunto xs == conjunto ys = 1 + sum [nOcurrencias xs z | z <- zs]

| otherwise = sum [nOcurrencias xs z | z <- zs]

-- (conjunto xs) es el conjunto ordenado correspondiente a xs. Por

-- ejemplo,

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

conjunto :: [Int] -> [Int]

conjunto = nub . sort

-- La propiedad es

prop_nOcurrencias :: (Positive Int) -> [Int] -> Bool

prop_nOcurrencias (Positive n) xs =

nOcurrenciasArbolSubconjuntos ys [1..n] == factorial (n-k)

where ys = nub [1 + x `mod` n | x <- xs]

k = length ys

factorial m = product [1..m]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=9}) prop_nOcurrencias

-- +++ OK, passed 100 tests.

Pensamiento

Nunca traces tu frontera,
ni cuides de tu perfil;
todo eso es cosa de fuera.

Antonio Machado

Tablas de operaciones binarias

PorJosé A. Alonso 26-diciembre-20182-enero-2019

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

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

0 1 2 0 2 1

1 2 0 1 0 2

2 0 1 2 1 0

Suma Resta

Definir las funciones

   tablaOperacion :: (Int -> Int -> Int) -> Int -> [[Int]]
   tablaSuma      :: Int -> [[Int]]
   tablaResta     :: Int -> [[Int]]
   tablaProducto  :: Int -> [[Int]]

tablaOperacion :: (Int -> Int -> Int) -> Int -> [[Int]]

tablaSuma :: Int -> [[Int]]

tablaResta :: Int -> [[Int]]

tablaProducto :: Int -> [[Int]]

tales que

(tablaOperacion f n) es la tabla de la operación f módulo n en [0..n-1]. Por ejemplo,

     tablaOperacion (+) 3  ==  [[0,1,2],[1,2,0],[2,0,1]]
     tablaOperacion (-) 3  ==  [[0,2,1],[1,0,2],[2,1,0]]
     tablaOperacion (-) 4  ==  [[0,3,2,1],[1,0,3,2],[2,1,0,3],[3,2,1,0]]
     tablaOperacion (\x y -> abs (x-y)) 3  ==  [[0,1,2],[1,0,1],[2,1,0]]

tablaOperacion (+) 3 == [[0,1,2],[1,2,0],[2,0,1]]

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

tablaOperacion (-) 4 == [[0,3,2,1],[1,0,3,2],[2,1,0,3],[3,2,1,0]]

tablaOperacion (\x y -> abs (x-y)) 3 == [[0,1,2],[1,0,1],[2,1,0]]

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

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

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

(tablaResta n) es la tabla de la resta módulo n en [0..n-1]. Por ejemplo,

     tablaResta 3  ==  [[0,2,1],[1,0,2],[2,1,0]]
     tablaResta 4  ==  [[0,3,2,1],[1,0,3,2],[2,1,0,3],[3,2,1,0]]

1 2	tablaResta 3 == [[0,2,1],[1,0,2],[2,1,0]] tablaResta 4 == [[0,3,2,1],[1,0,3,2],[2,1,0,3],[3,2,1,0]]

(tablaProducto n) es la tabla del producto módulo n en [0..n-1]. Por ejemplo,

     tablaProducto 3  ==  [[0,0,0],[0,1,2],[0,2,1]]
     tablaProducto 4  ==  [[0,0,0,0],[0,1,2,3],[0,2,0,2],[0,3,2,1]]

1 2	tablaProducto 3 == [[0,0,0],[0,1,2],[0,2,1]] tablaProducto 4 == [[0,0,0,0],[0,1,2,3],[0,2,0,2],[0,3,2,1]]

Comprobar con QuickCheck, si parato entero positivo n de verificar las siguientes propiedades:

La suma, módulo n, de todos los números de (tablaSuma n) es 0.
La suma, módulo n, de todos los números de (tablaResta n) es 0.
La suma, módulo n, de todos los números de (tablaProducto n) es n/2 si n es el doble de un número impar y es 0, en caso contrario.

Soluciones

import Test.QuickCheck

tablaOperacion :: (Int -> Int -> Int) -> Int -> [[Int]]
tablaOperacion f n =
  [[f i j `mod` n | j <- [0..n-1]] | i <- [0..n-1]]

tablaSuma :: Int -> [[Int]]
tablaSuma = tablaOperacion (+)

tablaResta :: Int -> [[Int]]
tablaResta = tablaOperacion (-)

tablaProducto :: Int -> [[Int]]
tablaProducto = tablaOperacion (*)

-- (sumaTabla xss) es la suma, módulo n, de los elementos de la tabla de
-- operación xss (donde n es el número de elementos de xss). Por
-- ejemplo, 
--    sumaTabla [[0,2,1],[1,1,2],[2,1,0]]  ==  1
sumaTabla :: [[Int]] -> Int
sumaTabla = sum . concat

-- La propiedad de la tabla de la suma es
prop_tablaSuma :: (Positive Int) -> Bool
prop_tablaSuma (Positive n) =
  sumaTabla (tablaSuma n) == 0

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

-- La propiedad de la tabla de la resta es
prop_tablaResta :: (Positive Int) -> Bool
prop_tablaResta (Positive n) =
  sumaTabla (tablaResta n) == 0

-- La comprobación es
--    λ> quickCheck prop_tablaResta
--    +++ OK, passed 100 tests.
  
-- La propiedad de la tabla del producto es
prop_tablaProducto :: (Positive Int) -> Bool
prop_tablaProducto (Positive n)
  | even n && odd (n `div` 2) = suma == n `div` 2
  | otherwise                 = suma == 0
  where suma = sumaTabla (tablaProducto n)

import Test.QuickCheck

tablaOperacion :: (Int -> Int -> Int) -> Int -> [[Int]]

tablaOperacion f n =

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

tablaSuma :: Int -> [[Int]]

tablaSuma = tablaOperacion (+)

tablaResta :: Int -> [[Int]]

tablaResta = tablaOperacion (-)

tablaProducto :: Int -> [[Int]]

tablaProducto = tablaOperacion (*)

-- (sumaTabla xss) es la suma, módulo n, de los elementos de la tabla de

-- operación xss (donde n es el número de elementos de xss). Por

-- ejemplo,

-- sumaTabla [[0,2,1],[1,1,2],[2,1,0]] == 1

sumaTabla :: [[Int]] -> Int

sumaTabla = sum . concat

-- La propiedad de la tabla de la suma es

prop_tablaSuma :: (Positive Int) -> Bool

prop_tablaSuma (Positive n) =

sumaTabla (tablaSuma n) == 0

-- La comprobación es

-- λ> quickCheck prop_tablaSuma

-- +++ OK, passed 100 tests.

-- La propiedad de la tabla de la resta es

prop_tablaResta :: (Positive Int) -> Bool

prop_tablaResta (Positive n) =

sumaTabla (tablaResta n) == 0

-- La comprobación es

-- λ> quickCheck prop_tablaResta

-- +++ OK, passed 100 tests.

-- La propiedad de la tabla del producto es

prop_tablaProducto :: (Positive Int) -> Bool

prop_tablaProducto (Positive n)

| even n && odd (n `div` 2) = suma == n `div` 2

| otherwise = suma == 0

where suma = sumaTabla (tablaProducto n)

Pensamiento

¿Tu verdad? No, la Verdad,
y ven conmigo a buscarla.
La tuya guárdatela.

Antonio Machado

Número de divisores compuestos

PorJosé A. Alonso 25-diciembre-20181-enero-2019

Definir la función

   nDivisoresCompuestos :: Integer -> Integer

1	nDivisoresCompuestos :: Integer -> Integer

tal que (nDivisoresCompuestos x) es el número de divisores de x que son compuestos (es decir, números mayores que 1 que no son primos). Por ejemplo,

   nDivisoresCompuestos 30  ==  4
   nDivisoresCompuestos (product [1..11])  ==  534
   nDivisoresCompuestos (product [1..25])  ==  340022
   length (show (nDivisoresCompuestos (product [1..3*10^4]))) == 1948

nDivisoresCompuestos 30 == 4

nDivisoresCompuestos (product [1..11]) == 534

nDivisoresCompuestos (product [1..25]) == 340022

length (show (nDivisoresCompuestos (product [1..3*10^4]))) == 1948

Soluciones

import Data.List (genericLength, group, inits, sort)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck

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

--    nDivisoresCompuestos 30  ==  4
nDivisoresCompuestos :: Integer -> Integer
nDivisoresCompuestos =
  genericLength . divisoresCompuestos

-- (divisoresCompuestos x) es la lista de los divisores de x que
-- son números compuestos (es decir, números mayores que 1 que no son
-- primos). Por ejemplo,
--    divisoresCompuestos 30  ==  [6,10,15,30]
divisoresCompuestos :: Integer -> [Integer]
divisoresCompuestos =
  sort
  . map product
  . compuestos
  . map concat
  . productoCartesiano
  . map inits
  . group
  . primeFactors
  where compuestos xss = [xs | xs <- xss, length xs > 1]  

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos xss. Por
-- ejemplo, 
--    λ> productoCartesiano [[1,3],[2,5],[6,4]]
--    [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]
  
-- 2ª solución
-- ===========

nDivisoresCompuestos2 :: Integer -> Integer
nDivisoresCompuestos2 x =
  nDivisores x - nDivisoresPrimos x - 1

-- (nDivisores x) es el número de divisores de x. Por ejemplo, 
--    nDivisores 30  ==  8
nDivisores :: Integer -> Integer
nDivisores x =
  product [1 + genericLength xs | xs <- group (primeFactors x)]

-- (nDivisoresPrimos x) es el número de divisores primos de x. Por
-- ejemplo,  
--    nDivisoresPrimos 30  ==  3
nDivisoresPrimos :: Integer -> Integer
nDivisoresPrimos =
  genericLength . group . primeFactors 

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

nDivisoresCompuestos3 :: Integer -> Integer
nDivisoresCompuestos3 x =
  nDivisores - nDivisoresPrimos - 1
  where xss              = group (primeFactors x)
        nDivisores       = product [1 + genericLength xs | xs <-xss]
        nDivisoresPrimos = genericLength xss

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

-- La propiedad es
prop_nDivisoresCompuestos :: (Positive Integer) -> Bool
prop_nDivisoresCompuestos (Positive x) =
  all (== nDivisoresCompuestos x) [f x | f <- [ nDivisoresCompuestos2
                                              , nDivisoresCompuestos3 ]]

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

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

--    λ> nDivisoresCompuestos (product [1..25])
--    340022
--    (2.04 secs, 2,232,146,776 bytes)
--    λ> nDivisoresCompuestos2 (product [1..25])
--    340022
--    (0.00 secs, 220,192 bytes)
--    
--    λ> length (show (nDivisoresCompuestos2 (product [1..3*10^4])))
--    1948
--    (5.22 secs, 8,431,630,288 bytes)
--    λ> length (show (nDivisoresCompuestos3 (product [1..3*10^4])))
--    1948
--    (3.06 secs, 4,662,277,664 bytes)

import Data.List (genericLength, group, inits, sort)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª solución

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

-- nDivisoresCompuestos 30 == 4

nDivisoresCompuestos :: Integer -> Integer

nDivisoresCompuestos =

genericLength . divisoresCompuestos

-- (divisoresCompuestos x) es la lista de los divisores de x que

-- son números compuestos (es decir, números mayores que 1 que no son

-- primos). Por ejemplo,

-- divisoresCompuestos 30 == [6,10,15,30]

divisoresCompuestos :: Integer -> [Integer]

divisoresCompuestos =

sort

. map product

. compuestos

. map concat

. productoCartesiano

. map inits

. group

. primeFactors

where compuestos xss = [xs | xs <- xss, length xs > 1]

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos xss. Por

-- ejemplo,

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

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

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 2ª solución

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

nDivisoresCompuestos2 :: Integer -> Integer

nDivisoresCompuestos2 x =

nDivisores x - nDivisoresPrimos x - 1

-- (nDivisores x) es el número de divisores de x. Por ejemplo,

-- nDivisores 30 == 8

nDivisores :: Integer -> Integer

nDivisores x =

product [1 + genericLength xs | xs <- group (primeFactors x)]

-- (nDivisoresPrimos x) es el número de divisores primos de x. Por

-- ejemplo,

-- nDivisoresPrimos 30 == 3

nDivisoresPrimos :: Integer -> Integer

nDivisoresPrimos =

genericLength . group . primeFactors

-- 3ª solución

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

nDivisoresCompuestos3 :: Integer -> Integer

nDivisoresCompuestos3 x =

nDivisores - nDivisoresPrimos - 1

where xss = group (primeFactors x)

nDivisores = product [1 + genericLength xs | xs <-xss]

nDivisoresPrimos = genericLength xss

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_nDivisoresCompuestos :: (Positive Integer) -> Bool

prop_nDivisoresCompuestos (Positive x) =

all (== nDivisoresCompuestos x) [f x | f <- [ nDivisoresCompuestos2

, nDivisoresCompuestos3 ]]

-- La comprobación es

-- λ> quickCheck prop_nDivisoresCompuestos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> nDivisoresCompuestos (product [1..25])

-- 340022

-- (2.04 secs, 2,232,146,776 bytes)

-- λ> nDivisoresCompuestos2 (product [1..25])

-- 340022

-- (0.00 secs, 220,192 bytes)

-- λ> length (show (nDivisoresCompuestos2 (product [1..3*10^4])))

-- 1948

-- (5.22 secs, 8,431,630,288 bytes)

-- λ> length (show (nDivisoresCompuestos3 (product [1..3*10^4])))

-- 1948

-- (3.06 secs, 4,662,277,664 bytes)

Pensamiento

«Lo corriente en el hombre es la tendencia a creer verdadero cuanto le
reporta alguna utilidad. Por eso hay tantos hombres capaces de comulgar
con ruedas de molino.»

Antonio Machado

Divisores compuestos

PorJosé A. Alonso 24-diciembre-201831-diciembre-2018

Definir la función

   divisoresCompuestos :: Integer -> [Integer]

1	divisoresCompuestos :: Integer -> [Integer]

tal que (divisoresCompuestos x) es la lista de los divisores de x que son números compuestos (es decir, números mayores que 1 que no son primos). Por ejemplo,

   divisoresCompuestos 30  ==  [6,10,15,30]
   length (divisoresCompuestos (product [1..11]))  ==  534
   length (divisoresCompuestos (product [1..14]))  ==  2585
   length (divisoresCompuestos (product [1..16]))  ==  5369
   length (divisoresCompuestos (product [1..25]))  ==  340022

divisoresCompuestos 30 == [6,10,15,30]

length (divisoresCompuestos (product [1..11])) == 534

length (divisoresCompuestos (product [1..14])) == 2585

length (divisoresCompuestos (product [1..16])) == 5369

length (divisoresCompuestos (product [1..25])) == 340022

Soluciones

import Data.List (group, inits, nub, sort, subsequences)
import Data.Numbers.Primes (isPrime, primeFactors)
import Test.QuickCheck

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

divisoresCompuestos :: Integer -> [Integer]
divisoresCompuestos x =
  [y | y <- divisores x
     , y > 1
     , not (isPrime y)]

-- (divisores x) es la lista de los divisores de x. Por ejemplo,
--    divisores 30  ==  [1,2,3,5,6,10,15,30]
divisores :: Integer -> [Integer]
divisores x =
  [y | y <- [1..x]
     , x `mod` y == 0]

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

divisoresCompuestos2 :: Integer -> [Integer]
divisoresCompuestos2 x =
  [y | y <- divisores2 x
     , y > 1
     , not (isPrime y)]

-- (divisores2 x) es la lista de los divisores de x. Por ejemplo,
--    divisores2 30  ==  [1,2,3,5,6,10,15,30]
divisores2 :: Integer -> [Integer]
divisores2 x =
  [y | y <- [1..x `div` 2], x `mod` y == 0] ++ [x] 

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

divisoresCompuestos3 :: Integer -> [Integer]
divisoresCompuestos3 x =
  [y | y <- divisores2 x
     , y > 1
     , not (isPrime y)]

-- (divisores3 x) es la lista de los divisores de x. Por ejemplo,
--    divisores2 30  ==  [1,2,3,5,6,10,15,30]
divisores3 :: Integer -> [Integer]
divisores3 x =
  nub (sort (ys ++ [x `div` y | y <- ys]))
  where ys = [y | y <- [1..floor (sqrt (fromIntegral x))]
                , x `mod` y == 0]
             
-- 4ª solución
-- ===========

divisoresCompuestos4 :: Integer -> [Integer]
divisoresCompuestos4 x =
  [y | y <- divisores4 x
     , y > 1
     , not (isPrime y)]

-- (divisores4 x) es la lista de los divisores de x. Por ejemplo,
--    divisores4 30  ==  [1,2,3,5,6,10,15,30]
divisores4 :: Integer -> [Integer]
divisores4 =
  nub . sort . map product . subsequences . primeFactors

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

divisoresCompuestos5 :: Integer -> [Integer]
divisoresCompuestos5 x =
  [y | y <- divisores5 x
     , y > 1
     , not (isPrime y)]

-- (divisores5 x) es la lista de los divisores de x. Por ejemplo,
--    divisores5 30  ==  [1,2,3,5,6,10,15,30]
divisores5 :: Integer -> [Integer]
divisores5 =
  sort
  . map (product . concat)
  . productoCartesiano
  . map inits
  . group
  . primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo, 
--    λ> productoCartesiano [[1,3],[2,5],[6,4]]
--    [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]
  
-- 6ª solución
-- ===========

divisoresCompuestos6 :: Integer -> [Integer]
divisoresCompuestos6 =
  sort
  . map product
  . compuestos
  . map concat
  . productoCartesiano
  . map inits
  . group
  . primeFactors
  where compuestos xss = [xs | xs <- xss, length xs > 1]  

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

-- La propiedad es
prop_divisoresCompuestos :: (Positive Integer) -> Bool
prop_divisoresCompuestos (Positive x) =
  all (== divisoresCompuestos x) [f x | f <- [ divisoresCompuestos2
                                             , divisoresCompuestos3
                                             , divisoresCompuestos4
                                             , divisoresCompuestos5
                                             , divisoresCompuestos6 ]]

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

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

--    λ> length (divisoresCompuestos (product [1..11]))
--    534
--    (14.59 secs, 7,985,108,976 bytes)
--    λ> length (divisoresCompuestos2 (product [1..11]))
--    534
--    (7.36 secs, 3,993,461,168 bytes)
--    λ> length (divisoresCompuestos3 (product [1..11]))
--    534
--    (7.35 secs, 3,993,461,336 bytes)
--    λ> length (divisoresCompuestos4 (product [1..11]))
--    534
--    (0.07 secs, 110,126,392 bytes)
--    λ> length (divisoresCompuestos5 (product [1..11]))
--    534
--    (0.01 secs, 3,332,224 bytes)
--    λ> length (divisoresCompuestos6 (product [1..11]))
--    534
--    (0.01 secs, 1,869,776 bytes)
--    
--    λ> length (divisoresCompuestos4 (product [1..14]))
--    2585
--    (9.11 secs, 9,461,570,720 bytes)
--    λ> length (divisoresCompuestos5 (product [1..14]))
--    2585
--    (0.04 secs, 17,139,872 bytes)
--    λ> length (divisoresCompuestos6 (product [1..14]))
--    2585
--    (0.02 secs, 10,140,744 bytes)
--    
--    λ> length (divisoresCompuestos2 (product [1..16]))
--    5369
--    (1.97 secs, 932,433,176 bytes)
--    λ> length (divisoresCompuestos5 (product [1..16]))
--    5369
--    (0.03 secs, 37,452,088 bytes)
--    λ> length (divisoresCompuestos6 (product [1..16]))
--    5369
--    (0.03 secs, 23,017,480 bytes)
--    
--    λ> length (divisoresCompuestos5 (product [1..25]))
--    340022
--    (2.43 secs, 3,055,140,056 bytes)
--    λ> length (divisoresCompuestos6 (product [1..25]))
--    340022
--    (1.94 secs, 2,145,440,904 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

import Data.List (group, inits, nub, sort, subsequences)

import Data.Numbers.Primes (isPrime, primeFactors)

import Test.QuickCheck

-- 1ª solución

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

divisoresCompuestos :: Integer -> [Integer]

divisoresCompuestos x =

[y | y <- divisores x

, y > 1

, not (isPrime y)]

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

-- divisores 30 == [1,2,3,5,6,10,15,30]

divisores :: Integer -> [Integer]

divisores x =

[y | y <- [1..x]

, x `mod` y == 0]

-- 2ª solución

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

divisoresCompuestos2 :: Integer -> [Integer]

divisoresCompuestos2 x =

[y | y <- divisores2 x

, y > 1

, not (isPrime y)]

-- (divisores2 x) es la lista de los divisores de x. Por ejemplo,

-- divisores2 30 == [1,2,3,5,6,10,15,30]

divisores2 :: Integer -> [Integer]

divisores2 x =

[y | y <- [1..x `div` 2], x `mod` y == 0] ++ [x]

-- 2ª solución

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

divisoresCompuestos3 :: Integer -> [Integer]

divisoresCompuestos3 x =

[y | y <- divisores2 x

, y > 1

, not (isPrime y)]

-- (divisores3 x) es la lista de los divisores de x. Por ejemplo,

-- divisores2 30 == [1,2,3,5,6,10,15,30]

divisores3 :: Integer -> [Integer]

divisores3 x =

nub (sort (ys ++ [x `div` y | y <- ys]))

where ys = [y | y <- [1..floor (sqrt (fromIntegral x))]

, x `mod` y == 0]

-- 4ª solución

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

divisoresCompuestos4 :: Integer -> [Integer]

divisoresCompuestos4 x =

[y | y <- divisores4 x

, y > 1

, not (isPrime y)]

-- (divisores4 x) es la lista de los divisores de x. Por ejemplo,

-- divisores4 30 == [1,2,3,5,6,10,15,30]

divisores4 :: Integer -> [Integer]

divisores4 =

nub . sort . map product . subsequences . primeFactors

-- 5ª solución

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

divisoresCompuestos5 :: Integer -> [Integer]

divisoresCompuestos5 x =

[y | y <- divisores5 x

, y > 1

, not (isPrime y)]

-- (divisores5 x) es la lista de los divisores de x. Por ejemplo,

-- divisores5 30 == [1,2,3,5,6,10,15,30]

divisores5 :: Integer -> [Integer]

divisores5 =

sort

. map (product . concat)

. productoCartesiano

. map inits

. group

. primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

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

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

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 6ª solución

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

divisoresCompuestos6 :: Integer -> [Integer]

divisoresCompuestos6 =

sort

. map product

. compuestos

. map concat

. productoCartesiano

. map inits

. group

. primeFactors

where compuestos xss = [xs | xs <- xss, length xs > 1]

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_divisoresCompuestos :: (Positive Integer) -> Bool

prop_divisoresCompuestos (Positive x) =

all (== divisoresCompuestos x) [f x | f <- [ divisoresCompuestos2

, divisoresCompuestos3

, divisoresCompuestos4

, divisoresCompuestos5

, divisoresCompuestos6 ]]

-- La comprobación es

-- λ> quickCheck prop_divisoresCompuestos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> length (divisoresCompuestos (product [1..11]))

-- 534

-- (14.59 secs, 7,985,108,976 bytes)

-- λ> length (divisoresCompuestos2 (product [1..11]))

-- 534

-- (7.36 secs, 3,993,461,168 bytes)

-- λ> length (divisoresCompuestos3 (product [1..11]))

-- 534

-- (7.35 secs, 3,993,461,336 bytes)

-- λ> length (divisoresCompuestos4 (product [1..11]))

-- 534

-- (0.07 secs, 110,126,392 bytes)

-- λ> length (divisoresCompuestos5 (product [1..11]))

-- 534

-- (0.01 secs, 3,332,224 bytes)

-- λ> length (divisoresCompuestos6 (product [1..11]))

-- 534

-- (0.01 secs, 1,869,776 bytes)

-- λ> length (divisoresCompuestos4 (product [1..14]))

-- 2585

-- (9.11 secs, 9,461,570,720 bytes)

-- λ> length (divisoresCompuestos5 (product [1..14]))

-- 2585

-- (0.04 secs, 17,139,872 bytes)

-- λ> length (divisoresCompuestos6 (product [1..14]))

-- 2585

-- (0.02 secs, 10,140,744 bytes)

-- λ> length (divisoresCompuestos2 (product [1..16]))

-- 5369

-- (1.97 secs, 932,433,176 bytes)

-- λ> length (divisoresCompuestos5 (product [1..16]))

-- 5369

-- (0.03 secs, 37,452,088 bytes)

-- λ> length (divisoresCompuestos6 (product [1..16]))

-- 5369

-- (0.03 secs, 23,017,480 bytes)

-- λ> length (divisoresCompuestos5 (product [1..25]))

-- 340022

-- (2.43 secs, 3,055,140,056 bytes)

-- λ> length (divisoresCompuestos6 (product [1..25]))

-- 340022

-- (1.94 secs, 2,145,440,904 bytes)

Pensamiento

«La verdad del hombre empieza donde acaba su propia tontería, pero la
tontería del hombre es inagotable.»

Antonio Machado

Árbol de divisores

PorJosé A. Alonso 21-diciembre-201828-diciembre-2018

Se dice que a es un divisor propio maximal de un número b si a es un divisor de b distinto de b y no existe ningún número c tal que a < c < b, a es un divisor de c y c es un divisor de b. Por ejemplo, 15 es un divisor propio maximal de 30, pero 5 no lo es.

El árbol de los divisores de un número x es el árbol que tiene como raíz el número x y cada nodo tiene como hijos sus divisores propios maximales. Por ejemplo, el árbol de divisores de 30 es

          30
          /|\
         / | \
        /  |  \
       /   |   \
      /    |    \
     6    10    15
    / \   / \   / \
   2   3 2   5 3   5

/|\

/ | \

6 10 15

/ \ / \ / \

2 3 2 5 3 5

Usando el tipo de dato

   data Arbol = N Integer [Arbol]
     deriving (Eq, Show)

1 2	data Arbol = N Integer [Arbol] deriving (Eq, Show)

el árbol anterior se representa por

   N 30
     [N 6
        [N 2 [N 1 []],
         N 3 [N 1 []]],
      N 10
        [N 2 [N 1 []],
         N 5 [N 1 []]],
      N 15
        [N 3 [N 1 []],
         N 5 [N 1 []]]]

N 30

[N 6

[N 2 [N 1 []],

N 3 [N 1 []]],

N 10

[N 2 [N 1 []],

N 5 [N 1 []]],

N 15

[N 3 [N 1 []],

N 5 [N 1 []]]]

Definir las funciones

   arbolDivisores             :: Integer -> Arbol
   nOcurrenciasArbolDivisores :: Integer -> Integer -> Integer

1 2	arbolDivisores :: Integer -> Arbol nOcurrenciasArbolDivisores :: Integer -> Integer -> Integer

tales que

(arbolDivisores x) es el árbol de los divisores del número x. Por ejemplo,

     λ> arbolDivisores 30
     N 30 [N 6  [N 2 [N 1 []],N 3 [N 1 []]],
           N 10 [N 2 [N 1 []],N 5 [N 1 []]],
           N 15 [N 3 [N 1 []],N 5 [N 1 []]]]

λ> arbolDivisores 30

N 30 [N 6 [N 2 [N 1 []],N 3 [N 1 []]],

N 10 [N 2 [N 1 []],N 5 [N 1 []]],

N 15 [N 3 [N 1 []],N 5 [N 1 []]]]

(nOcurrenciasArbolDivisores x y) es el número de veces que aparece el número x en el árbol de los divisores del número y. Por ejemplo,

     nOcurrenciasArbolDivisores  3 30  ==  2
     nOcurrenciasArbolDivisores  6 30  ==  1
     nOcurrenciasArbolDivisores 30 30  ==  1
     nOcurrenciasArbolDivisores  1 30  ==  6
     nOcurrenciasArbolDivisores  9 30  ==  0
     nOcurrenciasArbolDivisores  2 (product [1..10])  ==  360360
     nOcurrenciasArbolDivisores  3 (product [1..10])  ==  180180
     nOcurrenciasArbolDivisores  5 (product [1..10])  ==  90090
     nOcurrenciasArbolDivisores  7 (product [1..10])  ==  45045
     nOcurrenciasArbolDivisores  6 (product [1..10])  ==  102960
     nOcurrenciasArbolDivisores 10 (product [1..10])  ==  51480
     nOcurrenciasArbolDivisores 14 (product [1..10])  ==  25740

nOcurrenciasArbolDivisores 3 30 == 2

nOcurrenciasArbolDivisores 6 30 == 1

nOcurrenciasArbolDivisores 30 30 == 1

nOcurrenciasArbolDivisores 1 30 == 6

nOcurrenciasArbolDivisores 9 30 == 0

nOcurrenciasArbolDivisores 2 (product [1..10]) == 360360

nOcurrenciasArbolDivisores 3 (product [1..10]) == 180180

nOcurrenciasArbolDivisores 5 (product [1..10]) == 90090

nOcurrenciasArbolDivisores 7 (product [1..10]) == 45045

nOcurrenciasArbolDivisores 6 (product [1..10]) == 102960

nOcurrenciasArbolDivisores 10 (product [1..10]) == 51480

nOcurrenciasArbolDivisores 14 (product [1..10]) == 25740

Soluciones

import Data.Numbers.Primes (primeFactors)
import Data.List (genericLength, group, nub)

data Arbol = N Integer [Arbol]
  deriving (Eq, Show)

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

arbolDivisores :: Integer -> Arbol
arbolDivisores x =
  N x (map arbolDivisores (divisoresPropiosMaximales x))

-- (divisoresPropiosMaximales x) es la lista de los divisores propios
-- maximales de x. Por ejemplo,
--    divisoresPropiosMaximales 30   ==  [6,10,15]
--    divisoresPropiosMaximales 420  ==  [60,84,140,210]
--    divisoresPropiosMaximales 7    ==  [1]
divisoresPropiosMaximales :: Integer -> [Integer]
divisoresPropiosMaximales x =
  reverse [x `div` y | y <- nub (primeFactors x)]

-- Definición de nOcurrenciasArbolDivisores
-- ========================================
  
nOcurrenciasArbolDivisores :: Integer -> Integer -> Integer
nOcurrenciasArbolDivisores x y =
  nOcurrencias x (arbolDivisores y)

-- (nOcurrencias x a) es el número de veces que aprece x en el árbol
-- a. Por ejemplo,
--    nOcurrencias 3 (arbolDivisores 30)  ==  2
nOcurrencias :: Integer -> Arbol -> Integer
nOcurrencias x (N y [])
  | x == y    = 1
  | otherwise = 0
nOcurrencias x (N y zs)
  | x == y    = 1 + sum [nOcurrencias x z | z <- zs]
  | otherwise = sum [nOcurrencias x z | z <- zs]

import Data.Numbers.Primes (primeFactors)

import Data.List (genericLength, group, nub)

data Arbol = N Integer [Arbol]

deriving (Eq, Show)

-- Definición de arbolDivisores

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

arbolDivisores :: Integer -> Arbol

arbolDivisores x =

N x (map arbolDivisores (divisoresPropiosMaximales x))

-- (divisoresPropiosMaximales x) es la lista de los divisores propios

-- maximales de x. Por ejemplo,

-- divisoresPropiosMaximales 30 == [6,10,15]

-- divisoresPropiosMaximales 420 == [60,84,140,210]

-- divisoresPropiosMaximales 7 == [1]

divisoresPropiosMaximales :: Integer -> [Integer]

divisoresPropiosMaximales x =

reverse [x `div` y | y <- nub (primeFactors x)]

-- Definición de nOcurrenciasArbolDivisores

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

nOcurrenciasArbolDivisores :: Integer -> Integer -> Integer

nOcurrenciasArbolDivisores x y =

nOcurrencias x (arbolDivisores y)

-- (nOcurrencias x a) es el número de veces que aprece x en el árbol

-- a. Por ejemplo,

-- nOcurrencias 3 (arbolDivisores 30) == 2

nOcurrencias :: Integer -> Arbol -> Integer

nOcurrencias x (N y [])

| x == y = 1

| otherwise = 0

nOcurrencias x (N y zs)

| x == y = 1 + sum [nOcurrencias x z | z <- zs]

| otherwise = sum [nOcurrencias x z | z <- zs]

Pensamiento

«¿Dónde está la utilidad
de nuestras utilidades?
Volvamos a la verdad:
vanidad de vanidades.»

Antonio Machado

Divisores propios maximales

PorJosé A. Alonso 20-diciembre-201827-diciembre-2018

Definir las funciones

   divisoresPropiosMaximales  :: Integer -> [Integer]
   nDivisoresPropiosMaximales :: Integer -> Integer

1 2	divisoresPropiosMaximales :: Integer -> [Integer] nDivisoresPropiosMaximales :: Integer -> Integer

tales que

(divisoresPropiosMaximales x) es la lista de los divisores propios maximales de x. Por ejemplo,

     divisoresPropiosMaximales 30   ==  [6,10,15]
     divisoresPropiosMaximales 420  ==  [60,84,140,210]
     divisoresPropiosMaximales 7    ==  [1]
     length (divisoresPropiosMaximales (product [1..3*10^4])) == 3245

divisoresPropiosMaximales 30 == [6,10,15]

divisoresPropiosMaximales 420 == [60,84,140,210]

divisoresPropiosMaximales 7 == [1]

length (divisoresPropiosMaximales (product [1..3*10^4])) == 3245

(nDivisoresPropiosMaximales x) es el número de divisores propios maximales de x. Por ejemplo,

     nDivisoresPropiosMaximales 30   ==  3
     nDivisoresPropiosMaximales 420  ==  4
     nDivisoresPropiosMaximales 7    ==  1
     nDivisoresPropiosMaximales (product [1..3*10^4])  ==  3245

nDivisoresPropiosMaximales 30 == 3

nDivisoresPropiosMaximales 420 == 4

nDivisoresPropiosMaximales 7 == 1

nDivisoresPropiosMaximales (product [1..3*10^4]) == 3245

Soluciones

import Data.Numbers.Primes (primeFactors)
import Data.List (genericLength, group, nub)
import Test.QuickCheck

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

divisoresPropiosMaximales :: Integer -> [Integer]
divisoresPropiosMaximales x =
  [y | y <- divisoresPropios x
     , null [z | z <- divisoresPropios x
               , y < z 
               , z `mod` y == 0]]

-- (divisoresPropios x) es la lista de los divisores propios de x; es
-- decir, de los divisores de x distintos de x. Por ejemplo,
--    divisoresPropios 30  ==  [1,2,3,5,6,10,15]
divisoresPropios :: Integer -> [Integer]
divisoresPropios x =
  [y | y <- [1..x-1]
     , x `mod` y == 0]

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

divisoresPropiosMaximales2 :: Integer -> [Integer]
divisoresPropiosMaximales2 x =
  reverse [x `div` y | y <- nub (primeFactors x)]

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

-- La propiedad es
prop_divisoresPropiosMaximales_equiv :: (Positive Integer) -> Bool
prop_divisoresPropiosMaximales_equiv (Positive x) =
  divisoresPropiosMaximales x == divisoresPropiosMaximales2 x

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

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

--    λ> length (divisoresPropiosMaximales (product [1..10]))
--    4
--    (13.33 secs, 7,037,241,776 bytes)
--    λ> length (divisoresPropiosMaximales2 (product [1..10]))
--    4
--    (0.00 secs, 135,848 bytes)

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

nDivisoresPropiosMaximales :: Integer -> Integer
nDivisoresPropiosMaximales =
  genericLength . divisoresPropiosMaximales
  
-- 2ª definición de nDivisoresPropiosMaximales
-- ===========================================

nDivisoresPropiosMaximales2 :: Integer -> Integer
nDivisoresPropiosMaximales2 =
  genericLength . divisoresPropiosMaximales2
  
-- 3ª definición de nDivisoresPropiosMaximales
-- ===========================================

nDivisoresPropiosMaximales3 :: Integer -> Integer
nDivisoresPropiosMaximales3 =
  genericLength . group . primeFactors

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

-- La propiedad es
prop_nDivisoresPropiosMaximales_equiv :: (Positive Integer) -> Bool
prop_nDivisoresPropiosMaximales_equiv (Positive x) =
  nDivisoresPropiosMaximales  x == nDivisoresPropiosMaximales3 x &&
  nDivisoresPropiosMaximales2 x == nDivisoresPropiosMaximales3 x 

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

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

--    λ> nDivisoresPropiosMaximales2 (product [1..10])
--    4
--    (13.33 secs, 7,037,242,536 bytes)
--    λ> nDivisoresPropiosMaximales2 (product [1..10])
--    4
--    (0.00 secs, 135,640 bytes)
--    λ> nDivisoresPropiosMaximales3 (product [1..10])
--    4
--    (0.00 secs, 135,232 bytes)
--    
--    λ> nDivisoresPropiosMaximales2 (product [1..3*10^4])
--    3245
--    (3.12 secs, 4,636,274,040 bytes)
--    λ> nDivisoresPropiosMaximales3 (product [1..3*10^4])
--    3245
--    (3.06 secs, 4,649,295,056 bytes)

100

101

102

103

104

import Data.Numbers.Primes (primeFactors)

import Data.List (genericLength, group, nub)

import Test.QuickCheck

-- 1ª definición de divisoresPropiosMaximales

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

divisoresPropiosMaximales :: Integer -> [Integer]

divisoresPropiosMaximales x =

[y | y <- divisoresPropios x

, null [z | z <- divisoresPropios x

, y < z

, z `mod` y == 0]]

-- (divisoresPropios x) es la lista de los divisores propios de x; es

-- decir, de los divisores de x distintos de x. Por ejemplo,

-- divisoresPropios 30 == [1,2,3,5,6,10,15]

divisoresPropios :: Integer -> [Integer]

divisoresPropios x =

[y | y <- [1..x-1]

, x `mod` y == 0]

-- 2ª definición de divisoresPropiosMaximales

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

divisoresPropiosMaximales2 :: Integer -> [Integer]

divisoresPropiosMaximales2 x =

reverse [x `div` y | y <- nub (primeFactors x)]

-- Equivalencia de las definiciones de divisoresPropiosMaximales

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

-- La propiedad es

prop_divisoresPropiosMaximales_equiv :: (Positive Integer) -> Bool

prop_divisoresPropiosMaximales_equiv (Positive x) =

divisoresPropiosMaximales x == divisoresPropiosMaximales2 x

-- La comprobación es

-- λ> quickCheck prop_divisoresPropiosMaximales_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia de divisoresPropiosMaximales

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

-- λ> length (divisoresPropiosMaximales (product [1..10]))

-- 4

-- (13.33 secs, 7,037,241,776 bytes)

-- λ> length (divisoresPropiosMaximales2 (product [1..10]))

-- 4

-- (0.00 secs, 135,848 bytes)

-- 1ª definición de nDivisoresPropiosMaximales

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

nDivisoresPropiosMaximales :: Integer -> Integer

nDivisoresPropiosMaximales =

genericLength . divisoresPropiosMaximales

-- 2ª definición de nDivisoresPropiosMaximales

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

nDivisoresPropiosMaximales2 :: Integer -> Integer

nDivisoresPropiosMaximales2 =

genericLength . divisoresPropiosMaximales2

-- 3ª definición de nDivisoresPropiosMaximales

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

nDivisoresPropiosMaximales3 :: Integer -> Integer

nDivisoresPropiosMaximales3 =

genericLength . group . primeFactors

-- Equivalencia de las definiciones de nDivisoresPropiosMaximales

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

-- La propiedad es

prop_nDivisoresPropiosMaximales_equiv :: (Positive Integer) -> Bool

prop_nDivisoresPropiosMaximales_equiv (Positive x) =

nDivisoresPropiosMaximales x == nDivisoresPropiosMaximales3 x &&

nDivisoresPropiosMaximales2 x == nDivisoresPropiosMaximales3 x

-- La comprobación es

-- λ> quickCheck prop_nDivisoresPropiosMaximales_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia de nDivisoresPropiosMaximales

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

-- λ> nDivisoresPropiosMaximales2 (product [1..10])

-- 4

-- (13.33 secs, 7,037,242,536 bytes)

-- λ> nDivisoresPropiosMaximales2 (product [1..10])

-- 4

-- (0.00 secs, 135,640 bytes)

-- λ> nDivisoresPropiosMaximales3 (product [1..10])

-- 4

-- (0.00 secs, 135,232 bytes)

-- λ> nDivisoresPropiosMaximales2 (product [1..3*10^4])

-- 3245

-- (3.12 secs, 4,636,274,040 bytes)

-- λ> nDivisoresPropiosMaximales3 (product [1..3*10^4])

-- 3245

-- (3.06 secs, 4,649,295,056 bytes)

Pensamiento

«Moneda que está en la mano
quizá se deba guardar;
la monedita del alma
se pierde si no se da.»

Antonio Machado

Grado exponencial

PorJosé A. Alonso 19-diciembre-201826-diciembre-2018

El grado exponencial de un número n es el menor número x mayor que 1 tal que n es una subcadena de $n^x$ . Por ejemplo, el grado exponencial de 2 es 5 ya que 2 es una subcadena de 32 (que es $2^5$ ) y no es subcadena de las anteriores potencias de 2 (2, 4 y 16). El grado exponencial de 25 es 2 porque 25 es una subcadena de 625 (que es $25^2$ ).

Definir la función

   gradoExponencial :: Integer -> Integer

1	gradoExponencial :: Integer -> Integer

tal que (gradoExponencial n) es el grado exponencial de n. Por ejemplo,

   gradoExponencial 2      ==  5
   gradoExponencial 25     ==  2
   gradoExponencial 15     ==  26
   gradoExponencial 1093   ==  100
   gradoExponencial 10422  ==  200
   gradoExponencial 11092  ==  300

gradoExponencial 2 == 5

gradoExponencial 25 == 2

gradoExponencial 15 == 26

gradoExponencial 1093 == 100

gradoExponencial 10422 == 200

gradoExponencial 11092 == 300

Soluciones

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

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

gradoExponencial :: Integer -> Integer
gradoExponencial n =
  head [e | e <- [2..]
          , show n `isInfixOf` show (n^e)]

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

gradoExponencial2 :: Integer -> Integer
gradoExponencial2 n =
  2 + genericLength (takeWhile noSubcadena (potencias n))
  where c             = show n
        noSubcadena x = not (c `isInfixOf`show x)

-- (potencias n) es la lista de las potencias de n a partir de n^2. Por
-- ejemplo, 
--    λ> take 10 (potencias 2)
--    [4,8,16,32,64,128,256,512,1024,2048]
potencias :: Integer -> [Integer]
potencias n =
  iterate (*n) (n^2)

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

gradoExponencial3 :: Integer -> Integer
gradoExponencial3 n = aux 2
  where aux x
          | cs `isInfixOf` show (n^x) = x
          | otherwise                 = aux (x+1)
        cs = show n

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

-- La propiedad es
prop_gradosExponencial_equiv :: (Positive Integer) -> Bool
prop_gradosExponencial_equiv (Positive n) =
  gradoExponencial n == gradoExponencial2 n &&
  gradoExponencial n == gradoExponencial3 n

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

import Test.QuickCheck

import Data.List (genericLength, isInfixOf)

-- 1ª solución

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

gradoExponencial :: Integer -> Integer

gradoExponencial n =

head [e | e <- [2..]

, show n `isInfixOf` show (n^e)]

-- 2ª solución

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

gradoExponencial2 :: Integer -> Integer

gradoExponencial2 n =

2 + genericLength (takeWhile noSubcadena (potencias n))

where c = show n

noSubcadena x = not (c `isInfixOf`show x)

-- (potencias n) es la lista de las potencias de n a partir de n^2. Por

-- ejemplo,

-- λ> take 10 (potencias 2)

-- [4,8,16,32,64,128,256,512,1024,2048]

potencias :: Integer -> [Integer]

potencias n =

iterate (*n) (n^2)

-- 3ª solución

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

gradoExponencial3 :: Integer -> Integer

gradoExponencial3 n = aux 2

where aux x

| cs `isInfixOf` show (n^x) = x

| otherwise = aux (x+1)

cs = show n

-- Equivalencia

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

-- La propiedad es

prop_gradosExponencial_equiv :: (Positive Integer) -> Bool

prop_gradosExponencial_equiv (Positive n) =

gradoExponencial n == gradoExponencial2 n &&

gradoExponencial n == gradoExponencial3 n

-- La comprobación es

-- λ> quickCheck prop_gradosExponencial_equiv

-- +++ OK, passed 100 tests.

Referencia

Basado en la sucesión A045537 de la OEIS.

Pensamiento

«De cada diez novedades que pretenden descubrirnos, nueve son
tonterías. La décima y última, que no es necedad, resulta a última hora
que tampoco es nueva.»

Antonio Machado

Números primos de Pierpont

PorJosé A. Alonso 18-diciembre-201825-diciembre-2018

Un número primo de Pierpont es un número primo de la forma $2^{u}3^{v}+1$ , para u y v enteros no negativos.

Definir la sucesión

   primosPierpont :: [Integer]

1	primosPierpont :: [Integer]

tal que sus elementos son los números primos de Pierpont. Por ejemplo,

   λ> take 20 primosPierpont
   [2,3,5,7,13,17,19,37,73,97,109,163,193,257,433,487,577,769,1153,1297]
   λ> primosPierpont !! 49
   8503057

λ> take 20 primosPierpont

[2,3,5,7,13,17,19,37,73,97,109,163,193,257,433,487,577,769,1153,1297]

λ> primosPierpont !! 49

8503057

Soluciones

import Data.Numbers.Primes (primes, primeFactors)

primosPierpont :: [Integer]
primosPierpont =
  [n | n <- primes
     , primoPierpont n]

primoPierpont :: Integer -> Bool
primoPierpont n =
  primeFactors (n-1) `contenidoEn` [2,3]

-- (contenidoEn xs ys) se verifica si xs está contenido en ys. Por
-- ejemplo,
--    contenidoEn [2,3,2,2,3] [2,3]  ==  True
--    contenidoEn [2,3,2,2,1] [2,3]  ==  False
contenidoEn :: [Integer] -> [Integer] -> Bool
contenidoEn xs ys =
  all (`elem` ys) xs

import Data.Numbers.Primes (primes, primeFactors)

primosPierpont :: [Integer]

primosPierpont =

[n | n <- primes

, primoPierpont n]

primoPierpont :: Integer -> Bool

primoPierpont n =

primeFactors (n-1) `contenidoEn` [2,3]

-- (contenidoEn xs ys) se verifica si xs está contenido en ys. Por

-- ejemplo,

-- contenidoEn [2,3,2,2,3] [2,3] == True

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

contenidoEn :: [Integer] -> [Integer] -> Bool

contenidoEn xs ys =

all (`elem` ys) xs

Pensamiento

«La memoria es infiel: no sólo borra y confunde, sino que, a veces, inventa, para desorientarnos.»

Antonio Machado

Superación de límites

PorJosé A. Alonso 14-diciembre-201821-diciembre-2018

Una sucesión de puntuaciones se puede representar mediante una lista de números. Por ejemplo, [7,5,9,9,4,5,4,2,5,9,12,1]. En la lista anterior, los puntos en donde se alcanzan un nuevo máximo son 7, 9 y 12 (porque son mayores que todos sus anteriores) y en donde se alcanzan un nuevo mínimo son 7, 5, 4, 2 y 1 (porque son menores que todos sus anteriores). Por tanto, el máximo se ha superado 2 veces y el mínimo 4 veces.

Definir las funciones

   nuevosMaximos :: [Int] -> [Int]
   nuevosMinimos :: [Int] -> [Int]
   nRupturas     :: [Int] -> (Int,Int)

nuevosMaximos :: [Int] -> [Int]

nuevosMinimos :: [Int] -> [Int]

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

tales que

(nuevosMaximos xs) es la lista de los nuevos máximos de xs. Por ejemplo,

     nuevosMaximos [7,5,9,9,4,5,4,2,5,9,12,1]  ==  [7,9,12]

1	nuevosMaximos [7,5,9,9,4,5,4,2,5,9,12,1] == [7,9,12]

(nuevosMinimos xs) es la lista de los nuevos mínimos de xs. Por ejemplo,

     nuevosMinimos [7,5,9,9,4,5,4,2,5,9,12,1]  ==  [7,5,4,2,1]

1	nuevosMinimos [7,5,9,9,4,5,4,2,5,9,12,1] == [7,5,4,2,1]

(nRupturas xs) es el par formado por el número de veces que se supera el máximo y el número de veces que se supera el mínimo en xs. Por ejemplo,

     nRupturas [7,5,9,9,4,5,4,2,5,9,12,1]  ==  (2,4)

1	nRupturas [7,5,9,9,4,5,4,2,5,9,12,1] == (2,4)

Soluciones

import Data.List (group, inits)

nuevosMaximos :: [Int] -> [Int]
nuevosMaximos xs = map head (group (map maximum xss))
  where xss = tail (inits xs)

nuevosMinimos :: [Int] -> [Int]
nuevosMinimos xs = map head (group (map minimum xss))
  where xss = tail (inits xs)

nRupturas :: [Int] -> (Int,Int)
nRupturas [] = (0,0)
nRupturas xs =
  ( length (nuevosMaximos xs) - 1
  , length (nuevosMinimos xs) - 1)

import Data.List (group, inits)

nuevosMaximos :: [Int] -> [Int]

nuevosMaximos xs = map head (group (map maximum xss))

where xss = tail (inits xs)

nuevosMinimos :: [Int] -> [Int]

nuevosMinimos xs = map head (group (map minimum xss))

where xss = tail (inits xs)

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

nRupturas [] = (0,0)

nRupturas xs =

( length (nuevosMaximos xs) - 1

, length (nuevosMinimos xs) - 1)

Pensamiento

«Todo necio confunde valor y precio.» ~ Antonio Machado.

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Referencia

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico