Números con la misma cantidad de anteriores con 1 que sin 1

9 Comentarios

1. Haskell

   import Data.List (partition) especiales :: [Integer] especiales = [x | x <- [1..], especial x] especial :: Integer -> Bool especial n = length xs == length ys where (xs,ys) = partition p [1..n] p x | elem 1 (digitos x) = True | otherwise = False digitos x = [read [y] :: Int | y <- show x]

   1 2 3 4 5 6 7 8 9 10 11

   import Data.List (partition)   especiales :: [Integer] especiales = [x | x <- [1..], especial x]   especial :: Integer -> Bool especial n = length xs == length ys     where (xs,ys) = partition p [1..n]           p x | elem 1 (digitos x) = True               | otherwise          = False           digitos x = [read [y] :: Int | y <- show x]

   Responder

2. Haskell

   especiales :: [Integer] especiales = [x | x <- [1..], esEspecial x] where esEspecial n | even n = genericLength [1 | x <- [1..n], any (=='1') (show x)] == n`div`2 | otherwise = False

   1 2 3 4 5 6

   especiales :: [Integer] especiales = [x | x <- [1..], esEspecial x]     where esEspecial n               | even n = genericLength [1 | x <- [1..n], any (=='1') (show x)]                          == n`div`2               | otherwise = False

   Responder

   1. Simplificada y más eficiente:

      Haskell

      especiales :: [Integer] especiales = [x|x<-[2,4..], esEspecial x] where esEspecial n = genericLength [1|x<-[1..n], elem '1' (show x)] == n`div`2

      1 2 3

      especiales :: [Integer] especiales = [x|x<-[2,4..], esEspecial x]     where esEspecial n = genericLength [1|x<-[1..n], elem '1' (show x)] == n`div`2

      Responder

3. Haskell

   especiales :: [Integer] especiales = [n | n <- [1..], especial n] especial :: Integer -> Bool especial n = even n && div (fromIntegral n) 2 == length [x | x <- [1..n], conUno x] conUno :: Integer -> Bool conUno 0 = False conUno x = r == 1 || conUno q where (q,r) = quotRem x 10

   1 2 3 4 5 6 7 8 9 10 11

   especiales :: [Integer] especiales = [n | n <- [1..], especial n]   especial :: Integer -> Bool especial n =     even n && div (fromIntegral n) 2 == length [x | x <- [1..n], conUno x]   conUno :: Integer -> Bool conUno 0 = False conUno x = r == 1 || conUno q     where (q,r) = quotRem x 10

   Responder

4. Salvo error, parece que nºs especiales sólo hay éstos o los siguientes (¿hay más?) son muy grandes (por encima de 10e10):

   2,16,24,160,270,272,1456,3398,3418,3420,3422,13120,44686,118096,674934,1062880

   En lugar de evaluar uno a uno, se enumeran los rangos de números consecutivos que tienen o no uno (porque en cada rango habrá, como mucho, un único especial; eje. entre 100~~~000 y 199~~~999 sólo puede haber, a lo sumo, un especial, pues el conteo de «sin» está fijo y «con» crece estrictamente).

   Haskell

   import Data.List import System.Environment import Control.Applicative -- n1 con, n2 sin, n3 con, ... del 1 al 99 s199 = [1, 8, 10, 1, 1, 9, 1, 9, 1, 9, 1, 9, 1, 9, 1, 9, 1, 9, 1, 8] -- enumera para las potencias 10^2, 10^3, ... las secuencias tipo `s199` (del 1 al 10^n-1) conSinPot :: [[(Integer, Bool)]] conSinPot = (zip s199 $ cycle [True, False]): map z [3..] where z n = pre ++ [(10^(n - 1), True)] ++ concatMap (const $ (1, False):pre) [1..8] where pre = conSinPot!!(n - 3) -- obtiene la secuencia tipo `s199` pero desde el 1 hasta el infinito conSinPotencia :: [(Integer, Bool)] conSinPotencia = conSinPot!!0 ++ concatMap z [3..] where z n = [(10^(n - 1), True)] ++ concatMap (const $ (1, False):pre) [1..8] where pre = conSinPot!!(n - 3) -- usando los intervalos si/no, revisa si en cada salto puede haber equivalencia (con == sin) -- ponemos límite a la búsqueda del siguiente en base al número `i` máximo a revisar especiales'' limite = z 1 0 0 conSinPotencia where z i c s ((l, con):xs) = if i > limite then [] else if con then if c < s && s <= c + l then (i + s - c - 1): z (i + l) (c + l) s xs else z (i + l) (c + l) s xs else if s < c && c <= s + l then (i + c - s - 1): z (i + l) c (s + l) xs else z (i + l) c (s + l) xs main = do (n:_) <- map read <$> getArgs print $ especiales'' n {- [josejuan@centella Solveet]$ time -f "%E, %M" ./conuno 10000000000 [2,16,24,160,270,272,1456,3398,3418,3420,3422,13120,44686,118096,674934,1062880] 1:32.81, 4152268 -}

   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 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45

   import Data.List import System.Environment import Control.Applicative   -- n1 con, n2 sin, n3 con, ... del 1 al 99 s199 = [1, 8, 10, 1, 1, 9, 1, 9, 1, 9, 1, 9, 1, 9, 1, 9, 1, 9, 1, 8]   -- enumera para las potencias 10^2, 10^3, ... las secuencias tipo `s199` (del 1 al 10^n-1) conSinPot :: [[(Integer, Bool)]] conSinPot = (zip s199 $ cycle [True, False]): map z [3..]             where z n = pre ++ [(10^(n - 1), True)] ++ concatMap (const $ (1, False):pre) [1..8]                         where pre = conSinPot!!(n - 3)   -- obtiene la secuencia tipo `s199` pero desde el 1 hasta el infinito conSinPotencia :: [(Integer, Bool)] conSinPotencia = conSinPot!!0 ++ concatMap z [3..]   where z n = [(10^(n - 1), True)] ++ concatMap (const $ (1, False):pre) [1..8] where pre = conSinPot!!(n - 3)   -- usando los intervalos si/no, revisa si en cada salto puede haber equivalencia (con == sin) --   ponemos límite a la búsqueda del siguiente en base al número `i` máximo a revisar especiales'' limite = z 1 0 0 conSinPotencia   where z i c s ((l, con):xs) = if i > limite                                    then []                                    else                                     if con                                      then                                       if c < s && s <= c + l                                          then (i + s - c - 1): z (i + l) (c + l) s xs                                          else                  z (i + l) (c + l) s xs                                      else                                       if s < c && c <= s + l                                          then (i + c - s - 1): z (i + l) c (s + l) xs                                          else                  z (i + l) c (s + l) xs   main = do   (n:_) <- map read <$> getArgs   print $ especiales'' n   {-   [josejuan@centella Solveet]$ time -f "%E, %M" ./conuno 10000000000 [2,16,24,160,270,272,1456,3398,3418,3420,3422,13120,44686,118096,674934,1062880] 1:32.81, 4152268   -}

   Responder

   1. (Salvo error claro)

      Si x(n) es el número de números con 1 desde el 1 hasta 10^n-1 (1..999) es

      x(1) = 1
      x(n) = 10^(n-1) + 9 x(n-1)

      Desarrollando

      x(1)= 1
      x(2)= 10 + 9
      x(3)= 10² + 9 10 + 81
      x(4)= 10³ + 9 10² + 81 10 + 729
      x(5)= 10⁴ + 9 10³ + 81 10² + 729 10 + 6561
      …
      x(n) = 10^n – 9^n

      Si y(n) es el número de números sin 1 desde 1 hasta 10^n-1 (1..999) es

      y(n) = 10^n – 1 – x(n) = 9^n – 1

      Como las dos son estrictamente crecientes, en

      x(n) – y(n+1)

      ya no habrá suficientes «sin 1» para igualar a los «con 1» exactamente para ser

      (n-1) ln 10 = n ln 9

      es n=21.854, por lo que ya no hay especiales por encima de 10^22.

      Responder

   2. Es posible obtener todos los especiales hasta n en tiempo O(log n) y espacio O(log n) (el código en C está aquí)

      Responder

   3. Haskell

      {- Si Xn son el nº de nºs con 1 por debajo de 10^n e Yn los de sin 1, sospecho que existe una estrategia muy sencilla que avanza exponencialmente (incrementos tipo 10^n) pero no consigo concretarla; así, uso la misma estrategia que la versión de C, ir incrementando dígitos. Usámos una mónada para ir almacenando los especiales sin acarrear explícitamente la salida. Aunque no es eficiente ir trasegando dígitos, como es O(log n) es rápido. `ds` almacena los dígitos más significativos según se incrementan. `ps` almacena los dígitos menos significativos ya incrementados. `run` avanza un paso (+1) pero será exponencial en media (en `intento`). `inc` incrementa los dígitos. -} import Control.Monad import Control.Monad.Writer import Data.Word x n = 10^n - 9^n digits2Number :: [Word8] -> Integer digits2Number [] = 0 digits2Number (d:ds) = fromIntegral d + 10 * digits2Number ds especiales :: Int -> Writer [Integer] () especiales maxDigits = run [] 0 0 where run :: [Word8] -> Integer -> Integer -> Writer [Integer] () run ps con sin = if length ps >= maxDigits then return () else inc (reverse ps) [] 0 con sin inc :: [Word8] -> [Word8] -> Int -> Integer -> Integer -> Writer [Integer] () inc [] ps pot con sin = inc [0] ps pot con sin inc (0:ds) ps pot con sin = do let con2 = con + 10^pot when (con < sin && sin <= con2) (tell [digits2Number (reverse ps ++ [1] ++ ds) + sin - con - 1]) let ps_ = map (const 9) ps intento (_, (j, conj, sinj)) _ = let sinj_ = sinj + 10^pot - x pot in (sinj_ < con2, (j + 1, conj + x pot, sinj_)) (_, (j, con_, sin_)) = last $ takeWhile fst $ scanl intento (True, (1, con2, sin)) [2..9] run (reverse ds ++ [j] ++ ps_) con_ sin_ inc (9:ds) ps pot con sin = inc ds (0:ps) (pot + 1) con sin inc (d:ds) ps 0 con sin = do let ic = 9 - d sin2 = sin + fromIntegral ic when (sin < con && con <= sin2) (tell [digits2Number (reverse ps ++ [d] ++ ds) + con - sin]) run (reverse ds ++ [9] ++ ps) con sin2 inc (d:ds) ps pot con sin = do let sin_ = sin + 1 when (con == sin_) (tell [digits2Number (reverse ps ++ [d + 1] ++ ds)]) run (reverse ds ++ [d + 1] ++ ps) con sin_ {- Revisando hasta 10^23 (sin compilar) *Main> :set +s *Main> execWriter $ especiales 23 [2,16,24,160,270,272,1456,3398,3418,3420,3422,13120,44686,118096,674934,1062880] (1.86 secs, 145229036 bytes) -}

      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 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64

      {-     Si Xn son el nº de nºs con 1 por debajo de 10^n e Yn los de sin 1,     sospecho que existe una estrategia muy sencilla que avanza exponencialmente     (incrementos tipo 10^n) pero no consigo concretarla; así, uso la misma     estrategia que la versión de C, ir incrementando dígitos.          Usámos una mónada para ir almacenando los especiales sin acarrear     explícitamente la salida.          Aunque no es eficiente ir trasegando dígitos, como es O(log n) es rápido.          `ds` almacena los dígitos más significativos según se incrementan.     `ps` almacena los dígitos menos significativos ya incrementados.          `run` avanza un paso (+1) pero será exponencial en media (en `intento`).     `inc` incrementa los dígitos. -} import Control.Monad import Control.Monad.Writer import Data.Word   x n = 10^n - 9^n   digits2Number :: [Word8] -> Integer digits2Number [] = 0 digits2Number (d:ds) = fromIntegral d + 10 * digits2Number ds   especiales :: Int -> Writer [Integer] () especiales maxDigits = run [] 0 0     where run :: [Word8] -> Integer -> Integer -> Writer [Integer] ()           run ps con sin = if length ps >= maxDigits then return () else inc (reverse ps) [] 0 con sin           inc :: [Word8] -> [Word8] -> Int -> Integer -> Integer -> Writer [Integer] ()           inc [] ps pot con sin = inc [0] ps pot con sin           inc (0:ds) ps pot con sin = do             let con2 = con + 10^pot             when (con < sin && sin <= con2)                  (tell [digits2Number (reverse ps ++ [1] ++ ds) + sin - con - 1])             let ps_ = map (const 9) ps                 intento (_, (j, conj, sinj)) _ = let sinj_ = sinj + 10^pot - x pot                                                  in  (sinj_ < con2, (j + 1, conj + x pot, sinj_))                 (_, (j, con_, sin_)) = last $ takeWhile fst $ scanl intento (True, (1, con2, sin)) [2..9]             run (reverse ds ++ [j] ++ ps_) con_ sin_           inc (9:ds) ps pot con sin = inc ds (0:ps) (pot + 1) con sin           inc (d:ds) ps 0 con sin = do             let ic = 9 - d                 sin2 = sin + fromIntegral ic             when (sin < con && con <= sin2)                  (tell [digits2Number (reverse ps ++ [d] ++ ds) + con - sin])             run (reverse ds ++ [9] ++ ps) con sin2           inc (d:ds) ps pot con sin = do             let sin_ = sin + 1             when (con == sin_)                  (tell [digits2Number (reverse ps ++ [d + 1] ++ ds)])             run (reverse ds ++ [d + 1] ++ ps) con sin_                                      {-     Revisando hasta 10^23 (sin compilar)          *Main> :set +s     *Main> execWriter $ especiales 23     [2,16,24,160,270,272,1456,3398,3418,3420,3422,13120,44686,118096,674934,1062880]       (1.86 secs, 145229036 bytes) -}

      Responder

   4. ¡Al fin!, hay tres casos especiales, se revisan de arriba a abajo las potencias de 10 candidatas.

      Haskell

      import Data.List (sort) -- con y sin bajo potencias de 10 x n = 10^n - 9^n y n = 9^n - 1 -- con y sin bajo un dígito por una potencia de 10 (ej. bajo 40000) s 0 p = x p s d p = d * x p + 10^p t d p = (d + 1) * 10^p - 1 - s d p -- los que empiezan por uno son fáciles, porque crecen linealmente en su potencia especialesEmpezandoEn1 maxPotencia = [ 10^(p - 1) + sinA - conA - 1 | p <- [1..maxPotencia] , let conA = x (p - 1) -- antes de empezar todos los 1 sinA = y (p - 1) conB = x p -- al terminar todos los 1 de la potencia , conA < sinA && sinA <= conB -- si hay salto ] -- dígito y potencia candidata sobre la que se produce un posible corte -- similar al anterior, pero recursivamente en base a un conteo de potencia previa candidatos n baseCon baseSin maxPotencia = [(n + d * 10^p, conA, sinA + 1, p) | d <- [2..9], p <- [0..maxPotencia] , let conA = baseCon + s (d - 1) p sinA = baseSin + t (d - 1) p conB = baseCon + s d p sinB = baseSin + t d p , (conA < sinA && sinA <= conB) || (sinA < conA && conA <= sinB) ] -- recursivamente todas las expansiones candidatas todosCandidatos n c s 0 = candidatos n c s 0 todosCandidatos n c s p = let cs = candidatos n c s p in cs ++ concat [ todosCandidatos n c s (p - 1) | (n, c, s, p) <- cs ] -- especiales que no empiezan en 1, hay de dos tipos especialesEmpezandoEnOtro p = let cs = todosCandidatos 0 0 0 p in -- aquellos que *no* contienen el 1 [n | (n, c, s, _) <- cs, c == s] ++ -- aquellos que *si* contienen el 1 [n + z1 + z2 | (n, c, s, p) <- cs, p > 0 , let c' = c + x (p - 1) -- si tenemos 550000 subimos a 550999 (revisaremos el 1 siguiente) s' = s + y (p - 1) z1 = 10^(p - 1) - 1 -- vamos de 550000 a 550999 ¿cuantos 1 faltan? z2 = s' - c' , 0 < z2 && z2 < 10^(p - 1)] -- juntamos los especiales revisando hasta la potencia `p` especiales p = sort $ especialesEmpezandoEn1 p ++ especialesEmpezandoEnOtro p {- Revisando que no haya especiales hasta 10^100 (aunque sabemos que no hay encima de 10^23) *Main> :set +s *Main> especiales 100 [2,16,24,160,270,272,1456,3398,3418,3420,3422,13120,44686,118096,674934,1062880] (0.14 secs, 16507344 bytes) -}

      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 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65

      import Data.List (sort)   -- con y sin bajo potencias de 10 x n = 10^n - 9^n y n =  9^n - 1   -- con y sin bajo un dígito por una potencia de 10 (ej. bajo 40000) s 0 p = x p s d p = d * x p + 10^p t d p = (d + 1) * 10^p - 1 - s d p   -- los que empiezan por uno son fáciles, porque crecen linealmente en su potencia especialesEmpezandoEn1 maxPotencia =     [ 10^(p - 1) + sinA - conA - 1 | p <- [1..maxPotencia]         , let conA = x (p - 1)        -- antes de empezar todos los 1               sinA = y (p - 1)               conB = x p              -- al terminar todos los 1 de la potencia         , conA < sinA && sinA <= conB -- si hay salto         ]   -- dígito y potencia candidata sobre la que se produce un posible corte --      similar al anterior, pero recursivamente en base a un conteo de potencia previa candidatos n baseCon baseSin maxPotencia =     [(n + d * 10^p, conA, sinA + 1, p)             | d <- [2..9], p <- [0..maxPotencia]             , let conA = baseCon + s (d - 1) p                   sinA = baseSin + t (d - 1) p                   conB = baseCon + s  d      p                   sinB = baseSin + t  d      p             , (conA < sinA && sinA <= conB) ||               (sinA < conA && conA <= sinB)             ]   -- recursivamente todas las expansiones candidatas todosCandidatos n c s 0 = candidatos n c s 0 todosCandidatos n c s p =     let cs = candidatos n c s p     in  cs ++ concat [ todosCandidatos n c s (p - 1) | (n, c, s, p) <- cs ]   -- especiales que no empiezan en 1, hay de dos tipos especialesEmpezandoEnOtro p =     let cs = todosCandidatos 0 0 0 p     in  -- aquellos que *no* contienen el 1         [n | (n, c, s, _) <- cs, c == s] ++         -- aquellos que *si* contienen el 1         [n + z1 + z2 | (n, c, s, p) <- cs, p > 0                         , let c' = c + x (p - 1)  -- si tenemos 550000 subimos a 550999 (revisaremos el 1 siguiente)                               s' = s + y (p - 1)                               z1 = 10^(p - 1) - 1 -- vamos de 550000 a 550999 ¿cuantos 1 faltan?                               z2 = s' - c'                         , 0 < z2 && z2 < 10^(p - 1)]                          -- juntamos los especiales revisando hasta la potencia `p` especiales p = sort $ especialesEmpezandoEn1 p ++ especialesEmpezandoEnOtro p   {-       Revisando que no haya especiales hasta 10^100 (aunque sabemos que no hay encima de 10^23)       *Main> :set +s     *Main> especiales 100     [2,16,24,160,270,272,1456,3398,3418,3420,3422,13120,44686,118096,674934,1062880]       (0.14 secs, 16507344 bytes) -}

      Responder