map

Números como suma de sus dígitos

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

El número 23 se puede escribir de 4 formas como suma de sus dígitos

   2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 3
   2 + 2 + 2 + 2 + 2 + 2 + 2 + 3 + 3 + 3
   2 + 2 + 2 + 2 + 3 + 3 + 3 + 3 + 3
   2 + 3 + 3 + 3 + 3 + 3 + 3 + 3

2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 3

2 + 2 + 2 + 2 + 2 + 2 + 2 + 3 + 3 + 3

2 + 2 + 2 + 2 + 3 + 3 + 3 + 3 + 3

2 + 3 + 3 + 3 + 3 + 3 + 3 + 3

La de menor número de sumando es la última, que tiene 8 sumandos.

Definir las funciones

   minimoSumandosDigitos        :: Integer -> Integer
   graficaMinimoSumandosDigitos :: Integer -> IO ()

1 2	minimoSumandosDigitos :: Integer -> Integer graficaMinimoSumandosDigitos :: Integer -> IO ()

tales que

(minimoSumandosDigitos n) es el menor número de dígitos de n cuya suma es n. Por ejemplo,

     minimoSumandosDigitos 23    ==  8
     minimoSumandosDigitos 232   ==  78
     minimoSumandosDigitos 2323  ==  775
     map minimoSumandosDigitos [10..20] == [10,11,6,5,5,3,6,5,4,3,10]

minimoSumandosDigitos 23 == 8

minimoSumandosDigitos 232 == 78

minimoSumandosDigitos 2323 == 775

map minimoSumandosDigitos [10..20] == [10,11,6,5,5,3,6,5,4,3,10]

(graficaMinimoSumandosDigitos n) dibuja la gráfica de (minimoSumandosDigitos k) par los k primeros números naturales. Por ejemplo, (graficaMinimoSumandosDigitos 300) dibuja

Soluciones

import Data.List (nub, genericLength, sort)
import Graphics.Gnuplot.Simple

minimoSumandosDigitos :: Integer -> Integer
minimoSumandosDigitos n =
  minimoSumandos (digitos n) n

-- (digitos n) es el conjunto de los dígitos no nulos de n. Por ejemplo,
--    digitos 2032  ==  [2,3]
digitos :: Integer -> [Integer]
digitos n =
  nub [read [c] | c <- show n, c /= '0']

-- (minimoSumandos xs n) es el menor número de elementos de la lista de
-- enteros positivos xs (con posibles repeticiones) cuya suma es n. Por
-- ejemplo, 
--    minimoSumandos [7,2,4] 11  ==  2
minimoSumandos :: [Integer] -> Integer -> Integer
minimoSumandos xs n =
  minimum (mapo genericLength (sumas xs n))

-- (sumas xs n) es la lista de elementos de la lista de enteros
-- positivos xs (con posibles repeticiones) cuya suma es n. Por ejemplo,  
--    sumas [7,2,4] 11  ==  [[7,2,2],[7,4]]
sumas :: [Integer] -> Integer -> [[Integer]]
sumas [] 0 = [[]]
sumas [] _ = []
sumas (x:xs) n
  | x <= n    = map (x:) (sumas (x:xs) (n-x)) ++ sumas xs n
  | otherwise = sumas xs n

graficaMinimoSumandosDigitos :: Integer -> IO ()
graficaMinimoSumandosDigitos n =
  plotList [ Key Nothing
           , PNG "Numero_como_suma_de_sus_digitos.png"
           ]
           [minimoSumandosDigitos k | k <- [0..n-1]]

import Data.List (nub, genericLength, sort)

import Graphics.Gnuplot.Simple

minimoSumandosDigitos :: Integer -> Integer

minimoSumandosDigitos n =

minimoSumandos (digitos n) n

-- (digitos n) es el conjunto de los dígitos no nulos de n. Por ejemplo,

-- digitos 2032 == [2,3]

digitos :: Integer -> [Integer]

digitos n =

nub [read [c] | c <- show n, c /= '0']

-- (minimoSumandos xs n) es el menor número de elementos de la lista de

-- enteros positivos xs (con posibles repeticiones) cuya suma es n. Por

-- ejemplo,

-- minimoSumandos [7,2,4] 11 == 2

minimoSumandos :: [Integer] -> Integer -> Integer

minimoSumandos xs n =

minimum (mapo genericLength (sumas xs n))

-- (sumas xs n) es la lista de elementos de la lista de enteros

-- positivos xs (con posibles repeticiones) cuya suma es n. Por ejemplo,

-- sumas [7,2,4] 11 == [[7,2,2],[7,4]]

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

sumas [] 0 = [[]]

sumas [] _ = []

sumas (x:xs) n

| x <= n = map (x:) (sumas (x:xs) (n-x)) ++ sumas xs n

| otherwise = sumas xs n

graficaMinimoSumandosDigitos :: Integer -> IO ()

graficaMinimoSumandosDigitos n =

plotList [ Key Nothing

, PNG "Numero_como_suma_de_sus_digitos.png"

]

[minimoSumandosDigitos k | k <- [0..n-1]]

Pensamiento

Caminante, son tus huellas
el camino, y nada más;
caminante no hay camino,
se hace camino al andar.

Antonio Machado

Las torres de Hanói

PorJosé A. Alonso 5-marzo-201912-marzo-2019

Las torres de Hanoi es un rompecabeza que consta de tres postes que llamaremos A, B y C. Hay N discos de distintos tamaños en el poste A, de forma que no hay un disco situado sobre otro de menor tamaño. Los postes B y C están vacíos. Sólo puede moverse un disco a la vez y todos los discos deben de estar ensartados en algún poste. Ningún disco puede situarse sobre otro de menor tamaño. El problema consiste en colocar los N discos en el poste C.

Los postes se pueden representar mediante el siguiente tipo de datos

   data Poste = A | B | C
     deriving Show

1 2	data Poste = A \| B \| C deriving Show

Definir las funciones

   movimientos :: Integer -> [(Integer,Poste,Poste)]
   hanoi       :: Integer -> IO ()

1 2	movimientos :: Integer -> [(Integer,Poste,Poste)] hanoi :: Integer -> IO ()

tales que

(movimientos n) es la lista de los movimientos para resolver el problema de las torres de hanoi con n discos. Por ejemplo,

     λ> movimientos 1
     [(1,A,C)]
     λ> movimientos 2
     [(1,A,B),(2,A,C),(1,B,C)]
     λ> movimientos 3
     [(1,A,C),(2,A,B),(1,C,B),(3,A,C),(1,B,A),(2,B,C),(1,A,C)]

λ> movimientos 1

[(1,A,C)]

λ> movimientos 2

[(1,A,B),(2,A,C),(1,B,C)]

λ> movimientos 3

[(1,A,C),(2,A,B),(1,C,B),(3,A,C),(1,B,A),(2,B,C),(1,A,C)]

(hanoi n) escribe los mensajes de los movimientos para resolver el problema de las torres de hanoi con n discos. Por ejemplo,

     λ> hanoi 3
     Mueve el disco 1 de A a C
     Mueve el disco 2 de A a B
     Mueve el disco 1 de C a B
     Mueve el disco 3 de A a C
     Mueve el disco 1 de B a A
     Mueve el disco 2 de B a C
     Mueve el disco 1 de A a C

λ> hanoi 3

Mueve el disco 1 de A a C

Mueve el disco 2 de A a B

Mueve el disco 1 de C a B

Mueve el disco 3 de A a C

Mueve el disco 1 de B a A

Mueve el disco 2 de B a C

Mueve el disco 1 de A a C

Soluciones

data Poste = A | B | C
  deriving (Eq, Show)

movimientos :: Integer -> [(Integer,Poste,Poste)]
movimientos n = aux n A B C
  where  
    aux n a b c
      | n == 1    = [(1,a,c)]
      | otherwise = aux (n-1) a c b ++ (n,a,c) : aux (n-1) b a c

hanoi :: Integer -> IO ()
hanoi n = 
  putStrLn (unlines (map mensaje (movimientos n)))

-- (mensaje (n.x.y)) es la cadena indicando que el disco n se ha movido
-- desde el poste x al poste y. Por ejemplo, 
--    λ> mensaje (1,A,B)
--    "Mueve el disco 1 de A a B"
mensaje :: (Integer,Poste,Poste) -> String
mensaje (n,x,y) =
  "Mueve el disco " ++ show n ++ " de " ++ show x ++ " a " ++ show y

data Poste = A | B | C

deriving (Eq, Show)

movimientos :: Integer -> [(Integer,Poste,Poste)]

movimientos n = aux n A B C

where

aux n a b c

| n == 1 = [(1,a,c)]

| otherwise = aux (n-1) a c b ++ (n,a,c) : aux (n-1) b a c

hanoi :: Integer -> IO ()

hanoi n =

putStrLn (unlines (map mensaje (movimientos n)))

-- (mensaje (n.x.y)) es la cadena indicando que el disco n se ha movido

-- desde el poste x al poste y. Por ejemplo,

-- λ> mensaje (1,A,B)

-- "Mueve el disco 1 de A a B"

mensaje :: (Integer,Poste,Poste) -> String

mensaje (n,x,y) =

"Mueve el disco " ++ show n ++ " de " ++ show x ++ " a " ++ show y

Pensamiento

En preguntar lo que sabes
el tiempo no has de perder …
Y a preguntas sin respuesta
¿quién te podrá responder?

Antonio Machado

Hojas con caminos no decrecientes

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

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

   data Arbol = N Int [Arbol]
     deriving Show

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

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

/ \ 8 3 8 3

2 6 /|\ /|\ |

/ \ / \ 4 2 6 4 5 6 2

4 5 5 7

se representan por

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

ej1, ej2, ej3 :: Arbol

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

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

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

Definir la función

   hojasEnNoDecreciente :: Arbol -> [Int]

1	hojasEnNoDecreciente :: Arbol -> [Int]

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

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

hojasEnNoDecreciente ej1 == [4,5,7]

hojasEnNoDecreciente ej2 == [4,6,8]

hojasEnNoDecreciente ej3 == []

Soluciones

import Data.List (sort, nub)

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

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

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

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

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

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

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

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

import Data.List (sort, nub)

data Arbol = N Int [Arbol]

deriving Show

ej1, ej2, ej3 :: Arbol

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

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

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

-- 1ª solución

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

hojasEnNoDecreciente :: Arbol -> [Int]

hojasEnNoDecreciente a =

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

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

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

-- ramasNoDecrecientes ej3 == []

ramasNoDecrecientes :: Arbol -> [[Int]]

ramasNoDecrecientes a =

filter esNoDecreciente (ramas a)

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

-- λ> ramas ej1

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

-- λ> ramas ej2

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

-- λ> ramas ej3

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

ramas :: Arbol -> [[Int]]

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

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

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

-- decreciente. Por ejemplo,

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

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

esNoDecreciente :: [Int] -> Bool

esNoDecreciente xs =

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

-- 2ª solución

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

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

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

-- hojasEnNoDecreciente ej3 == []

hojasEnNoDecreciente2 :: Arbol -> [Int]

hojasEnNoDecreciente2 = sort . nub . aux

where

aux (N x []) = [x]

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

Pensamiento

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

Antonio Machado

Número de descomposiciones en sumas de cuatro cuadrados

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

Definir la función

   nDescomposiciones       :: Int -> Int
   graficaDescomposiciones :: Int -> IO ()

1 2	nDescomposiciones :: Int -> Int graficaDescomposiciones :: Int -> IO ()

tales que

(nDescomposiciones x) es el número de listas de los cuadrados de cuatro números enteros positivos cuya suma es x. Por ejemplo.

     nDescomposiciones 4      ==  1
     nDescomposiciones 5      ==  0
     nDescomposiciones 7      ==  4
     nDescomposiciones 10     ==  6
     nDescomposiciones 15     ==  12
     nDescomposiciones 50000  ==  5682

nDescomposiciones 4 == 1

nDescomposiciones 5 == 0

nDescomposiciones 7 == 4

nDescomposiciones 10 == 6

nDescomposiciones 15 == 12

nDescomposiciones 50000 == 5682

(graficaDescomposiciones n) dibuja la gráfica del número de descomposiciones de los n primeros números naturales. Por ejemplo, (graficaDescomposiciones 500) dibuja

Soluciones

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

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

nDescomposiciones :: Int -> Int
nDescomposiciones = length . descomposiciones

-- (descomposiciones x) es la lista de las listas de los cuadrados de
-- cuatro números enteros positivos cuya suma es x. Por  ejemplo. 
--    λ> descomposiciones 4
--    [[1,1,1,1]]
--    λ> descomposiciones 5
--    []
--    λ> descomposiciones 7
--    [[1,1,1,4],[1,1,4,1],[1,4,1,1],[4,1,1,1]]
--    λ> descomposiciones 10
--    [[1,1,4,4],[1,4,1,4],[1,4,4,1],[4,1,1,4],[4,1,4,1],[4,4,1,1]]
--    λ> descomposiciones 15
--    [[1,1,4,9],[1,1,9,4],[1,4,1,9],[1,4,9,1],[1,9,1,4],[1,9,4,1],
--     [4,1,1,9],[4,1,9,1],[4,9,1,1],[9,1,1,4],[9,1,4,1],[9,4,1,1]]
descomposiciones :: Int -> [[Int]]
descomposiciones x = aux x 4
  where 
    aux 0 1 = []
    aux 1 1 = [[1]]
    aux 2 1 = []
    aux 3 1 = []
    aux y 1 | esCuadrado y = [[y]]
            | otherwise    = []
    aux y n = [x^2 : zs | x <- [1..raizEntera y]
                        , zs <- aux (y - x^2) (n-1)]

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

-- (raizEntera n) es el mayor entero cuya raíz cuadrada es menor o igual
-- que n. Por ejemplo,
--    raizEntera 15  ==  3
--    raizEntera 16  ==  4
--    raizEntera 17  ==  4
raizEntera :: Int -> Int
raizEntera = floor . sqrt . fromIntegral 

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

nDescomposiciones2 :: Int -> Int
nDescomposiciones2 = length . descomposiciones2

descomposiciones2 :: Int -> [[Int]]
descomposiciones2 x = a ! (x,4)
  where
    a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]
    f 0 1 = []
    f 1 1 = [[1]]
    f 2 1 = []
    f 3 1 = []
    f i 1 | esCuadrado i = [[i]]
          | otherwise    = []
    f i j = [x^2 : zs | x <- [1..raizEntera i]
                      , zs <- a ! (i - x^2,j-1)]

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

nDescomposiciones3 :: Int -> Int
nDescomposiciones3 x = aux x 4
  where
    aux 0 1 = 0
    aux 1 1 = 1
    aux 2 1 = 0
    aux 3 1 = 0
    aux y 1 | esCuadrado y = 1
            | otherwise    = 0
    aux y n = sum [aux (y - x^2) (n-1) | x <- [1..raizEntera y]]

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

nDescomposiciones4 :: Int -> Int
nDescomposiciones4 x = a ! (x,4)
  where
    a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]
    f 0 1 = 0
    f 1 1 = 1
    f 2 1 = 0
    f 3 1 = 0
    f i 1 | esCuadrado i = 1
          | otherwise    = 0
    f i j = sum [a ! (i- x^2,j-1) | x <- [1..raizEntera i]]

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

-- La propiedad es
prop_nDescomposiciones :: Positive Int -> Bool
prop_nDescomposiciones (Positive x) =
  all (== nDescomposiciones x) [f x | f <- [ nDescomposiciones2
                                           , nDescomposiciones3
                                           , nDescomposiciones4]]

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

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

--    λ> nDescomposiciones 20000
--    1068
--    (3.69 secs, 3,307,250,128 bytes)
--    λ> nDescomposiciones2 20000
--    1068
--    (0.72 secs, 678,419,328 bytes)
--    λ> nDescomposiciones3 20000
--    1068
--    (3.94 secs, 3,485,725,552 bytes)
--    λ> nDescomposiciones4 20000
--    1068
--    (0.74 secs, 716,022,456 bytes)
--    
--    λ> nDescomposiciones2 50000
--    5682
--    (2.64 secs, 2,444,206,000 bytes)
--    λ> nDescomposiciones4 50000
--    5682
--    (2.77 secs, 2,582,443,448 bytes)

-- Definición de graficaDescomposiciones
-- =====================================

graficaDescomposiciones :: Int -> IO ()
graficaDescomposiciones n =
  plotList [ Key Nothing
           , PNG ("Numero_de_descomposiciones_en_sumas_de_cuadrados.png")
           ]
           (map nDescomposiciones3 [0..n])

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

import Data.Array

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª solución

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

nDescomposiciones :: Int -> Int

nDescomposiciones = length . descomposiciones

-- (descomposiciones x) es la lista de las listas de los cuadrados de

-- cuatro números enteros positivos cuya suma es x. Por ejemplo.

-- λ> descomposiciones 4

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

-- λ> descomposiciones 5

-- []

-- λ> descomposiciones 7

-- [[1,1,1,4],[1,1,4,1],[1,4,1,1],[4,1,1,1]]

-- λ> descomposiciones 10

-- [[1,1,4,4],[1,4,1,4],[1,4,4,1],[4,1,1,4],[4,1,4,1],[4,4,1,1]]

-- λ> descomposiciones 15

-- [[1,1,4,9],[1,1,9,4],[1,4,1,9],[1,4,9,1],[1,9,1,4],[1,9,4,1],

-- [4,1,1,9],[4,1,9,1],[4,9,1,1],[9,1,1,4],[9,1,4,1],[9,4,1,1]]

descomposiciones :: Int -> [[Int]]

descomposiciones x = aux x 4

where

aux 0 1 = []

aux 1 1 = [[1]]

aux 2 1 = []

aux 3 1 = []

aux y 1 | esCuadrado y = [[y]]

| otherwise = []

aux y n = [x^2 : zs | x <- [1..raizEntera y]

, zs <- aux (y - x^2) (n-1)]

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

-- ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 26 == False

esCuadrado :: Int -> Bool

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

-- (raizEntera n) es el mayor entero cuya raíz cuadrada es menor o igual

-- que n. Por ejemplo,

-- raizEntera 15 == 3

-- raizEntera 16 == 4

-- raizEntera 17 == 4

raizEntera :: Int -> Int

raizEntera = floor . sqrt . fromIntegral

-- 2ª solución

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

nDescomposiciones2 :: Int -> Int

nDescomposiciones2 = length . descomposiciones2

descomposiciones2 :: Int -> [[Int]]

descomposiciones2 x = a ! (x,4)

where

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

f 0 1 = []

f 1 1 = [[1]]

f 2 1 = []

f 3 1 = []

f i 1 | esCuadrado i = [[i]]

| otherwise = []

f i j = [x^2 : zs | x <- [1..raizEntera i]

, zs <- a ! (i - x^2,j-1)]

-- 3ª solución

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

nDescomposiciones3 :: Int -> Int

nDescomposiciones3 x = aux x 4

where

aux 0 1 = 0

aux 1 1 = 1

aux 2 1 = 0

aux 3 1 = 0

aux y 1 | esCuadrado y = 1

| otherwise = 0

aux y n = sum [aux (y - x^2) (n-1) | x <- [1..raizEntera y]]

-- 4ª solución

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

nDescomposiciones4 :: Int -> Int

nDescomposiciones4 x = a ! (x,4)

where

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

f 0 1 = 0

f 1 1 = 1

f 2 1 = 0

f 3 1 = 0

f i 1 | esCuadrado i = 1

| otherwise = 0

f i j = sum [a ! (i- x^2,j-1) | x <- [1..raizEntera i]]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_nDescomposiciones :: Positive Int -> Bool

prop_nDescomposiciones (Positive x) =

all (== nDescomposiciones x) [f x | f <- [ nDescomposiciones2

, nDescomposiciones3

, nDescomposiciones4]]

-- La comprobación es

-- λ> quickCheck prop_nDescomposiciones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> nDescomposiciones 20000

-- 1068

-- (3.69 secs, 3,307,250,128 bytes)

-- λ> nDescomposiciones2 20000

-- 1068

-- (0.72 secs, 678,419,328 bytes)

-- λ> nDescomposiciones3 20000

-- 1068

-- (3.94 secs, 3,485,725,552 bytes)

-- λ> nDescomposiciones4 20000

-- 1068

-- (0.74 secs, 716,022,456 bytes)

-- λ> nDescomposiciones2 50000

-- 5682

-- (2.64 secs, 2,444,206,000 bytes)

-- λ> nDescomposiciones4 50000

-- 5682

-- (2.77 secs, 2,582,443,448 bytes)

-- Definición de graficaDescomposiciones

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

graficaDescomposiciones :: Int -> IO ()

graficaDescomposiciones n =

plotList [ Key Nothing

, PNG ("Numero_de_descomposiciones_en_sumas_de_cuadrados.png")

]

(map nDescomposiciones3 [0..n])

Pensamiento

Ya habrá cigüeñas al sol,
mirando la tarde roja,
entre Moncayo y Urbión.

Antonio Machado

Número de sumandos en suma de cuadrados

PorJosé A. Alonso 21-febrero-201926-marzo-2022

El teorema de Lagrange de los cuatro cuadrados asegura que cualquier número entero positivo es la suma de, como máximo,cuatro cuadrados de números enteros. Por ejemplo,

   16 = 4²
   29 = 2² + 5²  
   14 = 1² + 2² + 3²
   15 = 1² + 1² + 2² + 3²

16 = 4²

29 = 2² + 5²

14 = 1² + 2² + 3²

15 = 1² + 1² + 2² + 3²

Definir las funciones

   ordenLagrange        :: Integer -> Int
   graficaOrdenLagrange :: Integer -> IO ()

1 2	ordenLagrange :: Integer -> Int graficaOrdenLagrange :: Integer -> IO ()

tales que

(ordenLagrange n) es el menor número de cuadrados necesarios para escribir n como suma de cuadrados. Por ejemplo.

     ordenLagrange 16     ==  1
     ordenLagrange 29     ==  2
     ordenLagrange 14     ==  3
     ordenLagrange 15     ==  4
     ordenLagrange 10000  ==  1
     ordenLagrange 10001  ==  2
     ordenLagrange 10002  ==  3
     ordenLagrange 10007  ==  4

ordenLagrange 16 == 1

ordenLagrange 29 == 2

ordenLagrange 14 == 3

ordenLagrange 15 == 4

ordenLagrange 10000 == 1

ordenLagrange 10001 == 2

ordenLagrange 10002 == 3

ordenLagrange 10007 == 4

(graficaOrdenLagrange n) dibuja la gráfica de los órdenes de Lagrange de los n primeros números naturales. Por ejemplo, (graficaOrdenLagrange 100) dibuja

Comprobar con QuickCheck que. para todo entero positivo k, el orden de Lagrange de k es menos o igual que 4, el de 4k+3 es distinto de 2 y el de 8k+7 es distinto de 3.

Soluciones

import Data.Array (Array, (!), array)
import Graphics.Gnuplot.Simple

import Test.QuickCheck

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

ordenLagrange :: Integer -> Int
ordenLagrange n
  | esCuadrado n = 1
  | otherwise    = 1 + minimum [ ordenLagrange (n - x^2)
                               | x <- [1..raizEntera n]]

-- (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

-- (raizEntera n) es el mayor entero cuya raíz cuadrada es menor o igual
-- que n. Por ejemplo,
--    raizEntera 15  ==  3
--    raizEntera 16  ==  4
--    raizEntera 17  ==  4
raizEntera :: Integer -> Integer
raizEntera = floor . sqrt . fromIntegral 

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

ordenLagrange2 :: Integer -> Int
ordenLagrange2 n = (vectorOrdenLagrange n) ! n

vectorOrdenLagrange :: Integer -> Array Integer Int
vectorOrdenLagrange n = v where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f i | esCuadrado i = 1
      | otherwise    = 1 + minimum [ v ! (i - j^2)
                                   | j <- [1..raizEntera i]]

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

-- La comparación es
--    λ> ordenLagrange 50
--    2
--    (10.39 secs, 1,704,144,464 bytes)
--    λ> ordenLagrange2 50
--    2
--    (0.01 secs, 341,920 bytes)

-- Definición de graficaOrdenLagrange
-- ==================================

graficaOrdenLagrange :: Integer -> IO ()
graficaOrdenLagrange n = 
  plotList [ Key Nothing
           , PNG ("Numero_de_sumandos_en_suma_de_cuadrados.png")
           ]
           (map ordenLagrange2 [0..n-1])

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

-- La propiedad es
prop_OrdenLagrange :: Positive Integer -> Bool
prop_OrdenLagrange (Positive k) =
  ordenLagrange2 k <= 4 &&
  ordenLagrange2 (4*k+3) /= 2 &&
  ordenLagrange2 (8*k+7) /= 3

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

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

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª definición

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

ordenLagrange :: Integer -> Int

ordenLagrange n

| esCuadrado n = 1

| otherwise = 1 + minimum [ ordenLagrange (n - x^2)

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

-- (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

-- (raizEntera n) es el mayor entero cuya raíz cuadrada es menor o igual

-- que n. Por ejemplo,

-- raizEntera 15 == 3

-- raizEntera 16 == 4

-- raizEntera 17 == 4

raizEntera :: Integer -> Integer

raizEntera = floor . sqrt . fromIntegral

-- 2ª definición

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

ordenLagrange2 :: Integer -> Int

ordenLagrange2 n = (vectorOrdenLagrange n) ! n

vectorOrdenLagrange :: Integer -> Array Integer Int

vectorOrdenLagrange n = v where

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

f i | esCuadrado i = 1

| otherwise = 1 + minimum [ v ! (i - j^2)

| j <- [1..raizEntera i]]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ordenLagrange 50

-- 2

-- (10.39 secs, 1,704,144,464 bytes)

-- λ> ordenLagrange2 50

-- 2

-- (0.01 secs, 341,920 bytes)

-- Definición de graficaOrdenLagrange

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

graficaOrdenLagrange :: Integer -> IO ()

graficaOrdenLagrange n =

plotList [ Key Nothing

, PNG ("Numero_de_sumandos_en_suma_de_cuadrados.png")

]

(map ordenLagrange2 [0..n-1])

-- Comprobación de la propiedad

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

-- La propiedad es

prop_OrdenLagrange :: Positive Integer -> Bool

prop_OrdenLagrange (Positive k) =

ordenLagrange2 k <= 4 &&

ordenLagrange2 (4*k+3) /= 2 &&

ordenLagrange2 (8*k+7) /= 3

-- La comprobación es

-- λ> quickCheck prop_OrdenLagrange

-- +++ OK, passed 100 tests.

Pensamiento

— Nuestro español bosteza.
¿Es hambre? ¿Sueño? ¿Hastío?
Doctor, ¿tendrá el estómago vacío?
— El vacío es más bien en la cabeza.

Antonio Machado

Números como suma de sus dígitos

Soluciones

Pensamiento

Las torres de Hanói

Soluciones

Pensamiento

Hojas con caminos no decrecientes

Soluciones

Pensamiento

Número de descomposiciones en sumas de cuatro cuadrados

Soluciones

Pensamiento

Número de sumandos en suma de cuadrados

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico