Menu Close

Etiqueta: length

Notas de evaluación acumulada

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

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

Definir las funciones

   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]
  • (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"

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

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

Decidir si existe un subconjunto con suma dada

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

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

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)

Mayor número obtenido intercambiando dos dígitos

Definir la función

   maximoIntercambio :: Int -> Int

tal que (maximoIntercambio x) es el máximo número que se puede obtener intercambiando dos dígitos de x. Por ejemplo,

   maximoIntercambio 983562  ==  986532
   maximoIntercambio 31524   ==  51324
   maximoIntercambio 897     ==  987

Soluciones

import Data.Array
 
-- 1ª solución
-- ===========
 
maximoIntercambio :: Int -> Int
maximoIntercambio = maximum . intercambios
 
-- (intercambios x) es la lista de los números obtenidos intercambiando
-- dos dígitos de x. Por ejemplo,
--    intercambios 1234  ==  [2134,3214,4231,1324,1432,1243]
intercambios :: Int -> [Int]
intercambios x = [intercambio i j x | i <- [0..n-2], j <- [i+1..n-1]]
    where n = length (show x)
 
-- (intercambio i j x) es el número obtenido intercambiando las cifras
-- que ocupan las posiciones i y j (empezando a contar en cero) del
-- número x. Por ejemplo,
--    intercambio 2 5 123456789  ==  126453789
intercambio :: Int -> Int -> Int -> Int
intercambio i j x = read (concat [as,[d],cs,[b],ds])
    where xs        = show x
          (as,b:bs) = splitAt i xs 
          (cs,d:ds) = splitAt (j-i-1) bs
 
-- 2ª solución (con vectores)
-- ==========================
 
maximoIntercambio2 :: Int -> Int
maximoIntercambio2 = read . elems . maximum . intercambios2
 
-- (intercambios2 x) es la lista de los vectores obtenidos
-- intercambiando dos elementos del vector de dígitos de x. Por ejemplo, 
--    ghci> intercambios2 1234
--    [array (0,3) [(0,'2'),(1,'1'),(2,'3'),(3,'4')],
--     array (0,3) [(0,'3'),(1,'2'),(2,'1'),(3,'4')],
--     array (0,3) [(0,'4'),(1,'2'),(2,'3'),(3,'1')],
--     array (0,3) [(0,'1'),(1,'3'),(2,'2'),(3,'4')],
--     array (0,3) [(0,'1'),(1,'4'),(2,'3'),(3,'2')],
--     array (0,3) [(0,'1'),(1,'2'),(2,'4'),(3,'3')]]
intercambios2 :: Int -> [Array Int Char]
intercambios2 x = [intercambioV i j v | i <- [0..n-2], j <- [i+1..n-1]]
    where xs = show x
          n  = length xs
          v  = listArray (0,n-1) xs
 
-- (intercambioV i j v) es el vector obtenido intercambiando los
-- elementos de v que ocupan las posiciones i y j. Por ejemplo,
--    ghci> intercambioV 2 4 (listArray (0,4) [3..8])
--    array (0,4) [(0,3),(1,4),(2,7),(3,6),(4,5)]
intercambioV :: Int -> Int -> Array Int a -> Array Int a
intercambioV i j v = v // [(i,v!j),(j,v!i)]

Árbol de subconjuntos

Definir las siguientes funciones

   arbolSubconjuntos       :: [a] -> Tree [a]
   nNodosArbolSubconjuntos :: Integer -> Integer
   sumaNNodos              :: Integer -> Integer

tales que

  • (arbolSubconjuntos xs) es el árbol de los subconjuntos de xs. Por ejemplo.
     λ> putStrLn (drawTree (arbolSubconjuntos "abc"))
     abc
     |
     +- bc
     |  |
     |  +- c
     |  |
     |  `- b
     |
     +- ac
     |  |
     |  +- c
     |  |
     |  `- a
     |
     `- ab
        |
        +- b
        |
        `- a
  • (nNodosArbolSubconjuntos xs) es el número de nodos del árbol de xs. Por ejemplo
     nNodosArbolSubconjuntos "abc"  ==  10
     nNodosArbolSubconjuntos [1..4*10^4] `mod` (7+10^9) == 546503960
  • (sumaNNodos n) es la suma del número de nodos de los árboles de los subconjuntos de [1..k] para 1 <= k <= n. Por ejemplo,
     λ> sumaNNodos 3  ==  14
     sumaNNodos (4*10^4) `mod` (7+10^9)  ==  249479844

Soluciones

import Data.List (genericLength, genericTake)
import Data.Tree (Tree (Node))
 
-- Definición de arbolSubconjuntos
-- ===============================
 
arbolSubconjuntos :: [a] -> Tree [a]
arbolSubconjuntos [x] = Node [x] []
arbolSubconjuntos xs =
  Node xs (map arbolSubconjuntos (sinUno xs))
 
-- (sinUno xs) es la lista obtenidas eliminando un elemento de xs. Por
-- ejemplo, 
--    sinUno "abcde"  ==  ["bcde","acde","abde","abce","abcd"]
sinUno :: [a] -> [[a]]
sinUno xs =
  [ys ++ zs | n <- [0..length xs - 1]
            , let (ys,_:zs) = splitAt n xs]       
 
-- 1ª definición de nNodosArbolSubconjuntos
-- ========================================
 
nNodosArbolSubconjuntos :: [a] -> Integer
nNodosArbolSubconjuntos =
  fromIntegral . length . arbolSubconjuntos 
 
-- 2ª definición de nNodosArbolSubconjuntos
-- ========================================
 
nNodosArbolSubconjuntos2 :: [a] -> Integer
nNodosArbolSubconjuntos2 = aux . genericLength
  where aux 1 = 1
        aux n = 1 + n * aux (n-1)
 
-- 3ª definición de nNodosArbolSubconjuntos
-- ========================================
 
nNodosArbolSubconjuntos3 :: [a] -> Integer
nNodosArbolSubconjuntos3 xs =
  sucNNodos !! (n-1)
  where n = length xs
 
-- sucNNodos es la sucesión de los números de nodos de los árboles de
-- los subconjuntos con 1, 2, ... elementos. Por ejemplo.
--    λ> take 10 sucNNodos
--    [1,3,10,41,206,1237,8660,69281,623530,6235301]
sucNNodos :: [Integer]
sucNNodos =
  1 : map (+ 1) (zipWith (*) [2..] sucNNodos)
 
-- Comparación de eficiencia de nNodosArbolSubconjuntos
-- ====================================================
 
--    λ> nNodosArbolSubconjuntos 10
--    6235301
--    (9.66 secs, 5,491,704,944 bytes)
--    λ> nNodosArbolSubconjuntos2 10
--    6235301
--    (0.00 secs, 145,976 bytes)
--
--    λ> length (show (nNodosArbolSubconjuntos2 (4*10^4)))
--    166714
--    (1.07 secs, 2,952,675,472 bytes)
--    λ> length (show (nNodosArbolSubconjuntos3 (4*10^4)))
--    166714
--    (1.53 secs, 2,959,020,680 bytes)
 
-- 1ª definición de sumaNNodos
-- ===========================
 
sumaNNodos :: Integer -> Integer
sumaNNodos n =
  sum [nNodosArbolSubconjuntos [1..k] | k <- [1..n]]
 
-- 2ª definición de sumaNNodos
-- ===========================
 
sumaNNodos2 :: Integer -> Integer
sumaNNodos2 n =
  sum [nNodosArbolSubconjuntos2 [1..k] | k <- [1..n]]
 
-- 3ª definición de sumaNNodos
-- ===========================
 
sumaNNodos3 :: Integer -> Integer
sumaNNodos3 n =
  sum (genericTake n sucNNodos)
 
-- Comparación de eficiencia de sumaNNodos
-- =======================================
 
--    λ> sumaNNodos 10 `mod` (7+10^9)
--    6938270
--    (16.00 secs, 9,552,410,688 bytes)
--    λ> sumaNNodos2 10 `mod` (7+10^9)
--    6938270
--    (0.00 secs, 177,632 bytes)
-- 
--    λ> sumaNNodos2 (2*10^3) `mod` (7+10^9)
--    851467820
--    (2.62 secs, 4,622,117,976 bytes)
--    λ> sumaNNodos3 (2*10^3) `mod` (7+10^9)
--    851467820
--    (0.01 secs, 8,645,336 bytes)

Sucesiones de números consecutivos con suma dada

El número 15 se puede escribir de 5 formas como suma de números naturales consecutivos:

   15 = 0+1+2+3+4+5 = 1+2+3+4+5 = 4+5+6 = 7+8 = 15.

Definir las funciones

   sucesionesConSuma        :: Int -> [(Int,Int)]
   graficaSucesionesConSuma :: Int -> IO ()

tales que

  • (sucesionesConSuma n) es la lista de los pares formados por el primero y por el último elemento de las sucesiones de números naturales consecutivos con suma n. Por ejemplo,
     sucesionesConSuma 15             ==  [(0,5),(1,5),(4,6),(7,8),(15,15)]
     length (sucesionesConSuma 3000)  ==  8
  • (graficaSucesionesConSuma n) dibuja la gráfica del número de formas de escribir los n primeros números como suma de números naturales consecutivos. Por ejemplo, (graficaSucesionesConSuma 100) dibuja
    Sucesiones_de_numeros_consecutivos_con_suma_dada

Soluciones

import Graphics.Gnuplot.Simple
 
-- 1ª solución
sucesionesConSuma :: Int -> [(Int,Int)]
sucesionesConSuma n =
  [(x,y) | y <- [0..n], x <- [0..y], sum [x..y] == n]
 
-- 2ª solución
sucesionesConSuma2 :: Int -> [(Int,Int)]
sucesionesConSuma2 n = 
    [(x,y) | y <- [0..n], x <- [0..y], (x+y)*(y-x+1) == 2*n]
 
-- Comparación de eficiencia
--    λ> sucesionesConSuma 700
--    [(3,37),(16,40),(84,91),(97,103),(138,142),(700,700)]
--    (2.71 secs, 7,894,718,264 bytes)
--    λ> sucesionesConSuma2 700
--    [(3,37),(16,40),(84,91),(97,103),(138,142),(700,700)]
--    (0.22 secs, 118,104,176 bytes)
 
-- Gráfica
graficaSucesionesConSuma :: Int -> IO ()
graficaSucesionesConSuma n =
  plotList [ Key Nothing
           , PNG "Sucesiones_de_numeros_consecutivos_con_suma_dada.png"]
           [length (sucesionesConSuma2 k) | k <- [0..n]]