Menu Close

Etiqueta: length

Representaciones de grafos

Los grafos no dirigidos puede representarse mediante matrices de adyacencia y también mediante listas de adyacencia. Por ejemplo, el grafo

   1 ----- 2
   | \     |
   |  3    |
   | /     |
   4 ----- 5

se puede representar por la matriz de adyacencia

   |0 1 1 1 0|
   |1 0 0 0 1|
   |1 0 0 1 0|
   |1 0 1 0 1|
   |0 1 0 1 0|

donde el elemento (i,j) es 1 si hay una arista entre los vértices i y j y es 0 si no la hay. También se puede representar por la lista de adyacencia

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

donde las primeras componentes son los vértices y las segundas la lista de los vértices conectados.

Definir las funciones

   matrizAlista :: Matrix Int -> [(Int,[Int])]
   listaAmatriz :: [(Int,[Int])] -> Matrix Int

tales que

  • (matrizAlista a) es la lista de adyacencia correspondiente a la matriz de adyacencia a. Por ejemplo, definiendo la matriz anterior por
     ejMatriz :: Matrix Int
     ejMatriz = fromLists [[0,1,1,1,0],
                           [1,0,0,0,1],
                           [1,0,0,1,0],
                           [1,0,1,0,1],
                           [0,1,0,1,0]]

se tiene que

     λ> matrizAlista ejMatriz
     [(1,[2,3,4]),(2,[1,5]),(3,[1,4]),(4,[1,3,5]),(5,[2,4])]
  • (listaAmatriz ps) es la matriz de adyacencia correspondiente a la lista de adyacencia ps. Por ejemplo,
     λ> listaAmatriz [(1,[2,3,4]),(2,[1,5]),(3,[1,4]),(4,[1,3,5]),(5,[2,4])]
     ( 0 1 1 1 0 )
     ( 1 0 0 0 1 )
     ( 1 0 0 1 0 )
     ( 1 0 1 0 1 )
     ( 0 1 0 1 0 )
     λ> matrizAlista it
     [(1,[2,3,4]),(2,[1,5]),(3,[1,4]),(4,[1,3,5]),(5,[2,4])]

Soluciones

import Data.List (sort)
import Data.Matrix
 
ejMatriz :: Matrix Int
ejMatriz = fromLists [[0,1,1,1,0],
                      [1,0,0,0,1],
                      [1,0,0,1,0],
                      [1,0,1,0,1],
                      [0,1,0,1,0]]
 
matrizAlista :: Matrix Int -> [(Int,[Int])]
matrizAlista a = 
  [(i,[j | j <- [1..n], a!(i,j) == 1]) | i <- [1..n]]
  where n = nrows a
 
listaAmatriz :: [(Int,[Int])] -> Matrix Int
listaAmatriz ps = fromLists [fila n xs | (_,xs) <- sort ps]
  where n = length ps
        fila n xs = [f i | i <- [1..n]]
          where f i | i `elem` xs = 1
                    | otherwise   = 0

Sucesión de Recamán

La sucesión de Recamán está definida como sigue:

   a(0) = 0
   a(n) = a(n-1) - n, si a(n-1) > n y no figura ya en la sucesión
   a(n) = a(n-1) + n, en caso contrario.

Definir las funciones

   sucRecaman :: [Int]
   invRecaman :: Int -> Int
   graficaSucRecaman :: Int -> IO ()
   graficaInvRecaman :: Int -> IO ()

tales que

  • sucRecaman es la lista de los términos de la sucesión de Recamám. Por ejemplo,
      λ> take 25 sucRecaman3
      [0,1,3,6,2,7,13,20,12,21,11,22,10,23,9,24,8,25,43,62,42,63,41,18,42]
      λ> sucRecaman !! 1000
      3686
      λ> sucRecaman !! 1000001
      1057163
  • (invRecaman n) es la primera posición de n en la sucesión de Recamán. Por ejemplo,
      invRecaman 10       ==  12
      invRecaman 3686     ==  1000
      invRecaman 1057163  ==  1000001
  • (graficaSucRecaman n) dibuja los n primeros términos de la sucesión de Recamán. Por ejemplo, (graficaSucRecaman 300) dibuja
    Sucesion_de_Recaman_1
  • (graficaInvRecaman n) dibuja los valores de (invRecaman k) para k entre 0 y n. Por ejemplo, (graficaInvRecaman 17) dibuja
    Sucesion_de_Recaman_2
    y (graficaInvRecaman 100) dibuja
    Sucesion_de_Recaman_3

Soluciones

import qualified Data.Set as S
 
-- 1ª solución
-- ===========
 
sucRecaman1 :: [Int]
sucRecaman1 = map suc1 [0..]
 
suc1 :: Int -> Int
suc1 0 = 0
suc1 n | y > n && y - n `notElem` ys = y - n
       | otherwise                   = y + n
  where y  = suc1 (n - 1)
        ys = [suc1 k | k <- [0..n - 1]]
 
-- 2ª solución
-- ===========
 
sucRecaman2 :: [Int]
sucRecaman2 = 0:zipWith3 f sucRecaman2 [1..] (repeat sucRecaman2)
  where f y n ys | y > n && y - n `notElem` take n ys = y - n
                 | otherwise                          = y + n
 
-- 3ª solución
-- ===========
 
sucRecaman3 :: [Int]
sucRecaman3 = 0 : recaman (S.singleton 0) 1 0
 
recaman :: S.Set Int -> Int -> Int -> [Int]
recaman s n x
  | x > n && (x-n) `S.notMember` s =
    (x-n) : recaman (S.insert (x-n) s) (n+1) (x-n)
  | otherwise =
    (x+n):recaman (S.insert (x+n) s) (n+1) (x+n) 
 
-- Comparación de eficiencia:
--    λ> sucRecaman1 !! 25
--    17
--    (3.76 secs, 2,394,593,952 bytes)
--    λ> sucRecaman2 !! 25
--    17
--    (0.00 secs, 0 bytes)
--    λ> sucRecaman3 !! 25
--    17
--    (0.00 secs, 0 bytes)
--
--    λ> sucRecaman2 !! (2*10^4)
--    14358
--    (2.69 secs, 6,927,559,784 bytes)
--    λ> sucRecaman3 !! (2*10^4)
--    14358
--    (0.04 secs, 0 bytes)
 
-- Definición de invRecaman
invRecaman :: Int -> Int
invRecaman n =
  length (takeWhile (/=n) sucRecaman3)
 
graficaSucRecaman :: Int -> IO ()
graficaSucRecaman n =
  plotList [Key Nothing]
           (take n sucRecaman3)
 
graficaInvRecaman :: Int -> IO ()
graficaInvRecaman n =
  plotList [Key Nothing]
           [invRecaman k | k <- [0..n]]

Números construidos con los dígitos de un conjunto dado

Definir las siguientes funciones

   numerosCon      :: [Integer] -> [Integer]
   numeroDeDigitos :: [Integer] -> Integer -> Int

tales que

  • (numerosCon ds) es la lista de los números que se pueden construir con los dígitos de ds (cuyos elementos son distintos elementos del 1 al 9) . Por ejemplo,
     λ> take 22 (numerosCon [1,4,6,9])
     [1,4,6,9,11,14,16,19,41,44,46,49,61,64,66,69,91,94,96,99,111,114]
     λ> take 15 (numerosCon [4,6,9])
     [4,6,9,44,46,49,64,66,69,94,96,99,444,446,449]
     λ> take 15 (numerosCon [6,9])
     [6,9,66,69,96,99,666,669,696,699,966,969,996,999,6666]
  • (numeroDeDigitos ds k) es el número de dígitos que tiene el k-ésimo elemento (empezando a contar en 0) de la sucesión (numerosCon ds). Por ejemplo,
     numeroDeDigitos [1,4,6,9]   3  ==  1
     numeroDeDigitos [1,4,6,9]   6  ==  2
     numeroDeDigitos [1,4,6,9]  22  ==  3
     numeroDeDigitos [4,6,9]    15  ==  3
     numeroDeDigitos [6,9]      15  ==  4
     numeroDeDigitos [1,4,6,9] (10^(10^5))  ==  166097
     numeroDeDigitos   [4,6,9] (10^(10^5))  ==  209590
     numeroDeDigitos     [6,9] (10^(10^5))  ==  332192

Soluciones

import Data.List (genericIndex, genericLength)
 
-- Definición de numerosCon
-- ========================
 
numerosCon :: [Integer] -> [Integer]
numerosCon xs = [n | n <- [0..]
                   , n `tieneSusDigitosEn` xs]
 
-- (tieneSusDigitosEn xs n) se verifica si los dígitos de n están contenidos en
-- xs. Por ejemplo,
--    4149 `tieneSusDigitosEn` [1,4,6,9]  ==  True
--    4143 `tieneSusDigitosEn` [1,4,6,9]  ==  False
tieneSusDigitosEn :: Integer -> [Integer] -> Bool
tieneSusDigitosEn n xs =
  digitos n `esSubconjunto` xs
 
-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos n = [read [c] | c <- show n]
 
-- (esSubconjunto xs ys) se verifica si xs es subconjunto de ys. Por
-- ejemplo, 
--    esSubconjunto [3,2,5] [4,2,5,7,3]  ==  True
--    esSubconjunto [3,2,5] [4,2,5,7]  ==  False
esSubconjunto :: Eq a => [a] -> [a] -> Bool
esSubconjunto xs ys = all (`elem` ys) xs
 
-- 1ª definición de numeroDeDigitos
-- ================================
 
numeroDeDigitos :: [Integer] -> Integer -> Int
numeroDeDigitos xs n =
  length (show (numerosCon xs `genericIndex` n))
 
-- 2ª definición de numeroDeDigitos
-- ================================
 
-- Observando que si el conjunto de dígitos tiene n elementos, entonces
-- hay n^k números con k dígitos.
 
numeroDeDigitos2 :: [Integer] -> Integer -> Int
numeroDeDigitos2 xs n =
  1 + length (takeWhile (<= n) (sumasDePotencias (genericLength xs)))
 
-- (potencia n) son las potencias de n. Por ejemplo,
--    take 5 (potencias 3)  ==  [3,9,27,81,243]
potencias :: Integer -> [Integer]
potencias k = iterate (*k) k 
 
-- (sumasDePotencias n) es la lista de las sumas acumuladas de las
-- potencias de n. Por ejemplo,
--    take 5 (sumasDePotencias 3)  ==  [3,12,39,120,363]
sumasDePotencias :: Integer -> [Integer]
sumasDePotencias k = scanl1 (+) (potencias k)
 
-- Comparación de eficiencia
-- =========================
 
--    λ> numeroDeDigitos [1,4,6,9] 2000
--    6
--    (3.98 secs, 1,424,390,064 bytes)
--    λ> numeroDeDigitos2 [1,4,6,9] 2000
--    6
--    (0.01 secs, 127,464 bytes)

Polinomio digital

Definir la función

   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

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)

Subconjuntos con suma dada

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

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

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.