Menu Close

Puntos en una región

Definir la función

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

tal que (puntos n) es la lista de los puntos (x,y) con coordenadas enteras de
la cuadrícula [1..n]x[1..n] (es decir, 1 ≤ x,y ≤ n) tales que |x²-xy-y²| = 1. Por ejemplo,

   length (puntos 10)          ==  5
   length (puntos 100)         ==  10
   length (puntos 1000)        ==  15
   length (puntos (10^50000))  ==  239249

Soluciones

-- 1ª definición
-- =============
 
puntos1 :: Integer -> [(Integer,Integer)]
puntos1 n =
    [(x,y) | x <- [1..n],
             y <- [1..n],
             abs (x^2-x*y-y^2) == 1] 
 
-- 2ª definición
-- =============
 
-- Calculando algunos elementos
--    λ> puntos1 10
--    [(1,1),(2,1),(3,2),(5,3),(8,5)]
--    λ> puntos1 20
--    [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8)]
--    λ> puntos1 100
--    [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]
--    λ> puntos1 89
--    [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]
-- se observa una ley de construcción de cada elemento a partir del anterior.
 
puntos2 :: Integer -> [(Integer,Integer)]
puntos2 n = takeWhile menor (iterate siguiente (1,1))
    where siguiente (x,y) = (x+y,x)
          menor (x,y)     = x <= n
 
-- 3ª definición
-- =============
 
-- Se observa que la lista de las segundas componentes
--    1,1,2,3,5,8,13,21,34,55,89,...
-- y la lista de las primeras componentes es el resto de la segunda. 
 
puntos3 :: Integer -> [(Integer,Integer)]
puntos3 n = zip (tail xs) xs
    where xs = takeWhile (<=n) fibonacci
 
-- fibonacci es la sucesión de Fibonacci. Por ejemplo,
--    take 11 fibonacci  ==  [1,1,2,3,5,8,13,21,34,55,89]
fibonacci :: [Integer]
fibonacci = 1 : 1 : zipWith (+) fibonacci (tail fibonacci)
 
-- Comparación de eficiencia
-- =========================
 
-- λ> length (puntos1 (10^3))
-- 15
-- (7.96 secs, 1,092,368,200 bytes)
-- λ> length (puntos2 (10^3))
-- 15
-- (0.02 secs, 0 bytes)
-- 
-- λ> length (puntos2 (10^30000))
-- 143549
-- (1.14 secs, 974,239,544 bytes)
-- λ> length (puntos3 (10^30000))
-- 143549
-- (3.28 secs, 967,206,560 bytes)

6 soluciones de “Puntos en una región

  1. josejuan
    import Data.Numbers.Fibonacci (fib)
     
    -- aunque existe fórmula explícita y puede usarse Data.Real.Constructible, otra forma es
    -- coste logarítmico sobre el dominio de búsqueda
    indiceOmenor n = up 1
      where up i = case n `compare` fib i of -- exponencialmente hacia arriba
                     EQ -> i
                     GT -> up $ i + i
                     LT -> down (i `div` 2) (i - 1)
            down a b | a > b     = b
                     | otherwise = let i = (a + b) `div` 2 -- exponencial (dicotómica) hacia abajo
                                   in  case n `compare` fib i of
                                           EQ -> i
                                           GT -> down (i + 1) b
                                           LT -> down a (i - 1)
     
     
    -- entonces la función solicitada es
    puntos :: Integer -> [(Integer, Integer)]
    puntos n = let s = fib <$> [1..indiceOmenor n] in zip (tail s) s
     
    {-
     
    > :set +s
    > mapM_ (print . length . puntos) [10, 100, 1000, 10^50000]
    5
    10
    15
    239249
    (0.30 secs, 72,752,224 bytes)
     
    -}
    • josejuan

      Es posible obtenerla sin calcular el índice pero no es eficiente

      puntos n = zip (tail s) s
                 where s = takeWhile (≤n) $ fib ↥ [1]
    • josejuan

      Calculando directamente la secuencia es notablemente más rápida que la última pero tampoco es tan eficiente como sólo calcular el índice final (la primera).

      puntos n = fix (λf a b → let c = a + b in if c ≤ n then (c, b): f b c else []) 0 1
  2. Abel Martín
    import Data.List (unfoldr)
     
    puntos :: Integer -> [(Integer,Integer)]
    puntos n = unfoldr f (1,1)
        where f (x,y) | x > n     = Nothing
                      | otherwise = Just ((x,y),(x+y,x))
  3. abrdelrod
    puntos :: Integer -> [(Integer,Integer)]
    puntos n | n < 1     = []
             | otherwise = takeWhile p (iterate f (1,1))
        where f (x,y) = (x+y,x)
              p (x,_) = x <= n
  4. isrbelnun
    puntos :: Integer -> [(Integer,Integer)]
    puntos n = [(x,y) | x <- [1..n], y <- [1..n], abs (x^2-x*y-y^2) == 1]

Escribe tu solución

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.