José A. Alonso

Sumas parciales

PorJosé A. Alonso 8-marzo-202115-marzo-2021

Los sufijos de la lista [3,7,2,5,4,6] son

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

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

[7,2,5,4,6]

[2,5,4,6]

[5,4,6]

[4,6]

[6]

[]

y la lista de sus sumas es [27,24,17,15,10,6,0].

Definir la función

   sumasParciales :: [Integer] -> [Integer]

1	sumasParciales :: [Integer] -> [Integer]

tal que (sumasParciales xs) es la lista de las sumas de los sufijos de xs. Por ejemplo,

   sumasParciales [3,7,2,5,4,6]  ==  [27,24,17,15,10,6,0]
   sumasParciales [1..10]        ==  [55,54,52,49,45,40,34,27,19,10,0]
   sum (sumasParciales [1..5*10^6])  ==  41666679166667500000

sumasParciales [3,7,2,5,4,6] == [27,24,17,15,10,6,0]

sumasParciales [1..10] == [55,54,52,49,45,40,34,27,19,10,0]

sum (sumasParciales [1..5*10^6]) == 41666679166667500000

Soluciones

import Data.List (tails)

-- 1ª solución
sumasParciales1 :: [Integer] -> [Integer]
sumasParciales1 xs = map sum (tails xs)

-- 2ª solución
sumasParciales2 :: [Integer] -> [Integer]
sumasParciales2 []     = [0]
sumasParciales2 (x:xs) = (x + s):s:ss
  where (s:ss) = sumasParciales2 xs

-- 3ª solución
sumasParciales3 :: [Integer] -> [Integer]
sumasParciales3 = foldr (\x (s:ss) -> (x + s) : (s:ss)) [0]

-- 4ª solución
sumasParciales4 :: [Integer] -> [Integer]
sumasParciales4 xs = scanl (-) (sum xs) xs

-- 5ª solución
sumasParciales5 :: [Integer] -> [Integer]
sumasParciales5 xs = reverse (0 : scanl1 (+) (reverse xs))

-- 6ª solución
sumasParciales6 :: [Integer] -> [Integer]
sumasParciales6 = scanr (+) 0

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

-- La comparación es
--    λ> sum (sumasParciales1 [1..3*10^4])
--    9000450005000
--    (19.70 secs, 40,132,872,616 bytes)
--    λ> sum (sumasParciales2 [1..3*10^4])
--    9000450005000
--    (0.04 secs, 16,932,840 bytes)
--    λ> sum (sumasParciales3 [1..3*10^4])
--    9000450005000
--    (0.02 secs, 13,880,608 bytes)
--    λ> sum (sumasParciales4 [1..3*10^4])
--    9000450005000
--    (0.03 secs, 12,178,080 bytes)
--    λ> sum (sumasParciales5 [1..3*10^4])
--    9000450005000
--    (0.02 secs, 9,974,600 bytes)
--    λ> sum (sumasParciales6 [1..3*10^4])
--    9000450005000
--    (0.02 secs, 10,694,368 bytes)
--
--    λ> sum (sumasParciales2 [1..3*10^6])
--    9000004500000500000
--    (3.13 secs, 1,685,139,696 bytes)
--    λ> sum (sumasParciales3 [1..3*10^6])
--    9000004500000500000
--    (2.37 secs, 1,380,492,448 bytes)
--    λ> sum (sumasParciales4 [1..3*10^6])
--    9000004500000500000
--    (1.84 secs, 1,211,188,264 bytes)
--    λ> sum (sumasParciales5 [1..3*10^6])
--    9000004500000500000
--    (1.22 secs, 987,790,392 bytes)
--    λ> sum (sumasParciales6 [1..3*10^6])
--    9000004500000500000
--    (1.34 secs, 1,059,792,344 bytes)
--
--    λ> sum (sumasParciales5 [1..5*10^6])
--    41666679166667500000
--    (2.36 secs, 1,844,332,576 bytes)
--    λ> sum (sumasParciales6 [1..5*10^6])
--    41666679166667500000
--    (2.03 secs, 1,964,365,912 bytes)

import Data.List (tails)

-- 1ª solución

sumasParciales1 :: [Integer] -> [Integer]

sumasParciales1 xs = map sum (tails xs)

-- 2ª solución

sumasParciales2 :: [Integer] -> [Integer]

sumasParciales2 [] = [0]

sumasParciales2 (x:xs) = (x + s):s:ss

where (s:ss) = sumasParciales2 xs

-- 3ª solución

sumasParciales3 :: [Integer] -> [Integer]

sumasParciales3 = foldr (\x (s:ss) -> (x + s) : (s:ss)) [0]

-- 4ª solución

sumasParciales4 :: [Integer] -> [Integer]

sumasParciales4 xs = scanl (-) (sum xs) xs

-- 5ª solución

sumasParciales5 :: [Integer] -> [Integer]

sumasParciales5 xs = reverse (0 : scanl1 (+) (reverse xs))

-- 6ª solución

sumasParciales6 :: [Integer] -> [Integer]

sumasParciales6 = scanr (+) 0

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sum (sumasParciales1 [1..3*10^4])

-- 9000450005000

-- (19.70 secs, 40,132,872,616 bytes)

-- λ> sum (sumasParciales2 [1..3*10^4])

-- 9000450005000

-- (0.04 secs, 16,932,840 bytes)

-- λ> sum (sumasParciales3 [1..3*10^4])

-- 9000450005000

-- (0.02 secs, 13,880,608 bytes)

-- λ> sum (sumasParciales4 [1..3*10^4])

-- 9000450005000

-- (0.03 secs, 12,178,080 bytes)

-- λ> sum (sumasParciales5 [1..3*10^4])

-- 9000450005000

-- (0.02 secs, 9,974,600 bytes)

-- λ> sum (sumasParciales6 [1..3*10^4])

-- 9000450005000

-- (0.02 secs, 10,694,368 bytes)

-- λ> sum (sumasParciales2 [1..3*10^6])

-- 9000004500000500000

-- (3.13 secs, 1,685,139,696 bytes)

-- λ> sum (sumasParciales3 [1..3*10^6])

-- 9000004500000500000

-- (2.37 secs, 1,380,492,448 bytes)

-- λ> sum (sumasParciales4 [1..3*10^6])

-- 9000004500000500000

-- (1.84 secs, 1,211,188,264 bytes)

-- λ> sum (sumasParciales5 [1..3*10^6])

-- 9000004500000500000

-- (1.22 secs, 987,790,392 bytes)

-- λ> sum (sumasParciales6 [1..3*10^6])

-- 9000004500000500000

-- (1.34 secs, 1,059,792,344 bytes)

-- λ> sum (sumasParciales5 [1..5*10^6])

-- 41666679166667500000

-- (2.36 secs, 1,844,332,576 bytes)

-- λ> sum (sumasParciales6 [1..5*10^6])

-- 41666679166667500000

-- (2.03 secs, 1,964,365,912 bytes)

Nuevas soluciones

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

Siguiente equidigital

PorJosé A. Alonso 5-marzo-202112-marzo-2021

Dos números son equidigitales si tienen el mismo multiconjunto de dígitos. Por ejemplo, 2021 y 2120 son equidigitales ya que ambos tiene a {0,1,2,2} como su multiconjunto de dígitos.

Definir la función

   siguienteEquidigital :: Integer -> Maybe Integer

1	siguienteEquidigital :: Integer -> Maybe Integer

tal que (siguienteEquidigital n) es precisamente el menor número equidigital con n que es mayor que n (es decir, (Just x) si x es dicho número o Nothing si no hay ningún número equidigital con n que sea mayor que n). Por ejemplo,

   siguienteEquidigital 12    ==  Just 21
   siguienteEquidigital 21    ==  Nothing
   siguienteEquidigital 513   ==  Just 531
   siguienteEquidigital 531   ==  Nothing
   siguienteEquidigital 2021  ==  Just 2102
   siguienteEquidigital 2102  ==  Just 2120
   siguienteEquidigital 2120  ==  Just 2201
   siguienteEquidigital 2201  ==  Just 2210
   siguienteEquidigital 2210  ==  Nothing
   fmap (`mod` 1000) (siguienteEquidigital (2^(10^5)))  ==  Just 637

siguienteEquidigital 12 == Just 21

siguienteEquidigital 21 == Nothing

siguienteEquidigital 513 == Just 531

siguienteEquidigital 531 == Nothing

siguienteEquidigital 2021 == Just 2102

siguienteEquidigital 2102 == Just 2120

siguienteEquidigital 2120 == Just 2201

siguienteEquidigital 2201 == Just 2210

siguienteEquidigital 2210 == Nothing

fmap (`mod` 1000) (siguienteEquidigital (2^(10^5))) == Just 637

Soluciones

import Data.List (sort)
import Data.Maybe (listToMaybe)

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

siguienteEquidigital :: Integer -> Maybe Integer
siguienteEquidigital n
  | null xs = Nothing
  | otherwise = Just (head xs)
  where xs = equidigitalesMayores n

-- (equidigitalesMayores n) es la lista de los equidigitales mayores que
-- n. Por ejemplo,
--    equidigitalesMayores 2021  ==  [2102,2120,2201,2210]
--    equidigitalesMayores 2210  ==  []
equidigitalesMayores :: Integer -> [Integer]
equidigitalesMayores n =
  [x | x <- [n+1..mayorEquidigital n],
       sort (show x) == ds]
  where ds = sort (show n)

-- (mayorEquidigital n) es el mayor número equidigital con n. Por ejemplo,
--    mayorEquidigital 2021  ==  2210
--    mayorEquidigital 2210  ==  2210
mayorEquidigital :: Integer -> Integer
mayorEquidigital = read . reverse . sort . show

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

siguienteEquidigital2 :: Integer -> Maybe Integer
siguienteEquidigital2 = listToMaybe . equidigitalesMayores

import Data.List (sort)

import Data.Maybe (listToMaybe)

-- 1ª solución

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

siguienteEquidigital :: Integer -> Maybe Integer

siguienteEquidigital n

| null xs = Nothing

| otherwise = Just (head xs)

where xs = equidigitalesMayores n

-- (equidigitalesMayores n) es la lista de los equidigitales mayores que

-- n. Por ejemplo,

-- equidigitalesMayores 2021 == [2102,2120,2201,2210]

-- equidigitalesMayores 2210 == []

equidigitalesMayores :: Integer -> [Integer]

equidigitalesMayores n =

[x | x <- [n+1..mayorEquidigital n],

sort (show x) == ds]

where ds = sort (show n)

-- (mayorEquidigital n) es el mayor número equidigital con n. Por ejemplo,

-- mayorEquidigital 2021 == 2210

-- mayorEquidigital 2210 == 2210

mayorEquidigital :: Integer -> Integer

mayorEquidigital = read . reverse . sort . show

-- 2ª solución

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

siguienteEquidigital2 :: Integer -> Maybe Integer

siguienteEquidigital2 = listToMaybe . equidigitalesMayores

Nuevas soluciones

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

Suma de la lista reducida

PorJosé A. Alonso 4-marzo-202111-marzo-2021

Definir las siguientes funciones

   transformada :: Integral a => [a] -> [a]
   reducida     :: Integral a => [a] -> [a]
   sumaReducida :: Integral a => [a] -> a

transformada :: Integral a => [a] -> [a]

reducida :: Integral a => [a] -> [a]

sumaReducida :: Integral a => [a] -> a

tales que

(transformada xs) es la lista obtenida sustituyendo en el primer de elementos consecutivos de xs el mayor por su diferencia, donde se supone que xs es una lista de enteros positivos. Por ejemplo,

     transformada [7,2,6]  ==  [5,2,6]
     transformada [2,7,6]  ==  [2,5,6]
     transformada [2,2,6]  ==  [2,2,4]
     transformada [2,2,2]  ==  [2,2,2]

transformada [7,2,6] == [5,2,6]

transformada [2,7,6] == [2,5,6]

transformada [2,2,6] == [2,2,4]

transformada [2,2,2] == [2,2,2]

(reducida xs) es la lista obtenida aplicando la transformación anterior mientras sea posible (es decir, mientras tenga elementos distintos), donde se supone que xs es una lista de enteros positivos. Por ejemplo,

     reducida [7,2,6]   ==  [1,1,1]
     reducida [6,9,21]  ==  [3,3,3]

1 2	reducida [7,2,6] == [1,1,1] reducida [6,9,21] == [3,3,3]

(sumaReducida xs) es la suma de la reducida de la lista xs. Por ejemplo,

     sumaReducida1 [7,2,6]   ==  3
     sumaReducida1 [6,9,21]  ==  9

1 2	sumaReducida1 [7,2,6] == 3 sumaReducida1 [6,9,21] == 9

Soluciones

import Data.List (genericLength)

-- Definición de transformada
-- ==========================

transformada :: Integral a => [a] -> [a]
transformada []  = []
transformada [x] = [x]
transformada (x:y:zs)
  | x > y = x-y : y : zs
  | x < y = x : y-x : zs
  | otherwise = x : transformada (y:zs)

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

reducida1 :: Integral a => [a] -> [a]
reducida1 xs
  | xs == ys  = xs
  | otherwise = reducida ys
  where ys = transformada xs

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

reducida2 :: Integral a => [a] -> [a]
reducida2 xs =
  replicate (length xs) (foldl1 gcd xs)

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

-- La comparación es
--    λ> sum (reducida1 [2,4..4*10^6])
--    4000000
--    (1.97 secs, 1,277,797,888 bytes)
--    λ> sum (reducida2 [2,4..4*10^6])
--    4000000
--    (1.92 secs, 1,277,798,344 bytes)

-- Definición de reducida
-- =======================

reducida :: Integral a => [a] -> [a]
reducida = reducida2

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

sumaReducida1 :: Integral a => [a] -> a
sumaReducida1 = sum . reducida

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

sumaReducida2 :: Integral a => [a] -> a
sumaReducida2 xs = genericLength xs * foldl1 gcd xs

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

-- La comparación es
--    λ> sumaReducida1 [2,4..4*10^6]
--    4000000
--    (2.53 secs, 1,277,796,760 bytes)
--    λ> sumaReducida2 [2,4..4*10^6]
--    4000000
--    (1.89 secs, 1,214,376,960 bytes)

import Data.List (genericLength)

-- Definición de transformada

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

transformada :: Integral a => [a] -> [a]

transformada [] = []

transformada [x] = [x]

transformada (x:y:zs)

| x > y = x-y : y : zs

| x < y = x : y-x : zs

| otherwise = x : transformada (y:zs)

-- 1ª definición de reducida

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

reducida1 :: Integral a => [a] -> [a]

reducida1 xs

| xs == ys = xs

| otherwise = reducida ys

where ys = transformada xs

-- 2ª definición de reducida

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

reducida2 :: Integral a => [a] -> [a]

reducida2 xs =

replicate (length xs) (foldl1 gcd xs)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sum (reducida1 [2,4..4*10^6])

-- 4000000

-- (1.97 secs, 1,277,797,888 bytes)

-- λ> sum (reducida2 [2,4..4*10^6])

-- 4000000

-- (1.92 secs, 1,277,798,344 bytes)

-- Definición de reducida

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

reducida :: Integral a => [a] -> [a]

reducida = reducida2

-- 1ª definición de sumaReducida

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

sumaReducida1 :: Integral a => [a] -> a

sumaReducida1 = sum . reducida

-- 2ª solución

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

sumaReducida2 :: Integral a => [a] -> a

sumaReducida2 xs = genericLength xs * foldl1 gcd xs

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaReducida1 [2,4..4*10^6]

-- 4000000

-- (2.53 secs, 1,277,796,760 bytes)

-- λ> sumaReducida2 [2,4..4*10^6]

-- 4000000

-- (1.89 secs, 1,214,376,960 bytes)

Nuevas soluciones

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

Espirales

PorJosé A. Alonso 3-marzo-202110-marzo-2021

Definir la función

   espiral :: Int -> [[Int]]

1	espiral :: Int -> [[Int]]

tal que (espiral n) es la espiral de orden n (es decir, con n filas y n columnas). Por ejemplo,

   λ> mapM_ print (espiral 5)
   [1,1,1,1,1]
   [0,0,0,0,1]
   [1,1,1,0,1]
   [1,0,0,0,1]
   [1,1,1,1,1]
   λ> mapM_ print (espiral 6)
   [1,1,1,1,1,1]
   [0,0,0,0,0,1]
   [1,1,1,1,0,1]
   [1,0,0,1,0,1]
   [1,0,0,0,0,1]
   [1,1,1,1,1,1]
   λ> mapM_ print (espiral 7)
   [1,1,1,1,1,1,1]
   [0,0,0,0,0,0,1]
   [1,1,1,1,1,0,1]
   [1,0,0,0,1,0,1]
   [1,0,1,1,1,0,1]
   [1,0,0,0,0,0,1]
   [1,1,1,1,1,1,1]
   λ> mapM_ print (espiral 8)
   [1,1,1,1,1,1,1,1]
   [0,0,0,0,0,0,0,1]
   [1,1,1,1,1,1,0,1]
   [1,0,0,0,0,1,0,1]
   [1,0,1,0,0,1,0,1]
   [1,0,1,1,1,1,0,1]
   [1,0,0,0,0,0,0,1]
   [1,1,1,1,1,1,1,1]

λ> mapM_ print (espiral 5)

[1,1,1,1,1]

[0,0,0,0,1]

[1,1,1,0,1]

[1,0,0,0,1]

[1,1,1,1,1]

λ> mapM_ print (espiral 6)

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

[0,0,0,0,0,1]

[1,1,1,1,0,1]

[1,0,0,1,0,1]

[1,0,0,0,0,1]

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

λ> mapM_ print (espiral 7)

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

[0,0,0,0,0,0,1]

[1,1,1,1,1,0,1]

[1,0,0,0,1,0,1]

[1,0,1,1,1,0,1]

[1,0,0,0,0,0,1]

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

λ> mapM_ print (espiral 8)

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

[0,0,0,0,0,0,0,1]

[1,1,1,1,1,1,0,1]

[1,0,0,0,0,1,0,1]

[1,0,1,0,0,1,0,1]

[1,0,1,1,1,1,0,1]

[1,0,0,0,0,0,0,1]

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

Nota: La serpiente (formada por los 1) nunca se puede tocar a ella misma.

Soluciones

import Data.List (transpose)

espiral :: Int -> [[Int]]
espiral n = espiralAux n n

espiralAux :: Int -> Int -> [[Int]]
espiralAux 0 _ = []
espiralAux 1 1 = [[1]]
espiralAux n m = primeraFila n : segundaFila n : filasDesdeTercera n m

-- (primeraFila n) es la primera fila de la espiral de orden n. Por
-- ejemplo,
--    λ> primeraFila 5
--    [1,1,1,1,1]
primeraFila :: Int -> [Int]
primeraFila n = replicate n 1

-- (segundaFila n) es la segunda de la espiral de orden n. Por
-- ejemplo,
--    λ> segundaFila 5
--    [0,0,0,0,1]
segundaFila :: Int -> [Int]
segundaFila n = replicate (n-1) 0 ++ [1]

-- (filasDesdeTercera n m), cuando n = m, es la lista de las filas de la
-- espiral de orden n a partir de la tercera. Por ejemplo,
--    λ> mapM_ print (filasDesdeTercera 5 5)
--    [1,1,1,0,1]
--    [1,0,0,0,1]
--    [1,1,1,1,1]
filasDesdeTercera :: Int -> Int -> [[Int]]
filasDesdeTercera n m = map reverse (transpose (espiralAux (m-2) n))

import Data.List (transpose)

espiral :: Int -> [[Int]]

espiral n = espiralAux n n

espiralAux :: Int -> Int -> [[Int]]

espiralAux 0 _ = []

espiralAux 1 1 = [[1]]

espiralAux n m = primeraFila n : segundaFila n : filasDesdeTercera n m

-- (primeraFila n) es la primera fila de la espiral de orden n. Por

-- ejemplo,

-- λ> primeraFila 5

-- [1,1,1,1,1]

primeraFila :: Int -> [Int]

primeraFila n = replicate n 1

-- (segundaFila n) es la segunda de la espiral de orden n. Por

-- ejemplo,

-- λ> segundaFila 5

-- [0,0,0,0,1]

segundaFila :: Int -> [Int]

segundaFila n = replicate (n-1) 0 ++ [1]

-- (filasDesdeTercera n m), cuando n = m, es la lista de las filas de la

-- espiral de orden n a partir de la tercera. Por ejemplo,

-- λ> mapM_ print (filasDesdeTercera 5 5)

-- [1,1,1,0,1]

-- [1,0,0,0,1]

-- [1,1,1,1,1]

filasDesdeTercera :: Int -> Int -> [[Int]]

filasDesdeTercera n m = map reverse (transpose (espiralAux (m-2) n))

Nuevas soluciones

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

Mínima diferencia de las sumas de las biparticiones de las N primeras potencias de dos

PorJosé A. Alonso 2-marzo-20219-marzo-2021

Se consideran las N primeras potencias de 2 (donde N es un número par). Por ejemplo, para N = 4, las potencias de 2 son 1, 2, 4 y 8. Las biparticiones de dichas potencias en dos conjuntos de igual tamaño son

   ([1,2],[4,8]), ([1,4],[2,8]), ([1,8],[2,4])

1	([1,2],[4,8]), ([1,4],[2,8]), ([1,8],[2,4])

Las sumas de los elementos de las biparticiones son

   (3,12), (5,10), (9,6)

1	(3,12), (5,10), (9,6)

Los valores absolutos de las diferencias de dichas sumas son

   9, 5, 3

9, 5, 3

El mínimo de dichas diferencias es 3.

Definir la función

  minimaDiferencia :: Integer -> Integer

1	minimaDiferencia :: Integer -> Integer

tal que (minimaDiferencia n) es la mínima diferencia de las sumas las biparticiones de las n (donde n es un número par) primeras potencias de dos conjuntos con igual número de elementos. Por ejemplo,

   minimaDiferencia 4  ==  3
   minimaDiferencia 6  ==  7
   minimaDiferencia (10^9) `mod` (10^9)  ==  787109375

minimaDiferencia 4 == 3

minimaDiferencia 6 == 7

minimaDiferencia (10^9) `mod` (10^9) == 787109375

Soluciones

import Test.QuickCheck
import Data.List ((\\))

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

minimaDiferencia :: Integer -> Integer
minimaDiferencia n =
  minimum [abs (sum xs - sum ys) | (xs,ys) <- particiones n]

-- (particiones n) es la lista de las particiones de las n (donde n es
-- un número par) de las n primeras potencias de 2 en dos conjuntos de
-- igual tamaño. Por ejemplo,
--   λ> particiones 4
--   [([1,2],[4,8]),([1,4],[2,8]),([1,8],[2,4]),
--    ([2,4],[1,8]),([2,8],[1,4]),([4,8],[1,2])]
particiones :: Integer -> [([Integer],[Integer])]
particiones n =
  [(as,xs \\ as) | as <- kSubconjuntos xs (n `div` 2)]
  where xs = [2^k | k <- [0..n-1]]

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

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

-- Nota: La suma de las primeras (n-1) potencias de 2 es
--    sum [2^i | i <- [0..n-2]] = 2^(n-1) - 1
-- que es menor que la n-ésima potencia de 2 (es decir, 2^(n-1) porque
-- se empieza a contar en 0). Por tanto, para que la diferencia de las
-- suma sea mínima hay que agrupar la última (2^(n-1) con las menores
-- (es decir, desde 0 hasta n/2-2).

minimaDiferencia2 :: Integer -> Integer
minimaDiferencia2 n =
  2^(n-1) + sum [2^i | i <- [0..n `div` 2 - 2]] -
  sum [2^i | i <- [n `div` 2 - 1.. n-2]]

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

-- Nota: Sea m = n/2 - 2. Entonces la suma de la mayor con las menores
-- es
--    s1 = 2^(n-1) + sum [2^i | i <- [0..m]]
--       = 2^(n-1) + (2^(m+1)-1)
-- y, puesto que la suma de las n primeras potencias es 2^n-1, la suma
-- de las restantes es
--    s2 = (2^n-1) - s1

minimaDiferencia3 :: Integer -> Integer
minimaDiferencia3 n = s1 - s2
  where m = n `div` 2 - 2
        s1 = 2^(n-1) + (2^(m+1)-1)
        s2 = (2^n-1) - s1

-- 4ª solución
-- ===========

-- Nota: Con la notación de la solución anterior, la mínima diferencia es
--    s1 - s2
--    = s1 - ((2^n-1) - s1)
--    = 2*s1 - (2^n-1)
--    = 2*(2^(n-1) + (2^(m+1)-1)) - (2^n-1)
--    = 2^n + 2^(m+2) - 2 - 2^n + 1
--    = 2^(m+2) - 1

minimaDiferencia4 :: Integer -> Integer
minimaDiferencia4 n = 2^(m+2) - 1
  where m = n `div` 2 - 2

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

-- La comparación es
--    λ> minimaDiferencia 22
--    2047
--    (7.75 secs, 6,597,330,816 bytes)
--    λ> minimaDiferencia2 22
--    2047
--    (0.00 secs, 126,344 bytes)
--    λ> minimaDiferencia3 22
--    2047
--    (0.01 secs, 107,192 bytes)
--    λ> minimaDiferencia4 22
--    2047
--    (0.01 secs, 102,544 bytes)
--
--    λ> minimaDiferencia2 (10^5) `mod` (10^50)
--    9602443968201967760613102289456131085235835109375
--    (8.18 secs, 2,915,200,064 bytes)
--    λ> minimaDiferencia3 (10^5) `mod` (10^50)
--    9602443968201967760613102289456131085235835109375
--    (0.01 secs, 293,640 bytes)
--    λ> minimaDiferencia4 (10^5) `mod` (10^50)
--    9602443968201967760613102289456131085235835109375
--    (0.03 secs, 167,176 bytes)
--
--    λ> minimaDiferencia3 (10^8) `mod` (10^50)
--    30521751870548886367615394702753936894129787109375
--    (2.08 secs, 149,075,824 bytes)
--    λ> minimaDiferencia4 (10^8) `mod` (10^50)
--    30521751870548886367615394702753936894129787109375
--    (0.41 secs, 24,929,696 bytes)

-- Comprobación de equivalencia
-- ============================

-- Como la primera sólo calcula hasta 22, se compara la primera con la
-- cuarta para dichos valores.
prop_equivalencia1 :: Bool
prop_equivalencia1 =
  and [minimaDiferencia n == minimaDiferencia4 n | n <- [0,2..22]]

-- La comprobación es
--    λ> prop_equivalencia1
--    True

-- La propiedad de la equivalencia de las definiciones 2, 3 y 4 es
prop_equivalencia :: Integer -> Bool
prop_equivalencia n =
  all (== (minimaDiferencia2 n'))
      [minimaDiferencia3 n',
       minimaDiferencia4 n']
  where n' = 2 + abs n

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

import Test.QuickCheck

import Data.List ((\\))

-- 1ª solución

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

minimaDiferencia :: Integer -> Integer

minimaDiferencia n =

minimum [abs (sum xs - sum ys) | (xs,ys) <- particiones n]

-- (particiones n) es la lista de las particiones de las n (donde n es

-- un número par) de las n primeras potencias de 2 en dos conjuntos de

-- igual tamaño. Por ejemplo,

-- λ> particiones 4

-- [([1,2],[4,8]),([1,4],[2,8]),([1,8],[2,4]),

-- ([2,4],[1,8]),([2,8],[1,4]),([4,8],[1,2])]

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

particiones n =

[(as,xs \\ as) | as <- kSubconjuntos xs (n `div` 2)]

where xs = [2^k | k <- [0..n-1]]

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

-- elementos. Por ejemplo,

-- λ> kSubconjuntos "bcde" 2

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

-- λ> kSubconjuntos "bcde" 3

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

-- λ> kSubconjuntos "abcde" 3

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

kSubconjuntos :: [a] -> Integer -> [[a]]

kSubconjuntos _ 0 = [[]]

kSubconjuntos [] _ = []

kSubconjuntos (x:xs) k =

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

-- 2ª solución

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

-- Nota: La suma de las primeras (n-1) potencias de 2 es

-- sum [2^i | i <- [0..n-2]] = 2^(n-1) - 1

-- que es menor que la n-ésima potencia de 2 (es decir, 2^(n-1) porque

-- se empieza a contar en 0). Por tanto, para que la diferencia de las

-- suma sea mínima hay que agrupar la última (2^(n-1) con las menores

-- (es decir, desde 0 hasta n/2-2).

minimaDiferencia2 :: Integer -> Integer

minimaDiferencia2 n =

2^(n-1) + sum [2^i | i <- [0..n `div` 2 - 2]] -

sum [2^i | i <- [n `div` 2 - 1.. n-2]]

-- 3ª solución

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

-- Nota: Sea m = n/2 - 2. Entonces la suma de la mayor con las menores

-- es

-- s1 = 2^(n-1) + sum [2^i | i <- [0..m]]

-- = 2^(n-1) + (2^(m+1)-1)

-- y, puesto que la suma de las n primeras potencias es 2^n-1, la suma

-- de las restantes es

-- s2 = (2^n-1) - s1

minimaDiferencia3 :: Integer -> Integer

minimaDiferencia3 n = s1 - s2

where m = n `div` 2 - 2

s1 = 2^(n-1) + (2^(m+1)-1)

s2 = (2^n-1) - s1

-- 4ª solución

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

-- Nota: Con la notación de la solución anterior, la mínima diferencia es

-- s1 - s2

-- = s1 - ((2^n-1) - s1)

-- = 2*s1 - (2^n-1)

-- = 2*(2^(n-1) + (2^(m+1)-1)) - (2^n-1)

-- = 2^n + 2^(m+2) - 2 - 2^n + 1

-- = 2^(m+2) - 1

minimaDiferencia4 :: Integer -> Integer

minimaDiferencia4 n = 2^(m+2) - 1

where m = n `div` 2 - 2

-- Comparación de eficiencia

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

-- La comparación es

-- λ> minimaDiferencia 22

-- 2047

-- (7.75 secs, 6,597,330,816 bytes)

-- λ> minimaDiferencia2 22

-- 2047

-- (0.00 secs, 126,344 bytes)

-- λ> minimaDiferencia3 22

-- 2047

-- (0.01 secs, 107,192 bytes)

-- λ> minimaDiferencia4 22

-- 2047

-- (0.01 secs, 102,544 bytes)

-- λ> minimaDiferencia2 (10^5) `mod` (10^50)

-- 9602443968201967760613102289456131085235835109375

-- (8.18 secs, 2,915,200,064 bytes)

-- λ> minimaDiferencia3 (10^5) `mod` (10^50)

-- 9602443968201967760613102289456131085235835109375

-- (0.01 secs, 293,640 bytes)

-- λ> minimaDiferencia4 (10^5) `mod` (10^50)

-- 9602443968201967760613102289456131085235835109375

-- (0.03 secs, 167,176 bytes)

-- λ> minimaDiferencia3 (10^8) `mod` (10^50)

-- 30521751870548886367615394702753936894129787109375

-- (2.08 secs, 149,075,824 bytes)

-- λ> minimaDiferencia4 (10^8) `mod` (10^50)

-- 30521751870548886367615394702753936894129787109375

-- (0.41 secs, 24,929,696 bytes)

-- Comprobación de equivalencia

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

-- Como la primera sólo calcula hasta 22, se compara la primera con la

-- cuarta para dichos valores.

prop_equivalencia1 :: Bool

prop_equivalencia1 =

and [minimaDiferencia n == minimaDiferencia4 n | n <- [0,2..22]]

-- La comprobación es

-- λ> prop_equivalencia1

-- True

-- La propiedad de la equivalencia de las definiciones 2, 3 y 4 es

prop_equivalencia :: Integer -> Bool

prop_equivalencia n =

all (== (minimaDiferencia2 n'))

[minimaDiferencia3 n',

minimaDiferencia4 n']

where n' = 2 + abs n

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

Nuevas soluciones

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

Índice del menor elemento a eliminar para que la suma sea divisible por K

PorJosé A. Alonso 1-marzo-20218-marzo-2021

Definir la función

   indice :: [Int] -> Int -> Maybe Int

1	indice :: [Int] -> Int -> Maybe Int

tal que (indice xs k) es el índice del menor elemento a eliminar de la lista de enteros positivos xs para que la suma de los restantes sea divisible por k o Nothing, si no existe dicho elemento. Por ejemplo,

   indice [1,8,4,1] 2         ==  Just 2
   indice [4,6,7,5,7] 11      ==  Just 2
   indice [4,6,7,5,7] 12      ==  Just 3
   indice [4,6,7,5,7] 13      ==  Nothing
   indice [1..10^7] 7         ==  Just 5
   indice [10^7,10^7-1..1] 7  ==  Just 9999994

indice [1,8,4,1] 2 == Just 2

indice [4,6,7,5,7] 11 == Just 2

indice [4,6,7,5,7] 12 == Just 3

indice [4,6,7,5,7] 13 == Nothing

indice [1..10^7] 7 == Just 5

indice [10^7,10^7-1..1] 7 == Just 9999994

Soluciones

import Test.QuickCheck
import Data.List (sort)
import Data.Maybe (listToMaybe)

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

indice :: [Int] -> Int -> Maybe Int
indice xs k
  | null ys   = Nothing
  | otherwise = Just (head ys)
  where ys = [i | (_,i,zs) <- sort (eliminaciones xs),
                  sum zs `mod` k == 0]

-- (eliminaciones xs) es la lista de ternas (x,i,zs) tales que x es un
-- elemento de xs, i es la posición de x en xs y zs es la lista de los
-- restantes elementos de xs. Por ejemplo,
--    λ> eliminaciones [5,7,6,5]
--    [(5,0,[7,6,5]),(7,1,[5,6,5]),(6,2,[5,7,5]),(5,3,[5,7,6])]
eliminaciones :: [a] -> [(a,Int,[a])]
eliminaciones xs = [(z,i,zs) | ((z,zs),i) <- zip (aux xs) [0..]]
  where aux []       = []
        aux [x]      = [(x,[])]
        aux (x:y:zs) = (x,y:zs) : [(v,x:vs) | (v,vs) <- aux (y:zs)]

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

indice2 :: [Int] -> Int -> Maybe Int
indice2 xs k
  | null ys   = Nothing
  | otherwise = Just (head ys)
  where d = sum xs `mod` k
        ys = [i | (x,i) <- sort (zip xs [0..]),
                  x `mod` k == d]

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

indice3 :: [Int] -> Int -> Maybe Int
indice3 xs k = listToMaybe ys
  where d = sum xs `mod` k
        ys = [i | (x,i) <- sort (zip xs [0..]),
                  x `mod` k == d]

-- Comprobación de la equivalencia
-- ===============================

-- La propiedad es
prop_equivalencia :: [Int] -> Int -> Bool
prop_equivalencia xs k =
  indice  xs' k' == indice2 xs' k' &&
  indice2 xs' k' == indice3 xs' k'
  where xs' = map ((+1) . abs) xs
        k'  = 1 + abs k

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

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

-- La comparación es
--    λ> indice [1..5000] 7
--    Just 2
--    (2.82 secs, 2,458,555,104 bytes)
--    λ> indice2 [1..5000] 7
--    Just 2
--    (0.01 secs, 1,991,232 bytes)
--    λ> indice3 [1..5000] 7
--    Just 2
--    (0.01 secs, 1,991,072 bytes)

import Test.QuickCheck

import Data.List (sort)

import Data.Maybe (listToMaybe)

-- 1ª solución

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

indice :: [Int] -> Int -> Maybe Int

indice xs k

| null ys = Nothing

| otherwise = Just (head ys)

where ys = [i | (_,i,zs) <- sort (eliminaciones xs),

sum zs `mod` k == 0]

-- (eliminaciones xs) es la lista de ternas (x,i,zs) tales que x es un

-- elemento de xs, i es la posición de x en xs y zs es la lista de los

-- restantes elementos de xs. Por ejemplo,

-- λ> eliminaciones [5,7,6,5]

-- [(5,0,[7,6,5]),(7,1,[5,6,5]),(6,2,[5,7,5]),(5,3,[5,7,6])]

eliminaciones :: [a] -> [(a,Int,[a])]

eliminaciones xs = [(z,i,zs) | ((z,zs),i) <- zip (aux xs) [0..]]

where aux [] = []

aux [x] = [(x,[])]

aux (x:y:zs) = (x,y:zs) : [(v,x:vs) | (v,vs) <- aux (y:zs)]

-- 2ª solución

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

indice2 :: [Int] -> Int -> Maybe Int

indice2 xs k

| null ys = Nothing

| otherwise = Just (head ys)

where d = sum xs `mod` k

ys = [i | (x,i) <- sort (zip xs [0..]),

x `mod` k == d]

-- 3ª solución

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

indice3 :: [Int] -> Int -> Maybe Int

indice3 xs k = listToMaybe ys

where d = sum xs `mod` k

ys = [i | (x,i) <- sort (zip xs [0..]),

x `mod` k == d]

-- Comprobación de la equivalencia

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

-- La propiedad es

prop_equivalencia :: [Int] -> Int -> Bool

prop_equivalencia xs k =

indice xs' k' == indice2 xs' k' &&

indice2 xs' k' == indice3 xs' k'

where xs' = map ((+1) . abs) xs

k' = 1 + abs k

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> indice [1..5000] 7

-- Just 2

-- (2.82 secs, 2,458,555,104 bytes)

-- λ> indice2 [1..5000] 7

-- Just 2

-- (0.01 secs, 1,991,232 bytes)

-- λ> indice3 [1..5000] 7

-- Just 2

-- (0.01 secs, 1,991,072 bytes)

Nuevas soluciones

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

Eliminaciones anotadas

PorJosé A. Alonso 26-febrero-20215-marzo-2021

Definir la función

   eliminaciones :: [a] -> [(a,Int,[a])]

1	eliminaciones :: [a] -> [(a,Int,[a])]

tal que (eliminaciones xs) es la lista de ternas (x,i,zs) tales que x es un elemento de xs, i es la posición de x en xs y zs es la lista de los restantes elementos de xs. Por ejemplo,

   λ> eliminaciones [5,7,6,5]
   [(5,0,[7,6,5]),(7,1,[5,6,5]),(6,2,[5,7,5]),(5,3,[5,7,6])]

1 2	λ> eliminaciones [5,7,6,5] [(5,0,[7,6,5]),(7,1,[5,6,5]),(6,2,[5,7,5]),(5,3,[5,7,6])]

Soluciones

import Test.QuickCheck (quickCheck)

-- 1ª solución
eliminaciones :: [a] -> [(a,Int,[a])]
eliminaciones xs = [(z,i,zs) | ((z,zs),i) <- zip (aux xs) [0..]]
  where aux []       = []
        aux [x]      = [(x,[])]
        aux (x:y:zs) = (x,y:zs) : [(v,x:vs) | (v,vs) <- aux (y:zs)]

-- 2ª solución
eliminaciones2 :: [a] -> [(a,Int,[a])]
eliminaciones2 xs =
  [(v,i,us++vs) | i <- [0..length xs - 1],
                  let (us,v:vs) = splitAt i xs]

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_equivalencia :: [Int] -> Bool
prop_equivalencia xs =
  eliminaciones xs == eliminaciones2 xs

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

import Test.QuickCheck (quickCheck)

-- 1ª solución

eliminaciones :: [a] -> [(a,Int,[a])]

eliminaciones xs = [(z,i,zs) | ((z,zs),i) <- zip (aux xs) [0..]]

where aux [] = []

aux [x] = [(x,[])]

aux (x:y:zs) = (x,y:zs) : [(v,x:vs) | (v,vs) <- aux (y:zs)]

-- 2ª solución

eliminaciones2 :: [a] -> [(a,Int,[a])]

eliminaciones2 xs =

[(v,i,us++vs) | i <- [0..length xs - 1],

let (us,v:vs) = splitAt i xs]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equivalencia :: [Int] -> Bool

prop_equivalencia xs =

eliminaciones xs == eliminaciones2 xs

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

Nuevas soluciones

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

Ternas crecientes de primos con el mayor igual a la suma de los menores

PorJosé A. Alonso 25-febrero-20214-marzo-2021

Definir la función

   ternasPrimas :: [(Integer,Integer,Integer)]

1	ternasPrimas :: [(Integer,Integer,Integer)]

tal que sus elementos son las ternas crecientes de primos con el mayor igual a la suma de los menores. Por ejemplo,

   ternasPrimas  ==  (2,3,5)
   ternasPrimas !! 34567  ==  (2,5393909,5393911)

1 2	ternasPrimas == (2,3,5) ternasPrimas !! 34567 == (2,5393909,5393911)

Soluciones

import Data.Numbers.Primes (primes)

ternasPrimas :: [(Integer,Integer,Integer)]
ternasPrimas = [(2,a,b) | (a,b) <- zip (primes) (tail (primes)),
                          a + 2 == b]

import Data.Numbers.Primes (primes)

ternasPrimas :: [(Integer,Integer,Integer)]

ternasPrimas = [(2,a,b) | (a,b) <- zip (primes) (tail (primes)),

a + 2 == b]

Nuevas soluciones

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

Máximo de las rotaciones

PorJosé A. Alonso 24-febrero-20213-marzo-2021

Las rotaciones del número 3252 son [3252, 2523, 5232, 2325] y el mayor de dichos números es 5232.

Definir la función

   maximoRotaciones :: Integer -> Integer

1	maximoRotaciones :: Integer -> Integer

tal que (maximoRotaciones n) es el mayor número obtenido rotando los dígitos de n. Por ejemplo,

   maximoRotaciones 3252    ==  5232
   maximoRotaciones 913942  ==  942913
   maximoRotaciones (234 + 10^(10^6)) `div` (10^(10^6))  ==  4

maximoRotaciones 3252 == 5232

maximoRotaciones 913942 == 942913

maximoRotaciones (234 + 10^(10^6)) `div` (10^(10^6)) == 4

Soluciones

import Data.List (inits, tails)

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

maximoRotaciones :: Integer -> Integer
maximoRotaciones = maximum . rotacionesNumero

-- (rotacionesNumero n) es la lista de las rotaciones obtenidas desplazando
-- el primer dígito de n al final. Por ejemplo,
--    rotacionesNumero 325  ==  [325,253,532]
rotacionesNumero :: Integer -> [Integer]
rotacionesNumero = map read . rotaciones . show

-- (rotaciones xs) es la lista de las rotaciones obtenidas desplazando
-- el primer elemento xs al final. Por ejemplo,
--    rotaciones [2,3,5]  ==  [[2,3,5],[3,5,2],[5,2,3]]
rotaciones :: [a] -> [[a]]
rotaciones xs = take (length xs) (iterate rota xs)

-- (rota xs) es la lista añadiendo el primer elemento de xs al
-- final. Por ejemplo,
--    rota [3,2,5,7]  ==  [2,5,7,3]
rota :: [a] -> [a]
rota (x:xs) = xs ++ [x]

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

maximoRotaciones2 :: Integer -> Integer
maximoRotaciones2 n =
  maximum (rotacionesDigito n (maximoDigito n))

-- (maximoDigito n) es el máximo de los dígitos de n. Por ejemplo,
--    maximoDigito 291394  ==  9
maximoDigito :: Integer -> Integer
maximoDigito n =
  read [maximum (show n)]

-- (rotacionesDigito n k) es la lista de las rotaciones de n cuyo primer
-- dígito es k. Por ejemplo,
--    rotacionesDigito 291394 9  ==  [913942,942913]
rotacionesDigito :: Integer -> Integer -> [Integer]
rotacionesDigito n k =
  [read (vs ++ us) | (us,vs) <- particiones (show n) (head (show k))]

-- (particiones xs y) es la lista de las particiones de xs en dos partes
-- tales que el primer elemento de la segunda parte es y. Por
-- ejemplo,
--    particiones [2,9,1,3,9,4] 9   == [([2],[9,1,3,9,4]),([2,9,1,3],[9,4])]
--    particiones [2,9,1,3,9,4] 3   == [([2,9,1],[3,9,4])]
--    particiones [2,9,1,3,9,4] 7   == []
--    particiones "Particiones" 'i' == [("Part","iciones"),("Partic","iones")]
particiones :: Eq a => [a] -> a -> [([a],[a])]
particiones xs y =
  [(prefijoSufijo xs zs,zs) | zs <- sufijos xs y]

-- (sufijos xs y) es la lista de los sufijos de xs que empiezan por
-- y. Por ejemplo,
--   λ> sufijos "particiones" 'i'
--   ["iciones","iones"]
sufijos :: Eq a => [a] -> a -> [[a]]
sufijos xs y = filter ((== y) . head) (init (tails xs))

-- (prefijoSufijo xs zs) es el prefijo de xs que junto con el sufijo zs
-- forma la lista xs. Por ejemplo,
--   λ> prefijoSufijo "particiones" "iciones"
--   "part"
prefijoSufijo :: [a] -> [a] -> [a]
prefijoSufijo xs zs = (inits xs) !! (length xs - length zs)

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_equivalencia :: Integer -> Property
prop_equivalencia n =
  n > 0 ==>
  maximoRotaciones n == maximoRotaciones2 n

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

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

-- La comparación es
--    λ> maximoRotaciones (product [1..2000]) `mod` (10^20)
--    64970515522882052348
--    (4.59 secs, 13,275,801,696 bytes)
--    λ> maximoRotaciones2 (product [1..2000]) `mod` (10^20)
--    64970515522882052348
--    (0.41 secs, 1,132,544,240 bytes)
--
--    λ> read (take 9 (show (maximoRotaciones (234 + 10^(10^4))))) :: Integer
--    410000000
--    (12.53 secs, 36,326,102,416 bytes)
--    λ> read (take 9 (show (maximoRotaciones2 (234 + 10^(10^4))))) :: Integer
--    410000000
--    (0.03 secs, 6,227,024 bytes)

100

101

import Data.List (inits, tails)

-- 1ª solución

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

maximoRotaciones :: Integer -> Integer

maximoRotaciones = maximum . rotacionesNumero

-- (rotacionesNumero n) es la lista de las rotaciones obtenidas desplazando

-- el primer dígito de n al final. Por ejemplo,

-- rotacionesNumero 325 == [325,253,532]

rotacionesNumero :: Integer -> [Integer]

rotacionesNumero = map read . rotaciones . show

-- (rotaciones xs) es la lista de las rotaciones obtenidas desplazando

-- el primer elemento xs al final. Por ejemplo,

-- rotaciones [2,3,5] == [[2,3,5],[3,5,2],[5,2,3]]

rotaciones :: [a] -> [[a]]

rotaciones xs = take (length xs) (iterate rota xs)

-- (rota xs) es la lista añadiendo el primer elemento de xs al

-- final. Por ejemplo,

-- rota [3,2,5,7] == [2,5,7,3]

rota :: [a] -> [a]

rota (x:xs) = xs ++ [x]

-- 2ª solución

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

maximoRotaciones2 :: Integer -> Integer

maximoRotaciones2 n =

maximum (rotacionesDigito n (maximoDigito n))

-- (maximoDigito n) es el máximo de los dígitos de n. Por ejemplo,

-- maximoDigito 291394 == 9

maximoDigito :: Integer -> Integer

maximoDigito n =

read [maximum (show n)]

-- (rotacionesDigito n k) es la lista de las rotaciones de n cuyo primer

-- dígito es k. Por ejemplo,

-- rotacionesDigito 291394 9 == [913942,942913]

rotacionesDigito :: Integer -> Integer -> [Integer]

rotacionesDigito n k =

[read (vs ++ us) | (us,vs) <- particiones (show n) (head (show k))]

-- (particiones xs y) es la lista de las particiones de xs en dos partes

-- tales que el primer elemento de la segunda parte es y. Por

-- ejemplo,

-- particiones [2,9,1,3,9,4] 9 == [([2],[9,1,3,9,4]),([2,9,1,3],[9,4])]

-- particiones [2,9,1,3,9,4] 3 == [([2,9,1],[3,9,4])]

-- particiones [2,9,1,3,9,4] 7 == []

-- particiones "Particiones" 'i' == [("Part","iciones"),("Partic","iones")]

particiones :: Eq a => [a] -> a -> [([a],[a])]

particiones xs y =

[(prefijoSufijo xs zs,zs) | zs <- sufijos xs y]

-- (sufijos xs y) es la lista de los sufijos de xs que empiezan por

-- y. Por ejemplo,

-- λ> sufijos "particiones" 'i'

-- ["iciones","iones"]

sufijos :: Eq a => [a] -> a -> [[a]]

sufijos xs y = filter ((== y) . head) (init (tails xs))

-- (prefijoSufijo xs zs) es el prefijo de xs que junto con el sufijo zs

-- forma la lista xs. Por ejemplo,

-- λ> prefijoSufijo "particiones" "iciones"

-- "part"

prefijoSufijo :: [a] -> [a] -> [a]

prefijoSufijo xs zs = (inits xs) !! (length xs - length zs)

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equivalencia :: Integer -> Property

prop_equivalencia n =

n > 0 ==>

maximoRotaciones n == maximoRotaciones2 n

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximoRotaciones (product [1..2000]) `mod` (10^20)

-- 64970515522882052348

-- (4.59 secs, 13,275,801,696 bytes)

-- λ> maximoRotaciones2 (product [1..2000]) `mod` (10^20)

-- 64970515522882052348

-- (0.41 secs, 1,132,544,240 bytes)

-- λ> read (take 9 (show (maximoRotaciones (234 + 10^(10^4))))) :: Integer

-- 410000000

-- (12.53 secs, 36,326,102,416 bytes)

-- λ> read (take 9 (show (maximoRotaciones2 (234 + 10^(10^4))))) :: Integer

-- 410000000

-- (0.03 secs, 6,227,024 bytes)

Nuevas soluciones

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

Particiones por un elemento

PorJosé A. Alonso 23-febrero-20212-marzo-2021

Definir la función

   particiones :: Eq a => [a] -> a -> [([a],[a])]

1	particiones :: Eq a => [a] -> a -> [([a],[a])]

tal que (particiones xs y) es la lista de las particiones de xs en dos partes tales que el primer elemento de la segunda parte es y. Por ejemplo,

   particiones [2,9,1,3,9,4] 9   == [([2],[9,1,3,9,4]),([2,9,1,3],[9,4])]
   particiones [2,9,1,3,9,4] 3   == [([2,9,1],[3,9,4])]
   particiones [2,9,1,3,9,4] 7   == []
   particiones "Particiones" 'i' == [("Part","iciones"),("Partic","iones")]

particiones [2,9,1,3,9,4] 9 == [([2],[9,1,3,9,4]),([2,9,1,3],[9,4])]

particiones [2,9,1,3,9,4] 3 == [([2,9,1],[3,9,4])]

particiones [2,9,1,3,9,4] 7 == []

particiones "Particiones" 'i' == [("Part","iciones"),("Partic","iones")]

Soluciones

import Data.List (tails, inits)

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

particiones :: Eq a => [a] -> a -> [([a],[a])]
particiones [] _ = []
particiones xs y
  | null vs = []
  | otherwise = (us,vs) : [(us ++ y:us', vs')
                          | (us',vs') <- particiones (tail vs) y ]
  where (us,vs) = span (/=y) xs

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

particiones2 :: Eq a => [a] -> a -> [([a],[a])]
particiones2 xs y =
  [(ys,z:zs) | (ys,z:zs) <- listaPares xs, z == y]

-- (listaPares xs) es la lista de los pares que resultan al dividir la
-- lista xs en dos partes. Por ejemplo,
--    λ> listaPares [2,9,1,3,9,4]
--    [([],[2,9,1,3,9,4]),([2],[9,1,3,9,4]),([2,9],[1,3,9,4]),([2,9,1],[3,9,4]),
--    ([2,9,1,3],[9,4]),([2,9,1,3,9],[4])]
listaPares :: [a] -> [([a],[a])]
listaPares xs = init (zip (inits xs) (tails xs))

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

particiones3 :: Eq a => [a] -> a -> [([a],[a])]
particiones3 xs y =
  [(prefijoSufijo xs zs,zs) | zs <- sufijos xs y]

-- (sufijos xs y) es la lista de los sufijos de xs que empiezan por
-- y. Por ejemplo,
--   λ> sufijos "particiones" 'i'
--   ["iciones","iones"]
sufijos :: Eq a => [a] -> a -> [[a]]
sufijos xs y = filter ((== y) . head) (init (tails xs))

-- (prefijoSufijo xs zs) es el prefijo de xs que junto con el sufijo zs
-- forma la lista xs. Por ejemplo,
--   λ> prefijoSufijo "particiones" "iciones"
--   "part"
prefijoSufijo :: [a] -> [a] -> [a]
prefijoSufijo xs zs = (inits xs) !! (length xs - length zs)

-- Comprobación de la equivalencia
-- ===============================

-- La propiedad es
prop_equivalencia :: [Int] -> Int -> Bool
prop_equivalencia xs y =
  particiones xs y'  == particiones2 xs y' &&
  particiones2 xs y' == particiones3 xs y'
  where y' = y `mod` length xs

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

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

-- La comparación es
--    λ> length (particiones (take (10^5) (cycle [1..9])) 5)
--    11111
--    (9.10 secs, 13,375,324,416 bytes)
--    λ> length (particiones2 (take (10^5) (cycle [1..9])) 5)
--    11111
--    (0.08 secs, 44,107,672 bytes)
--    λ> length (particiones3 (take (10^5) (cycle [1..9])) 5)
--    11111
--    (0.07 secs, 21,524,936 bytes)
--
--    λ> length (particiones2 (take (10^7) (cycle [1..9])) 5)
--    1111111
--    (3.93 secs, 4,400,105,800 bytes)
--    λ> length (particiones3 (take (10^7) (cycle [1..9])) 5)
--    1111111
--    (1.88 secs, 2,142,328,800 bytes)

import Data.List (tails, inits)

-- 1ª solución

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

particiones :: Eq a => [a] -> a -> [([a],[a])]

particiones [] _ = []

particiones xs y

| null vs = []

| otherwise = (us,vs) : [(us ++ y:us', vs')

| (us',vs') <- particiones (tail vs) y ]

where (us,vs) = span (/=y) xs

-- 2ª solución

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

particiones2 :: Eq a => [a] -> a -> [([a],[a])]

particiones2 xs y =

[(ys,z:zs) | (ys,z:zs) <- listaPares xs, z == y]

-- (listaPares xs) es la lista de los pares que resultan al dividir la

-- lista xs en dos partes. Por ejemplo,

-- λ> listaPares [2,9,1,3,9,4]

-- [([],[2,9,1,3,9,4]),([2],[9,1,3,9,4]),([2,9],[1,3,9,4]),([2,9,1],[3,9,4]),

-- ([2,9,1,3],[9,4]),([2,9,1,3,9],[4])]

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

listaPares xs = init (zip (inits xs) (tails xs))

-- 3ª solución

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

particiones3 :: Eq a => [a] -> a -> [([a],[a])]

particiones3 xs y =

[(prefijoSufijo xs zs,zs) | zs <- sufijos xs y]

-- (sufijos xs y) es la lista de los sufijos de xs que empiezan por

-- y. Por ejemplo,

-- λ> sufijos "particiones" 'i'

-- ["iciones","iones"]

sufijos :: Eq a => [a] -> a -> [[a]]

sufijos xs y = filter ((== y) . head) (init (tails xs))

-- (prefijoSufijo xs zs) es el prefijo de xs que junto con el sufijo zs

-- forma la lista xs. Por ejemplo,

-- λ> prefijoSufijo "particiones" "iciones"

-- "part"

prefijoSufijo :: [a] -> [a] -> [a]

prefijoSufijo xs zs = (inits xs) !! (length xs - length zs)

-- Comprobación de la equivalencia

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

-- La propiedad es

prop_equivalencia :: [Int] -> Int -> Bool

prop_equivalencia xs y =

particiones xs y' == particiones2 xs y' &&

particiones2 xs y' == particiones3 xs y'

where y' = y `mod` length xs

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (particiones (take (10^5) (cycle [1..9])) 5)

-- 11111

-- (9.10 secs, 13,375,324,416 bytes)

-- λ> length (particiones2 (take (10^5) (cycle [1..9])) 5)

-- 11111

-- (0.08 secs, 44,107,672 bytes)

-- λ> length (particiones3 (take (10^5) (cycle [1..9])) 5)

-- 11111

-- (0.07 secs, 21,524,936 bytes)

-- λ> length (particiones2 (take (10^7) (cycle [1..9])) 5)

-- 1111111

-- (3.93 secs, 4,400,105,800 bytes)

-- λ> length (particiones3 (take (10^7) (cycle [1..9])) 5)

-- 1111111

-- (1.88 secs, 2,142,328,800 bytes)

Nuevas soluciones

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

Sumas de potencias que son cuadrados perfectos

PorJosé A. Alonso 22-febrero-20211-marzo-2021

El 2º problema de la ONEM (Olimpíada Nacional Escolar de Matemática) de Mayo del 2020 dice

Determinar si existen enteros positivos a, b y c, no necesariamente distintos, tales que $a+b+c=2020$ y $2^a + 2^b + 2^c$ es un cuadrado perfecto.

Definir la función

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

1	soluciones :: Integer -> Integer -> [(Integer,Integer,Integer)]

tales que (soluciones k n) es la lista de las ternas no decrecientes (a,b,c) tales que que a+b+c=n y k^a + k^b + k^c es un cuadrado perfecto. Por ejemplo,

   soluciones 2 19  ==  [(2,6,11),(2,7,10),(4,7,8),(5,5,9),(6,6,7)]
   soluciones 3 19  ==  []
   take 2 (soluciones 2 2020)  ==  [(2,674,1344),(4,674,1342)]

soluciones 2 19 == [(2,6,11),(2,7,10),(4,7,8),(5,5,9),(6,6,7)]

soluciones 3 19 == []

take 2 (soluciones 2 2020) == [(2,674,1344),(4,674,1342)]

Soluciones

soluciones :: Integer -> Integer -> [(Integer,Integer,Integer)]
soluciones k n =
  [(a,b,c) | a <- [1..n `div` 3],
             b <- [a..n-a],
             let c = n-a-b,
             c >= b,
             esCuadradoPerfecto (k^a + k^b + k^c)]

-- (esCuadradoPerfecto x) se verifica si x es un cuadrado perfecto. Por
-- ejemplo,
--    esCuadradoPerfecto 16  ==  True
--    esCuadradoPerfecto 27  ==  False
esCuadradoPerfecto :: Integer -> Bool
esCuadradoPerfecto x =
  (raizEntera x)^2 == x

-- (raizEntera x) es el mayor entero cuyo cuadrado es menor o igual que
-- x. Por ejemplo,
--    raizEntera 16  ==  4
--    raizEntera 27  ==  5
raizEntera :: Integer -> Integer
raizEntera x = aux (1,x)
    where aux (a,b) | d == x    = c
                    | c == a    = c
                    | d < x     = aux (c,b)
                    | otherwise = aux (a,c)
              where c = (a+b) `div` 2
                    d = c^2

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

soluciones k n =

[(a,b,c) | a <- [1..n `div` 3],

b <- [a..n-a],

let c = n-a-b,

c >= b,

esCuadradoPerfecto (k^a + k^b + k^c)]

-- (esCuadradoPerfecto x) se verifica si x es un cuadrado perfecto. Por

-- ejemplo,

-- esCuadradoPerfecto 16 == True

-- esCuadradoPerfecto 27 == False

esCuadradoPerfecto :: Integer -> Bool

esCuadradoPerfecto x =

(raizEntera x)^2 == x

-- (raizEntera x) es el mayor entero cuyo cuadrado es menor o igual que

-- x. Por ejemplo,

-- raizEntera 16 == 4

-- raizEntera 27 == 5

raizEntera :: Integer -> Integer

raizEntera x = aux (1,x)

where aux (a,b) | d == x = c

| c == a = c

| d < x = aux (c,b)

| otherwise = aux (a,c)

where c = (a+b) `div` 2

d = c^2

Nuevas soluciones

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

Números balanceados

PorJosé A. Alonso 19-febrero-202126-febrero-2021

Un número está balanceado si tiene un número par de divisores primos (contados con su multiplicidad). Por ejemplo, 60 es balanceado porque tiene 4 divisores primos (2, 2, 3 y 5).

Un balanceador del entero positivo k es par de enteros positivos (a,b) tales que a es menor que b y, para todo x entre 1 y k, el valor del polinomio P(x) = (x+a)*(x+b) es un número balanceado. Por ejemplo, (2,4) es un balanceador de 3 ya que

P(1) = (1+2)*(1+4) = 15 = 3*5     es balanceado
P(2) = (2+2)*(2+4) = 24 = 2*2*2*3 es balanceado
P(3) = (3+2)*(3+4) = 35 = 5*7     es balanceado

P(1) = (1+2)*(1+4) = 15 = 3*5 es balanceado

P(2) = (2+2)*(2+4) = 24 = 2*2*2*3 es balanceado

P(3) = (3+2)*(3+4) = 35 = 5*7 es balanceado

Definir la función

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

1	balanceadores :: Integer -> [(Integer,Integer)]

tal que (balanceadores k) es el conjunto de los balanceadores de k. Por ejemplo,

   λ> take 7 (balanceadores 3)
   [(2,4),(1,6),(5,9),(1,11),(6,11),(7,12),(8,14)]
   λ> take 7 (balanceadores 5)
   [(8,14),(10,17),(6,18),(12,22),(13,23),(8,24),(14,24)]
   λ> take 7 (balanceadores 3)
   [(2,4),(1,6),(5,9),(1,11),(6,11),(7,12),(8,14)]
   λ> take 7 (balanceadores 4)
   [(6,11),(8,14),(9,15),(10,17),(6,18),(11,18),(7,19)]
   λ> take 7 (balanceadores 5)
   [(8,14),(10,17),(6,18),(12,22),(13,23),(8,24),(14,24)]
   λ> head (balanceadores 19)
   (1325,2827)

λ> take 7 (balanceadores 3)

[(2,4),(1,6),(5,9),(1,11),(6,11),(7,12),(8,14)]

λ> take 7 (balanceadores 5)

[(8,14),(10,17),(6,18),(12,22),(13,23),(8,24),(14,24)]

λ> take 7 (balanceadores 3)

[(2,4),(1,6),(5,9),(1,11),(6,11),(7,12),(8,14)]

λ> take 7 (balanceadores 4)

[(6,11),(8,14),(9,15),(10,17),(6,18),(11,18),(7,19)]

λ> take 7 (balanceadores 5)

[(8,14),(10,17),(6,18),(12,22),(13,23),(8,24),(14,24)]

λ> head (balanceadores 19)

(1325,2827)

Nota: Este ejercicio está basado en el problema N2 de la Olimpíada Internacional de Matemáticas (IMO) del 2009.

Soluciones

import Data.Numbers.Primes (primeFactors)

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

balanceadores :: Integer -> [(Integer,Integer)]
balanceadores k =
  [(a,b) | (a,b) <- pares
         , all esBalanceado [(x+a)*(x+b) | x <- [1..k]]]

-- (esBalanceado x) se verifica si x es balanceado. Por ejemplo,
--    esBalanceado 60  ==  True
--    esBalanceado 50  ==  False
esBalanceado :: Integer -> Bool
esBalanceado = even . length . primeFactors

-- pares el lista de pares de enteros positivos con el primero menor que
-- el segundo. Por ejemplo,
--    λ> take 10 pares
--    [(1,2),(1,3),(2,3),(1,4),(2,4),(3,4),(1,5),(2,5),(3,5),(4,5)]
pares :: [(Integer,Integer)]
pares = [(a,b) | b <- [1..]
               , a <- [1..b-1]]

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

balanceadores2 :: Integer -> [(Integer,Integer)]
balanceadores2 1 = balanceadores 1
balanceadores2 k =
  [(a,b) | (a,b) <- balanceadores2 (k-1)
         , all esBalanceado [(x+a)*(x+b) | x <- [1..k]]]

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

balanceadores3 :: Integer -> [(Integer,Integer)]
balanceadores3 k =
  [(a,b) | (a,b) <- pares
         , and [esBalanceado (x+a) == esBalanceado (x+b) | x <- [1..k]]]

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

-- La comparación es
--    λ> head (balanceadores 17)
--    (189,282)
--    (0.53 secs, 1,227,921,384 bytes)
--    λ> head (balanceadores2 17)
--    (189,282)
--    (0.97 secs, 2,483,869,656 bytes)
--    λ> head (balanceadores3 17)
--    (189,282)
--    (0.36 secs, 983,881,264 bytes)

import Data.Numbers.Primes (primeFactors)

-- 1ª solución

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

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

balanceadores k =

[(a,b) | (a,b) <- pares

, all esBalanceado [(x+a)*(x+b) | x <- [1..k]]]

-- (esBalanceado x) se verifica si x es balanceado. Por ejemplo,

-- esBalanceado 60 == True

-- esBalanceado 50 == False

esBalanceado :: Integer -> Bool

esBalanceado = even . length . primeFactors

-- pares el lista de pares de enteros positivos con el primero menor que

-- el segundo. Por ejemplo,

-- λ> take 10 pares

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

pares :: [(Integer,Integer)]

pares = [(a,b) | b <- [1..]

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

-- 2ª solución

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

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

balanceadores2 1 = balanceadores 1

balanceadores2 k =

[(a,b) | (a,b) <- balanceadores2 (k-1)

, all esBalanceado [(x+a)*(x+b) | x <- [1..k]]]

-- 3ª solución

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

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

balanceadores3 k =

[(a,b) | (a,b) <- pares

, and [esBalanceado (x+a) == esBalanceado (x+b) | x <- [1..k]]]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> head (balanceadores 17)

-- (189,282)

-- (0.53 secs, 1,227,921,384 bytes)

-- λ> head (balanceadores2 17)

-- (189,282)

-- (0.97 secs, 2,483,869,656 bytes)

-- λ> head (balanceadores3 17)

-- (189,282)

-- (0.36 secs, 983,881,264 bytes)

Nuevas soluciones

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

Mínimo número de saltos para alcanzar el final

PorJosé A. Alonso 17-febrero-202124-febrero-2021

Dada una lista de enteros positivos, se interpreta cada elemento el máximo número de pasos que se puede avanzar desde dicho elemento. Por ejemplo, para la lista [1,3,5,8,9,2,6,7,6,8,9], desde sólo se puede avanzar un paso (hasta el 3), desde el 3 se puede avanzar 3 pasos (hasta el 5, 8 ó 9), y así sucesivamente. En dicha lista, el mínimo número de saltos que hay que dar para alcanzar el final es 3 (el recorrido es 1, 3, 8, 9).

Definir la función

   minimoSaltos :: [Int] -> Int

1	minimoSaltos :: [Int] -> Int

tal que (minimoSaltosxs) es el mínimo número de saltos que hay que dar en la lista xs para alcanzar el final. Por ejemplo,

   minimoSaltos [1,3,5,8,9,2,6,7,6,8,9]  ==  3
   minimoSaltos (replicate 10 1)         ==  9
   minimoSaltos [1..25]                  ==  5

minimoSaltos [1,3,5,8,9,2,6,7,6,8,9] == 3

minimoSaltos (replicate 10 1) == 9

minimoSaltos [1..25] == 5

Soluciones

import Data.List (tails)

minimoSaltos :: [Int] -> Int
minimoSaltos (x:y:xs) =
  1 + minimum [minimoSaltos ys | ys <- take x (tails (y:xs))]
minimoSaltos _ = 0

import Data.List (tails)

minimoSaltos :: [Int] -> Int

minimoSaltos (x:y:xs) =

1 + minimum [minimoSaltos ys | ys <- take x (tails (y:xs))]

minimoSaltos _ = 0

Nuevas soluciones

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

Cantidad de números oblongos en un intervalo

PorJosé A. Alonso 16-febrero-202123-febrero-2021

Un número oblongo es un número que es el producto de dos números naturales consecutivos; es decir, n es un número oblongo si existe un número natural x tal que n = x(x+1). Por ejemplo, 42 es un número oblongo porque 42 = 6 x 7.

La sucesión de los números oblongos es

   0, 2, 6, 12, 20, 30, 42, 56, 72, 90, 110, 132, 156, 182, 210, ...

1	0, 2, 6, 12, 20, 30, 42, 56, 72, 90, 110, 132, 156, 182, 210, ...

En el intervalo [10,30] hay 3 números oblongos (el 12, el 20 y el 30).

Definir las funciones

   oblongos            :: [Integer]
   oblongosEnIntervalo :: Integer -> Integer -> Int

1 2	oblongos :: [Integer] oblongosEnIntervalo :: Integer -> Integer -> Int

tales que

oblongos es la sucesión de los números oblongos. Por ejemplo,

     take 15 oblongos   == [0,2,6,12,20,30,42,56,72,90,110,132,156,182,210]
     oblongos !! 50     == 2550
     oblongos !! (10^5) == 10000100000
     oblongos !! (10^6) == 1000001000000
     oblongos !! (10^7) == 100000010000000

take 15 oblongos == [0,2,6,12,20,30,42,56,72,90,110,132,156,182,210]

oblongos !! 50 == 2550

oblongos !! (10^5) == 10000100000

oblongos !! (10^6) == 1000001000000

oblongos !! (10^7) == 100000010000000

(oblongosEnIntervalo a b) es la cantidad de números oblongos en el intervalo [a,b]. Por ejemplo,

     oblongosEnIntervalo 10 30           ==  3
     oblongosEnIntervalo (10^3) (10^10)  ==  99968
     oblongosEnIntervalo (10^3) (10^12)  ==  999968
     oblongosEnIntervalo (10^3) (10^14)  ==  9999968

oblongosEnIntervalo 10 30 == 3

oblongosEnIntervalo (10^3) (10^10) == 99968

oblongosEnIntervalo (10^3) (10^12) == 999968

oblongosEnIntervalo (10^3) (10^14) == 9999968

Soluciones

-- 1ª definición de oblongos
oblongos1 :: [Integer]
oblongos1 = [n*(n+1) | n <- [0..]]

-- 2ª definición de oblongos
oblongos2 :: [Integer]
oblongos2 = zipWith (*) [0..] [1..]

-- 3ª definición de oblongos
oblongos3 :: [Integer]
oblongos3 = scanl1 (+) [0,2..]

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

--    λ> oblongos1 !! (10^7)
--    100000010000000
--    (3.05 secs, 1,840,112,008 bytes)
--    λ> oblongos2 !! (10^7)
--    100000010000000
--    (0.90 secs, 2,480,112,304 bytes)
--    λ> oblongos3 !! (10^7)
--    100000010000000
--    (3.38 secs, 2,252,411,640 bytes)

-- Definición de oblongos
-- ======================

-- En lo que sigue, usaremos la 2ª.
oblongos :: [Integer]
oblongos = oblongos2

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

oblongosEnIntervalo1 :: Integer -> Integer -> Int
oblongosEnIntervalo1 a b =
  length [x | x <- [a..b]
            , x `elem` takeWhile (<=b) oblongos]

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

oblongosEnIntervalo2 :: Integer -> Integer -> Int
oblongosEnIntervalo2 a b =
  length (takeWhile (<=b) (dropWhile (< a) oblongos))

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

-- La comparación es
--    λ> oblongosEnIntervalo1 100 (10^5)
--    306
--    (2.43 secs, 1,784,537,632 bytes)
--    λ> oblongosEnIntervalo2 100 (10^5)
--    306
--    (0.01 secs, 119,112 bytes)

-- 1ª definición de oblongos

oblongos1 :: [Integer]

oblongos1 = [n*(n+1) | n <- [0..]]

-- 2ª definición de oblongos

oblongos2 :: [Integer]

oblongos2 = zipWith (*) [0..] [1..]

-- 3ª definición de oblongos

oblongos3 :: [Integer]

oblongos3 = scanl1 (+) [0,2..]

-- Comparación de eficiencia

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

-- λ> oblongos1 !! (10^7)

-- 100000010000000

-- (3.05 secs, 1,840,112,008 bytes)

-- λ> oblongos2 !! (10^7)

-- 100000010000000

-- (0.90 secs, 2,480,112,304 bytes)

-- λ> oblongos3 !! (10^7)

-- 100000010000000

-- (3.38 secs, 2,252,411,640 bytes)

-- Definición de oblongos

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

-- En lo que sigue, usaremos la 2ª.

oblongos :: [Integer]

oblongos = oblongos2

-- 1ª definición de oblongosEnIntervalo

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

oblongosEnIntervalo1 :: Integer -> Integer -> Int

oblongosEnIntervalo1 a b =

length [x | x <- [a..b]

, x `elem` takeWhile (<=b) oblongos]

-- 2ª definición de oblongosEnIntervalo

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

oblongosEnIntervalo2 :: Integer -> Integer -> Int

oblongosEnIntervalo2 a b =

length (takeWhile (<=b) (dropWhile (< a) oblongos))

-- Comparación de eficiencia

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

-- La comparación es

-- λ> oblongosEnIntervalo1 100 (10^5)

-- 306

-- (2.43 secs, 1,784,537,632 bytes)

-- λ> oblongosEnIntervalo2 100 (10^5)

-- 306

-- (0.01 secs, 119,112 bytes)

Nuevas soluciones

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

Mínima suma borrando todas las ocurrencias de un dígito

PorJosé A. Alonso 15-febrero-202122-febrero-2021

Para la lista [23,12,77,82], las sumas obtenidas eliminando todas las ocurrencias de uno de sus dígitos son

+ Eliminando el 1: 23 +  2 + 77 + 82 = 184
+ Eliminando el 2:  3 + 1  + 77 + 8  =  89
+ Eliminando el 3: 2  + 12 + 77 + 82 = 173
+ Eliminando el 7: 23 + 12      + 82 = 117
+ Eliminando el 8: 23 + 12 + 77 +  2 = 114

+ Eliminando el 1: 23 + 2 + 77 + 82 = 184

+ Eliminando el 2: 3 + 1 + 77 + 8 = 89

+ Eliminando el 3: 2 + 12 + 77 + 82 = 173

+ Eliminando el 7: 23 + 12 + 82 = 117

+ Eliminando el 8: 23 + 12 + 77 + 2 = 114

El mínimo de las sumas es 89 (que se obtiene eliminando todas las ocurrencias del dígito 2).

Definir la función

   minimaSumaEliminandoDigito :: [Integer] -> Integer

1	minimaSumaEliminandoDigito :: [Integer] -> Integer

tal que (minimaSumaEliminandoDigito xs) es el mínimo de las sumas obtenidas eliminando todas las ocurrencias de uno de los dígitos de xs. Por ejemplo,

   minimaSumaEliminandoDigito [23,12,77,82]  ==  89
   minimaSumaEliminandoDigito [2312,7,4,82]  ==  50

1 2	minimaSumaEliminandoDigito [23,12,77,82] == 89 minimaSumaEliminandoDigito [2312,7,4,82] == 50

Soluciones

import Data.List ((\\), nub)

minimaSumaEliminandoDigito :: [Int] -> Int
minimaSumaEliminandoDigito xs =
  minimum [sumaSinDigito k xs | k <- digitosLista xs]

-- (digitosLista xs) es una lista, sin repeticiones, de los dígitos de
-- xs. Por ejemplo,
--    digitosLista [23,12,74,82]  ==  [2,3,1,7,4,8]
digitosLista :: [Int] -> [Int]
digitosLista = nub . concatMap digitos

-- (digitos x) es la lista de los dígitos de x. Por ejemplo,
--    digitos 3252  ==  [3,2,5,2]
digitos :: Int -> [Int]
digitos x = [read [c] | c <- show x]

-- (sumaSinDigito k xs) es la suma de los números de xs en los que se han
-- borrado todas las ocurrencias del dígito k. Por ejemplo,
--    sumaSinDigito 2 [23,12,22,82]  ==  12
sumaSinDigito :: Int -> [Int] -> Int
sumaSinDigito k xs = sum (listaSinDigito k xs)

-- (listaSinDigito k xs) es la lista de los números de xs en los que se han
-- borrado todas las ocurrencias del dígito k. Por ejemplo,
--    listaSinDigito 2 [23,12,22,82]  ==  [3,1,8]
listaSinDigito :: Int -> [Int] -> [Int]
listaSinDigito k xs =
  [read cs | x <- xs
           , let cs = filter (/=c) (show x)
           , not (null cs)]
  where [c] = show k

import Data.List ((\\), nub)

minimaSumaEliminandoDigito :: [Int] -> Int

minimaSumaEliminandoDigito xs =

minimum [sumaSinDigito k xs | k <- digitosLista xs]

-- (digitosLista xs) es una lista, sin repeticiones, de los dígitos de

-- xs. Por ejemplo,

-- digitosLista [23,12,74,82] == [2,3,1,7,4,8]

digitosLista :: [Int] -> [Int]

digitosLista = nub . concatMap digitos

-- (digitos x) es la lista de los dígitos de x. Por ejemplo,

-- digitos 3252 == [3,2,5,2]

digitos :: Int -> [Int]

digitos x = [read [c] | c <- show x]

-- (sumaSinDigito k xs) es la suma de los números de xs en los que se han

-- borrado todas las ocurrencias del dígito k. Por ejemplo,

-- sumaSinDigito 2 [23,12,22,82] == 12

sumaSinDigito :: Int -> [Int] -> Int

sumaSinDigito k xs = sum (listaSinDigito k xs)

-- (listaSinDigito k xs) es la lista de los números de xs en los que se han

-- borrado todas las ocurrencias del dígito k. Por ejemplo,

-- listaSinDigito 2 [23,12,22,82] == [3,1,8]

listaSinDigito :: Int -> [Int] -> [Int]

listaSinDigito k xs =

[read cs | x <- xs

, let cs = filter (/=c) (show x)

, not (null cs)]

where [c] = show k

Nuevas soluciones

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

Descomposición de N en K sumandos pares distintos

PorJosé A. Alonso 12-febrero-202119-febrero-2021

Definir las funciones

   sumas  :: Integer -> Integer -> [[Integer]]
   esSuma :: Integer -> Integer -> Bool

1 2	sumas :: Integer -> Integer -> [[Integer]] esSuma :: Integer -> Integer -> Bool

tales que

(sumas n k) es la lista de las descomposiones de n en k sumandos pares y distintos. Por ejemplo,

     sumas 16 3  ==  [[2,4,10],[2,6,8]]
     sumas 18 4  ==  []

1 2	sumas 16 3 == [[2,4,10],[2,6,8]] sumas 18 4 == []

(esSuma n k) se verifica si n se puede escribir como suma de k sumandos pares y distintos. Por ejemplo,

     esSuma 16 3  ==  True
     esSuma 18 4  ==  False
     esSuma (10^5000) (10^7)  ==  True
     esSuma (11^5000) (10^7)  ==  False

esSuma 16 3 == True

esSuma 18 4 == False

esSuma (10^5000) (10^7) == True

esSuma (11^5000) (10^7) == False

Soluciones

import Test.QuickCheck

sumas :: Integer -> Integer -> [[Integer]]
sumas n k = sumasLista n k [2,4..n]

-- (sumasLista n k xs) es la lista de las descomposiciones de n como k
-- elementos de xs (cada uno una vez como máximo). Por ejemplo,
--    sumasLista 16 3 [2,4..15]  ==  [[2,4,10],[2,6,8]]
--    sumasLista 18 4 [2,4..15]  ==  []
sumasLista :: Integer -> Integer -> [Integer] -> [[Integer]]
sumasLista _ _ [] = []
sumasLista n 1 xs
  | n `elem` xs = [[n]]
  | otherwise   = []
sumasLista n k (x:xs)
  | x > n     = []
  | otherwise = [x:ys | ys <- sumasLista (n-x) (k-1) xs] ++
                sumasLista n k xs

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

esSuma :: Integer -> Integer -> Bool
esSuma n k = not (null (sumas n k))

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

-- Se observan las siguientes propiedades:
-- 1. Si n es impar, no se puede escribir como suma de pares.
-- 2. El menor número que se puede escribir como suma de k sumandos
--    impares distintos es 2 * sum [1..k] y su descomposición es
--    [2,4..2*k] (es decir, map (*2) [1..k]).
-- 3. Si n es un número par mayor o igual que (2 * sum [1..k])
--    entonces se puede escribir como suma de k sumandos pares distintos;
--    en efecto,
--       x = 2 + 4 + ··· + 2*(k-1) + (x - (2 + 4 + ··· + 2*(k-1))

esSuma2 :: Integer -> Integer -> Bool
esSuma2 n k
  | odd n               = False
  | 2 * sum [1..k] <= n = True
  | otherwise           = False

-- 3ª definición de esSuma
-- =======================

esSuma3 :: Integer -> Integer -> Bool
esSuma3 n k
  | odd n            = False
  | k * (k + 1) <= n = True
  | otherwise        = False

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_equiv_esSuma :: Integer -> Integer -> Property
prop_equiv_esSuma n k =
  n > 0 && k > 0 ==>
  all (== (esSuma3 n k)) [esSuma n k, esSuma2 n k]

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

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

-- La comparación es
--    λ> esSuma 200 20
--    False
--    (6.12 secs, 3,079,059,560 bytes)
--    λ> esSuma2 200 20
--    False
--    (0.00 secs, 102,800 bytes)
--    λ> esSuma3 200 20
--    False
--    (0.01 secs, 102,760 bytes)
--
--    λ> esSuma2 (10^5000) (10^7)
--    True
--    (2.55 secs, 1,612,412,664 bytes)
--    λ> esSuma3 (10^5000) (10^7)
--    True
--    (0.03 secs, 109,200 bytes)

import Test.QuickCheck

sumas :: Integer -> Integer -> [[Integer]]

sumas n k = sumasLista n k [2,4..n]

-- (sumasLista n k xs) es la lista de las descomposiciones de n como k

-- elementos de xs (cada uno una vez como máximo). Por ejemplo,

-- sumasLista 16 3 [2,4..15] == [[2,4,10],[2,6,8]]

-- sumasLista 18 4 [2,4..15] == []

sumasLista :: Integer -> Integer -> [Integer] -> [[Integer]]

sumasLista _ _ [] = []

sumasLista n 1 xs

| n `elem` xs = [[n]]

| otherwise = []

sumasLista n k (x:xs)

| x > n = []

| otherwise = [x:ys | ys <- sumasLista (n-x) (k-1) xs] ++

sumasLista n k xs

-- 1ª definición de esSuma

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

esSuma :: Integer -> Integer -> Bool

esSuma n k = not (null (sumas n k))

-- 2ª definición de esSuma

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

-- Se observan las siguientes propiedades:

-- 1. Si n es impar, no se puede escribir como suma de pares.

-- 2. El menor número que se puede escribir como suma de k sumandos

-- impares distintos es 2 * sum [1..k] y su descomposición es

-- [2,4..2*k] (es decir, map (*2) [1..k]).

-- 3. Si n es un número par mayor o igual que (2 * sum [1..k])

-- entonces se puede escribir como suma de k sumandos pares distintos;

-- en efecto,

-- x = 2 + 4 + ··· + 2*(k-1) + (x - (2 + 4 + ··· + 2*(k-1))

esSuma2 :: Integer -> Integer -> Bool

esSuma2 n k

| odd n = False

| 2 * sum [1..k] <= n = True

| otherwise = False

-- 3ª definición de esSuma

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

esSuma3 :: Integer -> Integer -> Bool

esSuma3 n k

| odd n = False

| k * (k + 1) <= n = True

| otherwise = False

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equiv_esSuma :: Integer -> Integer -> Property

prop_equiv_esSuma n k =

n > 0 && k > 0 ==>

all (== (esSuma3 n k)) [esSuma n k, esSuma2 n k]

-- La comprobación es

-- λ> quickCheck prop_equiv_esSuma

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> esSuma 200 20

-- False

-- (6.12 secs, 3,079,059,560 bytes)

-- λ> esSuma2 200 20

-- False

-- (0.00 secs, 102,800 bytes)

-- λ> esSuma3 200 20

-- False

-- (0.01 secs, 102,760 bytes)

-- λ> esSuma2 (10^5000) (10^7)

-- True

-- (2.55 secs, 1,612,412,664 bytes)

-- λ> esSuma3 (10^5000) (10^7)

-- True

-- (0.03 secs, 109,200 bytes)

Nuevas soluciones

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

Ternas potencias de dos

PorJosé A. Alonso 10-febrero-202117-febrero-2021

Una terna (a,b,c) de números enteros positivos es especial si se verifica que ab-c, bc-a y ca-b son potencias de 2. Por ejemplo, (3,5,7) es especial ya que

   3 * 5 - 7 =  8 = 2^3
   5 * 7 - 3 = 32 = 2^5
   7 * 3 - 5 = 16 = 2^4

3 * 5 - 7 = 8 = 2^3

5 * 7 - 3 = 32 = 2^5

7 * 3 - 5 = 16 = 2^4

Definir las funciones

   esEspecial       :: (Integer,Integer,Integer) -> Bool
   ternasEspeciales :: [(Integer,Integer,Integer)]

1 2	esEspecial :: (Integer,Integer,Integer) -> Bool ternasEspeciales :: [(Integer,Integer,Integer)]

tales que

(esEspecial t) se verifica si t es una terna especial. Por ejemplo,

     esEspecial (3,5,7)  ==  True
     esEspecial (5,7,9)  ==  False

1 2	esEspecial (3,5,7) == True esEspecial (5,7,9) == False

ternasEspeciales es la lista de las ternasEspeciales ordenadas según su suma y las de la misma suma por orden lexicográfico. Por ejemplo,

     λ> take 16 ternasEspeciales
     [(2,2,2),
      (2,2,3),(2,3,2),(3,2,2),
      (3,5,7),(3,7,5),(5,3,7),(5,7,3),(7,3,5),(7,5,3),
      (2,6,11),(2,11,6),(6,2,11),(6,11,2),(11,2,6),(11,6,2)]

λ> take 16 ternasEspeciales

[(2,2,2),

(2,2,3),(2,3,2),(3,2,2),

(3,5,7),(3,7,5),(5,3,7),(5,7,3),(7,3,5),(7,5,3),

(2,6,11),(2,11,6),(6,2,11),(6,11,2),(11,2,6),(11,6,2)]

Comprobar con QuickCheck que sólo hay 16 ternas especiales; es decir, para toda terna t de enteros positivos, t pertenece a la lista de los 16 primeros elementos de ternasEspeciales o no es una terna especial.

Nota: Este ejercicio está basado en el problema N5 de la Olimpíada Internacional de Matemáticas (IMO) del 2015.

Soluciones

import Data.List (nub, permutations, sort)
import Data.Numbers.Primes (primeFactors)
import Data.Bits ((.&.))
import Test.QuickCheck (Property, (==>), quickCheck)

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

esEspecial1 :: (Integer,Integer,Integer) -> Bool
esEspecial1 (a,b,c) =
  all esPotenciaDeDos1 [a * b - c, b * c - a, c * a - b]

-- (esPotenciaDeDos n) se verifica si n es una potencia de dos. Por
-- ejemplo.
--    esPotenciaDeDos  8  == True
--    esPotenciaDeDos 32  == True
--    esPotenciaDeDos  0  == False
--    esPotenciaDeDos  1  == True
--    esPotenciaDeDos  2  == True
--    esPotenciaDeDos  6  == False
esPotenciaDeDos1 :: Integer -> Bool
esPotenciaDeDos1 n
    | n <= 0    = False
    | n <= 2    = True
    | even n    = esPotenciaDeDos1 (n `div` 2)
    | otherwise = False

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

esEspecial2 :: (Integer,Integer,Integer) -> Bool
esEspecial2 (a,b,c) =
  all esPotenciaDeDos2 [a * b - c, b * c - a, c * a - b]

esPotenciaDeDos2 :: Integer -> Bool
esPotenciaDeDos2 n = n == head (dropWhile (<n) potenciasDeDos)

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,
potenciasDeDos :: [Integer]
potenciasDeDos = iterate (*2) 1

-- 3ª definición de esEspecial
-- ===========================

esEspecial3 :: (Integer,Integer,Integer) -> Bool
esEspecial3 (a,b,c) =
  all esPotenciaDeDos3 [a * b - c, b * c - a, c * a - b]

esPotenciaDeDos3 :: Integer -> Bool
esPotenciaDeDos3 x = all (==2) (primeFactors x)

-- 4ª definición de esEspecial
-- ===========================

esEspecial4 :: (Integer,Integer,Integer) -> Bool
esEspecial4 (a,b,c) =
  all esPotenciaDeDos4 [a * b - c, b * c - a, c * a - b]

-- La siguiente definición de esPotenciaDeDos usa la función (.&.) de la
-- librería Data.Bits. Dicha función calcula el número correspondiente a
-- la conjunción de las representaciones binarias de sus argumentos. Por
-- ejemplo,
--    6 .&. 3 == 2
-- ya que
--    la representación binaria de 6 es     [1,1,0]
--    la representación binaria de 3 es       [1,1]
--    la conjunción es                        [1,0]
--    la representación decimal de [1,0] es   2
--
-- Otros ejemplos:
--    4 .&. 3 ==   [1,0,0] .&.   [1,1] == 0
--    8 .&. 7 == [1,0,0,0] .&. [1,1,1] = 0
esPotenciaDeDos4 :: Integer -> Bool
esPotenciaDeDos4 n = n .&. (n-1) == 0

-- Comparación de eficiencia de las definiciones de esEspecial
-- ===========================================================

-- La comparación es
--    λ> esEspecial1 (2^300000,2,0)
--    False
--    (3.05 secs, 5,765,728,296 bytes)
--    λ> esEspecial2 (2^300000,2,0)
--    False
--    (2.68 secs, 5,755,293,608 bytes)
--    λ> esEspecial3 (2^300000,2,0)
--    False
--    (2.45 secs, 5,758,527,232 bytes)
--    λ> esEspecial4 (2^300000,2,0)
--    False
--    (0.01 secs, 516,512 bytes)

-- Definición de esEspecial
-- ========================

-- En lo sucesivo usaremos la 4ª definición.
esEspecial :: (Integer,Integer,Integer) -> Bool
esEspecial = esEspecial4

-- Definición de ternasEspeciales
-- ==============================

--    λ> take 16 ternasEspeciales
--    [(2,2,2),(2,2,3),(2,3,2),(3,2,2),(3,5,7),(3,7,5),(5,3,7),(5,7,3),
--     (7,3,5),(7,5,3),(2,6,11),(2,11,6),(6,2,11),(6,11,2),(11,2,6),(11,6,2)]
ternasEspeciales :: [(Integer,Integer,Integer)]
ternasEspeciales = filter esEspecial1 ternas

-- ternas es la lista de ternas de enteros positivos con el orden
-- descrito anteriormente. Por ejemplo,
--    λ> take 20 ternas
--    [(1,1,1),
--     (1,1,2),(1,2,1),(2,1,1),
--     (1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1),
--     (1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)]
ternas :: [(Integer,Integer,Integer)]
ternas = concatMap ternasSuma [3..]

-- (ternasSuma n) es la lista de las ternas de enteros positivos cuya
-- suma es n ordenadas lexicográficamte. Por ejemplo,
--    λ> ternasSuma 3
--    [(1,1,1)]
--    λ> ternasSuma 4
--    [(1,1,2),(1,2,1),(2,1,1)]
--    λ> ternasSuma 5
--    [(1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1)]
--    λ> ternasSuma 6
--    [(1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)]
ternasSuma :: Integer -> [(Integer,Integer,Integer)]
ternasSuma n =
  sort (concatMap permutaciones [(a,b,c) | a <- [1..n]
                                         , b <- [a..n]
                                         , let c = n-a-b
                                         , b <= c])


-- (permutaciones t) es la lista de las permutaciones de la terna t. Por ejemplo,
--    λ> permutaciones (1,2,3)
--    [(1,2,3),(2,1,3),(3,2,1),(2,3,1),(3,1,2),(1,3,2)]
--    λ> permutaciones (1,1,2)
--    [(1,1,2),(2,1,1),(1,2,1)]
--    λ> permutaciones (1,1,1)
--    [(1,1,1)]
permutaciones :: (Integer,Integer,Integer) -> [(Integer,Integer,Integer)]
permutaciones (a,b,c) =
  nub [(x,y,z) | [x,y,z] <- permutations [a,b,c]]

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

-- La propiedad es
prop_ternasEspeciales :: (Integer,Integer,Integer) -> Property
prop_ternasEspeciales (a,b,c) =
  a > 0 && b > 0 && c > 0 ==>
  (a,b,c) `elem` xs || not (esEspecial (a,b,c))
  where xs = take 16 ternasEspeciales

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

import Data.List (nub, permutations, sort)

import Data.Numbers.Primes (primeFactors)

import Data.Bits ((.&.))

import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª definición de esEspecial

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

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

esEspecial1 (a,b,c) =

all esPotenciaDeDos1 [a * b - c, b * c - a, c * a - b]

-- (esPotenciaDeDos n) se verifica si n es una potencia de dos. Por

-- ejemplo.

-- esPotenciaDeDos 8 == True

-- esPotenciaDeDos 32 == True

-- esPotenciaDeDos 0 == False

-- esPotenciaDeDos 1 == True

-- esPotenciaDeDos 2 == True

-- esPotenciaDeDos 6 == False

esPotenciaDeDos1 :: Integer -> Bool

esPotenciaDeDos1 n

| n <= 0 = False

| n <= 2 = True

| even n = esPotenciaDeDos1 (n `div` 2)

| otherwise = False

-- 2ª definición de esEspecial

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

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

esEspecial2 (a,b,c) =

all esPotenciaDeDos2 [a * b - c, b * c - a, c * a - b]

esPotenciaDeDos2 :: Integer -> Bool

esPotenciaDeDos2 n = n == head (dropWhile (<n) potenciasDeDos)

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- 3ª definición de esEspecial

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

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

esEspecial3 (a,b,c) =

all esPotenciaDeDos3 [a * b - c, b * c - a, c * a - b]

esPotenciaDeDos3 :: Integer -> Bool

esPotenciaDeDos3 x = all (==2) (primeFactors x)

-- 4ª definición de esEspecial

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

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

esEspecial4 (a,b,c) =

all esPotenciaDeDos4 [a * b - c, b * c - a, c * a - b]

-- La siguiente definición de esPotenciaDeDos usa la función (.&.) de la

-- librería Data.Bits. Dicha función calcula el número correspondiente a

-- la conjunción de las representaciones binarias de sus argumentos. Por

-- ejemplo,

-- 6 .&. 3 == 2

-- ya que

-- la representación binaria de 6 es [1,1,0]

-- la representación binaria de 3 es [1,1]

-- la conjunción es [1,0]

-- la representación decimal de [1,0] es 2

-- Otros ejemplos:

-- 4 .&. 3 == [1,0,0] .&. [1,1] == 0

-- 8 .&. 7 == [1,0,0,0] .&. [1,1,1] = 0

esPotenciaDeDos4 :: Integer -> Bool

esPotenciaDeDos4 n = n .&. (n-1) == 0

-- Comparación de eficiencia de las definiciones de esEspecial

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

-- La comparación es

-- λ> esEspecial1 (2^300000,2,0)

-- False

-- (3.05 secs, 5,765,728,296 bytes)

-- λ> esEspecial2 (2^300000,2,0)

-- False

-- (2.68 secs, 5,755,293,608 bytes)

-- λ> esEspecial3 (2^300000,2,0)

-- False

-- (2.45 secs, 5,758,527,232 bytes)

-- λ> esEspecial4 (2^300000,2,0)

-- False

-- (0.01 secs, 516,512 bytes)

-- Definición de esEspecial

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

-- En lo sucesivo usaremos la 4ª definición.

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

esEspecial = esEspecial4

-- Definición de ternasEspeciales

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

-- λ> take 16 ternasEspeciales

-- [(2,2,2),(2,2,3),(2,3,2),(3,2,2),(3,5,7),(3,7,5),(5,3,7),(5,7,3),

-- (7,3,5),(7,5,3),(2,6,11),(2,11,6),(6,2,11),(6,11,2),(11,2,6),(11,6,2)]

ternasEspeciales :: [(Integer,Integer,Integer)]

ternasEspeciales = filter esEspecial1 ternas

-- ternas es la lista de ternas de enteros positivos con el orden

-- descrito anteriormente. Por ejemplo,

-- λ> take 20 ternas

-- [(1,1,1),

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

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

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

ternas :: [(Integer,Integer,Integer)]

ternas = concatMap ternasSuma [3..]

-- (ternasSuma n) es la lista de las ternas de enteros positivos cuya

-- suma es n ordenadas lexicográficamte. Por ejemplo,

-- λ> ternasSuma 3

-- [(1,1,1)]

-- λ> ternasSuma 4

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

-- λ> ternasSuma 5

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

-- λ> ternasSuma 6

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

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

ternasSuma n =

sort (concatMap permutaciones [(a,b,c) | a <- [1..n]

, b <- [a..n]

, let c = n-a-b

, b <= c])

-- (permutaciones t) es la lista de las permutaciones de la terna t. Por ejemplo,

-- λ> permutaciones (1,2,3)

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

-- λ> permutaciones (1,1,2)

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

-- λ> permutaciones (1,1,1)

-- [(1,1,1)]

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

permutaciones (a,b,c) =

nub [(x,y,z) | [x,y,z] <- permutations [a,b,c]]

-- Propiedad

-- =========

-- La propiedad es

prop_ternasEspeciales :: (Integer,Integer,Integer) -> Property

prop_ternasEspeciales (a,b,c) =

a > 0 && b > 0 && c > 0 ==>

(a,b,c) `elem` xs || not (esEspecial (a,b,c))

where xs = take 16 ternasEspeciales

-- La comprobación es

-- λ> quickCheck prop_ternasEspeciales

-- +++ OK, passed 100 tests.

Nuevas soluciones

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

Ordenación de ternas de enteros

PorJosé A. Alonso 9-febrero-202116-febrero-2021

Las ternas de números enteros positivos se pueden ordenar por su suma y las de la misma suma por orden lexicográfico. Por ejemplo,

ternas de suma 3:

   (1,1,1)

(1,1,1)

ternas de suma 4:

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

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

ternas de suma 5:

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

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

ternas de suma 6

   (1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)

1	(1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)

y así sucesivamente.

Definir la función

   ternas :: [(integer,integer,integer)]

1	ternas :: [(integer,integer,integer)]

tal que ternas es la lista de las ternas de enteros positivos con el orden descrito anteriormente. por ejemplo,

   λ> take 20 ternas
   [(1,1,1),
    (1,1,2),(1,2,1),(2,1,1),
    (1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1),
    (1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)]

λ> take 20 ternas

[(1,1,1),

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

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

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

Soluciones

import Data.List (nub, permutations, sort)

ternas :: [(Integer,Integer,Integer)]
ternas = concatMap ternasSuma [3..]

-- (ternasSuma n) es la lista de las ternas de enteros positivos cuya
-- suma es n ordenadas lexicográficamte. Por ejemplo,
--    λ> ternasSuma 3
--    [(1,1,1)]
--    λ> ternasSuma 4
--    [(1,1,2),(1,2,1),(2,1,1)]
--    λ> ternasSuma 5
--    [(1,1,3),(1,2,2),(1,3,1),(2,1,2),(2,2,1),(3,1,1)]
--    λ> ternasSuma 6
--    [(1,1,4),(1,2,3),(1,3,2),(1,4,1),(2,1,3),(2,2,2),(2,3,1),(3,1,2),(3,2,1),(4,1,1)]
ternasSuma :: Integer -> [(Integer,Integer,Integer)]
ternasSuma n =
  sort (concatMap permutaciones [(a,b,c) | a <- [1..n]
                                         , b <- [a..n]
                                         , let c = n-a-b
                                         , b <= c])

-- (permutaciones t) es la lista de las permutaciones de la terna t. Por ejemplo,
--    λ> permutaciones (1,2,3)
--    [(1,2,3),(2,1,3),(3,2,1),(2,3,1),(3,1,2),(1,3,2)]
--    λ> permutaciones (1,1,2)
--    [(1,1,2),(2,1,1),(1,2,1)]
--    λ> permutaciones (1,1,1)
--    [(1,1,1)]
permutaciones :: (Integer,Integer,Integer) -> [(Integer,Integer,Integer)]
permutaciones (a,b,c) =
  nub [(x,y,z) | [x,y,z] <- permutations [a,b,c]]

import Data.List (nub, permutations, sort)

ternas :: [(Integer,Integer,Integer)]

ternas = concatMap ternasSuma [3..]

-- (ternasSuma n) es la lista de las ternas de enteros positivos cuya

-- suma es n ordenadas lexicográficamte. Por ejemplo,

-- λ> ternasSuma 3

-- [(1,1,1)]

-- λ> ternasSuma 4

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

-- λ> ternasSuma 5

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

-- λ> ternasSuma 6

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

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

ternasSuma n =

sort (concatMap permutaciones [(a,b,c) | a <- [1..n]

, b <- [a..n]

, let c = n-a-b

, b <= c])

-- (permutaciones t) es la lista de las permutaciones de la terna t. Por ejemplo,

-- λ> permutaciones (1,2,3)

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

-- λ> permutaciones (1,1,2)

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

-- λ> permutaciones (1,1,1)

-- [(1,1,1)]

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

permutaciones (a,b,c) =

nub [(x,y,z) | [x,y,z] <- permutations [a,b,c]]

Nuevas soluciones

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

Mayor número borrando k dígitos

PorJosé A. Alonso 8-febrero-202115-febrero-2021

Definir la función

   mayorBorrando :: Int -> Integer -> Integer

1	mayorBorrando :: Int -> Integer -> Integer

tal que (mayorBorrando k n) es el mayor número obtenido borrando k dígitos de n (se supone que n tiene más de k dígitos). Por ejemplo,

   mayorBorrando 1 6782334  ==  782334
   mayorBorrando 3 6782334  ==  8334
   mayorBorrando 3 10020    ==  20
   mayorBorrando 1000000 (4256 + 10^1000004) == 14256

mayorBorrando 1 6782334 == 782334

mayorBorrando 3 6782334 == 8334

mayorBorrando 3 10020 == 20

mayorBorrando 1000000 (4256 + 10^1000004) == 14256

Soluciones

import Data.List (subsequences)

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

mayorBorrando :: Int -> Integer -> Integer
mayorBorrando k n = read (mayorBorrandoLista1 k (show n))

-- (mayorBorrandoLista1 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista1 1 "6782334"  ==  "782334"
--    mayorBorrandoLista1 3 "6782334"  ==  "8334"
mayorBorrandoLista1 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista1 k xs = maximum (borra1 k xs)

-- (borra1 k xs) es la lista de las listas obtenidas borrando k elementos
-- de xs. Por ejemplo,
--    borra1 1 "abcd"  ==  ["abc","abd","acd","bcd"]
--    borra1 2 "abcd"  ==  ["ab","ac","bc","ad","bd","cd"]
--    borra1 3 "abcd"  ==  ["a","b","c","d"]
borra1 n xs = [ys | ys <- subsequences xs, length ys == k]
  where k = length xs - n

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

mayorBorrando2 :: Int -> Integer -> Integer
mayorBorrando2 k n = read (mayorBorrandoLista2 k (show n))

-- (mayorBorrandoLista2 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista2 1 "6782334"  ==  "782334"
--    mayorBorrandoLista2 3 "6782334"  ==  "8334"
mayorBorrandoLista2 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista2 k xs = maximum (borra2 k xs)

-- (borra2 k xs) es la lista de las listas obtenidas borrando k elementos
-- de xs. Por ejemplo,
--    borra2 1 "abcd"  ==  ["abc","abd","acd","bcd"]
--    borra2 2 "abcd"  ==  ["ab","ac","ad","bc","bd","cd"]
--    borra2 3 "abcd"  ==  ["a","b","c","d"]
borra2 :: Eq a => Int -> [a] -> [[a]]
borra2 0 xs     = [xs]
borra2 n []     = []
borra2 n (x:xs) = [x:ys | ys <- borra2 n xs] ++ borra2 (n-1) xs

-- 3ª definición
-- =============

mayorBorrando3 :: Int -> Integer -> Integer
mayorBorrando3 k n = read (mayorBorrandoLista3 k (show n))

-- (mayorBorrandoLista3 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista3 1 "6782334"  ==  "782334"
--    mayorBorrandoLista3 3 "6782334"  ==  "8334"
mayorBorrandoLista3 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista3 k xs = maximum (itera k borraUnoListas [xs])

-- (borraUnoListas xss) es la lista obtenida borrando un elemento (de
-- todas las formas posibles de la lista de listas no vacías xss. Por
-- ejemplo,
--    borraUnoListas ["abc","def"]  ==  ["bc","ac","ab","ef","df","de"]
borraUnoListas :: [[a]] -> [[a]]
borraUnoListas = concatMap borraUno

-- (borraUno xs) es la lista de listas obtenidas borrando un elemento de la
-- lista no vacía xs de todas las formas posibles. Por ejemplo,
--    borraUno "abcde"  ==  ["bcde","acde","abde","abce","abcd"]
borraUno :: [a] -> [[a]]
borraUno [x] = [[]]
borraUno (x:xs) = xs : map (x:) (borraUno xs)

-- (itera k f x) es el resultado de aplicar k veces la función f al
-- elemento x. Por ejmplo,
--    itera 3 (*2) 1   ==  8
--    itera 4 (+2) 10  ==  18
itera :: Eq a => Int -> (a -> a) -> a -> a
itera 0 _ x = x
itera n f x = itera (n-1) f (f x)

-- 4ª definición
-- =============

mayorBorrando4 :: Int -> Integer -> Integer
mayorBorrando4 k n = read (mayorBorrandoLista4 k (show n))

-- (mayorBorrandoLista4 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista4 1 "6782334"  ==  "782334"
--    mayorBorrandoLista4 3 "6782334"  ==  "8334"
mayorBorrandoLista4 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista4 k = itera k mayorBorraUno

-- (mayorBorraUno xs) es la mayor lista obtenida eliminando un elemento de
-- xs. Por ejemplo,
--    mayorBorraUno "6782334"  ==  "782334"
--    mayorBorraUno "782334"   ==  "82334"
--    mayorBorraUno "82334"    ==  "8334"
mayorBorraUno :: Ord a => [a] -> [a]
mayorBorraUno = maximum . borraUno

-- 5ª definición
-- =============

mayorBorrando5 :: Int -> Integer -> Integer
mayorBorrando5 k n = read (mayorBorrandoLista5 k (show n))

-- (mayorBorrandoLista5 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista5 1 "6782334"  ==  "782334"
--    mayorBorrandoLista5 3 "6782334"  ==  "8334"
mayorBorrandoLista5 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista5 k = itera k mayorBorraUno2

-- (mayorBorraUno2 xs) es la mayor lista obtenida eliminando un elemento de
-- xs. Por ejemplo,
--    mayorBorraUno2 "6782334"  ==  "782334"
--    mayorBorraUno2 "782334"   ==  "82334"
--    mayorBorraUno2 "82334"    ==  "8334"
mayorBorraUno2 :: Ord a => [a] -> [a]
mayorBorraUno2 [x]      = []
mayorBorraUno2 (x:y:xs) | x < y     = y:xs
                        | otherwise = x : mayorBorraUno2 (y:xs)

-- 6ª definición
-- =============

mayorBorrando6 :: Int -> Integer -> Integer
mayorBorrando6 k n = read (mayorBorrandoLista6 k (show n))

-- (mayorBorrandoLista6 k xs) es la mayor lista obtenida borrando k elementos de
-- xs (se supone que xs tiene más de k elementos). Por ejemplo,
--    mayorBorrandoLista6 1 "6782334"  ==  "782334"
--    mayorBorrandoLista6 3 "6782334"  ==  "8334"
mayorBorrandoLista6 :: Ord a => Int -> [a] -> [a]
mayorBorrandoLista6 k xs = aux k [] xs

aux 0 ys     xs     = reverse ys ++ xs
aux k ys     []     = reverse (drop k ys)
aux k []     (x:xs) = aux k [x] xs
aux k (y:ys) (x:xs) | y >= x    = aux k     (x:y:ys) xs
                    | otherwise = aux (k-1) ys       (x:xs)

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

-- La comparación es
--    λ> mayorBorrando 6 (product [1..18])
--    7705728000
--    (0.06 secs, 15,165,496 bytes)
--    λ> mayorBorrando2 6 (product [1..18])
--    7705728000
--    (0.04 secs, 19,662,816 bytes)
--    λ> mayorBorrando3 6 (product [1..18])
--    7705728000
--    (6.93 secs, 5,143,807,064 bytes)
--    λ> mayorBorrando4 6 (product [1..18])
--    7705728000
--    (0.01 secs, 183,728 bytes)
--    λ> mayorBorrando5 6 (product [1..18])
--    7705728000
--    (0.01 secs, 118,984 bytes)
--    λ> mayorBorrando6 6 (product [1..18])
--    7705728000
--
--    λ> mayorBorrando 17 (product [1..25])
--    998400000
--    (19.09 secs, 14,516,359,464 bytes)
--    λ> mayorBorrando2 17 (product [1..25])
--    998400000
--    (47.39 secs, 30,066,413,608 bytes)
--    λ> mayorBorrando4 17 (product [1..25])
--    998400000
--    (0.01 secs, 458,320 bytes)
--    λ> mayorBorrando5 17 (product [1..25])
--    998400000
--    (0.01 secs, 134,424 bytes)
--    λ> mayorBorrando6 17 (product [1..25])
--    984000000
--    (0.01 secs, 124,600 bytes)
--
--    λ> mayorBorrando4 600 (product [1..300])
--    999999999999999
--    (3.29 secs, 4,421,841,944 bytes)
--    λ> mayorBorrando5 600 (product [1..300])
--    999999999999999
--    (0.03 secs, 6,690,440 bytes)
--    λ> mayorBorrando6 600 (product [1..300])
--    960000000000000
--    (0.01 secs, 593,864 bytes)
--
--    λ> mayorBorrando5 10000 (4256 + 10^10004)
--    14256
--    (16.04 secs, 18,221,784,872 bytes)
--    λ> mayorBorrando6 10000 (4256 + 10^10004)
--    14256
--    (0.02 secs, 6,669,592 bytes)
--
--    λ> mayorBorrando6 1000000 (4256 + 10^1000004)
--    14256
--    (1.04 secs, 655,561,656 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

import Data.List (subsequences)

-- 1ª definición

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

mayorBorrando :: Int -> Integer -> Integer

mayorBorrando k n = read (mayorBorrandoLista1 k (show n))

-- (mayorBorrandoLista1 k xs) es la mayor lista obtenida borrando k elementos de

-- xs (se supone que xs tiene más de k elementos). Por ejemplo,

-- mayorBorrandoLista1 1 "6782334" == "782334"

-- mayorBorrandoLista1 3 "6782334" == "8334"

mayorBorrandoLista1 :: Ord a => Int -> [a] -> [a]

mayorBorrandoLista1 k xs = maximum (borra1 k xs)

-- (borra1 k xs) es la lista de las listas obtenidas borrando k elementos

-- de xs. Por ejemplo,

-- borra1 1 "abcd" == ["abc","abd","acd","bcd"]

-- borra1 2 "abcd" == ["ab","ac","bc","ad","bd","cd"]

-- borra1 3 "abcd" == ["a","b","c","d"]

borra1 n xs = [ys | ys <- subsequences xs, length ys == k]

where k = length xs - n

-- 2ª definición

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

mayorBorrando2 :: Int -> Integer -> Integer

mayorBorrando2 k n = read (mayorBorrandoLista2 k (show n))

-- (mayorBorrandoLista2 k xs) es la mayor lista obtenida borrando k elementos de

-- xs (se supone que xs tiene más de k elementos). Por ejemplo,

-- mayorBorrandoLista2 1 "6782334" == "782334"

-- mayorBorrandoLista2 3 "6782334" == "8334"

mayorBorrandoLista2 :: Ord a => Int -> [a] -> [a]

mayorBorrandoLista2 k xs = maximum (borra2 k xs)

-- (borra2 k xs) es la lista de las listas obtenidas borrando k elementos

-- de xs. Por ejemplo,

-- borra2 1 "abcd" == ["abc","abd","acd","bcd"]

-- borra2 2 "abcd" == ["ab","ac","ad","bc","bd","cd"]

-- borra2 3 "abcd" == ["a","b","c","d"]

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

borra2 0 xs = [xs]

borra2 n [] = []

borra2 n (x:xs) = [x:ys | ys <- borra2 n xs] ++ borra2 (n-1) xs

-- 3ª definición

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

mayorBorrando3 :: Int -> Integer -> Integer

mayorBorrando3 k n = read (mayorBorrandoLista3 k (show n))

-- (mayorBorrandoLista3 k xs) es la mayor lista obtenida borrando k elementos de

-- xs (se supone que xs tiene más de k elementos). Por ejemplo,

-- mayorBorrandoLista3 1 "6782334" == "782334"

-- mayorBorrandoLista3 3 "6782334" == "8334"

mayorBorrandoLista3 :: Ord a => Int -> [a] -> [a]

mayorBorrandoLista3 k xs = maximum (itera k borraUnoListas [xs])

-- (borraUnoListas xss) es la lista obtenida borrando un elemento (de

-- todas las formas posibles de la lista de listas no vacías xss. Por

-- ejemplo,

-- borraUnoListas ["abc","def"] == ["bc","ac","ab","ef","df","de"]

borraUnoListas :: [[a]] -> [[a]]

borraUnoListas = concatMap borraUno

-- (borraUno xs) es la lista de listas obtenidas borrando un elemento de la

-- lista no vacía xs de todas las formas posibles. Por ejemplo,

-- borraUno "abcde" == ["bcde","acde","abde","abce","abcd"]

borraUno :: [a] -> [[a]]

borraUno [x] = [[]]

borraUno (x:xs) = xs : map (x:) (borraUno xs)

-- (itera k f x) es el resultado de aplicar k veces la función f al

-- elemento x. Por ejmplo,

-- itera 3 (*2) 1 == 8

-- itera 4 (+2) 10 == 18

itera :: Eq a => Int -> (a -> a) -> a -> a

itera 0 _ x = x

itera n f x = itera (n-1) f (f x)

-- 4ª definición

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

mayorBorrando4 :: Int -> Integer -> Integer

mayorBorrando4 k n = read (mayorBorrandoLista4 k (show n))

-- (mayorBorrandoLista4 k xs) es la mayor lista obtenida borrando k elementos de

-- xs (se supone que xs tiene más de k elementos). Por ejemplo,

-- mayorBorrandoLista4 1 "6782334" == "782334"

-- mayorBorrandoLista4 3 "6782334" == "8334"

mayorBorrandoLista4 :: Ord a => Int -> [a] -> [a]

mayorBorrandoLista4 k = itera k mayorBorraUno

-- (mayorBorraUno xs) es la mayor lista obtenida eliminando un elemento de

-- xs. Por ejemplo,

-- mayorBorraUno "6782334" == "782334"

-- mayorBorraUno "782334" == "82334"

-- mayorBorraUno "82334" == "8334"

mayorBorraUno :: Ord a => [a] -> [a]

mayorBorraUno = maximum . borraUno

-- 5ª definición

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

mayorBorrando5 :: Int -> Integer -> Integer

mayorBorrando5 k n = read (mayorBorrandoLista5 k (show n))

-- (mayorBorrandoLista5 k xs) es la mayor lista obtenida borrando k elementos de

-- xs (se supone que xs tiene más de k elementos). Por ejemplo,

-- mayorBorrandoLista5 1 "6782334" == "782334"

-- mayorBorrandoLista5 3 "6782334" == "8334"

mayorBorrandoLista5 :: Ord a => Int -> [a] -> [a]

mayorBorrandoLista5 k = itera k mayorBorraUno2

-- (mayorBorraUno2 xs) es la mayor lista obtenida eliminando un elemento de

-- xs. Por ejemplo,

-- mayorBorraUno2 "6782334" == "782334"

-- mayorBorraUno2 "782334" == "82334"

-- mayorBorraUno2 "82334" == "8334"

mayorBorraUno2 :: Ord a => [a] -> [a]

mayorBorraUno2 [x] = []

mayorBorraUno2 (x:y:xs) | x < y = y:xs

| otherwise = x : mayorBorraUno2 (y:xs)

-- 6ª definición

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

mayorBorrando6 :: Int -> Integer -> Integer

mayorBorrando6 k n = read (mayorBorrandoLista6 k (show n))

-- (mayorBorrandoLista6 k xs) es la mayor lista obtenida borrando k elementos de

-- xs (se supone que xs tiene más de k elementos). Por ejemplo,

-- mayorBorrandoLista6 1 "6782334" == "782334"

-- mayorBorrandoLista6 3 "6782334" == "8334"

mayorBorrandoLista6 :: Ord a => Int -> [a] -> [a]

mayorBorrandoLista6 k xs = aux k [] xs

aux 0 ys xs = reverse ys ++ xs

aux k ys [] = reverse (drop k ys)

aux k [] (x:xs) = aux k [x] xs

aux k (y:ys) (x:xs) | y >= x = aux k (x:y:ys) xs

| otherwise = aux (k-1) ys (x:xs)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> mayorBorrando 6 (product [1..18])

-- 7705728000

-- (0.06 secs, 15,165,496 bytes)

-- λ> mayorBorrando2 6 (product [1..18])

-- 7705728000

-- (0.04 secs, 19,662,816 bytes)

-- λ> mayorBorrando3 6 (product [1..18])

-- 7705728000

-- (6.93 secs, 5,143,807,064 bytes)

-- λ> mayorBorrando4 6 (product [1..18])

-- 7705728000

-- (0.01 secs, 183,728 bytes)

-- λ> mayorBorrando5 6 (product [1..18])

-- 7705728000

-- (0.01 secs, 118,984 bytes)

-- λ> mayorBorrando6 6 (product [1..18])

-- 7705728000

-- λ> mayorBorrando 17 (product [1..25])

-- 998400000

-- (19.09 secs, 14,516,359,464 bytes)

-- λ> mayorBorrando2 17 (product [1..25])

-- 998400000

-- (47.39 secs, 30,066,413,608 bytes)

-- λ> mayorBorrando4 17 (product [1..25])

-- 998400000

-- (0.01 secs, 458,320 bytes)

-- λ> mayorBorrando5 17 (product [1..25])

-- 998400000

-- (0.01 secs, 134,424 bytes)

-- λ> mayorBorrando6 17 (product [1..25])

-- 984000000

-- (0.01 secs, 124,600 bytes)

-- λ> mayorBorrando4 600 (product [1..300])

-- 999999999999999

-- (3.29 secs, 4,421,841,944 bytes)

-- λ> mayorBorrando5 600 (product [1..300])

-- 999999999999999

-- (0.03 secs, 6,690,440 bytes)

-- λ> mayorBorrando6 600 (product [1..300])

-- 960000000000000

-- (0.01 secs, 593,864 bytes)

-- λ> mayorBorrando5 10000 (4256 + 10^10004)

-- 14256

-- (16.04 secs, 18,221,784,872 bytes)

-- λ> mayorBorrando6 10000 (4256 + 10^10004)

-- 14256

-- (0.02 secs, 6,669,592 bytes)

-- λ> mayorBorrando6 1000000 (4256 + 10^1000004)

-- 14256

-- (1.04 secs, 655,561,656 bytes)

Nuevas soluciones

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

Listas obtenidas borrando k elementos

PorJosé A. Alonso 5-febrero-202112-febrero-2021

Definir la función

   borra :: Int -> [a] -> [[a]]

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

tal que (borra n xs) es la lista de las listas obtenidas borrando n elementos de xs. Por ejemplo,

   borra 0 "abcd"  ==  ["abcd"]
   borra 1 "abcd"  ==  ["abc","abd","acd","bcd"]
   borra 2 "abcd"  ==  ["ab","ac","ad","bc","bd","cd"]
   borra 3 "abcd"  ==  ["a","b","c","d"]
   borra 4 "abcd"  ==  [""]
   borra 5 "abcd"  ==  []
   borra 6 "abcd"  ==  []
   length (borra 2 [1..300])  ==  44850

borra 0 "abcd" == ["abcd"]

borra 1 "abcd" == ["abc","abd","acd","bcd"]

borra 2 "abcd" == ["ab","ac","ad","bc","bd","cd"]

borra 3 "abcd" == ["a","b","c","d"]

borra 4 "abcd" == [""]

borra 5 "abcd" == []

borra 6 "abcd" == []

length (borra 2 [1..300]) == 44850

Soluciones

import Data.List (nub, subsequences)

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

borra1 :: Eq a => Int -> [a] -> [[a]]
borra1 n xs = [ys | ys <- subsequences xs, length ys == k]
  where k = length xs - n

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

borra2 :: Eq a => Int -> [a] -> [[a]]
borra2 0 xs     = [xs]
borra2 n []     = []
borra2 n (x:xs) = [x:ys | ys <- borra2 n xs] ++ borra2 (n-1) xs

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

borra3 :: Eq a => Int -> [a] -> [[a]]
borra3 n xs =
  nub (itera n borraUnoListas [xs])

-- (borraUno xs) es la lista de listas obtenidas borrando un elemento de la
-- lista no vacía xs de todas las formas posibles. Por ejemplo,
--    borraUno "abcde"  ==  ["bcde","acde","abde","abce","abcd"]
borraUno :: [a] -> [[a]]
borraUno [x] = [[]]
borraUno (x:xs) = xs : map (x:) (borraUno xs)

--    borraUnoListas ["abc", "def"]  ==  ["bc","ac","ab","ef","df","de"]
borraUnoListas :: [[a]] -> [[a]]
borraUnoListas = concatMap borraUno

-- (itera k f x) es el resultado de aplicar k veces la función f al
-- elemento x. Por ejmplo,
--    itera 3 (*2) 1   ==  8
--    itera 4 (+2) 10  ==  18
itera :: Eq a => Int -> (a -> a) -> a -> a
itera 0 _ x = x
itera n f x = itera (n-1) f (f x)

-- 2ª definición de itera
itera2 :: Eq a => Int -> (a -> a) -> a -> a
itera2 0 _ = id
itera2 n f = itera2 (n-1) f . f

-- 3ª definición de itera
itera3 :: Eq a => Int -> (a -> a) -> a -> a
itera3 n f x = (iterate f x) !! n

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

-- La comparación es
--    λ> length (borra1 10 [1..11])
--    11
--    (0.03 secs, 527,712 bytes)
--    λ> length (borra2 10 [1..11])
--    11
--    (0.01 secs, 917,720 bytes)
--    λ> length (borra3 10 [1..11])
--    11
--    (22.32 secs, 20,104,455,496 bytes)
--
--    λ> length (borra1 25 [1..26])
--    26
--    (16.30 secs, 13,958,748,280 bytes)
--    λ> length (borra2 25 [1..26])
--    26
--    (36.36 secs, 25,769,904,744 bytes)
--
--    λ> length (borra1 2 [1..26])
--    325
--    (16.51 secs, 13,958,767,696 bytes)
--    λ> length (borra2 2 [1..26])
--    325
--    (0.01 secs, 168,272 bytes)
--    λ> length (borra3 2 [1..26])
--    325
--    (0.03 secs, 1,209,992 bytes)
--
--    λ> length (borra2 2 [1..100])
--    4950
--    (0.06 secs, 59,128,272 bytes)
--    λ> length (borra3 2 [1..100])
--    4950
--    (6.37 secs, 57,943,128 bytes)

import Data.List (nub, subsequences)

-- 1ª solución

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

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

borra1 n xs = [ys | ys <- subsequences xs, length ys == k]

where k = length xs - n

-- 2ª solución

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

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

borra2 0 xs = [xs]

borra2 n [] = []

borra2 n (x:xs) = [x:ys | ys <- borra2 n xs] ++ borra2 (n-1) xs

-- 3ª solución

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

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

borra3 n xs =

nub (itera n borraUnoListas [xs])

-- (borraUno xs) es la lista de listas obtenidas borrando un elemento de la

-- lista no vacía xs de todas las formas posibles. Por ejemplo,

-- borraUno "abcde" == ["bcde","acde","abde","abce","abcd"]

borraUno :: [a] -> [[a]]

borraUno [x] = [[]]

borraUno (x:xs) = xs : map (x:) (borraUno xs)

-- borraUnoListas ["abc", "def"] == ["bc","ac","ab","ef","df","de"]

borraUnoListas :: [[a]] -> [[a]]

borraUnoListas = concatMap borraUno

-- (itera k f x) es el resultado de aplicar k veces la función f al

-- elemento x. Por ejmplo,

-- itera 3 (*2) 1 == 8

-- itera 4 (+2) 10 == 18

itera :: Eq a => Int -> (a -> a) -> a -> a

itera 0 _ x = x

itera n f x = itera (n-1) f (f x)

-- 2ª definición de itera

itera2 :: Eq a => Int -> (a -> a) -> a -> a

itera2 0 _ = id

itera2 n f = itera2 (n-1) f . f

-- 3ª definición de itera

itera3 :: Eq a => Int -> (a -> a) -> a -> a

itera3 n f x = (iterate f x) !! n

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (borra1 10 [1..11])

-- 11

-- (0.03 secs, 527,712 bytes)

-- λ> length (borra2 10 [1..11])

-- 11

-- (0.01 secs, 917,720 bytes)

-- λ> length (borra3 10 [1..11])

-- 11

-- (22.32 secs, 20,104,455,496 bytes)

-- λ> length (borra1 25 [1..26])

-- 26

-- (16.30 secs, 13,958,748,280 bytes)

-- λ> length (borra2 25 [1..26])

-- 26

-- (36.36 secs, 25,769,904,744 bytes)

-- λ> length (borra1 2 [1..26])

-- 325

-- (16.51 secs, 13,958,767,696 bytes)

-- λ> length (borra2 2 [1..26])

-- 325

-- (0.01 secs, 168,272 bytes)

-- λ> length (borra3 2 [1..26])

-- 325

-- (0.03 secs, 1,209,992 bytes)

-- λ> length (borra2 2 [1..100])

-- 4950

-- (0.06 secs, 59,128,272 bytes)

-- λ> length (borra3 2 [1..100])

-- 4950

-- (6.37 secs, 57,943,128 bytes)

Nuevas soluciones

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

Pares con múltiplos con igual número de divisores

PorJosé A. Alonso 4-febrero-202111-febrero-2021

Definir la función

   paresNoDivisible :: [(Integer, Integer)]

1	paresNoDivisible :: [(Integer, Integer)]

tal que paresNoDivisible es la lista de los pares (n,k) tales que n < k y k no es divisible por n. Por ejemplo,

   λ> take 10 paresNoDivisible
   [(2,3),(3,4),(2,5),(3,5),(4,5),(4,6),(5,6),(2,7),(3,7),(4,7)]

1 2	λ> take 10 paresNoDivisible [(2,3),(3,4),(2,5),(3,5),(4,5),(4,6),(5,6),(2,7),(3,7),(4,7)]

Se observa que en el resultado los pares se ordenan primero según su segundo elemento y los que tienen el mismo segundo elemento se ordenan por el primer elemento.

Un par especial es un par de enteros positivos (n,k) tales que existe algún s tal que $s \times n$ y $s \times k$ tienen el mismo número de divisores. Por ejemplo, (3,4) es un par especial ya que $2 \times 3$ y $2 \times 4$ tienen 4 divisores.

Comprobar con QuickCheck todos los elementos de paresNoDivisible son pares especiales.

Nota: Este ejercicio está basado en el problema N1 de la Olimpíada Internacional de Matemáticas (IMO) del 2018.

Soluciones

import Data.List (genericLength, group)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck (Property, (==>), quickCheck)

-- Definición de paresNoDivisible
-- ==============================

paresNoDivisible :: [(Integer, Integer)]
paresNoDivisible =
  filter parNoDivisible pares

-- pares es la lista de los pares de enteros positivos ordenados primero
-- según su segundo elemento y los que tienen el mismo segundo elemento
-- están ordenados por el primer elemento. Por ejemplo,
--    λ> take 10 pares
--    [(1,2),(1,3),(2,3),(1,4),(2,4),(3,4),(1,5),(2,5),(3,5),(4,5)]
pares :: [(Integer, Integer)]
pares =
  [(n,k) | k <- [1..]
         , n <- [1..k-1]]

-- (parNoDivisible (n,k)) se verifica si n < k y k no es divisible por
-- n. Por ejemplo,
--    parNoDivisible (2,3)  ==  True
--    parNoDivisible (2,4)  ==  False
--    parNoDivisible (3,2)  ==  False
parNoDivisible :: (Integer, Integer) -> Bool
parNoDivisible (n,k) =
  n < k &&
  k `mod` n  /= 0

-- Definiciones de parEspecial
-- ===========================

-- Para expresar la propiedad se define la función
--    parEspecial :: (Integer, Integer) -> Bool
-- tal que (parEspecial (n,k)) se verifica si existe algún s tal que s*n
-- y s*k tienen el mismo número de divisores. Por ejemplo, {-# SCC "" #-}
--    parEspecial (3,4)  ==  True
--
-- Nota: La función parEspecial es una función parcial ya que sólo
-- termina para los pares especiales.

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

parEspecial1 :: (Integer, Integer) -> Bool
parEspecial1 (n,k) =
  n < k && not (null [s | s <- [1..]
                       , numeroDivisores (s * n) ==
                         numeroDivisores (s * k)])

-- (numeroDivisores n) es el número de divisores de n. Por ejemplo,
--    numeroDivisores 12  ==  6
--    numeroDivisores 14  ==  4
numeroDivisores :: Integer -> Integer
numeroDivisores n =
  genericLength [x | x <- [1..n]
                   , n `mod` x == 0]

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

parEspecial2 :: (Integer, Integer) -> Bool
parEspecial2 (n,k) =
  n < k && not (null [s | s <- [1..]
                       , numeroDivisores2 (s * n) ==
                         numeroDivisores2 (s * k)])

-- (numeroDivisores2 n) es el número de divisores de n. Por ejemplo,
--    numeroDivisores2 12  ==  6
--    numeroDivisores2 14  ==  4
numeroDivisores2 :: Integer -> Integer
numeroDivisores2 =
  product . map ((+1) . genericLength) . group . primeFactors

-- Comparación de eficiencia de definiciones de parEspecial
-- --------------------------------------------------------

-- La comparación es
--    λ> parEspecial1 (9,30)
--    True
--    (28.24 secs, 15,625,373,696 bytes)
--    λ> parEspecial2 (9,30)
--    True
--    (0.06 secs, 58,698,264 bytes)

-- En lo que sigue, usaremos la 2ª definición
parEspecial :: (Integer, Integer) -> Bool
parEspecial = parEspecial2

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

-- La propiedad es
prop_paresNoDivisible :: Int -> Property
prop_paresNoDivisible i =
  i >= 0 ==>
  parEspecial (paresNoDivisible !! i)

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

100

101

102

103

import Data.List (genericLength, group)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck (Property, (==>), quickCheck)

-- Definición de paresNoDivisible

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

paresNoDivisible :: [(Integer, Integer)]

paresNoDivisible =

filter parNoDivisible pares

-- pares es la lista de los pares de enteros positivos ordenados primero

-- según su segundo elemento y los que tienen el mismo segundo elemento

-- están ordenados por el primer elemento. Por ejemplo,

-- λ> take 10 pares

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

pares :: [(Integer, Integer)]

pares =

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

, n <- [1..k-1]]

-- (parNoDivisible (n,k)) se verifica si n < k y k no es divisible por

-- n. Por ejemplo,

-- parNoDivisible (2,3) == True

-- parNoDivisible (2,4) == False

-- parNoDivisible (3,2) == False

parNoDivisible :: (Integer, Integer) -> Bool

parNoDivisible (n,k) =

n < k &&

k `mod` n /= 0

-- Definiciones de parEspecial

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

-- Para expresar la propiedad se define la función

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

-- tal que (parEspecial (n,k)) se verifica si existe algún s tal que s*n

-- y s*k tienen el mismo número de divisores. Por ejemplo, {-# SCC "" #-}

-- parEspecial (3,4) == True

-- Nota: La función parEspecial es una función parcial ya que sólo

-- termina para los pares especiales.

-- 1ª definición de parEspecial

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

parEspecial1 :: (Integer, Integer) -> Bool

parEspecial1 (n,k) =

n < k && not (null [s | s <- [1..]

, numeroDivisores (s * n) ==

numeroDivisores (s * k)])

-- (numeroDivisores n) es el número de divisores de n. Por ejemplo,

-- numeroDivisores 12 == 6

-- numeroDivisores 14 == 4

numeroDivisores :: Integer -> Integer

numeroDivisores n =

genericLength [x | x <- [1..n]

, n `mod` x == 0]

-- 2ª definición de parEspecial

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

parEspecial2 :: (Integer, Integer) -> Bool

parEspecial2 (n,k) =

n < k && not (null [s | s <- [1..]

, numeroDivisores2 (s * n) ==

numeroDivisores2 (s * k)])

-- (numeroDivisores2 n) es el número de divisores de n. Por ejemplo,

-- numeroDivisores2 12 == 6

-- numeroDivisores2 14 == 4

numeroDivisores2 :: Integer -> Integer

numeroDivisores2 =

product . map ((+1) . genericLength) . group . primeFactors

-- Comparación de eficiencia de definiciones de parEspecial

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

-- La comparación es

-- λ> parEspecial1 (9,30)

-- True

-- (28.24 secs, 15,625,373,696 bytes)

-- λ> parEspecial2 (9,30)

-- True

-- (0.06 secs, 58,698,264 bytes)

-- En lo que sigue, usaremos la 2ª definición

parEspecial :: (Integer, Integer) -> Bool

parEspecial = parEspecial2

-- Propiedad

-- =========

-- La propiedad es

prop_paresNoDivisible :: Int -> Property

prop_paresNoDivisible i =

i >= 0 ==>

parEspecial (paresNoDivisible !! i)

-- La comprobación es

-- λ> quickCheck prop_paresNoDivisible

-- +++ OK, passed 100 tests.

Nuevas soluciones

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

Los números armónicos no son enteros

PorJosé A. Alonso 3-febrero-202110-febrero-2021

Los números armónicos son las sumas de los inversos de de los primeros números enteros positivos; es decir, el n-ésimo número armónico es

   H(n) = 1 + 1/2 + 1/3 + ··· + 1/n

1	H(n) = 1 + 1/2 + 1/3 + ··· + 1/n

Los primeros números armónicos son

   1, 3/2, 11/6, 25/12, 137/60, ..

1	1, 3/2, 11/6, 25/12, 137/60, ..

Definir, usando la librería de los números racionales (Data.Ratio), las funciones

   armonico  :: Integer -> Rational
   armonicos :: [Rational]
   esEntero  :: Rational -> Bool

armonico :: Integer -> Rational

armonicos :: [Rational]

esEntero :: Rational -> Bool

tales que

(armonico n) es el n-ésimo número armónico. Por ejemplo,

     armonico 2  ==    3 % 2
     armonico 3  ==   11 % 6
     armonico 4  ==   25 % 12
     armonico 5  ==  137 % 60

armonico 2 == 3 % 2

armonico 3 == 11 % 6

armonico 4 == 25 % 12

armonico 5 == 137 % 60

armonicos es la lista de los números armónicos. Por ejemplo,

     take 5 armonicos  ==  [1 % 1,3 % 2,11 % 6,25 % 12,137 % 60]

1	take 5 armonicos == [1 % 1,3 % 2,11 % 6,25 % 12,137 % 60]

(esEntero x) se verifica si x es un número entero. Por ejemplo,

     esEntero (1 % 7)           ==  False
     esEntero (1 % 7 + 20 % 7)  ==  True

1 2	esEntero (1 % 7) == False esEntero (1 % 7 + 20 % 7) == True

Comprobar con QuickCheck que

nigún número armónico, excepto el primero, es un número entero y
la diferencia de dos números armónicos distintos nunca es un número entero.

Nota: Este ejercicio está basado en el artículo Sums of consecutive reciprocals publicado por John D. Cook en su blog el 23 de enero de 2021.

Soluciones

import Data.List (genericIndex)
import Data.Ratio ((%), denominator)
import Test.QuickCheck (Property, (==>), quickCheck)

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

armonico  :: Integer -> Rational
armonico 1 = 1
armonico n = 1 % n + armonico (n-1)

armonicos :: [Rational]
armonicos = map armonico [1..]

esEntero  :: Rational -> Bool
esEntero x = denominator x == 1

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

armonicos2 :: [Rational]
armonicos2 = scanl1 (\ x y -> x + y) [1 % n | n <- [1..]]

armonico2  :: Integer -> Rational
armonico2 n = armonicos `genericIndex` n

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

-- La comparación es
--    λ> fromRational (armonicos !! (10^4))
--    9.787706026045383
--    (9.17 secs, 29,293,137,856 bytes)
--    λ> fromRational (armonicos2 !! (10^4))
--    9.787706026045383
--    (9.42 secs, 29,292,225,904 bytes)

-- Propiedades
-- ===========

-- La 1ª propiedad es
prop_armonicos :: Integer -> Property
prop_armonicos n =
  n > 1 ==>
  not (esEntero (armonico n))

-- La comprobación de la 1ª propiedad es
--    λ> quickCheck prop_armonicos
--    +++ OK, passed 100 tests.

-- La 2ª propiedad es
prop_armonicos2 :: Integer -> Integer -> Property
prop_armonicos2 n m =
  n > 0 && m > 0 && n /= m ==>
  not (esEntero (armonico n - armonico m))

-- La comprobación de la segunda propiedad es
--   λ> quickCheck prop_armonicos2
--   +++ OK, passed 100 tests.

import Data.List (genericIndex)

import Data.Ratio ((%), denominator)

import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª solución

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

armonico :: Integer -> Rational

armonico 1 = 1

armonico n = 1 % n + armonico (n-1)

armonicos :: [Rational]

armonicos = map armonico [1..]

esEntero :: Rational -> Bool

esEntero x = denominator x == 1

-- 2ª solución

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

armonicos2 :: [Rational]

armonicos2 = scanl1 (\ x y -> x + y) [1 % n | n <- [1..]]

armonico2 :: Integer -> Rational

armonico2 n = armonicos `genericIndex` n

-- Comparación de eficiencia

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

-- La comparación es

-- λ> fromRational (armonicos !! (10^4))

-- 9.787706026045383

-- (9.17 secs, 29,293,137,856 bytes)

-- λ> fromRational (armonicos2 !! (10^4))

-- 9.787706026045383

-- (9.42 secs, 29,292,225,904 bytes)

-- Propiedades

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

-- La 1ª propiedad es

prop_armonicos :: Integer -> Property

prop_armonicos n =

n > 1 ==>

not (esEntero (armonico n))

-- La comprobación de la 1ª propiedad es

-- λ> quickCheck prop_armonicos

-- +++ OK, passed 100 tests.

-- La 2ª propiedad es

prop_armonicos2 :: Integer -> Integer -> Property

prop_armonicos2 n m =

n > 0 && m > 0 && n /= m ==>

not (esEntero (armonico n - armonico m))

-- La comprobación de la segunda propiedad es

-- λ> quickCheck prop_armonicos2

-- +++ OK, passed 100 tests.

Nuevas soluciones

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

Partición por suma

PorJosé A. Alonso 2-febrero-20219-febrero-2021

Definir la función

   particion :: Int -> [Int] -> [[Int]]

1	particion :: Int -> [Int] -> [[Int]]

tal que (particion n xs) es la lista de los elementos de xs, en el mismo orden, agrupados en listas con sumas menores o iguales que n. Por ejemplo,

   particion 6 [1,1,1,3,2,2,2,1,2,2,3]   ==  [[1,1,1,3],[2,2,2],[1,2,2],[3]]
   particion 5 [1,1,1,3,2,2,2,1,2,2,3]   ==  [[1,1,1],[3,2],[2,2,1],[2,2],[3]]
   particion 4 [1,1,1,3,2,2,2,1,2,2,3]   ==  [[1,1,1],[3],[2,2],[2,1],[2,2],[3]]
   particion 3 [1,1,1,3,2,2,2,1,2,2,3]   ==  [[1,1,1],[3],[2],[2],[2,1],[2],[2],[3]]
   particion 2 [1,1,1,3,2,2,2,1,2,2,3]   ==  []

particion 6 [1,1,1,3,2,2,2,1,2,2,3] == [[1,1,1,3],[2,2,2],[1,2,2],[3]]

particion 5 [1,1,1,3,2,2,2,1,2,2,3] == [[1,1,1],[3,2],[2,2,1],[2,2],[3]]

particion 4 [1,1,1,3,2,2,2,1,2,2,3] == [[1,1,1],[3],[2,2],[2,1],[2,2],[3]]

particion 3 [1,1,1,3,2,2,2,1,2,2,3] == [[1,1,1],[3],[2],[2],[2,1],[2],[2],[3]]

particion 2 [1,1,1,3,2,2,2,1,2,2,3] == []

Soluciones

particion :: Int -> [Int] -> [[Int]]
particion n xs = reverse (map reverse (aux xs [[]]))
  where aux []     yss      = yss
        aux (x:xs) (ys:yss) | x > n           = []
                            | x + sum ys <= n = aux xs ((x:ys):yss)
                            | otherwise       = aux xs ([x]:ys:yss)

particion :: Int -> [Int] -> [[Int]]

particion n xs = reverse (map reverse (aux xs [[]]))

where aux [] yss = yss

aux (x:xs) (ys:yss) | x > n = []

| x + sum ys <= n = aux xs ((x:ys):yss)

| otherwise = aux xs ([x]:ys:yss)

Nuevas soluciones

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

Con algún nueve

PorJosé A. Alonso 1-febrero-20218-febrero-2021

Definir las funciones

   numerosConNueve :: [Integer]
   conNueve :: Integer -> Integer

1 2	numerosConNueve :: [Integer] conNueve :: Integer -> Integer

tales que

numerosConNueve es la lista de los números con algún dígito igual a 9. Por ejemplo,

     λ> take 20 numerosConNueve
     [9,19,29,39,49,59,69,79,89,90,91,92,93,94,95,96,97,98,99,109]

1 2	λ> take 20 numerosConNueve [9,19,29,39,49,59,69,79,89,90,91,92,93,94,95,96,97,98,99,109]

(conNueve n) es la cantidad de números enteros no negativos menores o iguales que n con algún dígito igual a 9. Por ejemplo,

     conNueve 1   ==  0
     conNueve 10  ==  1
     conNueve 90  ==  10
     length (show (conNueve (10^3)))      ==  3
     length (show (conNueve (10^30)))     ==  30
     length (show (conNueve (10^300)))    ==  300
     length (show (conNueve (10^3000)))   ==  3000
     length (show (conNueve (10^30000)))  ==  30000

conNueve 1 == 0

conNueve 10 == 1

conNueve 90 == 10

length (show (conNueve (10^3))) == 3

length (show (conNueve (10^30))) == 30

length (show (conNueve (10^300))) == 300

length (show (conNueve (10^3000))) == 3000

length (show (conNueve (10^30000))) == 30000

Soluciones

import Data.List (genericLength)
import Test.QuickCheck (Property, (==>), quickCheck)

numerosConNueve :: [Integer]
numerosConNueve = filter tieneNueve [9..]

-- (tieneNueve n) se verifica si algún dígito de n es igual a 9. Por
-- ejemplo,
--    tieneNueve 2919  ==  True
--    tieneNueve 2717  ==  False
tieneNueve :: Integer -> Bool
tieneNueve n = '9' `elem` show n

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

conNueve :: Integer -> Integer
conNueve n =
  genericLength (takeWhile (<= n) numerosConNueve)

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

conNueve2 :: Integer -> Integer
conNueve2 0 = 0
conNueve2 n
  | tieneNueve n = 1 + conNueve2 (n-1)
  | otherwise   = conNueve2 (n-1)

-- 3ª definición de conNueve
-- =========================

conNueve3 :: Integer -> Integer
conNueve3 n = n + 1 - sinNueve n

-- (sinNueve n) es la cantidad de números enteros no negativos menores
-- o iguales que n con ningún dígito igual a 9. Por ejemplo,
--    sinNueve 1   ==  2
--    sinNueve 9   ==  9
--    sinNueve 90  ==  81
sinNueve :: Integer -> Integer
sinNueve n = aux (digitos n)
  where aux []     = 0
        aux [9]    = 9
        aux [x]    = x+1
        aux (9:xs) = 9^(1 + length xs)
        aux (x:xs) = x*9^(length xs) + aux xs

-- (digitos n) es la lista de los dígitod de n. Por ejemplo,
--    digitos 2021  ==  [2,0,2,1]
digitos :: Integer -> [Integer]
digitos n = [read [c] | c <- show n]

-- 4ª definición de conNueve
-- =========================

conNueve4 :: Integer -> Integer
conNueve4 n = n + 1 - sinNueve2 n

sinNueve2 :: Integer -> Integer
sinNueve2 n = aux ds (length ds)
  where ds = digitos n
        aux []     _ = 0
        aux [9]    _ = 9
        aux [x]    _ = x+1
        aux (9:xs) m = 9^m
        aux (x:xs) m = x*9^(m-1) + aux xs (m-1)

-- Comprobacion de equivalencia
-- ============================

-- La propiedad es
prop_conNueve_equiv :: Integer -> Property
prop_conNueve_equiv n =
  n >= 0 ==>
  all (== (conNueve n))
      [conNueve2 n,
       conNueve3 n,
       conNueve4 n]

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

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

-- La comparación es
--    λ> conNueve (10^7)
--    5217031
--    (5.21 secs, 5,215,047,968 bytes)
--    λ> conNueve2 (10^7)
--    5217031
--    (8.25 secs, 5,651,944,872 bytes)
--    λ> conNueve3 (10^7)
--    5217031
--    (0.02 secs, 144,000 bytes)
--    λ> conNueve4 (10^7)
--    5217031
--    (0.02 secs, 145,904 bytes)
--
--    λ> length (show (conNueve3 (10^30000)))
--    30000
--    (3.24 secs, 776,076,072 bytes)
--    λ> length (show (conNueve4 (10^30000)))
--    30000
--    (2.00 secs, 786,452,856 bytes)

100

101

102

103

104

105

106

107

import Data.List (genericLength)

import Test.QuickCheck (Property, (==>), quickCheck)

numerosConNueve :: [Integer]

numerosConNueve = filter tieneNueve [9..]

-- (tieneNueve n) se verifica si algún dígito de n es igual a 9. Por

-- ejemplo,

-- tieneNueve 2919 == True

-- tieneNueve 2717 == False

tieneNueve :: Integer -> Bool

tieneNueve n = '9' `elem` show n

-- 1ª definición de conNueve

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

conNueve :: Integer -> Integer

conNueve n =

genericLength (takeWhile (<= n) numerosConNueve)

-- 2ª definición de conNueve

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

conNueve2 :: Integer -> Integer

conNueve2 0 = 0

conNueve2 n

| tieneNueve n = 1 + conNueve2 (n-1)

| otherwise = conNueve2 (n-1)

-- 3ª definición de conNueve

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

conNueve3 :: Integer -> Integer

conNueve3 n = n + 1 - sinNueve n

-- (sinNueve n) es la cantidad de números enteros no negativos menores

-- o iguales que n con ningún dígito igual a 9. Por ejemplo,

-- sinNueve 1 == 2

-- sinNueve 9 == 9

-- sinNueve 90 == 81

sinNueve :: Integer -> Integer

sinNueve n = aux (digitos n)

where aux [] = 0

aux [9] = 9

aux [x] = x+1

aux (9:xs) = 9^(1 + length xs)

aux (x:xs) = x*9^(length xs) + aux xs

-- (digitos n) es la lista de los dígitod de n. Por ejemplo,

-- digitos 2021 == [2,0,2,1]

digitos :: Integer -> [Integer]

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

-- 4ª definición de conNueve

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

conNueve4 :: Integer -> Integer

conNueve4 n = n + 1 - sinNueve2 n

sinNueve2 :: Integer -> Integer

sinNueve2 n = aux ds (length ds)

where ds = digitos n

aux [] _ = 0

aux [9] _ = 9

aux [x] _ = x+1

aux (9:xs) m = 9^m

aux (x:xs) m = x*9^(m-1) + aux xs (m-1)

-- Comprobacion de equivalencia

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

-- La propiedad es

prop_conNueve_equiv :: Integer -> Property

prop_conNueve_equiv n =

n >= 0 ==>

all (== (conNueve n))

[conNueve2 n,

conNueve3 n,

conNueve4 n]

-- La comprobación es

-- λ> quickCheck prop_conNueve_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> conNueve (10^7)

-- 5217031

-- (5.21 secs, 5,215,047,968 bytes)

-- λ> conNueve2 (10^7)

-- 5217031

-- (8.25 secs, 5,651,944,872 bytes)

-- λ> conNueve3 (10^7)

-- 5217031

-- (0.02 secs, 144,000 bytes)

-- λ> conNueve4 (10^7)

-- 5217031

-- (0.02 secs, 145,904 bytes)

-- λ> length (show (conNueve3 (10^30000)))

-- 30000

-- (3.24 secs, 776,076,072 bytes)

-- λ> length (show (conNueve4 (10^30000)))

-- 30000

-- (2.00 secs, 786,452,856 bytes)

Nuevas soluciones

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

Terna pitagórica en la que el perímetro es múltiplo de uno de los catetos

PorJosé A. Alonso 29-enero-20215-febrero-2021

La terna (n,a,b) es una terna pitagórica si n² = a²+b² y b < a < n. Por ejemplo, (5,4,3) y (10,8,6) son ternas pitagóricas.

Una terna pitagórica es primitiva si sus tres componentes son primos entre sí. Por ejemplo, (5,4,3) es una terna pitagórica primitiva y (10,8,6) es una terna pitagórica no primitiva (ya que sus tres lados son divisibles por 2).

Los elementos (n,a,b) de una terna pitagórica son las longitudes de los lados de un triágulo rectángulo; concretamente n es la longitud de la hipotenusa, a la del cateto mayor y b la del cateto menor. Su perímetro es n+a+b.

Definir la función

   ternasPPPDC :: [(Integer,Integer,Integer)]

1	ternasPPPDC :: [(Integer,Integer,Integer)]

tal que ternasPPPDC es la lista de las ternas pitagóricas primitivas tales que su perímetro es divisibe por alguno de los catetos. Por ejemplo,

   λ> take 5 ternasPPPDC
   [(5,4,3),(13,12,5),(17,15,8),(25,24,7),(37,35,12)]
   λ> [n | (n,a,b) <- take 15 ternasPPPDC]
   [5,13,17,25,37,41,61,65,85,101,113,145,145,181,197]
   λ> ternasPPPDC !! 80
   (4705,4704,97)

λ> take 5 ternasPPPDC

[(5,4,3),(13,12,5),(17,15,8),(25,24,7),(37,35,12)]

λ> [n | (n,a,b) <- take 15 ternasPPPDC]

[5,13,17,25,37,41,61,65,85,101,113,145,145,181,197]

λ> ternasPPPDC !! 80

(4705,4704,97)

Comprobar con QuickCheck que existen infinitas ternas pitagóricas primitivas tales que su perímetro es divisibe por alguno de los catetos; es decir, para todo x existe alguna terna (n,a,b) en ternasPPPDC tal que n es mayor que x.

Referencia: Este ejercicio está basado en el artículo Terna pitagórica en la que el perímetro es múltiplo de uno de los catetos publicado por Antonio Roldán en «Números y hoja de cálculo» el 21 de enero de 2021.

Soluciones

import Data.Numbers.Primes (primes)
import Test.QuickCheck (quickCheck)

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

ternasPPPDC :: [(Integer,Integer,Integer)]
ternasPPPDC =
  [(n,a,b) | (n,a,b) <- ternasPitagoricasPrimitivas
           , (n+a+b) `mod` a == 0 || (n+a+b) `mod` b == 0]

-- ternasPitagoricasPrimitivas es la lista de las ternas pitagóricas
-- primitivas. Por ejemplo,
--    λ> take 5 ternasPitagoricasPrimitivas
--    [(5,4,3),(13,12,5),(17,15,8),(25,24,7),(29,21,20)]
ternasPitagoricasPrimitivas :: [(Integer,Integer,Integer)]
ternasPitagoricasPrimitivas =
  [(n,a,b) | (n,a,b) <- ternasPitagoricas
           , foldl1 gcd [n,a,b] == 1]

-- ternasPitagoricas es la lista de las ternas pitagóricas. Por ejemplo,
--    λ> take 5 ternasPitagoricas
--    [(5,4,3),(10,8,6),(13,12,5),(15,12,9),(17,15,8)]
ternasPitagoricas :: [(Integer,Integer,Integer)]
ternasPitagoricas =
    [(n,a,b) | n <- [1..],
               a <- [1..n-1],
               let b2 = n^2-a^2,
               let b = round (sqrt (fromIntegral b2)),
               b < a,
               b^2 == b2]

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

ternasPPPDC2 :: [(Integer,Integer,Integer)]
ternasPPPDC2 =
  [(n,a,b) | (n,a,b) <- ternasPitagoricasPrimitivas2
           , (n+a+b) `mod` a == 0 || (n+a+b) `mod` b == 0]

ternasPitagoricasPrimitivas2 :: [(Integer,Integer,Integer)]
ternasPitagoricasPrimitivas2 =
  [(n,a,b) | (n,a,b) <- ternasPitagoricas2
           , foldl1 gcd [n,a,b] == 1]

ternasPitagoricas2 :: [(Integer,Integer,Integer)]
ternasPitagoricas2 =
    [(n,a,b) | n <- [5,9..],
               a <- [1..n-1],
               let b2 = n^2-a^2,
               let b = round (sqrt (fromIntegral b2)),
               b < a,
               b^2 == b2]

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

ternasPPPDC3 :: [(Integer,Integer,Integer)]
ternasPPPDC3 =
  [(n,a,b) | (n,a,b) <- ternasPitagoricasPrimitivas3
           , (n+a+b) `mod` a == 0 || (n+a+b) `mod` b == 0]

ternasPitagoricasPrimitivas3 :: [(Integer,Integer,Integer)]
ternasPitagoricasPrimitivas3 =
  [(n,a,b) | (n,a,b) <- ternasPitagoricas3
           , foldl1 gcd [n,a,b] == 1]

ternasPitagoricas3 :: [(Integer,Integer,Integer)]
ternasPitagoricas3 =
    [(n,a,b) | n <- [5,9..],
               or [x `mod` 4 == 1 | x <- takeWhile (<=n) primes, n `mod` x == 0],
               a <- [1..n-1],
               let b2 = n^2-a^2,
               let b = round (sqrt (fromIntegral b2)),
               b < a,
               b^2 == b2]

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

-- La comparación es
--    λ> ternasPPPDC !! 80
--    (4705,4704,97)
--    (19.66 secs, 21,249,420,072 bytes)
--    λ> ternasPPPDC2 !! 80
--    (4705,4704,97)
--    (5.00 secs, 5,316,680,464 bytes)
--    λ> ternasPPPDC3 !! 80
--    (4705,4704,97)
--    (3.68 secs, 4,234,492,416 bytes)

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

-- La propiedad es
prop_ternasPPPDC :: Integer -> Bool
prop_ternasPPPDC x =
  not (null [(n,a,b) | (n,a,b) <- ternasPPPDC
                     , n > x])

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

100

101

102

103

import Data.Numbers.Primes (primes)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

ternasPPPDC :: [(Integer,Integer,Integer)]

ternasPPPDC =

[(n,a,b) | (n,a,b) <- ternasPitagoricasPrimitivas

, (n+a+b) `mod` a == 0 || (n+a+b) `mod` b == 0]

-- ternasPitagoricasPrimitivas es la lista de las ternas pitagóricas

-- primitivas. Por ejemplo,

-- λ> take 5 ternasPitagoricasPrimitivas

-- [(5,4,3),(13,12,5),(17,15,8),(25,24,7),(29,21,20)]

ternasPitagoricasPrimitivas :: [(Integer,Integer,Integer)]

ternasPitagoricasPrimitivas =

[(n,a,b) | (n,a,b) <- ternasPitagoricas

, foldl1 gcd [n,a,b] == 1]

-- ternasPitagoricas es la lista de las ternas pitagóricas. Por ejemplo,

-- λ> take 5 ternasPitagoricas

-- [(5,4,3),(10,8,6),(13,12,5),(15,12,9),(17,15,8)]

ternasPitagoricas :: [(Integer,Integer,Integer)]

ternasPitagoricas =

[(n,a,b) | n <- [1..],

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

let b2 = n^2-a^2,

let b = round (sqrt (fromIntegral b2)),

b < a,

b^2 == b2]

-- 2ª solución

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

ternasPPPDC2 :: [(Integer,Integer,Integer)]

ternasPPPDC2 =

[(n,a,b) | (n,a,b) <- ternasPitagoricasPrimitivas2

, (n+a+b) `mod` a == 0 || (n+a+b) `mod` b == 0]

ternasPitagoricasPrimitivas2 :: [(Integer,Integer,Integer)]

ternasPitagoricasPrimitivas2 =

[(n,a,b) | (n,a,b) <- ternasPitagoricas2

, foldl1 gcd [n,a,b] == 1]

ternasPitagoricas2 :: [(Integer,Integer,Integer)]

ternasPitagoricas2 =

[(n,a,b) | n <- [5,9..],

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

let b2 = n^2-a^2,

let b = round (sqrt (fromIntegral b2)),

b < a,

b^2 == b2]

-- 3ª solución

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

ternasPPPDC3 :: [(Integer,Integer,Integer)]

ternasPPPDC3 =

[(n,a,b) | (n,a,b) <- ternasPitagoricasPrimitivas3

, (n+a+b) `mod` a == 0 || (n+a+b) `mod` b == 0]

ternasPitagoricasPrimitivas3 :: [(Integer,Integer,Integer)]

ternasPitagoricasPrimitivas3 =

[(n,a,b) | (n,a,b) <- ternasPitagoricas3

, foldl1 gcd [n,a,b] == 1]

ternasPitagoricas3 :: [(Integer,Integer,Integer)]

ternasPitagoricas3 =

[(n,a,b) | n <- [5,9..],

or [x `mod` 4 == 1 | x <- takeWhile (<=n) primes, n `mod` x == 0],

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

let b2 = n^2-a^2,

let b = round (sqrt (fromIntegral b2)),

b < a,

b^2 == b2]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ternasPPPDC !! 80

-- (4705,4704,97)

-- (19.66 secs, 21,249,420,072 bytes)

-- λ> ternasPPPDC2 !! 80

-- (4705,4704,97)

-- (5.00 secs, 5,316,680,464 bytes)

-- λ> ternasPPPDC3 !! 80

-- (4705,4704,97)

-- (3.68 secs, 4,234,492,416 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_ternasPPPDC :: Integer -> Bool

prop_ternasPPPDC x =

not (null [(n,a,b) | (n,a,b) <- ternasPPPDC

, n > x])

-- La comprobación es

-- λ> quickCheck prop_ternasPPPDC

-- +++ OK, passed 100 tests.

Nuevas soluciones

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

El número de Dottie

PorJosé A. Alonso 28-enero-20214-febrero-2021

La sucesión de Dottie correspondiente a un número x se obtiene a partir de x aplicándole la función coseno al término anterior. Por ejemplo, empezando en el 2021 los términos de la sucesión de Dottie son

   d(0) = 2021
   d(1) = cos(2021)                = -0.5768544484396986
   d(2) = cos(-0.5768544484396986) = 0.8381823464377144
   d(3) = cos(0.8381823464377144)  = 0.6688152257126013
   d(4) = cos(0.6688152257126013)  = 0.7845568438177061
   d(5) = cos(0.7845568438177061)  = 0.7077014336446841
   d(6) = cos(0.7077014336446841)  = 0.7598581544800473
   d(7) = cos(0.7598581544800473)  = 0.7249337238692606
   d(8) = cos(0.7249337238692606)  = 0.7485433703735275

d(0) = 2021

d(1) = cos(2021) = -0.5768544484396986

d(2) = cos(-0.5768544484396986) = 0.8381823464377144

d(3) = cos(0.8381823464377144) = 0.6688152257126013

d(4) = cos(0.6688152257126013) = 0.7845568438177061

d(5) = cos(0.7845568438177061) = 0.7077014336446841

d(6) = cos(0.7077014336446841) = 0.7598581544800473

d(7) = cos(0.7598581544800473) = 0.7249337238692606

d(8) = cos(0.7249337238692606) = 0.7485433703735275

Definir las funciones

   sucesionDottie :: Double -> [Double]
   limite :: [Double] -> Double -> Int -> Double

1 2	sucesionDottie :: Double -> [Double] limite :: [Double] -> Double -> Int -> Double

tales que

(sucesionDottie x) es la lista de los términos de la sucesión de Dottie correspondiente a x. Por ejemplo,

     λ> mapM_ print (take 10 (sucesionDottie 2021))
     2021.0
     -0.5768544484396986
     0.8381823464377144
     0.6688152257126013
     0.7845568438177061
     0.7077014336446841
     0.7598581544800473
     0.7249337238692606
     0.7485433703735275
     0.7326809874975466
     λ> mapM_ print (take 10 (drop 85 (sucesionDottie 2021)))
     0.7390851332151601
     0.739085133215161
     0.7390851332151605
     0.7390851332151608
     0.7390851332151606
     0.7390851332151607
     0.7390851332151607
     0.7390851332151607
     0.7390851332151607
     0.7390851332151607

λ> mapM_ print (take 10 (sucesionDottie 2021))

2021.0

-0.5768544484396986

0.8381823464377144

0.6688152257126013

0.7845568438177061

0.7077014336446841

0.7598581544800473

0.7249337238692606

0.7485433703735275

0.7326809874975466

λ> mapM_ print (take 10 (drop 85 (sucesionDottie 2021)))

0.7390851332151601

0.739085133215161

0.7390851332151605

0.7390851332151608

0.7390851332151606

0.7390851332151607

(limite xs a n) es el límite de xs con aproximación a y amplitud n; es decir, el primer término x de la sucesión tal que el valor absoluto de x y cualquiera de sus n siguentes elementos es menor que a. Por ejemplo,

     λ> limite [(2*n+1)/(n+5) | n <- [1..]] 0.001 300
     1.993991989319092
     λ> limite [(2*n+1)/(n+5) | n <- [1..]] 1e-6 300
     1.9998260062637745
     λ> limite [(1+1/n)**n | n <- [1..]] 0.001 300
     2.7155953364173175
     λ> limite (sucesionDottie 2021) 1e-16 100
     0.7390851332151607
     λ> limite (sucesionDottie 27) 1e-16 100
     0.7390851332151607

λ> limite [(2*n+1)/(n+5) | n <- [1..]] 0.001 300

1.993991989319092

λ> limite [(2*n+1)/(n+5) | n <- [1..]] 1e-6 300

1.9998260062637745

λ> limite [(1+1/n)**n | n <- [1..]] 0.001 300

2.7155953364173175

λ> limite (sucesionDottie 2021) 1e-16 100

0.7390851332151607

λ> limite (sucesionDottie 27) 1e-16 100

0.7390851332151607

Comprobar con QuickCheck que, para todo número x, el límite de la
sucesión de Dottie generada por x es mismo; es decir, si x e y son
dos números cualesquiera, entonces

     limite (sucesionDottie x) 1e-16 100 ==
     limite (sucesionDottie y) 1e-16 100

1 2	limite (sucesionDottie x) 1e-16 100 == limite (sucesionDottie y) 1e-16 100

Dicho límite es el número de Dottie.

Referencia: Este ejercicio está basado en el artículo El número de Dottie publicado por Miguel Ángel Morales en Gaussianos el 20 de enero de 2021.

Soluciones

import Data.List (tails)
import Test.QuickCheck

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

sucesionDottie1 :: Double -> [Double]
sucesionDottie1 x  = map (terminoDottie x) [0..]

terminoDottie :: Double -> Int -> Double
terminoDottie x 0 = x
terminoDottie x n = cos (terminoDottie x (n-1))

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

sucesionDottie2 :: Double -> [Double]
sucesionDottie2 x = iterate cos x

-- Comparación de eficiencia de definiciones de sucesionDottie
-- ===========================================================

-- La comparación es
--    λ> sucesionDottie1 2021 !! (5*10^6)
--    0.7390851332151607
--    (2.13 secs, 1,894,864,000 bytes)
--    λ> sucesionDottie2 2021 !! (5*10^6)
--    0.7390851332151607
--    (0.95 secs, 644,703,256 bytes)

-- En lo que sigue, usaremos la 2ª definición
sucesionDottie :: Double -> [Double]
sucesionDottie = sucesionDottie2

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

limite1 :: [Double] -> Double -> Int -> Double
limite1 xs a n =
  head [ x | (x:ys) <- segmentos xs n
       , all (\y ->  abs (y - x) < a) ys]

-- (segmentos xs n) es la lista de los segmentos de la lista infinita xs
-- con n elementos. Por ejemplo,
--    λ> take 5 (segmentos [1..] 3)
--    [[1,2,3],[2,3,4],[3,4,5],[4,5,6],[5,6,7]]
segmentos :: [a] -> Int -> [[a]]
segmentos xs n = map (take n) (tails xs)

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

limite2 :: [Double] -> Double -> Int -> Double
limite2 (n:ns) x a
  | abs (n - maximum (take (a-1) ns)) < x = n
  | otherwise                             = limite2 ns x a


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

-- La comparación es
--    λ> limite1 [(1+1/n)**n | n <- [1..]] 1e-8 100
--    2.7182700737511185
--    (1.40 secs, 1,044,694,328 bytes)
--    λ> limite2 [(1+1/n)**n | n <- [1..]] 1e-8 100
--    2.7182700737511185
--    (0.47 secs, 1,185,073,072 bytes)

-- En lo que sigue, usaremos la 2ª definición
limite :: [Double] -> Double -> Int -> Double
limite = limite2

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

-- La propiedad es
prop_Dottie :: Double -> Double -> Bool
prop_Dottie x y =
  limite (sucesionDottie x) 1e-16 100 ==
  limite (sucesionDottie y) 1e-16 100

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

import Data.List (tails)

import Test.QuickCheck

-- 1ª definición de sucesionDottie

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

sucesionDottie1 :: Double -> [Double]

sucesionDottie1 x = map (terminoDottie x) [0..]

terminoDottie :: Double -> Int -> Double

terminoDottie x 0 = x

terminoDottie x n = cos (terminoDottie x (n-1))

-- 2ª definición de sucesionDottie

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

sucesionDottie2 :: Double -> [Double]

sucesionDottie2 x = iterate cos x

-- Comparación de eficiencia de definiciones de sucesionDottie

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

-- La comparación es

-- λ> sucesionDottie1 2021 !! (5*10^6)

-- 0.7390851332151607

-- (2.13 secs, 1,894,864,000 bytes)

-- λ> sucesionDottie2 2021 !! (5*10^6)

-- 0.7390851332151607

-- (0.95 secs, 644,703,256 bytes)

-- En lo que sigue, usaremos la 2ª definición

sucesionDottie :: Double -> [Double]

sucesionDottie = sucesionDottie2

-- 1ª definición de limite

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

limite1 :: [Double] -> Double -> Int -> Double

limite1 xs a n =

head [ x | (x:ys) <- segmentos xs n

, all (\y -> abs (y - x) < a) ys]

-- (segmentos xs n) es la lista de los segmentos de la lista infinita xs

-- con n elementos. Por ejemplo,

-- λ> take 5 (segmentos [1..] 3)

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

segmentos :: [a] -> Int -> [[a]]

segmentos xs n = map (take n) (tails xs)

-- 2ª solución

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

limite2 :: [Double] -> Double -> Int -> Double

limite2 (n:ns) x a

| abs (n - maximum (take (a-1) ns)) < x = n

| otherwise = limite2 ns x a

-- Comparación de eficiencia

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

-- La comparación es

-- λ> limite1 [(1+1/n)**n | n <- [1..]] 1e-8 100

-- 2.7182700737511185

-- (1.40 secs, 1,044,694,328 bytes)

-- λ> limite2 [(1+1/n)**n | n <- [1..]] 1e-8 100

-- 2.7182700737511185

-- (0.47 secs, 1,185,073,072 bytes)

-- En lo que sigue, usaremos la 2ª definición

limite :: [Double] -> Double -> Int -> Double

limite = limite2

-- Propiedad

-- =========

-- La propiedad es

prop_Dottie :: Double -> Double -> Bool

prop_Dottie x y =

limite (sucesionDottie x) 1e-16 100 ==

limite (sucesionDottie y) 1e-16 100

-- La comprobación es

-- λ> quickCheck prop_Dottie

-- +++ OK, passed 100 tests.

Nuevas soluciones

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

Árboles acotados

PorJosé A. Alonso 27-enero-20213-febrero-2021

Los árboles binarios se pueden representar mediante el tipo Arbol definido por

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

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

Por ejemplo, el árbol

         7
        / \
       /   \
      /     \
     4       9
    / \     / \
   1   3   5   6

/ \

4 9

/ \ / \

1 3 5 6

se puede representar por

   N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))

1	N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))

Un árbol está acotado por un conjunto ys si todos los valores de sus hojas y sus nodos pertenecen a ys. Por ejemplo, el árbol anterior está acotado por [1..10] pero no lo está por [1..7].

Un árbol es monovalorado si todos sus elementos son iguales. Por ejemplo, de los siguientes árboles sólo son monovalorados los dos primeros

    5          9           5          9
   / \        / \         / \        / \
  5   5      9   9       5   6      9   7
                / \                    / \
               9   9                  9   9

5 9 5 9

/ \ / \ / \ / \

5 5 9 9 5 6 9 7

/ \ / \

9 9 9 9

Definir las funciones

   acotado :: Eq a => Arbol a -> [a] -> Bool
   monovalorados :: Arbol -> [Arbol]

1 2	acotado :: Eq a => Arbol a -> [a] -> Bool monovalorados :: Arbol -> [Arbol]

tales que

(acotado a ys) se verifica si a está acotado por ys. Por ejemplo,

     acotado (N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))) [1..10] == True
     acotado (N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))) [1..7]  == False

1 2	acotado (N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))) [1..10] == True acotado (N 7 (N 4 (H 1) (H 3)) (N 9 (H 5) (H 6))) [1..7] == False

(monovalorado a) se verifica si a es monovalorado. Por ejemplo,

     monovalorado (N 5 (H 5) (H 5))              ==  True
     monovalorado (N 5 (H 5) (H 6))              ==  False
     monovalorado (N 9 (H 9) (N 9 (H 9) (H 9)))  ==  True
     monovalorado (N 9 (H 9) (N 7 (H 9) (H 9)))  ==  False
     monovalorado (N 9 (H 9) (N 9 (H 7) (H 9)))  ==  False

monovalorado (N 5 (H 5) (H 5)) == True

monovalorado (N 5 (H 5) (H 6)) == False

monovalorado (N 9 (H 9) (N 9 (H 9) (H 9))) == True

monovalorado (N 9 (H 9) (N 7 (H 9) (H 9))) == False

monovalorado (N 9 (H 9) (N 9 (H 7) (H 9))) == False

Soluciones

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

acotado :: Eq a => Arbol a -> [a] -> Bool
acotado (H x) ys     = x `elem` ys
acotado (N x i d) ys = x `elem` ys && acotado i ys && acotado d ys

monovalorado :: Eq a => Arbol a -> Bool
monovalorado (H _) = True
monovalorado (N x i d) = acotado i [x] && acotado d [x]

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

acotado :: Eq a => Arbol a -> [a] -> Bool

acotado (H x) ys = x `elem` ys

acotado (N x i d) ys = x `elem` ys && acotado i ys && acotado d ys

monovalorado :: Eq a => Arbol a -> Bool

monovalorado (H _) = True

monovalorado (N x i d) = acotado i [x] && acotado d [x]

Nuevas soluciones

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

Limitación del número de repeticiones

PorJosé A. Alonso 26-enero-20212-febrero-2021

Definir la función

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

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

tal que (conRepeticionesAcotadas xs n) es una lista que contiene cada elemento de xs como máximo n veces sin reordenar (se supone que n es un número positivo).. Por ejemplo,

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

conRepeticionesAcotadas [1,2,3,1,2,1,3,2,3,5] 1 == [1,2,3,5]

conRepeticionesAcotadas [1,2,3,1,2,1,3,2,3,5] 2 == [1,2,3,1,2,3,5]

conRepeticionesAcotadas [1,2,3,1,2,1,3,2,3,5] 3 == [1,2,3,1,2,1,3,2,3,5]

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

Soluciones

import Data.List (foldl')
import Data.Maybe (fromJust, isNothing)
import Test.QuickCheck (Property, (==>),quickCheck)

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

conRepeticionesAcotadas :: Eq a => [a] -> Int -> [a]
conRepeticionesAcotadas xs n = reverse (aux [] xs)
  where aux zs []     = zs
        aux zs (y:ys) | m < n     = aux (y:zs) ys
                      | otherwise = aux zs ys
          where m = nOcurrencias y zs

-- (nOcurrencias x ys) es el número de ocurrencias de x en ys. Por
-- ejemplo,
--    nOcurrencias 7 [7,2,7,7,5]  ==  3
nOcurrencias :: Eq a => a -> [a] -> Int
nOcurrencias x ys = length (filter (== x) ys)

-- Se puede simplificar la definición de nOcurrencias:
nOcurrencias2 :: Eq a => a -> [a] -> Int
nOcurrencias2 x = length . filter (== x)

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

conRepeticionesAcotadas2 :: Eq a => [a] -> Int -> [a]
conRepeticionesAcotadas2 xs n = reverse (foldl' aux [] xs)
  where aux zs y | m < n     = y:zs
                 | otherwise = zs
          where m = nOcurrencias y zs

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

conRepeticionesAcotadas3 :: Eq a => [a] -> Int -> [a]
conRepeticionesAcotadas3 xs n = reverse (aux [] [] xs)
  where aux as _ []      = as
        aux as bs (y:ys) | y `elem` bs = aux as bs ys
                         | m < n       = aux (y:as) bs ys
                         | otherwise   = aux as (y:bs) ys
          where m = nOcurrencias y as

-- 4ª solución
-- ===========

conRepeticionesAcotadas4 :: Eq a => [a] -> Int -> [a]
conRepeticionesAcotadas4 xs n = aux xs []
  where aux [] _      = []
        aux (y:ys) ps | r == Nothing = y : aux ys ((y,1) : ps)
                      | m < n        = y : aux ys ((y,m+1) : ps)
                      | otherwise    = aux ys ps
                      where r = busca y ps
                            Just m = r

-- (busca x ps) es justamente la segunda componente del primer par de ps
-- cuya primera componente es xs, si ps tiene algún par cuya primera
-- componente es x; y Nothing en caso contrario. Por ejemplo,
--    busca 'a' [('b',2),('a',3),('a',1)]  ==  Just 3
--    busca 'c' [('b',2),('a',3),('a',1)]  ==  Nothing
busca :: Eq a => a -> [(a,b)] -> Maybe b
busca x ps
  | null ys   = Nothing
  | otherwise = Just (head ys)
  where ys = [n | (y,n) <- ps, y == x]

-- 5ª solución
-- ===========

conRepeticionesAcotadas5 :: Eq a => [a] -> Int -> [a]
conRepeticionesAcotadas5 xs n = aux xs []
  where aux [] _      = []
        aux (y:ys) ps | isNothing r = y : aux ys ((y,1) : ps)
                      | m < n       = y : aux ys ((y,m+1) : ps)
                      | otherwise   = aux ys ps
                      where r = lookup y ps
                            m = fromJust r

-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_conRepeticionesAcotadas :: [Int] -> Int -> Property
prop_conRepeticionesAcotadas xs n =
  n > 0 ==>
  all (==(conRepeticionesAcotadas xs n))
      [ conRepeticionesAcotadas2 xs n
      , conRepeticionesAcotadas3 xs n
      , conRepeticionesAcotadas4 xs n
      , conRepeticionesAcotadas5 xs n]

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

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

-- La comparación es
--    λ> length (conRepeticionesAcotadas (concat [[1..n] | n <- [1..500]]) 2)
--    999
--    (5.14 secs, 64,372,768 bytes)
--    λ> length (conRepeticionesAcotadas2 (concat [[1..n] | n <- [1..500]]) 2)
--    999
--    (4.95 secs, 62,322,880 bytes)
--    λ> length (conRepeticionesAcotadas3 (concat [[1..n] | n <- [1..500]]) 2)
--    999
--    (0.38 secs, 38,764,952 bytes)
--    λ> length (conRepeticionesAcotadas4 (concat [[1..n] | n <- [1..500]]) 2)
--    999
--    (5.66 secs, 2,429,904,144 bytes)
--    λ> length (conRepeticionesAcotadas5 (concat [[1..n] | n <- [1..500]]) 2)
--    999
--    (0.68 secs, 48,536,872 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List (foldl')

import Data.Maybe (fromJust, isNothing)

import Test.QuickCheck (Property, (==>),quickCheck)

-- 1ª solución

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

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

conRepeticionesAcotadas xs n = reverse (aux [] xs)

where aux zs [] = zs

aux zs (y:ys) | m < n = aux (y:zs) ys

| otherwise = aux zs ys

where m = nOcurrencias y zs

-- (nOcurrencias x ys) es el número de ocurrencias de x en ys. Por

-- ejemplo,

-- nOcurrencias 7 [7,2,7,7,5] == 3

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

nOcurrencias x ys = length (filter (== x) ys)

-- Se puede simplificar la definición de nOcurrencias:

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

nOcurrencias2 x = length . filter (== x)

-- 2ª solución

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

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

conRepeticionesAcotadas2 xs n = reverse (foldl' aux [] xs)

where aux zs y | m < n = y:zs

| otherwise = zs

where m = nOcurrencias y zs

-- 3ª solución

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

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

conRepeticionesAcotadas3 xs n = reverse (aux [] [] xs)

where aux as _ [] = as

aux as bs (y:ys) | y `elem` bs = aux as bs ys

| m < n = aux (y:as) bs ys

| otherwise = aux as (y:bs) ys

where m = nOcurrencias y as

-- 4ª solución

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

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

conRepeticionesAcotadas4 xs n = aux xs []

where aux [] _ = []

aux (y:ys) ps | r == Nothing = y : aux ys ((y,1) : ps)

| m < n = y : aux ys ((y,m+1) : ps)

| otherwise = aux ys ps

where r = busca y ps

Just m = r

-- (busca x ps) es justamente la segunda componente del primer par de ps

-- cuya primera componente es xs, si ps tiene algún par cuya primera

-- componente es x; y Nothing en caso contrario. Por ejemplo,

-- busca 'a' [('b',2),('a',3),('a',1)] == Just 3

-- busca 'c' [('b',2),('a',3),('a',1)] == Nothing

busca :: Eq a => a -> [(a,b)] -> Maybe b

busca x ps

| null ys = Nothing

| otherwise = Just (head ys)

where ys = [n | (y,n) <- ps, y == x]

-- 5ª solución

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

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

conRepeticionesAcotadas5 xs n = aux xs []

where aux [] _ = []

aux (y:ys) ps | isNothing r = y : aux ys ((y,1) : ps)

| m < n = y : aux ys ((y,m+1) : ps)

| otherwise = aux ys ps

where r = lookup y ps

m = fromJust r

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_conRepeticionesAcotadas :: [Int] -> Int -> Property

prop_conRepeticionesAcotadas xs n =

n > 0 ==>

all (==(conRepeticionesAcotadas xs n))

[ conRepeticionesAcotadas2 xs n

, conRepeticionesAcotadas3 xs n

, conRepeticionesAcotadas4 xs n

, conRepeticionesAcotadas5 xs n]

-- La comprobación es

-- λ> quickCheck prop_conRepeticionesAcotadas

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (conRepeticionesAcotadas (concat [[1..n] | n <- [1..500]]) 2)

-- 999

-- (5.14 secs, 64,372,768 bytes)

-- λ> length (conRepeticionesAcotadas2 (concat [[1..n] | n <- [1..500]]) 2)

-- 999

-- (4.95 secs, 62,322,880 bytes)

-- λ> length (conRepeticionesAcotadas3 (concat [[1..n] | n <- [1..500]]) 2)

-- 999

-- (0.38 secs, 38,764,952 bytes)

-- λ> length (conRepeticionesAcotadas4 (concat [[1..n] | n <- [1..500]]) 2)

-- 999

-- (5.66 secs, 2,429,904,144 bytes)

-- λ> length (conRepeticionesAcotadas5 (concat [[1..n] | n <- [1..500]]) 2)

-- 999

-- (0.68 secs, 48,536,872 bytes)

Nuevas soluciones

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

Potencias de dos más cercanas

PorJosé A. Alonso 25-enero-20211-febrero-2021

Definir la función

   potenciasDeDosMasCercanas :: [Integer] -> [Integer]

1	potenciasDeDosMasCercanas :: [Integer] -> [Integer]

tal que (potenciasDeDosMasCercanas xs) es la lista sustituyendo cada elemento de xs por su potencia de dos más cercana (en el caso de que haya dos equidistantes se elige la menor). Por ejemplo,

   potenciasDeDosMasCercanas2 [6,7,8,9,2021]  ==  [4,8,8,8,2048]

1	potenciasDeDosMasCercanas2 [6,7,8,9,2021] == [4,8,8,8,2048]

Soluciones

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

potenciasDeDosMasCercanas :: [Integer] -> [Integer]
potenciasDeDosMasCercanas = map potenciaDeDosMasCercana

-- (potenciaDeDosMasCercana n) es la potencia de dos más cercana (en el
-- caso de que haya dos equidistantes se elige la menor). Por ejemplo,
--    potenciaDeDosMasCercana 6  ==  4
--    potenciaDeDosMasCercana 7  ==  8
--    potenciaDeDosMasCercana 8  ==  8
--    potenciaDeDosMasCercana 9  ==  8
potenciaDeDosMasCercana :: Integer -> Integer
potenciaDeDosMasCercana n
  | dx <= dy  = x
  | otherwise = y
  where (x,y) = potenciasDeDosCercanas n
        dx    = n - x
        dy    = y - n

-- (potenciasDeDosMasCercanas n) es par formado por las dos potencias de
-- dos más cercana a n. Por ejemplo,
--    potenciasDeDosCercanas 6  ==  (4,8)
--    potenciasDeDosCercanas 7  ==  (4,8)
--    potenciasDeDosCercanas 8  ==  (4,8)
--    potenciasDeDosCercanas 9  ==  (8,16)
potenciasDeDosCercanas :: Integer -> (Integer, Integer)
potenciasDeDosCercanas n =
  (x `div` 2, x)
  where x = menorPotenciaDeDosMayorOIgual n

-- (menorPotenciaDeDosMayorOIgual n) es la menor potencia de dos mayor o
-- igual que n. Por ejemplo,
--    menorPotenciaDeDosMayorOIgual 6  ==  8
--    menorPotenciaDeDosMayorOIgual 8  ==  8
menorPotenciaDeDosMayorOIgual :: Integer -> Integer
menorPotenciaDeDosMayorOIgual n =
  head [2^x | x <- [0..], 2^x >= n]

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

potenciasDeDosMasCercanas2 :: [Integer] -> [Integer]
potenciasDeDosMasCercanas2 = map potenciaDeDosMasCercana2

potenciaDeDosMasCercana2 :: Integer -> Integer
potenciaDeDosMasCercana2 n =
  snd (min (n-x,x) (y-n,y))
  where (x,y) = potenciasDeDosCercanas2 n

potenciasDeDosCercanas2 :: Integer -> (Integer, Integer)
potenciasDeDosCercanas2 n = (x `div` 2, x)
  where (x:_) = dropWhile (<n) potenciasDeDos

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,
--    take 11 potenciasDeDos  ==  [1,2,4,8,16,32,64,128,256,512,1024]
potenciasDeDos :: [Integer]
potenciasDeDos = iterate (*2) 1

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

-- La comparación es
--    λ> maximum (potenciasDeDosMasCercanas [10^5..10^6])
--    1048576
--    (18.28 secs, 20,835,181,624 bytes)
--    λ> maximum (potenciasDeDosMasCercanas2 [10^5..10^6])
--    1048576
--    (2.44 secs, 830,307,736 bytes)

-- 1ª solución

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

potenciasDeDosMasCercanas :: [Integer] -> [Integer]

potenciasDeDosMasCercanas = map potenciaDeDosMasCercana

-- (potenciaDeDosMasCercana n) es la potencia de dos más cercana (en el

-- caso de que haya dos equidistantes se elige la menor). Por ejemplo,

-- potenciaDeDosMasCercana 6 == 4

-- potenciaDeDosMasCercana 7 == 8

-- potenciaDeDosMasCercana 8 == 8

-- potenciaDeDosMasCercana 9 == 8

potenciaDeDosMasCercana :: Integer -> Integer

potenciaDeDosMasCercana n

| dx <= dy = x

| otherwise = y

where (x,y) = potenciasDeDosCercanas n

dx = n - x

dy = y - n

-- (potenciasDeDosMasCercanas n) es par formado por las dos potencias de

-- dos más cercana a n. Por ejemplo,

-- potenciasDeDosCercanas 6 == (4,8)

-- potenciasDeDosCercanas 7 == (4,8)

-- potenciasDeDosCercanas 8 == (4,8)

-- potenciasDeDosCercanas 9 == (8,16)

potenciasDeDosCercanas :: Integer -> (Integer, Integer)

potenciasDeDosCercanas n =

(x `div` 2, x)

where x = menorPotenciaDeDosMayorOIgual n

-- (menorPotenciaDeDosMayorOIgual n) es la menor potencia de dos mayor o

-- igual que n. Por ejemplo,

-- menorPotenciaDeDosMayorOIgual 6 == 8

-- menorPotenciaDeDosMayorOIgual 8 == 8

menorPotenciaDeDosMayorOIgual :: Integer -> Integer

menorPotenciaDeDosMayorOIgual n =

head [2^x | x <- [0..], 2^x >= n]

-- 2ª solución

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

potenciasDeDosMasCercanas2 :: [Integer] -> [Integer]

potenciasDeDosMasCercanas2 = map potenciaDeDosMasCercana2

potenciaDeDosMasCercana2 :: Integer -> Integer

potenciaDeDosMasCercana2 n =

snd (min (n-x,x) (y-n,y))

where (x,y) = potenciasDeDosCercanas2 n

potenciasDeDosCercanas2 :: Integer -> (Integer, Integer)

potenciasDeDosCercanas2 n = (x `div` 2, x)

where (x:_) = dropWhile (<n) potenciasDeDos

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,

-- take 11 potenciasDeDos == [1,2,4,8,16,32,64,128,256,512,1024]

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximum (potenciasDeDosMasCercanas [10^5..10^6])

-- 1048576

-- (18.28 secs, 20,835,181,624 bytes)

-- λ> maximum (potenciasDeDosMasCercanas2 [10^5..10^6])

-- 1048576

-- (2.44 secs, 830,307,736 bytes)

Nuevas soluciones

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

La serie 1 – 2 + 3 – 4 + ···

PorJosé A. Alonso 22-enero-202129-enero-2021

En este ejercicio se considerará la serie

   1 - 2 + 3 - 4 + 5 - 6 + 7 - 8 + 9 - 10 + ···

1	1 - 2 + 3 - 4 + 5 - 6 + 7 - 8 + 9 - 10 + ···

Definir las funciones

   serie     :: [Integer]
   sumaSerie :: Integer -> Integer

1 2	serie :: [Integer] sumaSerie :: Integer -> Integer

tales que

serie es lalista de los términos de la serie anterior; es decir,

     take 7 serie  ==  [1,-2,3,-4,5,-6,7]

1	take 7 serie == [1,-2,3,-4,5,-6,7]

(sumaSerie n) es la suma de los n primeros términos de la serie. Por ejemplo,

     sumaSerie 5     ==  3
     sumaSerie 6     ==  -3
     sumaSerie 2021  ==  1011
     length (show (sumaSerie (10^1000)))  ==  1001

sumaSerie 5 == 3

sumaSerie 6 == -3

sumaSerie 2021 == 1011

length (show (sumaSerie (10^1000))) == 1001

Comprobar con QuickCheck que

la suma de la serie se puede hacer tan grande como se desee; es decir, que para todo número a existe un n tal que la suma de los n primeros términos de la serie es mayor que a;
la suma de la serie se puede hacer tan pequeña como se desee; es decir, que para todo número a existe un n tal que la suma de los n primeros términos de la serie es menor que a.

Soluciones

import Data.List (cycle, genericTake)
import Test.QuickCheck (Property, (==>), quickCheck)

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

serie :: [Integer]
serie = [(-1)^(n-1) * n | n <- [1..]]

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

serie2 :: [Integer]
serie2 = zipWith (*) (cycle [1,-1]) [1..]

-- 3ª definición de serie
-- ======================

serie3 :: [Integer]
serie3 = zipWith ($) (cycle [id,negate]) [1..]

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

sumaSerie :: Integer -> Integer
sumaSerie n = sum (genericTake n serie)

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

-- La 2ª definición se basa en la siguiente observación
-- + Si n es par, entonces
--        1 - 2 + 3 - 4 + 5 - 6 + ··· + (n-1) - n
--      = (1 - 2) + (3 - 4) + (5 - 6) + ··· + ((n-1) - n)
--      = -1      - 1       - 1       - ··· - 1
--      = -1 * n/2
-- + Si n es impar, entonces
--        1 - 2 + 3 - 4 + 5 - 6 + ··· + (n-2) - (n-1) + n
--      = (1 - 2) + (3 - 4) + (5 - 6) + ··· + ((n-2) - (n-1)) + n
--      = -1      - 1       - 1       - ··· - 1               + n
--      = -1 * (n-1)/2 + n
--      = n - ((n-1)/2)

sumaSerie2 :: Integer -> Integer
sumaSerie2 n
  | even n    = -(n `div` 2)
  | otherwise = n - ((n - 1) `div` 2)


-- 3ª definición sumaSerie
-- =======================

-- La 3ª definición se basa en la siguiente observación
--    λ> [sumaSerie n | n <- [1..20]]
--    [1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,7,-7,8,-8,9,-9,10,-10]

sumaSerie3 :: Integer -> Integer
sumaSerie3 n = ((-1)^(n-1)*(2*n+1)+1) `div` 4

-- Equivalencia
-- ============

-- La propiedad es
prop_sumaSerie_equiv :: Integer -> Property
prop_sumaSerie_equiv n =
  n > 0 ==>
  sumaSerie  n == sumaSerie2 n &&
  sumaSerie2 n == sumaSerie3 n

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

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

-- La comparación es
--    λ> sumaSerie (10^6)
--    -500000
--    (3.34 secs, 5,106,633,208 bytes)
--    λ> sumaSerie2 (10^6)
--    -500000
--    (0.01 secs, 102,600 bytes)
--    λ> sumaSerie3 (10^6)
--    -500000
--    (0.02 secs, 110,976 bytes)
--    λ> sumaSerie3 (10^6)
--    -500000

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

-- La propiedad es
prop_sumaSerie :: Integer -> Bool
prop_sumaSerie a =
  any (> a) sumas && any (< a) sumas
  where sumas = [sumaSerie2 n | n <- [1..]]

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

100

101

import Data.List (cycle, genericTake)

import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª definición de serie

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

serie :: [Integer]

serie = [(-1)^(n-1) * n | n <- [1..]]

-- 2ª definición de serie

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

serie2 :: [Integer]

serie2 = zipWith (*) (cycle [1,-1]) [1..]

-- 3ª definición de serie

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

serie3 :: [Integer]

serie3 = zipWith ($) (cycle [id,negate]) [1..]

-- 1ª definición de sumaSerie

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

sumaSerie :: Integer -> Integer

sumaSerie n = sum (genericTake n serie)

-- 2ª definición sumaSerie

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

-- La 2ª definición se basa en la siguiente observación

-- + Si n es par, entonces

-- 1 - 2 + 3 - 4 + 5 - 6 + ··· + (n-1) - n

-- = (1 - 2) + (3 - 4) + (5 - 6) + ··· + ((n-1) - n)

-- = -1 - 1 - 1 - ··· - 1

-- = -1 * n/2

-- + Si n es impar, entonces

-- 1 - 2 + 3 - 4 + 5 - 6 + ··· + (n-2) - (n-1) + n

-- = (1 - 2) + (3 - 4) + (5 - 6) + ··· + ((n-2) - (n-1)) + n

-- = -1 - 1 - 1 - ··· - 1 + n

-- = -1 * (n-1)/2 + n

-- = n - ((n-1)/2)

sumaSerie2 :: Integer -> Integer

sumaSerie2 n

| even n = -(n `div` 2)

| otherwise = n - ((n - 1) `div` 2)

-- 3ª definición sumaSerie

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

-- La 3ª definición se basa en la siguiente observación

-- λ> [sumaSerie n | n <- [1..20]]

-- [1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,7,-7,8,-8,9,-9,10,-10]

sumaSerie3 :: Integer -> Integer

sumaSerie3 n = ((-1)^(n-1)*(2*n+1)+1) `div` 4

-- Equivalencia

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

-- La propiedad es

prop_sumaSerie_equiv :: Integer -> Property

prop_sumaSerie_equiv n =

n > 0 ==>

sumaSerie n == sumaSerie2 n &&

sumaSerie2 n == sumaSerie3 n

-- La comprobación es

-- λ> quickCheck prop_sumaSerie_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaSerie (10^6)

-- -500000

-- (3.34 secs, 5,106,633,208 bytes)

-- λ> sumaSerie2 (10^6)

-- -500000

-- (0.01 secs, 102,600 bytes)

-- λ> sumaSerie3 (10^6)

-- -500000

-- (0.02 secs, 110,976 bytes)

-- λ> sumaSerie3 (10^6)

-- -500000

-- Propiedad

-- =========

-- La propiedad es

prop_sumaSerie :: Integer -> Bool

prop_sumaSerie a =

any (> a) sumas && any (< a) sumas

where sumas = [sumaSerie2 n | n <- [1..]]

-- La comprobación es

-- λ> quickCheck prop_sumaSerie

-- +++ OK, passed 100 tests.

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico