Medio

Números ordenados con cuadrados ordenados

PorJosé A. Alonso 18-marzo-202125-marzo-2021

Un número es ordenado si cada uno de sus dígitos es menor o igual el siguiente dígito. Por ejemplo, 116 es un número creciente y su cuadrado es 13456, que también es ordenado. En cambio, 115 es ordenado pero su cuadrado es 13225 que no es ordenado.

Definir la lista

   numerosOrdenadosConCuadradosOrdenados :: [Integer]

1	numerosOrdenadosConCuadradosOrdenados :: [Integer]

cuyos elementos son los números ordenados cuyos cuadrados también lo son. Por ejemplo,

   λ> take 20 numerosOrdenadosConCuadradosOrdenados
   [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117]
   λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (10^6)))
   1411
   λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (5*10^6)))
   3159

λ> take 20 numerosOrdenadosConCuadradosOrdenados

[0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117]

λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (10^6)))

1411

λ> length (show (numerosOrdenadosConCuadradosOrdenados !! (5*10^6)))

3159

Soluciones

import Data.List

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

numerosOrdenadosConCuadradosOrdenados :: [Integer]
numerosOrdenadosConCuadradosOrdenados =
  filter numeroOrdenadoConCuadradoOrdenado [0..]

-- (numeroOrdenadoConCuadradoOrdenado n) se verifica si n es un número
-- ordenado cuyo cuadrado también lo es. Por ejemplo,
--    numeroOrdenadoConCuadradoOrdenado 116  ==  True
--    numeroOrdenadoConCuadradoOrdenado 115  ==  False
numeroOrdenadoConCuadradoOrdenado :: Integer -> Bool
numeroOrdenadoConCuadradoOrdenado n =
  ordenado n && ordenado (n^2)

-- (ordenado n) se verifica si n es un número ordenado. Por ejemplo,
--    ordenado 115  ==  True
--    ordenado 151  ==  False
ordenado :: Integer -> Bool
ordenado n =
  and [x <= y | (x,y) <- zip xs (tail xs)]
  where xs = show n

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

-- Se basa en la observación de los sisuientes cálculos con la primera
-- solución
--    λ> take 30 numerosOrdenadosConCuadradosOrdenados
--    [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117,
--     167,334,335,337,367,667,1667,3334,3335,3337]
--    λ> take 21 (dropWhile (<= 117) numerosOrdenadosConCuadradosOrdenados)
--    [167,334,335,337,367,667,
--     1667,3334,3335,3337,3367,3667,6667,
--     16667,33334,33335,33337,33367,33667,36667,66667]
--
-- Se observa que a partir del 167 todos los elementos son de 4 tipos
-- como se ve en la siguente tabla
--    |-------+--------+--------+--------+--------|
--    |       | Tipo A | Tipo B | Tipo C | Tipo D |
--    |-------+--------+--------+--------+--------|
--    |   167 | 16¹7   |        |        |        |
--    |   334 |        | 3²4    |        |        |
--    |   335 |        |        | 3²5    |        |
--    |   337 |        |        |        | 3²6⁰7  |
--    |   367 |        |        |        | 3¹6¹7  |
--    |   667 |        |        |        | 3⁰6²7  |
--    |  1667 | 16²7   |        |        |        |
--    |  3334 |        | 3³4    |        |        |
--    |  3335 |        |        | 3³5    |        |
--    |  3337 |        |        |        | 3³6⁰7  |
--    |  3367 |        |        |        | 3²6¹7  |
--    |  3667 |        |        |        | 3¹6²7  |
--    |  6667 |        |        |        | 3⁰6³7  |
--    | 16667 | 16³7   |        |        |        |
--    | 33334 |        | 3⁴4    |        |        |
--    | 33335 |        |        | 3⁴5    |        |
--    | 33337 |        |        |        | 3⁴6⁰7  |
--    | 33367 |        |        |        | 3³6¹7  |
--    | 33667 |        |        |        | 3²6²7  |
--    | 36667 |        |        |        | 3¹6³7  |
--    | 66667 |        |        |        | 3⁰6⁴7  |
--    |-------+--------+--------+--------+--------|
-- donde el exponente en cad dígito indica el número de repeticiones de
-- dicho dígito.

numerosOrdenadosConCuadradosOrdenados2 :: [Integer]
numerosOrdenadosConCuadradosOrdenados2 =
  [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117] ++
  map read (concat [['1' : replicate n '6' ++ "7",
                     replicate (n+1) '3' ++ "4",
                     replicate (n+1) '3' ++ "5"] ++
                    [replicate a '3' ++ replicate b '6' ++ "7"
                    | b <- [0..n+1], let a = (n+1) - b]
                   | n <- [1..]])

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

-- La comparación es
--    λ> numerosOrdenadosConCuadradosOrdenados !! 50
--    1666667
--    (2.35 secs, 2,173,983,096 bytes)
--    λ> numerosOrdenadosConCuadradosOrdenados2 !! 50
--    1666667
--    (0.01 secs, 125,296 bytes)

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

-- La comprobación es
--    λ> take 50 numerosOrdenadosConCuadradosOrdenados == take 50 numerosOrdenadosConCuadradosOrdenados2
--    True

import Data.List

-- 1ª solución

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

numerosOrdenadosConCuadradosOrdenados :: [Integer]

numerosOrdenadosConCuadradosOrdenados =

filter numeroOrdenadoConCuadradoOrdenado [0..]

-- (numeroOrdenadoConCuadradoOrdenado n) se verifica si n es un número

-- ordenado cuyo cuadrado también lo es. Por ejemplo,

-- numeroOrdenadoConCuadradoOrdenado 116 == True

-- numeroOrdenadoConCuadradoOrdenado 115 == False

numeroOrdenadoConCuadradoOrdenado :: Integer -> Bool

numeroOrdenadoConCuadradoOrdenado n =

ordenado n && ordenado (n^2)

-- (ordenado n) se verifica si n es un número ordenado. Por ejemplo,

-- ordenado 115 == True

-- ordenado 151 == False

ordenado :: Integer -> Bool

ordenado n =

and [x <= y | (x,y) <- zip xs (tail xs)]

where xs = show n

-- 2ª solución

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

-- Se basa en la observación de los sisuientes cálculos con la primera

-- solución

-- λ> take 30 numerosOrdenadosConCuadradosOrdenados

-- [0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117,

-- 167,334,335,337,367,667,1667,3334,3335,3337]

-- λ> take 21 (dropWhile (<= 117) numerosOrdenadosConCuadradosOrdenados)

-- [167,334,335,337,367,667,

-- 1667,3334,3335,3337,3367,3667,6667,

-- 16667,33334,33335,33337,33367,33667,36667,66667]

-- Se observa que a partir del 167 todos los elementos son de 4 tipos

-- como se ve en la siguente tabla

-- |-------+--------+--------+--------+--------|

-- |-------+--------+--------+--------+--------|

-- | 167 | 16¹7 | | | |

-- | 334 | | 3²4 | | |

-- | 335 | | | 3²5 | |

-- | 337 | | | | 3²6⁰7 |

-- | 367 | | | | 3¹6¹7 |

-- | 667 | | | | 3⁰6²7 |

-- | 1667 | 16²7 | | | |

-- | 3334 | | 3³4 | | |

-- | 3335 | | | 3³5 | |

-- | 3337 | | | | 3³6⁰7 |

-- | 3367 | | | | 3²6¹7 |

-- | 3667 | | | | 3¹6²7 |

-- | 6667 | | | | 3⁰6³7 |

-- | 16667 | 16³7 | | | |

-- | 33334 | | 3⁴4 | | |

-- | 33335 | | | 3⁴5 | |

-- | 33337 | | | | 3⁴6⁰7 |

-- | 33367 | | | | 3³6¹7 |

-- | 33667 | | | | 3²6²7 |

-- | 36667 | | | | 3¹6³7 |

-- | 66667 | | | | 3⁰6⁴7 |

-- |-------+--------+--------+--------+--------|

-- donde el exponente en cad dígito indica el número de repeticiones de

-- dicho dígito.

numerosOrdenadosConCuadradosOrdenados2 :: [Integer]

numerosOrdenadosConCuadradosOrdenados2 =

[0,1,2,3,4,5,6,7,12,13,15,16,17,34,35,37,38,67,116,117] ++

map read (concat [['1' : replicate n '6' ++ "7",

replicate (n+1) '3' ++ "4",

replicate (n+1) '3' ++ "5"] ++

[replicate a '3' ++ replicate b '6' ++ "7"

| b <- [0..n+1], let a = (n+1) - b]

| n <- [1..]])

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numerosOrdenadosConCuadradosOrdenados !! 50

-- 1666667

-- (2.35 secs, 2,173,983,096 bytes)

-- λ> numerosOrdenadosConCuadradosOrdenados2 !! 50

-- 1666667

-- (0.01 secs, 125,296 bytes)

-- Comprobación de equivalencia

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

-- La comprobación es

-- λ> take 50 numerosOrdenadosConCuadradosOrdenados == take 50 numerosOrdenadosConCuadradosOrdenados2

-- True

Nuevas soluciones

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

Cálculo de pi mediante la fórmula de Brouncker

PorJosé A. Alonso 11-marzo-202118-marzo-2021

El mes de marzo es el mes de pi, ya que el 14 de marzo (3/14) es el día de pi. Con ese motivo, el pasado 3 de marzo se publicó en Twitter un mensaje con la fórmula de Brouncker para el cálculo de pi

La primeras aproximaciones son

     a(1) = 4                                  =  4
     a(2) = 4/(1+1^2)                          =  2.0
     a(3) = 4/(1+1^2/(2+3^2))                  =  3.666666666666667
     a(4) = 4/(1+1^2/(2+3^2/(2+5^2)))          =  2.8
     a(5) = 4/(1+1^2/(2+3^2/(2+5^2/(2+7^2))))  =  3.395238095238095

a(1) = 4 = 4

a(2) = 4/(1+1^2) = 2.0

a(3) = 4/(1+1^2/(2+3^2)) = 3.666666666666667

a(4) = 4/(1+1^2/(2+3^2/(2+5^2))) = 2.8

a(5) = 4/(1+1^2/(2+3^2/(2+5^2/(2+7^2)))) = 3.395238095238095

Definir las funciones

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

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

tales que

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

     aproximacionPi 1      ==  4.0
     aproximacionPi 2      ==  2.0
     aproximacionPi 3      ==  3.666666666666667
     aproximacionPi 4      ==  2.8
     aproximacionPi 5      ==  3.395238095238095
     aproximacionPi 10     ==  3.0301437124966535
     aproximacionPi 1000   ==  3.1405916523380406
     aproximacionPi 1001   ==  3.142592653839793
     aproximacionPi 10000  ==  3.141492643588543
     aproximacionPi 10001  ==  3.1416926535900433
     pi                    ==  3.141592653589793

aproximacionPi 1 == 4.0

aproximacionPi 2 == 2.0

aproximacionPi 3 == 3.666666666666667

aproximacionPi 4 == 2.8

aproximacionPi 5 == 3.395238095238095

aproximacionPi 10 == 3.0301437124966535

aproximacionPi 1000 == 3.1405916523380406

aproximacionPi 1001 == 3.142592653839793

aproximacionPi 10000 == 3.141492643588543

aproximacionPi 10001 == 3.1416926535900433

pi == 3.141592653589793

(grafica xs) dibuja la gráfica de las k-ésimas aproximaciones de pi para k en xs. Por ejemplo, (grafica [10..100]) dibuja

Soluciones

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

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

aproximacionPi :: Int -> Double
aproximacionPi 1 = 4
aproximacionPi n = 4/(1 + 1/(aux 1 3))
  where aux a b | a == n-1  = 1
                | otherwise = 2 + (b^2)/(aux (a+1) (b+2))

-- El cálculo es
--    aproximacionPi 2
--      = 4/(1 + 1/(aux 1 3))
--      = 4/(1 + 1/1)
--      = 2.0
--
--    aproximacionPi 3
--      = 4/(1 + 1/(aux 1 3))
--      = 4/(1 + 1/(2 + 3^2/(aux 2 5))
--      = 4/(1 + 1/(2 + 3^2/1))
--      = 3.666666666666667
--
--    aproximacionPi 4
--      = 4/(1 + 1/(aux 1 3))
--      = 4/(1 + 1/(2 + 3^2/(aux 2 5))
--      = 4/(1 + 1/(2 + 3^2/(2 + 5^2/(aux 3 7))))
--      = 4/(1 + 1/(2 + 3^2/(2 + 5^2/1)))
--      = 2.8

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

aproximacionPi2 :: Int -> Double
aproximacionPi2 n =
  aproximacionFC n fraccionPi

-- fraccionPi es la representación de la fracción continua de pi como un
-- par de listas infinitas.
fraccionPi :: [(Integer, Integer)]
fraccionPi = zip (0 : 1 : [2,2..]) (4 : map (^2) [1,3..])

-- (aproximacionFC n fc) es la n-ésima aproximación de la fracción
-- continua fc (como un par de listas).
aproximacionFC :: Int -> [(Integer, Integer)] -> Double
aproximacionFC n =
  foldr (\(a,b) z -> fromIntegral a + fromIntegral b / z) 1 . take n

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

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

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

-- 1ª solución

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

aproximacionPi :: Int -> Double

aproximacionPi 1 = 4

aproximacionPi n = 4/(1 + 1/(aux 1 3))

where aux a b | a == n-1 = 1

| otherwise = 2 + (b^2)/(aux (a+1) (b+2))

-- El cálculo es

-- aproximacionPi 2

-- = 4/(1 + 1/(aux 1 3))

-- = 4/(1 + 1/1)

-- = 2.0

-- aproximacionPi 3

-- = 4/(1 + 1/(aux 1 3))

-- = 4/(1 + 1/(2 + 3^2/(aux 2 5))

-- = 4/(1 + 1/(2 + 3^2/1))

-- = 3.666666666666667

-- aproximacionPi 4

-- = 4/(1 + 1/(aux 1 3))

-- = 4/(1 + 1/(2 + 3^2/(aux 2 5))

-- = 4/(1 + 1/(2 + 3^2/(2 + 5^2/(aux 3 7))))

-- = 4/(1 + 1/(2 + 3^2/(2 + 5^2/1)))

-- = 2.8

-- 2ª solución

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

aproximacionPi2 :: Int -> Double

aproximacionPi2 n =

aproximacionFC n fraccionPi

-- fraccionPi es la representación de la fracción continua de pi como un

-- par de listas infinitas.

fraccionPi :: [(Integer, Integer)]

fraccionPi = zip (0 : 1 : [2,2..]) (4 : map (^2) [1,3..])

-- (aproximacionFC n fc) es la n-ésima aproximación de la fracción

-- continua fc (como un par de listas).

aproximacionFC :: Int -> [(Integer, Integer)] -> Double

aproximacionFC n =

foldr (\(a,b) z -> fromIntegral a + fromIntegral b / z) 1 . take n

-- Gráfica

-- =======

grafica :: [Int] -> IO ()

grafica xs =

plotList [ Key Nothing

-- , PNG "Calculo_de_pi_mediante_la_formula_de_Brouncker_1.png"

]

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

Nuevas soluciones

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

Sucesión de Rowland

PorJosé A. Alonso 9-marzo-202116-marzo-2021

Definir las siguientes sucesiones

   sucesionA       :: [Integer]
   sucesionB       :: [Integer]
   sucesionRowland :: [Integer]

sucesionA :: [Integer]

sucesionB :: [Integer]

sucesionRowland :: [Integer]

tales que

el término n-ésimo de la sucesionA es a(n) definido por a(1) = 7 y a(n) = a(n-1) + mcd(n, a(n-1)), para n > 1. Por ejemplo,

     λ> take 20 sucesionA
     [7,8,9,10,15,18,19,20,21,22,33,36,37,38,39,40,41,42,43,44]

1 2	λ> take 20 sucesionA [7,8,9,10,15,18,19,20,21,22,33,36,37,38,39,40,41,42,43,44]

los términos de la sucesionB son las diferencias de los términos consecutivos de la sucesionA. Por ejemplo,

     λ> take 30 sucesionB
     [1,1,1,5,3,1,1,1,1,11,3,1,1,1,1,1,1,1,1,1,1,23,3,1,1,1,1,1,1,1]

1 2	λ> take 30 sucesionB [1,1,1,5,3,1,1,1,1,11,3,1,1,1,1,1,1,1,1,1,1,23,3,1,1,1,1,1,1,1]

los términos de la sucesionRowland son los términos de la sucesionB distintos de 1. Por ejemplo,\0

      λ> take 20 sucesionRowland
      [5,3,11,3,23,3,47,3,5,3,101,3,7,11,3,13,233,3,467,3]
      λ> sucesionRowland !! 92
      15567089

λ> take 20 sucesionRowland

[5,3,11,3,23,3,47,3,5,3,101,3,7,11,3,13,233,3,467,3]

λ> sucesionRowland !! 92

15567089

Comprobar con QuickCheck que los elementos de la sucesionRowland son números primos.

Nota: Eric S. Rowland demostró en A natural prime-generating recurrence que los elementos de la sucesionRowland son números primos.

Soluciones

import Data.Numbers.Primes (isPrime)
import Test.QuickCheck (Property, (==>), quickCheck)

sucesionA :: [Integer]
sucesionA =
   7 : zipWith (+) sucesionA (zipWith gcd sucesionA [2..])

sucesionB :: [Integer]
sucesionB = zipWith (-) (tail sucesionA) sucesionA

sucesionRowland :: [Integer]
sucesionRowland =  filter (> 1) sucesionB

-- La propiedad es
prop_sucesionRowland :: Int -> Property
prop_sucesionRowland n =
  n >= 0 ==> isPrime (sucesionRowland !! n)

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

import Data.Numbers.Primes (isPrime)

import Test.QuickCheck (Property, (==>), quickCheck)

sucesionA :: [Integer]

sucesionA =

7 : zipWith (+) sucesionA (zipWith gcd sucesionA [2..])

sucesionB :: [Integer]

sucesionB = zipWith (-) (tail sucesionA) sucesionA

sucesionRowland :: [Integer]

sucesionRowland = filter (> 1) sucesionB

-- La propiedad es

prop_sucesionRowland :: Int -> Property

prop_sucesionRowland n =

n >= 0 ==> isPrime (sucesionRowland !! n)

-- La comprobación es

-- λ> quickCheck prop_sucesionRowland

-- +++ OK, passed 100 tests.

Nuevas soluciones

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

Siguiente equidigital

PorJosé A. Alonso 5-marzo-202112-marzo-2021

Dos números son equidigitales si tienen el mismo multiconjunto de dígitos. Por ejemplo, 2021 y 2120 son equidigitales ya que ambos tiene a {0,1,2,2} como su multiconjunto de dígitos.

Definir la función

   siguienteEquidigital :: Integer -> Maybe Integer

1	siguienteEquidigital :: Integer -> Maybe Integer

tal que (siguienteEquidigital n) es precisamente el menor número equidigital con n que es mayor que n (es decir, (Just x) si x es dicho número o Nothing si no hay ningún número equidigital con n que sea mayor que n). Por ejemplo,

   siguienteEquidigital 12    ==  Just 21
   siguienteEquidigital 21    ==  Nothing
   siguienteEquidigital 513   ==  Just 531
   siguienteEquidigital 531   ==  Nothing
   siguienteEquidigital 2021  ==  Just 2102
   siguienteEquidigital 2102  ==  Just 2120
   siguienteEquidigital 2120  ==  Just 2201
   siguienteEquidigital 2201  ==  Just 2210
   siguienteEquidigital 2210  ==  Nothing
   fmap (`mod` 1000) (siguienteEquidigital (2^(10^5)))  ==  Just 637

siguienteEquidigital 12 == Just 21

siguienteEquidigital 21 == Nothing

siguienteEquidigital 513 == Just 531

siguienteEquidigital 531 == Nothing

siguienteEquidigital 2021 == Just 2102

siguienteEquidigital 2102 == Just 2120

siguienteEquidigital 2120 == Just 2201

siguienteEquidigital 2201 == Just 2210

siguienteEquidigital 2210 == Nothing

fmap (`mod` 1000) (siguienteEquidigital (2^(10^5))) == Just 637

Soluciones

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

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

siguienteEquidigital :: Integer -> Maybe Integer
siguienteEquidigital n
  | null xs = Nothing
  | otherwise = Just (head xs)
  where xs = equidigitalesMayores n

-- (equidigitalesMayores n) es la lista de los equidigitales mayores que
-- n. Por ejemplo,
--    equidigitalesMayores 2021  ==  [2102,2120,2201,2210]
--    equidigitalesMayores 2210  ==  []
equidigitalesMayores :: Integer -> [Integer]
equidigitalesMayores n =
  [x | x <- [n+1..mayorEquidigital n],
       sort (show x) == ds]
  where ds = sort (show n)

-- (mayorEquidigital n) es el mayor número equidigital con n. Por ejemplo,
--    mayorEquidigital 2021  ==  2210
--    mayorEquidigital 2210  ==  2210
mayorEquidigital :: Integer -> Integer
mayorEquidigital = read . reverse . sort . show

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

siguienteEquidigital2 :: Integer -> Maybe Integer
siguienteEquidigital2 = listToMaybe . equidigitalesMayores

import Data.List (sort)

import Data.Maybe (listToMaybe)

-- 1ª solución

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

siguienteEquidigital :: Integer -> Maybe Integer

siguienteEquidigital n

| null xs = Nothing

| otherwise = Just (head xs)

where xs = equidigitalesMayores n

-- (equidigitalesMayores n) es la lista de los equidigitales mayores que

-- n. Por ejemplo,

-- equidigitalesMayores 2021 == [2102,2120,2201,2210]

-- equidigitalesMayores 2210 == []

equidigitalesMayores :: Integer -> [Integer]

equidigitalesMayores n =

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

sort (show x) == ds]

where ds = sort (show n)

-- (mayorEquidigital n) es el mayor número equidigital con n. Por ejemplo,

-- mayorEquidigital 2021 == 2210

-- mayorEquidigital 2210 == 2210

mayorEquidigital :: Integer -> Integer

mayorEquidigital = read . reverse . sort . show

-- 2ª solución

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

siguienteEquidigital2 :: Integer -> Maybe Integer

siguienteEquidigital2 = listToMaybe . equidigitalesMayores

Nuevas soluciones

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

Mínima diferencia de las sumas de las biparticiones de las N primeras potencias de dos

PorJosé A. Alonso 2-marzo-20219-marzo-2021

Se consideran las N primeras potencias de 2 (donde N es un número par). Por ejemplo, para N = 4, las potencias de 2 son 1, 2, 4 y 8. Las biparticiones de dichas potencias en dos conjuntos de igual tamaño son

   ([1,2],[4,8]), ([1,4],[2,8]), ([1,8],[2,4])

1	([1,2],[4,8]), ([1,4],[2,8]), ([1,8],[2,4])

Las sumas de los elementos de las biparticiones son

   (3,12), (5,10), (9,6)

1	(3,12), (5,10), (9,6)

Los valores absolutos de las diferencias de dichas sumas son

   9, 5, 3

9, 5, 3

El mínimo de dichas diferencias es 3.

Definir la función

  minimaDiferencia :: Integer -> Integer

1	minimaDiferencia :: Integer -> Integer

tal que (minimaDiferencia n) es la mínima diferencia de las sumas las biparticiones de las n (donde n es un número par) primeras potencias de dos conjuntos con igual número de elementos. Por ejemplo,

   minimaDiferencia 4  ==  3
   minimaDiferencia 6  ==  7
   minimaDiferencia (10^9) `mod` (10^9)  ==  787109375

minimaDiferencia 4 == 3

minimaDiferencia 6 == 7

minimaDiferencia (10^9) `mod` (10^9) == 787109375

Soluciones

import Test.QuickCheck
import Data.List ((\\))

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

minimaDiferencia :: Integer -> Integer
minimaDiferencia n =
  minimum [abs (sum xs - sum ys) | (xs,ys) <- particiones n]

-- (particiones n) es la lista de las particiones de las n (donde n es
-- un número par) de las n primeras potencias de 2 en dos conjuntos de
-- igual tamaño. Por ejemplo,
--   λ> particiones 4
--   [([1,2],[4,8]),([1,4],[2,8]),([1,8],[2,4]),
--    ([2,4],[1,8]),([2,8],[1,4]),([4,8],[1,2])]
particiones :: Integer -> [([Integer],[Integer])]
particiones n =
  [(as,xs \\ as) | as <- kSubconjuntos xs (n `div` 2)]
  where xs = [2^k | k <- [0..n-1]]

-- (kSubconjuntos xs k) es la lista de los subconjuntos de xs con k
-- elementos. Por ejemplo,
--    λ> kSubconjuntos "bcde" 2
--    ["bc","bd","be","cd","ce","de"]
--    λ> kSubconjuntos "bcde" 3
--    ["bcd","bce","bde","cde"]
--    λ> kSubconjuntos "abcde" 3
--    ["abc","abd","abe","acd","ace","ade","bcd","bce","bde","cde"]
kSubconjuntos :: [a] -> Integer -> [[a]]
kSubconjuntos _ 0      = [[]]
kSubconjuntos [] _     = []
kSubconjuntos (x:xs) k =
  [x:ys | ys <- kSubconjuntos xs (k-1)] ++ kSubconjuntos xs k

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

-- Nota: La suma de las primeras (n-1) potencias de 2 es
--    sum [2^i | i <- [0..n-2]] = 2^(n-1) - 1
-- que es menor que la n-ésima potencia de 2 (es decir, 2^(n-1) porque
-- se empieza a contar en 0). Por tanto, para que la diferencia de las
-- suma sea mínima hay que agrupar la última (2^(n-1) con las menores
-- (es decir, desde 0 hasta n/2-2).

minimaDiferencia2 :: Integer -> Integer
minimaDiferencia2 n =
  2^(n-1) + sum [2^i | i <- [0..n `div` 2 - 2]] -
  sum [2^i | i <- [n `div` 2 - 1.. n-2]]

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

-- Nota: Sea m = n/2 - 2. Entonces la suma de la mayor con las menores
-- es
--    s1 = 2^(n-1) + sum [2^i | i <- [0..m]]
--       = 2^(n-1) + (2^(m+1)-1)
-- y, puesto que la suma de las n primeras potencias es 2^n-1, la suma
-- de las restantes es
--    s2 = (2^n-1) - s1

minimaDiferencia3 :: Integer -> Integer
minimaDiferencia3 n = s1 - s2
  where m = n `div` 2 - 2
        s1 = 2^(n-1) + (2^(m+1)-1)
        s2 = (2^n-1) - s1

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

-- Nota: Con la notación de la solución anterior, la mínima diferencia es
--    s1 - s2
--    = s1 - ((2^n-1) - s1)
--    = 2*s1 - (2^n-1)
--    = 2*(2^(n-1) + (2^(m+1)-1)) - (2^n-1)
--    = 2^n + 2^(m+2) - 2 - 2^n + 1
--    = 2^(m+2) - 1

minimaDiferencia4 :: Integer -> Integer
minimaDiferencia4 n = 2^(m+2) - 1
  where m = n `div` 2 - 2

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

-- La comparación es
--    λ> minimaDiferencia 22
--    2047
--    (7.75 secs, 6,597,330,816 bytes)
--    λ> minimaDiferencia2 22
--    2047
--    (0.00 secs, 126,344 bytes)
--    λ> minimaDiferencia3 22
--    2047
--    (0.01 secs, 107,192 bytes)
--    λ> minimaDiferencia4 22
--    2047
--    (0.01 secs, 102,544 bytes)
--
--    λ> minimaDiferencia2 (10^5) `mod` (10^50)
--    9602443968201967760613102289456131085235835109375
--    (8.18 secs, 2,915,200,064 bytes)
--    λ> minimaDiferencia3 (10^5) `mod` (10^50)
--    9602443968201967760613102289456131085235835109375
--    (0.01 secs, 293,640 bytes)
--    λ> minimaDiferencia4 (10^5) `mod` (10^50)
--    9602443968201967760613102289456131085235835109375
--    (0.03 secs, 167,176 bytes)
--
--    λ> minimaDiferencia3 (10^8) `mod` (10^50)
--    30521751870548886367615394702753936894129787109375
--    (2.08 secs, 149,075,824 bytes)
--    λ> minimaDiferencia4 (10^8) `mod` (10^50)
--    30521751870548886367615394702753936894129787109375
--    (0.41 secs, 24,929,696 bytes)

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

-- Como la primera sólo calcula hasta 22, se compara la primera con la
-- cuarta para dichos valores.
prop_equivalencia1 :: Bool
prop_equivalencia1 =
  and [minimaDiferencia n == minimaDiferencia4 n | n <- [0,2..22]]

-- La comprobación es
--    λ> prop_equivalencia1
--    True

-- La propiedad de la equivalencia de las definiciones 2, 3 y 4 es
prop_equivalencia :: Integer -> Bool
prop_equivalencia n =
  all (== (minimaDiferencia2 n'))
      [minimaDiferencia3 n',
       minimaDiferencia4 n']
  where n' = 2 + abs n

-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ 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

import Test.QuickCheck

import Data.List ((\\))

-- 1ª solución

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

minimaDiferencia :: Integer -> Integer

minimaDiferencia n =

minimum [abs (sum xs - sum ys) | (xs,ys) <- particiones n]

-- (particiones n) es la lista de las particiones de las n (donde n es

-- un número par) de las n primeras potencias de 2 en dos conjuntos de

-- igual tamaño. Por ejemplo,

-- λ> particiones 4

-- [([1,2],[4,8]),([1,4],[2,8]),([1,8],[2,4]),

-- ([2,4],[1,8]),([2,8],[1,4]),([4,8],[1,2])]

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

particiones n =

[(as,xs \\ as) | as <- kSubconjuntos xs (n `div` 2)]

where xs = [2^k | k <- [0..n-1]]

-- (kSubconjuntos xs k) es la lista de los subconjuntos de xs con k

-- elementos. Por ejemplo,

-- λ> kSubconjuntos "bcde" 2

-- ["bc","bd","be","cd","ce","de"]

-- λ> kSubconjuntos "bcde" 3

-- ["bcd","bce","bde","cde"]

-- λ> kSubconjuntos "abcde" 3

-- ["abc","abd","abe","acd","ace","ade","bcd","bce","bde","cde"]

kSubconjuntos :: [a] -> Integer -> [[a]]

kSubconjuntos _ 0 = [[]]

kSubconjuntos [] _ = []

kSubconjuntos (x:xs) k =

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

-- 2ª solución

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

-- Nota: La suma de las primeras (n-1) potencias de 2 es

-- sum [2^i | i <- [0..n-2]] = 2^(n-1) - 1

-- que es menor que la n-ésima potencia de 2 (es decir, 2^(n-1) porque

-- se empieza a contar en 0). Por tanto, para que la diferencia de las

-- suma sea mínima hay que agrupar la última (2^(n-1) con las menores

-- (es decir, desde 0 hasta n/2-2).

minimaDiferencia2 :: Integer -> Integer

minimaDiferencia2 n =

2^(n-1) + sum [2^i | i <- [0..n `div` 2 - 2]] -

sum [2^i | i <- [n `div` 2 - 1.. n-2]]

-- 3ª solución

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

-- Nota: Sea m = n/2 - 2. Entonces la suma de la mayor con las menores

-- es

-- s1 = 2^(n-1) + sum [2^i | i <- [0..m]]

-- = 2^(n-1) + (2^(m+1)-1)

-- y, puesto que la suma de las n primeras potencias es 2^n-1, la suma

-- de las restantes es

-- s2 = (2^n-1) - s1

minimaDiferencia3 :: Integer -> Integer

minimaDiferencia3 n = s1 - s2

where m = n `div` 2 - 2

s1 = 2^(n-1) + (2^(m+1)-1)

s2 = (2^n-1) - s1

-- 4ª solución

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

-- Nota: Con la notación de la solución anterior, la mínima diferencia es

-- s1 - s2

-- = s1 - ((2^n-1) - s1)

-- = 2*s1 - (2^n-1)

-- = 2*(2^(n-1) + (2^(m+1)-1)) - (2^n-1)

-- = 2^n + 2^(m+2) - 2 - 2^n + 1

-- = 2^(m+2) - 1

minimaDiferencia4 :: Integer -> Integer

minimaDiferencia4 n = 2^(m+2) - 1

where m = n `div` 2 - 2

-- Comparación de eficiencia

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

-- La comparación es

-- λ> minimaDiferencia 22

-- 2047

-- (7.75 secs, 6,597,330,816 bytes)

-- λ> minimaDiferencia2 22

-- 2047

-- (0.00 secs, 126,344 bytes)

-- λ> minimaDiferencia3 22

-- 2047

-- (0.01 secs, 107,192 bytes)

-- λ> minimaDiferencia4 22

-- 2047

-- (0.01 secs, 102,544 bytes)

-- λ> minimaDiferencia2 (10^5) `mod` (10^50)

-- 9602443968201967760613102289456131085235835109375

-- (8.18 secs, 2,915,200,064 bytes)

-- λ> minimaDiferencia3 (10^5) `mod` (10^50)

-- 9602443968201967760613102289456131085235835109375

-- (0.01 secs, 293,640 bytes)

-- λ> minimaDiferencia4 (10^5) `mod` (10^50)

-- 9602443968201967760613102289456131085235835109375

-- (0.03 secs, 167,176 bytes)

-- λ> minimaDiferencia3 (10^8) `mod` (10^50)

-- 30521751870548886367615394702753936894129787109375

-- (2.08 secs, 149,075,824 bytes)

-- λ> minimaDiferencia4 (10^8) `mod` (10^50)

-- 30521751870548886367615394702753936894129787109375

-- (0.41 secs, 24,929,696 bytes)

-- Comprobación de equivalencia

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

-- Como la primera sólo calcula hasta 22, se compara la primera con la

-- cuarta para dichos valores.

prop_equivalencia1 :: Bool

prop_equivalencia1 =

and [minimaDiferencia n == minimaDiferencia4 n | n <- [0,2..22]]

-- La comprobación es

-- λ> prop_equivalencia1

-- True

-- La propiedad de la equivalencia de las definiciones 2, 3 y 4 es

prop_equivalencia :: Integer -> Bool

prop_equivalencia n =

all (== (minimaDiferencia2 n'))

[minimaDiferencia3 n',

minimaDiferencia4 n']

where n' = 2 + abs n

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

Nuevas soluciones

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

Números ordenados con cuadrados ordenados

Soluciones

Nuevas soluciones

Cálculo de pi mediante la fórmula de Brouncker

Soluciones

Nuevas soluciones

Sucesión de Rowland

Soluciones

Nuevas soluciones

Siguiente equidigital

Soluciones

Nuevas soluciones

Mínima diferencia de las sumas de las biparticiones de las N primeras potencias de dos

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico