fork(3) download
copy 
  1. import Control.Monad
  2. import Data.List
  3. import Text.Printf
  4. eval' = foldr f
  5.     where
  6.     f 0 acc = acc + 2
  7.     f 1 acc = sqrt acc
  8.  
  9. sol' = foldl' f
  10.     where
  11.     f acc 0 = acc - 2
  12.     f acc 1 = acc ^2 
  13.  
  14. sol, eval :: [Int] -> Double
  15. sol = sol' pi
  16. eval = eval' 0
  17.  
  18. dfs :: [Int] -> Double -> IO ()
  19. dfs key tgt 
  20.     | eval key == pi = printf "find solution %d\n" (length key)
  21.     | otherwise = do
  22.         when (foldl' (\acc x -> acc * 3 + x) 0 key `mod` 1000 == 0) $ 
  23.             printf "current context: %s %.15f\n" (show key) tgt
  24.         let n = length key
  25.         let good (key, v) = eval key == pi || (1 < v && v < fromIntegral (2 * (53 - n)))
  26.         let cands = filter good [(key ++ [0], tgt - 2), (key ++ [1], tgt^2)]
  27.         forM_ cands $ \(nkey, ntgt) -> dfs nkey ntgt
  28.  
  29.  
  30. main :: IO ()
  31. main = 
  32.     dfs [] pi
  33.  
Success #stdin #stdout 0.04s 0KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
current context: [] 3.141592653589793
current context: [0] 1.141592653589793
find solution 53
current context: [0,1,1,1,1,0,0,0,1,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,1,1,0,1,0,1,0,0,0,0,0,1,0,0,0] 10.009967193484070
current context: [0,1,1,1,1,0,0,0,1,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,1,1,0,1,0,1,0,0,0,0,0,1,0,0,0,0] 8.009967193484070
current context: [0,1,1,1,1,0,0,0,1,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,1,1,0,1,0,1,0,0,0,0,0,1,0,0,0,0,0] 6.009967193484069
current context: [0,1,1,1,1,0,0,0,1,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,0,0,0,0,0,1,0,1,1,0,0,1,0] 2.136979828787066
current context: [0,1,1,1,1,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,1,0,0,1,1,1,0,0,0,0,0] 12.971464939400775
current context: [0,1,1,1,1,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,1,0,0,1,1,1,0,0,0,0,0,0] 10.971464939400775
current context: [0,1,1,1,1,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,0,1,0,0,1,1,1,0,0,0,0,0,0,0] 8.971464939400775
current context: [0,1,1,1,1,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,1,1,1,1,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0] 3.096778591615806
current context: [0,1,1,1,1,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,1,1,1,1,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0] 1.096778591615806
current context: [0,1,1,1,1,0,0,1,0,0,0,0,0,0,0,0,1,0,0,1,0,0,0,0,1,0,1,1,0,1,1,0,0,0,0,1,0,1,1,0,1,0,1,0,0,1,0,0,0,0,0,1,1] 1.055802708798190
current context: [0,1,1,1,1,0,0,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,1,1,1,0,0,1,0] 9.249623879059596
current context: [1,0,0,0,0,1,0,1,1,0,1,0,0,0,0,1,1,1,1,1,1,1,1,0,1,0,0,1,1,0,0,1,1,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0] 2.248988542770825
current context: [1,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1] 12.589836050062631
current context: [1,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,0] 10.589836050062631
current context: [1,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,0,0] 8.589836050062631
current context: [1,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,1,0,1,0,1,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,1,0,0] 1.135235828711170
current context: [1,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,0,0,0,0,1,1,0,0] 1.470652565890449
https://ideone.com/5WwNiY
language:
Haskell (ghc 8.4.4)
created:
7 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!