Exercitium

Ciclos de un grafo

PorJosé A. Alonso 18-mayo-201526-marzo-2022

Un ciclo en un grafo G es una secuencia [v(1),v(2),v(3),…,v(n)] de nodos de G tal que:

(v(1),v(2)), (v(2),v(3)), (v(3),v(4)), …, (v(n-1),v(n)) son aristas de G,
v(1) = v(n), y
salvo v(1) = v(n), todos los v(i) son distintos entre sí.

Definir la función

   ciclos :: Grafo Int Int -> [[Int]]

1	ciclos :: Grafo Int Int -> [[Int]]

tal que (ciclos g) es la lista de ciclos de g. Por ejemplo, si g1 y g2 son los grafos definidos por

   g1, g2 :: Grafo Int Int
   g1 = creaGrafo D (1,4) [(1,2,0),(2,3,0),(2,4,0),(4,1,0)]
   g2 = creaGrafo D (1,4) [(1,2,0),(2,1,0),(2,4,0),(4,1,0)]

g1, g2 :: Grafo Int Int

g1 = creaGrafo D (1,4) [(1,2,0),(2,3,0),(2,4,0),(4,1,0)]

g2 = creaGrafo D (1,4) [(1,2,0),(2,1,0),(2,4,0),(4,1,0)]

entonces

   ciclos g1  ==  [[1,2,4,1],[2,4,1,2],[4,1,2,4]]
   ciclos g2  ==  [[1,2,1],[1,2,4,1],[2,1,2],[2,4,1,2],[4,1,2,4]]

1 2	ciclos g1 == [[1,2,4,1],[2,4,1,2],[4,1,2,4]] ciclos g2 == [[1,2,1],[1,2,4,1],[2,1,2],[2,4,1,2],[4,1,2,4]]

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

Soluciones

import Data.List (nub, subsequences, permutations, sort)
import I1M.Grafo

-- 1ª definición (por fuerza bruta)
-- ================================

ciclos1 :: Grafo Int Int -> [[Int]]
ciclos1 g = 
    sort [ys | (x:xs) <- concatMap permutations (subsequences (nodos g)) 
             , let ys = (x:xs) ++ [x]
             , esCiclo ys g]

-- (esCiclo vs g) se verifica si vs es un ciclo en el grafo g. Por
-- ejemplo, 
esCiclo :: [Int] -> Grafo Int Int -> Bool
esCiclo vs g = 
    all (aristaEn g) (zip vs (tail vs)) &&
    head vs == last vs &&
    length (nub vs) == length vs - 1    

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

ciclos2 :: Grafo Int Int -> [[Int]]
ciclos2 g = sort [ys | (x:xs) <- caminos g
                     , let ys = (x:xs) ++ [x]
                     , esCiclo ys g]

-- (caminos g) es la lista de los caminos en el grafo g. Por ejemplo,
--    caminos g1  ==  [[1,2,3],[1,2,4],[2,3],[2,4,1],[3],[4,1,2,3]]
caminos :: Grafo Int Int -> [[Int]]
caminos g = concatMap (caminosDesde g) (nodos g)

-- (caminosDesde g v) es la lista de los caminos en el grafo g a partir
-- del vértice v. Por ejemplo,
--    caminosDesde g1 1  ==  [[1],[1,2],[1,2,3],[1,2,4]]
--    caminosDesde g1 2  ==  [[2],[2,3],[2,4],[2,4,1]]
--    caminosDesde g1 3  ==  [[3]]
--    caminosDesde g1 4  ==  [[4],[4,1],[4,1,2],[4,1,2,3]]
caminosDesde :: Grafo Int Int -> Int -> [[Int]]
caminosDesde g v = 
    map (reverse . fst) $
    concat $ 
    takeWhile (not.null) (iterate (concatMap sucesores) [([v],[v])])
    where sucesores (x:xs,ys) = [(z:x:xs,z:ys) | z <- adyacentes g x
                                               , z `notElem` ys]

-- 3ª solución (Pedro Martín)
-- ==========================

ciclos3 :: Grafo Int Int -> [[Int]]
ciclos3 g = concat [aux [n] (adyacentes g n) | n <- nodos g] where 
    aux _ [] = []
    aux xs (y:ys)
        | notElem y xs = aux (xs ++ [y]) (adyacentes g y) ++ aux xs ys
        | y == head xs = (xs ++ [y]) : aux xs ys
        | otherwise    = aux xs ys

-- 4ª solución (Chema Cortés)
-- ==========================

ciclos4 :: Grafo Int Int -> [[Int]]
ciclos4 g = concat [ caminos a a [] | a <- nodos g ] where
    -- caminos posibles de b hasta a, sin pasar dos veces por un mismo nodo
    caminos a b vs
        | a == b && (not.null) vs = [[b]]
        | otherwise = [ b:xs | c <- adyacentes g b
                             , c `notElem` vs
                             , xs <- caminos a c (c:vs)]

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

-- ghci> let ejemplo n = creaGrafo D (1,n) ((n,1,0) : [(i,i+1,0) | i <- [1..n-1]])
-- 
-- ghci> length (ciclos1 (ejemplo 9))
-- 9
-- (4.92 secs, 1371229152 bytes)
--
-- ghci> length (ciclos2 (ejemplo 9))
-- 9
-- (0.01 secs, 2577736 bytes)
-- 
-- ghci> length (ciclos3 (ejemplo 9))
-- 9
-- (0.01 secs, 1038932 bytes)
-- 
-- ghci> length (ciclos4 (ejemplo 9))
-- 9
-- (0.01 secs, 2589288 bytes)
-- 
-- ghci> length (ciclos2 (ejemplo 400))
-- 400
-- (11.74 secs, 5148997000 bytes)
-- 
-- ghci> length (ciclos3 (ejemplo 400))
-- 400
-- (4.99 secs, 936520100 bytes)
-- 
-- ghci> length (ciclos4 (ejemplo 400))
-- 400
-- (1.56 secs, 66701772 bytes)

100

101

102

import Data.List (nub, subsequences, permutations, sort)

import I1M.Grafo

-- 1ª definición (por fuerza bruta)

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

ciclos1 :: Grafo Int Int -> [[Int]]

ciclos1 g =

sort [ys | (x:xs) <- concatMap permutations (subsequences (nodos g))

, let ys = (x:xs) ++ [x]

, esCiclo ys g]

-- (esCiclo vs g) se verifica si vs es un ciclo en el grafo g. Por

-- ejemplo,

esCiclo :: [Int] -> Grafo Int Int -> Bool

esCiclo vs g =

all (aristaEn g) (zip vs (tail vs)) &&

head vs == last vs &&

length (nub vs) == length vs - 1

-- 2ª definición

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

ciclos2 :: Grafo Int Int -> [[Int]]

ciclos2 g = sort [ys | (x:xs) <- caminos g

, let ys = (x:xs) ++ [x]

, esCiclo ys g]

-- (caminos g) es la lista de los caminos en el grafo g. Por ejemplo,

-- caminos g1 == [[1,2,3],[1,2,4],[2,3],[2,4,1],[3],[4,1,2,3]]

caminos :: Grafo Int Int -> [[Int]]

caminos g = concatMap (caminosDesde g) (nodos g)

-- (caminosDesde g v) es la lista de los caminos en el grafo g a partir

-- del vértice v. Por ejemplo,

-- caminosDesde g1 1 == [[1],[1,2],[1,2,3],[1,2,4]]

-- caminosDesde g1 2 == [[2],[2,3],[2,4],[2,4,1]]

-- caminosDesde g1 3 == [[3]]

-- caminosDesde g1 4 == [[4],[4,1],[4,1,2],[4,1,2,3]]

caminosDesde :: Grafo Int Int -> Int -> [[Int]]

caminosDesde g v =

map (reverse . fst) $

concat $

takeWhile (not.null) (iterate (concatMap sucesores) [([v],[v])])

where sucesores (x:xs,ys) = [(z:x:xs,z:ys) | z <- adyacentes g x

, z `notElem` ys]

-- 3ª solución (Pedro Martín)

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

ciclos3 :: Grafo Int Int -> [[Int]]

ciclos3 g = concat [aux [n] (adyacentes g n) | n <- nodos g] where

aux _ [] = []

aux xs (y:ys)

| notElem y xs = aux (xs ++ [y]) (adyacentes g y) ++ aux xs ys

| y == head xs = (xs ++ [y]) : aux xs ys

| otherwise = aux xs ys

-- 4ª solución (Chema Cortés)

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

ciclos4 :: Grafo Int Int -> [[Int]]

ciclos4 g = concat [ caminos a a [] | a <- nodos g ] where

-- caminos posibles de b hasta a, sin pasar dos veces por un mismo nodo

caminos a b vs

| a == b && (not.null) vs = [[b]]

| otherwise = [ b:xs | c <- adyacentes g b

, c `notElem` vs

, xs <- caminos a c (c:vs)]

-- Comparación de eficiencia

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

-- ghci> let ejemplo n = creaGrafo D (1,n) ((n,1,0) : [(i,i+1,0) | i <- [1..n-1]])

-- ghci> length (ciclos1 (ejemplo 9))

-- 9

-- (4.92 secs, 1371229152 bytes)

-- ghci> length (ciclos2 (ejemplo 9))

-- 9

-- (0.01 secs, 2577736 bytes)

-- ghci> length (ciclos3 (ejemplo 9))

-- 9

-- (0.01 secs, 1038932 bytes)

-- ghci> length (ciclos4 (ejemplo 9))

-- 9

-- (0.01 secs, 2589288 bytes)

-- ghci> length (ciclos2 (ejemplo 400))

-- 400

-- (11.74 secs, 5148997000 bytes)

-- ghci> length (ciclos3 (ejemplo 400))

-- 400

-- (4.99 secs, 936520100 bytes)

-- ghci> length (ciclos4 (ejemplo 400))

-- 400

-- (1.56 secs, 66701772 bytes)

Números alternados

PorJosé A. Alonso 15-mayo-201513-junio-2015

Decimos que un número es alternado si no tiene dos cifras consecutivas iguales ni tres cifras consecutivas en orden creciente no estricto o decreciente no estricto. Por ejemplo, los números 132425 y 92745 son alternados, pero los números 12325 y 29778 no. Las tres primeras cifras de 12325 están en orden creciente y 29778 tiene dos cifras iguales consecutivas.

Definir la constante

   alternados :: [Integer]

1	alternados :: [Integer]

cuyo valor es la lista infinita de los números alternados. Por ejemplo,

   take 10 alternados                      ==  [0,1,2,3,4,5,6,7,8,9]
   length (takeWhile (< 1000) alternados)  ==  616
   alternados !! 1234567                   ==  19390804

take 10 alternados == [0,1,2,3,4,5,6,7,8,9]

length (takeWhile (< 1000) alternados) == 616

alternados !! 1234567 == 19390804

Soluciones

import Data.Char (digitToInt)

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

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

-- (cifrasAlternadas xs) se verifica si las lista de cifras xs es
-- alternada. Por ejemplo,
--    cifrasAlternadas [1,3,2,4,2,5]  ==  True
--    cifrasAlternadas [9,2,7,4,5]    ==  True
--    cifrasAlternadas [1,2,3,2,5]    ==  False
--    cifrasAlternadas [2,9,7,7,8]    ==  False
cifrasAlternadas :: [Int] -> Bool
cifrasAlternadas [x1,x2] = x1 /= x2
cifrasAlternadas (x1:x2:x3:xs) =
    not (((x1 <= x2) && (x2 <= x3)) || ((x1 >= x2) && (x2 >= x3))) &&
    cifrasAlternadas (x2:x3:xs)
cifrasAlternadas _ = True

-- (alternado n) se verifica si n es un número alternado. Por ejemplo,
--    alternado 132425  ==  True
--    alternado 92745   ==  True
--    alternado 12325   ==  False
--    alternado 29778   ==  False
alternado :: Integer -> Bool
alternado n = cifrasAlternadas (cifras n)

alternados1 :: [Integer]
alternados1 = filter alternado [0..]

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

-- (extiendeAlternado n) es la lista de números alternados que se pueden
-- obtener añadiendo una cifra al final del número alternado n. Por
-- ejemplo,
--    extiendeAlternado 7   ==  [70,71,72,73,74,75,76,78,79]
--    extiendeAlternado 24  ==  [240,241,242,243]
--    extiendeAlternado 42  ==  [423,424,425,426,427,428,429]
extiendeAlternado :: Integer -> [Integer]
extiendeAlternado n 
    | n < 10    = [n*10+h | h <- [0..n-1]++[n+1..9]]
    | d < c     = [n*10+h | h <- [0..c-1]]
    | otherwise = [n*10+h | h <- [c+1..9]]
    where c = n `mod` 10
          d = (n `mod` 100) `div` 10

alternados2 :: [Integer]
alternados2 = concat (iterate (concatMap extiendeAlternado) [0])

import Data.Char (digitToInt)

-- 1ª definición

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

-- (cifras n) es la lista de las cifras de n. Por ejemplo.

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

cifras :: Integer -> [Int]

cifras n = map digitToInt (show n)

-- (cifrasAlternadas xs) se verifica si las lista de cifras xs es

-- alternada. Por ejemplo,

-- cifrasAlternadas [1,3,2,4,2,5] == True

-- cifrasAlternadas [9,2,7,4,5] == True

-- cifrasAlternadas [1,2,3,2,5] == False

-- cifrasAlternadas [2,9,7,7,8] == False

cifrasAlternadas :: [Int] -> Bool

cifrasAlternadas [x1,x2] = x1 /= x2

cifrasAlternadas (x1:x2:x3:xs) =

not (((x1 <= x2) && (x2 <= x3)) || ((x1 >= x2) && (x2 >= x3))) &&

cifrasAlternadas (x2:x3:xs)

cifrasAlternadas _ = True

-- (alternado n) se verifica si n es un número alternado. Por ejemplo,

-- alternado 132425 == True

-- alternado 92745 == True

-- alternado 12325 == False

-- alternado 29778 == False

alternado :: Integer -> Bool

alternado n = cifrasAlternadas (cifras n)

alternados1 :: [Integer]

alternados1 = filter alternado [0..]

-- 2ª definición

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

-- (extiendeAlternado n) es la lista de números alternados que se pueden

-- obtener añadiendo una cifra al final del número alternado n. Por

-- ejemplo,

-- extiendeAlternado 7 == [70,71,72,73,74,75,76,78,79]

-- extiendeAlternado 24 == [240,241,242,243]

-- extiendeAlternado 42 == [423,424,425,426,427,428,429]

extiendeAlternado :: Integer -> [Integer]

extiendeAlternado n

| n < 10 = [n*10+h | h <- [0..n-1]++[n+1..9]]

| d < c = [n*10+h | h <- [0..c-1]]

| otherwise = [n*10+h | h <- [c+1..9]]

where c = n `mod` 10

d = (n `mod` 100) `div` 10

alternados2 :: [Integer]

alternados2 = concat (iterate (concatMap extiendeAlternado) [0])

Visibilidad de listas y matrices

PorJosé A. Alonso 14-mayo-201513-junio-2015

La visibilidad de una lista es el número de elementos que son estrictamente mayores que todos los anteriores. Por ejemplo, la visibilidad de la lista [1,2,5,2,3,6] es 4.

La visibilidad de una matriz P es el par formado por las visibilidades de las filas de P y las visibilidades de las columnas de P. Por ejemplo, dada la matriz

       ( 4 2 1 )
   Q = ( 3 2 5 )
       ( 6 1 8 )

( 4 2 1 )

Q = ( 3 2 5 )

( 6 1 8 )

la visibilidad de Q es ([1,2,2],[2,1,3]).

Definir las funciones

   visibilidadLista  :: [Int] -> Int
   visibilidadMatriz :: Matrix Int -> ([Int],[Int])

1 2	visibilidadLista :: [Int] -> Int visibilidadMatriz :: Matrix Int -> ([Int],[Int])

tales que

(visibilidadLista xs) es la visibilidad de la lista xs. Por ejemplo,

     visibilidadLista [1,2,5,2,3,6]   ==  4
     visibilidadLista [0,-2,5,1,6,6]  ==  3

1 2	visibilidadLista [1,2,5,2,3,6] == 4 visibilidadLista [0,-2,5,1,6,6] == 3

(visibilidadMatriz p) es la visibilidad de la matriz p. Por ejemplo,

     ghci> visibilidadMatriz (fromLists [[4,2,1],[3,2,5],[6,1,8]])
     ([1,2,2],[2,1,3])
     ghci> visibilidadMatriz (fromLists [[0,2,1],[0,2,5],[6,1,8]])
     ([2,3,2],[2,1,3])

ghci> visibilidadMatriz (fromLists [[4,2,1],[3,2,5],[6,1,8]])

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

ghci> visibilidadMatriz (fromLists [[0,2,1],[0,2,5],[6,1,8]])

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

Soluciones

import Data.List (inits)
import Data.Matrix (Matrix, (!), nrows, ncols, fromLists)

visibilidadLista :: [Int] -> Int
visibilidadLista xs =
    length [x | (ys,x) <- zip (inits xs) xs, all (<x) ys]

visibilidadMatriz :: Matrix Int -> ([Int],[Int])
visibilidadMatriz p =
    ([visibilidadLista [p ! (i,j) | j <- [1..n]] | i <- [1..m]],
     [visibilidadLista [p ! (i,j) | i <- [1..m]] | j <- [1..n]])
     where m = nrows p
           n = ncols p

import Data.List (inits)

import Data.Matrix (Matrix, (!), nrows, ncols, fromLists)

visibilidadLista :: [Int] -> Int

visibilidadLista xs =

length [x | (ys,x) <- zip (inits xs) xs, all (<x) ys]

visibilidadMatriz :: Matrix Int -> ([Int],[Int])

visibilidadMatriz p =

([visibilidadLista [p ! (i,j) | j <- [1..n]] | i <- [1..m]],

[visibilidadLista [p ! (i,j) | i <- [1..m]] | j <- [1..n]])

where m = nrows p

n = ncols p

Reconocimiento de camino en un grafo

PorJosé A. Alonso 13-mayo-201526-marzo-2022

Dado un grafo no dirigido G, un camino en G es una secuencia de nodos [v(1),v(2),v(3),…,v(n)] tal que para todo i entre 1 y n-1, (v(i),v(i+1)) es una arista de G. Por ejemplo, dados los grafos

   g1, g2 :: Grafo Int Int
   g1 = creaGrafo ND (1,3) [(1,2,0),(1,3,0),(2,3,0)]
   g2 = creaGrafo ND (1,4) [(1,2,0),(1,3,0),(1,4,0),(2,4,0),(3,4,0)]

g1, g2 :: Grafo Int Int

g1 = creaGrafo ND (1,3) [(1,2,0),(1,3,0),(2,3,0)]

g2 = creaGrafo ND (1,4) [(1,2,0),(1,3,0),(1,4,0),(2,4,0),(3,4,0)]

la lista [1,2,3] es un camino en g1, pero no es un camino en g2 puesto que la arista (2,3) no existe en g2.

Definir la función

   camino :: Grafo Int Int -> [Int] -> Bool

1	camino :: Grafo Int Int -> [Int] -> Bool

tal que (camino g vs) se verifica si la lista de nodos vs es un camino en el grafo g. Por ejemplo,

   camino g1 [1,2,3]  ==  True
   camino g2 [1,2,3]  ==  False

1 2	camino g1 [1,2,3] == True camino g2 [1,2,3] == False

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

Soluciones

import I1M.Grafo 
camino :: Grafo Int Int -> [Int] -> Bool
camino g vs = all (aristaEn g) (zip vs (tail vs))

import I1M.Grafo

camino :: Grafo Int Int -> [Int] -> Bool

camino g vs = all (aristaEn g) (zip vs (tail vs))

El teorema de Midy

PorJosé A. Alonso 12-mayo-201513-junio-2015

El ejercicio de hoy, propuesto por Antonio García Blázquez, tiene como objetivo comprobar la veracidad del Teorema de Midy, este teorema dice:

Sea a/p una fracción, donde a < p y p > 5 es un número primo. Si esta fracción tiene una expansión decimal periódica, donde la cantidad de dígitos en el período es par, entonces podemos partir el período en dos mitades, cuya suma es un número formado únicamente por nueves.

Por ejemplo, 2/7 = 0’285714285714… El período es 285714, cuya longitud es par (6). Lo partimos por la mitad y las sumamos: 285+714 = 999.

Definir la función

   teoremaMidy :: Integer -> Bool

1	teoremaMidy :: Integer -> Bool

tal que (teoremaMidy n) se verifica si para todo todo número primo p menor que n y mayor que 5 y todo número natural a menor que p tales que la cantidad de dígitos en el período de a/p es par, entonces podemos partir el período de a/p en dos mitades, cuya suma es un número formado únicamente por nueves. Por ejemplo,

   teoremaMidy 200  ==  True

1	teoremaMidy 200 == True

Además, comprobar el teorema de Midy usando QuickCheck.

Soluciones

import Data.List (genericTake)
import Data.Numbers.Primes (primes, isPrime)
import Test.QuickCheck

teoremaMidy :: Integer -> Bool
teoremaMidy n = 
    all conclusionMidy [(a,p) | p <- takeWhile (<n) (drop 3 primes),
                                a <- [1..p-1],
                                tienePeriodoDeLongitudPar (a,p)]

-- (tienePeriodoDeLongitudPar (a,p)) se verifica si el período de a/p
-- (con p un primo mayor que 5 y que a) es de longitud par. Por ejemplo,  
--    tienePeriodoDeLongitudPar (1,7)   ==  True
--    tienePeriodoDeLongitudPar (1,37)  ==  False
tienePeriodoDeLongitudPar :: (Integer,Integer) -> Bool
tienePeriodoDeLongitudPar (a,p) =
    even (longitudPeriodo p)

-- (expansionDec (a,p)) es la expansión decimal de a/p. Por ejemplo, 
--    take 10 (expansionDec (1,4))    ==  [0,2,5]
--    take 10 (expansionDec (1,7))    ==  [0,1,4,2,8,5,7,1,4,2]
--    take 12 (expansionDec (90,7))   ==  [12,8,5,7,1,4,2,8,5,7,1,4]
--    take 12 (expansionDec (23,14))  ==  [1,6,4,2,8,5,7,1,4,2,8,5]
expansionDec :: (Integer,Integer) -> [Integer]
expansionDec (x,y) 
    | r == 0    = [q] 
    | otherwise = q : expansionDec (r*10,y)
    where (q,r) = quotRem x y

-- (longitudPeriodo p) es la longitud del período de 1/p (y de
-- cualquier fracción irreducible de denominador p), donde p es un
-- número primo mayor que 5. Por ejemplo, 
--    longitudPeriodo 7   ==  6
--    longitudPeriodo 37  ==  3
--    longitudPeriodo 83  ==  41
longitudPeriodo :: Integer -> Integer
longitudPeriodo p = head [k | k <- [1..], 10^k `mod` p == 1]

-- (periodo (a,p)) es el período de a/b (para a < p y p > 5 es primo). 
-- Por ejemplo, 
--    periodo (1,7)   ==  [1,4,2,8,5,7]
--    periodo (2,7)   ==  [2,8,5,7,1,4]
--    periodo (6,7)   ==  [8,5,7,1,4,2]
--    periodo (1,73)  ==  [0,1,3,6,9,8,6,3]
periodo :: (Integer,Integer) -> [Integer]
periodo (a,p) = genericTake t xs
    where (_:xs) = expansionDec (a,p)
          t      = longitudPeriodo p

-- (conclusionMidy (a,p)) se verifica si a/p verifica la conclusión del
-- teorema de Midy; es decir, podemos partir el período de a/p en dos
-- mitades, cuya suma es un número formado únicamente por nueves. Por
-- ejemplo,  
--    conclusionMidy (1,7)   ==  True
--    conclusionMidy (1,37)  ==  False
conclusionMidy :: (Integer,Integer) -> Bool
conclusionMidy (a,p) = 
    all (==9) (zipWith (+) ys zs)
    where xs      = periodo (a,p)
          (ys,zs) = splitAt (length xs `div` 2) xs

-- ---------------------------------------------------------------------
-- § Comprobación con QuickCheck                                      --
-- ---------------------------------------------------------------------

-- (condicionMidy (a,p)) se verifica si a/p cumple las condiciones del
-- teorema de Midy. Por ejemplo,
--    condicionMidy (1,7)   ==  True
--    condicionMidy (1,37)  ==  False
condicionMidy :: (Integer,Integer) -> Bool
condicionMidy (a,p) = 
    a > 0 && 
    a < p && 
    isPrime p && 
    p > 5 && 
    tienePeriodoDeLongitudPar (a,p)

-- La propiedad es 
prop_teoremaMidy :: (Integer,Integer) -> Property
prop_teoremaMidy (a,p) = 
    condicionMidy (a,p) ==> conclusionMidy (a,p)

-- La comprobación es 
--    ghci> quickCheck prop_teoremaMidy
--    *** Gave up! Passed only 24 tests.

-- En la comprobación se observa que la mayoría de los ejemplos
-- generados no cumplen la condición del teorema de Midy y sólo 24 de
-- ellos la cumplen y también la conclusión. 

-- Para aumentar el número de casos en lo que se cumpla la condición, se
-- puede aumentar el valor de maxSuccess; por ejemplo,   
--    ghci> quickCheckWith (stdArgs {maxSuccess=700}) prop_teoremaMidy
--    *** Gave up! Passed only 137 tests.

-- Otra forma de conseguirlo es definir un generador de números de Midy
-- (es decir, de pares (a,p) que cumplan la condición del teorema de
-- Midy). Por ejemplo, 
--    ghci> sample numeroMidy
--    (15,19)
--    (5,7)
--    (1,23)
--    (7,11)
numeroMidy :: Gen (Integer,Integer)
numeroMidy = suchThat arbitrary condicionMidy

-- La propiedad es
prop_teoremaMidy2 :: Property
prop_teoremaMidy2 = forAll numeroMidy conclusionMidy

-- La comprobación es
--    ghci> quickCheck prop_teoremaMidy2
--    +++ OK, passed 100 tests.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

import Data.List (genericTake)

import Data.Numbers.Primes (primes, isPrime)

import Test.QuickCheck

teoremaMidy :: Integer -> Bool

teoremaMidy n =

all conclusionMidy [(a,p) | p <- takeWhile (<n) (drop 3 primes),

a <- [1..p-1],

tienePeriodoDeLongitudPar (a,p)]

-- (tienePeriodoDeLongitudPar (a,p)) se verifica si el período de a/p

-- (con p un primo mayor que 5 y que a) es de longitud par. Por ejemplo,

-- tienePeriodoDeLongitudPar (1,7) == True

-- tienePeriodoDeLongitudPar (1,37) == False

tienePeriodoDeLongitudPar :: (Integer,Integer) -> Bool

tienePeriodoDeLongitudPar (a,p) =

even (longitudPeriodo p)

-- (expansionDec (a,p)) es la expansión decimal de a/p. Por ejemplo,

-- take 10 (expansionDec (1,4)) == [0,2,5]

-- take 10 (expansionDec (1,7)) == [0,1,4,2,8,5,7,1,4,2]

-- take 12 (expansionDec (90,7)) == [12,8,5,7,1,4,2,8,5,7,1,4]

-- take 12 (expansionDec (23,14)) == [1,6,4,2,8,5,7,1,4,2,8,5]

expansionDec :: (Integer,Integer) -> [Integer]

expansionDec (x,y)

| r == 0 = [q]

| otherwise = q : expansionDec (r*10,y)

where (q,r) = quotRem x y

-- (longitudPeriodo p) es la longitud del período de 1/p (y de

-- cualquier fracción irreducible de denominador p), donde p es un

-- número primo mayor que 5. Por ejemplo,

-- longitudPeriodo 7 == 6

-- longitudPeriodo 37 == 3

-- longitudPeriodo 83 == 41

longitudPeriodo :: Integer -> Integer

longitudPeriodo p = head [k | k <- [1..], 10^k `mod` p == 1]

-- (periodo (a,p)) es el período de a/b (para a < p y p > 5 es primo).

-- Por ejemplo,

-- periodo (1,7) == [1,4,2,8,5,7]

-- periodo (2,7) == [2,8,5,7,1,4]

-- periodo (6,7) == [8,5,7,1,4,2]

-- periodo (1,73) == [0,1,3,6,9,8,6,3]

periodo :: (Integer,Integer) -> [Integer]

periodo (a,p) = genericTake t xs

where (_:xs) = expansionDec (a,p)

t = longitudPeriodo p

-- (conclusionMidy (a,p)) se verifica si a/p verifica la conclusión del

-- teorema de Midy; es decir, podemos partir el período de a/p en dos

-- mitades, cuya suma es un número formado únicamente por nueves. Por

-- ejemplo,

-- conclusionMidy (1,7) == True

-- conclusionMidy (1,37) == False

conclusionMidy :: (Integer,Integer) -> Bool

conclusionMidy (a,p) =

all (==9) (zipWith (+) ys zs)

where xs = periodo (a,p)

(ys,zs) = splitAt (length xs `div` 2) xs

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

-- § Comprobación con QuickCheck --

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

-- (condicionMidy (a,p)) se verifica si a/p cumple las condiciones del

-- teorema de Midy. Por ejemplo,

-- condicionMidy (1,7) == True

-- condicionMidy (1,37) == False

condicionMidy :: (Integer,Integer) -> Bool

condicionMidy (a,p) =

a > 0 &&

a < p &&

isPrime p &&

p > 5 &&

tienePeriodoDeLongitudPar (a,p)

-- La propiedad es

prop_teoremaMidy :: (Integer,Integer) -> Property

prop_teoremaMidy (a,p) =

condicionMidy (a,p) ==> conclusionMidy (a,p)

-- La comprobación es

-- ghci> quickCheck prop_teoremaMidy

-- *** Gave up! Passed only 24 tests.

-- En la comprobación se observa que la mayoría de los ejemplos

-- generados no cumplen la condición del teorema de Midy y sólo 24 de

-- ellos la cumplen y también la conclusión.

-- Para aumentar el número de casos en lo que se cumpla la condición, se

-- puede aumentar el valor de maxSuccess; por ejemplo,

-- ghci> quickCheckWith (stdArgs {maxSuccess=700}) prop_teoremaMidy

-- *** Gave up! Passed only 137 tests.

-- Otra forma de conseguirlo es definir un generador de números de Midy

-- (es decir, de pares (a,p) que cumplan la condición del teorema de

-- Midy). Por ejemplo,

-- ghci> sample numeroMidy

-- (15,19)

-- (5,7)

-- (1,23)

-- (7,11)

numeroMidy :: Gen (Integer,Integer)

numeroMidy = suchThat arbitrary condicionMidy

-- La propiedad es

prop_teoremaMidy2 :: Property

prop_teoremaMidy2 = forAll numeroMidy conclusionMidy

-- La comprobación es

-- ghci> quickCheck prop_teoremaMidy2

-- +++ OK, passed 100 tests.

Ciclos de un grafo

Soluciones

Números alternados

Soluciones

Visibilidad de listas y matrices

Soluciones

Reconocimiento de camino en un grafo

Soluciones

El teorema de Midy

Soluciones

Entradas recientes

Buscar

Correo electrónico