José A. Alonso

Repeticiones consecutivas

PorJosé A. Alonso 17-marzo-202024-marzo-2020

Se dice que una palabra tiene una repetición en una frase si es igual a una, o más, de las palabras consecutivas sin distinguir mayúsculas de minúsculas.

Definir la función

   nRepeticionesConsecutivas :: String ->Int

1	nRepeticionesConsecutivas :: String ->Int

tal que (nRepeticionesConsecutivas cs) es el número de repeticiones de palabras consecutivas de la cadena cs. Por ejemplo,

   nRepeticionesConsecutivas "oso rana"                    == 0      
   nRepeticionesConsecutivas "oso rana oso"                == 0
   nRepeticionesConsecutivas "oso oSo rana"                == 1
   nRepeticionesConsecutivas "oso oso oso rana"            == 1
   nRepeticionesConsecutivas "coronavirus virus oso rana"  == 0
   nRepeticionesConsecutivas "virus     virus oso rana"    == 1
   nRepeticionesConsecutivas "virus oso virus oso rana"    == 0
   nRepeticionesConsecutivas "oso oso oso oso oso oso"     == 1
   nRepeticionesConsecutivas "oso oso oso oso rana rana"   == 2
   nRepeticionesConsecutivas "rana rana oso oso rana rana" == 3

nRepeticionesConsecutivas "oso rana" == 0

nRepeticionesConsecutivas "oso rana oso" == 0

nRepeticionesConsecutivas "oso oSo rana" == 1

nRepeticionesConsecutivas "oso oso oso rana" == 1

nRepeticionesConsecutivas "coronavirus virus oso rana" == 0

nRepeticionesConsecutivas "virus virus oso rana" == 1

nRepeticionesConsecutivas "virus oso virus oso rana" == 0

nRepeticionesConsecutivas "oso oso oso oso oso oso" == 1

nRepeticionesConsecutivas "oso oso oso oso rana rana" == 2

nRepeticionesConsecutivas "rana rana oso oso rana rana" == 3

Soluciones

import Data.List (group)
import Data.Char (toUpper)

-- 1ª solución
nRepeticionesConsecutivas :: String ->Int
nRepeticionesConsecutivas = aux . words . map toUpper 
  where aux (x:y:zs) | x == y    = 1 + aux (dropWhile (== x) zs)
                     | otherwise = aux (y:zs)
        aux _ = 0

-- 2ª solución
nRepeticionesConsecutivas2 :: String ->Int
nRepeticionesConsecutivas2 cs =
  length [xs | xs <- group (words (map toUpper cs)), length xs > 1]

-- 3ª solución
nRepeticionesConsecutivas3 :: String ->Int
nRepeticionesConsecutivas3 =
  length . filter ((>1) . length) . group . words . map toUpper

import Data.List (group)

import Data.Char (toUpper)

-- 1ª solución

nRepeticionesConsecutivas :: String ->Int

nRepeticionesConsecutivas = aux . words . map toUpper

where aux (x:y:zs) | x == y = 1 + aux (dropWhile (== x) zs)

| otherwise = aux (y:zs)

aux _ = 0

-- 2ª solución

nRepeticionesConsecutivas2 :: String ->Int

nRepeticionesConsecutivas2 cs =

length [xs | xs <- group (words (map toUpper cs)), length xs > 1]

-- 3ª solución

nRepeticionesConsecutivas3 :: String ->Int

nRepeticionesConsecutivas3 =

length . filter ((>1) . length) . group . words . map toUpper

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Pensamiento

«En el campo de la computación, el momento de la verdad es la ejecución de un programa; todo lo demás es profecía.»

Herbert A. Simon.

Medias de dígitos de pi

PorJosé A. Alonso 16-marzo-202023-marzo-2020

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 las funciones

   mediasDigitosDePi        :: IO [Double]
   graficaMediasDigitosDePi :: Int -> IO ()

1 2	mediasDigitosDePi :: IO [Double] graficaMediasDigitosDePi :: Int -> IO ()

tales que

mediasDigitosDePi es la sucesión cuyo n-ésimo elemento es la media de los n primeros dígitos de pi. Por ejemplo,

     λ> xs <- mediasDigitosDePi
     λ> take 5 xs
     [1.0,2.5,2.0,2.75,4.0]
     λ> take 10 xs
     [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]
     λ> take 10 <$> mediasDigitosDePi
     [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

λ> xs <- mediasDigitosDePi

λ> take 5 xs

[1.0,2.5,2.0,2.75,4.0]

λ> take 10 xs

[1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

λ> take 10 <$> mediasDigitosDePi

[1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

(graficaMediasDigitosDePi n) dibuja la gráfica de los n primeros términos de mediasDigitosDePi. Por ejemplo,
- (graficaMediasDigitosDePi 20) dibuja
- (graficaMediasDigitosDePi 200) dibuja
- (graficaMediasDigitosDePi 2000) dibuja

Soluciones

import Data.Char (digitToInt)
import Data.List (genericLength, inits, tails)
import Graphics.Gnuplot.Simple ( Attribute (Key, PNG)
                               , plotList )

-- Definición de mediasDigitosDePi
-- ===============================

mediasDigitosDePi :: IO [Double]
mediasDigitosDePi = do
  (_:_:ds) <- readFile "Digitos_de_pi.txt"
  return (medias (digitos ds))

-- (digitos cs) es la lista de los digitos de cs. Por ejempplo,
--    digitos "1415926535"  ==  [1,4,1,5,9,2,6,5,3,5]
digitos :: String -> [Int]
digitos = map digitToInt

-- (medias xs) es la lista de las medias de los segmentos iniciales de
-- xs. Por ejemplo,
--    λ> medias [1,4,1,5,9,2,6,5,3,5]
--    [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]
medias :: [Int] -> [Double]
medias xs = map media (tail (inits xs))

-- (media xs) es la media aritmética de xs. Por ejemplo,
--    media [1,4,1,5,9]  ==  4.0
media :: [Int] -> Double
media xs = fromIntegral (sum xs) / genericLength xs

-- Definición de graficaMediasDigitosDePi
-- ======================================

graficaMediasDigitosDePi :: Int -> IO ()
graficaMediasDigitosDePi n = do
  xs <- mediasDigitosDePi
  plotList [ Key Nothing
           , PNG ("Medias_de_digitos_de_pi_" ++ show n ++ ".png")
           ]
           (take n xs)

import Data.Char (digitToInt)

import Data.List (genericLength, inits, tails)

import Graphics.Gnuplot.Simple ( Attribute (Key, PNG)

, plotList )

-- Definición de mediasDigitosDePi

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

mediasDigitosDePi :: IO [Double]

mediasDigitosDePi = do

(_:_:ds) <- readFile "Digitos_de_pi.txt"

return (medias (digitos ds))

-- (digitos cs) es la lista de los digitos de cs. Por ejempplo,

-- digitos "1415926535" == [1,4,1,5,9,2,6,5,3,5]

digitos :: String -> [Int]

digitos = map digitToInt

-- (medias xs) es la lista de las medias de los segmentos iniciales de

-- xs. Por ejemplo,

-- λ> medias [1,4,1,5,9,2,6,5,3,5]

-- [1.0,2.5,2.0,2.75,4.0,3.6666666666666665,4.0,4.125,4.0,4.1]

medias :: [Int] -> [Double]

medias xs = map media (tail (inits xs))

-- (media xs) es la media aritmética de xs. Por ejemplo,

-- media [1,4,1,5,9] == 4.0

media :: [Int] -> Double

media xs = fromIntegral (sum xs) / genericLength xs

-- Definición de graficaMediasDigitosDePi

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

graficaMediasDigitosDePi :: Int -> IO ()

graficaMediasDigitosDePi n = do

xs <- mediasDigitosDePi

plotList [ Key Nothing

, PNG ("Medias_de_digitos_de_pi_" ++ show n ++ ".png")

]

(take n xs)

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Pensamiento

Es el mejor de los buenos
quien sabe que en esta vida
todo es cuestión de medida:
un poco más, algo menos.

Antonio Machado

Cálculo de pi mediante la serie de Nilakantha

PorJosé A. Alonso 12-marzo-202025-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"

División de cadenas

PorJosé A. Alonso 11-marzo-202018-marzo-2020

Definir la función

   division :: String -> [String]

1	division :: String -> [String]

tal que (division cs) es la lista de las palabras formadas por dos elementos consecutivos de cs y, en el caso de que la longitud de cs sea impar, el último elemento de la última palabra es el carácter de subrayado. Por ejemplo,

   division "pandemia"    ==  ["pa","nd","em","ia"]
   division "covid2019"   ==  ["co","vi","d2","01","9_"]
   division "covid 2019"  ==  ["co","vi","d ","20","19"]

division "pandemia" == ["pa","nd","em","ia"]

division "covid2019" == ["co","vi","d2","01","9_"]

division "covid 2019" == ["co","vi","d ","20","19"]

Soluciones

import Data.List.Split

-- 1ª solución
division :: String -> [String]
division []       = []
division [x]      = [[x,'_']]
division (x:y:zs) = [x,y] : division zs

-- 2ª solución
division2 :: String -> [String]
division2 cs =
  [[ds!!i,ds!!(i+1)] | i <- [0,2.. length cs - 1]]
  where ds = cs ++ "_"

-- 3ª solución
division3 :: String -> [String]
division3 = takeWhile ((2 ==) . length) . chunksOf 2 . (++ "_")

-- 4ª solución
division4 :: String -> [String]
division4 = init . chunksOf 2 . (++ "_")

import Data.List.Split

-- 1ª solución

division :: String -> [String]

division [] = []

division [x] = [[x,'_']]

division (x:y:zs) = [x,y] : division zs

-- 2ª solución

division2 :: String -> [String]

division2 cs =

[[ds!!i,ds!!(i+1)] | i <- [0,2.. length cs - 1]]

where ds = cs ++ "_"

-- 3ª solución

division3 :: String -> [String]

division3 = takeWhile ((2 ==) . length) . chunksOf 2 . (++ "_")

-- 4ª solución

division4 :: String -> [String]

division4 = init . chunksOf 2 . (++ "_")

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Pensamiento

«Las matemáticas tienen un triple objetivo. Debe proporcionar un instrumento para el estudio de la naturaleza. Pero esto no es todo: tiene un objetivo filosófico y, me atrevo a decir, un objetivo estético.»

Henri Poincaré.

Inversión de palabras

PorJosé A. Alonso 10-marzo-202017-marzo-2020

Definir la función

   palabrasInvertidas :: String -> String

1	palabrasInvertidas :: String -> String

tal que (palabrasInvertidas cs) es la cadena obtenida invirtiendo las palabras de cs. Por ejemplo,

   λ> palabrasInvertidas "Del principio al final"
   "final al principio Del"
   λ> palabrasInvertidas "una a una"
   "una a una"

λ> palabrasInvertidas "Del principio al final"

"final al principio Del"

λ> palabrasInvertidas "una a una"

"una a una"

Soluciones

palabrasInvertidas :: String -> String
palabrasInvertidas = unwords . reverse . words

1 2	palabrasInvertidas :: String -> String palabrasInvertidas = unwords . reverse . words

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Pensamiento

«Las matemáticas son el arte de dar el mismo nombre a cosas diferentes.»

Henri Poincaré.

Primero no consecutivo

PorJosé A. Alonso 9-marzo-202026-marzo-2022

Definir la función

   primeroNoConsecutivo :: (Eq a,Enum a) => [a] -> Maybe a

1	primeroNoConsecutivo :: (Eq a,Enum a) => [a] -> Maybe a

tal que (primeroNoConsecutivo xs) es el primer elemento de la lista xs que no es igual al siguiente de su elemento anterior en xs o Nothing si tal elemento no existe. Por ejemplo

   primeroNoConsecutivo [1,2,3,4,6,7,8] == Just 6
   primeroNoConsecutivo "bcdfg"         == Just 'f'
   primeroNoConsecutivo "bcdef"         == Nothing

primeroNoConsecutivo [1,2,3,4,6,7,8] == Just 6

primeroNoConsecutivo "bcdfg" == Just 'f'

primeroNoConsecutivo "bcdef" == Nothing

Soluciones

import Data.Maybe (listToMaybe)

-- 1ª solución
primeroNoConsecutivo1 :: (Eq a, Enum a) => [a] -> Maybe a
primeroNoConsecutivo1 xs
  | null ys   = Nothing
  | otherwise = Just (head ys)
  where ys = [y | (z,y) <- zip xs (tail xs), y /= succ z]

-- 2ª solución
primeroNoConsecutivo2 :: (Eq a, Enum a) => [a] -> Maybe a
primeroNoConsecutivo2 xs = 
  listToMaybe [y | (z,y) <- zip xs (tail xs), y /= succ z]

-- 3ª solución
primeroNoConsecutivo3 :: (Eq a,Enum a) => [a] -> Maybe a
primeroNoConsecutivo3 (x:y:zs)
  | succ x /= y = Just y 
  | otherwise   = primeroNoConsecutivo3 (y:zs)
primeroNoConsecutivo3 _ = Nothing

-- 4ª solución
primeroNoConsecutivo :: (Eq a,Enum a) => [a] -> Maybe a
primeroNoConsecutivo [] = Nothing
primeroNoConsecutivo (x:ys) = aux x ys
  where aux _ [] = Nothing
        aux x' (z:zs) | z == succ x' = aux z zs
                      | otherwise    = Just z

import Data.Maybe (listToMaybe)

-- 1ª solución

primeroNoConsecutivo1 :: (Eq a, Enum a) => [a] -> Maybe a

primeroNoConsecutivo1 xs

| null ys = Nothing

| otherwise = Just (head ys)

where ys = [y | (z,y) <- zip xs (tail xs), y /= succ z]

-- 2ª solución

primeroNoConsecutivo2 :: (Eq a, Enum a) => [a] -> Maybe a

primeroNoConsecutivo2 xs =

listToMaybe [y | (z,y) <- zip xs (tail xs), y /= succ z]

-- 3ª solución

primeroNoConsecutivo3 :: (Eq a,Enum a) => [a] -> Maybe a

primeroNoConsecutivo3 (x:y:zs)

| succ x /= y = Just y

| otherwise = primeroNoConsecutivo3 (y:zs)

primeroNoConsecutivo3 _ = Nothing

-- 4ª solución

primeroNoConsecutivo :: (Eq a,Enum a) => [a] -> Maybe a

primeroNoConsecutivo [] = Nothing

primeroNoConsecutivo (x:ys) = aux x ys

where aux _ [] = Nothing

aux x' (z:zs) | z == succ x' = aux z zs

| otherwise = Just z

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Pensamiento

«La única enseñanza que un profesor puede dar, en mi opinión, es la de pensar delante de sus alumnos.»

Henri Lebesgue.

Producto de Fibonaccis consecutivos

PorJosé A. Alonso 6-marzo-202017-marzo-2020

Los números de Fibonacci son los números F(n) de la siguiente sucesión

   0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, ...

1	0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, ...

que comienza con 0 y 1 y los siguientes términos son las sumas de los dos anteriores.

Un número x es el producto de dos números de Fibonacci consecutivos si existe un n tal que

   F(n) * F(n+1) = x

1	F(n) * F(n+1) = x

y su prueba es (F(n),F(n+1),True). Por ejemplo, 714 es el producto de dos números de Fibonacci consecutivos ya que

F(8) = 21, F(9) = 34 y 714 = 21 * 34.

1	F(8) = 21, F(9) = 34 y 714 = 21 * 34.

Su prueba es (21, 34, True).

Un número x no es el producto de dos números de Fibonacci consecutivos si no existe un n tal que

   F(n) * F(n+1) = x

1	F(n) * F(n+1) = x

y su prueba es (F(m),F(m+1),False) donde m es el menor número tal que

   F(m) * F(m+1) > x

1	F(m) * F(m+1) > x

Por ejemplo, 800 no es el producto de dos números de Fibonacci consecutivos, ya que

 F(8) = 21, F(9) = 34, F(10) = 55 y 21 * 34 < 800 < 34 * 55.

1	F(8) = 21, F(9) = 34, F(10) = 55 y 21 * 34 < 800 < 34 * 55.

Su prueba es (34, 55, False),

Definir la función

   productoFib :: Integer -> (Integer, Integer, Bool)

1	productoFib :: Integer -> (Integer, Integer, Bool)

tal que (productoFib x) es la prueba de que es, o no es, el producto de dos números de Fibonacci consecutivos. Por ejemplo,

   productoFib 714  == (21,  34, True)
   productoFib 800  == (34,  55, False)
   productoFib 4895 == (55,  89, True)
   productoFib 5895 == (89, 144, False)

productoFib 714 == (21, 34, True)

productoFib 800 == (34, 55, False)

productoFib 4895 == (55, 89, True)

productoFib 5895 == (89, 144, False)

Soluciones

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

productoFib :: Integer -> (Integer, Integer, Bool)
productoFib n
  | c == n    = (a,b,True)
  | otherwise = (a,b,False)
  where (a,b,c) = head (dropWhile (\(x,y,z) -> z < n) productos) 

-- fibs es la sucesión de números de Fibonacci. Por ejemplo,
--    take 14 fibs  ==  [0,1,1,2,3,5,8,13,21,34,55,89,144,233]
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

-- productos es la lista de las ternas (a,b,c) tales que a y b son dos
-- números de Fibonacci consecutivos y c es su producto. Por ejemplo,
--    λ> take 7 productos
--    [(0,1,0),(1,1,1),(1,2,2),(2,3,6),(3,5,15),(5,8,40),(8,13,104)]
productos :: [(Integer,Integer,Integer)]
productos = [(x,y,x*y) | (x,y) <- zip fibs (tail fibs)] 

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

productoFib2 :: Integer -> (Integer, Integer, Bool)
productoFib2 n = aux 0 1 n
  where
    aux a b c
        | a * b >= c = (a, b, a * b == c)
        | otherwise  = aux b (a + b) c
           
-- 3ª solución
-- ===========

productoFib3 :: Integer -> (Integer, Integer, Bool)
productoFib3 x = aux 0 1
  where
    aux a b | a * b >= x = (a, b, x == a * b)
            | otherwise  = aux b (a + b)

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

-- La comparación es
--    λ> let (x,_,_) = productoFib (10^20000) in length (show x)
--    10000
--    (1.15 secs, 323,396,360 bytes)
--    λ> let (x,_,_) = productoFib2 (10^20000) in length (show x)
--    10000
--    (1.10 secs, 317,268,672 bytes)
--    λ> let (x,_,_) = productoFib3 (10^20000) in length (show x)
--    10000
--    (1.08 secs, 314,972,440 bytes)

-- 1ª solución

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

productoFib :: Integer -> (Integer, Integer, Bool)

productoFib n

| c == n = (a,b,True)

| otherwise = (a,b,False)

where (a,b,c) = head (dropWhile (\(x,y,z) -> z < n) productos)

-- fibs es la sucesión de números de Fibonacci. Por ejemplo,

-- take 14 fibs == [0,1,1,2,3,5,8,13,21,34,55,89,144,233]

fibs :: [Integer]

fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

-- productos es la lista de las ternas (a,b,c) tales que a y b son dos

-- números de Fibonacci consecutivos y c es su producto. Por ejemplo,

-- λ> take 7 productos

-- [(0,1,0),(1,1,1),(1,2,2),(2,3,6),(3,5,15),(5,8,40),(8,13,104)]

productos :: [(Integer,Integer,Integer)]

productos = [(x,y,x*y) | (x,y) <- zip fibs (tail fibs)]

-- 2ª solución

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

productoFib2 :: Integer -> (Integer, Integer, Bool)

productoFib2 n = aux 0 1 n

where

aux a b c

| a * b >= c = (a, b, a * b == c)

| otherwise = aux b (a + b) c

-- 3ª solución

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

productoFib3 :: Integer -> (Integer, Integer, Bool)

productoFib3 x = aux 0 1

where

aux a b | a * b >= x = (a, b, x == a * b)

| otherwise = aux b (a + b)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> let (x,_,_) = productoFib (10^20000) in length (show x)

-- 10000

-- (1.15 secs, 323,396,360 bytes)

-- λ> let (x,_,_) = productoFib2 (10^20000) in length (show x)

-- 10000

-- (1.10 secs, 317,268,672 bytes)

-- λ> let (x,_,_) = productoFib3 (10^20000) in length (show x)

-- 10000

-- (1.08 secs, 314,972,440 bytes)

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Pensamiento

«El placer que obtenemos de la música proviene de contar, pero contando inconscientemente. La música no es más que aritmética inconsciente.»

Gottfried Wilhelm Leibniz.

Ordenación pendular

PorJosé A. Alonso 5-marzo-202017-marzo-2020

La ordenación pendular de una lista xs es la lista obtenida organizando sus elementos de manera similar al movimiento de ida y vuelta de un péndulo; es decir,

El menor elemento de xs se coloca en el centro de la lista.
El siguiente elemento se coloca a la derecha del menor.
El siguiente elemento se coloca a la izquierda del menor y así sucesivamente, de una manera similar a la de un péndulo.

Por ejemplo, la ordenación pendular de [6,6,8,5,10] es [10,6,5,6,8].

Definir la función

   pendulo :: [Int] -> [Int]

1	pendulo :: [Int] -> [Int]

tal que (pendulo xs) es la ordenación pendular de xs. Por ejemplo,

   pendulo [6,6,8,5,10]                 == [10,6,5,6,8]
   pendulo [-9,-2,-10,-6]               == [-6,-10,-9,-2]
   pendulo [11,-16,-18,13,-11,-12,3,18] == [13,3,-12,-18,-16,-11,11,18]

pendulo [6,6,8,5,10] == [10,6,5,6,8]

pendulo [-9,-2,-10,-6] == [-6,-10,-9,-2]

pendulo [11,-16,-18,13,-11,-12,3,18] == [13,3,-12,-18,-16,-11,11,18]

Soluciones

import Data.List (sort)

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

pendulo :: [Int] -> [Int]
pendulo xs = reverse (impares ys) ++ y : pares ys
  where (y:ys) = sort xs

-- (pares xs) son los elementos de xs que ocupan posiciones pares.
pares :: [a] -> [a]
pares []     = []
pares (x:xs) = x : impares xs

-- (impares xs) son los elementos de xs que ocupan posiciones impares.
impares :: [a] -> [a]
impares []     = []
impares (_:xs) = pares xs

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

pendulo2 :: [Int] -> [Int]
pendulo2 xs = aux (sort xs) [] True
  where
    aux [] ys _         = ys
    aux (x:xs) ys True  = aux xs (x:ys) False 
    aux (x:xs) ys False = aux xs (ys ++ [x]) True

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

-- La comparación es
--    λ> length (pendulo [1..2*10^4])
--    20000
--    (0.03 secs, 6,501,896 bytes)
--    λ> length (pendulo2 [1..2*10^4])
--    20000
--    (2.37 secs, 8,596,479,096 bytes)

import Data.List (sort)

-- 1ª solución

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

pendulo :: [Int] -> [Int]

pendulo xs = reverse (impares ys) ++ y : pares ys

where (y:ys) = sort xs

-- (pares xs) son los elementos de xs que ocupan posiciones pares.

pares :: [a] -> [a]

pares [] = []

pares (x:xs) = x : impares xs

-- (impares xs) son los elementos de xs que ocupan posiciones impares.

impares :: [a] -> [a]

impares [] = []

impares (_:xs) = pares xs

-- 2ª solución

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

pendulo2 :: [Int] -> [Int]

pendulo2 xs = aux (sort xs) [] True

where

aux [] ys _ = ys

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

aux (x:xs) ys False = aux xs (ys ++ [x]) True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (pendulo [1..2*10^4])

-- 20000

-- (0.03 secs, 6,501,896 bytes)

-- λ> length (pendulo2 [1..2*10^4])

-- 20000

-- (2.37 secs, 8,596,479,096 bytes)

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Pensamiento

«La mejor obra del matemático es el arte, un arte altamente perfecto, tan audaz como los más secretos sueños de la imaginación, claro y límpido. El genio matemático y el genio artístico se tocan mutuamente.»

Gösta Mittag-Leffler.

Avistamientos de la pelota

PorJosé A. Alonso 4-marzo-202017-marzo-2020

Un niño está jugando con una pelota en el noveno piso de un edificio alto. La altura de este piso, h, es conocida. Deja caer la pelota por la ventana. La pelota rebota una r-ésima parte de su altura (por ejemplo, dos tercios de su altura). Su madre mira por una ventana a w metros del suelo (por ejemplo, a 1.5 metros). ¿Cuántas veces verá la madre a la pelota pasar frente a su ventana incluyendo cuando está cayendo y rebotando?

Se deben cumplir tres condiciones para que el experimento sea válido:

La altura «h» debe ser mayor que 0
El rebote «r» debe ser mayor que 0 y menor que 1
La altura de la ventana debe ser mayor que 0 y menor que h.

Definir la función

   numeroAvistamientos :: Double -> Double -> Double -> Integer

1	numeroAvistamientos :: Double -> Double -> Double -> Integer

tal que (numeroAvistamientos h r v) es el número de avistamientos de la pelota si se cumplen las tres condiciones anteriores y es -1 en caso contrario. Por ejemplo,

   numeroAvistamientos 3    0.66 1.5  ==  3
   numeroAvistamientos 30   0.66 1.5  ==  15
   numeroAvistamientos (-3) 0.66 1.5  ==  -1
   numeroAvistamientos 3    (-1) 1.5  ==  -1
   numeroAvistamientos 3    2    1.5  ==  -1
   numeroAvistamientos 3    0.5  (-1) ==  -1
   numeroAvistamientos 3    0.5  4    ==  -1

numeroAvistamientos 3 0.66 1.5 == 3

numeroAvistamientos 30 0.66 1.5 == 15

numeroAvistamientos (-3) 0.66 1.5 == -1

numeroAvistamientos 3 (-1) 1.5 == -1

numeroAvistamientos 3 2 1.5 == -1

numeroAvistamientos 3 0.5 (-1) == -1

numeroAvistamientos 3 0.5 4 == -1

Soluciones

import Data.List (genericLength)

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

numeroAvistamientos :: Double -> Double -> Double -> Integer
numeroAvistamientos h r v
  | adecuados h r v = 2 * n - 1 
  | otherwise      = -1
  where n = genericLength (takeWhile (>=v) (iterate (*r) h))

-- (adecuados h r v) se verifica si los datos cumplen las condiciones
-- para que el experimento sea válido.
adecuados :: Double -> Double -> Double -> Bool
adecuados h r v =
  h > 0 && 0 < r && r < 1 && 0 < v && v < h

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

numeroAvistamientos2 :: Double -> Double -> Double -> Integer
numeroAvistamientos2 h r v 
  | adecuados h r v = 2 + numeroAvistamientos2 (h * r) r v
  | otherwise       = -1

-- 3ª solución
numeroAvistamientos3 :: Double -> Double -> Double -> Integer
numeroAvistamientos3 h r v
  | adecuados h r v = 1 + 2 * floor (logBase r (v / h))
  | otherwise       = -1

import Data.List (genericLength)

-- 1ª solución

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

numeroAvistamientos :: Double -> Double -> Double -> Integer

numeroAvistamientos h r v

| adecuados h r v = 2 * n - 1

| otherwise = -1

where n = genericLength (takeWhile (>=v) (iterate (*r) h))

-- (adecuados h r v) se verifica si los datos cumplen las condiciones

-- para que el experimento sea válido.

adecuados :: Double -> Double -> Double -> Bool

adecuados h r v =

h > 0 && 0 < r && r < 1 && 0 < v && v < h

-- 2ª solución

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

numeroAvistamientos2 :: Double -> Double -> Double -> Integer

numeroAvistamientos2 h r v

| adecuados h r v = 2 + numeroAvistamientos2 (h * r) r v

| otherwise = -1

-- 3ª solución

numeroAvistamientos3 :: Double -> Double -> Double -> Integer

numeroAvistamientos3 h r v

| adecuados h r v = 1 + 2 * floor (logBase r (v / h))

| otherwise = -1

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Pensamiento

«Los patrones del matemático, como los del pintor o el poeta deben ser hermosos; las ideas, como los colores o las palabras deben encajar de manera armoniosa. La belleza es la primera prueba: no hay lugar permanente en este mundo para las matemáticas feas.»

G. H. Hardy.

Mayor equidigital

PorJosé A. Alonso 3-marzo-202010-marzo-2020

Definir la función

   mayorEquidigital :: Integer -> Integer

1	mayorEquidigital :: Integer -> Integer

tal que (mayorEquidigital n) es el mayor número que se puede formar con los dígitos de n. Por ejemplo,

   mayorEquidigital 325271  ==  753221

1	mayorEquidigital 325271 == 753221

Soluciones

import Data.List (sort)

mayorEquidigital :: Integer -> Integer
mayorEquidigital = read . reverse . sort . show

import Data.List (sort)

mayorEquidigital :: Integer -> Integer

mayorEquidigital = read . reverse . sort . show

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Pensamiento

«Un matemático, como un pintor o un poeta, es un creador de patrones. Si sus patrones son más permanentes que los de ellos, es porque están hechos con ideas.»

G. H. Hardy.

Pandemia

PorJosé A. Alonso 2-marzo-20209-marzo-2020

¡El mundo está en cuarentena! Hay una nueva pandemia que lucha contra la humanidad. Cada continente está aislado de los demás, pero las personas infectadas se han propagado antes de la advertencia.

En este problema se representará el mundo por una cadena como la siguiente

   "01000000X000X011X0X"

1	"01000000X000X011X0X"

donde 0 representa no infectado, 1 representa infectado y X representa un océano

Las reglas de propagación son:

El virus no puede propagarse al otro lado de un océano.
Si una persona se infecta, todas las personas de este continente se infectan también.
El primer y el último continente no están conectados.

El problema consiste en encontrar el porcentaje de la población humana que se infectó al final. Por ejemplo,

   inicio:     "01000000X000X011X0X"
   final:      "11111111X000X111X0X"
   total:      15
   infectados: 11
   porcentaje: 100*11/15 = 73.33333333333333

inicio: "01000000X000X011X0X"

final: "11111111X000X111X0X"

total: 15

infectados: 11

porcentaje: 100*11/15 = 73.33333333333333

Definir la función

   porcentajeInfectados :: String -> Double

1	porcentajeInfectados :: String -> Double

tal que (porcentajeInfectados xs) es el porcentaje final de infectados para el mapa inicial xs. Por ejemplo,

   porcentajeInfectados "01000000X000X011X0X"  == 73.33333333333333
   porcentajeInfectados "01X000X010X011XX"     == 72.72727272727273
   porcentajeInfectados "XXXXX"                == 0.0
   porcentajeInfectados "0000000010"           == 100.0
   porcentajeInfectados "X00X000000X10X0100"   == 42.857142857142854

porcentajeInfectados "01000000X000X011X0X" == 73.33333333333333

porcentajeInfectados "01X000X010X011XX" == 72.72727272727273

porcentajeInfectados "XXXXX" == 0.0

porcentajeInfectados "0000000010" == 100.0

porcentajeInfectados "X00X000000X10X0100" == 42.857142857142854

Soluciones

import Data.List (genericLength)
import Data.List.Split (splitOn)

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

porcentajeInfectados :: String -> Double
porcentajeInfectados xs
  | nh == 0   = 0
  | otherwise = 100 * ni / nh
  where ni = fromIntegral (numeroInfectados xs)
        nh = fromIntegral (numeroHabitantes xs)

-- (continentes xs) es la lista de las poblaciones de los continentes
-- del mapa xs. Por ejemplo,
--    continentes "01000000X000X011X0X" == ["01000000","000","011","0"]
--    continentes "01X000X010X011XX"    == ["01","000","010","011"]
--    continentes "XXXXX"               == [""]
--    continentes "0000000010"          == ["0000000010"]
--    continentes "X00X000000X10X0100"  == ["","00","000000","10","0100"]
continentes :: String -> [String]
continentes [] = []
continentes xs = as : continentes (dropWhile (=='X') bs)
  where (as,bs) = break (=='X') xs

-- (numeroInfectados xs) es el número final de infectados a partir del
-- mapa xs. Por ejemplo,
--    numeroInfectados "01000000X000X011X0X"  ==  11
numeroInfectados :: String -> Int
numeroInfectados xs =
  sum [length ys | ys <- continentes xs
                 , '1' `elem` ys]
  
-- (numeroHabitantes xs) es el número final de habitantes del mapa
-- xs. Por ejemplo, 
--    numeroHabitantes "01000000X000X011X0X"  ==  15
numeroHabitantes :: String -> Int
numeroHabitantes xs = length (filter (/='X') xs)

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

porcentajeInfectados2 :: String -> Double
porcentajeInfectados2 xs
  | nh == 0   = 0
  | otherwise = 100 * ni / nh
  where ni = sum [genericLength ys | ys <- splitOn "X" xs, '1' `elem` ys]
        nh = genericLength (filter (/='X') xs)

import Data.List (genericLength)

import Data.List.Split (splitOn)

-- 1ª solución

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

porcentajeInfectados :: String -> Double

porcentajeInfectados xs

| nh == 0 = 0

| otherwise = 100 * ni / nh

where ni = fromIntegral (numeroInfectados xs)

nh = fromIntegral (numeroHabitantes xs)

-- (continentes xs) es la lista de las poblaciones de los continentes

-- del mapa xs. Por ejemplo,

-- continentes "01000000X000X011X0X" == ["01000000","000","011","0"]

-- continentes "01X000X010X011XX" == ["01","000","010","011"]

-- continentes "XXXXX" == [""]

-- continentes "0000000010" == ["0000000010"]

-- continentes "X00X000000X10X0100" == ["","00","000000","10","0100"]

continentes :: String -> [String]

continentes [] = []

continentes xs = as : continentes (dropWhile (=='X') bs)

where (as,bs) = break (=='X') xs

-- (numeroInfectados xs) es el número final de infectados a partir del

-- mapa xs. Por ejemplo,

-- numeroInfectados "01000000X000X011X0X" == 11

numeroInfectados :: String -> Int

numeroInfectados xs =

sum [length ys | ys <- continentes xs

, '1' `elem` ys]

-- (numeroHabitantes xs) es el número final de habitantes del mapa

-- xs. Por ejemplo,

-- numeroHabitantes "01000000X000X011X0X" == 15

numeroHabitantes :: String -> Int

numeroHabitantes xs = length (filter (/='X') xs)

-- 2ª solución

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

porcentajeInfectados2 :: String -> Double

porcentajeInfectados2 xs

| nh == 0 = 0

| otherwise = 100 * ni / nh

where ni = sum [genericLength ys | ys <- splitOn "X" xs, '1' `elem` ys]

nh = genericLength (filter (/='X') xs)

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Pensamiento

«El avance de las matemáticas puede ser visto como un progreso de lo infinito a lo finito.»

Gian-Carlo Rota.

Producto de Kronecker

PorJosé A. Alonso 28-febrero-20207-marzo-2020

Si $A$ es una matriz $m \times n$ y $B$ es una matriz $p \times q$ , entonces el producto de Kronecker $A \otimes B$ es la matriz bloque $mp \times nq$

Más explícitamente, tenemos

Por ejemplo,

Definir la función

   kronecker :: Num t => Matrix t -> Matrix t -> Matrix t

1	kronecker :: Num t => Matrix t -> Matrix t -> Matrix t

tal que (kronecker a b) es el producto de Kronecker de las matrices a y b. Por ejemplo,

   λ> kronecker (fromLists [[1,2],[3,1]]) (fromLists [[0,3],[2,1]])
   ┌         ┐
   │ 0 3 0 6 │
   │ 2 1 4 2 │
   │ 0 9 0 3 │
   │ 6 3 2 1 │
   └         ┘
   λ> kronecker (fromLists [[1,2],[3,4]]) (fromLists [[2,1],[-1,0],[3,2]])
   ┌             ┐
   │  2  1  4  2 │
   │ -1  0 -2  0 │
   │  3  2  6  4 │
   │  6  3  8  4 │
   │ -3  0 -4  0 │
   │  9  6 12  8 │
   └             ┘
   λ> kronecker (fromLists [[2,1],[-1,0],[3,2]]) (fromLists [[1,2],[3,4]])
   ┌             ┐
   │  2  4  1  2 │
   │  6  8  3  4 │
   │ -1 -2  0  0 │
   │ -3 -4  0  0 │
   │  3  6  2  4 │
   │  9 12  6  8 │
   └             ┘

λ> kronecker (fromLists [[1,2],[3,1]]) (fromLists [[0,3],[2,1]])

┌ ┐

│ 0 3 0 6 │

│ 2 1 4 2 │

│ 0 9 0 3 │

│ 6 3 2 1 │

└ ┘

λ> kronecker (fromLists [[1,2],[3,4]]) (fromLists [[2,1],[-1,0],[3,2]])

┌ ┐

│ 2 1 4 2 │

│ -1 0 -2 0 │

│ 3 2 6 4 │

│ 6 3 8 4 │

│ -3 0 -4 0 │

│ 9 6 12 8 │

└ ┘

λ> kronecker (fromLists [[2,1],[-1,0],[3,2]]) (fromLists [[1,2],[3,4]])

┌ ┐

│ 2 4 1 2 │

│ 6 8 3 4 │

│ -1 -2 0 0 │

│ -3 -4 0 0 │

│ 3 6 2 4 │

│ 9 12 6 8 │

└ ┘

Soluciones

import Data.Matrix

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

kronecker :: Num t => Matrix t -> Matrix t -> Matrix t
kronecker a b =
  matrix (m*p) (n*q) f
  where m = nrows a
        n = ncols a
        p = nrows b
        q = ncols b
        f (i,j) = a !(k+1,r+1) * b!(l+1,s+1)
          where (k,l) = quotRem (i-1) p
                (r,s) = quotRem (j-1) q

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

kronecker2 a b = bloqueFila a b (ncols a)
  where
    bloque (i,j) a b = scaleMatrix (a!(i,j)) b
    bloqueFila a b 1 = bloqueColumna 1 a b
    bloqueFila a b n = bloqueFila a b (n-1) <|> bloqueColumna n a b
    bloqueColumna j a b = aux a b (nrows a)
      where aux a b 1 = bloque (1,j) a b
            aux a b n = aux a b (n-1) <-> bloque (n,j) a b

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

kronecker3 :: Num t => Matrix t -> Matrix t -> Matrix t
kronecker3 a b =
  foldl1 (<->) [foldl1 (<|>) [scaleMatrix (a!(i,j)) b
                             | j <- [1..ncols b]]
                             | i <- [1..nrows a]]

import Data.Matrix

-- 1ª solución

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

kronecker :: Num t => Matrix t -> Matrix t -> Matrix t

kronecker a b =

matrix (m*p) (n*q) f

where m = nrows a

n = ncols a

p = nrows b

q = ncols b

f (i,j) = a !(k+1,r+1) * b!(l+1,s+1)

where (k,l) = quotRem (i-1) p

(r,s) = quotRem (j-1) q

-- 2ª solución

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

kronecker2 a b = bloqueFila a b (ncols a)

where

bloque (i,j) a b = scaleMatrix (a!(i,j)) b

bloqueFila a b 1 = bloqueColumna 1 a b

bloqueFila a b n = bloqueFila a b (n-1) <|> bloqueColumna n a b

bloqueColumna j a b = aux a b (nrows a)

where aux a b 1 = bloque (1,j) a b

aux a b n = aux a b (n-1) <-> bloque (n,j) a b

-- 3ª solución

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

kronecker3 :: Num t => Matrix t -> Matrix t -> Matrix t

kronecker3 a b =

foldl1 (<->) [foldl1 (<|>) [scaleMatrix (a!(i,j)) b

| j <- [1..ncols b]]

| i <- [1..nrows a]]

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«La resolución de problemas es una habilidad práctica como, digamos, la natación. Adquirimos cualquier habilidad práctica por imitación y práctica. Tratando de nadar, imitas lo que otras personas hacen con sus manos y pies para mantener sus cabezas sobre el agua, y, finalmente, aprendes a nadar practicando la natación. Al intentar resolver problemas, hay que observar e imitar lo que hacen otras personas al resolver problemas y, finalmente, se aprende a resolver problemas haciéndolos.»

George Pólya.

Reducción de SAT a Clique

PorJosé A. Alonso 27-febrero-20205-marzo-2020

Nota: En este ejercicio se usa la misma notación que en los anteriores importando los módulos

+ Evaluacion_de_FNC
+ Modelos_de_FNC
+ Problema_SAT_para_FNC
+ Cliques
+ KCliques
+ Grafo_FNC

+ Evaluacion_de_FNC

+ Modelos_de_FNC

+ Problema_SAT_para_FNC

+ Cliques

+ KCliques

+ Grafo_FNC

Definir las funciones

   cliquesFNC :: FNC -> [[(Int,Literal)]]
   cliquesCompletos :: FNC -> [[(Int,Literal)]]
   esSatisfaciblePorClique :: FNC -> Bool

cliquesFNC :: FNC -> [[(Int,Literal)]]

cliquesCompletos :: FNC -> [[(Int,Literal)]]

esSatisfaciblePorClique :: FNC -> Bool

tales que

(cliquesFNCf) es la lista de los cliques del grafo de f. Por ejemplo,

     λ> cliquesFNC [[1,-2,3],[-1,2],[-2,3]]
     [[], [(0,1)], [(1,2)], [(0,1),(1,2)], [(2,-2)],
      [(0,1),(2,-2)], [(2,3)], [(0,1),(2,3)], [(1,2),(2,3)],
      [(0,1),(1,2),(2,3)], [(0,-2)], [(2,-2),(0,-2)], [(2,3),(0,-2)],
      [(1,-1)], [(2,-2),(1,-1)], [(2,3),(1,-1)], [(0,-2),(1,-1)],
      [(2,-2),(0,-2),(1,-1)], [(2,3),(0,-2),(1,-1)], [(0,3)],
      [(1,2),(0,3)], [(2,-2),(0,3)], [(2,3),(0,3)],
      [(1,2),(2,3),(0,3)], [(1,-1),(0,3)],
      [(2,-2),(1,-1),(0,3)], [(2,3),(1,-1),(0,3)]]

λ> cliquesFNC [[1,-2,3],[-1,2],[-2,3]]

[[], [(0,1)], [(1,2)], [(0,1),(1,2)], [(2,-2)],

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

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

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

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

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

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

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

(cliquesCompletos f) es la lista de los cliques del grafo de f que tiene tantos elementos como cláusulas tiene f. Por ejemplo,

     λ> cliquesCompletos [[1,-2,3],[-1,2],[-2,3]]
     [[(0,1),(1,2),(2,3)],   [(2,-2),(0,-2),(1,-1)],
      [(2,3),(0,-2),(1,-1)], [(1,2),(2,3),(0,3)],
      [(2,-2),(1,-1),(0,3)], [(2,3),(1,-1),(0,3)]]
     λ> cliquesCompletos [[1,2],[1,-2],[-1,2],[-1,-2]]
     []

λ> cliquesCompletos [[1,-2,3],[-1,2],[-2,3]]

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

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

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

λ> cliquesCompletos [[1,2],[1,-2],[-1,2],[-1,-2]]

[]

(esSatisfaciblePorClique f) se verifica si f no contiene la cláusula vacía, tiene más de una cláusula y posee algún clique completo. Por ejemplo,

     λ> esSatisfaciblePorClique [[1,-2,3],[-1,2],[-2,3]]
     True
     λ> esSatisfaciblePorClique [[1,2],[1,-2],[-1,2],[-1,-2]]
     False

λ> esSatisfaciblePorClique [[1,-2,3],[-1,2],[-2,3]]

True

λ> esSatisfaciblePorClique [[1,2],[1,-2],[-1,2],[-1,-2]]

False

Comprobar con QuickCheck que toda fórmula en FNC es satisfacible si, y solo si, es satisfacible por Clique.

Soluciones

module Reduccion_de_SAT_a_Clique where

import Evaluacion_de_FNC
import Modelos_de_FNC
import Problema_SAT_para_FNC
import Cliques
import KCliques
import Grafo_FNC
import Data.List (nub, sort)
import Test.QuickCheck

cliquesFNC :: FNC -> [[(Int,Literal)]]
cliquesFNC f = cliques (grafoFNC f)

cliquesCompletos :: FNC -> [[(Int,Literal)]]
cliquesCompletos cs = kCliques (grafoFNC cs) (length cs)

esSatisfaciblePorClique :: FNC -> Bool
esSatisfaciblePorClique f =
     [] `notElem` f'
  && (length f' <= 1 || not (null (cliquesCompletos f')))
  where f' = nub (map (nub . sort) f) 

-- La propiedad es
prop_esSatisfaciblePorClique :: FNC -> Bool
prop_esSatisfaciblePorClique f =
  esSatisfacible f == esSatisfaciblePorClique f

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

module Reduccion_de_SAT_a_Clique where

import Evaluacion_de_FNC

import Modelos_de_FNC

import Problema_SAT_para_FNC

import Cliques

import KCliques

import Grafo_FNC

import Data.List (nub, sort)

import Test.QuickCheck

cliquesFNC :: FNC -> [[(Int,Literal)]]

cliquesFNC f = cliques (grafoFNC f)

cliquesCompletos :: FNC -> [[(Int,Literal)]]

cliquesCompletos cs = kCliques (grafoFNC cs) (length cs)

esSatisfaciblePorClique :: FNC -> Bool

esSatisfaciblePorClique f =

[] `notElem` f'

&& (length f' <= 1 || not (null (cliquesCompletos f')))

where f' = nub (map (nub . sort) f)

-- La propiedad es

prop_esSatisfaciblePorClique :: FNC -> Bool

prop_esSatisfaciblePorClique f =

esSatisfacible f == esSatisfaciblePorClique f

-- La comprobación es

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

-- +++ OK, passed 100 tests.

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«La resolución de problemas es una habilidad práctica como, digamos, la natación. Adquirimos cualquier habilidad práctica por imitación y práctica. Tratando de nadar, imitas lo que otras personas hacen con sus manos y pies para mantener sus cabezas sobre el agua, y, finalmente, aprendes a nadar practicando la natación. Al intentar resolver problemas, hay que observar e imitar lo que hacen otras personas al resolver problemas y, finalmente, se aprende a resolver problemas haciéndolos.»

George Pólya.

Grafo de una FNC (fórmula en forma normal conjuntiva)

PorJosé A. Alonso 26-febrero-20204-marzo-2020

Para reducir el problema del clique a SAT se comienza asociando a cada fórmula F en FNC un grafo G de forma que F es saisfacible si, y sólo si, G tiene un clique con tantos nodos como cláusulas tiene F.

Los nodos del grafo de F son los literales de las cláusulas de F junto con el número de la cláusula. Por ejemplo, la lista de nodos de la FNC [[1,-2,3],[-1,2],[-2,3]] es

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

[(0,1),(0,-2),(0,3),

(1,-1),(1,2),

(2,-2),(2,3)]

En el grafo de F, hay un arco entre dos nodos si, y solo si, corresponden a cláusulas distintas y sus literales no son complementarios. Por ejemplo,

hay un arco entre (0,1) y (1,2) [porque son de cláusulas distintas (0 y 1) y sus literales (1 y 2) no son complementarios.
no hay un arco entre (0,1) y (1,-1) [porque sus literales (1 y -1) no son complementarios.
no hay un arco entre (0,1) y (0,3) [porque son de la misma cláusula (la 0)].

Nota: En este ejercicio se usará los conceptos de los anteriores importando los módulos Evaluacion_de_FNC y Grafo.

Definir las funciones

   nodosFNC :: FNC -> [(Int,Literal)]
   grafoFNC :: FNC -> Grafo (Int,Literal)

1 2	nodosFNC :: FNC -> [(Int,Literal)] grafoFNC :: FNC -> Grafo (Int,Literal)

tales que

(nodosFNC f) es la lista de los nodos del grafo de f. Por ejemplo,

     λ> nodosFNC [[1,-2,3],[-1,2],[-2,3]]
     [(0,1),(0,-2),(0,3),(1,-1),(1,2),(2,-2),(2,3)]

1 2	λ> nodosFNC [[1,-2,3],[-1,2],[-2,3]] [(0,1),(0,-2),(0,3),(1,-1),(1,2),(2,-2),(2,3)]

(grafo FNC f) es el grafo de f. Por ejemplo,

     λ> grafoFNC [[1,-2,3],[-1,2],[-2,3]]
     [ ((0,1),(1,2)),  ((0,1),(2,-2)), ((0,1),(2,3)),
       ((0,-2),(1,-1)),((0,-2),(2,-2)),((0,-2),(2,3)),
       ((0,3),(1,-1)), ((0,3),(1,2)),  ((0,3),(2,-2)),((0,3),(2,3)),
       ((1,-1),(2,-2)),((1,-1),(2,3)),
       ((1,2),(2,3))]
     λ> grafoFNC [[1,2],[1,-2],[-1,2],[-1,-2]]
     [((0,1),(1,1)),((0,1),(1,-2)),((0,1),(2,2)),((0,1),(3,-2)),
      ((0,2),(1,1)),((0,2),(2,-1)),((0,2),(2,2)),((0,2),(3,-1)),
      ((1,1),(2,2)),((1,1),(3,-2)),
      ((1,-2),(2,-1)),((1,-2),(3,-1)),((1,-2),(3,-2)),
      ((2,-1),(3,-1)),((2,-1),(3,-2)),
      ((2,2),(3,-1))]

λ> grafoFNC [[1,-2,3],[-1,2],[-2,3]]

[ ((0,1),(1,2)), ((0,1),(2,-2)), ((0,1),(2,3)),

((0,-2),(1,-1)),((0,-2),(2,-2)),((0,-2),(2,3)),

((0,3),(1,-1)), ((0,3),(1,2)), ((0,3),(2,-2)),((0,3),(2,3)),

((1,-1),(2,-2)),((1,-1),(2,3)),

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

λ> grafoFNC [[1,2],[1,-2],[-1,2],[-1,-2]]

[((0,1),(1,1)),((0,1),(1,-2)),((0,1),(2,2)),((0,1),(3,-2)),

((0,2),(1,1)),((0,2),(2,-1)),((0,2),(2,2)),((0,2),(3,-1)),

((1,1),(2,2)),((1,1),(3,-2)),

((1,-2),(2,-1)),((1,-2),(3,-1)),((1,-2),(3,-2)),

((2,-1),(3,-1)),((2,-1),(3,-2)),

((2,2),(3,-1))]

Soluciones

module Grafo_FNC where

import Evaluacion_de_FNC
import Grafo
import Data.List (tails)

nodosFNC :: FNC -> [(Int,Literal)]
nodosFNC f = 
  [(i,x) | (i,xs) <- zip [0..] f
         , x <- xs]

grafoFNC :: FNC -> Grafo (Int,Literal)
grafoFNC f = 
  [ ((i,x),(i',x'))
  | ((i,x),(i',x')) <- parejas (nodosFNC f)
  , i' /= i
  , x' /= negate x]

-- (parejas xs) es la lista de las parejas formados por los elementos de
-- xs y sus siguientes en xs. Por ejemplo, 
--    parejas [1..4] == [(1,2),(1,3),(1,4),(2,3),(2,4),(3,4)]
parejas :: [a] -> [(a,a)]
parejas xs =
  [(x,y) | (x:ys) <- tails xs
         , y <- ys]

module Grafo_FNC where

import Evaluacion_de_FNC

import Grafo

import Data.List (tails)

nodosFNC :: FNC -> [(Int,Literal)]

nodosFNC f =

[(i,x) | (i,xs) <- zip [0..] f

, x <- xs]

grafoFNC :: FNC -> Grafo (Int,Literal)

grafoFNC f =

[ ((i,x),(i',x'))

| ((i,x),(i',x')) <- parejas (nodosFNC f)

, i' /= i

, x' /= negate x]

-- (parejas xs) es la lista de las parejas formados por los elementos de

-- xs y sus siguientes en xs. Por ejemplo,

-- parejas [1..4] == [(1,2),(1,3),(1,4),(2,3),(2,4),(3,4)]

parejas :: [a] -> [(a,a)]

parejas xs =

[(x,y) | (x:ys) <- tails xs

, y <- ys]

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«Las matemáticas tienen dos caras: son la ciencia rigurosa de Euclides, pero también son algo más. La matemática presentada a la manera euclidiana aparece como una ciencia sistemática y deductiva; pero la matemática en ciernes aparece como una ciencia experimental e inductiva. Ambos aspectos son tan antiguos como la propia ciencia de las matemáticas.»

George Pólya.

Cliques de orden k

PorJosé A. Alonso 25-febrero-20203-marzo-2020

Nota: En este ejercicio usaremos las mismas notaciones que en el anterior importando el módulo Cliques.

Definir la función

   kCliques :: Eq a => Grafo a -> Int -> [[a]]

1	kCliques :: Eq a => Grafo a -> Int -> [[a]]

tal que (kCliques g k) es la lista de los cliques del grafo g de tamaño k. Por ejemplo,

   λ> kCliques [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 3
   [[2,3,5],[2,4,5]]
   λ> kCliques [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 2
   [[1,2],[2,3],[2,4],[2,5],[3,5],[4,5]]
   λ> kCliques [(n,n+1) | n <- [1..100]] 3
   []

λ> kCliques [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 3

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

λ> kCliques [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 2

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

λ> kCliques [(n,n+1) | n <- [1..100]] 3

[]

Nota: Escribir la solución en el módulo KCliques para poderlo usar en los siguientes ejercicios.

Soluciones

module KCliques where

import Grafo
import Cliques

-- 1ª definición
kCliques1 :: Eq a => Grafo a -> Int -> [[a]]
kCliques1 g k =
  [xs | xs <- cliques g
      , length xs == k]

-- 2ª definición
kCliques :: Eq a => Grafo a -> Int -> [[a]]
kCliques g k =
  [xs | xs <- kSubconjuntos (nodos g) k
      , esClique g xs]

-- (kSubconjuntos xs k) es la lista de los subconjuntos de xs con k
-- elementos. Por ejemplo, 
--    ghci> kSubconjuntos "bcde" 2
--    ["bc","bd","be","cd","ce","de"]
--    ghci> kSubconjuntos "bcde" 3
--    ["bcd","bce","bde","cde"]
--    ghci> kSubconjuntos "abcde" 3
--    ["abc","abd","abe","acd","ace","ade","bcd","bce","bde","cde"]
kSubconjuntos :: [a] -> Int -> [[a]]
kSubconjuntos _ 0      = [[]]
kSubconjuntos [] _     = []
kSubconjuntos (x:xs) k = 
  [x:ys | ys <- kSubconjuntos xs (k-1)] ++ kSubconjuntos xs k  

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

--    λ> kCliques1 [(n,n+1) | n <- [1..20]] 3
--    []
--    (4.28 secs, 3,204,548,608 bytes)
--    λ> kCliques [(n,n+1) | n <- [1..20]] 3
--    []
--    (0.01 secs, 3,075,768 bytes)

module KCliques where

import Grafo

import Cliques

-- 1ª definición

kCliques1 :: Eq a => Grafo a -> Int -> [[a]]

kCliques1 g k =

[xs | xs <- cliques g

, length xs == k]

-- 2ª definición

kCliques :: Eq a => Grafo a -> Int -> [[a]]

kCliques g k =

[xs | xs <- kSubconjuntos (nodos g) k

, esClique g xs]

-- (kSubconjuntos xs k) es la lista de los subconjuntos de xs con k

-- elementos. Por ejemplo,

-- ghci> kSubconjuntos "bcde" 2

-- ["bc","bd","be","cd","ce","de"]

-- ghci> kSubconjuntos "bcde" 3

-- ["bcd","bce","bde","cde"]

-- ghci> kSubconjuntos "abcde" 3

-- ["abc","abd","abe","acd","ace","ade","bcd","bce","bde","cde"]

kSubconjuntos :: [a] -> Int -> [[a]]

kSubconjuntos _ 0 = [[]]

kSubconjuntos [] _ = []

kSubconjuntos (x:xs) k =

[x:ys | ys <- kSubconjuntos xs (k-1)] ++ kSubconjuntos xs k

-- Comparación de eficiencia

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

-- λ> kCliques1 [(n,n+1) | n <- [1..20]] 3

-- []

-- (4.28 secs, 3,204,548,608 bytes)

-- λ> kCliques [(n,n+1) | n <- [1..20]] 3

-- []

-- (0.01 secs, 3,075,768 bytes)

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«Es mejor resolver un problema de cinco maneras diferentes, que resolver cinco problemas de una sola manera.»

George Pólya.

Subconjuntos de orden k

PorJosé A. Alonso 24-febrero-20202-marzo-2020

Definir la función

   kSubconjuntos :: [a] -> Int -> [[a]]

1	kSubconjuntos :: [a] -> Int -> [[a]]

tal que (kSubconjuntos xs k) es la lista de los subconjuntos de xs con k elementos. Por ejemplo,

   ghci> kSubconjuntos "bcde" 2
   ["bc","bd","be","cd","ce","de"]
   ghci> kSubconjuntos "bcde" 3
   ["bcd","bce","bde","cde"]
   ghci> kSubconjuntos "abcde" 3
   ["abc","abd","abe","acd","ace","ade","bcd","bce","bde","cde"]

ghci> kSubconjuntos "bcde" 2

["bc","bd","be","cd","ce","de"]

ghci> kSubconjuntos "bcde" 3

["bcd","bce","bde","cde"]

ghci> kSubconjuntos "abcde" 3

["abc","abd","abe","acd","ace","ade","bcd","bce","bde","cde"]

Soluciones

import Data.List (subsequences)

-- 1ª definición
kSubconjuntos1 :: [a] -> Int -> [[a]]
kSubconjuntos1 xs k =
  [ys | ys <- subsequences xs
      , length ys == k]

-- 2ª definición
kSubconjuntos :: [a] -> Int -> [[a]]
kSubconjuntos _ 0      = [[]]
kSubconjuntos [] _     = []
kSubconjuntos (x:xs) k = 
  [x:ys | ys <- kSubconjuntos xs (k-1)] ++ kSubconjuntos xs k  

-- Comparación de eficiencia
--    λ> length (kSubconjuntos1 [1..24] 3)
--    2024
--    (4.70 secs, 3,489,911,856 bytes)
--    λ> length (kSubconjuntos [1..24] 3)
--    2024
--    (0.03 secs, 2,039,488 bytes)

import Data.List (subsequences)

-- 1ª definición

kSubconjuntos1 :: [a] -> Int -> [[a]]

kSubconjuntos1 xs k =

[ys | ys <- subsequences xs

, length ys == k]

-- 2ª definición

kSubconjuntos :: [a] -> Int -> [[a]]

kSubconjuntos _ 0 = [[]]

kSubconjuntos [] _ = []

kSubconjuntos (x:xs) k =

[x:ys | ys <- kSubconjuntos xs (k-1)] ++ kSubconjuntos xs k

-- Comparación de eficiencia

-- λ> length (kSubconjuntos1 [1..24] 3)

-- 2024

-- (4.70 secs, 3,489,911,856 bytes)

-- λ> length (kSubconjuntos [1..24] 3)

-- 2024

-- (0.03 secs, 2,039,488 bytes)

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«La belleza en las matemáticas es ver la verdad sin esfuerzo.»

George Pólya.

Cliques de un grafo

PorJosé A. Alonso 21-febrero-202028-febrero-2020

Nota: En este ejercicio usaremos las mismas notaciones que en el anterior importando el módulo Grafo.

Un clique (en español, pandilla) de un grafo g es un conjunto de nodos de g tal que todos sus elementos están conectados en g.

Definir las funciones

   esClique :: Eq a => Grafo a -> [a] -> Bool
   cliques  :: Eq a => Grafo a -> [[a]]

1 2	esClique :: Eq a => Grafo a -> [a] -> Bool cliques :: Eq a => Grafo a -> [[a]]

tales que

(esClique g xs) se verifica si el conjunto de nodos xs del grafo g es un clique de g. Por ejemplo,

     esClique [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] [2,3,5]  ==  True
     esClique [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] [2,3,4]  ==  False

1 2	esClique [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] [2,3,5] == True esClique [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] [2,3,4] == False

(cliques g) es la lista de los cliques del grafo g. Por ejemplo,

     λ> cliques [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)]
     [[],[1],[2],[1,2],[3],[2,3],[4],[2,4],
      [5],[2,5],[3,5],[2,3,5],[4,5],[2,4,5]]

λ> cliques [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)]

[[],[1],[2],[1,2],[3],[2,3],[4],[2,4],

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

Nota: Escribir la solución en el módulo Cliques para poderlo usar en los siguientes ejercicios.

Soluciones

module Cliques where

import Grafo
import Data.List (tails, subsequences)

esClique :: Eq a => Grafo a -> [a] -> Bool
esClique g xs =
  and [conectados g x y | (x,y) <- parejas xs]

-- (parejas xs) es la lista de las parejas formados por los elementos de
-- xs y sus siguientes en xs. Por ejemplo, 
--    parejas [1..4] == [(1,2),(1,3),(1,4),(2,3),(2,4),(3,4)]
parejas :: [a] -> [(a,a)]
parejas xs =
  [(x,y) | (x:ys) <- tails xs
         , y <- ys]

cliques :: Eq a => Grafo a -> [[a]]
cliques g =
  [xs | xs <- subsequences (nodos g)
      , esClique g xs]

module Cliques where

import Grafo

import Data.List (tails, subsequences)

esClique :: Eq a => Grafo a -> [a] -> Bool

esClique g xs =

and [conectados g x y | (x,y) <- parejas xs]

-- (parejas xs) es la lista de las parejas formados por los elementos de

-- xs y sus siguientes en xs. Por ejemplo,

-- parejas [1..4] == [(1,2),(1,3),(1,4),(2,3),(2,4),(3,4)]

parejas :: [a] -> [(a,a)]

parejas xs =

[(x,y) | (x:ys) <- tails xs

, y <- ys]

cliques :: Eq a => Grafo a -> [[a]]

cliques g =

[xs | xs <- subsequences (nodos g)

, esClique g xs]

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«Para enseñar de manera efectiva, un profesor debe desarrollar un sentimiento por su asignatura; no puede hacer que sus alumnos sientan su vitalidad si no la siente él mismo. No puede compartir su entusiasmo cuando no tiene entusiasmo que compartir. La forma en que expone su tema puede ser tan importante como el tema que expone; debe sentir personalmente que es importante.»

George Pólya.

Parejas de un conjunto

PorJosé A. Alonso 20-febrero-202028-febrero-2020

Definir la función

   parejas :: [a] -> [(a,a)]

1	parejas :: [a] -> [(a,a)]

tal que (parejas xs) es la lista de las parejas formados por los elementos de xs y sus siguientes en xs. Por ejemplo,

   parejas [1..4] == [(1,2),(1,3),(1,4),(2,3),(2,4),(3,4)]
   length (parejas [sin,cos,tan,log])  ==  6

1 2	parejas [1..4] == [(1,2),(1,3),(1,4),(2,3),(2,4),(3,4)] length (parejas [sin,cos,tan,log]) == 6

Soluciones

import Data.List (tails)

-- 1ª solución
parejas :: [a] -> [(a,a)]
parejas []     = []
parejas (x:xs) = [(x,y) | y <- xs] ++ parejas xs

-- 2ª solución
parejas2 :: [a] -> [(a,a)]
parejas2 xs =
  [(x,y) | (x:ys) <- tails xs
         , y <- ys]

import Data.List (tails)

-- 1ª solución

parejas :: [a] -> [(a,a)]

parejas [] = []

parejas (x:xs) = [(x,y) | y <- xs] ++ parejas xs

-- 2ª solución

parejas2 :: [a] -> [(a,a)]

parejas2 xs =

[(x,y) | (x:ys) <- tails xs

, y <- ys]

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«La primera regla del descubrimiento es tener inteligencia y buena suerte. La segunda regla del descubrimiento es sentarse y esperar hasta que se tenga una idea brillante.»

George Pólya.

Nodos y conexiones de un grafo

PorJosé A. Alonso 19-febrero-202026-febrero-2020

Un grafo no dirigido se representa por la lista de sus arcos. Por ejemplo, el grafo

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

1 -- 2 -- 4

| \ |

3 -- 5

se representa por [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)].

Se define el tipo de grafo por

   type Grafo a = [(a,a)]

1	type Grafo a = [(a,a)]

Definir las funciones

   nodos      :: Eq a => Grafo a -> [a]
   conectados :: Eq a => Grafo a -> a -> a -> Bool

1 2	nodos :: Eq a => Grafo a -> [a] conectados :: Eq a => Grafo a -> a -> a -> Bool

tales que

(nodos g) es la lista de los nodos del grafo g. Por ejemplo,

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

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

(conectados g x y) se verifica si el grafo no dirigido g posee un arco con extremos x e y. Por ejemplo,

     conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 3 2  ==  True
     conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 2 3  ==  True
     conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 3 4  ==  False

conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 3 2 == True

conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 2 3 == True

conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 3 4 == False

Nota: Escribir la solución en el módulo Grafo para poderlo usar en los siguientes ejercicios.

module Grafo where

import Data.List (nub)

type Grafo a = [(a,a)]

nodos :: Eq a => Grafo a -> [a]
nodos g = nub (concat [[x,y] | (x,y) <- g])

conectados :: Eq a => Grafo a -> a -> a -> Bool
conectados g x y =
  (x,y) `elem` g || (y,x) `elem` g

module Grafo where

import Data.List (nub)

type Grafo a = [(a,a)]

nodos :: Eq a => Grafo a -> [a]

nodos g = nub (concat [[x,y] | (x,y) <- g])

conectados :: Eq a => Grafo a -> a -> a -> Bool

conectados g x y =

(x,y) `elem` g || (y,x) `elem` g

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Soluciones

Pensamiento

«La elegancia de un teorema es directamente proporcional al número de ideas que puedes ver en él e inversamente proporcional al esfuerzo que requiere verlas.»

George Pólya.

Problema SAT para FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 18-febrero-202025-febrero-2020

Nota: En este ejercicio usaremos las mismas notaciones que en los anteriores importando los módulos import Modelos_de_FNC y Evaluacion_de_FNC

Una FNC (fórmula en forma normal conjuntiva) es satisfacible, si tiene algún modelo. Por ejemplo,

Definir la función

   esSatisfacible :: FNC -> Bool

1	esSatisfacible :: FNC -> Bool

tal que (esSatisfacible f) se verifica si la FNC f es satistacible. Por ejemplo,

   esSatisfacible [[-1,2],[-2,1]]    ==  True
   esSatisfacible [[-1,2],[-2],[1]]  ==  False
   esSatisfacible [[1,2],[]]         ==  False
   esSatisfacible []                 ==  True

esSatisfacible [[-1,2],[-2,1]] == True

esSatisfacible [[-1,2],[-2],[1]] == False

esSatisfacible [[1,2],[]] == False

esSatisfacible [] == True

Nota: Escribir la solución en el módulo Problema_de_SAT_para_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Problema_SAT_para_FNC where

import Modelos_de_FNC  
import Evaluacion_de_FNC

esSatisfacible :: FNC -> Bool
esSatisfacible = not . null . modelos

module Problema_SAT_para_FNC where

import Modelos_de_FNC

import Evaluacion_de_FNC

esSatisfacible :: FNC -> Bool

esSatisfacible = not . null . modelos

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«Un gran descubrimiento resuelve un gran problema, pero hay un grano de descubrimiento en cualquier problema.»

George Pólya.

Modelos de FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 17-febrero-202024-febrero-2020

Nota: En este ejercicio usaremos las mismas notaciones que en anterior importando los módulos Interpretaciones_de_FNC y Evaluacion_de_FNC

Una interpretación I es un modelo de un literal L si el valor de L en I es verdadero. Por ejemplo, la interpretación [2,5]

es modelo del literal x(2) (porque 2 ∈ [2,5])
no es modelo del literal x(3) (porque 3 ∉ [2,5])
es modelo del literal -x(4) (porque 4 ∉ [2,5])

Una interpretación I es un modelo de una cláusula C si el valor de C en I es verdadero. Por ejemplo, la interpretación [2,5]

es modelo de la cláusula (x(2) v x(3)) (porque x(2) es verdadero)
no es modelo de la cláusula (x(3) v x(4)) (porque x(3) y x(4) son falsos)

Una interpretación I es un modelo de una FNC F si el valor de F en I es verdadero. Por ejemplo, la interpretación [2,5]

es modelo de la FNC ((x(2) v x(5)) & (-x(4) v x(3)) porque lo es de sus dos cláusulas.

Definir las siguientes funciones

   esModeloLiteral  :: Interpretacion -> Literal -> Bool
   esModeloClausula :: Interpretacion -> Clausula -> Bool
   esModelo         :: Interpretacion -> FNC -> Bool
   modelosClausula  :: Clausula -> [Interpretacion]
   modelos          :: FNC -> [Interpretacion]

esModeloLiteral :: Interpretacion -> Literal -> Bool

esModeloClausula :: Interpretacion -> Clausula -> Bool

esModelo :: Interpretacion -> FNC -> Bool

modelosClausula :: Clausula -> [Interpretacion]

modelos :: FNC -> [Interpretacion]

tales que

(esModeloLiteral i l) se verifica si i es modelo del literal l. Por ejemplo,

     esModeloLiteral [3,5] 3     ==  True
     esModeloLiteral [3,5] 4     ==  False
     esModeloLiteral [3,5] (-3)  ==  False
     esModeloLiteral [3,5] (-4)  ==  True

esModeloLiteral [3,5] 3 == True

esModeloLiteral [3,5] 4 == False

esModeloLiteral [3,5] (-3) == False

esModeloLiteral [3,5] (-4) == True

(esModeloClausula i c) se verifica si i es modelo de la cláusula c. Por ejemplo,

     esModeloClausula [3,5] [2,3,-5]  ==  True
     esModeloClausula [3,5] [2,4,-1]  ==  True
     esModeloClausula [3,5] [2,4,1]   ==  False

esModeloClausula [3,5] [2,3,-5] == True

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

esModeloClausula [3,5] [2,4,1] == False

(esModelo i f) se verifica si i es modelo de la fórmula f. Por ejemplo,

     esModelo [1,3] [[1,-2],[3]]  ==  True
     esModelo [1]   [[1,-2],[3]]  ==  False
     esModelo [1]   []            ==  True

esModelo [1,3] [[1,-2],[3]] == True

esModelo [1] [[1,-2],[3]] == False

esModelo [1] [] == True

(modelosClausula c) es la lista de los modelos de la cláusula c. Por ejemplo,

     modelosClausula [-1,2]  ==  [[],[2],[1,2]]
     modelosClausula [-1,1]  ==  [[],[1]]
     modelosClausula []      ==  []

modelosClausula [-1,2] == [[],[2],[1,2]]

modelosClausula [-1,1] == [[],[1]]

modelosClausula [] == []

(modelos f) es la lista de los modelos de la fórmula f. Por ejemplo,

     modelos [[-1,2],[-2,1]]    ==  [[],[1,2]]
     modelos [[-1,2],[-2],[1]]  ==  []
     modelos [[1,-1,2]]         ==  [[],[1],[2],[1,2]]

modelos [[-1,2],[-2,1]] == [[],[1,2]]

modelos [[-1,2],[-2],[1]] == []

modelos [[1,-1,2]] == [[],[1],[2],[1,2]]

Nota: Escribir la solución en el módulo Modelos_de_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Modelos_de_FNC where

import Interpretaciones_de_FNC 
import Evaluacion_de_FNC

esModeloLiteral :: Interpretacion -> Literal -> Bool
esModeloLiteral i l
  | l > 0     = l `elem` i
  | otherwise = negate l `notElem` i

esModeloClausula :: Interpretacion -> Clausula -> Bool
esModeloClausula i = any (esModeloLiteral i)

esModelo :: Interpretacion -> FNC -> Bool
esModelo i = all (esModeloClausula i)

modelosClausula :: Clausula -> [Interpretacion]
modelosClausula c =
  [i | i <- interpretacionesClausula c,
       esModeloClausula i c]

modelos :: FNC -> [Interpretacion]
modelos f =
  [i | i <- interpretaciones f,
       esModelo i f]

module Modelos_de_FNC where

import Interpretaciones_de_FNC

import Evaluacion_de_FNC

esModeloLiteral :: Interpretacion -> Literal -> Bool

esModeloLiteral i l

| l > 0 = l `elem` i

| otherwise = negate l `notElem` i

esModeloClausula :: Interpretacion -> Clausula -> Bool

esModeloClausula i = any (esModeloLiteral i)

esModelo :: Interpretacion -> FNC -> Bool

esModelo i = all (esModeloClausula i)

modelosClausula :: Clausula -> [Interpretacion]

modelosClausula c =

[i | i <- interpretacionesClausula c,

esModeloClausula i c]

modelos :: FNC -> [Interpretacion]

modelos f =

[i | i <- interpretaciones f,

esModelo i f]

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«Por muy correcto que parezca un teorema matemático, nunca hay que conformarse con que no haya algo imperfecto en él hasta obtener la impresión de qie es bello.»

George Boole.

Interpretaciones de FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 14-febrero-202022-febrero-2020

Nota: En este ejercicio usaremos las mismas notaciones que en el anterior importando los módulos Evaluacion_de_FNC y Atomos_de_FNC.

Definir las siguientes funciones

   interpretacionesClausula :: Clausula -> [Interpretacion]
   interpretaciones         :: FNC -> [Interpretacion]

1 2	interpretacionesClausula :: Clausula -> [Interpretacion] interpretaciones :: FNC -> [Interpretacion]

tales que

(interpretacionesClausula c) es el conjunto de interpretaciones de la cláusula c. Por ejemplo,

     interpretacionesClausula [1,2,-1]  ==  [[],[1],[2],[1,2]]
     interpretacionesClausula []        ==  [[]]

1 2	interpretacionesClausula [1,2,-1] == [[],[1],[2],[1,2]] interpretacionesClausula [] == [[]]

(interpretaciones f) es el conjunto de interpretaciones de la fórmula f. Por ejemplo,

     interpretaciones [[1,-2],[-1,2]] == [[],[1],[2],[1,2]] 
     interpretaciones []              == [[]]

1 2	interpretaciones [[1,-2],[-1,2]] == [[],[1],[2],[1,2]] interpretaciones [] == [[]]

Nota: Escribir la solución en el módulo Interpretaciones_de_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Interpretaciones_de_FNC where

import Evaluacion_de_FNC
import Atomos_de_FNC
import Data.List (subsequences)

interpretacionesClausula :: Clausula -> [Interpretacion]
interpretacionesClausula = subsequences . atomosClausula 

interpretaciones :: FNC -> [Interpretacion]
interpretaciones = subsequences . atomosFNC

module Interpretaciones_de_FNC where

import Evaluacion_de_FNC

import Atomos_de_FNC

import Data.List (subsequences)

interpretacionesClausula :: Clausula -> [Interpretacion]

interpretacionesClausula = subsequences . atomosClausula

interpretaciones :: FNC -> [Interpretacion]

interpretaciones = subsequences . atomosFNC

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«En matemáticas, el arte de hacer preguntas es más valioso que la resolución de problemas.»

Georg Cantor.

Átomos de FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 13-febrero-202020-febrero-2020

Nota: En este ejercicio usaremos las mismas notaciones que en el anterior importando el módulo Evaluacion_de_FNC.

Definir las siguientes funciones

    atomosClausula :: Clausula -> [Atomo]
    atomosFNC      :: FNC -> [Atomo]

1 2	atomosClausula :: Clausula -> [Atomo] atomosFNC :: FNC -> [Atomo]

tales que

(atomosClausula c) es el conjunto de los átomos de la cláusula c. Por ejemplo,

     atomosClausula [3,1,-3] == [1,3]

1	atomosClausula [3,1,-3] == [1,3]

(atomosFNC f) es el conjunto de los átomos de la FNC f. Por ejemplo,

   atomosFNC [[4,5],[1,-2],[-4,-1,-5]]  ==  [1,2,4,5]

1	atomosFNC [[4,5],[1,-2],[-4,-1,-5]] == [1,2,4,5]

Nota: Escribir la solución en el módulo Atomos_de_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Atomos_de_FNC where
  
import Evaluacion_de_FNC
import Data.List (sort, nub)

-- 1ª definición de atomosClausula
atomosClausula :: Clausula -> [Atomo]
atomosClausula c = sort (nub (map abs c))

-- 2ª definición de atomosClausula
atomosClausula2 :: Clausula -> [Atomo]
atomosClausula2 = sort . nub . map abs

-- 1ª definición de atomosFNC
atomosFNC :: FNC -> [Atomo]
atomosFNC f = sort (nub (concat [atomosClausula c | c <- f]))

-- 2ª definición
atomosFNC2 :: FNC -> [Atomo]
atomosFNC2 f = sort (nub (concatMap atomosClausula f))

-- 3ª definición
atomosFNC3 :: FNC -> [Atomo]
atomosFNC3 = sort . nub . concatMap atomosClausula

module Atomos_de_FNC where

import Evaluacion_de_FNC

import Data.List (sort, nub)

-- 1ª definición de atomosClausula

atomosClausula :: Clausula -> [Atomo]

atomosClausula c = sort (nub (map abs c))

-- 2ª definición de atomosClausula

atomosClausula2 :: Clausula -> [Atomo]

atomosClausula2 = sort . nub . map abs

-- 1ª definición de atomosFNC

atomosFNC :: FNC -> [Atomo]

atomosFNC f = sort (nub (concat [atomosClausula c | c <- f]))

-- 2ª definición

atomosFNC2 :: FNC -> [Atomo]

atomosFNC2 f = sort (nub (concatMap atomosClausula f))

-- 3ª definición

atomosFNC3 :: FNC -> [Atomo]

atomosFNC3 = sort . nub . concatMap atomosClausula

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«La esencia de las matemáticas es su libertad.»

Georg Cantor.

Evaluación de FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 12-febrero-202019-febrero-2020

Una FNC (fórmula en forma normal conjuntiva) es una conjunción de cláusulas, donde una cláusula es una disyunción de literales y un literal es un átomo o su negación. Por ejemplo,

   (x(1) v -x(3)) & x(2) & (-x(2) v x(3) v x(1))

1	(x(1) v -x(3)) & x(2) & (-x(2) v x(3) v x(1))

es una FNC con tres clásulas tales que la primera cláusula tiene 2 literales (x(1) y -x(3)), la segunda tiene 1 (x(2)) y la tercera tiene 3 (-x(2), x(3) y x(1)).

Usaremos las siguientes representaciones:

Los átomos se representan por enteros positivos. Por ejemplo, 3 representa x(3).
Los literales se representan por enteros. Por ejemplo, 3 representa el literal positivo x(3) y -5 el literal negativo -x(5).
Una cláusula es una lista de literales que representa la disyunción se sus literales. Por ejemplo, [3,2,-4] representa a (x(3) v x(2) v -x(4)).
Una fórmula en forma normal conjuntiva (FNC) es una lista de cláusulas que representa la conjunción de sus cláusulas. Por ejemplo, [[3,2],[-1,2,5]] representa a ((x(3) v x(2)) & (-x(1) v x(2) v x(5))).

Una interpretación I es un conjunto de átomos. Se supone que los átomos de I son verdaderos y los restantes son falsos. Por ejemplo, en la interpretación [2,5]

el literal x(2) es verdadero (porque 2 ∈ [2,5])
el literal x(3) es falso (porque 3 ∉ [2,5])
el literal -x(4) es verdadero (porque 4 ∉ [2,5])
la cláusula (x(2) v x(3)) es verdadera (porque x(2) es verdadero)
la cláusula (x(3) v x(4)) es falsa (porque x(3) y x(4) son falsos)
la FNC ((x(2) v x(5)) & (-x(4) v x(3)) es verdadera porque lo son sus dos cláusulas

En el ejercicio se usarán los siguientes tipos de datos

   type Atomo          = Int
   type Literal        = Int
   type Clausula       = [Literal]
   type FNC            = [Clausula]
   type Interpretacion = [Atomo]

type Atomo = Int

type Literal = Int

type Clausula = [Literal]

type FNC = [Clausula]

type Interpretacion = [Atomo]

Definir las siguientes funciones

   valorLiteral  :: Interpretacion -> Literal -> Bool
   valorClausula :: Interpretacion -> Clausula -> Bool
   valor         :: Interpretacion -> FNC -> Bool

valorLiteral :: Interpretacion -> Literal -> Bool

valorClausula :: Interpretacion -> Clausula -> Bool

valor :: Interpretacion -> FNC -> Bool

tales que

(valorLiteral i l) es el valor del literal l en la interpretación i. Por ejemplo,

     valorLiteral [3,5] 3     ==  True
     valorLiteral [3,5] 4     ==  False
     valorLiteral [3,5] (-3)  ==  False
     valorLiteral [3,5] (-4)  ==  True

valorLiteral [3,5] 3 == True

valorLiteral [3,5] 4 == False

valorLiteral [3,5] (-3) == False

valorLiteral [3,5] (-4) == True

(valorClausula i c) es el valor de la cláusula c en la interpretación i. Por ejemplo,

     valorClausula [3,5] [2,3,-5]  ==  True
     valorClausula [3,5] [2,4,-1]  ==  True
     valorClausula [3,5] [2,4,1]   ==  False

valorClausula [3,5] [2,3,-5] == True

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

valorClausula [3,5] [2,4,1] == False

(valor i f) es el valor de la fórmula en FNC f en la interpretación i. Por ejemplo,

     valor [1,3] [[1,-2],[3]]  ==  True
     valor [1]   [[1,-2],[3]]  ==  False
     valor [1]   []            ==  True

valor [1,3] [[1,-2],[3]] == True

valor [1] [[1,-2],[3]] == False

valor [1] [] == True

Nota: Escribir la solución en el módulo Evaluacion_de_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Evaluacion_de_FNC where

type Atomo          = Int
type Literal        = Int
type Clausula       = [Literal]
type FNC            = [Clausula]
type Interpretacion = [Atomo]

-- Definición de valorLiteral
-- ==========================

valorLiteral :: Interpretacion -> Literal -> Bool
valorLiteral i l
  | l > 0     = l `elem` i
  | otherwise = negate l `notElem` i

-- Definiciones de valorClausula
-- =============================

-- 1ª definición
valorClausula :: Interpretacion -> Clausula -> Bool
valorClausula i c = or [valorLiteral i l | l <- c]

-- 2ª definición
valorClausula2 :: Interpretacion -> Clausula -> Bool
valorClausula2 i = any (valorLiteral i)

-- Definiciones de valor de FNC
-- ============================

-- 1ª definición
valor :: Interpretacion -> FNC -> Bool
valor i f = and [valorClausula i c | c <- f]

-- 2ª definición
valor2 :: Interpretacion -> FNC -> Bool
valor2 i = all (valorClausula i)

module Evaluacion_de_FNC where

type Atomo = Int

type Literal = Int

type Clausula = [Literal]

type FNC = [Clausula]

type Interpretacion = [Atomo]

-- Definición de valorLiteral

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

valorLiteral :: Interpretacion -> Literal -> Bool

valorLiteral i l

| l > 0 = l `elem` i

| otherwise = negate l `notElem` i

-- Definiciones de valorClausula

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

-- 1ª definición

valorClausula :: Interpretacion -> Clausula -> Bool

valorClausula i c = or [valorLiteral i l | l <- c]

-- 2ª definición

valorClausula2 :: Interpretacion -> Clausula -> Bool

valorClausula2 i = any (valorLiteral i)

-- Definiciones de valor de FNC

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

-- 1ª definición

valor :: Interpretacion -> FNC -> Bool

valor i f = and [valorClausula i c | c <- f]

-- 2ª definición

valor2 :: Interpretacion -> FNC -> Bool

valor2 i = all (valorClausula i)

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«Todo buen matemático es al menos medio filósofo, y todo buen filósofo es al menos medio matemático.»

Gottlob Frege.

Conjetura de Lemoine

PorJosé A. Alonso 11-febrero-202026-marzo-2022

La conjetura de Lemoine afirma que

Todos los números impares mayores que 5 se pueden escribir de la forma p + 2q donde p y q son números primos. Por ejemplo, 47 = 13 + 2 x 17

Definir las funciones

   descomposicionesLemoine :: Integer -> [(Integer,Integer)]
   graficaLemoine :: Integer -> IO ()

1 2	descomposicionesLemoine :: Integer -> [(Integer,Integer)] graficaLemoine :: Integer -> IO ()

tales que

(descomposicionesLemoine n) es la lista de pares de primos (p,q) tales que n = p + 2q. Por ejemplo,

     descomposicionesLemoine 5   ==  []
     descomposicionesLemoine 7   ==  [(3,2)]
     descomposicionesLemoine 9   ==  [(5,2),(3,3)]
     descomposicionesLemoine 21  ==  [(17,2),(11,5),(7,7)]
     descomposicionesLemoine 47  ==  [(43,2),(41,3),(37,5),(13,17)]
     descomposicionesLemoine 33  ==  [(29,2),(23,5),(19,7),(11,11),(7,13)]
     length (descomposicionesLemoine 2625)  ==  133

descomposicionesLemoine 5 == []

descomposicionesLemoine 7 == [(3,2)]

descomposicionesLemoine 9 == [(5,2),(3,3)]

descomposicionesLemoine 21 == [(17,2),(11,5),(7,7)]

descomposicionesLemoine 47 == [(43,2),(41,3),(37,5),(13,17)]

descomposicionesLemoine 33 == [(29,2),(23,5),(19,7),(11,11),(7,13)]

length (descomposicionesLemoine 2625) == 133

(graficaLemoine n) dibuja la gráfica de los números de descomposiciones de Lemoine para los números impares menores o iguales que n. Por ejemplo, (graficaLemoine n 400) dibuja

Comprobar con QuickCheck la conjetura de Lemoine.

Nota: Basado en Lemoine’s conjecture

Soluciones

import Data.Numbers.Primes (isPrime, primes)
import Graphics.Gnuplot.Simple
import Test.QuickCheck

descomposicionesLemoine :: Integer -> [(Integer,Integer)]
descomposicionesLemoine n =
  [(p,q) | q <- takeWhile (<=(n-2) `div` 2) primes
         , let p = n - 2 * q
         , isPrime p]

graficaLemoine :: Integer -> IO ()
graficaLemoine n = do
  plotList [ Key Nothing
           , Title "Conjetura de Lemoine"
           , PNG "Conjetura_de_Lemoine.png"
           ]
           [(k,length (descomposicionesLemoine k)) | k <- [1,3..n]]

-- La conjetura es
prop_conjeturaLemoine :: Integer -> Bool
prop_conjeturaLemoine n =
  not (null (descomposicionesLemoine n'))
  where n' = 7 + 2 * abs n

-- Su comprobación es
--    λ> quickCheck prop_conjeturaLemoine
--    +++ OK, passed 100 tests.

import Data.Numbers.Primes (isPrime, primes)

import Graphics.Gnuplot.Simple

import Test.QuickCheck

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

descomposicionesLemoine n =

[(p,q) | q <- takeWhile (<=(n-2) `div` 2) primes

, let p = n - 2 * q

, isPrime p]

graficaLemoine :: Integer -> IO ()

graficaLemoine n = do

plotList [ Key Nothing

, Title "Conjetura de Lemoine"

, PNG "Conjetura_de_Lemoine.png"

]

[(k,length (descomposicionesLemoine k)) | k <- [1,3..n]]

-- La conjetura es

prop_conjeturaLemoine :: Integer -> Bool

prop_conjeturaLemoine n =

not (null (descomposicionesLemoine n'))

where n' = 7 + 2 * abs n

-- Su comprobación es

-- λ> quickCheck prop_conjeturaLemoine

-- +++ OK, passed 100 tests.

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«Todo el mundo sabe lo que es una curva, hasta que ha estudiado suficientes matemáticas para confundirse a través del incontable número de posibles excepciones.»

Felix Klein.

Conjetura de Collatz generalizada

PorJosé A. Alonso 10-febrero-202017-febrero-2020

Sea p un número primo. Toma un número natural positivo, si es divisible entre un número primo menor que p divídelo entre el menor de dicho divisores, y en otro caso multiplícalo por p y súmale uno; si el resultado no es igual a uno, repite el proceso. Por ejemplo, para p = 7 y empezando en 42 el proceso es

   42
   -> 21   [= 42/2]
   -> 7    [= 21/3]
   -> 50   [= 7*7+1]
   -> 25   [= 50/5]
   -> 5    [= 25/5]
   -> 1    [= 5/5]

-> 21 [= 42/2]

-> 7 [= 21/3]

-> 50 [= 7*7+1]

-> 25 [= 50/5]

-> 5 [= 25/5]

-> 1 [= 5/5]

La conjetura de Collatz generalizada afirma que este proceso siempre acaba en un número finito de pasos.

Definir la función

   collatzGeneral :: Integer -> Integer -> [Integer]

1	collatzGeneral :: Integer -> Integer -> [Integer]

tal que (collatzGeneral p x) es la sucesión de los elementos obtenidos en el proceso anterior para el primo p enpezando en x. Por ejemplo,

   take 15 (collatzGeneral 7 42) == [42,21,7,50,25,5,1,8,4,2,1,8,4,2,1]
   take 15 (collatzGeneral 3  6) == [6,3,10,5,16,8,4,2,1,4,2,1,4,2,1]
   take 15 (collatzGeneral 5  6) == [6,3,1,6,3,1,6,3,1,6,3,1,6,3,1]
   take 15 (collatzGeneral 7  6) == [6,3,1,8,4,2,1,8,4,2,1,8,4,2,1]
   take 15 (collatzGeneral 9  6) == [6,3,1,10,5,1,10,5,1,10,5,1,10,5,1]

take 15 (collatzGeneral 7 42) == [42,21,7,50,25,5,1,8,4,2,1,8,4,2,1]

take 15 (collatzGeneral 3 6) == [6,3,10,5,16,8,4,2,1,4,2,1,4,2,1]

take 15 (collatzGeneral 5 6) == [6,3,1,6,3,1,6,3,1,6,3,1,6,3,1]

take 15 (collatzGeneral 7 6) == [6,3,1,8,4,2,1,8,4,2,1,8,4,2,1]

take 15 (collatzGeneral 9 6) == [6,3,1,10,5,1,10,5,1,10,5,1,10,5,1]

Comprobar con QuickCheck que se verifica la conjetura de Collatz generalizada; es decir, para todos enteros positivos n, x si p es el primo n-ésimo entonces 1 pertenece a (collatzGeneral p x).

Nota: El ejercicio etá basado en el artículo Los primos de la conjetura de Collatz publicado la semana pasada por Francisco R. Villatoro en su blog La Ciencia de la Mula Francis.

Soluciones

import Data.Numbers.Primes (primeFactors, primes)
import Test.QuickCheck

collatzGeneral :: Integer -> Integer -> [Integer]
collatzGeneral p x =
  iterate (siguiente p) x

siguiente :: Integer -> Integer -> Integer
siguiente p x 
  | null xs   = p * x + 1
  | otherwise = x `div` head xs
  where xs = takeWhile (<p) (primeFactors x)

prop_collatzGeneral :: Int -> Integer -> Property
prop_collatzGeneral n x =
  n > 0 && x > 0 ==>
  1 `elem` collatzGeneral p x
  where p = primes !! n 

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

import Data.Numbers.Primes (primeFactors, primes)

import Test.QuickCheck

collatzGeneral :: Integer -> Integer -> [Integer]

collatzGeneral p x =

iterate (siguiente p) x

siguiente :: Integer -> Integer -> Integer

siguiente p x

| null xs = p * x + 1

| otherwise = x `div` head xs

where xs = takeWhile (<p) (primeFactors x)

prop_collatzGeneral :: Int -> Integer -> Property

prop_collatzGeneral n x =

n > 0 && x > 0 ==>

1 `elem` collatzGeneral p x

where p = primes !! n

-- La comprobación es

-- λ> quickCheck prop_collatzGeneral

-- +++ OK, passed 100 tests.

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«Las matemáticas son la ciencia que utiliza palabras fáciles para ideas difíciles.»

Edward Kasner y James R. Newman

La menos conocida de las conjeturas de Goldbach

PorJosé A. Alonso 7-febrero-202017-febrero-2020

Goldbach, el de la famosa conjetura, hizo por lo menos otra conjetura que finalmente resultó ser falsa.

Esta última decía que todo número compuesto impar puede expresarse como la suma de un número primo más dos veces la suma de un cuadrado. Así por ejemplo,

    9 =  7 + 2×1^2
   15 =  7 + 2×2^2
   21 =  3 + 2×3^2
   25 =  7 + 2×3^2
   27 = 19 + 2×2^2
   33 = 31 + 2×1^2

9 = 7 + 2×1^2

15 = 7 + 2×2^2

21 = 3 + 2×3^2

25 = 7 + 2×3^2

27 = 19 + 2×2^2

33 = 31 + 2×1^2

Definir las sucesiones

   imparesCompuestos :: [Integer]
   descomposiciones :: Integer -> [(Integer,Integer)]
   contraejemplosGoldbach :: [Integer]

imparesCompuestos :: [Integer]

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

contraejemplosGoldbach :: [Integer]

tales que

imparesCompuestos es la lista de los números impares compuestos. Por ejemplo,

     take 9 imparesCompuestos  ==  [9,15,21,25,27,33,35,39,45]

1	take 9 imparesCompuestos == [9,15,21,25,27,33,35,39,45]

(descomposiciones n) es la lista de las descomposiciones de n de n como la suma de un número primo más dos veces la suma de un cuadrado. Por ejemplo,

     descomposiciones 9     ==  [(7,1)]
     descomposiciones 21    ==  [(3,9),(13,4),(19,1)]
     descomposiciones 5777  ==  []

descomposiciones 9 == [(7,1)]

descomposiciones 21 == [(3,9),(13,4),(19,1)]

descomposiciones 5777 == []

Las 3 descomposiciones de 21 son

     21 =  3 + 2*9 = 21 + 2*3^2
     21 = 13 + 2*4 = 13 + 2*3^2
     21 = 19 + 2*1 = 19 + 2*1^2

21 = 3 + 2*9 = 21 + 2*3^2

21 = 13 + 2*4 = 13 + 2*3^2

21 = 19 + 2*1 = 19 + 2*1^2

contraejemplosGoldbach es la lista de los contraejemplos de la anterior conjetura de Goldbach; es decir, los números impares compuestos que no pueden expresarse como la suma de un número primo más dos veces la suma de un cuadrado. Por ejemplo,

   take 2 contraejemplosGoldbach  ==  [5777,5993]

1	take 2 contraejemplosGoldbach == [5777,5993]

Comprobar con QuickCheck que la conjetura de Golbach se verifica a partir de 5993; es decir, todo número compuesto impar mayor que 5993 puede expresarse como la suma de un número primo más dos veces la suma de un cuadrado.

Nota: Basado en el artículo La menos conocida de las conjeturas de Goldbach de Claudio Meller en el blog Números y algo más.

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck

imparesCompuestos :: [Integer]
imparesCompuestos = filter esCompuesto [3,5..]

-- (esCompuesto x) se verifica si x es un número compuesto. Por ejemplo,
--    esCompuesto 6  ==  True
--    esCompuesto 7  ==  False
esCompuesto :: Integer -> Bool
esCompuesto = not . isPrime

contraejemplosGoldbach :: [Integer]
contraejemplosGoldbach = filter esContraejemplo imparesCompuestos

-- (esContraejemplo x) es verifica si el número impar compuesto x es un
-- contraejemplo de la conjetura de Goldbach. Por ejemplo,
--    esContraejemplo 5777  ==  True
--    esContraejemplo 15    ==  False
esContraejemplo :: Integer -> Bool
esContraejemplo = null . descomposiciones

descomposiciones :: Integer -> [(Integer,Integer)]
descomposiciones n =
  [(p,x) | p <- takeWhile (<=n) primes
         , (n - p) `mod` 2 == 0
         , let x = (n - p) `div` 2
         , esCuadrado x]

-- (esCuadrado x) es verifica si x es un cuadrado perfecto. Por ejemplo, 
--    esCuadrado 16  ==  True
--    esCuadrado 27  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x = y^2 == x
  where y = ceiling (sqrt (fromIntegral x))

-- La propiedad es
prop_conjetura :: Int -> Property
prop_conjetura n =
  n >= 0 ==> not (esContraejemplo (imparesCompuestosMayore5993 !! n))
  where imparesCompuestosMayore5993 = dropWhile (<=5993) imparesCompuestos

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

import Data.Numbers.Primes

import Test.QuickCheck

imparesCompuestos :: [Integer]

imparesCompuestos = filter esCompuesto [3,5..]

-- (esCompuesto x) se verifica si x es un número compuesto. Por ejemplo,

-- esCompuesto 6 == True

-- esCompuesto 7 == False

esCompuesto :: Integer -> Bool

esCompuesto = not . isPrime

contraejemplosGoldbach :: [Integer]

contraejemplosGoldbach = filter esContraejemplo imparesCompuestos

-- (esContraejemplo x) es verifica si el número impar compuesto x es un

-- contraejemplo de la conjetura de Goldbach. Por ejemplo,

-- esContraejemplo 5777 == True

-- esContraejemplo 15 == False

esContraejemplo :: Integer -> Bool

esContraejemplo = null . descomposiciones

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

descomposiciones n =

[(p,x) | p <- takeWhile (<=n) primes

, (n - p) `mod` 2 == 0

, let x = (n - p) `div` 2

, esCuadrado x]

-- (esCuadrado x) es verifica si x es un cuadrado perfecto. Por ejemplo,

-- esCuadrado 16 == True

-- esCuadrado 27 == False

esCuadrado :: Integer -> Bool

esCuadrado x = y^2 == x

where y = ceiling (sqrt (fromIntegral x))

-- La propiedad es

prop_conjetura :: Int -> Property

prop_conjetura n =

n >= 0 ==> not (esContraejemplo (imparesCompuestosMayore5993 !! n))

where imparesCompuestosMayore5993 = dropWhile (<=5993) imparesCompuestos

-- La comprobación es

-- λ> quickCheck prop_conjetura

-- +++ OK, passed 100 tests.

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«Obvio es la palabra más peligrosa de las matemáticas.»

Eric Temple Bell

Triángulo de Bell

PorJosé A. Alonso 6-febrero-202013-febrero-2020

El triágulo de Bell es el triángulo numérico, cuya primera fila es [1] y en cada fila, el primer elemento es el último de la fila anterior y el elemento en la posición j se obtiene sumando el elemento anterior de su misma fila y de la fila anterior. Sus primeras filas son

   1 
   1   2
   2   3   5
   5   7  10  15
   15 20  27  37  52
   52 67  87 114 151 203

1 2

2 3 5

5 7 10 15

15 20 27 37 52

52 67 87 114 151 203

Definir la función

   trianguloDeBell :: [[Integer]]

1	trianguloDeBell :: [[Integer]]

tal que trianguloDeBell es la lista con las filas de dicho triángulo. Por ejemplo

   λ> take 5 trianguloDeBell
   [[1],[1,2],[2,3,5],[5,7,10,15],[15,20,27,37,52]]

1 2	λ> take 5 trianguloDeBell [[1],[1,2],[2,3,5],[5,7,10,15],[15,20,27,37,52]]

Comprobar con QuickCheck que los números que aparecen en la primera columna del triángulo coinciden con los números de Bell; es decir, el primer elemento de la n-ésima fila es el n-ésimo número de Bell.

Soluciones

import Data.List (genericIndex, genericLength)
import Test.QuickCheck

trianguloDeBell :: [[Integer]]
trianguloDeBell = iterate siguiente [1]

-- (siguiente xs) es la fila siguiente de xs en el triángulo de
-- Bell. Por ejemplo,
--    siguiente [1]     ==  [1,2]
--    siguiente [1,2]   ==  [2,3,5]
--    siguiente [2,3,5] ==  [5,7,10,15]
siguiente :: [Integer] -> [Integer]
siguiente xs = last xs : zipWith (+) xs (siguiente xs)

-- Propiedad
-- =========

-- La propiedad es
prop_TrianguloDeBell :: Integer -> Property
prop_TrianguloDeBell n =
  n > 0 ==> head (trianguloDeBell `genericIndex` n) == bell n

-- (bell n) es el n-ésimo número de Bell definido en el ejercicio
-- anterior.  
bell :: Integer -> Integer
bell n = genericLength (particiones [1..n])

particiones :: [a] -> [[[a]]]
particiones [] = [[]]
particiones (x:xs) =
  concat [([x] : yss) : inserta x yss | yss <- ysss]
  where ysss = particiones xs

inserta :: a -> [[a]] -> [[[a]]]
inserta _ []       = []
inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss] 

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

import Data.List (genericIndex, genericLength)

import Test.QuickCheck

trianguloDeBell :: [[Integer]]

trianguloDeBell = iterate siguiente [1]

-- (siguiente xs) es la fila siguiente de xs en el triángulo de

-- Bell. Por ejemplo,

-- siguiente [1] == [1,2]

-- siguiente [1,2] == [2,3,5]

-- siguiente [2,3,5] == [5,7,10,15]

siguiente :: [Integer] -> [Integer]

siguiente xs = last xs : zipWith (+) xs (siguiente xs)

-- Propiedad

-- =========

-- La propiedad es

prop_TrianguloDeBell :: Integer -> Property

prop_TrianguloDeBell n =

n > 0 ==> head (trianguloDeBell `genericIndex` n) == bell n

-- (bell n) es el n-ésimo número de Bell definido en el ejercicio

-- anterior.

bell :: Integer -> Integer

bell n = genericLength (particiones [1..n])

particiones :: [a] -> [[[a]]]

particiones [] = [[]]

particiones (x:xs) =

concat [([x] : yss) : inserta x yss | yss <- ysss]

where ysss = particiones xs

inserta :: a -> [[a]] -> [[[a]]]

inserta _ [] = []

inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=10}) prop_TrianguloDeBell

-- +++ OK, passed 100 tests.

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«La ciencia es lo que entendemos lo suficientemente bien como para explicarle a una computadora. El arte es todo lo demás.»

Donald Knuth.

Números de Bell

PorJosé A. Alonso 5-febrero-202012-febrero-2020

Una partición de un conjunto A es un conjunto de subconjuntos no vacíos de A, disjuntos dos a dos y cuya unión es A. Por ejemplo, el conjunto {1, 2, 3} tiene exactamente 5 particiones:

   {{1}, {2}, {3}}
   {{1,2}, {3}}
   {{1,3}, {2}}
   {{1}, {2,3}}
   {{1,2,3}}

{{1}, {2}, {3}}

{{1,2}, {3}}

{{1,3}, {2}}

{{1}, {2,3}}

El n-ésimo número de Bell, B(n), es el número de particiones de un conjunto de n elementos. Por lo visto anteriormentem B(3) = 5.

Definir las funciones

   particiones :: [a] -> [[[a]]]
   bell :: Integer -> Integer

1 2	particiones :: [a] -> [[[a]]] bell :: Integer -> Integer

tales que

(particiones xs) es el conjunto de las particiones de xs. Por ejemplo,

     λ> particiones [1,2]
     [[[1,2]],[[1],[2]]]
     λ> particiones [1,2,3]
     [[[1,2,3]],[[1],[2,3]],[[1,2],[3]],[[2],[1,3]],[[1],[2],[3]]]
     λ> particiones "abcd"
     [["abcd"],["a","bcd"],["ab","cd"],["b","acd"],["abc","d"],["bc","ad"],
      ["ac","bd"],["c","abd"],["a","b","cd"],["a","bc","d"],["a","c","bd"],
      ["ab","c","d"],["b","ac","d"],["b","c","ad"],["a","b","c","d"]]

λ> particiones [1,2]

[[[1,2]],[[1],[2]]]

λ> particiones [1,2,3]

[[[1,2,3]],[[1],[2,3]],[[1,2],[3]],[[2],[1,3]],[[1],[2],[3]]]

λ> particiones "abcd"

[["abcd"],["a","bcd"],["ab","cd"],["b","acd"],["abc","d"],["bc","ad"],

["ac","bd"],["c","abd"],["a","b","cd"],["a","bc","d"],["a","c","bd"],

["ab","c","d"],["b","ac","d"],["b","c","ad"],["a","b","c","d"]]

(bell n) es el n-ésimo número de Bell. Por ejemplo,

     λ> bell 3
     5
     λ> map bell [0..10]
     [1,1,2,5,15,52,203,877,4140,21147,115975]

λ> bell 3

λ> map bell [0..10]

[1,1,2,5,15,52,203,877,4140,21147,115975]

Comprobar con QuickCheck que (bell n) es equivalente a la función B(n) definida por

$B(0) = 1$
$B(n) = \displaystyle \sum_{k=0}^{n-1} \binom{n-1}{k} B(k)$

Soluciones

import Data.List (genericLength)
import Test.QuickCheck

-- Definición de particiones
-- =========================

particiones :: [a] -> [[[a]]]
particiones [] = [[]]
particiones (x:xs) =
  concat [([x] : yss) : inserta x yss | yss <- ysss]
  where ysss = particiones xs

-- (inserta x yss) es la lista obtenida insertando x en cada uno de los
-- elementos de yss. Por ejemplo, 
--    λ> inserta 1 [[2,3],[4],[5,6,7]]
--    [[[1,2,3],[4],[5,6,7]],[[2,3],[1,4],[5,6,7]],[[2,3],[4],[1,5,6,7]]]
inserta :: a -> [[a]] -> [[[a]]]
inserta _ []       = []
inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss] 

-- Definición de Bell
-- ==================

bell :: Integer -> Integer
bell n = genericLength (particiones [1..n])

-- Propiedad
-- =========

prop_Bell :: Integer -> Property
prop_Bell n =
  n >= 0 ==> bell n == b n

b :: Integer -> Integer
b 0 = 1
b n = sum [comb (n-1) k * b k | k <- [0..n-1]]

comb :: Integer -> Integer -> Integer
comb n k = product [n-k+1..n] `div` product [1..k]

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

import Data.List (genericLength)

import Test.QuickCheck

-- Definición de particiones

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

particiones :: [a] -> [[[a]]]

particiones [] = [[]]

particiones (x:xs) =

concat [([x] : yss) : inserta x yss | yss <- ysss]

where ysss = particiones xs

-- (inserta x yss) es la lista obtenida insertando x en cada uno de los

-- elementos de yss. Por ejemplo,

-- λ> inserta 1 [[2,3],[4],[5,6,7]]

-- [[[1,2,3],[4],[5,6,7]],[[2,3],[1,4],[5,6,7]],[[2,3],[4],[1,5,6,7]]]

inserta :: a -> [[a]] -> [[[a]]]

inserta _ [] = []

inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss]

-- Definición de Bell

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

bell :: Integer -> Integer

bell n = genericLength (particiones [1..n])

-- Propiedad

-- =========

prop_Bell :: Integer -> Property

prop_Bell n =

n >= 0 ==> bell n == b n

b :: Integer -> Integer

b 0 = 1

b n = sum [comb (n-1) k * b k | k <- [0..n-1]]

comb :: Integer -> Integer -> Integer

comb n k = product [n-k+1..n] `div` product [1..k]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=10}) prop_Bell

-- +++ OK, passed 100 tests.

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«Cambiemos nuestra actitud tradicional en la construcción de programas. En lugar de imaginar que nuestra tarea principal es indicarle a una computadora lo que debe hacer, concentrémonos más bien en explicarle a los seres humanos lo que queremos que haga una computadora.»

Donald Knuth.

Máximo número de consecutivos iguales al dado

PorJosé A. Alonso 4-febrero-202011-febrero-2020

Definir la función

   maximoConsecutivosIguales :: Eq a => a -> [a] -> Int

1	maximoConsecutivosIguales :: Eq a => a -> [a] -> Int

tal que (maximoConsecutivosIguales x xs) es el mayor número de elementos consecutivos en xs iguales a x. Por ejemplo,

   maximoConsecutivosIguales 'b' "abbcccbbbd"    ==  3
   maximoConsecutivosIguales 'b' "abbbbcccbbbd"  ==  4
   maximoConsecutivosIguales 'e' "abbcccbbbd"    ==  0

maximoConsecutivosIguales 'b' "abbcccbbbd" == 3

maximoConsecutivosIguales 'b' "abbbbcccbbbd" == 4

maximoConsecutivosIguales 'e' "abbcccbbbd" == 0

Soluciones

import Data.List (group)

maximoConsecutivosIguales :: Eq a => a -> [a] -> Int
maximoConsecutivosIguales x = maximum
                            . (0:)
                            . map length
                            . filter ((== x) . head)
                            . group

import Data.List (group)

maximoConsecutivosIguales :: Eq a => a -> [a] -> Int

maximoConsecutivosIguales x = maximum

. (0:)

. map length

. filter ((== x) . head)

. group

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«La programación de computadoras es un arte, porque aplica el conocimiento
acumulado al mundo, porque requiere habilidad e ingenio, y especialmente
porque produce belleza. Un programador que subconscientemente se ve
a sí mismo como un artista disfrutará con lo que hace y lo hará mejor.»

Donald Knuth.