Exercitium

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

Reducción de opuestos

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

Se considera el siguiente procedimiento de reducción de listas: busca un par de elementos consecutivos iguales pero con signos opuestos, se eliminan dichos elementos y se continúa el proceso hasta que no se encuentren pares de elementos consecutivos iguales pero con signos opuestos. Por ejemplo, la reducción de [-2,1,-1,2,3,4,-3] es

   [-2,1,-1,2,3,4,-3]    (se elimina el par (1,-1))
   -> [-2,2,3,4,-3]      (se elimina el par (-2,2))
   -> [3,4,-3]           (el par (3,-3) no son consecutivos)

[-2,1,-1,2,3,4,-3] (se elimina el par (1,-1))

-> [-2,2,3,4,-3] (se elimina el par (-2,2))

-> [3,4,-3] (el par (3,-3) no son consecutivos)

Definir la función

   reducida :: [Int] -> [Int]

1	reducida :: [Int] -> [Int]

tal que (reducida xs) es la lista obtenida aplicando a xs el de eliminación de pares de elementos consecutivos opuestos. Por ejemplo,

   reducida [-2,1,-1,2,3,4,-3]           == [3,4,-3]
   reducida [-2,1,-1,2,3,-4,4,-3]        == []
   reducida [-2,1,-1,2,5,3,-4,4,-3]      == [5]
   reducida [-2,1,-1,2,5,3,-4,4,-3,-5]   == []

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

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

reducida [-2,1,-1,2,5,3,-4,4,-3] == [5]

reducida [-2,1,-1,2,5,3,-4,4,-3,-5] == []

Soluciones

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

reducida :: [Int] -> [Int]
reducida xs | xs == ys  = xs
            | otherwise = reducida ys
            where ys = paso xs

paso :: [Int] -> [Int]
paso [] = []
paso [x] = [x]
paso (x:y:zs) | x == -y   = paso zs
              | otherwise = x : paso (y:zs)

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

reducida2 :: [Int] -> [Int]
reducida2 xs = aux xs []
    where aux [] ys                   = reverse ys
          aux (x:xs) (y:ys) | x == -y = aux xs ys
          aux (x:xs) ys               = aux xs (x:ys)

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

--    λ> reducida (take (10^7) (cycle [1,-1]))
--    []
--    (9.40 secs, 1,280,127,720 bytes)
--    λ> reducida2 (take (10^7) (cycle [1,-1]))
--    []
--    (12.16 secs, 2,080,127,560 bytes)

-- 1ª solución

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

reducida :: [Int] -> [Int]

reducida xs | xs == ys = xs

| otherwise = reducida ys

where ys = paso xs

paso :: [Int] -> [Int]

paso [] = []

paso [x] = [x]

paso (x:y:zs) | x == -y = paso zs

| otherwise = x : paso (y:zs)

-- 2ª solución

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

reducida2 :: [Int] -> [Int]

reducida2 xs = aux xs []

where aux [] ys = reverse ys

aux (x:xs) (y:ys) | x == -y = aux xs ys

aux (x:xs) ys = aux xs (x:ys)

-- Comparación de eficiencia

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

-- λ> reducida (take (10^7) (cycle [1,-1]))

-- []

-- (9.40 secs, 1,280,127,720 bytes)

-- λ> reducida2 (take (10^7) (cycle [1,-1]))

-- []

-- (12.16 secs, 2,080,127,560 bytes)

Matrices de Hadamard

PorJosé A. Alonso 17-abril-201825-abril-2021

Las matrices de Hadamard se definen recursivamente como sigue

   λ> hadamard 0
   ( 1 )
   
   λ> hadamard 1
   (  1  1 )
   (  1 -1 )
   
   λ> hadamard 2
   (  1  1  1  1 )
   (  1 -1  1 -1 )
   (  1  1 -1 -1 )
   (  1 -1 -1  1 )
   
   λ> hadamard 3
   (  1  1  1  1  1  1  1  1 )
   (  1 -1  1 -1  1 -1  1 -1 )
   (  1  1 -1 -1  1  1 -1 -1 )
   (  1 -1 -1  1  1 -1 -1  1 )
   (  1  1  1  1 -1 -1 -1 -1 )
   (  1 -1  1 -1 -1  1 -1  1 )
   (  1  1 -1 -1 -1 -1  1  1 )
   (  1 -1 -1  1 -1  1  1 -1 )

λ> hadamard 0

( 1 )

λ> hadamard 1

( 1 1 )

( 1 -1 )

λ> hadamard 2

( 1 1 1 1 )

( 1 -1 1 -1 )

( 1 1 -1 -1 )

( 1 -1 -1 1 )

λ> hadamard 3

( 1 1 1 1 1 1 1 1 )

( 1 -1 1 -1 1 -1 1 -1 )

( 1 1 -1 -1 1 1 -1 -1 )

( 1 -1 -1 1 1 -1 -1 1 )

( 1 1 1 1 -1 -1 -1 -1 )

( 1 -1 1 -1 -1 1 -1 1 )

( 1 1 -1 -1 -1 -1 1 1 )

( 1 -1 -1 1 -1 1 1 -1 )

En general, la n-ésima matriz de Hadamard, H(n), es

   ( H(n-1)  H(n-1) )
   ( H(n-1) -H(n-1) )

1 2	( H(n-1) H(n-1) ) ( H(n-1) -H(n-1) )

Definir la función

   hadamard :: Int -> Matrix Int

1	hadamard :: Int -> Matrix Int

tal que (hadamard n) es la n-ésima matriz de Hadamard.

Comprobar con QuickCheck que para todo número natural n, el producto de la n-ésima matriz de Hadamard y su traspuesta es igual al producto de 2^n por la matriz identidad de orden 2^n.

Soluciones

import Data.Matrix (Matrix, identity, joinBlocks, scaleMatrix, transpose)
import Test.QuickCheck 

hadamard :: Int -> Matrix Int
hadamard 0 = identity 1
hadamard n = joinBlocks (a, a, a, b)
  where a = hadamard (n-1)
        b = scaleMatrix (-1) a

-- La propiedad es
prop_Hadamard :: (Positive Int) -> Bool
prop_Hadamard (Positive n) =
  h * transpose h == scaleMatrix (2^n) (identity (2^n))
  where h = hadamard n

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

import Data.Matrix (Matrix, identity, joinBlocks, scaleMatrix, transpose)

import Test.QuickCheck

hadamard :: Int -> Matrix Int

hadamard 0 = identity 1

hadamard n = joinBlocks (a, a, a, b)

where a = hadamard (n-1)

b = scaleMatrix (-1) a

-- La propiedad es

prop_Hadamard :: (Positive Int) -> Bool

prop_Hadamard (Positive n) =

h * transpose h == scaleMatrix (2^n) (identity (2^n))

where h = hadamard n

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=7}) prop_Hadamard

-- +++ OK, passed 100 tests.

Decidir si existe un subconjunto con suma dada

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

Sea S un conjunto finito de números naturales y m un número natural. El problema consiste en determinar si existe un subconjunto de S cuya suma es m. Por ejemplo, si S = [3,34,4,12,5,2] y m = 9, existe un subconjunto de S, [4,5], cuya suma es 9. En cambio, no hay ningún subconjunto de S que sume 13.

Definir la función

    existeSubSuma :: [Int] -> Int -> Bool

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

tal que (existeSubSuma xs m) se verifica si existe algún subconjunto de xs que sume m. Por ejemplo,

    existeSubSuma [3,34,4,12,5,2] 9                == True
    existeSubSuma [3,34,4,12,5,2] 13               == False
    existeSubSuma ([3,34,4,12,5,2]++[20..400]) 13  == False
    existeSubSuma ([3,34,4,12,5,2]++[20..400]) 654 == True
    existeSubSuma [1..200] (sum [1..200])          == True

existeSubSuma [3,34,4,12,5,2] 9 == True

existeSubSuma [3,34,4,12,5,2] 13 == False

existeSubSuma ([3,34,4,12,5,2]++[20..400]) 13 == False

existeSubSuma ([3,34,4,12,5,2]++[20..400]) 654 == True

existeSubSuma [1..200] (sum [1..200]) == True

Soluciones

import Data.List  (subsequences, sort)
import Data.Array (Array, array, listArray, (!))
 
-- 1ª definición (Calculando todos los subconjuntos)
-- =================================================
 
existeSubSuma1 :: [Int] -> Int -> Bool
existeSubSuma1 xs n =
  any (\ys -> sum ys == n) (subsequences xs)
 
-- 2ª definición (por recursión)
-- =============================
 
existeSubSuma2 :: [Int] -> Int -> Bool
existeSubSuma2 _  0 = True
existeSubSuma2 [] _ = False
existeSubSuma2 (x:xs) n
  | n < x     = existeSubSuma2 xs n
  | otherwise = existeSubSuma2 xs (n-x) || existeSubSuma2 xs n 
  
-- 3ª definición (por programación dinámica)
-- =========================================
 
existeSubSuma3 :: [Int] -> Int -> Bool
existeSubSuma3 xs n =
  matrizExisteSubSuma3 xs n ! (length xs,n) 
 
-- (matrizExisteSubSuma3 xs m) es la matriz q tal que q(i,j) se verifica
-- si existe algún subconjunto de (take i xs) que sume j. Por ejemplo,
--    λ> elems (matrizExisteSubSuma3 [1,3,5] 9)
--    [True,False,False,False,False,False,False,False,False,False,
--     True,True, False,False,False,False,False,False,False,False,
--     True,True, False,True, True, False,False,False,False,False,
--     True,True, False,True, True, True, True, False,True, True]
-- Con las cabeceras,
--            0     1     2     3     4     5     6     7     8     9
--    []     [True,False,False,False,False,False,False,False,False,False,
--    [1]     True,True, False,False,False,False,False,False,False,False,
--    [1,3]   True,True, False,True, True, False,False,False,False,False,
--    [1,3,5] True,True, False,True, True, True, True, False,True, True]
matrizExisteSubSuma3 :: [Int] -> Int -> Array (Int,Int) Bool
matrizExisteSubSuma3 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 = True
        f 0 _ = False
        f i j | j < v ! i = q ! (i-1,j)
              | otherwise = q ! (i-1,j-v!i) || q ! (i-1,j)
 
-- 4ª definición (ordenando y por recursión)
-- =========================================
 
existeSubSuma4 :: [Int] -> Int -> Bool
existeSubSuma4 xs = aux (sort xs)
  where aux _  0 = True
        aux [] _ = False
        aux (y:ys) n
          | y <= n    = aux ys (n-y) || aux ys n
          | otherwise = False
 
-- 5ª definición (ordenando y dinámica)
-- ====================================
 
existeSubSuma5 :: [Int] -> Int -> Bool
existeSubSuma5 xs n =
  matrizExisteSubSuma5 (reverse (sort xs)) n ! (length xs,n) 
 
matrizExisteSubSuma5 :: [Int] -> Int -> Array (Int,Int) Bool
matrizExisteSubSuma5 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 = True
        f 0 _ = False
        f i j | v ! i <= j = q ! (i-1,j-v!i) || q ! (i-1,j) 
              | otherwise  = False
 
-- Equivalencia
-- ============
 
prop_existeSubSuma :: [Int] -> Int -> Bool
prop_existeSubSuma xs n =
  all (== existeSubSuma2 ys m) [ existeSubSuma3 ys m
                               , existeSubSuma4 ys m
                               , existeSubSuma5 ys m ]
  where ys = map abs xs
        m  = abs n
 
-- La comprobación es
--    λ> quickCheck prop_existeSubSuma
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia:
-- ==========================

--    λ> let xs = [1..22] in existeSubSuma1 xs (sum xs)
--    True
--    (7.76 secs, 3,892,403,928 bytes)
--    λ> let xs = [1..22] in existeSubSuma2 xs (sum xs)
--    True
--    (0.02 secs, 95,968 bytes)
--    λ> let xs = [1..22] in existeSubSuma3 xs (sum xs)
--    True
--    (0.03 secs, 6,055,200 bytes)
--    λ> let xs = [1..22] in existeSubSuma4 xs (sum xs)
--    True
--    (0.01 secs, 98,880 bytes)
--    λ> let xs = [1..22] in existeSubSuma5 xs (sum xs)
--    True
--    (0.02 secs, 2,827,560 bytes)
  
--    λ> let xs = [1..200] in existeSubSuma2 xs (sum xs)
--    True
--    (0.01 secs, 182,280 bytes)
--    λ> let xs = [1..200] in existeSubSuma3 xs (sum xs)
--    True
--    (8.89 secs, 1,875,071,968 bytes)
--    λ> let xs = [1..200] in existeSubSuma4 xs (sum xs)
--    True
--    (0.02 secs, 217,128 bytes)
--    λ> let xs = [1..200] in existeSubSuma5 xs (sum xs)
--    True
--    (8.66 secs, 1,875,087,976 bytes)
--
--    λ> and [existeSubSuma2 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (2.82 secs, 323,372,512 bytes)
--    λ> and [existeSubSuma3 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (0.65 secs, 221,806,376 bytes)
--    λ> and [existeSubSuma4 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (4.12 secs, 535,153,152 bytes)
--    λ> and [existeSubSuma5 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (0.73 secs, 238,579,696 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

import Data.List (subsequences, sort)

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

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

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

existeSubSuma1 :: [Int] -> Int -> Bool

existeSubSuma1 xs n =

any (\ys -> sum ys == n) (subsequences xs)

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

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

existeSubSuma2 :: [Int] -> Int -> Bool

existeSubSuma2 _ 0 = True

existeSubSuma2 [] _ = False

existeSubSuma2 (x:xs) n

| n < x = existeSubSuma2 xs n

| otherwise = existeSubSuma2 xs (n-x) || existeSubSuma2 xs n

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

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

existeSubSuma3 :: [Int] -> Int -> Bool

existeSubSuma3 xs n =

matrizExisteSubSuma3 xs n ! (length xs,n)

-- (matrizExisteSubSuma3 xs m) es la matriz q tal que q(i,j) se verifica

-- si existe algún subconjunto de (take i xs) que sume j. Por ejemplo,

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

-- [True,False,False,False,False,False,False,False,False,False,

-- True,True, False,False,False,False,False,False,False,False,

-- True,True, False,True, True, False,False,False,False,False,

-- True,True, False,True, True, True, True, False,True, True]

-- Con las cabeceras,

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

-- [] [True,False,False,False,False,False,False,False,False,False,

-- [1] True,True, False,False,False,False,False,False,False,False,

-- [1,3] True,True, False,True, True, False,False,False,False,False,

-- [1,3,5] True,True, False,True, True, True, True, False,True, True]

matrizExisteSubSuma3 :: [Int] -> Int -> Array (Int,Int) Bool

matrizExisteSubSuma3 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 = True

f 0 _ = False

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

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

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

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

existeSubSuma4 :: [Int] -> Int -> Bool

existeSubSuma4 xs = aux (sort xs)

where aux _ 0 = True

aux [] _ = False

aux (y:ys) n

| y <= n = aux ys (n-y) || aux ys n

| otherwise = False

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

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

existeSubSuma5 :: [Int] -> Int -> Bool

existeSubSuma5 xs n =

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

matrizExisteSubSuma5 :: [Int] -> Int -> Array (Int,Int) Bool

matrizExisteSubSuma5 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 = True

f 0 _ = False

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

| otherwise = False

-- Equivalencia

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

prop_existeSubSuma :: [Int] -> Int -> Bool

prop_existeSubSuma xs n =

all (== existeSubSuma2 ys m) [ existeSubSuma3 ys m

, existeSubSuma4 ys m

, existeSubSuma5 ys m ]

where ys = map abs xs

m = abs n

-- La comprobación es

-- λ> quickCheck prop_existeSubSuma

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia:

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

-- λ> let xs = [1..22] in existeSubSuma1 xs (sum xs)

-- True

-- (7.76 secs, 3,892,403,928 bytes)

-- λ> let xs = [1..22] in existeSubSuma2 xs (sum xs)

-- True

-- (0.02 secs, 95,968 bytes)

-- λ> let xs = [1..22] in existeSubSuma3 xs (sum xs)

-- True

-- (0.03 secs, 6,055,200 bytes)

-- λ> let xs = [1..22] in existeSubSuma4 xs (sum xs)

-- True

-- (0.01 secs, 98,880 bytes)

-- λ> let xs = [1..22] in existeSubSuma5 xs (sum xs)

-- True

-- (0.02 secs, 2,827,560 bytes)

-- λ> let xs = [1..200] in existeSubSuma2 xs (sum xs)

-- True

-- (0.01 secs, 182,280 bytes)

-- λ> let xs = [1..200] in existeSubSuma3 xs (sum xs)

-- True

-- (8.89 secs, 1,875,071,968 bytes)

-- λ> let xs = [1..200] in existeSubSuma4 xs (sum xs)

-- True

-- (0.02 secs, 217,128 bytes)

-- λ> let xs = [1..200] in existeSubSuma5 xs (sum xs)

-- True

-- (8.66 secs, 1,875,087,976 bytes)

-- λ> and [existeSubSuma2 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (2.82 secs, 323,372,512 bytes)

-- λ> and [existeSubSuma3 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (0.65 secs, 221,806,376 bytes)

-- λ> and [existeSubSuma4 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (4.12 secs, 535,153,152 bytes)

-- λ> and [existeSubSuma5 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (0.73 secs, 238,579,696 bytes)

Búsqueda en los dígitos de pi

PorJosé A. Alonso 13-abril-201826-marzo-2022

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

   3.1415926535897932384626433832 ... 83996346460422090106105779458151

1	3.1415926535897932384626433832 ... 83996346460422090106105779458151

Definir la función

   posicion :: String -> IO (Maybe Int)

1	posicion :: String -> IO (Maybe Int)

tal que (posicion n) es (Just k) si k es la posición de n en la sucesión formada por un millón dígitos decimales del número pi y Nothing si n no ocurre en dicha sucesión. Por ejemplo,

   λ> posicion "15"
   Just 3
   λ> posicion "2017"
   Just 8897
   λ> posicion "022017"
   Just 382052
   λ> posicion "14022017"
   Nothing
   λ> posicion "999999"
   Just 762
   λ> posicion "458151"
   Just 999995

λ> posicion "15"

Just 3

λ> posicion "2017"

Just 8897

λ> posicion "022017"

Just 382052

λ> posicion "14022017"

Nothing

λ> posicion "999999"

Just 762

λ> posicion "458151"

Just 999995

Nota. Se puede comprobar la función mediante The pi-search page o Pi search engine.

Soluciones

import Data.List (isPrefixOf)

posicion :: String -> IO (Maybe Int)
posicion ns = do
  ds <- readFile "Digitos_de_pi.txt"
  return (posicionEnLista (drop 2 ds) ns)

posicionEnLista :: Eq a => [a] -> [a] -> Maybe Int
posicionEnLista xs ys = aux xs 1
  where aux [] _ = Nothing
        aux (x:xs) n | ys `isPrefixOf` (x:xs) = Just n
                     | otherwise              = aux xs (n+1)

import Data.List (isPrefixOf)

posicion :: String -> IO (Maybe Int)

posicion ns = do

ds <- readFile "Digitos_de_pi.txt"

return (posicionEnLista (drop 2 ds) ns)

posicionEnLista :: Eq a => [a] -> [a] -> Maybe Int

posicionEnLista xs ys = aux xs 1

where aux [] _ = Nothing

aux (x:xs) n | ys `isPrefixOf` (x:xs) = Just n

| otherwise = aux xs (n+1)

Números superpares

PorJosé A. Alonso 12-abril-201819-abril-2018

Definir la función

   superpar :: Int -> Bool

1	superpar :: Int -> Bool

tal que (superpar n) se verifica si n es un número par tal que todos sus dígitos son pares. Por ejemplo,

   superpar 426  ==  True
   superpar 456  ==  False

1 2	superpar 426 == True superpar 456 == False

Soluciones

-- 1ª definición (por recursión)
superpar :: Int -> Bool
superpar n | n < 10    = even n
           | otherwise = even n && superpar (n `div` 10)

-- 2ª definición (por comprensión):
superpar2 :: Int -> Bool
superpar2 n = and [even d | d <- digitos n]

digitos :: Int -> [Int]
digitos n = [read [d] | d <- show n]

-- 3ª definición (por recursión sobre los dígitos):
superpar3 :: Int -> Bool
superpar3 n = sonPares (digitos n)
    where sonPares []     = True
          sonPares (d:ds) = even d && sonPares ds

-- la función sonPares se puede definir por plegado:
superpar3' :: Int -> Bool
superpar3' n = sonPares (digitos n)
    where sonPares ds = foldr ((&&) . even) True ds

-- 4ª definición (con all):
superpar4 :: Int -> Bool
superpar4 n = all even (digitos n)

-- 5ª definición (con filter):
superpar5 :: Int -> Bool
superpar5 n = filter even (digitos n) == digitos n

-- 6ª definición (con filter):
superpar6 :: Int -> Bool
superpar6 n = all (`elem` "02468") (show n)

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

superpar :: Int -> Bool

superpar n | n < 10 = even n

| otherwise = even n && superpar (n `div` 10)

-- 2ª definición (por comprensión):

superpar2 :: Int -> Bool

superpar2 n = and [even d | d <- digitos n]

digitos :: Int -> [Int]

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

-- 3ª definición (por recursión sobre los dígitos):

superpar3 :: Int -> Bool

superpar3 n = sonPares (digitos n)

where sonPares [] = True

sonPares (d:ds) = even d && sonPares ds

-- la función sonPares se puede definir por plegado:

superpar3' :: Int -> Bool

superpar3' n = sonPares (digitos n)

where sonPares ds = foldr ((&&) . even) True ds

-- 4ª definición (con all):

superpar4 :: Int -> Bool

superpar4 n = all even (digitos n)

-- 5ª definición (con filter):

superpar5 :: Int -> Bool

superpar5 n = filter even (digitos n) == digitos n

-- 6ª definición (con filter):

superpar6 :: Int -> Bool

superpar6 n = all (`elem` "02468") (show n)

Cálculo de pi mediante la serie de Nilakantha

PorJosé A. Alonso 11-abril-201825-marzo-2022

Una serie infinita para el cálculo de pi, publicada por Nilakantha en el siglo XV, es

Definir las funciones

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

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

tales que

(aproximacionPi n) es la n-ésima aproximación de pi obtenido sumando los n primeros términos de la serie de Nilakantha. Por ejemplo,

     aproximacionPi 0        ==  3.0
     aproximacionPi 1        ==  3.1666666666666665
     aproximacionPi 2        ==  3.1333333333333333
     aproximacionPi 3        ==  3.145238095238095
     aproximacionPi 4        ==  3.1396825396825396
     aproximacionPi 5        ==  3.1427128427128426
     aproximacionPi 10       ==  3.1414067184965018
     aproximacionPi 100      ==  3.1415924109719824
     aproximacionPi 1000     ==  3.141592653340544
     aproximacionPi 10000    ==  3.141592653589538
     aproximacionPi 100000   ==  3.1415926535897865
     aproximacionPi 1000000  ==  3.141592653589787
     pi                      ==  3.141592653589793

aproximacionPi 0 == 3.0

aproximacionPi 1 == 3.1666666666666665

aproximacionPi 2 == 3.1333333333333333

aproximacionPi 3 == 3.145238095238095

aproximacionPi 4 == 3.1396825396825396

aproximacionPi 5 == 3.1427128427128426

aproximacionPi 10 == 3.1414067184965018

aproximacionPi 100 == 3.1415924109719824

aproximacionPi 1000 == 3.141592653340544

aproximacionPi 10000 == 3.141592653589538

aproximacionPi 100000 == 3.1415926535897865

aproximacionPi 1000000 == 3.141592653589787

pi == 3.141592653589793

(tabla f ns) escribe en el fichero f las n-ésimas aproximaciones de pi, donde n toma los valores de la lista ns, junto con sus errores. Por ejemplo, al evaluar la expresión

     tabla "AproximacionesPi.txt" [0,10..100]

1	tabla "AproximacionesPi.txt" [0,10..100]

hace que el contenido del fichero «AproximacionesPi.txt» sea

+------+----------------+----------------+
| n    | Aproximación   | Error          |
+------+----------------+----------------+
|    0 | 3.000000000000 | 0.141592653590 |
|   10 | 3.141406718497 | 0.000185935093 |
|   20 | 3.141565734659 | 0.000026918931 |
|   30 | 3.141584272675 | 0.000008380915 |
|   40 | 3.141589028941 | 0.000003624649 |
|   50 | 3.141590769850 | 0.000001883740 |
|   60 | 3.141591552546 | 0.000001101044 |
|   70 | 3.141591955265 | 0.000000698325 |
|   80 | 3.141592183260 | 0.000000470330 |
|   90 | 3.141592321886 | 0.000000331704 |
|  100 | 3.141592410972 | 0.000000242618 |
+------+----------------+----------------+

+------+----------------+----------------+

| n | Aproximación | Error |

+------+----------------+----------------+

| 0 | 3.000000000000 | 0.141592653590 |

| 10 | 3.141406718497 | 0.000185935093 |

| 20 | 3.141565734659 | 0.000026918931 |

| 30 | 3.141584272675 | 0.000008380915 |

| 40 | 3.141589028941 | 0.000003624649 |

| 50 | 3.141590769850 | 0.000001883740 |

| 60 | 3.141591552546 | 0.000001101044 |

| 70 | 3.141591955265 | 0.000000698325 |

| 80 | 3.141592183260 | 0.000000470330 |

| 90 | 3.141592321886 | 0.000000331704 |

| 100 | 3.141592410972 | 0.000000242618 |

+------+----------------+----------------+

al evaluar la expresión

     tabla "AproximacionesPi.txt" [0,500..5000]

1	tabla "AproximacionesPi.txt" [0,500..5000]

hace que el contenido del fichero «AproximacionesPi.txt» sea

+------+----------------+----------------+
| n    | Aproximación   | Error          |
+------+----------------+----------------+
|    0 | 3.000000000000 | 0.141592653590 |
|  500 | 3.141592651602 | 0.000000001988 |
| 1000 | 3.141592653341 | 0.000000000249 |
| 1500 | 3.141592653516 | 0.000000000074 |
| 2000 | 3.141592653559 | 0.000000000031 |
| 2500 | 3.141592653574 | 0.000000000016 |
| 3000 | 3.141592653581 | 0.000000000009 |
| 3500 | 3.141592653584 | 0.000000000006 |
| 4000 | 3.141592653586 | 0.000000000004 |
| 4500 | 3.141592653587 | 0.000000000003 |
| 5000 | 3.141592653588 | 0.000000000002 |
+------+----------------+----------------+

+------+----------------+----------------+

| n | Aproximación | Error |

+------+----------------+----------------+

| 0 | 3.000000000000 | 0.141592653590 |

| 500 | 3.141592651602 | 0.000000001988 |

| 1000 | 3.141592653341 | 0.000000000249 |

| 1500 | 3.141592653516 | 0.000000000074 |

| 2000 | 3.141592653559 | 0.000000000031 |

| 2500 | 3.141592653574 | 0.000000000016 |

| 3000 | 3.141592653581 | 0.000000000009 |

| 3500 | 3.141592653584 | 0.000000000006 |

| 4000 | 3.141592653586 | 0.000000000004 |

| 4500 | 3.141592653587 | 0.000000000003 |

| 5000 | 3.141592653588 | 0.000000000002 |

+------+----------------+----------------+

Soluciones

import Text.Printf

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

aproximacionPi :: Int -> Double
aproximacionPi n = serieNilakantha !! n

serieNilakantha :: [Double]
serieNilakantha = scanl1 (+) terminosNilakantha

terminosNilakantha :: [Double]
terminosNilakantha = zipWith (/) numeradores denominadores
  where numeradores   = 3 : cycle [4,-4]
        denominadores = 1 : [n*(n+1)*(n+2) | n <- [2,4..]]

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

aproximacionPi2 :: Int -> Double
aproximacionPi2 = aux 3 2 1
  where aux x _ _ 0 = x
        aux x y z m =
          aux (x+4/product[y..y+2]*z) (y+2) (negate z) (m-1)

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

--    λ> aproximacionPi (2*10^5)
--    3.141592653589787
--    (0.82 secs, 145,964,728 bytes)
--    λ> aproximacionPi2 (2*10^5)
--    3.141592653589787
--    (2.27 secs, 432,463,496 bytes)
--    λ> aproximacionPi (3*10^5)
--    3.141592653589787
--    (0.34 secs, 73,056,488 bytes)
--    λ> aproximacionPi2 (3*10^5)
--    3.141592653589787
--    (3.24 secs, 648,603,824 bytes)

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

tabla :: FilePath -> [Int] -> IO ()
tabla f ns = do
  writeFile f (tablaAux ns)

tablaAux :: [Int] -> String
tablaAux ns =
     linea
  ++ cabecera
  ++ linea
  ++ concat [printf "| %4d | %.12f | %.12f |\n" n a e
            | n <- ns
            , let a = aproximacionPi n
            , let e = abs (pi - a)]
  ++ linea

linea :: String
linea = "+------+----------------+----------------+\n"

cabecera :: String
cabecera = "| n    | Aproximación   | Error          |\n"

import Text.Printf

-- 1ª solución

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

aproximacionPi :: Int -> Double

aproximacionPi n = serieNilakantha !! n

serieNilakantha :: [Double]

serieNilakantha = scanl1 (+) terminosNilakantha

terminosNilakantha :: [Double]

terminosNilakantha = zipWith (/) numeradores denominadores

where numeradores = 3 : cycle [4,-4]

denominadores = 1 : [n*(n+1)*(n+2) | n <- [2,4..]]

-- 2ª solución

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

aproximacionPi2 :: Int -> Double

aproximacionPi2 = aux 3 2 1

where aux x _ _ 0 = x

aux x y z m =

aux (x+4/product[y..y+2]*z) (y+2) (negate z) (m-1)

-- Comparación de eficiencia

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

-- λ> aproximacionPi (2*10^5)

-- 3.141592653589787

-- (0.82 secs, 145,964,728 bytes)

-- λ> aproximacionPi2 (2*10^5)

-- 3.141592653589787

-- (2.27 secs, 432,463,496 bytes)

-- λ> aproximacionPi (3*10^5)

-- 3.141592653589787

-- (0.34 secs, 73,056,488 bytes)

-- λ> aproximacionPi2 (3*10^5)

-- 3.141592653589787

-- (3.24 secs, 648,603,824 bytes)

-- Definicioń de tabla

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

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

tabla f ns = do

writeFile f (tablaAux ns)

tablaAux :: [Int] -> String

tablaAux ns =

linea

++ cabecera

++ linea

++ concat [printf "| %4d | %.12f | %.12f |\n" n a e

| n <- ns

, let a = aproximacionPi n

, let e = abs (pi - a)]

++ linea

linea :: String

linea = "+------+----------------+----------------+\n"

cabecera :: String

cabecera = "| n | Aproximación | Error |\n"

Alturas primas

PorJosé A. Alonso 10-abril-201826-marzo-2022

Se considera una enumeración de los números primos:

    p(1)=2,  p(2)=3, p(3)=5, p(4)=7, p(5)=11, p(6)=13, p(7)=17,...

1	p(1)=2, p(2)=3, p(3)=5, p(4)=7, p(5)=11, p(6)=13, p(7)=17,...

Dado un entero x > 1, su altura prima es el mayor i tal que el primo p(i) aparece en la factorización de x en números primos. Por ejemplo, la altura prima de 3500 tiene longitud 4, pues 3500=2^2×5^3×7^1 y la de 34 tiene es 7, pues 34 = 2×17. Además, se define la altura prima de 1 como 0.

Definir las funciones

   alturaPrima        :: Integer -> Integer
   alturasPrimas      :: Integer -> [Integer]
   graficaAlturaPrima :: Integer -> IO ()

alturaPrima :: Integer -> Integer

alturasPrimas :: Integer -> [Integer]

graficaAlturaPrima :: Integer -> IO ()

tales que

(alturaPrima x) es la altura prima de x. Por ejemplo,

     alturaPrima 3500  ==  4
     alturaPrima 34    ==  7

1 2	alturaPrima 3500 == 4 alturaPrima 34 == 7

(alturasPrimas n) es la lista de las altura prima de los primeros n números enteros positivos. Por ejemplo,

     alturasPrimas 15  ==  [0,1,2,1,3,2,4,1,2,3,5,2,6,4,3]
     maximum (alturasPrimas 10000)  ==  1229
     maximum (alturasPrimas 20000)  ==  2262
     maximum (alturasPrimas 30000)  ==  3245
     maximum (alturasPrimas 40000)  ==  4203

alturasPrimas 15 == [0,1,2,1,3,2,4,1,2,3,5,2,6,4,3]

maximum (alturasPrimas 10000) == 1229

maximum (alturasPrimas 20000) == 2262

maximum (alturasPrimas 30000) == 3245

maximum (alturasPrimas 40000) == 4203

(graficaAlturaPrima n) dibuja las alturas primas de los números entre 2 y n. Por ejemplo, (graficaAlturaPrima 500) dibuja

Soluciones

import Data.List (genericLength)
import Data.Numbers.Primes (isPrime, primes, primeFactors)
import Data.Array
import Graphics.Gnuplot.Simple

-- 1ª definicioń de alturaPrima
-- ============================

alturaPrima :: Integer -> Integer
alturaPrima 1 = 0
alturaPrima n = indice (mayorFactorPrimo n)

-- (mayorFactorPrimo n) es el mayor factor primo de n. Por ejemplo,
--    mayorFactorPrimo 3500  ==  7
--    mayorFactorPrimo 34    ==  17
mayorFactorPrimo :: Integer -> Integer
mayorFactorPrimo = last . primeFactors

-- (indice p) es el índice de p en la sucesión de los números
-- primos. Por ejemplo,
--    indice 7   ==  4
--    indice 17  ==  7
indice :: Integer -> Integer
indice p = genericLength (takeWhile (<=p) primes)

-- 2ª definicioń de alturaPrima
-- ============================

alturaPrima2 :: Integer -> Integer
alturaPrima2 n = v ! n
  where v = array (1,n) [(i,f i) | i <- [1..n]]
        f 1 = 0
        f k | isPrime k = indice2 k
            | otherwise = v ! (k `div` (head (primeFactors k)))

indice2 :: Integer -> Integer
indice2 p = head [n | (x,n) <- indicesPrimos, x == p]

-- indicesPrimos es la suceción formada por los números primos y sus
-- índices. Por ejemplo,
--    λ> take 10 indicesPrimos
--    [(2,1),(3,2),(5,3),(7,4),(11,5),(13,6),(17,7),(19,8),(23,9),(29,10)]
indicesPrimos :: [(Integer,Integer)]
indicesPrimos = zip primes [1..]

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

alturasPrimas :: Integer -> [Integer]
alturasPrimas n = map alturaPrima [1..n]

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

alturasPrimas2 :: Integer -> [Integer]
alturasPrimas2 n = elems v 
  where v = array (1,n) [(i,f i) | i <- [1..n]]
        f 1 = 0
        f k | isPrime k = indice2 k
            | otherwise = v ! (k `div` (head (primeFactors k)))

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

--    λ> maximum (alturasPrimas 20000)
--    2262
--    (29.97 secs, 13,179,984,536 bytes)
--    λ> maximum (alturasPrimas2 20000)
--    2262
--    (2.11 secs, 455,259,448 bytes)

-- Definición de graficaAlturaPrima
-- ================================

graficaAlturaPrima :: Integer -> IO ()
graficaAlturaPrima n =
  plotList [ Key Nothing
           , PNG "Alturas_primas.png"
           ]
           (alturasPrimas2 n)

import Data.List (genericLength)

import Data.Numbers.Primes (isPrime, primes, primeFactors)

import Data.Array

import Graphics.Gnuplot.Simple

-- 1ª definicioń de alturaPrima

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

alturaPrima :: Integer -> Integer

alturaPrima 1 = 0

alturaPrima n = indice (mayorFactorPrimo n)

-- (mayorFactorPrimo n) es el mayor factor primo de n. Por ejemplo,

-- mayorFactorPrimo 3500 == 7

-- mayorFactorPrimo 34 == 17

mayorFactorPrimo :: Integer -> Integer

mayorFactorPrimo = last . primeFactors

-- (indice p) es el índice de p en la sucesión de los números

-- primos. Por ejemplo,

-- indice 7 == 4

-- indice 17 == 7

indice :: Integer -> Integer

indice p = genericLength (takeWhile (<=p) primes)

-- 2ª definicioń de alturaPrima

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

alturaPrima2 :: Integer -> Integer

alturaPrima2 n = v ! n

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

f 1 = 0

f k | isPrime k = indice2 k

| otherwise = v ! (k `div` (head (primeFactors k)))

indice2 :: Integer -> Integer

indice2 p = head [n | (x,n) <- indicesPrimos, x == p]

-- indicesPrimos es la suceción formada por los números primos y sus

-- índices. Por ejemplo,

-- λ> take 10 indicesPrimos

-- [(2,1),(3,2),(5,3),(7,4),(11,5),(13,6),(17,7),(19,8),(23,9),(29,10)]

indicesPrimos :: [(Integer,Integer)]

indicesPrimos = zip primes [1..]

-- 1ª definición de alturasPrimas

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

alturasPrimas :: Integer -> [Integer]

alturasPrimas n = map alturaPrima [1..n]

-- 2ª definición de alturasPrimas

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

alturasPrimas2 :: Integer -> [Integer]

alturasPrimas2 n = elems v

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

f 1 = 0

f k | isPrime k = indice2 k

| otherwise = v ! (k `div` (head (primeFactors k)))

-- Comparación de eficiencia

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

-- λ> maximum (alturasPrimas 20000)

-- 2262

-- (29.97 secs, 13,179,984,536 bytes)

-- λ> maximum (alturasPrimas2 20000)

-- 2262

-- (2.11 secs, 455,259,448 bytes)

-- Definición de graficaAlturaPrima

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

graficaAlturaPrima :: Integer -> IO ()

graficaAlturaPrima n =

plotList [ Key Nothing

, PNG "Alturas_primas.png"

]

(alturasPrimas2 n)

Ampliación de árboles binarios

PorJosé A. Alonso 9-abril-201816-abril-2018

Representamos los árboles binarios mediante el tipo de dato

   data Arbol a = H a
                | N a (Arbol a) (Arbol a)
     deriving Show

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

Una forma de ampliar un árbol binario es añadiendo un nuevo nivel donde
las nuevas hojas sean iguales a la suma de los valores de los nodos
desde el padre hasta llegar a la raíz (inclusives). Por ejemplo:

      5               5       |         3                3
     / \             / \      |        / \             /   \
    2   0    ==>    2   0     |       2   4    ==>    2     4
                   / \ / \    |      / \             / \   / \
                  7  7 5  5   |     0   1           0   1 7   7
                              |                    /\   /\
                              |                   5  5 6  6

5 5 | 3 3

/ \ / \ | / \ / \

2 0 ==> 2 0 | 2 4 ==> 2 4

/ \ / \ | / \ / \ / \

7 7 5 5 | 0 1 0 1 7 7

| /\ /\

| 5 5 6 6

Definir la función

   ampliaArbol:: Num a => Arbol a -> Arbol a

1	ampliaArbol:: Num a => Arbol a -> Arbol a

tal que (ampliaArbol a) es el árbol a ampliado en un nivel. Por
ejemplo,

   λ> ampliaArbol (N 5 (H 2)(H 0))
   N 5 (N 2 (H 7) (H 7)) (N 0 (H 5) (H 5))
   λ> ampliaArbol (N 3 (N 2 (H 0) (H 1)) (H 4))
   N 3 (N 2 (N 0 (H 5) (H 5)) (N 1 (H 6) (H 6))) (N 4 (H 7) (H 7))
   λ> ampliaArbol (H 1)
   N 1 (H 1) (H 1)
   λ> ampliaArbol N 1 (H 1) (H 1)
   N 1 (N 1 (H 2) (H 2)) (N 1 (H 2) (H 2))

λ> ampliaArbol (N 5 (H 2)(H 0))

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

λ> ampliaArbol (N 3 (N 2 (H 0) (H 1)) (H 4))

N 3 (N 2 (N 0 (H 5) (H 5)) (N 1 (H 6) (H 6))) (N 4 (H 7) (H 7))

λ> ampliaArbol (H 1)

N 1 (H 1) (H 1)

λ> ampliaArbol N 1 (H 1) (H 1)

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

Soluciones

data Arbol a = H a
             | N a (Arbol a) (Arbol a)
  deriving Show

ampliaArbol :: Num a => Arbol a -> Arbol a
ampliaArbol a = aux 0 a
  where aux n (H x)     = N x (H (n+x)) (H (n+x))
        aux n (N x i d) = N x (aux (n+x) i) (aux (n+x) d)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

ampliaArbol :: Num a => Arbol a -> Arbol a

ampliaArbol a = aux 0 a

where aux n (H x) = N x (H (n+x)) (H (n+x))

aux n (N x i d) = N x (aux (n+x) i) (aux (n+x) d)

Clases de equivalencia

PorJosé A. Alonso 5-abril-201812-abril-2018

Definir la función

   clasesEquivalencia :: Ord a => 
                         Set a -> (a -> a -> Bool) -> Set (Set a)

1 2	clasesEquivalencia :: Ord a => Set a -> (a -> a -> Bool) -> Set (Set a)

tal que (clasesEquivalencia xs r) es el conjunto de las clases de equivalencia de xs respecto de la relación de equivalencia r. Por ejemplo,

   ghci> let c = fromList [-3..3]
   ghci> clasesEquivalencia c (\x y -> x `mod` 3 == y `mod` 3)
   fromList [fromList [-3,0,3],fromList [-2,1],fromList [-1,2]]
   ghci> clasesEquivalencia c (\x y -> (x - y) `mod` 2 == 0)
   fromList [fromList [-3,-1,1,3],fromList [-2,0,2]]

ghci> let c = fromList [-3..3]

ghci> clasesEquivalencia c (\x y -> x `mod` 3 == y `mod` 3)

fromList [fromList [-3,0,3],fromList [-2,1],fromList [-1,2]]

ghci> clasesEquivalencia c (\x y -> (x - y) `mod` 2 == 0)

fromList [fromList [-3,-1,1,3],fromList [-2,0,2]]

Soluciones

import Data.Set as S

clasesEquivalencia :: Ord a => 
                      Set a -> (a -> a -> Bool) -> Set (Set a)
clasesEquivalencia xs r 
    | S.null xs =  empty
    | otherwise =  us `insert` clasesEquivalencia vs r
    where (y,ys)  = deleteFindMin xs
          (us,vs) = partition (r y) xs

import Data.Set as S

clasesEquivalencia :: Ord a =>

Set a -> (a -> a -> Bool) -> Set (Set a)

clasesEquivalencia xs r

| S.null xs = empty

| otherwise = us `insert` clasesEquivalencia vs r

where (y,ys) = deleteFindMin xs

(us,vs) = partition (r y) xs

Notas de evaluación acumulada

Soluciones

Reducción de opuestos

Soluciones

Matrices de Hadamard

Soluciones

Decidir si existe un subconjunto con suma dada

Soluciones

Búsqueda en los dígitos de pi

Soluciones

Números superpares

Soluciones

Cálculo de pi mediante la serie de Nilakantha

Soluciones

Alturas primas

Soluciones

Ampliación de árboles binarios

Soluciones

Clases de equivalencia

Soluciones

Entradas recientes

Buscar

Correo electrónico