length

Elementos que respetan la ordenación

PorJosé A. Alonso 7-diciembre-201614-diciembre-2016

Se dice que un elemento x de una lista xs respeta la ordenación si x es mayor o igual que todos lo que tiene delante en xs y es menor o igual que todos lo que tiene detrás en xs. Por ejemplo, en la lista lista [3,2,1,4,6,5,7,9,8] el número 4 respeta la ordenación pero el número 5 no la respeta (porque es mayor que el 6 que está delante).

Definir la función

   respetuosos :: Ord a => [a] -> [a]

1	respetuosos :: Ord a => [a] -> [a]

tal que (respetuosos xs) es la lista de los elementos de xs que respetan la ordenación. Por ejemplo,

   respetuosos [3,2,1,4,6,4,7,9,8]  ==  [4,7]
   respetuosos [2,1,3,4,6,4,7,8,9]  ==  [3,4,7,8,9]
   respetuosos "abaco"              ==  "aco"
   respetuosos "amor"               ==  "amor"
   respetuosos "romanos"            ==  "s"
   respetuosos [1..9]               ==  [1,2,3,4,5,6,7,8,9]
   respetuosos [9,8..1]             ==  []

respetuosos [3,2,1,4,6,4,7,9,8] == [4,7]

respetuosos [2,1,3,4,6,4,7,8,9] == [3,4,7,8,9]

respetuosos "abaco" == "aco"

respetuosos "amor" == "amor"

respetuosos "romanos" == "s"

respetuosos [1..9] == [1,2,3,4,5,6,7,8,9]

respetuosos [9,8..1] == []

Comprobar con QuickCheck que para cualquier lista de enteros xs se verifican las siguientes propiedades:

todos los elementos de (sort xs) respetan la ordenación y
en la lista (nub (reverse (sort xs))) hay como máximo un elemento que respeta la ordenación.

Soluciones

import Data.List (inits, nub, sort, tails)
import Test.QuickCheck

-- 1ª definición (por comprensión):
respetuosos :: Ord a => [a] -> [a]
respetuosos xs =
  [z | k <- [0..n-1]
     , let (ys,z:zs) = splitAt k xs
     , all (<=z) ys
     , all (>=z) zs]
  where n = length xs

-- 2ª definición (por recursión):
respetuosos2 :: Ord a => [a] -> [a]
respetuosos2 xs = aux [] [] xs
  where aux zs _  []      = reverse zs
        aux zs ys (x:xs)
          | all (<=x) ys && all (>=x) xs = aux (x:zs) (x:ys) xs
          | otherwise                    = aux zs     (x:ys) xs

-- 3ª definición
respetuosos3 :: Ord a => [a] -> [a]
respetuosos3 xs = [ x | (ys,x,zs) <- zip3 (inits xs) xs (tails xs)
                      , all (<=x) ys
                      , all (x<=) zs ]

-- 4ª solución
respetuosos4 :: Ord a =>[a] ->[a]
respetuosos4 xs =
  [x | (a, x, b) <- zip3 (scanl1 max xs) xs (scanr1 min xs)
     , a <= x && x <= b]

-- Comparación de eficiencia
--    λ> length (respetuosos [1..3000])
--    3000
--    (3.31 secs, 1,140,407,224 bytes)
--    λ> length (respetuosos2 [1..3000])
--    3000
--    (2.85 secs, 587,082,160 bytes)
--    λ> length (respetuosos3 [1..3000])
--    3000
--    (2.12 secs, 785,446,880 bytes)
--    λ> length (respetuosos4 [1..3000])
--    3000
--    (0.02 secs, 0 bytes)

-- 1ª propiedad
prop_respetuosos1 :: [Int] -> Bool
prop_respetuosos1 xs =
  respetuosos (sort xs) == sort xs

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

-- La 2ª propiedad
prop_respetuosos2 :: [Int] -> Bool
prop_respetuosos2 xs =
  length (respetuosos (nub (reverse (sort xs)))) <= 1

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

import Data.List (inits, nub, sort, tails)

import Test.QuickCheck

-- 1ª definición (por comprensión):

respetuosos :: Ord a => [a] -> [a]

respetuosos xs =

[z | k <- [0..n-1]

, let (ys,z:zs) = splitAt k xs

, all (<=z) ys

, all (>=z) zs]

where n = length xs

-- 2ª definición (por recursión):

respetuosos2 :: Ord a => [a] -> [a]

respetuosos2 xs = aux [] [] xs

where aux zs _ [] = reverse zs

aux zs ys (x:xs)

| all (<=x) ys && all (>=x) xs = aux (x:zs) (x:ys) xs

| otherwise = aux zs (x:ys) xs

-- 3ª definición

respetuosos3 :: Ord a => [a] -> [a]

respetuosos3 xs = [ x | (ys,x,zs) <- zip3 (inits xs) xs (tails xs)

, all (<=x) ys

, all (x<=) zs ]

-- 4ª solución

respetuosos4 :: Ord a =>[a] ->[a]

respetuosos4 xs =

[x | (a, x, b) <- zip3 (scanl1 max xs) xs (scanr1 min xs)

, a <= x && x <= b]

-- Comparación de eficiencia

-- λ> length (respetuosos [1..3000])

-- 3000

-- (3.31 secs, 1,140,407,224 bytes)

-- λ> length (respetuosos2 [1..3000])

-- 3000

-- (2.85 secs, 587,082,160 bytes)

-- λ> length (respetuosos3 [1..3000])

-- 3000

-- (2.12 secs, 785,446,880 bytes)

-- λ> length (respetuosos4 [1..3000])

-- 3000

-- (0.02 secs, 0 bytes)

-- 1ª propiedad

prop_respetuosos1 :: [Int] -> Bool

prop_respetuosos1 xs =

respetuosos (sort xs) == sort xs

-- La comprobación es

-- λ> quickCheck prop_respetuosos1

-- +++ OK, passed 100 tests.

-- La 2ª propiedad

prop_respetuosos2 :: [Int] -> Bool

prop_respetuosos2 xs =

length (respetuosos (nub (reverse (sort xs)))) <= 1

-- La comprobación es

-- λ> quickCheck prop_respetuosos2

-- +++ OK, passed 100 tests.

Máxima ramificación

PorJosé A. Alonso 23-noviembre-201630-noviembre-2016

Los árboles se pueden representar mediante el siguiente tipo de datos

   data Arbol a = N a [Arbol a]
                  deriving Show

1 2	data Arbol a = N a [Arbol a] deriving Show

Por ejemplo, los árboles

     1         1             1          
    / \       / \           / \   
   2   3     2   3         2   3  
       |        /|\       /|\  |   
       4       4 5 6     4 5 6 7

1 1 1

/ \ / \ / \

2 3 2 3 2 3

| /|\ /|\ |

4 4 5 6 4 5 6 7

se representan por

   ej1, ej2, ej3 :: Arbol Int
   ej1 = N 1 [N 2 [],N 3 [N 4 []]]
   ej2 = N 1 [N 2 [], N 3 [N 4 [], N 5 [], N 6 []]
   ej3 = N 1 [N 2 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [],N 3 [N 4 []]]

ej2 = N 1 [N 2 [], N 3 [N 4 [], N 5 [], N 6 []]

ej3 = N 1 [N 2 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

En el primer ejemplo la máxima ramificación es 2 (en el nodo 1 que tiene 2 hijos), la del segundo es 3 (en el nodo 3 que tiene 3 hijos) y la del tercero es 3 (en el nodo 3 que tiene 3 hijos).

Definir la función

   maximaRamificacion :: Arbol a -> Int

1	maximaRamificacion :: Arbol a -> Int

tal que (maximaRamificacion a) es la máxima ramificación del árbol a. Por ejemplo,

   maximaRamificacion ej1  ==  2
   maximaRamificacion ej2  ==  3
   maximaRamificacion ej3  ==  3

maximaRamificacion ej1 == 2

maximaRamificacion ej2 == 3

maximaRamificacion ej3 == 3

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show

ej1, ej2 :: Arbol Int
ej1 = N 1 [N 2 [],N 3 [N 4 []]]
ej2 = N 1 [N 2 [], N 3 [N 4 [], N 5 [], N 6 []]]
ej3 = N 1 [N 2 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]] 

maximaRamificacion :: Arbol a -> Int
maximaRamificacion (N _ []) = 0
maximaRamificacion (N x xs) =
  max (length xs) (maximum (map maximaRamificacion xs))

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2 :: Arbol Int

ej1 = N 1 [N 2 [],N 3 [N 4 []]]

ej2 = N 1 [N 2 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 2 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

maximaRamificacion :: Arbol a -> Int

maximaRamificacion (N _ []) = 0

maximaRamificacion (N x xs) =

max (length xs) (maximum (map maximaRamificacion xs))

Subconjuntos acotados

PorJosé A. Alonso 10-noviembre-201617-noviembre-2016

Definir la función

   subconjuntosAcotados :: [a] -> Int -> [[a]]

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

tal que (subconjuntosAcotados xs k) es la lista de los subconjuntos de xs con k elementos como máximo. Por ejemplo,

   λ> subconjuntosAcotados "abcd" 1
   ["a","b","c","d",""]
   λ> subconjuntosAcotados "abcd" 2
   ["ab","ac","ad","a","bc","bd","b","cd","c","d",""]
   λ> subconjuntosAcotados "abcd" 3
   ["abc","abd","ab","acd","ac","ad","a",
    "bcd","bc","bd","b","cd","c","d",""]
   λ> length (subconjuntosAcotados [1..1000] 2)
   500501
   λ> length (subconjuntosAcotados2 [1..2000] 2)
   2001001

λ> subconjuntosAcotados "abcd" 1

["a","b","c","d",""]

λ> subconjuntosAcotados "abcd" 2

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

λ> subconjuntosAcotados "abcd" 3

["abc","abd","ab","acd","ac","ad","a",

"bcd","bc","bd","b","cd","c","d",""]

λ> length (subconjuntosAcotados [1..1000] 2)

500501

λ> length (subconjuntosAcotados2 [1..2000] 2)

2001001

Soluciones

import Data.List (subsequences)

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

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

-- Comparación de eficiencia
--    λ> length (subconjuntosAcotados1 [1..25] 2)
--    326
--    (10.48 secs, 6,968,637,480 bytes)
--    λ> length (subconjuntosAcotados2 [1..25] 2)
--    326
--    (0.00 secs, 0 bytes)

import Data.List (subsequences)

-- 1ª definición

subconjuntosAcotados1 :: [a] -> Int -> [[a]]

subconjuntosAcotados1 xs k =

[ys | ys <- subsequences xs

, length ys <= k]

-- 2ª definición

subconjuntosAcotados2 :: [a] -> Int -> [[a]]

subconjuntosAcotados2 _ 0 = [[]]

subconjuntosAcotados2 [] _ = [[]]

subconjuntosAcotados2 (x:xs) k =

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

++ subconjuntosAcotados2 xs k

-- Comparación de eficiencia

-- λ> length (subconjuntosAcotados1 [1..25] 2)

-- 326

-- (10.48 secs, 6,968,637,480 bytes)

-- λ> length (subconjuntosAcotados2 [1..25] 2)

-- 326

-- (0.00 secs, 0 bytes)

Variación de la conjetura de Goldbach

PorJosé A. Alonso 9-noviembre-201625-abril-2021

La conjetura de Goldbach afirma que

Todo número entero mayor que 5 se puede escribir como suma de tres números primos.

En este ejercicio consideraremos la variación consistente en exigir que los tres sumandos sean distintos.

Definir las funciones

   sumas3PrimosDistintos      :: Int -> [(Int,Int,Int)]
   conKsumas3PrimosDistintos  :: Int -> Int -> [Int]
   noSonSumas3PrimosDistintos :: Int -> [Int]

sumas3PrimosDistintos :: Int -> [(Int,Int,Int)]

conKsumas3PrimosDistintos :: Int -> Int -> [Int]

noSonSumas3PrimosDistintos :: Int -> [Int]

tales que

(sumas3PrimosDistintos n) es la lista de las descomposiciones decrecientes de n como tres primos distintos. Por ejemplo,

   sumas3PrimosDistintos 26  ==  [(13,11,2),(17,7,2),(19,5,2)]
   sumas3PrimosDistintos 18  ==  [(11,5,2),(13,3,2)]
   sumas3PrimosDistintos 10  ==  [(5,3,2)]
   sumas3PrimosDistintos 11  ==  []

sumas3PrimosDistintos 26 == [(13,11,2),(17,7,2),(19,5,2)]

sumas3PrimosDistintos 18 == [(11,5,2),(13,3,2)]

sumas3PrimosDistintos 10 == [(5,3,2)]

sumas3PrimosDistintos 11 == []

(conKsumas3PrimosDistintos k n) es la lista de los números menores o iguales que n que se pueden escribir en k forma distintas como suma de tres primos distintos. Por ejemplo,

   conKsumas3PrimosDistintos 3 99  ==  [26,27,29,32,36,42,46,48,54,58,60]
   conKsumas3PrimosDistintos 2 99  ==  [18,20,21,22,23,24,25,28,30,34,64,70]
   conKsumas3PrimosDistintos 1 99  ==  [10,12,14,15,16,19,40]
   conKsumas3PrimosDistintos 0 99  ==  [11,13,17]

conKsumas3PrimosDistintos 3 99 == [26,27,29,32,36,42,46,48,54,58,60]

conKsumas3PrimosDistintos 2 99 == [18,20,21,22,23,24,25,28,30,34,64,70]

conKsumas3PrimosDistintos 1 99 == [10,12,14,15,16,19,40]

conKsumas3PrimosDistintos 0 99 == [11,13,17]

(noSonSumas3PrimosDistintos n) es la lista de los números menores o iguales que n que no se pueden escribir como suma de tres primos distintos. Por ejemplo,

   noSonSumas3PrimosDistintos 99   ==  [11,13,17]
   noSonSumas3PrimosDistintos 500  ==  [11,13,17]

1 2	noSonSumas3PrimosDistintos 99 == [11,13,17] noSonSumas3PrimosDistintos 500 == [11,13,17]

Soluciones

import Data.Numbers.Primes

sumas3PrimosDistintos :: Int -> [(Int,Int,Int)]
sumas3PrimosDistintos n =
  [(a,b,c) | a <- takeWhile (<=n-5) primes
           , b <- takeWhile (<a) primes
           , let c = n - a - b
           , c < b
           , isPrime c]

conKsumas3PrimosDistintos :: Int -> Int -> [Int]
conKsumas3PrimosDistintos k n =
  [x | x <- [10..n]
     , length (sumas3PrimosDistintos x) == k]

noSonSumas3PrimosDistintos :: Int -> [Int]
noSonSumas3PrimosDistintos = conKsumas3PrimosDistintos 0

import Data.Numbers.Primes

sumas3PrimosDistintos :: Int -> [(Int,Int,Int)]

sumas3PrimosDistintos n =

[(a,b,c) | a <- takeWhile (<=n-5) primes

, b <- takeWhile (<a) primes

, let c = n - a - b

, c < b

, isPrime c]

conKsumas3PrimosDistintos :: Int -> Int -> [Int]

conKsumas3PrimosDistintos k n =

[x | x <- [10..n]

, length (sumas3PrimosDistintos x) == k]

noSonSumas3PrimosDistintos :: Int -> [Int]

noSonSumas3PrimosDistintos = conKsumas3PrimosDistintos 0

Referencias

Basado en el artículo Derivaciones de la conjetura de Goldbach de Claudio Meller en el blog Números y algo más.

Triángulos geométricos

PorJosé A. Alonso 2-noviembre-20169-noviembre-2016

Un triángulo geométrico es un triángulo de lados enteros, representados por la terna (a,b,c) tal que a ≤ b ≤ c y están en progresión geométrica, es decir, b^2 = a*c. Por ejemplo, un triángulo de lados a = 144, b = 156 y c = 169.

Definir la función

   numeroTG :: Integer -> Int

1	numeroTG :: Integer -> Int

tal que (numeroTG n) es el número de triángulos geométricos de perímetro menor o igual que n. Por ejemplo

    numeroTG 10  == 3
    numeroTG 100 == 42
    numeroTG 200 == 91

numeroTG 10 == 3

numeroTG 100 == 42

numeroTG 200 == 91

Nota: Los triángulos geométricos de perímetro menor o igual que 20 son

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

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

Se observa que (1,2,4) aunque cumple que 1+2+4 <= 20 y 2^2 = 1*4 no pertenece a la lista ya que 1+2 > 4 y, por tanto, no hay ningún triángulo cuyos lados midan 1, 2 y 4.

Soluciones

-- 1ª definición:
numeroTG :: Integer -> Int
numeroTG n = 
    length [(a,b,c) | c <- [1..n]
                    , b <- [1..c]
                    , a <- [1..b]
                    , a+b > c
                    , a+b+c <= n
                    , b^2 == a*c
                    ]

-- 2ª definición:
numeroTG2 :: Integer -> Int
numeroTG2 n = 
    length [(a,b,c) | c <- [1..n]
                    , b <- [1..c]
                    , b^2 `rem` c == 0
                    , let a = b^2 `div` c
                    , a+b > c
                    , a+b+c <= n
                    ]

-- Comparación de eficiencia:
--    λ> numeroTG 300
--    143
--    (2.40 secs, 1,496,824,720 bytes)
--    λ> numeroTG2 300
--    143
--    (0.05 secs, 40,908,568 bytes)

-- 1ª definición:

numeroTG :: Integer -> Int

numeroTG n =

length [(a,b,c) | c <- [1..n]

, b <- [1..c]

, a <- [1..b]

, a+b > c

, a+b+c <= n

, b^2 == a*c

]

-- 2ª definición:

numeroTG2 :: Integer -> Int

numeroTG2 n =

length [(a,b,c) | c <- [1..n]

, b <- [1..c]

, b^2 `rem` c == 0

, let a = b^2 `div` c

, a+b > c

, a+b+c <= n

]

-- Comparación de eficiencia:

-- λ> numeroTG 300

-- 143

-- (2.40 secs, 1,496,824,720 bytes)

-- λ> numeroTG2 300

-- 143

-- (0.05 secs, 40,908,568 bytes)

Referencia

El ejercicio está basado en el problema 370 del proyecto Euler.

Elementos que respetan la ordenación

Soluciones

Máxima ramificación

Soluciones

Subconjuntos acotados

Soluciones

Variación de la conjetura de Goldbach

Soluciones

Referencias

Triángulos geométricos

Soluciones

Referencia

Entradas recientes

Buscar

Correo electrónico