Números dorados

PorJosé A. Alonso 6-enero-201713-enero-2017

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

1	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]

λ> 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)]

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)]

6 Comentarios

import Data.List (permutations)

esDorado :: Integer -> Bool
esDorado x =
  even (length z) 
  && any (== x) (map (f.g.splitAt (div (length z) 2)) (permutations z))
  where z       = show x
        f (x,y) = x^2-y^2
        g (x,y) = (read x,read y)

import Data.List (permutations)

esDorado :: Integer -> Bool

esDorado x =

even (length z)

&& any (== x) (map (f.g.splitAt (div (length z) 2)) (permutations z))

where z = show x

f (x,y) = x^2-y^2

g (x,y) = (read x,read y)

Responder

import Data.List (foldl', permutations)

esDorado :: Integer -> Bool
esDorado x
  | odd ldx   = False
  | otherwise = not
                $ null
                $ filter (dorado x)
                $ map (particion (div ldx 2))
                $ permutations dx
  where
    dx  = digits x
    ldx = length dx
                
particion :: Int -> [Integer] -> ([Integer],[Integer])
particion l xs = (take l xs, drop l xs)

dorado :: Integer -> ([Integer],[Integer]) -> Bool
dorado x (a,b) = (fromDigits a)^2 - (fromDigits b)^2 == x 

fromDigits :: [Integer] -> Integer
fromDigits xs = foldl' (\x y -> 10*x + y) 0 xs

digits :: Integer -> [Integer]
digits n = [read [x] | x <- show n]

import Data.List (foldl', permutations)

esDorado :: Integer -> Bool

esDorado x

| odd ldx = False

| otherwise = not

$ null

$ filter (dorado x)

$ map (particion (div ldx 2))

$ permutations dx

where

dx = digits x

ldx = length dx

particion :: Int -> [Integer] -> ([Integer],[Integer])

particion l xs = (take l xs, drop l xs)

dorado :: Integer -> ([Integer],[Integer]) -> Bool

dorado x (a,b) = (fromDigits a)^2 - (fromDigits b)^2 == x

fromDigits :: [Integer] -> Integer

fromDigits xs = foldl' (\x y -> 10*x + y) 0 xs

digits :: Integer -> [Integer]

digits n = [read [x] | x <- show n]

Responder

Parece un poco forzado decir que el nº 1 tiene 2 dígitos (por eso de que 32^2 - 1^2 = 1023). Si nos ceñimos a la definición:

import Data.List (sort)
import Math.NumberTheory.Logarithms (integerLog10')
import Math.NumberTheory.Powers.Squares (isSquare', integerSquareRoot')

-- Las permutaciones crecen factorialmente, algo menos malo es crecer potencialmente
esDorado :: Integer ->Bool
esDorado n =
  case (1 + integerLog10' n) `divMod` 2 of
    (s, 0) ->not $ null [() | b <-[10^(s - 1)  .. integerSquareRoot' (10^(2 * s) - n)]
                          , let { b2 = b^2; a2 = n + b^2 }
                          , isSquare' a2
                          , (a2 - b2) == n
                          , sort (show n) == sort (show (integerSquareRoot' a2) ++ show b)
                          ]
    (_, 1) ->False
{-

> esDorado 541067040000
True
(0.10 secs, 50,200,352 bytes)

> esDorado' 541067040000 -- (permutando)
True
(25.31 secs, 29,755,756,464 bytes)

-}


-- Para obtener una enumeración parece mejor acotar intervalos
dorados :: Integer ->[Integer]
dorados n = dorados' (integerSquareRoot' (10^(2 * n - 1) - 10^n + 1)) n

-- permitiendo empezar en una cota arbitraria
dorados' :: Integer ->Integer ->[Integer]
dorados' f n = [d | a <-[f .. 10^n - 1]
               , let { a2 = a^2; sa = show a }
               , b <-[k1 .. integerSquareRoot' (a2 - k2)]
               , let d = a2 - b^2
               , sort (show d) == sort (sa ++ show b)]
  where k1 = 10^(    n - 1)
        k2 = 10^(2 * n - 1)

{-

-- los primeros 7161 dorados
[josejuan@centella centella]$ time -f "%E, %M" ../dorados 4
7161
0:43.11, 4520

-- primer dorado con 18 dígitos
[josejuan@centella centella]$ time -f "%E, %M" ../dorados 9
100000021653538776
0:04.05, 4096

-}

import Data.List (sort)

import Math.NumberTheory.Logarithms (integerLog10')

import Math.NumberTheory.Powers.Squares (isSquare', integerSquareRoot')

-- Las permutaciones crecen factorialmente, algo menos malo es crecer potencialmente

esDorado :: Integer ->Bool

esDorado n =

case (1 + integerLog10' n) `divMod` 2 of

(s, 0) ->not $ null [() | b <-[10^(s - 1) .. integerSquareRoot' (10^(2 * s) - n)]

, let { b2 = b^2; a2 = n + b^2 }

, isSquare' a2

, (a2 - b2) == n

, sort (show n) == sort (show (integerSquareRoot' a2) ++ show b)

]

(_, 1) ->False

> esDorado 541067040000

True

(0.10 secs, 50,200,352 bytes)

> esDorado' 541067040000 -- (permutando)

True

(25.31 secs, 29,755,756,464 bytes)

-- Para obtener una enumeración parece mejor acotar intervalos

dorados :: Integer ->[Integer]

dorados n = dorados' (integerSquareRoot' (10^(2 * n - 1) - 10^n + 1)) n

-- permitiendo empezar en una cota arbitraria

dorados' :: Integer ->Integer ->[Integer]

dorados' f n = [d | a <-[f .. 10^n - 1]

, let { a2 = a^2; sa = show a }

, b <-[k1 .. integerSquareRoot' (a2 - k2)]

, let d = a2 - b^2

, sort (show d) == sort (sa ++ show b)]

where k1 = 10^( n - 1)

k2 = 10^(2 * n - 1)

-- los primeros 7161 dorados

[josejuan@centella centella]$ time -f "%E, %M" ../dorados 4

7161

0:43.11, 4520

-- primer dorado con 18 dígitos

[josejuan@centella centella]$ time -f "%E, %M" ../dorados 9

100000021653538776

0:04.05, 4096

Responder

import Data.List (permutations)
import Data.Char (digitToInt)

-- He tenido que cambiar los tipos porque no hacía coincidir ninguna función
esDorado :: Int -> Bool
esDorado x
  | even (length (digitos x)) = elem x (listaOperaciones x)
  | otherwise                 = False

unDigitos :: [Int] -> Int
unDigitos [a]    = a 
unDigitos (x:xs) = x*10^(length xs) + unDigitos xs

numerosX []       = []
numerosX (xs:xss) = map digitToInt xs : numerosX xss

divisionPermuta :: [Int] -> [Int] 
divisionPermuta xs
  | null xs = xs
  | odd (length xs) = xs
  | otherwise = unDigitos (take (div (length xs) 2) xs) :
                unDigitos (drop (div (length xs) 2) xs) : []

operacion :: [[Int]] -> [Int]
operacion [] = []
operacion (xs:xss) = ((head xs)^2 - (last xs)^2) : operacion xss

listaOperaciones :: Int -> [Int]
listaOperaciones x =
  operacion (map divisionPermuta (numerosX (permutations (show x))))

digitos :: Int -> [Int]
digitos n = [read [x] | x <- show n]

import Data.List (permutations)

import Data.Char (digitToInt)

-- He tenido que cambiar los tipos porque no hacía coincidir ninguna función

esDorado :: Int -> Bool

esDorado x

| even (length (digitos x)) = elem x (listaOperaciones x)

| otherwise = False

unDigitos :: [Int] -> Int

unDigitos [a] = a

unDigitos (x:xs) = x*10^(length xs) + unDigitos xs

numerosX [] = []

numerosX (xs:xss) = map digitToInt xs : numerosX xss

divisionPermuta :: [Int] -> [Int]

divisionPermuta xs

| null xs = xs

| odd (length xs) = xs

| otherwise = unDigitos (take (div (length xs) 2) xs) :

unDigitos (drop (div (length xs) 2) xs) : []

operacion :: [[Int]] -> [Int]

operacion [] = []

operacion (xs:xss) = ((head xs)^2 - (last xs)^2) : operacion xss

listaOperaciones :: Int -> [Int]

listaOperaciones x =

operacion (map divisionPermuta (numerosX (permutations (show x))))

digitos :: Int -> [Int]

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

Responder

import Data.List ((\\), permutations, subsequences)

esDorado :: Integer -> Bool
esDorado x =
  any (==x) (map (\n -> abs ((numero (fst n))^2) - ((numero (snd n))^2))
                 (particionesValidas (digitos x)))

digitos :: Integer -> [Integer]
digitos x = [read [d] | d <- show x]

particionesValidas :: [Integer] -> [([Integer],[Integer])]
particionesValidas xs =
  filter (\p -> (length (snd p) == length (fst p)) &&
                ((length (snd p) + length (fst p)) == length xs))
         (particiones xs)

particiones :: [Integer] -> [([Integer],[Integer])]
particiones xs =
  [(ys, zs) | ys <- concatMap permutations (subsequences xs)
            , zs <- permutations (xs \\ ys)]

numero :: [Integer] -> Integer
numero xs = auxN (reverse xs)

auxN :: [Integer] -> Integer
auxN []     = 0
auxN (x:xs) = x + 10 * (auxN xs)

import Data.List ((\\), permutations, subsequences)

esDorado :: Integer -> Bool

esDorado x =

any (==x) (map (\n -> abs ((numero (fst n))^2) - ((numero (snd n))^2))

(particionesValidas (digitos x)))

digitos :: Integer -> [Integer]

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

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

particionesValidas xs =

filter (\p -> (length (snd p) == length (fst p)) &&

((length (snd p) + length (fst p)) == length xs))

(particiones xs)

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

particiones xs =

[(ys, zs) | ys <- concatMap permutations (subsequences xs)

, zs <- permutations (xs \\ ys)]

numero :: [Integer] -> Integer

numero xs = auxN (reverse xs)

auxN :: [Integer] -> Integer

auxN [] = 0

auxN (x:xs) = x + 10 * (auxN xs)

Responder

import Data.List

esDorado :: Integer -> Bool
esDorado x =
  length x' `mod` 2 == 0
  && not ( null [b | a <- grupos x
                   , let b = x + a^2
                   , b `elem` map (^2) (grupos' a x) ] )
  where x' = show x

-- La función grupos da las posibles descomposiciones del número. 
grupos :: Integer -> [Integer]
grupos n = nub [read (take n2 x) | x <- (permutations n')]
  where n' = show n
        n2 = length n' `div` 2

-- La función grupos' da las permutaciones de los dígitos que quedan del
-- número dada un subconjunto de sus dígitos. 
grupos' :: Integer -> Integer -> [Integer]
grupos' a x = nub [read (take x2 s) | s <- (permutations (x'\\show a))]
  where x' = show x
        x2 = length x' `div` 2

import Data.List

esDorado :: Integer -> Bool

esDorado x =

length x' `mod` 2 == 0

&& not ( null [b | a <- grupos x

, let b = x + a^2

, b `elem` map (^2) (grupos' a x) ] )

where x' = show x

-- La función grupos da las posibles descomposiciones del número.

grupos :: Integer -> [Integer]

grupos n = nub [read (take n2 x) | x <- (permutations n')]

where n' = show n

n2 = length n' `div` 2

-- La función grupos' da las permutaciones de los dígitos que quedan del

-- número dada un subconjunto de sus dígitos.

grupos' :: Integer -> Integer -> [Integer]

grupos' a x = nub [read (take x2 s) | s <- (permutations (x'\\show a))]

where x' = show x

x2 = length x' `div` 2

Responder

Números dorados

Soluciones

6 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Se puede imprimir o compartir con

6 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico