map

Las sucesiones de Loomis

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

La sucesión de Loomis generada por un número entero positivo x es la sucesión cuyos términos se definen por

f(0) es x
f(n) es la suma de f(n-1) y el producto de los dígitos no nulos de f(n-1)

Los primeros términos de las primeras sucesiones de Loomis son

Generada por 1: 1, 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, …
Generada por 2: 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 3: 3, 6, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 4: 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, 138, …
Generada por 5: 5, 10, 11, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, …

Se observa que a partir de un término todas coinciden con la generada por 1. Dicho término se llama el punto de convergencia. Por ejemplo,

la generada por 2 converge a 2
la generada por 3 converge a 26
la generada por 4 converge a 4
la generada por 5 converge a 26

Definir las siguientes funciones

   sucLoomis           :: Integer -> [Integer]
   convergencia        :: Integer -> Integer
   graficaConvergencia :: [Integer] -> IO ()

sucLoomis :: Integer -> [Integer]

convergencia :: Integer -> Integer

graficaConvergencia :: [Integer] -> IO ()

tales que

(sucLoomis x) es la sucesión de Loomis generada por x. Por ejemplo,

     λ> take 15 (sucLoomis 1)
     [1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 2)
     [2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 3)
     [3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 4)
     [4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]
     λ> take 15 (sucLoomis 5)
     [5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 20)
     [20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]
     λ> take 15 (sucLoomis 100)
     [100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]
     λ> sucLoomis 1 !! (2*10^5)
     235180736652

λ> take 15 (sucLoomis 1)

[1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]

λ> take 15 (sucLoomis 2)

[2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]

λ> take 15 (sucLoomis 3)

[3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]

λ> take 15 (sucLoomis 4)

[4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]

λ> take 15 (sucLoomis 5)

[5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]

λ> take 15 (sucLoomis 20)

[20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]

λ> take 15 (sucLoomis 100)

[100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]

λ> sucLoomis 1 !! (2*10^5)

235180736652

(convergencia x) es el término de convergencia de la sucesioń de Loomis generada por x xon la geerada por 1. Por ejemplo,

     convergencia  2      ==  2
     convergencia  3      ==  26
     convergencia  4      ==  4
     convergencia 17      ==  38
     convergencia 19      ==  102
     convergencia 43      ==  162
     convergencia 27      ==  202
     convergencia 58      ==  474
     convergencia 63      ==  150056
     convergencia 81      ==  150056
     convergencia 89      ==  150056
     convergencia (10^12) ==  1000101125092

convergencia 2 == 2

convergencia 3 == 26

convergencia 4 == 4

convergencia 17 == 38

convergencia 19 == 102

convergencia 43 == 162

convergencia 27 == 202

convergencia 58 == 474

convergencia 63 == 150056

convergencia 81 == 150056

convergencia 89 == 150056

convergencia (10^12) == 1000101125092

(graficaConvergencia xs) dibuja la gráfica de los términos de convergencia de las sucesiones de Loomis generadas por los elementos de xs. Por ejemplo, (graficaConvergencia ([1..50]) dibuja

y graficaConvergencia ([1..148] \ [63,81,89,137]) dibuja

Soluciones

import Data.List               ((\\))
import Data.Char               (digitToInt)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title, XRange, PNG))

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

sucLoomis :: Integer -> [Integer]
sucLoomis x = map (loomis x) [0..]

loomis :: Integer -> Integer -> Integer
loomis x 0 = x
loomis x n = y + productoDigitosNoNulos y
  where y = loomis x (n-1)

productoDigitosNoNulos :: Integer -> Integer
productoDigitosNoNulos = product . digitosNoNulos

digitosNoNulos :: Integer -> [Integer]
digitosNoNulos x =
  [read [c] | c <- show x, c /= '0']

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

sucLoomis2 :: Integer -> [Integer]
sucLoomis2 = iterate siguienteLoomis 

siguienteLoomis :: Integer -> Integer
siguienteLoomis y = y + productoDigitosNoNulos y

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

sucLoomis3 :: Integer -> [Integer]
sucLoomis3 =
  iterate ((+) <*> product .
           map (toInteger . digitToInt) .
           filter (/= '0') . show)

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

--    λ> sucLoomis 1 !! 30000
--    6571272766
--    (2.45 secs, 987,955,944 bytes)
--    λ> sucLoomis2 1 !! 30000
--    6571272766
--    (2.26 secs, 979,543,328 bytes)
--    λ> sucLoomis3 1 !! 30000
--    6571272766
--    (0.31 secs, 88,323,832 bytes)

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

convergencia1 :: Integer -> Integer
convergencia1 x =
  head (dropWhile noEnSucLoomisDe1 (sucLoomis x))

noEnSucLoomisDe1 :: Integer -> Bool
noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)

sucLoomisDe1 :: [Integer]
sucLoomisDe1 = sucLoomis 1

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

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

convergencia2 :: Integer -> Integer
convergencia2 = aux (sucLoomis3 1) . sucLoomis3
 where aux as@(x:xs) bs@(y:ys) | x == y    = x
                               | x < y     = aux xs bs
                               | otherwise = aux as ys

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

convergencia3 :: Integer -> Integer
convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3
 
-- (interseccion xs ys) es la intersección entre las listas ordenadas xs
-- e ys. Por ejemplo,
--    λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))
--    [2,4,8,16,22,26,38,62,74,102]
interseccion :: Ord a => [a] -> [a] -> [a]
interseccion = aux
  where aux as@(x:xs) bs@(y:ys) = case compare x y of
                                    LT ->     aux xs bs
                                    EQ -> x : aux xs ys
                                    GT ->     aux as ys
        aux _         _         = []                           

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

convergencia4 :: Integer -> Integer
convergencia4 x = perteneceA (sucLoomis3 x) 1
  where perteneceA (y:ys) n | y == c    = y
                            | otherwise = perteneceA ys c
          where c = head $ dropWhile (< y) $ sucLoomis3 n

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

--    λ> convergencia1 (10^4)
--    150056
--    (2.94 secs, 1,260,809,808 bytes)
--    λ> convergencia2 (10^4)
--    150056
--    (0.03 secs, 700,240 bytes)
--    λ> convergencia3 (10^4)
--    150056
--    (0.03 secs, 1,165,496 bytes)
--    λ> convergencia4 (10^4)
--    150056
--    (0.02 secs, 1,119,648 bytes)
--    
--    λ> convergencia2 (10^12)
--    1000101125092
--    (1.81 secs, 714,901,080 bytes)
--    λ> convergencia3 (10^12)
--    1000101125092
--    (1.92 secs, 744,932,184 bytes)
--    λ> convergencia4 (10^12)
--    1000101125092
--    (1.82 secs, 941,053,328 bytes)

-- Definición de graficaConvergencia
-- ==================================

graficaConvergencia :: [Integer] -> IO ()
graficaConvergencia xs =
  plotList [ Key Nothing
           , Title "Convergencia de sucesiones de Loomis"
           , XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))
           , PNG "Las_sucesiones_de_Loomis_2.png"
           ]
           [(x,convergencia2 x) | x <- xs]

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

import Data.Char (digitToInt)

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

-- 1ª definición de sucLoomis

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

sucLoomis :: Integer -> [Integer]

sucLoomis x = map (loomis x) [0..]

loomis :: Integer -> Integer -> Integer

loomis x 0 = x

loomis x n = y + productoDigitosNoNulos y

where y = loomis x (n-1)

productoDigitosNoNulos :: Integer -> Integer

productoDigitosNoNulos = product . digitosNoNulos

digitosNoNulos :: Integer -> [Integer]

digitosNoNulos x =

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

-- 2ª definición de sucLoomis

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

sucLoomis2 :: Integer -> [Integer]

sucLoomis2 = iterate siguienteLoomis

siguienteLoomis :: Integer -> Integer

siguienteLoomis y = y + productoDigitosNoNulos y

-- 3ª definición de sucLoomis

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

sucLoomis3 :: Integer -> [Integer]

sucLoomis3 =

iterate ((+) <*> product .

map (toInteger . digitToInt) .

filter (/= '0') . show)

-- Comparación de eficiencia

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

-- λ> sucLoomis 1 !! 30000

-- 6571272766

-- (2.45 secs, 987,955,944 bytes)

-- λ> sucLoomis2 1 !! 30000

-- 6571272766

-- (2.26 secs, 979,543,328 bytes)

-- λ> sucLoomis3 1 !! 30000

-- 6571272766

-- (0.31 secs, 88,323,832 bytes)

-- 1ª definición de convergencia

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

convergencia1 :: Integer -> Integer

convergencia1 x =

head (dropWhile noEnSucLoomisDe1 (sucLoomis x))

noEnSucLoomisDe1 :: Integer -> Bool

noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)

sucLoomisDe1 :: [Integer]

sucLoomisDe1 = sucLoomis 1

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys =

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

-- 2ª definición de convergencia

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

convergencia2 :: Integer -> Integer

convergencia2 = aux (sucLoomis3 1) . sucLoomis3

where aux as@(x:xs) bs@(y:ys) | x == y = x

| x < y = aux xs bs

| otherwise = aux as ys

-- 3ª definición de convergencia

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

convergencia3 :: Integer -> Integer

convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3

-- (interseccion xs ys) es la intersección entre las listas ordenadas xs

-- e ys. Por ejemplo,

-- λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))

-- [2,4,8,16,22,26,38,62,74,102]

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

interseccion = aux

where aux as@(x:xs) bs@(y:ys) = case compare x y of

LT -> aux xs bs

EQ -> x : aux xs ys

GT -> aux as ys

aux _ _ = []

-- 4ª definición de convergencia

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

convergencia4 :: Integer -> Integer

convergencia4 x = perteneceA (sucLoomis3 x) 1

where perteneceA (y:ys) n | y == c = y

| otherwise = perteneceA ys c

where c = head $ dropWhile (< y) $ sucLoomis3 n

-- Comparación de eficiencia

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

-- λ> convergencia1 (10^4)

-- 150056

-- (2.94 secs, 1,260,809,808 bytes)

-- λ> convergencia2 (10^4)

-- 150056

-- (0.03 secs, 700,240 bytes)

-- λ> convergencia3 (10^4)

-- 150056

-- (0.03 secs, 1,165,496 bytes)

-- λ> convergencia4 (10^4)

-- 150056

-- (0.02 secs, 1,119,648 bytes)

-- λ> convergencia2 (10^12)

-- 1000101125092

-- (1.81 secs, 714,901,080 bytes)

-- λ> convergencia3 (10^12)

-- 1000101125092

-- (1.92 secs, 744,932,184 bytes)

-- λ> convergencia4 (10^12)

-- 1000101125092

-- (1.82 secs, 941,053,328 bytes)

-- Definición de graficaConvergencia

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

graficaConvergencia :: [Integer] -> IO ()

graficaConvergencia xs =

plotList [ Key Nothing

, Title "Convergencia de sucesiones de Loomis"

, XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))

, PNG "Las_sucesiones_de_Loomis_2.png"

]

[(x,convergencia2 x) | x <- xs]

Pensamiento

Era una noche del mes
de mayo, azul y serena.
Sobre el agudo ciprés
brillaba la luna llena.

Antonio Machado

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

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

Definir la función

   mayorProducto :: Int -> Integer -> Integer

1	mayorProducto :: Int -> Integer -> Integer

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

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

mayorProducto 2 325 == 10

mayorProducto 5 11111 == 1

mayorProducto 5 113111 == 3

mayorProducto 5 110111 == 0

mayorProducto 5 10151112 == 10

mayorProducto 5 101511124 == 10

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

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

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

import Test.QuickCheck

import Data.List (inits, tails)

import Data.Char (digitToInt)

-- 1ª solución

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

mayorProducto1 :: Int -> Integer -> Integer

mayorProducto1 n x =

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

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

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

cifras :: Integer -> [Integer]

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

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

-- lista xs. Por ejemplo,

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

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

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

-- 2ª solución

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

mayorProducto2 :: Int -> Integer -> Integer

mayorProducto2 n x = maximum (aux ns)

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

aux xs | length xs < n = []

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

-- 3ª solución

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

mayorProducto3 :: Int -> Integer -> Integer

mayorProducto3 n = maximum

. map (product . take n)

. filter ((>=n) . length)

. tails

. cifras

-- 4ª solución

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

mayorProducto4 :: Int -> Integer -> Integer

mayorProducto4 n = maximum

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

. filter ((==n) . length)

. concatMap inits

. tails

. show

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

-- Comparación de soluciones --

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

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

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

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

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

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

-- | 4 | 2.77 | | |

Pensamiento

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

Antonio Machado

Operaciones con series de potencias

PorJosé A. Alonso 26-abril-201925-marzo-2022

Una serie de potencias es una serie de la forma

   a₀ + a₁x + a₂x² + a₃x³ + ...

1	a₀ + a₁x + a₂x² + a₃x³ + ...

Las series de potencias se pueden representar mediante listas infinitas. Por ejemplo, la serie de la función exponencial es

   e^x = 1 + x + x²/2! + x³/3! + ...

1	e^x = 1 + x + x²/2! + x³/3! + ...

y se puede representar por [1, 1, 1/2, 1/6, 1/24, 1/120, …]

Las operaciones con series se pueden ver como una generalización de las de los polinomios.

En lo que sigue, usaremos el tipo (Serie a) para representar las series de potencias con coeficientes en a y su definición es

   type Serie a = [a]

1	type Serie a = [a]

Definir las siguientes funciones

   opuesta      :: Num a => Serie a -> Serie a
   suma         :: Num a => Serie a -> Serie a -> Serie a
   resta        :: Num a => Serie a -> Serie a -> Serie a
   producto     :: Num a => Serie a -> Serie a -> Serie a
   cociente     :: Fractional a => Serie a -> Serie a -> Serie a
   derivada     :: (Num a, Enum a) => Serie a -> Serie a
   integral     :: (Fractional a, Enum a) => Serie a -> Serie a
   expx         :: Serie Rational

opuesta :: Num a => Serie a -> Serie a

suma :: Num a => Serie a -> Serie a -> Serie a

resta :: Num a => Serie a -> Serie a -> Serie a

producto :: Num a => Serie a -> Serie a -> Serie a

cociente :: Fractional a => Serie a -> Serie a -> Serie a

derivada :: (Num a, Enum a) => Serie a -> Serie a

integral :: (Fractional a, Enum a) => Serie a -> Serie a

expx :: Serie Rational

tales que

(opuesta xs) es la opuesta de la serie xs. Por ejemplo,

     λ> take 7 (opuesta [-6,-4..])
     [6,4,2,0,-2,-4,-6]

1 2	λ> take 7 (opuesta [-6,-4..]) [6,4,2,0,-2,-4,-6]

(suma xs ys) es la suma de las series xs e ys. Por ejemplo,

     λ> take 7 (suma [1,3..] [2,4..])
     [3,7,11,15,19,23,27]

1 2	λ> take 7 (suma [1,3..] [2,4..]) [3,7,11,15,19,23,27]

(resta xs ys) es la resta de las series xs es ys. Por ejemplo,

     λ> take 7 (resta [3,5..] [2,4..])
     [1,1,1,1,1,1,1]
     λ> take 7 (resta ([3,7,11,15,19,23,27] ++ repeat 0) [1,3..])
     [2,4,6,8,10,12,14]

λ> take 7 (resta [3,5..] [2,4..])

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

λ> take 7 (resta ([3,7,11,15,19,23,27] ++ repeat 0) [1,3..])

[2,4,6,8,10,12,14]

(producto xs ys) es el producto de las series xs e ys. Por ejemplo,

     λ> take 7 (producto [3,5..] [2,4..])
     [6,22,52,100,170,266,392]

1 2	λ> take 7 (producto [3,5..] [2,4..]) [6,22,52,100,170,266,392]

(cociente xs ys) es el cociente de las series xs e ys. Por ejemplo,

     λ> take 7 (cociente ([6,22,52,100,170,266,392] ++ repeat 0) [3,5..])
     [2.0,4.0,6.0,8.0,10.0,12.0,14.0]

1 2	λ> take 7 (cociente ([6,22,52,100,170,266,392] ++ repeat 0) [3,5..]) [2.0,4.0,6.0,8.0,10.0,12.0,14.0]

(derivada xs) es la derivada de la serie xs. Por ejemplo,

     λ> take 7 (derivada [2,4..])
     [4,12,24,40,60,84,112]

1 2	λ> take 7 (derivada [2,4..]) [4,12,24,40,60,84,112]

(integral xs) es la integral de la serie xs. Por ejemplo,

     λ> take 7 (integral ([4,12,24,40,60,84,112] ++ repeat 0))
     [0.0,4.0,6.0,8.0,10.0,12.0,14.0]

1 2	λ> take 7 (integral ([4,12,24,40,60,84,112] ++ repeat 0)) [0.0,4.0,6.0,8.0,10.0,12.0,14.0]

expx es la serie de la función exponencial. Por ejemplo,

     λ> take 8 expx
     [1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]
     λ> take 8 (derivada expx)
     [1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]
     λ> take 8 (integral expx)
     [0 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 expx

[1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 (derivada expx)

[1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 (integral expx)

[0 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

Soluciones

type Serie a = [a] 

opuesta :: Num a => Serie a -> Serie a
opuesta = map negate

suma :: Num a => Serie a -> Serie a -> Serie a
suma = zipWith (+)

resta :: Num a => Serie a -> Serie a -> Serie a
resta xs ys = suma xs (opuesta ys)

producto :: Num a => Serie a -> Serie a -> Serie a
producto (x:xs) zs@(y:ys) = 
    x*y : suma (producto xs zs) (map (x*) ys)

cociente :: Fractional a => Serie a -> Serie a -> Serie a
cociente (x:xs) (y:ys) = zs 
    where zs = x/y : map (/y) (resta xs (producto zs ys))  

derivada :: (Num a, Enum a) => Serie a -> Serie a
derivada (_:xs) = zipWith (*) xs [1..]

integral :: (Fractional a, Enum a) => Serie a -> Serie a
integral xs = 0 : zipWith (/) xs [1..]

expx :: Serie Rational
expx = map (1/) (map fromIntegral factoriales)

-- factoriales es la lista de los factoriales. Por ejemplo, 
--    take 7 factoriales  ==  [1,1,2,6,24,120,720]
factoriales :: [Integer]
factoriales = 1 : scanl1 (*) [1..]

type Serie a = [a]

opuesta :: Num a => Serie a -> Serie a

opuesta = map negate

suma :: Num a => Serie a -> Serie a -> Serie a

suma = zipWith (+)

resta :: Num a => Serie a -> Serie a -> Serie a

resta xs ys = suma xs (opuesta ys)

producto :: Num a => Serie a -> Serie a -> Serie a

producto (x:xs) zs@(y:ys) =

x*y : suma (producto xs zs) (map (x*) ys)

cociente :: Fractional a => Serie a -> Serie a -> Serie a

cociente (x:xs) (y:ys) = zs

where zs = x/y : map (/y) (resta xs (producto zs ys))

derivada :: (Num a, Enum a) => Serie a -> Serie a

derivada (_:xs) = zipWith (*) xs [1..]

integral :: (Fractional a, Enum a) => Serie a -> Serie a

integral xs = 0 : zipWith (/) xs [1..]

expx :: Serie Rational

expx = map (1/) (map fromIntegral factoriales)

-- factoriales es la lista de los factoriales. Por ejemplo,

-- take 7 factoriales == [1,1,2,6,24,120,720]

factoriales :: [Integer]

factoriales = 1 : scanl1 (*) [1..]

Pensamiento

Ni mármol duro y eterno,
ni música ni pintura,
sino palabra en el tiempo.

Antonio Machado

Reparto de escaños por la ley d’Hont

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

El sistema D’Hondt es una fórmula creada por Victor d’Hondt, que permite obtener el número de cargos electos asignados a las candidaturas, en proporción a los votos conseguidos.

Tras el recuento de los votos, se calcula una serie de divisores para cada partido. La fórmula de los divisores es V/N, donde V representa el número total de votos recibidos por el partido, y N representa cada uno de los números enteros desde 1 hasta el número de cargos electos de la circunscripción objeto de escrutinio. Una vez realizadas las divisiones de los votos de cada partido por cada uno de los divisores desde 1 hasta N, la asignación de cargos electos se hace ordenando los cocientes de las divisiones de mayor a menor y asignando a cada uno un escaño hasta que éstos se agoten

Definir la función

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

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

tal que (reparto n vs) es la lista de los pares formados por los números de los partidos y el número de escaño que les corresponden al repartir n escaños en función de la lista de sus votos. Por ejemplo,

   ghci> reparto 7 [340000,280000,160000,60000,15000]
   [(1,3),(2,3),(3,1)]
   ghci> reparto 21 [391000,311000,184000,73000,27000,12000,2000]
   [(1,9),(2,7),(3,4),(4,1)]

ghci> reparto 7 [340000,280000,160000,60000,15000]

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

ghci> reparto 21 [391000,311000,184000,73000,27000,12000,2000]

[(1,9),(2,7),(3,4),(4,1)]

es decir, en el primer ejemplo,

al 1º partido (que obtuvo 340000 votos) le corresponden 3 escaños,
al 2º partido (que obtuvo 280000 votos) le corresponden 3 escaños,
al 3º partido (que obtuvo 160000 votos) le corresponden 1 escaño.

Soluciones

import Data.List (sort, group)

-- Para los ejemplos que siguen, se usará la siguiente ditribución de
-- votos entre 5 partidos.
ejVotos :: [Int]
ejVotos = [340000,280000,160000,60000,15000]

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

reparto :: Int -> [Int] -> [(Int,Int)]
reparto n vs = 
  [(x,1 + length xs) | (x:xs) <- group (sort (repartoAux n vs))] 

-- (repartoAux n vs) es el número de los partidos, cuyos votos son vs, que
-- obtienen los n escaños. Por ejemplo,
--    ghci> repartoAux 7 ejVotos
--    [1,2,1,3,2,1,2]
repartoAux :: Int -> [Int] -> [Int]
repartoAux n vs = map snd (repartoAux' n vs)

-- (repartoAux' n vs) es la lista formada por los n restos mayores
-- correspondientes a la lista de votos vs. Por ejemplo,
--    ghci> repartoAux' 7 ejVotos
--    [(340000,1),(280000,2),(170000,1),(160000,3),(140000,2),(113333,1),
--     (93333,2)]
repartoAux' :: Int -> [Int] -> [(Int,Int)]
repartoAux' n vs = 
  take n (reverse (sort (concatMap (restos n) (votosPartidos vs))))

-- (votosPartidos vs) es la lista con los pares formados por los votos y
-- el número de cada partido. Por ejemplo, 
--    ghci> votosPartidos ejVotos
--    [(340000,1),(280000,2),(160000,3),(60000,4),(15000,5)]
votosPartidos :: [Int] -> [(Int,Int)]
votosPartidos vs = zip vs [1..]

-- (restos n (x,i)) es la lista obtenidas dividiendo n entre 1, 2,..., n.
-- Por ejemplo, 
--    ghci> restos 5 (340000,1)
--    [(340000,1),(170000,1),(113333,1),(85000,1),(68000,1)]
restos :: Int -> (Int,Int) -> [(Int,Int)]
restos n (x,i) = [(x `div` k,i) | k <- [1..n]]

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

reparto2 :: Int -> [Int] -> [(Int,Int)]
reparto2 n xs = 
  ( map (\x -> (head x, length x))  
  . group  
  . sort  
  . map snd  
  . take n  
  . reverse  
  . sort
  ) [(x `div` i, p) | (x,p) <- zip xs [1..], i <- [1..n]]

import Data.List (sort, group)

-- Para los ejemplos que siguen, se usará la siguiente ditribución de

-- votos entre 5 partidos.

ejVotos :: [Int]

ejVotos = [340000,280000,160000,60000,15000]

-- 1ª solución

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

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

reparto n vs =

[(x,1 + length xs) | (x:xs) <- group (sort (repartoAux n vs))]

-- (repartoAux n vs) es el número de los partidos, cuyos votos son vs, que

-- obtienen los n escaños. Por ejemplo,

-- ghci> repartoAux 7 ejVotos

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

repartoAux :: Int -> [Int] -> [Int]

repartoAux n vs = map snd (repartoAux' n vs)

-- (repartoAux' n vs) es la lista formada por los n restos mayores

-- correspondientes a la lista de votos vs. Por ejemplo,

-- ghci> repartoAux' 7 ejVotos

-- [(340000,1),(280000,2),(170000,1),(160000,3),(140000,2),(113333,1),

-- (93333,2)]

repartoAux' :: Int -> [Int] -> [(Int,Int)]

repartoAux' n vs =

take n (reverse (sort (concatMap (restos n) (votosPartidos vs))))

-- (votosPartidos vs) es la lista con los pares formados por los votos y

-- el número de cada partido. Por ejemplo,

-- ghci> votosPartidos ejVotos

-- [(340000,1),(280000,2),(160000,3),(60000,4),(15000,5)]

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

votosPartidos vs = zip vs [1..]

-- (restos n (x,i)) es la lista obtenidas dividiendo n entre 1, 2,..., n.

-- Por ejemplo,

-- ghci> restos 5 (340000,1)

-- [(340000,1),(170000,1),(113333,1),(85000,1),(68000,1)]

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

restos n (x,i) = [(x `div` k,i) | k <- [1..n]]

-- 2ª solución

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

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

reparto2 n xs =

( map (\x -> (head x, length x))

. group

. sort

. map snd

. take n

. reverse

. sort

) [(x `div` i, p) | (x,p) <- zip xs [1..], i <- [1..n]]

Pensamiento

Sus cantares llevan
agua de remanso,
que parece quieta.
Y que no lo está;
mas no tiene prisa
por ir a la mar.

Antonio Machado

Matriz dodecafónica

PorJosé A. Alonso 10-abril-201925-abril-2019

Como se explica en Create a Twelve-Tone Melody With a Twelve-Tone Matrix una matriz dodecafónica es una matriz de 12 filas y 12 columnas construidas siguiendo los siguientes pasos:

Se escribe en la primera fila una permutación de los números del 1 al 12. Por ejemplo,

     (  3  1  9  5  4  6  8  7 12 10 11  2 )
     (                                     )
     (                                     )
     (                                     )
     (                                     )
     (                                     )
     (                                     )
     (                                     )
     (                                     )
     (                                     )
     (                                     )
     (                                     )

( 3 1 9 5 4 6 8 7 12 10 11 2 )

( )

Escribir la primera columna de forma que, para todo i (entre 2 y 12), a(i,1) es el número entre 1 y 12 que verifica la siguiente condición

     (a(1,1) - a(i,1)) = (a(1,i) - a(1,1)) (módulo 12)

1	(a(1,1) - a(i,1)) = (a(1,i) - a(1,1)) (módulo 12)

Siguiendo con el ejemplo anterior, la matriz con la 1ª fila y la 1ª columna es

     (  3  1  9  5  4  6  8  7 12 10 11  2 )
     (  5                                  )
     (  9                                  )
     (  1                                  )
     (  2                                  )
     ( 12                                  )
     ( 10                                  )
     ( 11                                  )
     (  6                                  )
     (  8                                  )
     (  7                                  )
     (  4                                  )

( 3 1 9 5 4 6 8 7 12 10 11 2 )

( 5 )

( 9 )

( 1 )

( 2 )

( 12 )

( 10 )

( 11 )

( 6 )

( 8 )

( 7 )

( 4 )

Escribir la segunda fila de forma que, para todo j (entre 2 y 12), a(j,2) es el número entre 1 y 12 que verifica la siguiente condición

     (a(2,j) - a(1,j)) = (a(2,1) - a(1,1)) (módulo 12)

1	(a(2,j) - a(1,j)) = (a(2,1) - a(1,1)) (módulo 12)

Siguiendo con el ejemplo anterior, la matriz con la 1ª fila, 1ª columna y 2ª fila es

     (  3  1  9  5  4  6  8  7 12 10 11  2 )
     (  5  3 11  7  6  8 10  9  2 12  1  4 )
     (  9                                  )
     (  1                                  )
     (  2                                  )
     ( 12                                  )
     ( 10                                  )
     ( 11                                  )
     (  6                                  )
     (  8                                  )
     (  7                                  )
     (  4                                  )

( 3 1 9 5 4 6 8 7 12 10 11 2 )

( 5 3 11 7 6 8 10 9 2 12 1 4 )

( 9 )

( 1 )

( 2 )

( 12 )

( 10 )

( 11 )

( 6 )

( 8 )

( 7 )

( 4 )

Las restantes filas se completan como la 2ª; es decir, para todo i (entre 3 y 12) y todo j (entre 2 y 12), a(i,j) es el número entre 1 y 12 que verifica la siguiente relación.

     (a(i,j) - a(1,j)) = (a(i,1) - a(1,1)) (módulo 12)

1	(a(i,j) - a(1,j)) = (a(i,1) - a(1,1)) (módulo 12)

Siguiendo con el ejemplo anterior, la matriz dodecafónica es

     (  3  1  9  5  4  6  8  7 12 10 11  2 )
     (  5  3 11  7  6  8 10  9  2 12  1  4 )
     (  9  7  3 11 10 12  2  1  6  4  5  8 )
     (  1 11  7  3  2  4  6  5 10  8  9 12 )
     (  2 12  8  4  3  5  7  6 11  9 10  1 )
     ( 12 10  6  2  1  3  5  4  9  7  8 11 )
     ( 10  8  4 12 11  1  3  2  7  5  6  9 )
     ( 11  9  5  1 12  2  4  3  8  6  7 10 )
     (  6  4 12  8  7  9 11 10  3  1  2  5 )
     (  8  6  2 10  9 11  1 12  5  3  4  7 )
     (  7  5  1  9  8 10 12 11  4  2  3  6 )
     (  4  2 10  6  5  7  9  8  1 11 12  3 )

( 3 1 9 5 4 6 8 7 12 10 11 2 )

( 5 3 11 7 6 8 10 9 2 12 1 4 )

( 9 7 3 11 10 12 2 1 6 4 5 8 )

( 1 11 7 3 2 4 6 5 10 8 9 12 )

( 2 12 8 4 3 5 7 6 11 9 10 1 )

( 12 10 6 2 1 3 5 4 9 7 8 11 )

( 10 8 4 12 11 1 3 2 7 5 6 9 )

( 11 9 5 1 12 2 4 3 8 6 7 10 )

( 6 4 12 8 7 9 11 10 3 1 2 5 )

( 8 6 2 10 9 11 1 12 5 3 4 7 )

( 7 5 1 9 8 10 12 11 4 2 3 6 )

( 4 2 10 6 5 7 9 8 1 11 12 3 )

Definir la función

   matrizDodecafonica :: [Int] -> Matrix Int

1	matrizDodecafonica :: [Int] -> Matrix Int

tal que (matrizDodecafonica xs) es la matriz dodecafónica cuya primera fila es xs (que se supone que es una permutación de los números del 1 al 12). Por ejemplo,

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

λ> matrizDodecafonica [3,1,9,5,4,6,8,7,12,10,11,2]

( 3 1 9 5 4 6 8 7 12 10 11 2 )

( 5 3 11 7 6 8 10 9 2 12 1 4 )

( 9 7 3 11 10 12 2 1 6 4 5 8 )

( 1 11 7 3 2 4 6 5 10 8 9 12 )

( 2 12 8 4 3 5 7 6 11 9 10 1 )

( 12 10 6 2 1 3 5 4 9 7 8 11 )

( 10 8 4 12 11 1 3 2 7 5 6 9 )

( 11 9 5 1 12 2 4 3 8 6 7 10 )

( 6 4 12 8 7 9 11 10 3 1 2 5 )

( 8 6 2 10 9 11 1 12 5 3 4 7 )

( 7 5 1 9 8 10 12 11 4 2 3 6 )

( 4 2 10 6 5 7 9 8 1 11 12 3 )

Comprobar con QuickCheck para toda matriz dodecafónica D se verifican las siguientes propiedades:

todas las filas de D son permutaciones de los números 1 a 12,
todos los elementos de la diagonal de D son iguales y
la suma de todos los elementos de D es 936.

Nota: Este ejercicio ha sido propuesto por Francisco J. Hidalgo.

Soluciones

import Data.List
import Test.QuickCheck
import Data.Matrix

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

matrizDodecafonica :: [Int] -> Matrix Int
matrizDodecafonica xs = matrix 12 12 f
  where f (1,j) = xs !! (j-1)
        f (i,1) = modulo12 (2 * f (1,1) - f (1,i)) 
        f (i,j) = modulo12 (f (1,j) + f (i,1) - f (1,1)) 
        modulo12 0  = 12
        modulo12 12 = 12
        modulo12 x  = x `mod` 12
  
-- 2ª solución
-- ===========

matrizDodecafonica2 :: [Int] -> Matrix Int
matrizDodecafonica2 xs = fromLists (secuencias xs)

secuencias :: [Int] -> [[Int]]
secuencias xs = [secuencia a xs | a <- inversa xs]

inversa :: [Int] -> [Int]
inversa xs = map conv (map (\x -> (-x) + 2* (abs a)) xs)
  where a = head xs
        
secuencia :: Int -> [Int] -> [Int]
secuencia n xs = [conv (a+(n-b)) | a <- xs] 
  where b = head xs

conv :: Int -> Int
conv n | n == 0 = 12
       | n < 0 = conv (n+12)
       | n > 11 = conv (mod n 12)
       | otherwise = n          

-- Propiedades
-- ===========

-- Las propiedades son
prop_dodecafonica :: Int -> Property
prop_dodecafonica n = 
  n >= 0 ==>
  all esPermutacion (toLists d)
  && all (== d!(1,1)) [d!(i,i) | i <- [2..12]]
  && sum d == 936
  where xss = permutations [1..12]
        k   = n `mod` product [1..12]
        d   = matrizDodecafonica (xss !! k)
        esPermutacion ys = sort ys == [1..12]

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

import Data.List

import Test.QuickCheck

import Data.Matrix

-- 1ª solución

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

matrizDodecafonica :: [Int] -> Matrix Int

matrizDodecafonica xs = matrix 12 12 f

where f (1,j) = xs !! (j-1)

f (i,1) = modulo12 (2 * f (1,1) - f (1,i))

f (i,j) = modulo12 (f (1,j) + f (i,1) - f (1,1))

modulo12 0 = 12

modulo12 12 = 12

modulo12 x = x `mod` 12

-- 2ª solución

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

matrizDodecafonica2 :: [Int] -> Matrix Int

matrizDodecafonica2 xs = fromLists (secuencias xs)

secuencias :: [Int] -> [[Int]]

secuencias xs = [secuencia a xs | a <- inversa xs]

inversa :: [Int] -> [Int]

inversa xs = map conv (map (\x -> (-x) + 2* (abs a)) xs)

where a = head xs

secuencia :: Int -> [Int] -> [Int]

secuencia n xs = [conv (a+(n-b)) | a <- xs]

where b = head xs

conv :: Int -> Int

conv n | n == 0 = 12

| n < 0 = conv (n+12)

| n > 11 = conv (mod n 12)

| otherwise = n

-- Propiedades

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

-- Las propiedades son

prop_dodecafonica :: Int -> Property

prop_dodecafonica n =

n >= 0 ==>

all esPermutacion (toLists d)

&& all (== d!(1,1)) [d!(i,i) | i <- [2..12]]

&& sum d == 936

where xss = permutations [1..12]

k = n `mod` product [1..12]

d = matrizDodecafonica (xss !! k)

esPermutacion ys = sort ys == [1..12]

-- La comprobación es

-- λ> quickCheck prop_dodecafonica

-- +++ OK, passed 100 tests.

Pensamiento

Como el olivar,
mucho fruto lleva,
poca sombra da.

Antonio Machado

Las sucesiones de Loomis

Soluciones

Pensamiento

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

Soluciones

Pensamiento

Operaciones con series de potencias

Soluciones

Pensamiento

Matriz dodecafónica

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico