init

Contando en la arena

PorJosé A. Alonso 2-marzo-20179-marzo-2017

El problema de ayer de ¡Acepta el reto! fue Contando en la arena cuyo enunciado es el siguiente:

Es ampliamente conocido que escribimos los números utilizando base 10, en la que expresamos las cantidades utilizando 10 dígitos distintos (0…9). El valor de cada uno de ellos depende de la posición que ocupe dentro del número, pues cada dígito se multiplica por una potencia de 10 distinta según cuál sea esa posición.

La descomposición, por ejemplo, del número 1.234 es: 1.234 = 1×10^3 + 2×10^2 + 3×10^1 + 4×10^0

Otra base muy conocida es la base 2 al ser la utilizada por los dispositivos electrónicos. En ella sólo hay dos dígitos distintos (0 y 1), que se ven multiplicados por potencias de 2.

Mucho antes de que llegaran la base 2, la base 10 e incluso los números romanos, los primeros seres humanos contaban haciendo surcos en la arena, muescas en un trozo de madera o colocando palos en línea. Estaban, sin saberlo, usando base 1. En ella sólo hay un símbolo y cada dígito es multiplicado por una potencia de 1. Dado que 1^n = 1 el resultado es que todos los dígitos tienen el mismo peso.

Definir la función

   transformaAbase1 :: FilePath -> FilePath -> IO ()

1	transformaAbase1 :: FilePath -> FilePath -> IO ()

tal que al evaluar (transformaAbase1 f1 f2) lee el contenido del fichero f1 (que estará compuesto por distintos números mayores que 0, cada uno en una línea) y escribe en el fichero f2 una línea con la representación en base 1 de cada uno de los números de f1 excepto el 0 final. Por ejemplo, si el contenido de «Entrada.txt» es

al evaluar (transformaAbase1 «Entrada.txt» «Salida.txt») el contenido de «Salida.txt» debe de ser

1
1111
111111

1111

111111

Soluciones

transformaAbase1 :: FilePath -> FilePath -> IO ()
transformaAbase1 f1 f2 = do
  cs <- readFile f1
  writeFile f2 (transformaAbase1Aux cs)

-- (transformaAbase1Aux cs) es la cadena obtenida transformando a base 1
-- cada uno de los números de cs. Por ejemplo,
--    λ> transformaAbase1Aux "1\n4\n6\n0\n" 
--    "1\n1111\n111111\n"
transformaAbase1Aux :: String -> String
transformaAbase1Aux cs =
  unlines (map (show . enBase1) (numeros cs))

-- (numeros cs) es la lista de los números de cs, excepto el último. Por
-- ejemplo, 
--    numeros "1\n4\n6\n0\n"  ==  [1,4,6]
numeros :: String -> [Integer]
numeros cs  =
  init (map read (lines cs))

-- (enBsase1 x) es la representación de x en base 1. Por ejemplo,
--    enBase1 4  ==  1111
enBase1 :: Integer -> Integer
enBase1 x = (10^x - 1) `div` 9

transformaAbase1 :: FilePath -> FilePath -> IO ()

transformaAbase1 f1 f2 = do

cs <- readFile f1

writeFile f2 (transformaAbase1Aux cs)

-- (transformaAbase1Aux cs) es la cadena obtenida transformando a base 1

-- cada uno de los números de cs. Por ejemplo,

-- λ> transformaAbase1Aux "1\n4\n6\n0\n"

-- "1\n1111\n111111\n"

transformaAbase1Aux :: String -> String

transformaAbase1Aux cs =

unlines (map (show . enBase1) (numeros cs))

-- (numeros cs) es la lista de los números de cs, excepto el último. Por

-- ejemplo,

-- numeros "1\n4\n6\n0\n" == [1,4,6]

numeros :: String -> [Integer]

numeros cs =

init (map read (lines cs))

-- (enBsase1 x) es la representación de x en base 1. Por ejemplo,

-- enBase1 4 == 1111

enBase1 :: Integer -> Integer

enBase1 x = (10^x - 1) `div` 9

Segmentos comunes maximales

PorJosé A. Alonso 30-diciembre-20167-enero-2017

Los segmentos de «abcd» son

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

1	["","a","ab","abc","abcd","b","bc","bcd","c","cd","d"]

Los segmentos comunes de «abcd» y «axbce» son

   ["","a","b","bc","c"]

1	["","a","b","bc","c"]

Los segmentos comunes maximales (es decir, no contenidos en otros segmentos) de «abcd» y «axbce» son

   ["a","bc"]

1	["a","bc"]

Definir la función

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

1	segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]

tal que (segmentosComunesMaximales xs ys) es la lista de los segmentos comunes maximales de xs e ys. Por ejemplo,

   segmentosComunesMaximales "abcd" "axbce"  ==  ["a","bc"]
   segmentosComunesMaximales [8,8] [8]       ==  [[8]]

1 2	segmentosComunesMaximales "abcd" "axbce" == ["a","bc"] segmentosComunesMaximales [8,8] [8] == [[8]]

Soluciones

import Data.List (inits, tails, isInfixOf)

segmentosComunesMaximales :: Eq a => [a] -> [a] -> [[a]]
segmentosComunesMaximales xs ys =
  nub [zs | zs <- zss
          , null [us | us <- zss, zs `isInfixOf` us, us /= zs]]
  where zss = segmentosComunes xs ys

segmentosComunes :: Eq a => [a] -> [a] -> [[a]]
segmentosComunes xs ys =
  [zs | zs <- segmentos xs
      , zs `isInfixOf` ys]

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,
--    segmentos "abc"  ==  ["","a","ab","abc","b","bc","c"]
segmentos :: [a] -> [[a]]
segmentos xs =
  [] : concatMap (tail . inits) (init (tails xs))

import Data.List (inits, tails, isInfixOf)

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

segmentosComunesMaximales xs ys =

nub [zs | zs <- zss

, null [us | us <- zss, zs `isInfixOf` us, us /= zs]]

where zss = segmentosComunes xs ys

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

segmentosComunes xs ys =

[zs | zs <- segmentos xs

, zs `isInfixOf` ys]

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,

-- segmentos "abc" == ["","a","ab","abc","b","bc","c"]

segmentos :: [a] -> [[a]]

segmentos xs =

[] : concatMap (tail . inits) (init (tails xs))

Posiciones de equilibrio

PorJosé A. Alonso 15-diciembre-201622-diciembre-2016

Se dice que k es una posición de equilibrio de una lista xs si la suma de los elementos de xs en las posiciones menores que k es igual a la suma de los elementos de xs en las posiciones mayores que k. Por ejemplo, en la lista [-7,1,5,2,-4,3,0] el 3 es una posición de equilibrio ya que -7+1+5 = -4+3+0; también lo es el 6 ya que -7+1+5+2+(-4)+3 = 0.

Definir la función,

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

1	equilibrios :: (Num a, Eq a) => [a] -> [Int]

tal que (equilibrios xs) es la lista de las posiciones de equilibrio de xs. Por ejemplo,

   equilibrios [-7,1,5,2,-4,3,0]  ==  [3,6]
   equilibrios [1..10^6]          ==  []

1 2	equilibrios [-7,1,5,2,-4,3,0] == [3,6] equilibrios [1..10^6] == []

Soluciones

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

equilibrios1 :: (Num a, Eq a) => [a] -> [Int]
equilibrios1 xs =
  [n | n <- [0..length xs - 1]
     , sum (take n xs) == sum (drop (n+1) xs)]

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

equilibrios2 :: (Num a, Eq a) => [a] -> [Int]
equilibrios2 xs =
  [n | (n,x,y) <- zip3 [0..] (sumasI xs) (sumasD xs)
     , x == y]

sumasI :: (Num a, Eq a) => [a] -> [a]
sumasI xs = [sum (take n xs) | n <- [0..length xs - 1]] 

sumasD :: (Num a, Eq a) => [a] -> [a]
sumasD xs = [sum (drop (n+1) xs) | n <- [0..length xs - 1]] 

-- 3ª definición
-- =============

equilibrios3 :: (Num a, Eq a) => [a] -> [Int]
equilibrios3 xs =
  [n | (n,x,y) <- zip3 [0..] (sumasI' xs) (sumasD' xs)
     , x == y]

sumasI' :: (Num a, Eq a) => [a] -> [a]
sumasI'  = init . scanl (+) 0 

sumasD' :: (Num a, Eq a) => [a] -> [a]
sumasD' = tail . scanr (+) 0

-- 4ª definición
-- =============

equilibrios4 :: (Num a, Eq a) => [a] -> [Int]
equilibrios4 xs =
  [n | (n,x,y) <- zip3 [0..] (scanl1 (+) xs) (scanr1 (+) xs)
     , x == y]

-- Comparación de eficiencia
--    λ> let xs = [1..10^4] in equilibrios1 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (20.92 secs, 46,240,541,256 bytes)
--    λ> let xs = [1..10^4] in equilibrios2 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (21.12 secs, 46,249,562,520 bytes)
--    λ> let xs = [1..10^4] in equilibrios3 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (0.02 secs, 11,858,768 bytes)
--    λ> let xs = [1..10^4] in equilibrios4 (xs ++ [5] ++ reverse xs)
--    [10000]
--    (0.02 secs, 13,963,952 bytes)

-- 1ª definición

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

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

equilibrios1 xs =

[n | n <- [0..length xs - 1]

, sum (take n xs) == sum (drop (n+1) xs)]

-- 2ª definición

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

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

equilibrios2 xs =

[n | (n,x,y) <- zip3 [0..] (sumasI xs) (sumasD xs)

, x == y]

sumasI :: (Num a, Eq a) => [a] -> [a]

sumasI xs = [sum (take n xs) | n <- [0..length xs - 1]]

sumasD :: (Num a, Eq a) => [a] -> [a]

sumasD xs = [sum (drop (n+1) xs) | n <- [0..length xs - 1]]

-- 3ª definición

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

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

equilibrios3 xs =

[n | (n,x,y) <- zip3 [0..] (sumasI' xs) (sumasD' xs)

, x == y]

sumasI' :: (Num a, Eq a) => [a] -> [a]

sumasI' = init . scanl (+) 0

sumasD' :: (Num a, Eq a) => [a] -> [a]

sumasD' = tail . scanr (+) 0

-- 4ª definición

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

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

equilibrios4 xs =

[n | (n,x,y) <- zip3 [0..] (scanl1 (+) xs) (scanr1 (+) xs)

, x == y]

-- Comparación de eficiencia

-- λ> let xs = [1..10^4] in equilibrios1 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (20.92 secs, 46,240,541,256 bytes)

-- λ> let xs = [1..10^4] in equilibrios2 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (21.12 secs, 46,249,562,520 bytes)

-- λ> let xs = [1..10^4] in equilibrios3 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (0.02 secs, 11,858,768 bytes)

-- λ> let xs = [1..10^4] in equilibrios4 (xs ++ [5] ++ reverse xs)

-- [10000]

-- (0.02 secs, 13,963,952 bytes)

Máxima suma de elementos consecutivos

PorJosé A. Alonso 17-marzo-20161-mayo-2016

Definir la función

   sumaMaxima :: [Integer] -> Integer

1	sumaMaxima :: [Integer] -> Integer

tal que (sumaMaxima xs) es el valor máximo de la suma de elementos consecutivos de la lista xs. Por ejemplo,

   sumaMaxima []             ==  0 
   sumaMaxima [2,-2,3,-3,4]  ==  4
   sumaMaxima [-1,-2,-3]     ==  0
   sumaMaxima [2,-1,3,-2,3]  ==  5
   sumaMaxima [1,-1,3,-2,4]  ==  5
   sumaMaxima [2,-1,3,-2,4]  ==  6
   sumaMaxima [1..10^6]      ==  500000500000

sumaMaxima [] == 0

sumaMaxima [2,-2,3,-3,4] == 4

sumaMaxima [-1,-2,-3] == 0

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

sumaMaxima [1,-1,3,-2,4] == 5

sumaMaxima [2,-1,3,-2,4] == 6

sumaMaxima [1..10^6] == 500000500000

Comprobar con QuickCheck que

   sumaMaxima xs == sumaMaxima (reverse xs)

1	sumaMaxima xs == sumaMaxima (reverse xs)

Soluciones

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

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

sumaMaxima1 :: [Integer] -> Integer
sumaMaxima1 [] = 0
sumaMaxima1 xs =
    maximum (0 : map sum [sublista xs i j | i <- [0..length xs - 1],
                                            j <- [i..length xs - 1]])

sublista :: [Integer] -> Int -> Int -> [Integer]
sublista xs i j =
    [xs!!k | k <- [i..j]]

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

sumaMaxima2 :: [Integer] -> Integer
sumaMaxima2 [] = 0
sumaMaxima2 xs = sumaMaximaAux 0 0 xs
    where m = maximum xs

sumaMaximaAux :: Integer -> Integer -> [Integer] -> Integer
sumaMaximaAux m v [] = max m v
sumaMaximaAux m v (x:xs)
    | x >= 0    = sumaMaximaAux m (v+x) xs
    | v+x > 0   = sumaMaximaAux (max m v) (v+x) xs
    | otherwise = sumaMaximaAux (max m v) 0 xs

-- 3ª definición
-- =============

sumaMaxima3 :: [Integer] -> Integer
sumaMaxima3 [] = 0
sumaMaxima3 xs = maximum (map sum (segmentos xs))

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo 
--    segmentos "abc"  ==  ["", "a","ab","abc","b","bc","c"]
segmentos :: [a] -> [[a]]
segmentos xs =
    [] : concat [tail (inits ys) | ys <- init (tails xs)]

-- 4ª definición
-- =============

sumaMaxima4 :: [Integer] -> Integer
sumaMaxima4 [] = 0
sumaMaxima4 xs = 
    maximum (concat [scanl (+) 0 ys | ys <- tails xs])

-- Comprobación
-- ============

-- La propiedad es
prop_sumaMaxima :: [Integer] -> Bool
prop_sumaMaxima xs =
    sumaMaxima2 xs == n &&
    sumaMaxima3 xs == n &&
    sumaMaxima4 xs == n
    where n = sumaMaxima1 xs

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

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

--    λ> let n = 10^2 in sumaMaxima1 [-n..n] 
--    5050
--    (2.10 secs, 390,399,104 bytes)
--    λ> let n = 10^2 in sumaMaxima2 [-n..n] 
--    5050
--    (0.02 secs, 0 bytes)
--    λ> let n = 10^2 in sumaMaxima3 [-n..n] 
--    5050
--    (0.27 secs, 147,705,184 bytes)
--    λ> let n = 10^2 in sumaMaxima4 [-n..n] 
--    5050
--    (0.04 secs, 11,582,520 bytes)

prop_inversa :: [Integer] -> Bool
prop_inversa xs =
    sumaMaxima2 xs == sumaMaxima2 (reverse xs)

import Data.List (inits, tails)

import Test.QuickCheck

-- 1ª definición

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

sumaMaxima1 :: [Integer] -> Integer

sumaMaxima1 [] = 0

sumaMaxima1 xs =

maximum (0 : map sum [sublista xs i j | i <- [0..length xs - 1],

j <- [i..length xs - 1]])

sublista :: [Integer] -> Int -> Int -> [Integer]

sublista xs i j =

[xs!!k | k <- [i..j]]

-- 2ª definición

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

sumaMaxima2 :: [Integer] -> Integer

sumaMaxima2 [] = 0

sumaMaxima2 xs = sumaMaximaAux 0 0 xs

where m = maximum xs

sumaMaximaAux :: Integer -> Integer -> [Integer] -> Integer

sumaMaximaAux m v [] = max m v

sumaMaximaAux m v (x:xs)

| x >= 0 = sumaMaximaAux m (v+x) xs

| v+x > 0 = sumaMaximaAux (max m v) (v+x) xs

| otherwise = sumaMaximaAux (max m v) 0 xs

-- 3ª definición

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

sumaMaxima3 :: [Integer] -> Integer

sumaMaxima3 [] = 0

sumaMaxima3 xs = maximum (map sum (segmentos xs))

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo

-- segmentos "abc" == ["", "a","ab","abc","b","bc","c"]

segmentos :: [a] -> [[a]]

segmentos xs =

[] : concat [tail (inits ys) | ys <- init (tails xs)]

-- 4ª definición

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

sumaMaxima4 :: [Integer] -> Integer

sumaMaxima4 [] = 0

sumaMaxima4 xs =

maximum (concat [scanl (+) 0 ys | ys <- tails xs])

-- Comprobación

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

-- La propiedad es

prop_sumaMaxima :: [Integer] -> Bool

prop_sumaMaxima xs =

sumaMaxima2 xs == n &&

sumaMaxima3 xs == n &&

sumaMaxima4 xs == n

where n = sumaMaxima1 xs

-- La comprobación es

-- λ> quickCheck prop_sumaMaxima

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> let n = 10^2 in sumaMaxima1 [-n..n]

-- 5050

-- (2.10 secs, 390,399,104 bytes)

-- λ> let n = 10^2 in sumaMaxima2 [-n..n]

-- 5050

-- (0.02 secs, 0 bytes)

-- λ> let n = 10^2 in sumaMaxima3 [-n..n]

-- 5050

-- (0.27 secs, 147,705,184 bytes)

-- λ> let n = 10^2 in sumaMaxima4 [-n..n]

-- 5050

-- (0.04 secs, 11,582,520 bytes)

prop_inversa :: [Integer] -> Bool

prop_inversa xs =

sumaMaxima2 xs == sumaMaxima2 (reverse xs)

Primos hereditarios

PorJosé A. Alonso 16-abril-20151-mayo-2016

Un número primo es hereditario si todos los números obtenidos eliminando dígitos por la derecha o por la izquierda son primos. Por ejemplo, 3797 es hereditario ya que los números obtenidos eliminando dígitos por la derecha son 3797, 379, 37 y 3 y los obtenidos eliminando dígitos por la izquierda son 3797, 797, 97 y 7 y todos ellos son primos.

Definir la sucesión

   hereditarios :: [Integer]

1	hereditarios :: [Integer]

cuyos elementos son los números hereditarios. Por ejemplo,

   ghci> take 15 hereditarios
   [2,3,5,7,23,37,53,73,313,317,373,797,3137,3797,739397]

1 2	ghci> take 15 hereditarios [2,3,5,7,23,37,53,73,313,317,373,797,3137,3797,739397]

Soluciones

import Data.List (inits, tails)
import Data.Char (digitToInt)
import Data.Numbers.Primes (primes, isPrime)

hereditarios :: [Integer]
hereditarios = [n | n <- primes, hereditario n]

hereditario :: Integer -> Bool
hereditario n = 
    all odd (map digitToInt (tail ds)) &&
    all isPrime (map read (tail (inits ds))) &&
    all isPrime (map read (init (tails ds)))
    where ds = show n

import Data.List (inits, tails)

import Data.Char (digitToInt)

import Data.Numbers.Primes (primes, isPrime)

hereditarios :: [Integer]

hereditarios = [n | n <- primes, hereditario n]

hereditario :: Integer -> Bool

hereditario n =

all odd (map digitToInt (tail ds)) &&

all isPrime (map read (tail (inits ds))) &&

all isPrime (map read (init (tails ds)))

where ds = show n

Contando en la arena

Soluciones

Segmentos comunes maximales

Soluciones

Posiciones de equilibrio

Soluciones

Máxima suma de elementos consecutivos

Soluciones

Primos hereditarios

Soluciones

Entradas recientes

Buscar

Correo electrónico