José A. Alonso

Clausura respecto de una operación binaria

PorJosé A. Alonso 2-mayo-20189-mayo-2018

Se dice que una operador @ es interno en un conjunto A si al @ sobre elementos de A se obtiene como resultado otro elemento de A. Por ejemplo, la suma es un operador interno en el conjunto de los números naturales pares.

La clausura de un conjunto A con respecto a un operador @ es el menor conjunto B tal que A está contenido en B y el operador @ es interno en el conjunto B. Por ejemplo, la clausura del conjunto {2} con respecto a la suma es el conjunto de los números pares positivos:

   {2, 4, 6, 8, ...} = {2*k | k <- [1..]}

1	{2, 4, 6, 8, ...} = {2*k \| k <- [1..]}

Definir la función

   clausuraOperador :: (Int -> Int -> Int) -> Set Int -> Set Int

1	clausuraOperador :: (Int -> Int -> Int) -> Set Int -> Set Int

tal que (clausuraOperador op xs) es la clausura del conjunto xs con respecto a la operación op. Por ejemplo,

   clausuraOperador gcd (fromList [6,9,10])     ==
      fromList [1,2,3,6,9,10]
   clausuraOperador gcd (fromList [42,70,105])  ==
      fromList [7,14,21,35,42,70,105]
   clausuraOperador lcm (fromList [6,9,10])     ==
      fromList [6,9,10,18,30,90]
   clausuraOperador lcm (fromList [2,3,5,7])    ==
      fromList [2,3,5,6,7,10,14,15,21,30,35,42,70,105,210]

clausuraOperador gcd (fromList [6,9,10]) ==

fromList [1,2,3,6,9,10]

clausuraOperador gcd (fromList [42,70,105]) ==

fromList [7,14,21,35,42,70,105]

clausuraOperador lcm (fromList [6,9,10]) ==

fromList [6,9,10,18,30,90]

clausuraOperador lcm (fromList [2,3,5,7]) ==

fromList [2,3,5,6,7,10,14,15,21,30,35,42,70,105,210]

Soluciones

import Prelude hiding (map)
import Data.Set ( Set
                , elems
                , fromList
                , map
                , notMember
                , union
                , unions
                ) 

-- 1ª definición 
clausuraOperador :: (Int -> Int -> Int) -> Set Int -> Set Int
clausuraOperador op =
  until (\ xs -> null [(x,y) | x <- elems xs,
                               y <- elems xs,
                               notMember (op x y) xs])
        (\ xs -> union xs (fromList [op x y | x <- elems xs,
                                              y <- elems xs]))

-- 2ª definición 
clausuraOperador2 :: (Int -> Int -> Int) -> Set Int -> Set Int
clausuraOperador2 op = until ((==) <*> g) g
  where g ys = unions [map (`op` y) ys | y <- elems ys]

import Prelude hiding (map)

import Data.Set ( Set

, elems

, fromList

, map

, notMember

, union

, unions

)

-- 1ª definición

clausuraOperador :: (Int -> Int -> Int) -> Set Int -> Set Int

clausuraOperador op =

until (\ xs -> null [(x,y) | x <- elems xs,

y <- elems xs,

notMember (op x y) xs])

(\ xs -> union xs (fromList [op x y | x <- elems xs,

y <- elems xs]))

-- 2ª definición

clausuraOperador2 :: (Int -> Int -> Int) -> Set Int -> Set Int

clausuraOperador2 op = until ((==) <*> g) g

where g ys = unions [map (`op` y) ys | y <- elems ys]

Polinomio digital

PorJosé A. Alonso 1-mayo-20188-mayo-2018

Definir la función

   polinomioDigital :: Int -> Polinomio Int

1	polinomioDigital :: Int -> Polinomio Int

tal que (polinomioDigital n) es el polinomio cuyos coeficientes son los dígitos de n. Por ejemplo,

   λ> polinomioDigital 5703 
   5*x^3 + 7*x^2 + 3

1 2	λ> polinomioDigital 5703 5x^3 + 7x^2 + 3

Nota: Este ejercicio debe realizarse usando únicamente las funciones de la librería I1M.Pol que se encuentra aquí y se describe aquí.

Soluciones

import I1M.Pol

polinomioDigital :: Int -> Polinomio Int
polinomioDigital = creaPolDensa . digitos

-- (digitos n) es la lista de las dígitos de n. Por ejemplo,        
--    dígitos 142857  ==  [1,4,2,8,5,7]
digitos :: Int -> [Int]
digitos n = [read [x]| x <- show n]

-- (creaPolDensa xs) es el polinomio cuya representación densa es
-- xs. Por ejemplo, 
--    creaPolDensa [7,0,0,4,0,3]  ==  7*x^5 + 4*x^2 + 3
creaPolDensa :: (Num a, Eq a) => [a] -> Polinomio a
creaPolDensa []     = polCero
creaPolDensa (x:xs) = consPol (length xs) x (creaPolDensa xs)

import I1M.Pol

polinomioDigital :: Int -> Polinomio Int

polinomioDigital = creaPolDensa . digitos

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

-- dígitos 142857 == [1,4,2,8,5,7]

digitos :: Int -> [Int]

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

-- (creaPolDensa xs) es el polinomio cuya representación densa es

-- xs. Por ejemplo,

-- creaPolDensa [7,0,0,4,0,3] == 7*x^5 + 4*x^2 + 3

creaPolDensa :: (Num a, Eq a) => [a] -> Polinomio a

creaPolDensa [] = polCero

creaPolDensa (x:xs) = consPol (length xs) x (creaPolDensa xs)

Las sucesiones de Loomis

PorJosé A. Alonso 30-abril-201825-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

144

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]

Operaciones con series de potencias

PorJosé A. Alonso 27-abril-201825-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..]

Diccionario inverso

PorJosé A. Alonso 26-abril-20187-mayo-2018

El inverso de un diccionario d es el diccionario que a cada valor x le asigna la lista de claves cuyo valor en d es x. Por ejemplo, el inverso de

   [("a",3),("b",2),("c",3),("d",2),("e",1)])

1	[("a",3),("b",2),("c",3),("d",2),("e",1)])

   [(1,["e"]),(2,["d","b"]),(3,["c","a"])]

1	[(1,["e"]),(2,["d","b"]),(3,["c","a"])]

Definir la función

   inverso :: (Ord k, Ord v) => Map k v -> Map v [k]

1	inverso :: (Ord k, Ord v) => Map k v -> Map v [k]

tal que (inverso d) es el inverso del diccionario d. Por ejemplo,

   λ> inverso (fromList [("a",3),("b",2),("c",3),("d",2),("e",1)])
   fromList [(1,["e"]),(2,["d","b"]),(3,["c","a"])]
   λ> inverso (fromList [(x,x^2) | x <- [-3,-2..3]])
   fromList [(0,[0]),(1,[1,-1]),(4,[2,-2]),(9,[3,-3])]

λ> inverso (fromList [("a",3),("b",2),("c",3),("d",2),("e",1)])

fromList [(1,["e"]),(2,["d","b"]),(3,["c","a"])]

λ> inverso (fromList [(x,x^2) | x <- [-3,-2..3]])

fromList [(0,[0]),(1,[1,-1]),(4,[2,-2]),(9,[3,-3])]

Soluciones

import Data.Map ( Map
                , assocs
                , deleteFindMin
                , empty
                , fromList
                , fromListWith
                , insertWith
                )
import qualified Data.Map as M 


-- 1ª definición
inverso :: (Ord k, Ord v) => Map k v -> Map v [k]
inverso d = fromListWith (++) [(y,[x]) | (x,y) <- assocs d]

-- 2ª definición
inverso2 :: (Ord k, Ord v) => Map k v -> Map v [k]
inverso2 d
  | M.null d  = empty
  | otherwise = insertWith (++) y [x] (inverso2 e)
  where ((x,y),e) = deleteFindMin d

import Data.Map ( Map

, assocs

, deleteFindMin

, empty

, fromList

, fromListWith

, insertWith

)

import qualified Data.Map as M

-- 1ª definición

inverso :: (Ord k, Ord v) => Map k v -> Map v [k]

inverso d = fromListWith (++) [(y,[x]) | (x,y) <- assocs d]

-- 2ª definición

inverso2 :: (Ord k, Ord v) => Map k v -> Map v [k]

inverso2 d

| M.null d = empty

| otherwise = insertWith (++) y [x] (inverso2 e)

where ((x,y),e) = deleteFindMin d

Subconjuntos con suma dada

PorJosé A. Alonso 25-abril-20182-mayo-2018

Sea S un conjunto finito de números enteros positivos y n un número natural. El problema consiste en calcular los subconjuntos de S cuya suma es n.

Definir la función

   subconjuntosSuma:: [Int] -> Int -> [[Int]] tal que

1	subconjuntosSuma:: [Int] -> Int -> [[Int]] tal que

tal que (subconjuntosSuma xs n) es la lista de los subconjuntos de xs cuya suma es n. Por ejemplo,

   λ> subconjuntosSuma [3,34,4,12,5,2] 9
   [[4,5],[3,4,2]]
   λ> subconjuntosSuma [3,34,4,12,5,2] 13
   []
   λ> length (subconjuntosSuma [1..100] (sum [1..100]))
   1

λ> subconjuntosSuma [3,34,4,12,5,2] 9

[[4,5],[3,4,2]]

λ> subconjuntosSuma [3,34,4,12,5,2] 13

[]

λ> length (subconjuntosSuma [1..100] (sum [1..100]))

Soluciones

import Data.Array
import qualified Data.Matrix as M
import Data.Maybe
import Data.List
import Test.QuickCheck

-- 1ª definición (Calculando todos los subconjuntos)
-- =================================================

subconjuntosSuma1 :: [Int] -> Int -> [[Int]]
subconjuntosSuma1 xs n =
  [ys | ys <- subsequences xs, sum ys == n]

-- 2ª definición (por recursión)
-- =============================

subconjuntosSuma2 :: [Int] -> Int -> [[Int]]
subconjuntosSuma2 _  0 = [[]]
subconjuntosSuma2 [] _ = []
subconjuntosSuma2 (x:xs) n
  | n < x     = subconjuntosSuma2 xs n
  | otherwise = subconjuntosSuma2 xs n ++
                [x:ys | ys <- subconjuntosSuma2 xs (n-x)]

-- 3ª definición (por programación dinámica)
-- =========================================

subconjuntosSuma3 :: [Int] -> Int -> [[Int]]
subconjuntosSuma3 xs n =
  map reverse (matrizSubconjuntosSuma3 xs n ! (length xs,n))

-- (matrizSubconjuntosSuma3 xs m) es la matriz q tal que q(i,j) es la
-- lista de los subconjuntos de (take i xs) que suman j. Por ejemplo,
--    λ> elems (matrizSubconjuntosSuma3 [1,3,5] 9)
--    [[[]],[],   [],[],   [],     [],   [],     [],[],    [],
--     [[]],[[1]],[],[],   [],     [],   [],     [],[],    [],
--     [[]],[[1]],[],[[3]],[[3,1]],[],   [],     [],[],    [],
--     [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]
-- Con las cabeceras,
--            0    1     2  3     4       5     6       7  8       9 
--    []     [[[]],[],   [],[],   [],     [],   [],     [],[],    [],
--    [1]     [[]],[[1]],[],[],   [],     [],   [],     [],[],    [],
--    [1,3]   [[]],[[1]],[],[[3]],[[3,1]],[],   [],     [],[],    [],
--    [1,3,5] [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]
matrizSubconjuntosSuma3 :: [Int] -> Int -> Array (Int,Int) [[Int]]
matrizSubconjuntosSuma3 xs n = q
  where m = length xs
        v = listArray (1,m) xs
        q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],
                                                  j <- [0..n]]
        f _ 0 = [[]]
        f 0 _ = []
        f i j | j < v ! i = q ! (i-1,j)
              | otherwise = q ! (i-1,j) ++
                            [v!i:ys | ys <- q ! (i-1,j-v!i)]

-- 4ª definición (ordenando y por recursión)
-- =========================================

subconjuntosSuma4 :: [Int] -> Int -> [[Int]]
subconjuntosSuma4 xs = aux (sort xs)
  where aux _  0 = [[]]
        aux [] _ = []
        aux (y:ys) n
          | y > n     = []
          | otherwise = aux ys n ++ [y:zs | zs <- aux ys (n-y)]

-- 5ª definición (ordenando y dinámica)
-- ====================================

subconjuntosSuma5 :: [Int] -> Int -> [[Int]]
subconjuntosSuma5 xs n =
  matrizSubconjuntosSuma5 (reverse (sort xs)) n ! (length xs,n)

matrizSubconjuntosSuma5 :: [Int] -> Int -> Array (Int,Int) [[Int]]
matrizSubconjuntosSuma5 xs n = q
  where m = length xs
        v = listArray (1,m) xs
        q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],
                                                  j <- [0..n]]
        f _ 0 = [[]]
        f 0 _ = []
        f i j | v ! i > j = []
              | otherwise = q ! (i-1,j) ++
                            [v!i:ys | ys <- q ! (i-1,j-v!i)]

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

prop_subconjuntosSuma :: [Int] -> Int -> Bool
prop_subconjuntosSuma xs n =
  all (`igual` subconjuntosSuma2 ys m) [ subconjuntosSuma3 ys m
                                       , subconjuntosSuma4 ys m
                                       , subconjuntosSuma5 ys m ]
  where ys = map (\y -> 1 + abs y) xs 
        m  = abs n
        ordenado = sort . map sort
        igual xss yss = ordenado xss == ordenado yss

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

100

101

102

import Data.Array

import qualified Data.Matrix as M

import Data.Maybe

import Data.List

import Test.QuickCheck

-- 1ª definición (Calculando todos los subconjuntos)

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

subconjuntosSuma1 :: [Int] -> Int -> [[Int]]

subconjuntosSuma1 xs n =

[ys | ys <- subsequences xs, sum ys == n]

-- 2ª definición (por recursión)

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

subconjuntosSuma2 :: [Int] -> Int -> [[Int]]

subconjuntosSuma2 _ 0 = [[]]

subconjuntosSuma2 [] _ = []

subconjuntosSuma2 (x:xs) n

| n < x = subconjuntosSuma2 xs n

| otherwise = subconjuntosSuma2 xs n ++

[x:ys | ys <- subconjuntosSuma2 xs (n-x)]

-- 3ª definición (por programación dinámica)

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

subconjuntosSuma3 :: [Int] -> Int -> [[Int]]

subconjuntosSuma3 xs n =

map reverse (matrizSubconjuntosSuma3 xs n ! (length xs,n))

-- (matrizSubconjuntosSuma3 xs m) es la matriz q tal que q(i,j) es la

-- lista de los subconjuntos de (take i xs) que suman j. Por ejemplo,

-- λ> elems (matrizSubconjuntosSuma3 [1,3,5] 9)

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

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

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

-- [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]

-- Con las cabeceras,

-- 0 1 2 3 4 5 6 7 8 9

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

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

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

-- [1,3,5] [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]

matrizSubconjuntosSuma3 :: [Int] -> Int -> Array (Int,Int) [[Int]]

matrizSubconjuntosSuma3 xs n = q

where m = length xs

v = listArray (1,m) xs

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

j <- [0..n]]

f _ 0 = [[]]

f 0 _ = []

f i j | j < v ! i = q ! (i-1,j)

| otherwise = q ! (i-1,j) ++

[v!i:ys | ys <- q ! (i-1,j-v!i)]

-- 4ª definición (ordenando y por recursión)

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

subconjuntosSuma4 :: [Int] -> Int -> [[Int]]

subconjuntosSuma4 xs = aux (sort xs)

where aux _ 0 = [[]]

aux [] _ = []

aux (y:ys) n

| y > n = []

| otherwise = aux ys n ++ [y:zs | zs <- aux ys (n-y)]

-- 5ª definición (ordenando y dinámica)

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

subconjuntosSuma5 :: [Int] -> Int -> [[Int]]

subconjuntosSuma5 xs n =

matrizSubconjuntosSuma5 (reverse (sort xs)) n ! (length xs,n)

matrizSubconjuntosSuma5 :: [Int] -> Int -> Array (Int,Int) [[Int]]

matrizSubconjuntosSuma5 xs n = q

where m = length xs

v = listArray (1,m) xs

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

j <- [0..n]]

f _ 0 = [[]]

f 0 _ = []

f i j | v ! i > j = []

| otherwise = q ! (i-1,j) ++

[v!i:ys | ys <- q ! (i-1,j-v!i)]

-- Equivalencia

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

prop_subconjuntosSuma :: [Int] -> Int -> Bool

prop_subconjuntosSuma xs n =

all (`igual` subconjuntosSuma2 ys m) [ subconjuntosSuma3 ys m

, subconjuntosSuma4 ys m

, subconjuntosSuma5 ys m ]

where ys = map (\y -> 1 + abs y) xs

m = abs n

ordenado = sort . map sort

igual xss yss = ordenado xss == ordenado yss

-- La comprobación es

-- λ> quickCheck prop_subconjuntosSuma

-- +++ OK, passed 100 tests.

Sumas de subconjuntos

PorJosé A. Alonso 24-abril-20181-mayo-2018

Definir la función

   sumasSubconjuntos :: Set Int -> Set Int

1	sumasSubconjuntos :: Set Int -> Set Int

tal que (sumasSubconjuntos xs) es el conjunto de las sumas de cada uno de los subconjuntos de xs. Por ejemplo,

   λ> sumasSubconjuntos (fromList [3,2,5])
   fromList [0,2,3,5,7,8,10]
   λ> length (sumasSubconjuntos (fromList [-40,-39..40]))
   1641

λ> sumasSubconjuntos (fromList [3,2,5])

fromList [0,2,3,5,7,8,10]

λ> length (sumasSubconjuntos (fromList [-40,-39..40]))

1641

Soluciones

import Data.List
import Data.Set ( Set
                , deleteFindMin
                , fromList
                , singleton
                , toList
                )
import qualified Data.Set as S

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

sumasSubconjuntos :: Set Int -> Set Int
sumasSubconjuntos xs =
  fromList (map sum (subsequences (toList xs))) 

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

sumasSubconjuntos2 :: Set Int -> Set Int
sumasSubconjuntos2 =
  fromList . sumasSubconjuntosL . toList  

sumasSubconjuntosL :: [Int] -> [Int]
sumasSubconjuntosL []     = [0]
sumasSubconjuntosL (x:xs) = ys `union` map (+x) ys
  where ys = sumasSubconjuntosL xs

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

sumasSubconjuntos3 :: Set Int -> Set Int
sumasSubconjuntos3 xs
  | S.null xs = singleton 0
  | otherwise = zs `S.union` (S.map (+y) zs)
  where (y,ys) = deleteFindMin xs
        zs     = sumasSubconjuntos2 ys

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

--    λ> length (sumasSubconjuntos (fromList [1..22]))
--    254
--    (4.17 secs, 4,574,495,128 bytes)
--    λ> length (sumasSubconjuntos2 (fromList [1..22]))
--    254
--    (0.03 secs, 5,583,200 bytes)
--    λ> length (sumasSubconjuntos3 (fromList [1..22]))
--    254
--    (0.03 secs, 5,461,064 bytes)
--
--    λ> length (sumasSubconjuntos2 (fromList [1..60]))
--    1831
--    (2.75 secs, 611,912,128 bytes)
--    λ> length (sumasSubconjuntos3 (fromList [1..60]))
--    1831
--    (2.81 secs, 610,476,992 bytes)

import Data.List

import Data.Set ( Set

, deleteFindMin

, fromList

, singleton

, toList

)

import qualified Data.Set as S

-- 1ª definición

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

sumasSubconjuntos :: Set Int -> Set Int

sumasSubconjuntos xs =

fromList (map sum (subsequences (toList xs)))

-- 2ª definición

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

sumasSubconjuntos2 :: Set Int -> Set Int

sumasSubconjuntos2 =

fromList . sumasSubconjuntosL . toList

sumasSubconjuntosL :: [Int] -> [Int]

sumasSubconjuntosL [] = [0]

sumasSubconjuntosL (x:xs) = ys `union` map (+x) ys

where ys = sumasSubconjuntosL xs

-- 3ª solución

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

sumasSubconjuntos3 :: Set Int -> Set Int

sumasSubconjuntos3 xs

| S.null xs = singleton 0

| otherwise = zs `S.union` (S.map (+y) zs)

where (y,ys) = deleteFindMin xs

zs = sumasSubconjuntos2 ys

-- Comparación de eficiencia

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

-- λ> length (sumasSubconjuntos (fromList [1..22]))

-- 254

-- (4.17 secs, 4,574,495,128 bytes)

-- λ> length (sumasSubconjuntos2 (fromList [1..22]))

-- 254

-- (0.03 secs, 5,583,200 bytes)

-- λ> length (sumasSubconjuntos3 (fromList [1..22]))

-- 254

-- (0.03 secs, 5,461,064 bytes)

-- λ> length (sumasSubconjuntos2 (fromList [1..60]))

-- 1831

-- (2.75 secs, 611,912,128 bytes)

-- λ> length (sumasSubconjuntos3 (fromList [1..60]))

-- 1831

-- (2.81 secs, 610,476,992 bytes)

Subsucesiones crecientes de elementos consecutivos

PorJosé A. Alonso 23-abril-201830-abril-2018

Definir la función

   subsucesiones :: [Integer] -> [[Integer]]

1	subsucesiones :: [Integer] -> [[Integer]]

tal que (subsucesiones xs) es la lista de las subsucesiones crecientes de elementos consecutivos de xs. Por ejemplo,

   subsucesiones [1,0,1,2,3,0,4,5]  == [[1],[0,1,2,3],[0,4,5]]
   subsucesiones [5,6,1,3,2,7]      == [[5,6],[1,3],[2,7]]
   subsucesiones [2,3,3,4,5]        == [[2,3],[3,4,5]]
   subsucesiones [7,6,5,4]          == [[7],[6],[5],[4]]

subsucesiones [1,0,1,2,3,0,4,5] == [[1],[0,1,2,3],[0,4,5]]

subsucesiones [5,6,1,3,2,7] == [[5,6],[1,3],[2,7]]

subsucesiones [2,3,3,4,5] == [[2,3],[3,4,5]]

subsucesiones [7,6,5,4] == [[7],[6],[5],[4]]

Soluciones

subsucesiones :: [Integer] -> [[Integer]]
subsucesiones []  = []
subsucesiones [x] = [[x]]
subsucesiones (x:y:zs)
  | x < y     = (x:us):vss
  | otherwise = [x]:p
  where p@(us:vss) = subsucesiones (y:zs)

subsucesiones :: [Integer] -> [[Integer]]

subsucesiones [] = []

subsucesiones [x] = [[x]]

subsucesiones (x:y:zs)

| x < y = (x:us):vss

| otherwise = [x]:p

where p@(us:vss) = subsucesiones (y:zs)

Números compuestos por un conjunto de primos

PorJosé A. Alonso 20-abril-201830-abril-2018

Los números compuestos por un conjunto de primos son los números cuyos factores primos pertenecen al conjunto. Por ejemplo, los primeros números compuestos por [2,5,7] son

   1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70,...

1	1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70,...

El 28 es compuesto ya que sus divisores primos son 2 y 7 que están en [2,5,7].

Definir la función

   compuestos :: [Integer] -> [Integer]

1	compuestos :: [Integer] -> [Integer]

tal que (compuesto ps) es la lista de los números compuestos por el conjunto de primos ps. Por ejemplo,

   λ> take 20 (compuestos [2,5,7])
   [1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70]
   λ> take 20 (compuestos [2,5])
   [1,2,4,5,8,10,16,20,25,32,40,50,64,80,100,125,128,160,200,250]
   λ> take 20 (compuestos [2,3,5])
   [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36]
   λ> take 20 (compuestos [3,5,7,11,13])
   [1,3,5,7,9,11,13,15,21,25,27,33,35,39,45,49,55,63,65,75]
   λ> take 15 (compuestos [2])
   [1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384]
   λ> compuestos [2,7] !! (10^4)
   57399514149595471961908157955229677377312712667508119466382354072731648
   λ> compuestos [2,3,5] !! (10^5)
   290237644800000000000000000000000000000

λ> take 20 (compuestos [2,5,7])

[1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70]

λ> take 20 (compuestos [2,5])

[1,2,4,5,8,10,16,20,25,32,40,50,64,80,100,125,128,160,200,250]

λ> take 20 (compuestos [2,3,5])

[1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36]

λ> take 20 (compuestos [3,5,7,11,13])

[1,3,5,7,9,11,13,15,21,25,27,33,35,39,45,49,55,63,65,75]

λ> take 15 (compuestos [2])

[1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384]

λ> compuestos [2,7] !! (10^4)

57399514149595471961908157955229677377312712667508119466382354072731648

λ> compuestos [2,3,5] !! (10^5)

290237644800000000000000000000000000000

Soluciones

import Data.Numbers.Primes (primeFactors)

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

compuestos1 :: [Integer] -> [Integer]
compuestos1 ps =
  [n | n <- [1..], esCompuesto ps n]

-- (esCompuesto ps n) se verifica si los factores primos de n pertenecen
-- a ps. Por ejemplo, 
--    esCompuesto [2,3,7]    28  ==  True
--    esCompuesto [2,3,7]   140  ==  False
--    esCompuesto [2,3,5,7] 140  ==  True
esCompuesto :: [Integer] -> Integer -> Bool
esCompuesto ps n =
  subconjunto (primeFactors n) ps

-- (subconjunto xs ys) se verifica si todos los elementos de xs
-- pertenecen a ys. Por ejemplo, 
--    subconjunto [2,7,2] [7,5,2]  ==  True
--    subconjunto [2,7,3] [7,5,2]  ==  False
subconjunto :: Eq a => [a] -> [a] -> Bool
subconjunto xs ys =
  all (`elem` ys) xs

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

compuestos2 :: [Integer] -> [Integer]
compuestos2 ps =
   1 : mezclaTodas (combinaciones ps)

-- (combinaciones ps) es la lista de los productos de cada elemento de
-- ps por los números compuestos con ps. Por ejemplo,
--    λ> take 8 (compuestos4 [2,5,7])
--    [1,2,4,5,7,8,10,14]
--    λ> map (take 6) (combinaciones [2,5,7])
--    [[2,4,8,10,14,16],[5,10,20,25,35,40],[7,14,28,35,49,56]]
combinaciones :: [Integer] -> [[Integer]]
combinaciones ps =
  [[p * q | q <- compuestos2 ps] | p <- ps]

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como
-- sus elementos son listas infinitas ordenadas. Por ejemplo, 
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])
--    [2,3,4,5,6,7,8,9,10,11]
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])
--    [2,4,6,8,9,10,12,14,16,18]
mezclaTodas :: [[Integer]] -> [Integer]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la mezcla, eliminando repetidos, de las lista
-- ordenadas xs e ys. Por ejemplo,  
mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla []     ys              = ys
mezcla xs     []              = xs
mezcla us@(x:xs) vs@(y:ys) | x == y     = x : mezcla xs ys
                           | x < y      = x : mezcla xs vs
                           | otherwise  = y : mezcla us ys

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

compuestos3 :: [Integer] -> [Integer]
compuestos3 [] = [1]
compuestos3 (p:ps) =
  mezclaTodas [map (*y) (compuestos3 ps) | y <- [p^k | k <- [0..]]]

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

compuestos4 :: [Integer] -> [Integer]
compuestos4 ps = foldl aux xs (tail ps)
  where p        = head ps
        xs       = [p^k | k <- [0..]]
        aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

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

compuestos5 :: [Integer] -> [Integer]
compuestos5 = foldl aux [1] 
  where aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

-- 6ª solución
-- ===========

compuestos6 :: [Integer] -> [Integer]
compuestos6 xs = aux
  where aux = 1 : mezclas xs aux
        mezclas []     _  = []
        mezclas (x:xs) zs = mezcla (map (x*) zs) (mezclas xs zs)

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

--    λ> compuestos1 [2,3,5] !! 300
--    84375
--    (5.85 secs, 2,961,101,088 bytes)
--    λ> compuestos2 [2,3,5] !! 300
--    84375
--    (3.54 secs, 311,137,952 bytes)
--    λ> compuestos2 [2,3,5] !! 400
--    312500
--    (13.01 secs, 1,229,801,184 bytes)
--    λ> compuestos3 [2,3,5] !! 400
--    312500
--    (0.02 secs, 2,066,152 bytes)
--    λ> compuestos3 [2,3,5] !! 20000
--    15441834907098675000000
--    (1.57 secs, 203,061,864 bytes)
--    λ> compuestos4 [2,3,5] !! 20000
--    15441834907098675000000
--    (0.40 secs, 53,335,080 bytes)
--    λ> compuestos4 [2,3,5] !! 50000
--    2379528690747474604574166220800
--    (1.25 secs, 170,058,496 bytes)
--    λ> compuestos5 [2,3,5] !! 50000
--    2379528690747474604574166220800
--    (1.26 secs, 170,104,648 bytes)
--    λ> compuestos6 [2,3,5] !! 50000
--    2379528690747474604574166220800
--    (0.26 secs, 40,490,280 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

import Data.Numbers.Primes (primeFactors)

-- 1ª solución

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

compuestos1 :: [Integer] -> [Integer]

compuestos1 ps =

[n | n <- [1..], esCompuesto ps n]

-- (esCompuesto ps n) se verifica si los factores primos de n pertenecen

-- a ps. Por ejemplo,

-- esCompuesto [2,3,7] 28 == True

-- esCompuesto [2,3,7] 140 == False

-- esCompuesto [2,3,5,7] 140 == True

esCompuesto :: [Integer] -> Integer -> Bool

esCompuesto ps n =

subconjunto (primeFactors n) ps

-- (subconjunto xs ys) se verifica si todos los elementos de xs

-- pertenecen a ys. Por ejemplo,

-- subconjunto [2,7,2] [7,5,2] == True

-- subconjunto [2,7,3] [7,5,2] == False

subconjunto :: Eq a => [a] -> [a] -> Bool

subconjunto xs ys =

all (`elem` ys) xs

-- 2ª solución

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

compuestos2 :: [Integer] -> [Integer]

compuestos2 ps =

1 : mezclaTodas (combinaciones ps)

-- (combinaciones ps) es la lista de los productos de cada elemento de

-- ps por los números compuestos con ps. Por ejemplo,

-- λ> take 8 (compuestos4 [2,5,7])

-- [1,2,4,5,7,8,10,14]

-- λ> map (take 6) (combinaciones [2,5,7])

-- [[2,4,8,10,14,16],[5,10,20,25,35,40],[7,14,28,35,49,56]]

combinaciones :: [Integer] -> [[Integer]]

combinaciones ps =

[[p * q | q <- compuestos2 ps] | p <- ps]

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como

-- sus elementos son listas infinitas ordenadas. Por ejemplo,

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])

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

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])

-- [2,4,6,8,9,10,12,14,16,18]

mezclaTodas :: [[Integer]] -> [Integer]

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la mezcla, eliminando repetidos, de las lista

-- ordenadas xs e ys. Por ejemplo,

mezcla :: [Integer] -> [Integer] -> [Integer]

mezcla [] ys = ys

mezcla xs [] = xs

mezcla us@(x:xs) vs@(y:ys) | x == y = x : mezcla xs ys

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

-- 3ª solución

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

compuestos3 :: [Integer] -> [Integer]

compuestos3 [] = [1]

compuestos3 (p:ps) =

mezclaTodas [map (*y) (compuestos3 ps) | y <- [p^k | k <- [0..]]]

-- 4ª solución

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

compuestos4 :: [Integer] -> [Integer]

compuestos4 ps = foldl aux xs (tail ps)

where p = head ps

xs = [p^k | k <- [0..]]

aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

-- 5ª solución

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

compuestos5 :: [Integer] -> [Integer]

compuestos5 = foldl aux [1]

where aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

-- 6ª solución

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

compuestos6 :: [Integer] -> [Integer]

compuestos6 xs = aux

where aux = 1 : mezclas xs aux

mezclas [] _ = []

mezclas (x:xs) zs = mezcla (map (x*) zs) (mezclas xs zs)

-- Comparación de eficiencia

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

-- λ> compuestos1 [2,3,5] !! 300

-- 84375

-- (5.85 secs, 2,961,101,088 bytes)

-- λ> compuestos2 [2,3,5] !! 300

-- 84375

-- (3.54 secs, 311,137,952 bytes)

-- λ> compuestos2 [2,3,5] !! 400

-- 312500

-- (13.01 secs, 1,229,801,184 bytes)

-- λ> compuestos3 [2,3,5] !! 400

-- 312500

-- (0.02 secs, 2,066,152 bytes)

-- λ> compuestos3 [2,3,5] !! 20000

-- 15441834907098675000000

-- (1.57 secs, 203,061,864 bytes)

-- λ> compuestos4 [2,3,5] !! 20000

-- 15441834907098675000000

-- (0.40 secs, 53,335,080 bytes)

-- λ> compuestos4 [2,3,5] !! 50000

-- 2379528690747474604574166220800

-- (1.25 secs, 170,058,496 bytes)

-- λ> compuestos5 [2,3,5] !! 50000

-- 2379528690747474604574166220800

-- (1.26 secs, 170,104,648 bytes)

-- λ> compuestos6 [2,3,5] !! 50000

-- 2379528690747474604574166220800

-- (0.26 secs, 40,490,280 bytes)

Notas de evaluación acumulada

PorJosé A. Alonso 19-abril-201826-abril-2018

La evaluación acumulada, las notas se calculan recursivamente con la siguiente función

   N(1) = E(1)
   N(k) = máximo(E(k), 0.4*N(k-1)+0.6*E(k))

1 2	N(1) = E(1) N(k) = máximo(E(k), 0.4N(k-1)+0.6E(k))

donde E(k) es la nota del examen k. Por ejemplo, si las notas de los exámenes son [3,7,6,3] entonces las acumuladas son [3.0,7.0,6.4,4.4]

Las notas e los exámenes se encuentran en ficheros CSV con los valores separados por comas. Cada línea representa la nota de un alumno, el primer valor es el identificador del alumno y los restantes son sus notas. Por ejemplo, el contenido de examenes.csv es

   juaruigar,3,7,9,3
   evadialop,3,6,7,4
   carrodmes,0,9,8,7

juaruigar,3,7,9,3

evadialop,3,6,7,4

carrodmes,0,9,8,7

Definir las funciones

   acumuladas      :: [Double] -> [Double]
   notasAcumuladas :: FilePath -> FilePath -> IO ()

1 2	acumuladas :: [Double] -> [Double] notasAcumuladas :: FilePath -> FilePath -> IO ()

tales que

(acumuladas xs) es la lista de las notas acumuladas (redondeadas con un decimal) de los notas de los exámenes xs. Por ejemplo,

     acumuladas [2,5]      ==  [2.0,5.0]
     acumuladas [5,2]      ==  [5.0,3.2]
     acumuladas [3,7,6,3]  ==  [3.0,7.0,6.4,4.4]
     acumuladas [3,6,7,3]  ==  [3.0,6.0,7.0,4.6]

acumuladas [2,5] == [2.0,5.0]

acumuladas [5,2] == [5.0,3.2]

acumuladas [3,7,6,3] == [3.0,7.0,6.4,4.4]

acumuladas [3,6,7,3] == [3.0,6.0,7.0,4.6]

(notasAcumuladas f1 f2) que escriba en el fichero f2 las notas acumuladas correspondientes a las notas de los exámenes del fichero f1. Por ejemplo, al evaluar

     notasAcumuladas "examenes.csv" "acumuladas.csv"

1	notasAcumuladas "examenes.csv" "acumuladas.csv"

escribe en el fichero acumuladas.csv

     juaruigar,3.0,7.0,9.0,5.4
     evadialop,3.0,6.0,7.0,5.2
     carrodmes,0.0,9.0,8.4,7.6

juaruigar,3.0,7.0,9.0,5.4

evadialop,3.0,6.0,7.0,5.2

carrodmes,0.0,9.0,8.4,7.6

Soluciones

import Text.CSV
import Data.Either

-- Definicioń de acumuladas
-- ========================

acumuladas :: [Double] -> [Double]
acumuladas = reverse . aux . reverse
  where aux []     = []
        aux [x]    = [x]
        aux (x:xs) = conUnDecimal (max x (0.6*x+0.4*y)) : y : ys 
          where (y:ys) = aux xs

--    conUnDecimal 7.26  ==  7.3
--    conUnDecimal 7.24  ==  7.2
conUnDecimal :: Double -> Double
conUnDecimal x = fromIntegral (round (10*x)) / 10

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

notasAcumuladas :: FilePath -> FilePath -> IO ()
notasAcumuladas f1 f2 = do
  cs <- readFile f1
  writeFile f2 (unlines (map ( acumuladaACadena
                             . notaAAcumuladas
                             . listaANota
                             . cadenaALista
                             )
                             (contenidoALineasDeNotas cs)))

--   λ> contenidoALineasDeNotas "juaruigar,3,7,6,3\nevadialop,3,6,7,3\n\n  \n"
--   ["juaruigar,3,7,6,3","evadialop,3,6,7,3"]
contenidoALineasDeNotas :: String -> [String]
contenidoALineasDeNotas = filter esLineaDeNotas . lines
  where esLineaDeNotas = elem ','

--    cadenaALista "a,b c,d"            ==  ["a","b c","d"]
--    cadenaALista "juaruigar,3,7,6,3"  ==  ["juaruigar","3","7","6","3"]
cadenaALista :: String -> [String]
cadenaALista cs
  | tieneComas cs = d : cadenaALista ds
  | otherwise     = [cs]
  where (d,_:ds)   = span (/=',') cs
        tieneComas = elem ','

--    λ> listaANota ["juaruigar","3","7","6","3"]
--    ("juaruigar",[3.0,7.0,6.0,3.0])
listaANota :: [String] -> (String,[Double])
listaANota (x:xs) = (x,map read xs)

--   λ> notaAAcumuladas ("juaruigar",[3.0,7.0,6.0,3.0])
--   ("juaruigar",[3.0,7.0,6.4,4.4])
notaAAcumuladas :: (String,[Double]) -> (String,[Double])
notaAAcumuladas (x,xs) = (x, acumuladas xs)

--    λ> acumuladaACadena ("juaruigar",[3.0,7.0,6.4,4.4])
--    "juaruigar,3.0,7.0,6.4,4.4"
acumuladaACadena :: (String,[Double]) -> String
acumuladaACadena (x,xs) =
  x ++ "," ++ tail (init (show xs))

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

notasAcumuladas2 :: FilePath -> FilePath -> IO ()
notasAcumuladas2 f1 f2 = do
  cs <- readFile f1
  let (Right csv) = parseCSV f1 cs
  let notas = [xs | xs <- csv, length xs > 1]
  writeFile f2 (unlines (map ( acumuladaACadena
                             . notaAAcumuladas
                             . listaANota
                             )
                             notas))

import Text.CSV

import Data.Either

-- Definicioń de acumuladas

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

acumuladas :: [Double] -> [Double]

acumuladas = reverse . aux . reverse

where aux [] = []

aux [x] = [x]

aux (x:xs) = conUnDecimal (max x (0.6*x+0.4*y)) : y : ys

where (y:ys) = aux xs

-- conUnDecimal 7.26 == 7.3

-- conUnDecimal 7.24 == 7.2

conUnDecimal :: Double -> Double

conUnDecimal x = fromIntegral (round (10*x)) / 10

-- 1ª definición de notasAcumuladas

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

notasAcumuladas :: FilePath -> FilePath -> IO ()

notasAcumuladas f1 f2 = do

cs <- readFile f1

writeFile f2 (unlines (map ( acumuladaACadena

. notaAAcumuladas

. listaANota

. cadenaALista

)

(contenidoALineasDeNotas cs)))

-- λ> contenidoALineasDeNotas "juaruigar,3,7,6,3\nevadialop,3,6,7,3\n\n \n"

-- ["juaruigar,3,7,6,3","evadialop,3,6,7,3"]

contenidoALineasDeNotas :: String -> [String]

contenidoALineasDeNotas = filter esLineaDeNotas . lines

where esLineaDeNotas = elem ','

-- cadenaALista "a,b c,d" == ["a","b c","d"]

-- cadenaALista "juaruigar,3,7,6,3" == ["juaruigar","3","7","6","3"]

cadenaALista :: String -> [String]

cadenaALista cs

| tieneComas cs = d : cadenaALista ds

| otherwise = [cs]

where (d,_:ds) = span (/=',') cs

tieneComas = elem ','

-- λ> listaANota ["juaruigar","3","7","6","3"]

-- ("juaruigar",[3.0,7.0,6.0,3.0])

listaANota :: [String] -> (String,[Double])

listaANota (x:xs) = (x,map read xs)

-- λ> notaAAcumuladas ("juaruigar",[3.0,7.0,6.0,3.0])

-- ("juaruigar",[3.0,7.0,6.4,4.4])

notaAAcumuladas :: (String,[Double]) -> (String,[Double])

notaAAcumuladas (x,xs) = (x, acumuladas xs)

-- λ> acumuladaACadena ("juaruigar",[3.0,7.0,6.4,4.4])

-- "juaruigar,3.0,7.0,6.4,4.4"

acumuladaACadena :: (String,[Double]) -> String

acumuladaACadena (x,xs) =

x ++ "," ++ tail (init (show xs))

-- 2ª definición de notasAcumuladas

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

notasAcumuladas2 :: FilePath -> FilePath -> IO ()

notasAcumuladas2 f1 f2 = do

cs <- readFile f1

let (Right csv) = parseCSV f1 cs

let notas = [xs | xs <- csv, length xs > 1]

writeFile f2 (unlines (map ( acumuladaACadena

. notaAAcumuladas

. listaANota

)

notas))

Autor: José A. Alonso

Clausura respecto de una operación binaria

Soluciones

Polinomio digital

Soluciones

Las sucesiones de Loomis

Soluciones

Operaciones con series de potencias

Soluciones

Diccionario inverso

Soluciones

Subconjuntos con suma dada

Soluciones

Sumas de subconjuntos

Soluciones

Subsucesiones crecientes de elementos consecutivos

Soluciones

Números compuestos por un conjunto de primos

Soluciones

Notas de evaluación acumulada

Soluciones

Entradas recientes

Buscar

Correo electrónico