0votos

Emulando a Dik T. Winter en Haskell

por josejuan hace 6 años

Ineficiente pero curioso. Resuelto como un problema de optimización binaria (programación lineal entera).

Un número de N dígitos es narcisista si la suma de las potencias N-ésimas de sus dígitos es él mismo.

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
66
67
68
69
70
71
{-- 
 
Aunque el problema de encontrar todos los números Narcisistas en puramente combinacional, 
se puede representar fácilmente mediante un problema de programación lineal entera 
(concretamente optimización binaria). 
 
Este código en Haskell genera un problema de optimización binaria en formato "lp_solve". 
 
Para resolverlo, basta enviarlo al comando "lp_solve". 
 
 
 
Un helper que realiza todo el proceso y nos da el número final para bash puede ser: 
 
$ cat maxNarc 
#!/bin/bash 
./MaxNarcissistic $1 | lp_solve | grep '^d.*1$' | perl -n -e 's/d[0-9]+([0-9]) .*$/$1/; print $_' | perl -e 'while(<>){chomp;$u="$_$u";}print "$u\n"' 
 
 
 
Por ejemplo, la ejecución para n=1..7 en un Atom D510 podría ser: 
 
$ for i in 1 2 3 4 5 6 7; do echo '================='; time -f "%E" ./maxNarc $i; done 
================= 
0:00.03 
================= 
 
0:00.03 
================= 
407 
0:00.06 
================= 
9474 
0:00.23 
================= 
93084 
0:04.36 
================= 
548834 
1:02.04 
================= 
9926315 
7:58.60 
 
 
--} 
 
import Data.List (intersperse) 
import System.Environment (getArgs) 
 
main = do 
  (w:_) <- getArgs 
  let n :: Int 
      n = read w 
   
  -- Expresión a optimizar: 
  putStrLn $ "max: " ++ (concat $ intersperse " + \n" $ map (\p -> concat $ intersperse " + " $ map (\d -> show (d^n) ++ " d" ++ show p ++ show d) [0..9] ) [1..n]) ++ ";\n" 
   
  -- Cada N dígito sólo puede tomar un valor entre 0 y 9. 
  mapM_ (\p -> putStrLn $ (concat $ intersperse " + " $ map (\d -> "d" ++ show p ++ show d) [0..9]) ++ " = 1;") [1..n] 
  putStrLn "" 
 
  -- La suma de las potencias debe estar entre  
  putStrLn $ show (10^(n-1)) ++ " <= " ++ (concat $ intersperse " + \n" $ map (\p -> concat $ intersperse " + " $ map (\d -> show (d^n) ++ " d" ++ show p ++ show d) [0..9] ) [1..n]) ++ " <= " ++ show (10^n-1) ++ ";\n" 
 
  -- La suma de las potencias debe coincidir con la representación en base 10: 
  putStrLn $ (concat $ intersperse " + \n" $ map (\p -> concat $ intersperse " + " $ map (\d -> show (d^n - d * 10^(p-1)) ++ " d" ++ show p ++ show d) [0..9] ) [1..n]) ++ " = 0;\n" 
 
  -- Nuestras variables son binarias (la variable "dAB" indica que el dígito A toma el valor B) 
  putStrLn $ "bin " ++ (concat $ intersperse ",\n" $ map (\p -> concat $ intersperse ", " $ map (\d -> "d" ++ show p ++ show d) [0..9] ) [1..n]) ++ ";" 
1 comentario
0votos

Escrito por josejuan hace 6 años

Bueno, un ejemplo del sistema lineal generado para n=3 sería:
$ ./MaxNarcissistic 3
max: 0 d10 + 1 d11 + 8 d12 + 27 d13 + 64 d14 + 125 d15 + 216 d16 + 343 d17 + 512 d18 + 729 d19 +
0 d20 + 1 d21 + 8 d22 + 27 d23 + 64 d24 + 125 d25 + 216 d26 + 343 d27 + 512 d28 + 729 d29 +
0 d30 + 1 d31 + 8 d32 + 27 d33 + 64 d34 + 125 d35 + 216 d36 + 343 d37 + 512 d38 + 729 d39;

d10 + d11 + d12 + d13 + d14 + d15 + d16 + d17 + d18 + d19 = 1;
d20 + d21 + d22 + d23 + d24 + d25 + d26 + d27 + d28 + d29 = 1;
d30 + d31 + d32 + d33 + d34 + d35 + d36 + d37 + d38 + d39 = 1;

100 <= 0 d10 + 1 d11 + 8 d12 + 27 d13 + 64 d14 + 125 d15 + 216 d16 + 343 d17 + 512 d18 + 729 d19 +
0 d20 + 1 d21 + 8 d22 + 27 d23 + 64 d24 + 125 d25 + 216 d26 + 343 d27 + 512 d28 + 729 d29 +
0 d30 + 1 d31 + 8 d32 + 27 d33 + 64 d34 + 125 d35 + 216 d36 + 343 d37 + 512 d38 + 729 d39 <= 999;

0 d10 + 0 d11 + 6 d12 + 24 d13 + 60 d14 + 120 d15 + 210 d16 + 336 d17 + 504 d18 + 720 d19 +
0 d20 + -9 d21 + -12 d22 + -3 d23 + 24 d24 + 75 d25 + 156 d26 + 273 d27 + 432 d28 + 639 d29 +
0 d30 + -99 d31 + -192 d32 + -273 d33 + -336 d34 + -375 d35 + -384 d36 + -357 d37 + -288 d38 + -171 d39 = 0;

bin d10, d11, d12, d13, d14, d15, d16, d17, d18, d19,
d20, d21, d22, d23, d24, d25, d26, d27, d28, d29,
d30, d31, d32, d33, d34, d35, d36, d37, d38, d39;

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.