Menu Close

Etiqueta: splitAt

Suma minimal de productos de pares de elementos consecutivos

Al permutar los elementos de la lista [1,2,3,4] se obtienen los siguientes valores de la suma de pares de elementos consecutivos:

  • 10, por ejemplo con [1,4,2,3] ya que 1×4+2×3 = 10
  • 11, por ejemplo con [1,3,2,4] ya que 1×3+2×4 = 11
  • 14, por ejemplo con [1,2,3,4] ya que 1×2+3×4 = 14

Por tanto, la mínima suma de los productos de elementos consecutivos en las permutaciones de [1,2,3,4] es 10 y una permutación con dicha suma es [1,4,2,3].

Definir las funciones

   minimaSumaProductos  :: (Num a, Ord a) => [a] -> a
   permutacionMinimal   :: (Num a, Ord a) => [a] -> [a]

tales que

  • (minimaSumaProductos xs) es la mínima suma de los productos de elementos consecutivos en las permutaciones de lista xs, suponiendo que xs tiene un número par de elementos. Por ejemplo,
     minimaSumaProductos [1..4]             ==  10
     minimaSumaProductos [3,2,5,7,1,6]      ==  34
     minimaSumaProductos [9,2,8,4,5,7,6,0]  ==  74
     minimaSumaProductos [1,2,1,4,0,5,6,0]  ==  6
  • (permutacionMinimal xs) es una permutación de xs cuya suma de productos de elementos consecutivos de xs es la mínima suma de los productos de elementos consecutivos en las permutaciones de lista xs, suponiendo que xs tiene un número par de elementos. Por ejemplo,
     permutacionMinimal [1..4]             ==  [1,4,3,2]
     permutacionMinimal [3,2,5,7,1,6]      ==  [1,7,2,6,3,5]
     permutacionMinimal [9,2,8,4,5,7,6,0]  ==  [0,9,2,8,4,7,5,6]
     permutacionMinimal [1,2,1,4,0,5,6,0]  ==  [0,6,0,5,1,4,1,2]

Soluciones

import Data.List (sort, permutations)
import Test.QuickCheck
 
-- 1ª definición
-- =============
 
minimaSumaProductos :: (Num a, Ord a) => [a] -> a
minimaSumaProductos xs =
  minimum [sumaProductos ys | ys <- permutations xs]
 
--    sumaProductos [3,2,1,4]  ==  10
--    sumaProductos [2,4,3,1]  ==  11
--    sumaProductos [1,2,3,4]  ==  14
sumaProductos :: (Num a, Ord a) => [a] -> a
sumaProductos []       = 0
sumaProductos [x]      = x
sumaProductos (x:y:zs) = x*y + sumaProductos zs
 
permutacionMinimal :: (Num a, Ord a) => [a] -> [a]
permutacionMinimal xs =
  head [ys | ys <- yss
           , sumaProductos ys == m]
  where yss = permutations xs
        m   = minimaSumaProductos xs
 
-- 2ª definición
-- =============
 
permutacionMinimal2 :: (Num a, Ord a) => [a] -> [a]
permutacionMinimal2 xs =
  intercala ys (reverse zs)
  where n = length xs
        (ys,zs) = splitAt (n `div` 2) (sort xs)
 
intercala :: [a] -> [a] -> [a]
intercala xs ys =
  concat [[x,y] | (x,y) <- zip xs ys]
 
minimaSumaProductos2 :: (Num a, Ord a) => [a] -> a
minimaSumaProductos2 =
  sumaProductos . permutacionMinimal2
 
-- Equivalencia
-- ============
 
prop_equivalencia :: [Int] -> Property
prop_equivalencia xs =
  even (length xs) ==>
  minimaSumaProductos xs == minimaSumaProductos2 xs
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=10}) prop_equivalencia
--    +++ OK, passed 100 tests.

Números dorados

Los dígitos del número 2375 se pueden separar en dos grupos de igual tamaño ([7,2] y [5,3]) tales que para los correspondientes números (72 y 53) se verifique que la diferencia de sus cuadrados sea el número original (es decir, 72^2 – 53^2 = 2375).

Un número x es dorado si sus dígitos se pueden separar en dos grupos de igual tamaño tales que para los correspondientes números (a y b) se verifique que la diferencia de sus cuadrados sea el número original (es decir, b^2 – a^2 = x).

Definir la función

   esDorado :: Integer -> Bool

tales que (esDorado x) se verifica si x es un número dorado. Por
ejemplo,

   λ> esDorado 2375
   True
   λ> take 5 [x | x <- [1..], esDorado x]
   [48,1023,1404,2325,2375]

Soluciones

 
import Data.List (permutations)
 
esDorado :: Integer -> Bool
esDorado x =
  even (length (show x)) &&
  or [b^2 - a^2 == x | (a,b) <- particionesNumero x]
 
-- (particiones xs) es la lista de las formas de dividir xs en dos
-- partes de igual longitud (se supone que xs tiene un número par de
-- elementos). Por ejemplo,
--    λ> particiones "abcd"
--    [("ab","cd"),("ba","cd"),("cb","ad"),("bc","ad"),("ca","bd"),
--     ("ac","bd"),("dc","ba"),("cd","ba"),("cb","da"),("db","ca"),
--     ("bd","ca"),("bc","da"),("da","bc"),("ad","bc"),("ab","dc"),
--     ("db","ac"),("bd","ac"),("ba","dc"),("da","cb"),("ad","cb"),
--     ("ac","db"),("dc","ab"),("cd","ab"),("ca","db")]
particiones :: [a] -> [([a],[a])]
particiones xs =
  [splitAt m ys | ys <- permutations xs]
  where m = length xs `div` 2
 
-- (particionesNumero n) es la lista de las formas de dividir n en dos
-- partes de igual longitud (se supone que n tiene un número par de
-- dígitos). Por ejemplo,
--    λ> particionesNumero 1234
--    [(12,34),(21,34),(32,14),(23,14),(31,24),(13,24),(43,21),(34,21),
--     (32,41),(42,31),(24,31),(23,41),(41,23),(14,23),(12,43),(42,13),
--     (24,13),(21,43),(41,32),(14,32),(13,42),(43,12),(34,12),(31,42)]
particionesNumero :: Integer -> [(Integer,Integer)]
particionesNumero n =
  [(read xs,read ys) | (xs,ys) <- particiones (show n)]

Números de la suerte

Un número de la suerte es un número natural que se genera por una criba, similar a la criba de Eratóstenes, como se indica a continuación:

Se comienza con la lista de los números enteros a partir de 1:

   1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25...

Se eliminan los números de dos en dos

   1,  3,  5,  7,  9,   11,   13,   15,   17,   19,   21,   23,   25...

Como el segundo número que ha quedado es 3, se eliminan los números
restantes de tres en tres:

   1,  3,      7,  9,         13,   15,         19,   21,         25...

Como el tercer número que ha quedado es 7, se eliminan los números restantes de
siete en siete:

   1,  3,      7,  9,         13,   15,               21,         25...

Este procedimiento se repite indefinidamente y los supervivientes son
los números de la suerte:

   1,3,7,9,13,15,21,25,31,33,37,43,49,51,63,67,69,73,75,79

Definir la sucesión

   numerosDeLaSuerte :: [Int]

cuyos elementos son los números de la suerte. Por ejemplo,

   λ> take 20 numerosDeLaSuerte
   [1,3,7,9,13,15,21,25,31,33,37,43,49,51,63,67,69,73,75,79]
   λ> numerosDeLaSuerte !! 1500
   13995

Soluciones

-- 1ª definición
numerosDeLaSuerte :: [Int]
numerosDeLaSuerte = criba 3 [1,3..]
  where
    criba i (n:s:xs) =
      n : criba (i + 1) (s : [x | (n, x) <- zip [i..] xs
                                , rem n s /= 0])
 
-- 2ª definición
numerosDeLaSuerte2 :: [Int]
numerosDeLaSuerte2 =  1 : criba 2 [1, 3..]
  where criba k xs = z : criba (k + 1) (aux xs)
          where z = xs !! (k - 1 )
                aux ws = us ++ aux vs
                  where (us, _:vs) = splitAt (z - 1) ws

Elementos que respetan la ordenación

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]

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]             ==  []

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.

Centro de gravedad de una lista

Se dice que una lista de números xs es equilibrada si existe una posición k tal que la suma de los elementos de xs en las posiciones menores que k es igual a la de los elementos de xs en las posiciones mayores que k. La posición k se llama el centro de gravedad de xs. Por ejemplo, la lista [1,3,4,5,-2,1] es equilibrada, y su centro de gravedad es 2, ya que la suma de [1,3] es igual a la de [5,-2,1]. En cambio, la lista [1,6,4,5,-2,1] no tiene centro de gravedad.

Definir la función

   centro :: (Num a, Eq a) => [a] -> Maybe Int

tal que (centro xs) es justo el centro e gravedad de xs, si la lista xs es equilibrada y Nothing en caso contrario. Por ejemplo,

   centro [1,3,4,5,-2,1]           ==  Just 2
   centro [1,6,4,5,-2,1]           ==  Nothing
   centro [1,2,3,4,3,2,1]          ==  Just 3
   centro [1,100,50,-51,1,1]       ==  Just 1
   centro [1,2,3,4,5,6]            ==  Nothing
   centro [20,10,30,10,10,15,35]   ==  Just 3
   centro [20,10,-80,10,10,15,35]  ==  Just 0
   centro [10,-80,10,10,15,35,20]  ==  Just 6
   centro [0,0,0,0,0]              ==  Just 0
   centro [-1,-2,-3,-4,-3,-2,-1]   ==  Just 3

Soluciones

import Data.List (inits, tails)
import Data.Maybe (listToMaybe)
 
-- 1ª solución
-- ===========
 
centro1 :: (Num a, Eq a) => [a] -> Maybe Int
centro1 xs 
    | null ns   = Nothing
    | otherwise = Just (head ns)
    where ns = [n | n <- [0..length xs - 1],
                    let (ys,_:zs) = splitAt n xs,
                    sum ys == sum zs]
 
-- 2ª solución
-- ===========
 
centro2 :: (Num a, Eq a) => [a] -> Maybe Int
centro2 xs = aux 0 0 (sum xs) xs where
    aux _ _ _ [] = Nothing
    aux k i d (z:zs) | i == d - z = Just k
                     | otherwise  = aux (k + 1) (i + z) (d - z) zs
 
-- 3ª solución
-- ===========
 
centro3 :: (Num a, Eq a) => [a] -> Maybe Int
centro3 xs =
  listToMaybe [ k | (k,ys,_:zs) <- zip3 [0..] (inits xs) (tails xs)
                  , sum ys == sum zs]
 
-- Comparación de eficiencia
-- =========================
 
--    λ> let xs = [1..3000] in centro1 (xs ++ (0:xs))
--    Just 3000
--    (2.70 secs, 2,088,881,728 bytes)
--    λ> let xs = [1..3000] in centro2 (xs ++ (0:xs))
--    Just 3000
--    (0.03 secs, 0 bytes)
--    λ> let xs = [1..3000] in centro3 (xs ++ (0:xs))
--    Just 3000
--    (2.34 secs, 1,727,569,688 bytes)