├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── build └── .gitkeep ├── configure ├── input ├── p008_input.txt ├── p013_input.txt ├── p018_input.txt ├── p022_names.txt ├── p042_words.txt ├── p054_poker.txt ├── p059_cipher.txt ├── p067_triangle.txt ├── p079_keylog.txt ├── p081_matrix.txt ├── p082_matrix.txt ├── p083_matrix.txt ├── p089_roman.txt ├── p096_sudoku.txt ├── p098_words.txt ├── p099_base_exp.txt ├── p102_triangles.txt ├── p107_network.txt ├── p185_input.txt └── p345_input.txt ├── lib └── Common │ ├── DataStructure │ ├── Fenwick.hs │ └── UnionFind.hs │ ├── List.hs │ ├── MapReduce.hs │ ├── Matrix │ ├── LICENSE │ └── Matrix.hs │ ├── MonadRef.hs │ ├── NumMod │ ├── MkNumMod.hs │ └── NumMod.hs │ ├── Numbers │ ├── EulerPhi.hs │ ├── InfiniteSequence.hs │ ├── Numbers.hs │ └── Primes.hs │ ├── Polynomial │ └── Polynomial.hs │ ├── README.md │ └── Utils.hs ├── project-euler-solutions.cabal.in └── src ├── .ghci ├── 1.hs ├── 10.hs ├── 100.hs ├── 102.hs ├── 104.hs ├── 107.hs ├── 108.hs ├── 11.hs ├── 110.hs ├── 119.hs ├── 12.hs ├── 120.hs ├── 123.hs ├── 124.hs ├── 13.hs ├── 132.hs ├── 14.hs ├── 15.hs ├── 151.hs ├── 16.hs ├── 162.hs ├── 17.hs ├── 173.hs ├── 18.hs ├── 185.hs ├── 187.hs ├── 19.hs ├── 191.hs ├── 2.hs ├── 20.hs ├── 203.hs ├── 205.hs ├── 206.hs ├── 207.hs ├── 21.hs ├── 211.hs ├── 214.hs ├── 216.hs ├── 22.hs ├── 222.hs ├── 225.hs ├── 23.hs ├── 231.hs ├── 232.hs ├── 239.hs ├── 24.hs ├── 240.hs ├── 249.hs ├── 25.hs ├── 250.hs ├── 258.hs ├── 26.hs ├── 265.hs ├── 266.hs ├── 267.hs ├── 269.hs ├── 27.hs ├── 271.hs ├── 28.hs ├── 286.hs ├── 29.hs ├── 3.hs ├── 30.hs ├── 304.hs ├── 307.hs ├── 31.hs ├── 310.hs ├── 317.hs ├── 32.hs ├── 323.hs ├── 33.hs ├── 34.hs ├── 345.hs ├── 346.hs ├── 347.hs ├── 35.hs ├── 356.hs ├── 357.hs ├── 36.hs ├── 365.hs ├── 37.hs ├── 371.hs ├── 378.hs ├── 38.hs ├── 381.hs ├── 39.hs ├── 394.hs ├── 4.hs ├── 40.hs ├── 401.hs ├── 407.hs ├── 41.hs ├── 42.hs ├── 429.hs ├── 43.hs ├── 432.hs ├── 435.hs ├── 44.hs ├── 443.hs ├── 45.hs ├── 458.hs ├── 46.hs ├── 47.hs ├── 479.hs ├── 48.hs ├── 49.hs ├── 491.hs ├── 492.hs ├── 493.hs ├── 498.hs ├── 5.hs ├── 50.hs ├── 500.hs ├── 501.hs ├── 504.hs ├── 506.hs ├── 509.hs ├── 51.hs ├── 510.hs ├── 511.hs ├── 512.hs ├── 514.hs ├── 515.hs ├── 516.hs ├── 517.hs ├── 519.hs ├── 52.hs ├── 523.hs ├── 527.hs ├── 53.hs ├── 537.hs ├── 54.hs ├── 543.hs ├── 545.hs ├── 55.hs ├── 56.hs ├── 561.hs ├── 57.hs ├── 58.hs ├── 59.hs ├── 6.hs ├── 60.hs ├── 61.hs ├── 62.hs ├── 63.hs ├── 64.hs ├── 65.hs ├── 66.hs ├── 67.hs ├── 68.hs ├── 69.hs ├── 7.hs ├── 70.hs ├── 71.hs ├── 72.hs ├── 73.hs ├── 74.hs ├── 75.hs ├── 76.hs ├── 77.hs ├── 78.hs ├── 79.hs ├── 8.hs ├── 80.hs ├── 81.hs ├── 82.hs ├── 83.hs ├── 84.hs ├── 85.hs ├── 86.hs ├── 87.hs ├── 88.hs ├── 89.hs ├── 9.hs ├── 90.hs ├── 91.hs ├── 92.hs ├── 93.hs ├── 94.hs ├── 95.hs ├── 96.hs ├── 97.hs ├── 98.hs └── 99.hs /.gitignore: -------------------------------------------------------------------------------- 1 | *.exe 2 | *.hi 3 | *.o 4 | *.swp 5 | *.hp 6 | *.prof 7 | 8 | .stack-work/ 9 | stack.yaml 10 | project-euler-solutions.cabal 11 | 12 | Build/ 13 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright foreverbell (c) 2016 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | GHC = ghc 2 | GHC_FLAGS = -threaded -O2 -fllvm -W -fwarn-tabs 3 | 4 | SOURCE_FILES := $(wildcard Src/*.hs) 5 | OBJECT_FILES := $(patsubst Src/%.hs, Build/%, $(SOURCE_FILES)) 6 | 7 | all: $(OBJECT_FILES) 8 | 9 | build/%: src/%.hs 10 | $(GHC) -iLib -o $@ $(GHC_FLAGS) $< 11 | 12 | %: build/% 13 | 14 | 15 | clean: 16 | rm src/*.o 17 | rm src/*.hi 18 | rm $(OBJECT_FILES) 19 | 20 | .PHONY: clean 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # project-euler-solutions 2 | 3 | ## WARNING! SPOILER ALERT! 4 | 5 | Please, do **NOT** refer to these codes before you fully solve your problem. Copying others code is cheating and it is meaningless. 6 | 7 | ## Description 8 | 9 | My solutions to Project Euler in Haskell. 10 | 11 | Handle: [foreverbell](https://projecteuler.net/profile/foreverbell.png), friend key: 658700_e467bf8d1b99d40348ddabe8736a5ce2. 12 | 13 | ## Build 14 | 15 | Two ways to build one solution. 16 | 17 | ### Makefile 18 | 19 | ```sh 20 | $ make 42 21 | $ Build/42 22 | ``` 23 | 24 | If ghc is complaining about missing packages, see `project-euler-solutions.cabal.in` and `configure` for more details. 25 | 26 | ### stack 27 | 28 | ```sh 29 | ./configure 42 30 | stack init 31 | stack build 32 | stack exec 42 33 | ``` 34 | 35 | ## License 36 | 37 | BSD3 38 | -------------------------------------------------------------------------------- /build/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/foreverbell/project-euler-solutions/c0bf2746aafce9be510892814e2d03e20738bf2b/build/.gitkeep -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Data.List (sort, intercalate) 4 | import System.Directory (getDirectoryContents) 5 | import System.Environment (getArgs) 6 | import Text.Printf (printf) 7 | 8 | template = unlines [ "executable %d" 9 | , " hs-source-dirs: src" 10 | , " main-is: %d.hs" 11 | , " ghc-options: -threaded -O2 -fllvm -W -fwarn-tabs" 12 | , " build-depends: %s" 13 | , " default-language: Haskell2010" 14 | ] ++ "\n" 15 | 16 | packages = intercalate ", " [ "base" 17 | , "project-euler-solutions" 18 | , "array", "vector", "containers" 19 | , "text", "random", "time" 20 | , "parallel", "deepseq", "primitive" 21 | , "data-memocombinators" 22 | , "vector-th-unbox" 23 | ] 24 | 25 | dropSuffix :: FilePath -> FilePath 26 | dropSuffix f = take (length f - 3) f 27 | 28 | filterDots :: [FilePath] -> [FilePath] 29 | filterDots fs = filter (\p -> p /= "." && p /= "..") fs 30 | 31 | main = do 32 | args <- getArgs 33 | fs <- case args of 34 | [] -> map (read . dropSuffix) <$> filterDots <$> getDirectoryContents "src/" :: IO [Int] 35 | xs -> return $ map read args 36 | putStrLn $ printf "found %d haskell file(s)." (length fs) 37 | templateIn <- readFile "project-euler-solutions.cabal.in" 38 | writeFile "project-euler-solutions.cabal" $ templateIn ++ concatMap (\d -> printf template d d packages) (sort fs) 39 | putStrLn "project-euler-solutions.cabal is successfully generated." 40 | -------------------------------------------------------------------------------- /input/p008_input.txt: -------------------------------------------------------------------------------- 1 | 73167176531330624919225119674426574742355349194934 2 | 96983520312774506326239578318016984801869478851843 3 | 85861560789112949495459501737958331952853208805511 4 | 12540698747158523863050715693290963295227443043557 5 | 66896648950445244523161731856403098711121722383113 6 | 62229893423380308135336276614282806444486645238749 7 | 30358907296290491560440772390713810515859307960866 8 | 70172427121883998797908792274921901699720888093776 9 | 65727333001053367881220235421809751254540594752243 10 | 52584907711670556013604839586446706324415722155397 11 | 53697817977846174064955149290862569321978468622482 12 | 83972241375657056057490261407972968652414535100474 13 | 82166370484403199890008895243450658541227588666881 14 | 16427171479924442928230863465674813919123162824586 15 | 17866458359124566529476545682848912883142607690042 16 | 24219022671055626321111109370544217506941658960408 17 | 07198403850962455444362981230987879927244284909188 18 | 84580156166097919133875499200524063689912560717606 19 | 05886116467109405077541002256983155200055935729725 20 | 71636269561882670428252483600823257530420752963450 -------------------------------------------------------------------------------- /input/p013_input.txt: -------------------------------------------------------------------------------- 1 | 37107287533902102798797998220837590246510135740250 2 | 46376937677490009712648124896970078050417018260538 3 | 74324986199524741059474233309513058123726617309629 4 | 91942213363574161572522430563301811072406154908250 5 | 23067588207539346171171980310421047513778063246676 6 | 89261670696623633820136378418383684178734361726757 7 | 28112879812849979408065481931592621691275889832738 8 | 44274228917432520321923589422876796487670272189318 9 | 47451445736001306439091167216856844588711603153276 10 | 70386486105843025439939619828917593665686757934951 11 | 62176457141856560629502157223196586755079324193331 12 | 64906352462741904929101432445813822663347944758178 13 | 92575867718337217661963751590579239728245598838407 14 | 58203565325359399008402633568948830189458628227828 15 | 80181199384826282014278194139940567587151170094390 16 | 35398664372827112653829987240784473053190104293586 17 | 86515506006295864861532075273371959191420517255829 18 | 71693888707715466499115593487603532921714970056938 19 | 54370070576826684624621495650076471787294438377604 20 | 53282654108756828443191190634694037855217779295145 21 | 36123272525000296071075082563815656710885258350721 22 | 45876576172410976447339110607218265236877223636045 23 | 17423706905851860660448207621209813287860733969412 24 | 81142660418086830619328460811191061556940512689692 25 | 51934325451728388641918047049293215058642563049483 26 | 62467221648435076201727918039944693004732956340691 27 | 15732444386908125794514089057706229429197107928209 28 | 55037687525678773091862540744969844508330393682126 29 | 18336384825330154686196124348767681297534375946515 30 | 80386287592878490201521685554828717201219257766954 31 | 78182833757993103614740356856449095527097864797581 32 | 16726320100436897842553539920931837441497806860984 33 | 48403098129077791799088218795327364475675590848030 34 | 87086987551392711854517078544161852424320693150332 35 | 59959406895756536782107074926966537676326235447210 36 | 69793950679652694742597709739166693763042633987085 37 | 41052684708299085211399427365734116182760315001271 38 | 65378607361501080857009149939512557028198746004375 39 | 35829035317434717326932123578154982629742552737307 40 | 94953759765105305946966067683156574377167401875275 41 | 88902802571733229619176668713819931811048770190271 42 | 25267680276078003013678680992525463401061632866526 43 | 36270218540497705585629946580636237993140746255962 44 | 24074486908231174977792365466257246923322810917141 45 | 91430288197103288597806669760892938638285025333403 46 | 34413065578016127815921815005561868836468420090470 47 | 23053081172816430487623791969842487255036638784583 48 | 11487696932154902810424020138335124462181441773470 49 | 63783299490636259666498587618221225225512486764533 50 | 67720186971698544312419572409913959008952310058822 51 | 95548255300263520781532296796249481641953868218774 52 | 76085327132285723110424803456124867697064507995236 53 | 37774242535411291684276865538926205024910326572967 54 | 23701913275725675285653248258265463092207058596522 55 | 29798860272258331913126375147341994889534765745501 56 | 18495701454879288984856827726077713721403798879715 57 | 38298203783031473527721580348144513491373226651381 58 | 34829543829199918180278916522431027392251122869539 59 | 40957953066405232632538044100059654939159879593635 60 | 29746152185502371307642255121183693803580388584903 61 | 41698116222072977186158236678424689157993532961922 62 | 62467957194401269043877107275048102390895523597457 63 | 23189706772547915061505504953922979530901129967519 64 | 86188088225875314529584099251203829009407770775672 65 | 11306739708304724483816533873502340845647058077308 66 | 82959174767140363198008187129011875491310547126581 67 | 97623331044818386269515456334926366572897563400500 68 | 42846280183517070527831839425882145521227251250327 69 | 55121603546981200581762165212827652751691296897789 70 | 32238195734329339946437501907836945765883352399886 71 | 75506164965184775180738168837861091527357929701337 72 | 62177842752192623401942399639168044983993173312731 73 | 32924185707147349566916674687634660915035914677504 74 | 99518671430235219628894890102423325116913619626622 75 | 73267460800591547471830798392868535206946944540724 76 | 76841822524674417161514036427982273348055556214818 77 | 97142617910342598647204516893989422179826088076852 78 | 87783646182799346313767754307809363333018982642090 79 | 10848802521674670883215120185883543223812876952786 80 | 71329612474782464538636993009049310363619763878039 81 | 62184073572399794223406235393808339651327408011116 82 | 66627891981488087797941876876144230030984490851411 83 | 60661826293682836764744779239180335110989069790714 84 | 85786944089552990653640447425576083659976645795096 85 | 66024396409905389607120198219976047599490197230297 86 | 64913982680032973156037120041377903785566085089252 87 | 16730939319872750275468906903707539413042652315011 88 | 94809377245048795150954100921645863754710598436791 89 | 78639167021187492431995700641917969777599028300699 90 | 15368713711936614952811305876380278410754449733078 91 | 40789923115535562561142322423255033685442488917353 92 | 44889911501440648020369068063960672322193204149535 93 | 41503128880339536053299340368006977710650566631954 94 | 81234880673210146739058568557934581403627822703280 95 | 82616570773948327592232845941706525094512325230608 96 | 22918802058777319719839450180888072429661980811197 97 | 77158542502016545090413245809786882778948721859617 98 | 72107838435069186155435662884062257473692284509516 99 | 20849603980134001723930671666823555245252804609722 100 | 53503534226472524250874054075591789781264330331690 -------------------------------------------------------------------------------- /input/p018_input.txt: -------------------------------------------------------------------------------- 1 | 75 2 | 95 64 3 | 17 47 82 4 | 18 35 87 10 5 | 20 04 82 47 65 6 | 19 01 23 75 03 34 7 | 88 02 77 73 07 63 67 8 | 99 65 04 28 06 16 70 92 9 | 41 41 26 56 83 40 80 70 33 10 | 41 48 72 33 47 32 37 16 94 29 11 | 53 71 44 65 25 43 91 52 97 51 14 12 | 70 11 33 28 77 73 17 78 39 68 17 57 13 | 91 71 52 38 17 14 91 43 58 50 27 29 48 14 | 63 66 04 68 89 53 67 30 73 16 69 87 40 31 15 | 04 62 98 27 23 09 70 98 73 93 38 53 60 04 23 -------------------------------------------------------------------------------- /input/p059_cipher.txt: -------------------------------------------------------------------------------- 1 | 2 | 79,59,12,2,79,35,8,28,20,2,3,68,8,9,68,45,0,12,9,67,68,4,7,5,23,27,1,21,79,85,78,79,85,71,38,10,71,27,12,2,79,6,2,8,13,9,1,13,9,8,68,19,7,1,71,56,11,21,11,68,6,3,22,2,14,0,30,79,1,31,6,23,19,10,0,73,79,44,2,79,19,6,28,68,16,6,16,15,79,35,8,11,72,71,14,10,3,79,12,2,79,19,6,28,68,32,0,0,73,79,86,71,39,1,71,24,5,20,79,13,9,79,16,15,10,68,5,10,3,14,1,10,14,1,3,71,24,13,19,7,68,32,0,0,73,79,87,71,39,1,71,12,22,2,14,16,2,11,68,2,25,1,21,22,16,15,6,10,0,79,16,15,10,22,2,79,13,20,65,68,41,0,16,15,6,10,0,79,1,31,6,23,19,28,68,19,7,5,19,79,12,2,79,0,14,11,10,64,27,68,10,14,15,2,65,68,83,79,40,14,9,1,71,6,16,20,10,8,1,79,19,6,28,68,14,1,68,15,6,9,75,79,5,9,11,68,19,7,13,20,79,8,14,9,1,71,8,13,17,10,23,71,3,13,0,7,16,71,27,11,71,10,18,2,29,29,8,1,1,73,79,81,71,59,12,2,79,8,14,8,12,19,79,23,15,6,10,2,28,68,19,7,22,8,26,3,15,79,16,15,10,68,3,14,22,12,1,1,20,28,72,71,14,10,3,79,16,15,10,68,3,14,22,12,1,1,20,28,68,4,14,10,71,1,1,17,10,22,71,10,28,19,6,10,0,26,13,20,7,68,14,27,74,71,89,68,32,0,0,71,28,1,9,27,68,45,0,12,9,79,16,15,10,68,37,14,20,19,6,23,19,79,83,71,27,11,71,27,1,11,3,68,2,25,1,21,22,11,9,10,68,6,13,11,18,27,68,19,7,1,71,3,13,0,7,16,71,28,11,71,27,12,6,27,68,2,25,1,21,22,11,9,10,68,10,6,3,15,27,68,5,10,8,14,10,18,2,79,6,2,12,5,18,28,1,71,0,2,71,7,13,20,79,16,2,28,16,14,2,11,9,22,74,71,87,68,45,0,12,9,79,12,14,2,23,2,3,2,71,24,5,20,79,10,8,27,68,19,7,1,71,3,13,0,7,16,92,79,12,2,79,19,6,28,68,8,1,8,30,79,5,71,24,13,19,1,1,20,28,68,19,0,68,19,7,1,71,3,13,0,7,16,73,79,93,71,59,12,2,79,11,9,10,68,16,7,11,71,6,23,71,27,12,2,79,16,21,26,1,71,3,13,0,7,16,75,79,19,15,0,68,0,6,18,2,28,68,11,6,3,15,27,68,19,0,68,2,25,1,21,22,11,9,10,72,71,24,5,20,79,3,8,6,10,0,79,16,8,79,7,8,2,1,71,6,10,19,0,68,19,7,1,71,24,11,21,3,0,73,79,85,87,79,38,18,27,68,6,3,16,15,0,17,0,7,68,19,7,1,71,24,11,21,3,0,71,24,5,20,79,9,6,11,1,71,27,12,21,0,17,0,7,68,15,6,9,75,79,16,15,10,68,16,0,22,11,11,68,3,6,0,9,72,16,71,29,1,4,0,3,9,6,30,2,79,12,14,2,68,16,7,1,9,79,12,2,79,7,6,2,1,73,79,85,86,79,33,17,10,10,71,6,10,71,7,13,20,79,11,16,1,68,11,14,10,3,79,5,9,11,68,6,2,11,9,8,68,15,6,23,71,0,19,9,79,20,2,0,20,11,10,72,71,7,1,71,24,5,20,79,10,8,27,68,6,12,7,2,31,16,2,11,74,71,94,86,71,45,17,19,79,16,8,79,5,11,3,68,16,7,11,71,13,1,11,6,1,17,10,0,71,7,13,10,79,5,9,11,68,6,12,7,2,31,16,2,11,68,15,6,9,75,79,12,2,79,3,6,25,1,71,27,12,2,79,22,14,8,12,19,79,16,8,79,6,2,12,11,10,10,68,4,7,13,11,11,22,2,1,68,8,9,68,32,0,0,73,79,85,84,79,48,15,10,29,71,14,22,2,79,22,2,13,11,21,1,69,71,59,12,14,28,68,14,28,68,9,0,16,71,14,68,23,7,29,20,6,7,6,3,68,5,6,22,19,7,68,21,10,23,18,3,16,14,1,3,71,9,22,8,2,68,15,26,9,6,1,68,23,14,23,20,6,11,9,79,11,21,79,20,11,14,10,75,79,16,15,6,23,71,29,1,5,6,22,19,7,68,4,0,9,2,28,68,1,29,11,10,79,35,8,11,74,86,91,68,52,0,68,19,7,1,71,56,11,21,11,68,5,10,7,6,2,1,71,7,17,10,14,10,71,14,10,3,79,8,14,25,1,3,79,12,2,29,1,71,0,10,71,10,5,21,27,12,71,14,9,8,1,3,71,26,23,73,79,44,2,79,19,6,28,68,1,26,8,11,79,11,1,79,17,9,9,5,14,3,13,9,8,68,11,0,18,2,79,5,9,11,68,1,14,13,19,7,2,18,3,10,2,28,23,73,79,37,9,11,68,16,10,68,15,14,18,2,79,23,2,10,10,71,7,13,20,79,3,11,0,22,30,67,68,19,7,1,71,8,8,8,29,29,71,0,2,71,27,12,2,79,11,9,3,29,71,60,11,9,79,11,1,79,16,15,10,68,33,14,16,15,10,22,73 3 | -------------------------------------------------------------------------------- /input/p079_keylog.txt: -------------------------------------------------------------------------------- 1 | 319 2 | 680 3 | 180 4 | 690 5 | 129 6 | 620 7 | 762 8 | 689 9 | 762 10 | 318 11 | 368 12 | 710 13 | 720 14 | 710 15 | 629 16 | 168 17 | 160 18 | 689 19 | 716 20 | 731 21 | 736 22 | 729 23 | 316 24 | 729 25 | 729 26 | 710 27 | 769 28 | 290 29 | 719 30 | 680 31 | 318 32 | 389 33 | 162 34 | 289 35 | 162 36 | 718 37 | 729 38 | 319 39 | 790 40 | 680 41 | 890 42 | 362 43 | 319 44 | 760 45 | 316 46 | 729 47 | 380 48 | 319 49 | 728 50 | 716 -------------------------------------------------------------------------------- /input/p107_network.txt: -------------------------------------------------------------------------------- 1 | -,-,-,427,668,495,377,678,-,177,-,-,870,-,869,624,300,609,131,-,251,-,-,-,856,221,514,-,591,762,182,56,-,884,412,273,636,-,-,774 2 | -,-,262,-,-,508,472,799,-,956,578,363,940,143,-,162,122,910,-,729,802,941,922,573,531,539,667,607,-,920,-,-,315,649,937,-,185,102,636,289 3 | -,262,-,-,926,-,958,158,647,47,621,264,81,-,402,813,649,386,252,391,264,637,349,-,-,-,108,-,727,225,578,699,-,898,294,-,575,168,432,833 4 | 427,-,-,-,366,-,-,635,-,32,962,468,893,854,718,427,448,916,258,-,760,909,529,311,404,-,-,588,680,875,-,615,-,409,758,221,-,-,76,257 5 | 668,-,926,366,-,-,-,250,268,-,503,944,-,677,-,727,793,457,981,191,-,-,-,351,969,925,987,328,282,589,-,873,477,-,-,19,450,-,-,- 6 | 495,508,-,-,-,-,-,765,711,819,305,302,926,-,-,582,-,861,-,683,293,-,-,66,-,27,-,-,290,-,786,-,554,817,33,-,54,506,386,381 7 | 377,472,958,-,-,-,-,-,-,120,42,-,134,219,457,639,538,374,-,-,-,966,-,-,-,-,-,449,120,797,358,232,550,-,305,997,662,744,686,239 8 | 678,799,158,635,250,765,-,-,-,35,-,106,385,652,160,-,890,812,605,953,-,-,-,79,-,712,613,312,452,-,978,900,-,901,-,-,225,533,770,722 9 | -,-,647,-,268,711,-,-,-,283,-,172,-,663,236,36,403,286,986,-,-,810,761,574,53,793,-,-,777,330,936,883,286,-,174,-,-,-,828,711 10 | 177,956,47,32,-,819,120,35,283,-,50,-,565,36,767,684,344,489,565,-,-,103,810,463,733,665,494,644,863,25,385,-,342,470,-,-,-,730,582,468 11 | -,578,621,962,503,305,42,-,-,50,-,155,519,-,-,256,990,801,154,53,474,650,402,-,-,-,966,-,-,406,989,772,932,7,-,823,391,-,-,933 12 | -,363,264,468,944,302,-,106,172,-,155,-,-,-,380,438,-,41,266,-,-,104,867,609,-,270,861,-,-,165,-,675,250,686,995,366,191,-,433,- 13 | 870,940,81,893,-,926,134,385,-,565,519,-,-,313,851,-,-,-,248,220,-,826,359,829,-,234,198,145,409,68,359,-,814,218,186,-,-,929,203,- 14 | -,143,-,854,677,-,219,652,663,36,-,-,313,-,132,-,433,598,-,-,168,870,-,-,-,128,437,-,383,364,966,227,-,-,807,993,-,-,526,17 15 | 869,-,402,718,-,-,457,160,236,767,-,380,851,132,-,-,596,903,613,730,-,261,-,142,379,885,89,-,848,258,112,-,900,-,-,818,639,268,600,- 16 | 624,162,813,427,727,582,639,-,36,684,256,438,-,-,-,-,539,379,664,561,542,-,999,585,-,-,321,398,-,-,950,68,193,-,697,-,390,588,848,- 17 | 300,122,649,448,793,-,538,890,403,344,990,-,-,433,596,539,-,-,73,-,318,-,-,500,-,968,-,291,-,-,765,196,504,757,-,542,-,395,227,148 18 | 609,910,386,916,457,861,374,812,286,489,801,41,-,598,903,379,-,-,-,946,136,399,-,941,707,156,757,258,251,-,807,-,-,-,461,501,-,-,616,- 19 | 131,-,252,258,981,-,-,605,986,565,154,266,248,-,613,664,73,-,-,686,-,-,575,627,817,282,-,698,398,222,-,649,-,-,-,-,-,654,-,- 20 | -,729,391,-,191,683,-,953,-,-,53,-,220,-,730,561,-,946,686,-,-,389,729,553,304,703,455,857,260,-,991,182,351,477,867,-,-,889,217,853 21 | 251,802,264,760,-,293,-,-,-,-,474,-,-,168,-,542,318,136,-,-,-,-,392,-,-,-,267,407,27,651,80,927,-,974,977,-,-,457,117,- 22 | -,941,637,909,-,-,966,-,810,103,650,104,826,870,261,-,-,399,-,389,-,-,-,202,-,-,-,-,867,140,403,962,785,-,511,-,1,-,707,- 23 | -,922,349,529,-,-,-,-,761,810,402,867,359,-,-,999,-,-,575,729,392,-,-,388,939,-,959,-,83,463,361,-,-,512,931,-,224,690,369,- 24 | -,573,-,311,351,66,-,79,574,463,-,609,829,-,142,585,500,941,627,553,-,202,388,-,164,829,-,620,523,639,936,-,-,490,-,695,-,505,109,- 25 | 856,531,-,404,969,-,-,-,53,733,-,-,-,-,379,-,-,707,817,304,-,-,939,164,-,-,616,716,728,-,889,349,-,963,150,447,-,292,586,264 26 | 221,539,-,-,925,27,-,712,793,665,-,270,234,128,885,-,968,156,282,703,-,-,-,829,-,-,-,822,-,-,-,736,576,-,697,946,443,-,205,194 27 | 514,667,108,-,987,-,-,613,-,494,966,861,198,437,89,321,-,757,-,455,267,-,959,-,616,-,-,-,349,156,339,-,102,790,359,-,439,938,809,260 28 | -,607,-,588,328,-,449,312,-,644,-,-,145,-,-,398,291,258,698,857,407,-,-,620,716,822,-,-,293,486,943,-,779,-,6,880,116,775,-,947 29 | 591,-,727,680,282,290,120,452,777,863,-,-,409,383,848,-,-,251,398,260,27,867,83,523,728,-,349,293,-,212,684,505,341,384,9,992,507,48,-,- 30 | 762,920,225,875,589,-,797,-,330,25,406,165,68,364,258,-,-,-,222,-,651,140,463,639,-,-,156,486,212,-,-,349,723,-,-,186,-,36,240,752 31 | 182,-,578,-,-,786,358,978,936,385,989,-,359,966,112,950,765,807,-,991,80,403,361,936,889,-,339,943,684,-,-,965,302,676,725,-,327,134,-,147 32 | 56,-,699,615,873,-,232,900,883,-,772,675,-,227,-,68,196,-,649,182,927,962,-,-,349,736,-,-,505,349,965,-,474,178,833,-,-,555,853,- 33 | -,315,-,-,477,554,550,-,286,342,932,250,814,-,900,193,504,-,-,351,-,785,-,-,-,576,102,779,341,723,302,474,-,689,-,-,-,451,-,- 34 | 884,649,898,409,-,817,-,901,-,470,7,686,218,-,-,-,757,-,-,477,974,-,512,490,963,-,790,-,384,-,676,178,689,-,245,596,445,-,-,343 35 | 412,937,294,758,-,33,305,-,174,-,-,995,186,807,-,697,-,461,-,867,977,511,931,-,150,697,359,6,9,-,725,833,-,245,-,949,-,270,-,112 36 | 273,-,-,221,19,-,997,-,-,-,823,366,-,993,818,-,542,501,-,-,-,-,-,695,447,946,-,880,992,186,-,-,-,596,949,-,91,-,768,273 37 | 636,185,575,-,450,54,662,225,-,-,391,191,-,-,639,390,-,-,-,-,-,1,224,-,-,443,439,116,507,-,327,-,-,445,-,91,-,248,-,344 38 | -,102,168,-,-,506,744,533,-,730,-,-,929,-,268,588,395,-,654,889,457,-,690,505,292,-,938,775,48,36,134,555,451,-,270,-,248,-,371,680 39 | -,636,432,76,-,386,686,770,828,582,-,433,203,526,600,848,227,616,-,217,117,707,369,109,586,205,809,-,-,240,-,853,-,-,-,768,-,371,-,540 40 | 774,289,833,257,-,381,239,722,711,468,933,-,-,17,-,-,148,-,-,853,-,-,-,-,264,194,260,947,-,752,147,-,-,343,112,273,344,680,540,- -------------------------------------------------------------------------------- /input/p185_input.txt: -------------------------------------------------------------------------------- 1 | 5616185650518293 2 2 | 3847439647293047 1 3 | 5855462940810587 3 4 | 9742855507068353 3 5 | 4296849643607543 3 6 | 3174248439465858 1 7 | 4513559094146117 2 8 | 7890971548908067 3 9 | 8157356344118483 1 10 | 2615250744386899 2 11 | 8690095851526254 3 12 | 6375711915077050 1 13 | 6913859173121360 1 14 | 6442889055042768 2 15 | 2321386104303845 0 16 | 2326509471271448 2 17 | 5251583379644322 2 18 | 1748270476758276 3 19 | 4895722652190306 1 20 | 3041631117224635 3 21 | 1841236454324589 3 22 | 2659862637316867 2 23 | -------------------------------------------------------------------------------- /input/p345_input.txt: -------------------------------------------------------------------------------- 1 | 7 53 183 439 863 497 383 563 79 973 287 63 343 169 583 2 | 627 343 773 959 943 767 473 103 699 303 957 703 583 639 913 3 | 447 283 463 29 23 487 463 993 119 883 327 493 423 159 743 4 | 217 623 3 399 853 407 103 983 89 463 290 516 212 462 350 5 | 960 376 682 962 300 780 486 502 912 800 250 346 172 812 350 6 | 870 456 192 162 593 473 915 45 989 873 823 965 425 329 803 7 | 973 965 905 919 133 673 665 235 509 613 673 815 165 992 326 8 | 322 148 972 962 286 255 941 541 265 323 925 281 601 95 973 9 | 445 721 11 525 473 65 511 164 138 672 18 428 154 448 848 10 | 414 456 310 312 798 104 566 520 302 248 694 976 430 392 198 11 | 184 829 373 181 631 101 969 613 840 740 778 458 284 760 390 12 | 821 461 843 513 17 901 711 993 293 157 274 94 192 156 574 13 | 34 124 4 878 450 476 712 914 838 669 875 299 823 329 699 14 | 815 559 813 459 522 788 168 586 966 232 308 833 251 631 107 15 | 813 883 451 509 615 77 281 613 459 205 380 274 302 35 805 16 | -------------------------------------------------------------------------------- /lib/Common/DataStructure/Fenwick.hs: -------------------------------------------------------------------------------- 1 | module Common.DataStructure.Fenwick ( 2 | Fenwick 3 | , make 4 | , ask 5 | , askLR 6 | , modify 7 | ) where 8 | 9 | import Control.Monad (liftM, liftM2, forM_) 10 | import Control.Monad.Primitive 11 | import Data.Bits ((.&.)) 12 | import Data.List (foldl') 13 | import qualified Data.Vector.Unboxed.Mutable as MV 14 | 15 | newtype (PrimMonad m, Num e, MV.Unbox e) => Fenwick m e = Fenwick (MV.MVector (PrimState m) e) 16 | 17 | {-# INLINABLE make #-} 18 | {-# INLINABLE ask #-} 19 | {-# INLINABLE askLR #-} 20 | {-# INLINABLE modify #-} 21 | 22 | make :: (PrimMonad m, Num e, MV.Unbox e) => Int -> m (Fenwick m e) 23 | make n = liftM Fenwick (MV.replicate (n + 1) 0) 24 | 25 | ask :: (PrimMonad m, Num e, MV.Unbox e) => Fenwick m e -> (e -> e -> e) -> Int -> m e 26 | ask _ _ 0 = return 0 27 | ask (Fenwick fenwick) f x = liftM (foldl' f 0) $ mapM (MV.unsafeRead fenwick) xs 28 | where 29 | xs = takeWhile (> 0) $ iterate (\x -> x - (x .&. (-x))) x 30 | 31 | askLR :: (PrimMonad m, Num e, MV.Unbox e) => Fenwick m e -> (e -> e -> e) -> Int -> Int -> m e 32 | askLR fenwick f l r 33 | | l <= r = liftM2 f (ask fenwick f r) (liftM negate (ask fenwick f (l - 1))) 34 | | otherwise = return 0 35 | 36 | modify :: (PrimMonad m, Num e, MV.Unbox e) => Fenwick m e -> (e -> e -> e) -> Int -> e -> m () 37 | modify (Fenwick fenwick) f x d = forM_ xs $ \i -> MV.unsafeModify fenwick (f d) i 38 | where 39 | xs = takeWhile (<= n) $ iterate (\x -> x + (x .&. (-x))) x 40 | n = MV.length fenwick - 1 41 | -------------------------------------------------------------------------------- /lib/Common/DataStructure/UnionFind.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts, FlexibleInstances, RankNTypes #-} 2 | 3 | module Common.DataStructure.UnionFind ( 4 | UFSet 5 | , make 6 | , find 7 | , union 8 | ) where 9 | 10 | import Control.Monad (liftM2) 11 | import Control.Monad.Primitive 12 | import qualified Common.MonadRef as R 13 | import qualified Data.Vector.Unboxed as V 14 | import qualified Data.Vector.Unboxed.Mutable as MV 15 | 16 | data (PrimMonad m, R.MonadRef r m) => UFSet r m = UFSet { 17 | ufsSize :: r Int, 18 | ufsSet :: MV.MVector (PrimState m) Int 19 | } 20 | 21 | make :: (PrimMonad m, R.MonadRef r m) => Int -> m (UFSet r m) 22 | make n = liftM2 UFSet (R.new n) (V.thaw $ V.fromList [0 .. n - 1]) 23 | 24 | find :: (PrimMonad m, R.MonadRef r m) => UFSet r m -> Int -> m Int 25 | find ufs u = do 26 | f <- MV.unsafeRead (ufsSet ufs) u 27 | if u == f 28 | then return u 29 | else do 30 | f' <- find ufs f 31 | MV.unsafeWrite (ufsSet ufs) u f' 32 | return f' 33 | 34 | union :: (PrimMonad m, R.MonadRef r m) => UFSet r m -> Int -> Int -> m Bool 35 | union ufs u v = do 36 | u' <- find ufs u 37 | v' <- find ufs v 38 | if u' /= v' 39 | then do 40 | MV.unsafeWrite (ufsSet ufs) u' v' 41 | R.modify_' (ufsSize ufs) pred 42 | return True 43 | else return False 44 | -------------------------------------------------------------------------------- /lib/Common/List.hs: -------------------------------------------------------------------------------- 1 | module Common.List ( 2 | rotate 3 | , minus 4 | , intersect 5 | , nub' 6 | , unique 7 | , maximumBy' 8 | , minimumBy' 9 | , maximum' 10 | , minimum' 11 | ) where 12 | 13 | import Data.List (foldl1', group) 14 | import qualified Data.Set as S 15 | 16 | {-# INLINABLE rotate #-} 17 | {-# INLINABLE minus #-} 18 | {-# INLINABLE intersect #-} 19 | {-# INLINABLE nub' #-} 20 | {-# INLINABLE unique #-} 21 | {-# INLINABLE maximumBy' #-} 22 | {-# INLINABLE minimumBy' #-} 23 | {-# INLINABLE maximum' #-} 24 | {-# INLINABLE minimum' #-} 25 | 26 | rotate :: Int -> [a] -> [a] 27 | rotate n xs = take (length xs) (drop n (cycle xs)) 28 | 29 | -- set differeance (assert already sorted) 30 | minus :: (Ord a) => [a] -> [a] -> [a] 31 | minus xs [] = xs 32 | minus [] _ = [] 33 | minus xs'@(x:xs) ys'@(y:ys) = case compare x y of 34 | LT -> x : xs `minus` ys' 35 | EQ -> xs `minus` ys 36 | GT -> xs' `minus` ys 37 | 38 | -- set intersection (assert already sorted) 39 | intersect :: (Ord a) => [a] -> [a] -> [a] 40 | intersect [] _ = [] 41 | intersect _ [] = [] 42 | intersect xs'@(x:xs) ys'@(y:ys) = case compare x y of 43 | EQ -> x : xs `intersect` ys 44 | LT -> xs `intersect` ys' 45 | GT -> xs' `intersect` ys 46 | 47 | nub' :: (Ord a) => [a] -> [a] 48 | nub' = S.toList . S.fromList 49 | 50 | -- test if one list has a unique element 51 | unique :: (Eq a) => [a] -> Bool 52 | unique xs = 1 == length (group xs) 53 | 54 | maximumBy' :: (a -> a -> Ordering) -> [a] -> a 55 | maximumBy' _ [] = undefined 56 | maximumBy' cmp xs = foldl1' helper xs 57 | where 58 | helper a b = case cmp a b of 59 | LT -> b 60 | _ -> a 61 | 62 | minimumBy' :: (a -> a -> Ordering) -> [a] -> a 63 | minimumBy' _ [] = undefined 64 | minimumBy' cmp xs = foldl1' helper xs 65 | where 66 | helper a b = case cmp a b of 67 | GT -> b 68 | _ -> a 69 | 70 | maximum' :: Ord a => [a] -> a 71 | maximum' = foldl1' max 72 | 73 | minimum' :: Ord a => [a] -> a 74 | minimum' = foldl1' min 75 | -------------------------------------------------------------------------------- /lib/Common/MapReduce.hs: -------------------------------------------------------------------------------- 1 | module Common.MapReduce ( 2 | mapReduce 3 | , mapReduce' 4 | ) where 5 | 6 | import Control.Parallel.Strategies (parMap, rdeepseq, using, NFData) 7 | import Control.Parallel (pseq) 8 | 9 | {-# INLINABLE divide #-} 10 | {-# INLINABLE mapReduce #-} 11 | {-# INLINABLE mapReduce' #-} 12 | 13 | divide :: Int -> [a] -> [[a]] 14 | divide _ [] = [] 15 | divide n xs = as : divide n bs where (as, bs) = splitAt n xs 16 | 17 | mapReduce :: (NFData b, NFData c) => Int -> (a -> b) -> ([b] -> c) -> [a] -> c 18 | mapReduce chunk mapFunc reduceFunc xs = mapResult `pseq` reduceResult 19 | where 20 | mapResult = concat $ parMap rdeepseq (map mapFunc) (divide chunk xs) 21 | reduceResult = reduceFunc mapResult `using` rdeepseq 22 | 23 | mapReduce' :: (NFData b) => Int -> Int -> (a -> b) -> ([b] -> b) -> [a] -> b 24 | mapReduce' block chunk mapFunc reduceFunc xs = fstReduce `pseq` sndReduce 25 | where 26 | fstReduce = map (mapReduce chunk mapFunc reduceFunc) (divide block xs) 27 | sndReduce = reduceFunc fstReduce `using` rdeepseq 28 | -------------------------------------------------------------------------------- /lib/Common/Matrix/LICENSE: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/foreverbell/project-euler-solutions/c0bf2746aafce9be510892814e2d03e20738bf2b/lib/Common/Matrix/LICENSE -------------------------------------------------------------------------------- /lib/Common/Matrix/Matrix.hs: -------------------------------------------------------------------------------- 1 | -- modified from https://github.com/Daniel-Diaz/matrix for my specific use. 2 | 3 | module Common.Matrix.Matrix ( 4 | Matrix, 5 | rows, cols, 6 | fmap, 7 | (!), (!.), getElem, safeGet, unsafeGet, 8 | getRow, getCol, 9 | fromList, toList, fromLists, toLists, 10 | create, 11 | zero, identity, scalar, 12 | add, subtract, multiply, 13 | power 14 | ) where 15 | 16 | import Prelude hiding (subtract, fmap) 17 | import Data.Bits (Bits, shiftR, (.&.)) 18 | import Data.Maybe (fromMaybe) 19 | import qualified Data.Vector.Unboxed as V 20 | import qualified Data.Vector as RV 21 | 22 | data V.Unbox a => Matrix a = Matrix { 23 | rows :: {-# UNPACK #-} !Int, 24 | cols :: {-# UNPACK #-} !Int, 25 | vect :: V.Vector a 26 | } deriving (Eq, Show) 27 | 28 | encode :: Int -> (Int, Int) -> Int 29 | {-# INLINE encode #-} 30 | encode m (i, j) = (i - 1) * m + j - 1 31 | 32 | fmap :: V.Unbox a => (a -> a) -> Matrix a -> Matrix a 33 | {-# INLINE fmap #-} 34 | fmap f (Matrix r c v) = Matrix r c $ V.map f v 35 | 36 | getElem :: V.Unbox a => Int -> Int -> Matrix a -> a 37 | {-# INLINE getElem #-} 38 | getElem i j m = fromMaybe (error "getElem: out of bound.") (safeGet i j m) 39 | 40 | (!) :: V.Unbox a => Matrix a -> (Int, Int) -> a 41 | {-# INLINE (!) #-} 42 | m ! (i, j) = getElem i j m 43 | 44 | (!.) :: V.Unbox a => Matrix a -> (Int, Int) -> a 45 | {-# INLINE (!.) #-} 46 | m !. (i, j) = unsafeGet i j m 47 | 48 | safeGet :: V.Unbox a => Int -> Int -> Matrix a -> Maybe a 49 | {-# INLINE safeGet #-} 50 | safeGet i j m@(Matrix r c _) 51 | | i < 1 || j < 1 || i > r || j > c = Nothing 52 | | otherwise = Just $ unsafeGet i j m 53 | 54 | unsafeGet :: V.Unbox a => Int -> Int -> Matrix a -> a 55 | {-# INLINE unsafeGet #-} 56 | unsafeGet i j (Matrix _ c v) = V.unsafeIndex v $ encode c (i, j) 57 | 58 | getRow :: V.Unbox a => Int -> Matrix a -> V.Vector a 59 | {-# INLINE getRow #-} 60 | getRow i (Matrix _ m v) = V.slice (m * (i - 1)) m v 61 | 62 | getCol :: V.Unbox a => Int -> Matrix a -> V.Vector a 63 | {-# INLINE getCol #-} 64 | getCol j (Matrix n m v) = V.generate n $ \i -> v V.! encode m (i + 1, j) 65 | 66 | create :: V.Unbox a => Int -> Int -> ((Int, Int) -> a) -> Matrix a 67 | {-# INLINE create #-} 68 | create n m f = Matrix n m $ V.fromList [ f (i, j) | i <- [1 .. n], j <- [1 .. m] ] 69 | 70 | fromList :: V.Unbox a => Int -> Int -> [a] -> Matrix a 71 | {-# INLINE fromList #-} 72 | fromList n m = Matrix n m . V.fromListN (n * m) 73 | 74 | fromLists :: V.Unbox a => [[a]] -> Matrix a 75 | {-# INLINE fromLists #-} 76 | fromLists [] = error "fromLists: empty list." 77 | fromLists (xs:xss) = fromList n m $ concat $ xs : map (take m) xss where 78 | n = 1 + length xss 79 | m = length xs 80 | 81 | toList :: V.Unbox a => Matrix a -> [a] 82 | {-# INLINE toList #-} 83 | toList m@(Matrix r c _) = [ unsafeGet i j m | i <- [1 .. r] , j <- [1 .. c] ] 84 | 85 | toLists :: V.Unbox a => Matrix a -> [[a]] 86 | {-# INLINE toLists #-} 87 | toLists m@(Matrix r c _) = [ [ unsafeGet i j m | j <- [1 .. c] ] | i <- [1 .. r] ] 88 | 89 | zero :: (V.Unbox a, Num a) => Int -> Int -> Matrix a 90 | {-# INLINE zero #-} 91 | zero n m = Matrix n m $ V.replicate (n * m) 0 92 | 93 | scalar :: (V.Unbox a, Num a) => Int -> a -> Matrix a 94 | {-# INLINE scalar #-} 95 | scalar n x = create n n $ \(i, j) -> if i == j then x else 0 96 | 97 | identity :: (V.Unbox a, Num a) => Int -> Matrix a 98 | {-# INLINE identity #-} 99 | identity n = scalar n 1 100 | 101 | add :: (V.Unbox a, Num a) => Matrix a -> Matrix a -> Matrix a 102 | {-# INLINE add #-} 103 | add (Matrix r1 c1 v1) (Matrix r2 c2 v2) 104 | | r1 == r2 && c1 == c2 = Matrix r1 c1 $ V.zipWith (+) v1 v2 105 | | otherwise = error "add: matrix size not match." 106 | 107 | subtract :: (V.Unbox a, Num a) => Matrix a -> Matrix a -> Matrix a 108 | {-# INLINE subtract #-} 109 | subtract (Matrix r1 c1 v1) (Matrix r2 c2 v2) 110 | | r1 == r2 && c1 == c2 = Matrix r1 c1 $ V.zipWith (-) v1 v2 111 | | otherwise = error "subtract: matrix size not match." 112 | 113 | multiply :: (V.Unbox a, Num a) => Matrix a -> Matrix a -> Matrix a 114 | {-# INLINE multiply #-} 115 | multiply m1@(Matrix _ c _) m2@(Matrix r _ _) 116 | | c == r = multiply' m1 m2 117 | | otherwise = error "multiply: matrix size not match." 118 | 119 | multiply' :: (V.Unbox a, Num a) => Matrix a -> Matrix a -> Matrix a 120 | {-# INLINE multiply' #-} 121 | multiply' m1@(Matrix r _ _) m2@(Matrix _ c _) = create r c $ \(i, j) -> dotProduct (RV.unsafeIndex avs $ i - 1) (RV.unsafeIndex bvs $ j - 1) where 122 | avs = RV.generate r $ \i -> getRow (i + 1) m1 123 | bvs = RV.generate c $ \i -> getCol (i + 1) m2 124 | dotProduct v1 v2 = V.foldl' (+) 0 $ V.zipWith (*) v1 v2 125 | 126 | power :: (Integral a, Bits a, V.Unbox b, Num b) => Matrix b -> a -> Matrix b 127 | {-# INLINE power #-} 128 | power m@(Matrix r c _) p 129 | | r == c = helper m p $ identity r 130 | | otherwise = error "power: matrix not squared." 131 | where 132 | helper _ 0 ret = ret 133 | helper a x ret = if (x .&. 1) == 1 134 | then helper a' x' (multiply' ret a) 135 | else helper a' x' ret where 136 | a' = multiply' a a 137 | x' = x `shiftR` 1 138 | -------------------------------------------------------------------------------- /lib/Common/MonadRef.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} 2 | 3 | module Common.MonadRef ( 4 | MonadRef (..) 5 | ) where 6 | 7 | import Control.Monad.ST (ST) 8 | import Control.Monad (void) 9 | import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef, modifyIORef') 10 | import Data.STRef (STRef, newSTRef, readSTRef, writeSTRef, modifySTRef, modifySTRef') 11 | 12 | import Prelude hiding (read) 13 | 14 | class Monad m => MonadRef r m | m -> r where 15 | {-# MINIMAL new, read, write, (modify_ | modify), (modify_' | modify') #-} 16 | 17 | new :: a -> m (r a) 18 | read :: r a -> m a 19 | write :: r a -> a -> m () 20 | 21 | modify_, modify_' :: r a -> (a -> a) -> m () 22 | modify_ r f = void $ modify r f 23 | modify_' r f = void $ modify' r f 24 | 25 | modify, modify' :: r a -> (a -> a) -> m a 26 | modify r f = modify_ r f >> read r 27 | modify' r f = modify_' r f >> read r 28 | 29 | instance MonadRef IORef IO where 30 | new = newIORef 31 | read = readIORef 32 | write = writeIORef 33 | modify_ = modifyIORef 34 | modify_' = modifyIORef' 35 | 36 | instance MonadRef (STRef s) (ST s) where 37 | new = newSTRef 38 | read = readSTRef 39 | write = writeSTRef 40 | modify_ = modifySTRef 41 | modify_' = modifySTRef' 42 | -------------------------------------------------------------------------------- /lib/Common/NumMod/MkNumMod.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module Common.NumMod.MkNumMod ( 4 | mkNumMod 5 | ) where 6 | 7 | import Language.Haskell.TH 8 | import Data.Vector.Unboxed.Deriving 9 | 10 | apprem :: Int -> Bool -> Exp -> Exp 11 | apprem n needMod e = UInfixE (ParensE e) remE (LitE (IntegerL $ fromIntegral n)) 12 | where 13 | remE = if needMod then VarE 'mod else VarE 'rem 14 | 15 | inline :: Name -> [Dec] -> [Dec] 16 | inline name = (:) pragma 17 | where 18 | pragma = PragmaD (InlineP name Inline FunLike AllPhases) 19 | 20 | wrapper :: Int -> Name 21 | wrapper n = mkName $ "Int" ++ show n 22 | 23 | unwrapper :: Int -> Name 24 | unwrapper n = mkName $ "fromInt" ++ show n 25 | 26 | wrap :: Int -> Exp -> Exp 27 | wrap n e = RecConE (wrapper n) [(unwrapper n, e)] 28 | 29 | unwrap :: Int -> Exp -> Exp 30 | unwrap n e = VarE (unwrapper n) `AppE` e 31 | 32 | mkVar :: Int -> Name -> Exp 33 | mkVar n = unwrap n . VarE 34 | 35 | mkShow :: Int -> [Dec] 36 | mkShow n = inline m [ FunD m [ Clause [VarP x] (NormalB $ VarE 'show `AppE` apprem n True (mkVar n x)) [] ] ] 37 | where 38 | m = mkName "show" 39 | x = mkName "x" 40 | 41 | mkBOp :: Int -> Bool -> Exp -> Name -> [Dec] 42 | mkBOp n canOverflow0 op opName = inline opName [ FunD opName [ Clause [VarP a, VarP b] (NormalB $ wrap n . dropInteger . apprem n False $ UInfixE var1 op var2) [] ] ] 43 | where 44 | a = mkName "a" 45 | b = mkName "b" 46 | canOverflow = n >= 2^31 && canOverflow0 47 | liftInteger | canOverflow = AppE (VarE 'toInteger) 48 | | otherwise = id 49 | dropInteger | canOverflow = AppE (VarE 'fromInteger) 50 | | otherwise = id 51 | var1 = liftInteger $ mkVar n a 52 | var2 = liftInteger $ mkVar n b 53 | 54 | mkAddition :: Int -> [Dec] 55 | mkAddition n = mkBOp n False (VarE '(+)) (mkName "+") 56 | 57 | mkSubtract :: Int -> [Dec] 58 | mkSubtract n = mkBOp n False (VarE '(-)) (mkName "-") 59 | 60 | mkMultiply :: Int -> [Dec] 61 | mkMultiply n = mkBOp n True (VarE '(*)) (mkName "*") 62 | 63 | mkFromInteger :: Int -> [Dec] 64 | mkFromInteger n = inline m [ FunD m [ Clause [VarP a] (NormalB $ wrap n e) [] ] ] 65 | where 66 | m = mkName "fromInteger" 67 | a = mkName "a" 68 | e = VarE 'fromIntegral `AppE` apprem n False (VarE a) 69 | 70 | mkUndefined :: Name -> [Dec] 71 | mkUndefined m = [ FunD m [ Clause [WildP] (NormalB $ VarE 'undefined) [] ] ] 72 | 73 | mkAbs :: Int -> [Dec] 74 | mkAbs _ = mkUndefined m 75 | where 76 | m = mkName "abs" 77 | 78 | mkSignum :: Int -> [Dec] 79 | mkSignum _ = mkUndefined m 80 | where 81 | m = mkName "signum" 82 | 83 | mkNumMod :: Bool -> Int -> DecsQ 84 | mkNumMod enableUnbox n = do 85 | let typeName = wrapper n 86 | let typeNum = DataD [] typeName [] [RecC typeName [(unwrapper n, Unpacked, ConT ''Int)]] [] 87 | let instanceShow = InstanceD [] (ConT ''Show `AppT` ConT typeName) (mkShow n) 88 | let instanceNum = InstanceD [] (ConT ''Num `AppT` ConT typeName) $ 89 | concatMap ($ n) [mkAddition, mkSubtract, mkMultiply, mkFromInteger, mkAbs, mkSignum] 90 | instanceUnbox <- do 91 | let var = mkName "x" 92 | if enableUnbox 93 | then derivingUnbox (show typeName) 94 | (return $ ArrowT `AppT` ConT typeName `AppT` ConT ''Int) 95 | (return $ LamE [VarP var] (unwrap n (VarE var))) 96 | (return $ LamE [VarP var] (wrap n (VarE var))) 97 | else return [] 98 | return $ [typeNum, instanceShow, instanceNum] ++ instanceUnbox 99 | 100 | {- mkNumMod True 42 101 | ======> 102 | data Int42 = Int42 { fromInt42 :: {-# UNPACK #-} !Int } 103 | instance Show Int42 104 | instance Num Int42 (@abs@ and @signum@ are set to undefined) 105 | instances for Vector Unbox (optional) 106 | -} 107 | -------------------------------------------------------------------------------- /lib/Common/NumMod/NumMod.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeFamilies #-} 2 | 3 | module Common.NumMod.NumMod ( 4 | IntMod 5 | , fromInteger_ 6 | , fromInt 7 | , toInt 8 | ) where 9 | 10 | import Prelude 11 | import qualified Prelude as P 12 | import Data.Vector.Unboxed.Deriving 13 | 14 | data IntMod = IntMod {-# UNPACK #-} !Int {-# UNPACK #-} !Int 15 | 16 | instance Show IntMod where 17 | show (IntMod n _) = show n 18 | 19 | instance Num IntMod where 20 | {-# INLINE (+) #-} 21 | {-# INLINE (-) #-} 22 | {-# INLINE (*) #-} 23 | {-# INLINE fromInteger #-} 24 | 25 | (+) x (IntMod 0 0) = x 26 | (+) (IntMod 0 0) x = x 27 | (+) (IntMod a m1) (IntMod b m2) = 28 | if m1 == m2 && m1 /= 0 29 | then IntMod ((a + b) `mod` m1) m1 30 | else undefined 31 | 32 | (-) x (IntMod 0 0) = x 33 | (-) (IntMod 0 0) (IntMod b m) = if m /= 0 then IntMod ((-b) `mod` m) m else undefined 34 | (-) (IntMod a m1) (IntMod b m2) = 35 | if m1 == m2 && m1 /= 0 36 | then IntMod ((a - b) `mod` m1) m1 37 | else undefined 38 | 39 | (*) (IntMod 0 0) (IntMod 0 0) = IntMod 0 0 40 | (*) (IntMod a m) (IntMod b 0) = IntMod ((a * b) `mod` m) m 41 | (*) (IntMod a 0) (IntMod b m) = IntMod ((a * b) `mod` m) m 42 | (*) (IntMod a m1) (IntMod b m2) = 43 | if m1 == m2 && m1 /= 0 44 | then if m1 >= 2^31 45 | then IntMod (fromInteger $ (toInteger a * toInteger b) `mod` toInteger m1) m1 46 | else IntMod ((a * b) `mod` m1) m1 47 | else undefined 48 | 49 | -- Wild 0/1 50 | fromInteger 0 = IntMod 0 0 51 | fromInteger 1 = IntMod 1 0 52 | fromInteger _ = undefined 53 | 54 | abs _ = undefined 55 | signum _ = undefined 56 | 57 | derivingUnbox "IntMod" 58 | [t| IntMod -> (Int, Int) |] 59 | [| \(IntMod n m) -> (n, m) |] 60 | [| \(n, m) -> IntMod n m |] -- unbox deriving is transparent to users, n `mod` m is not needed. 61 | 62 | {-# INLINE fromInteger_ #-} 63 | {-# INLINE fromInt #-} 64 | {-# INLINE toInt #-} 65 | 66 | fromInteger_ :: Int -> Integer -> IntMod 67 | fromInteger_ m a | m > 0 = IntMod (P.fromInteger $ a `mod` m') m 68 | | otherwise = error "invalid modulo" 69 | where 70 | m' = P.toInteger m 71 | 72 | fromInt :: Int -> Int -> IntMod 73 | fromInt m a | m > 0 = IntMod (a `mod` m) m 74 | | otherwise = error "invalid modulo" 75 | 76 | toInt :: IntMod -> Int 77 | toInt (IntMod n _) = n 78 | -------------------------------------------------------------------------------- /lib/Common/Numbers/EulerPhi.hs: -------------------------------------------------------------------------------- 1 | module Common.Numbers.EulerPhi ( 2 | phi 3 | , phiTo 4 | ) where 5 | 6 | import Common.Utils (if') 7 | import Common.Numbers.Primes (primes', countPrimeApprox) 8 | import qualified Common.MonadRef as R 9 | import Control.Monad (when, forM_) 10 | import Control.Monad.Trans.Loop (iterateLoopT, exit) 11 | import Control.Monad.Trans.Class (lift) 12 | import qualified Data.Vector.Unboxed.Mutable as MV 13 | import qualified Data.Vector.Unboxed as V 14 | 15 | phi :: Int -> Int 16 | phi n = loop 1 n primes' 17 | where 18 | loop :: Int -> Int -> [Int] -> Int 19 | loop ret 1 _ = ret 20 | loop ret n (p:ps) = if n `rem` p /= 0 21 | then loop ret n ps 22 | else loop ret' n' ps 23 | where 24 | (n', a) = divide 1 (n `quot` p) p 25 | ret' = ret * (p - 1) * a 26 | divide ph re p = if re `rem` p /= 0 27 | then (re, ph) 28 | else divide (ph * p) (re `quot` p) p 29 | loop _ _ [] = undefined 30 | 31 | phiTo :: Int -> [Int] 32 | phiTo n = tail $ V.toList $ V.create $ do 33 | pt <- R.new (0 :: Int) 34 | sieve <- MV.replicate (n + 1) True 35 | primes <- MV.replicate (countPrimeApprox n + 1) (0 :: Int) 36 | phi <- MV.replicate (n + 1) (1 :: Int) 37 | forM_ [2 .. n] $ \i -> do 38 | isPrime <- MV.unsafeRead sieve i 39 | when isPrime $ do 40 | pt' <- R.modify' pt (+ 1) 41 | MV.unsafeWrite primes pt' i 42 | MV.unsafeWrite phi i (i - 1) 43 | phi' <- MV.unsafeRead phi i 44 | pt' <- R.read pt 45 | iterateLoopT 1 $ \j -> 46 | if' (j > pt') exit $ do 47 | p' <- lift $ MV.unsafeRead primes j 48 | if' (p' * i > n) exit $ do 49 | lift $ MV.unsafeWrite sieve (p' * i) False 50 | lift $ MV.unsafeWrite phi (p' * i) (phi' * if' (i `rem` p' == 0) p' (p' - 1)) 51 | if' (i `rem` p' == 0) exit $ return $ j + 1 52 | return phi 53 | -------------------------------------------------------------------------------- /lib/Common/Numbers/InfiniteSequence.hs: -------------------------------------------------------------------------------- 1 | module Common.Numbers.InfiniteSequence ( 2 | prime 3 | , fibnoacci 4 | ) where 5 | 6 | import qualified Common.Numbers.Primes as P 7 | 8 | prime :: Integral a => [a] 9 | prime = P.primes 10 | 11 | fibnoacci :: Integral a => [a] 12 | fibnoacci = 0 : 1 : zipWith (+) fibnoacci (tail fibnoacci) 13 | -------------------------------------------------------------------------------- /lib/Common/Numbers/Numbers.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | 3 | module Common.Numbers.Numbers ( 4 | factorial 5 | , binomial 6 | , multiBinomial 7 | , powMod 8 | , fastpow 9 | , exgcd 10 | , inverse 11 | , inverse' 12 | , inverseToM 13 | , inverseTo 14 | , crt2 15 | , crt 16 | , tonelliShanks 17 | ) where 18 | 19 | import Data.Bits (Bits, (.&.), shiftR, shiftL) 20 | import Data.Maybe (fromJust) 21 | import qualified Data.Vector as V 22 | 23 | factorial :: (Integral a) => a -> a 24 | {-# INLINABLE factorial #-} 25 | factorial n = product [1 .. n] 26 | 27 | binomial :: (Integral a) => a -> a -> a 28 | {-# INLINABLE binomial #-} 29 | binomial a b = if a < b 30 | then 0 31 | else product [b + 1 .. a] `quot` product [1 .. (a - b)] 32 | 33 | multiBinomial :: (Integral a) => [a] -> a 34 | {-# INLINABLE multiBinomial #-} 35 | multiBinomial xs = factorial (sum xs) `quot` product (map factorial xs) 36 | 37 | powMod :: (Integral a, Bits b, Integral b) => a -> b -> a -> a 38 | {-# INLINABLE powMod #-} 39 | powMod a p m = helper a p m 1 40 | where 41 | helper _ 0 _ ret = ret 42 | helper a p m ret = if (p .&. 1) == 1 43 | then helper a' p' m (ret * a `rem` m) 44 | else helper a' p' m ret 45 | where 46 | a' = a * a `rem` m 47 | p' = p `shiftR` 1 48 | 49 | fastpow :: (Num a, Bits b, Integral b) => a -> b -> a 50 | {-# INLINABLE fastpow #-} 51 | fastpow a p = helper a p 1 52 | where 53 | helper _ 0 ret = ret 54 | helper a p ret = if (p .&. 1) == 1 55 | then helper a' p' (ret * a) 56 | else helper a' p' ret 57 | where 58 | a' = a * a 59 | p' = p `shiftR` 1 60 | 61 | exgcd :: (Integral a) => a -> a -> (a, a, a) 62 | {-# INLINABLE exgcd #-} 63 | exgcd a 0 = (a, 1, 0) 64 | exgcd a b = (d, y, x - (a `quot` b) * y) 65 | where 66 | (d, x, y) = exgcd b (a `rem` b) 67 | 68 | -- | p should be a prime. 69 | inverse :: (Integral a) => a -> a -> a 70 | {-# INLINABLE inverse #-} 71 | inverse x p = if x' == 0 72 | then undefined 73 | else powMod x' (toInteger (p - 2)) p 74 | where 75 | x' = x `rem` p 76 | 77 | -- | x and m should be co-prime. 78 | -- | this version is preferred. 79 | inverse' :: (Integral a) => a -> a -> a 80 | {-# INLINABLE inverse' #-} 81 | inverse' x m = if d /= 1 82 | then undefined 83 | else a `rem` m 84 | where 85 | (d, a, _) = exgcd x m 86 | 87 | inverseToM :: (Monad m, Integral a) => Int -> a -> [m a] 88 | {-# INLINABLE inverseToM #-} 89 | inverseToM n m = V.toList cache 90 | where 91 | cache = V.fromList $ fail "undefined" : return 1 : map inv [2 .. n] 92 | inv x = do 93 | let (q, r) = m `quotRem` fromIntegral x 94 | y <- cache V.! fromIntegral r 95 | return $ y * (m - q) `rem` m 96 | 97 | inverseTo :: (Integral a) => Int -> a -> [a] 98 | {-# INLINABLE inverseTo #-} 99 | inverseTo n m = map fromJust $ inverseToM n m 100 | 101 | crt2 :: (Integral a) => (a, a) -> (a, a) -> a 102 | {-# INLINABLE crt2 #-} 103 | crt2 (p1, r1) (p2, r2) = (a + b) `rem` n 104 | where 105 | n = p1 * p2 106 | a = inverse' p2 p1 * p2 `rem` n * r1 `mod` n 107 | b = inverse' p1 p2 * p1 `rem` n * r2 `mod` n 108 | 109 | crt :: (Integral a) => [(a, a)] -> a 110 | {-# INLINABLE crt #-} 111 | crt = loop 1 1 112 | where 113 | loop _ res [] = res 114 | loop pp res ((p, r):rest) = loop (pp * p) (crt2 (pp, res) (p, r)) rest 115 | 116 | legendre :: (Integral a, Bits a) => a -> a -> a 117 | legendre n p = powMod n ((p - 1) `quot` 2) p 118 | 119 | tonelliShanks :: forall a. (Integral a, Bits a) => a -> a -> Maybe a 120 | {-# INLINABLE tonelliShanks #-} 121 | tonelliShanks n p | legendre n p /= 1 = Nothing 122 | | otherwise = Just r 123 | where 124 | (q, s) = until (odd . fst) (\(q0, s0) -> (q0 `quot` 2, s0 + 1)) (p - 1, 0) 125 | z = head $ filter (\t -> legendre t p == p - 1) [1 .. ] 126 | (r, _, _, _) = until (\(_, t, _, _) -> t == 1) iter (powMod n ((q+1) `quot` 2) p, powMod n q p, s, powMod z q p) 127 | iter (r, t, m, c) = (r * b `rem` p, t * b2 `rem` p, i, b2) 128 | where 129 | i = fst $ head $ filter (\(_, x) -> x == 1) $ zip [0 .. m-1] $ iterate (\t0 -> t0 * t0 `rem` p) t 130 | b = powMod c k p 131 | b2 = b * b `rem` p 132 | k = 1 `shiftL` (m - i - 1) :: a 133 | -------------------------------------------------------------------------------- /lib/Common/Polynomial/Polynomial.hs: -------------------------------------------------------------------------------- 1 | module Common.Polynomial.Polynomial ( 2 | Polynomial 3 | , toList 4 | , fromList 5 | , (!) 6 | , naiveMultiply 7 | , karatsubaMultiply 8 | ) where 9 | 10 | import Data.Bits (shiftL, shiftR) 11 | import qualified Data.Vector.Unboxed as V 12 | 13 | newtype V.Unbox a => Polynomial a = P (V.Vector a) 14 | deriving (Show) 15 | 16 | instance (V.Unbox a, Num a) => Num (Polynomial a) where 17 | (+) (P p1) (P p2) = P $ zipWith_ (+) p1 p2 18 | (-) (P p1) (P p2) = P $ zipWith_ (-) p1 p2 19 | (*) p1 p2 = karatsubaMultiply p1 p2 20 | fromInteger n = fromList [fromInteger n] 21 | abs _ = undefined 22 | signum _ = undefined 23 | 24 | toList :: V.Unbox a => Polynomial a -> [a] 25 | toList (P p) = V.toList p 26 | 27 | fromList :: V.Unbox a => [a] -> Polynomial a 28 | fromList = P . V.fromList 29 | 30 | (!) :: (V.Unbox a, Num a) => Polynomial a -> Int -> a 31 | P p ! i = p V.! i 32 | 33 | (?!) :: (V.Unbox a, Num a) => V.Vector a -> Int -> a 34 | p ?! i | i < 0 || i >= n = 0 35 | | otherwise = V.unsafeIndex p i 36 | where n = V.length p 37 | 38 | shift :: (V.Unbox a, Num a) => Int -> V.Vector a -> V.Vector a 39 | shift n = (V.++) (V.replicate n 0) 40 | 41 | zipWith_ :: (V.Unbox a, Num a) => (a -> a -> a) -> V.Vector a -> V.Vector a -> V.Vector a 42 | zipWith_ f p1 p2 = V.generate (max (V.length p1) (V.length p2)) $ \i -> f (p1 ?! i) (p2 ?! i) 43 | 44 | zipWith3_ :: (V.Unbox a, Num a) => (a -> a -> a -> a) -> V.Vector a -> V.Vector a -> V.Vector a -> V.Vector a 45 | zipWith3_ f p1 p2 p3 = V.generate (maximum (map V.length [p1, p2, p3])) $ \i -> f (p1 ?! i) (p2 ?! i) (p3 ?! i) 46 | 47 | naiveMultiply :: (V.Unbox a, Num a) => Polynomial a -> Polynomial a -> Polynomial a 48 | naiveMultiply (P p1) (P p2) | n == 0 || m == 0 = P V.empty 49 | | otherwise = P $ V.fromList $ 50 | flip map [0 .. n + m - 2] $ \k -> do 51 | let offset = max 0 (k + 1 - m) 52 | V.sum $ V.imap (get offset k) (V.drop offset $ V.take (k + 1) p1) 53 | where 54 | n = V.length p1 55 | m = V.length p2 56 | get offset k i v = (V.unsafeIndex p2 j) * v 57 | where j = k - i - offset 58 | 59 | karatsubaMultiply :: (V.Unbox a, Num a) => Polynomial a -> Polynomial a -> Polynomial a 60 | karatsubaMultiply (P p1) (P p2) | m == 0 = P V.empty 61 | | n <= 250 = naiveMultiply (P p1) (P p2) 62 | | otherwise = P $ V.take deg $ zipWith3_ (\x y z -> x + y + z) sub1 part1 part2 63 | where 64 | n = max (V.length p1) (V.length p2) 65 | m = min (V.length p1) (V.length p2) 66 | deg = V.length p1 + V.length p2 - 1 67 | half = n `shiftR` 1 + 1 68 | a = V.take half p1 69 | b = V.drop half p1 70 | c = V.take half p2 71 | d = V.drop half p2 72 | P sub1 = karatsubaMultiply (P a) (P c) 73 | P sub2 = karatsubaMultiply (P b) (P d) 74 | P sub3 = karatsubaMultiply (P $ zipWith_ (+) a b) (P $ zipWith_ (+) c d) 75 | part1 = shift half $ zipWith3_ (\x y z -> x - y - z) sub3 sub2 sub1 76 | part2 = shift (half `shiftL` 1) sub2 77 | -------------------------------------------------------------------------------- /lib/Common/README.md: -------------------------------------------------------------------------------- 1 | # Common 2 | 3 | Some utilities, data structures and algorithms for problem solving. 4 | -------------------------------------------------------------------------------- /lib/Common/Utils.hs: -------------------------------------------------------------------------------- 1 | module Common.Utils ( 2 | if' 3 | , (?) 4 | , isqrt 5 | , modifyArray 6 | , initArray 7 | , submasks 8 | , combmasks 9 | ) where 10 | 11 | import Control.Monad (forM_) 12 | import Data.Array.MArray (MArray, newArray, readArray, writeArray) 13 | import Data.Bits (shiftL, shiftR, complement, (.&.), (.|.)) 14 | import Data.Ix (Ix) 15 | 16 | if' :: Bool -> t -> t -> t 17 | {-# INLINE if' #-} 18 | if' p a b = if p 19 | then a 20 | else b 21 | 22 | infixl 2 ? 23 | {-# INLINE (?) #-} 24 | p ? t = if' p (const t) id 25 | 26 | isqrt :: (Integral a) => a -> a 27 | {-# INLINABLE isqrt #-} 28 | isqrt = floor . sqrt . fromIntegral 29 | 30 | modifyArray :: (MArray a e m, Ix i) => a i e -> (e -> e) -> i -> m () 31 | {-# INLINABLE modifyArray #-} 32 | modifyArray a f i = readArray a i >>= writeArray a i . f 33 | 34 | initArray :: (MArray a e m, Ix i) => (i, i) -> e -> [(i, e)] -> m (a i e) 35 | initArray (l, u) initValue setValues = do 36 | a <- newArray (l, u) initValue 37 | forM_ setValues $ \(i, e) -> writeArray a i e 38 | return a 39 | 40 | submasks :: Int -> [Int] 41 | {-# INLINE submasks #-} 42 | submasks mask = 0 : takeWhile (/= 0) (iterate (\sub -> (sub - 1) .&. mask) mask) 43 | 44 | combmasks :: Int -> Int -> [Int] 45 | {-# INLINE combmasks #-} 46 | combmasks n k = takeWhile (< limit) $ iterate iter $ (1 `shiftL` k) - 1 47 | where 48 | limit = 1 `shiftL` n 49 | iter comb = (((comb .&. complement y) `div` x) `shiftR` 1) .|. y 50 | where 51 | x = comb .&. (-comb) 52 | y = comb + x 53 | -------------------------------------------------------------------------------- /project-euler-solutions.cabal.in: -------------------------------------------------------------------------------- 1 | name: project-euler-solutions 2 | version: 0.1.0.0 3 | synopsis: Project Euler solutions in Haskell 4 | homepage: http://github.com/foreverbell/project-euler-solutions 5 | license: BSD3 6 | license-file: LICENSE 7 | author: foreverbell 8 | maintainer: dql.foreverbell@gmail.com 9 | copyright: 2015 foreverbell 10 | category: Math 11 | build-type: Simple 12 | cabal-version: >=1.10 13 | tested-with: GHC==7.10.3 14 | 15 | library 16 | hs-source-dirs: lib 17 | exposed-modules: Common.DataStructure.Fenwick 18 | Common.DataStructure.UnionFind 19 | Common.List 20 | Common.MapReduce 21 | Common.Matrix.Matrix 22 | Common.MonadRef 23 | Common.Numbers.EulerPhi 24 | Common.Numbers.InfiniteSequence 25 | Common.Numbers.Numbers 26 | Common.Numbers.Primes 27 | Common.NumMod.MkNumMod 28 | Common.NumMod.NumMod 29 | Common.Polynomial.Polynomial 30 | Common.Utils 31 | ghc-options: -threaded -O2 -fllvm -W -fwarn-tabs 32 | build-depends: base >= 4.7 && < 5 33 | , containers 34 | , array 35 | , vector 36 | , text 37 | , random 38 | , deepseq 39 | , template-haskell 40 | , primitive 41 | , transformers 42 | , parallel 43 | , control-monad-loop 44 | , vector-th-unbox 45 | default-language: Haskell2010 46 | 47 | source-repository head 48 | type: git 49 | location: http://github.com/foreverbell/project-euler-solutions 50 | 51 | -------------------------------------------------------------------------------- /src/.ghci: -------------------------------------------------------------------------------- 1 | :set -i../lib 2 | :set -XDatatypeContexts 3 | -------------------------------------------------------------------------------- /src/1.hs: -------------------------------------------------------------------------------- 1 | main = print $ sum $ filter (\x -> (x `mod` 3 == 0) || (x `mod` 5 == 0)) [1 .. 999] 2 | -------------------------------------------------------------------------------- /src/10.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Primes (primesTo) 2 | 3 | main = print $ sum $ primesTo 2000000 4 | -------------------------------------------------------------------------------- /src/100.hs: -------------------------------------------------------------------------------- 1 | 2 | possiblePairs :: [(Integer, Integer)] 3 | possiblePairs = (1,1) : map foo possiblePairs where 4 | foo (a,b) = (3*a+4*b-3, 2*a+3*b-2) 5 | 6 | main = print $ snd $ head $ dropWhile ((<= bound) . fst) $ possiblePairs where 7 | bound = 10^12 8 | -------------------------------------------------------------------------------- /src/102.hs: -------------------------------------------------------------------------------- 1 | 2 | splitByComma :: String -> [Int] 3 | splitByComma [] = [] 4 | splitByComma (',' : xs) = splitByComma xs 5 | splitByComma s = (read a) : (splitByComma b) 6 | where (a, b) = span (/= ',') s 7 | 8 | readInput :: IO [[Int]] 9 | readInput = readFile "input/p102_triangles.txt" >>= (return . map splitByComma . words) 10 | 11 | crossSgn :: (Int, Int, Int, Int) -> Int 12 | crossSgn (x1, y1, x2, y2) = case compare cp 0 of 13 | GT -> 1 14 | EQ -> 0 15 | LT -> -1 16 | where cp = (x1 - x2) * y2 - (y1 - y2) * x2 17 | 18 | solveSingle :: [Int] -> Bool 19 | solveSingle [a,b,c,d,e,f] = (length $ filter (> 0) sgn) * (length $ filter (< 0) sgn) == 0 20 | where 21 | sgn = [crossSgn (a,b,c,d), crossSgn (c,d,e,f), crossSgn (e,f,a,b)] 22 | 23 | main = readInput >>= ((print . length . filter id) . (map solveSingle)) 24 | 25 | -------------------------------------------------------------------------------- /src/104.hs: -------------------------------------------------------------------------------- 1 | import Data.List (sort) 2 | 3 | fibonacciTail :: [Int] 4 | fibonacciTail = 1 : 1 : zipWith (\x y -> (x + y) `mod` 1000000000) fibonacciTail (tail fibonacciTail) 5 | 6 | fibonacciHead :: [Int] 7 | fibonacciHead = [ gen n | n <- [1 .. ] ] where 8 | logPhi = log ((1 + sqrt 5) / 2) / (log 10) :: Double 9 | logSqrt5 = (log (sqrt 5)) / (log 10) :: Double 10 | gen n = (round $ 10 ** (t - (fromIntegral (floor t)) + 10)) `div` 100 11 | where t = logPhi * n - logSqrt5 :: Double 12 | 13 | main = print $ solve fibonacciHead fibonacciTail 1 where 14 | pandigital xs = (sort xs) == "123456789" 15 | check = pandigital . show 16 | solve (x:xs) (y:ys) index 17 | | (check x) && (check y) = index 18 | | otherwise = solve xs ys (index + 1) 19 | -------------------------------------------------------------------------------- /src/107.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad 2 | import Control.Monad.ST 3 | import qualified Common.MonadRef as R 4 | import qualified Common.DataStructure.UnionFind as UF 5 | import Data.List (sortBy) 6 | import Data.Function (on) 7 | 8 | type Edge = (Int, Int, Int) 9 | type Graph = (Int, Int, [Edge]) -- n, sum of edges, edges 10 | 11 | weight :: Edge -> Int 12 | weight (_, _, w) = w 13 | 14 | kruskal :: Graph -> Int 15 | kruskal (n, _, edges) = runST $ do 16 | acc <- R.new 0 17 | ufs <- UF.make n 18 | let sortedE = sortBy (compare `on` weight) edges 19 | forM_ sortedE $ \(u, v, w) -> do 20 | merged <- UF.union ufs u v 21 | when merged $ R.modify_' acc (+ w) 22 | R.read acc 23 | 24 | comma :: String -> [String] 25 | comma [] = [] 26 | comma (',':xs) = comma xs 27 | comma s = a:comma b 28 | where 29 | (a, b) = span (/= ',') s 30 | 31 | readInput :: IO Graph 32 | readInput = do 33 | input <- readFile "input/p107_network.txt" 34 | let e = concat $ parse input 35 | let n = length $ words input 36 | let s = sum $ map weight e 37 | return (n, s, e) 38 | where 39 | parse input = zipWith f (words input) [0 .. ] 40 | where 41 | f input u = do 42 | (w, v) <- filter (\(_, v) -> u < v) $ filter ((/= "-") . fst) $ zip (comma input) [0 .. ] 43 | return (u, v, read w) 44 | 45 | main = do 46 | g@(_, s, _) <- readInput 47 | print $ s - kruskal g 48 | -------------------------------------------------------------------------------- /src/108.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Primes (primesTo) 2 | 3 | primeTable = primesTo 100000 4 | 5 | count n = (1 + (rec primeTable n 1)) `div` 2 where 6 | fullDiv n p b 7 | | (n `mod` p == 0) = fullDiv (n `div` p) p (b + 1) 8 | | otherwise = (n, b) 9 | rec (p:ps) 1 res = res 10 | rec (p:ps) n res 11 | | p * p > n = res * 3 12 | | otherwise = rec ps a (res * (2 * b + 1)) 13 | where (a, b) = fullDiv n p 0 14 | 15 | main = print $ head $ filter (\n -> (count n) > 1000) [1 .. ] 16 | -------------------------------------------------------------------------------- /src/11.hs: -------------------------------------------------------------------------------- 1 | import Common.Utils (if') 2 | 3 | input = [ [ 8, 2, 22, 97, 38, 15, 0, 40, 0, 75, 4, 5, 7, 78, 52, 12, 50, 77, 91, 8] 4 | , [49, 49, 99, 40, 17, 81, 18, 57, 60, 87, 17, 40, 98, 43, 69, 48, 4, 56, 62, 0] 5 | , [81, 49, 31, 73, 55, 79, 14, 29, 93, 71, 40, 67, 53, 88, 30, 3, 49, 13, 36, 65] 6 | , [52, 70, 95, 23, 4, 60, 11, 42, 69, 24, 68, 56, 1, 32, 56, 71, 37, 2, 36, 91] 7 | , [22, 31, 16, 71, 51, 67, 63, 89, 41, 92, 36, 54, 22, 40, 40, 28, 66, 33, 13, 80] 8 | , [24, 47, 32, 60, 99, 3, 45, 2, 44, 75, 33, 53, 78, 36, 84, 20, 35, 17, 12, 50] 9 | , [32, 98, 81, 28, 64, 23, 67, 10, 26, 38, 40, 67, 59, 54, 70, 66, 18, 38, 64, 70] 10 | , [67, 26, 20, 68, 2, 62, 12, 20, 95, 63, 94, 39, 63, 8, 40, 91, 66, 49, 94, 21] 11 | , [24, 55, 58, 5, 66, 73, 99, 26, 97, 17, 78, 78, 96, 83, 14, 88, 34, 89, 63, 72] 12 | , [21, 36, 23, 9, 75, 0, 76, 44, 20, 45, 35, 14, 0, 61, 33, 97, 34, 31, 33, 95] 13 | , [78, 17, 53, 28, 22, 75, 31, 67, 15, 94, 3, 80, 4, 62, 16, 14, 9, 53, 56, 92] 14 | , [16, 39, 5, 42, 96, 35, 31, 47, 55, 58, 88, 24, 0, 17, 54, 24, 36, 29, 85, 57] 15 | , [86, 56, 0, 48, 35, 71, 89, 7, 5, 44, 44, 37, 44, 60, 21, 58, 51, 54, 17, 58] 16 | , [19, 80, 81, 68, 5, 94, 47, 69, 28, 73, 92, 13, 86, 52, 17, 77, 4, 89, 55, 40] 17 | , [ 4, 52, 8, 83, 97, 35, 99, 16, 7, 97, 57, 32, 16, 26, 26, 79, 33, 27, 98, 66] 18 | , [88, 36, 68, 87, 57, 62, 20, 72, 3, 46, 33, 67, 46, 55, 12, 32, 63, 93, 53, 69] 19 | , [ 4, 42, 16, 73, 38, 25, 39, 11, 24, 94, 72, 18, 8, 46, 29, 32, 40, 62, 76, 36] 20 | , [20, 69, 36, 41, 72, 30, 23, 88, 34, 62, 99, 69, 82, 67, 59, 85, 74, 4, 36, 16] 21 | , [20, 73, 35, 29, 78, 31, 90, 1, 74, 31, 49, 71, 48, 86, 81, 16, 23, 57, 5, 54] 22 | , [ 1, 70, 54, 71, 83, 51, 54, 69, 16, 92, 33, 48, 61, 43, 52, 1, 89, 19, 67, 48] ] :: [[Int]] 23 | 24 | go d step v@(x, y) = if' (onBoard v) ((input!!x)!!y * next) 0 where 25 | plus (a, b) (c, d) = (a + c, b + d) 26 | dirs = [(-1, 0), (0, -1), (-1, -1), (-1, 1)] 27 | next = if' (step == 0) 1 $ go d (step - 1) (v `plus` (dirs!!d)) 28 | onBoard (x, y) = (x `elem` [0 .. 19]) && (y `elem` [0 .. 19]) 29 | 30 | main = print $ maximum [go d 3 (x,y) | d <- [0 .. 3], x <- [0 .. 19], y <- [0 .. 19]] 31 | -------------------------------------------------------------------------------- /src/110.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Primes (primes) 2 | 3 | dfs :: [Int] -> Int -> Int -> Integer -> Integer -> Integer 4 | dfs (p:ps) t total num best 5 | | num > best = best 6 | | otherwise = minimum result 7 | where 8 | result = [ dfs ps i (total * (2 * i + 1)) j (minimum (best : (take i result))) | (i, j) <- (zip [0 .. t] pow) ] 9 | pow = num : map (* (toInteger p)) pow 10 | dfs [] t total num best = case compare total 8000000 of 11 | GT -> min best num 12 | _ -> best 13 | 14 | main = print $ dfs primeTable 20 1 1 upperBound where 15 | primeTable = take 14 $ primes -- 3**14 > 3999999 16 | upperBound = 10^100 17 | 18 | -------------------------------------------------------------------------------- /src/119.hs: -------------------------------------------------------------------------------- 1 | import Data.List (unfoldr) 2 | 3 | sumd n | n < 10 = 0 4 | | otherwise = sum $ unfoldr f n 5 | where 6 | f 0 = Nothing 7 | f a = Just (a `mod` 10, a `div` 10) 8 | 9 | get :: Integer -> [Integer] 10 | get p = map (^p) $ filter (\n -> n == sumd (n^p)) [1 .. 100] 11 | 12 | union :: Ord a => [a] -> [a] -> [a] 13 | union xs [] = xs 14 | union [] ys = ys 15 | union (x:xs) (y:ys) | x == y = x:union xs ys 16 | | x < y = x:union xs (y:ys) 17 | | x > y = y:union (x:xs) ys 18 | 19 | main = print $ (foldr union [] [get p | p <- [2 .. 100]]) !! 29 20 | -------------------------------------------------------------------------------- /src/12.hs: -------------------------------------------------------------------------------- 1 | numOfDivisors x = length (filter (\d -> x `mod` d == 0) [1 .. x]) 2 | numOfTriDivisors x 3 | | odd x = (numOfDivisors x) * (numOfDivisors ((x + 1) `div` 2)) 4 | | even x = (numOfDivisors (x `div` 2)) * (numOfDivisors (x + 1)) 5 | 6 | main = print ((n * (n + 1)) `div` 2) 7 | where n = head (dropWhile (\x -> (numOfTriDivisors x) <= 500) [1 .. ]) 8 | -------------------------------------------------------------------------------- /src/120.hs: -------------------------------------------------------------------------------- 1 | import Common.List (maximumBy') 2 | import Data.Function (on) 3 | 4 | rMax :: Int -> Int 5 | rMax a = f $ maximumBy' (compare `on` f) $ take m $ iterate (\(x, y) -> (x * (a - 1) `mod` m, y * (a + 1) `mod` m)) (1, 1) 6 | where 7 | m = a*a 8 | f (a, b) = (a + b) `mod` m 9 | 10 | main = print $ sum $ map rMax [3 .. 1000] 11 | -------------------------------------------------------------------------------- /src/123.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Primes (primes') 2 | import Common.Numbers.Numbers (powMod) 3 | import Data.Maybe (fromJust) 4 | import Data.List (find) 5 | 6 | r p n = (powMod (p - 1) n m + powMod (p + 1) n m) `mod` m 7 | where m = p * p 8 | 9 | main = print $ snd $ fromJust $ find (\(p, n) -> r (toInteger p) n > 10^10) $ zip primes' ([1 .. ] :: [Int]) 10 | -------------------------------------------------------------------------------- /src/124.hs: -------------------------------------------------------------------------------- 1 | import Data.List (nub, sort) 2 | import System.Random (mkStdGen) 3 | import Common.Numbers.Primes (factorize) 4 | 5 | rad n = product $ nub ds 6 | where ds = fst $ factorize (mkStdGen n) n 7 | 8 | main = print $ snd $ sort [ (rad n, n) | n <- [1 .. 100000] ] !! 9999 9 | -------------------------------------------------------------------------------- /src/13.hs: -------------------------------------------------------------------------------- 1 | 2 | main = (readFile "input/p013_input.txt") >>= (putStrLn . take 10 . show . sum . (map (\x -> read x :: Integer)) . lines) 3 | -------------------------------------------------------------------------------- /src/132.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Primes (primes') 2 | import Common.Numbers.Numbers (powMod) 3 | 4 | check :: Int -> Int -> Bool 5 | check _ 2 = False 6 | check _ 5 = False 7 | check n p = powMod 10 (gcd n (p-1)) p == 1 && ((sum0 xs) * q `rem` p + sum0 (take r xs)) `rem` p == 0 8 | where 9 | get xs = 1 : takeWhile (/= 1) (tail xs) 10 | xs = get $ iterate (\x -> x * 10 `rem` p) 1 11 | (q, r) = n `quotRem` length xs 12 | sum0 = foldr (\x y -> (x+y) `rem` p) 0 13 | 14 | main = print $ sum $ take 40 $ filter (check $ 10^9) primes' 15 | -------------------------------------------------------------------------------- /src/14.hs: -------------------------------------------------------------------------------- 1 | 2 | import qualified Data.MemoCombinators as Memo 3 | import Common.List (maximumBy') 4 | import Data.Function (on) 5 | 6 | maxN = 1000000 7 | 8 | step :: Int -> Int 9 | step 1 = 1 10 | step n = if n > maxN 11 | then step' n 12 | else Memo.arrayRange (1, maxN) step' n where 13 | step' n = succ $ step $ if odd n 14 | then 3 * n + 1 15 | else n `div` 2 16 | 17 | main = print $ maximumBy' (compare `on` step) [1 .. maxN] 18 | -------------------------------------------------------------------------------- /src/15.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Numbers (binomial) 3 | 4 | main = print $ (binomial 40 20 :: Integer) 5 | -------------------------------------------------------------------------------- /src/151.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Rank2Types #-} 2 | 3 | import qualified Data.MemoCombinators as Memo 4 | import Text.Printf (printf) 5 | 6 | memo4 :: Memo.Memo a -> Memo.Memo b -> Memo.Memo c -> Memo.Memo d -> (a -> b -> c -> d -> r) -> (a -> b -> c -> d -> r) 7 | memo4 a b c d = a . (Memo.memo3 b c d .) 8 | 9 | solve :: Int -> Int -> Int -> Int -> Double 10 | solve a2 a3 a4 a5 = memo4 Memo.integral Memo.integral Memo.integral Memo.integral solve' a2 a3 a4 a5 11 | where 12 | solve' 0 0 0 1 = 0 13 | solve' a2 a3 a4 a5 = v1 + v2 + v3 + v4 + v5 14 | where 15 | s = a2 + a3 + a4 + a5 16 | p2 = fromIntegral a2 / fromIntegral s 17 | p3 = fromIntegral a3 / fromIntegral s 18 | p4 = fromIntegral a4 / fromIntegral s 19 | p5 = fromIntegral a5 / fromIntegral s 20 | v1 = if s==1 then 1 else 0 21 | v2 = if a2>0 then p2 * solve (a2-1) (a3+1) (a4+1) (a5+1) else 0 22 | v3 = if a3>0 then p3 * solve a2 (a3-1) (a4+1) (a5+1) else 0 23 | v4 = if a4>0 then p4 * solve a2 a3 (a4-1) (a5+1) else 0 24 | v5 = if a5>0 then p5 * solve a2 a3 a4 (a5-1) else 0 25 | 26 | main = printf "%.6f\n" $ solve 1 1 1 1 27 | -------------------------------------------------------------------------------- /src/16.hs: -------------------------------------------------------------------------------- 1 | sumOfDigit :: Integer -> Integer 2 | sumOfDigit 0 = 0 3 | sumOfDigit x = (x `mod` 10) + (sumOfDigit (x `div` 10)) 4 | 5 | main = print (sumOfDigit (2 ^ 1000)) 6 | -------------------------------------------------------------------------------- /src/162.hs: -------------------------------------------------------------------------------- 1 | import qualified Data.MemoCombinators as Memo 2 | import Data.Bits ((.|.)) 3 | import Data.Char (toUpper) 4 | import Numeric (showHex) 5 | 6 | dp :: Int -> Int -> Bool -> Int 7 | dp = Memo.memo3 Memo.integral Memo.integral Memo.bool dp' 8 | where 9 | dp' 0 7 _ = 1 10 | dp' 0 _ _ = 0 11 | dp' n bits only0 = sum [ f d | d <- [0 .. 15] ] 12 | where 13 | f d = dp (n-1) bits' only0' 14 | where 15 | bits' | d == 10 = bits .|. 4 16 | | d == 1 = bits .|. 2 17 | | d == 0 && not only0 = bits .|. 1 18 | | otherwise = bits 19 | only0' = only0 && (d == 0) 20 | 21 | main = putStrLn $ map toUpper $ showHex ret [] 22 | where ret = dp 16 0 True 23 | -------------------------------------------------------------------------------- /src/17.hs: -------------------------------------------------------------------------------- 1 | -- http://english.stackexchange.com/questions/111765/how-to-write-out-numbers-in-compliance-with-british-usage 2 | 3 | numberToWord :: Int -> String 4 | numberToWord 0 = "zero" 5 | numberToWord 1 = "one" 6 | numberToWord 2 = "two" 7 | numberToWord 3 = "three" 8 | numberToWord 4 = "four" 9 | numberToWord 5 = "five" 10 | numberToWord 6 = "six" 11 | numberToWord 7 = "seven" 12 | numberToWord 8 = "eight" 13 | numberToWord 9 = "nine" 14 | numberToWord 10 = "ten" 15 | numberToWord 11 = "eleven" 16 | numberToWord 12 = "twelve" 17 | numberToWord 13 = "thirteen" 18 | numberToWord 14 = "fourteen" 19 | numberToWord 15 = "fifteen" 20 | numberToWord 16 = "sixteen" 21 | numberToWord 17 = "seventeen" 22 | numberToWord 18 = "eighteen" 23 | numberToWord 19 = "nineteen" 24 | numberToWord 20 = "twenty" 25 | numberToWord 30 = "thirty" 26 | numberToWord 40 = "forty" 27 | numberToWord 50 = "fifty" 28 | numberToWord 60 = "sixty" 29 | numberToWord 70 = "seventy" 30 | numberToWord 80 = "eighty" 31 | numberToWord 90 = "ninety" 32 | numberToWord 1000 = "one thousand" 33 | numberToWord x 34 | | x `mod` 100 == 0 = (numberToWord (x `div` 100)) ++ " hundred" 35 | | x < 100 = (numberToWord (x - (x `mod` 10))) ++ " " ++ (numberToWord (x `mod` 10)) 36 | | otherwise = (numberToWord (x - (x `mod` 100))) ++ " and " ++ (numberToWord (x `mod` 100)) 37 | 38 | countLetters x = foldr ((+) . length) 0 (words (numberToWord x)) 39 | 40 | main = print $ sum $ map countLetters [1 .. 1000] 41 | -------------------------------------------------------------------------------- /src/173.hs: -------------------------------------------------------------------------------- 1 | import Common.Utils (isqrt) 2 | 3 | root d | d <= 0 = 0 4 | | otherwise = isqrt d 5 | 6 | solve :: Int -> Int 7 | solve n = sum [ count a | a <- [1 .. n `div` 4 + 1] ] 8 | where 9 | count a = (a - k) `div` 2 10 | where k = 1 + (isqrt $ a*a - n - 1) 11 | 12 | main = print $ solve 1000000 13 | -------------------------------------------------------------------------------- /src/18.hs: -------------------------------------------------------------------------------- 1 | 2 | fromString :: [[String]] -> [[Int]] 3 | fromString s = map (\x -> map (\y -> read y) x) s 4 | 5 | dp :: Int -> [[Int]] -> [Int] 6 | dp 0 triangle = head triangle 7 | dp level triangle = zipWith (+) row (zipWith max (0 : bak) (bak ++ [0])) 8 | where row = head triangle 9 | bak = dp (level - 1) (tail triangle) 10 | 11 | solve :: String -> Int 12 | solve input = maximum (dp (n - 1) (fromString triangle)) 13 | where triangle = reverse (map words (lines input)) 14 | n = length triangle 15 | 16 | main = (readFile "input/p018_input.txt") >>= (print . solve) 17 | -------------------------------------------------------------------------------- /src/185.hs: -------------------------------------------------------------------------------- 1 | import qualified Data.IntMap as M 2 | import Control.Monad (guard) 3 | import Control.Applicative (empty) 4 | 5 | {- real 3m37.442s 6 | user 3m36.196s 7 | sys 0m1.135s 8 | -} 9 | 10 | type Input = [(Int, Int)] 11 | 12 | {-# INLINE encode #-} 13 | {-# INLINE decodeBase #-} 14 | {-# INLINE coincide #-} 15 | 16 | encode :: [Int] -> [Int] -> Int 17 | encode xs cs = foldr f 0 $ zip xs cs 18 | where 19 | f (a, b) v | b > a = -1 20 | | v < 0 = v 21 | | otherwise = v * (a + 1) + b 22 | 23 | decodeBase :: Int -> [Int] 24 | decodeBase x = take 8 $ helper x 25 | where helper x = let (q, r) = x `quotRem` 10 in r : helper q 26 | 27 | coincide :: [Int] -> [Int] -> Int 28 | coincide as bs = length $ filter id $ zipWith (==) as bs 29 | 30 | search1 :: Input -> M.IntMap Int 31 | search1 input = M.fromList $ do 32 | a <- [0 .. 99999999] 33 | let e = encode cs $ map (coincide (decodeBase a)) vsd 34 | guard $ e >= 0 35 | return (e, a) 36 | where vs = map ((`rem` 10^8) . fst) input 37 | cs = map snd input 38 | vsd = map decodeBase vs 39 | 40 | search2 :: Input -> M.IntMap Int -> (Int, Int) 41 | search2 input m = head $ do 42 | a <- [0 .. 99999999] 43 | let e = encode cs $ map (coincide (decodeBase a)) vsd 44 | guard $ e >= 0 45 | case M.lookup (mv - e) m of 46 | Just f -> return (f, a) 47 | Nothing -> empty 48 | where vs = map ((`quot` 10^8) . fst) input 49 | cs = map snd input 50 | vsd = map decodeBase vs 51 | mv = encode cs cs 52 | 53 | solve :: Input -> Int 54 | solve input = b * (10^8) + a 55 | where (a, b) = search2 input (search1 input) 56 | 57 | parse :: String -> Input 58 | parse input = map f (map read <$> map words (lines input)) 59 | where f xs = (xs !! 0, xs !! 1) 60 | 61 | main = (print . solve . parse) =<< readFile "input/p185_input.txt" 62 | -------------------------------------------------------------------------------- /src/187.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Primes (countPrime', primesTo) 2 | import Common.Utils (isqrt) 3 | import qualified Data.Map as M 4 | import Data.Maybe (fromJust) 5 | 6 | n = 10^8 :: Int 7 | 8 | primes = primesTo $ isqrt n 9 | 10 | count = M.fromList $ countPrime' n 11 | 12 | solve m | from > to = 0 13 | | otherwise = fromJust (M.lookup to count) - fromJust (M.lookup (from - 1) count) 14 | where 15 | from = m 16 | to = n `div` m 17 | 18 | main = print $ sum $ map solve primes 19 | -------------------------------------------------------------------------------- /src/19.hs: -------------------------------------------------------------------------------- 1 | -- 1 Jan 1901 was a Tuesday 2 | -- ModifiedJulianDay 15385 -> 1901-01-01 3 | -- ModifiedJulianDay 51909 -> 2000-12-31 4 | 5 | import Data.Time.Calendar 6 | 7 | firstDay :: Day -> Bool 8 | firstDay date = (d == 1) 9 | where (y, m, d) = toGregorian date 10 | 11 | main = print (length (filter (\x -> (firstDay (ModifiedJulianDay x)) && (x - 15385) `mod` 7 == 5) [15385 .. 51909])) 12 | -------------------------------------------------------------------------------- /src/191.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TupleSections #-} 2 | 3 | import Data.Maybe (fromJust, isJust) 4 | import Data.List (groupBy, sort) 5 | import Data.Function (on) 6 | 7 | data Attendance = A | L | O 8 | type State = (Int, Int) 9 | 10 | transtate :: State -> Attendance -> Maybe State 11 | transtate (1, _) L = Nothing 12 | transtate (_, 2) A = Nothing 13 | transtate (0, _) L = Just (1, 0) 14 | transtate (n, _) O = Just (n, 0) 15 | transtate (n, k) A = Just (n, k + 1) 16 | 17 | go :: [(State, Int)] -> [(State, Int)] 18 | go vs = merge $ map fromJust $ filter isJust $ [ (, c) <$> transtate v a | (v, c) <- vs, a <- [A, L, O] ] 19 | where 20 | merge vs = map f $ groupBy ((==) `on` fst) $ sort vs 21 | f vs = (fst (vs!!0), sum $ map snd vs) 22 | 23 | main = print $ sum $ map snd $ (iterate go [((0, 0), 1)]) !! 30 24 | -------------------------------------------------------------------------------- /src/2.hs: -------------------------------------------------------------------------------- 1 | main = print $ sum $ filter even $ takeWhile (<= 4000000) fib where 2 | fib = 1 : 2 : zipWith (+) fib (tail fib) 3 | -------------------------------------------------------------------------------- /src/20.hs: -------------------------------------------------------------------------------- 1 | import Data.List 2 | 3 | sumOfDigit :: Integer -> Integer 4 | sumOfDigit x = sum $ unfoldr helper x where 5 | helper 0 = Nothing 6 | helper x = Just (x `mod` 10, x `div` 10) 7 | 8 | main = print $ sumOfDigit $ product [1 .. 100] 9 | -------------------------------------------------------------------------------- /src/203.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Primes (primesTo) 2 | import Common.List (nub') 3 | import Common.Utils (isqrt) 4 | 5 | n = 50 6 | 7 | binomial :: Int -> Int -> Int 8 | binomial n k = fromIntegral $ a `div` b 9 | where 10 | a = product [n' - k' + 1 .. n'] 11 | b = product [1 .. k'] 12 | n' = fromIntegral n :: Integer 13 | k' = fromIntegral (min k (n - k)) :: Integer 14 | 15 | primes = primesTo upto 16 | where upto = isqrt $ binomial n (n `div` 2) 17 | 18 | squarefree n = go n primes 19 | where 20 | go _ [] = True 21 | go 1 _ = True 22 | go n (p:ps) | n `mod` p == 0 = if n `mod` (p^2) == 0 then False else go (n `div` p) ps 23 | | otherwise = go n ps 24 | 25 | numbers = nub' $ concatMap (\i -> [ binomial i k | k <- [0 .. i] ]) [1 .. n] 26 | 27 | main = print $ sum $ filter squarefree numbers 28 | -------------------------------------------------------------------------------- /src/205.hs: -------------------------------------------------------------------------------- 1 | 2 | import Data.Array.Unboxed 3 | import Data.Array.ST 4 | import Control.Monad (guard, forM_, when) 5 | import Control.Monad.ST 6 | import Text.Printf 7 | 8 | dynamic :: Int -> Int -> [(Int, Int)] 9 | dynamic times dice = assocs $ rec times dice init where 10 | cnt = times * dice 11 | init = listArray (0, cnt) (1 : (repeat 0)) 12 | rec :: Int -> Int -> UArray Int Int -> UArray Int Int 13 | rec 0 _ ret = ret 14 | rec times dice last = rec (times - 1) dice $ runSTUArray $ do 15 | ret <- newArray (0, cnt) 0 16 | forM_ [cnt, cnt - 1 .. 1] $ \i -> do 17 | forM_ [1 .. dice] $ \j -> do 18 | when (i >= j) $ do 19 | v <- readArray ret i 20 | writeArray ret i (v + last!(i - j)) 21 | return ret 22 | 23 | peter = dynamic 9 4 24 | colin = dynamic 6 6 25 | 26 | solve = sum $ do 27 | (a, b) <- peter 28 | (c, d) <- colin 29 | guard $ a > c 30 | return $ b * d 31 | 32 | main = putStrLn $ printf "%.7f" (a / b) where 33 | a = fromIntegral solve :: Double 34 | b = (4^9)*(6^6) :: Double 35 | -------------------------------------------------------------------------------- /src/206.hs: -------------------------------------------------------------------------------- 1 | 2 | isqrt = floor . sqrt . fromIntegral 3 | 4 | isDesired :: Int -> Bool 5 | isDesired x = check (show (x * x)) '1' where 6 | check (x:[]) n = True 7 | check (x:xs) n = if (x == n) then check (tail xs) (succ x) else False 8 | 9 | solve = head $ filter isDesired [lo, lo + 10 .. ] where 10 | lo = isqrt (10^18) 11 | 12 | main = print $ solve 13 | -------------------------------------------------------------------------------- /src/207.hs: -------------------------------------------------------------------------------- 1 | import Data.Bits ((.&.)) 2 | import Data.List (scanl') 3 | 4 | proportions = zip [1 .. ] $ scanl' f (0, 0) [2 .. ] 5 | where 6 | isPower2 :: Int -> Bool 7 | isPower2 x = x .&. (-x) == x 8 | f (a, b) i | isPower2 i = (a + 1, b + 1) 9 | | otherwise = (a, b + 1) 10 | 11 | solve = n*n - n 12 | where 13 | f (_, (a, b)) = 12345 * a >= b 14 | n = fst $ head $ dropWhile f proportions 15 | 16 | main = print (solve :: Int) 17 | -------------------------------------------------------------------------------- /src/21.hs: -------------------------------------------------------------------------------- 1 | 2 | sumOfDivisors n = sum $ filter (\x -> n `mod` x == 0) [1 .. (n - 1)] 3 | 4 | amicable = [ x | x <- [1 .. 10000], y <- [sumOfDivisors x], y /= x, sumOfDivisors y == x ] 5 | 6 | main = print $ sum amicable 7 | -------------------------------------------------------------------------------- /src/211.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Utils (isqrt) 3 | import Control.Monad (forM_, when) 4 | import Data.Array.Unboxed 5 | import Data.Array.ST 6 | import Control.Monad.ST 7 | 8 | eratos :: Int -> UArray Int Int 9 | eratos n = runSTUArray $ do 10 | isPrime <- newListArray (1, n) (repeat True) :: ST s (STUArray s Int Bool) 11 | minPrimePart <- newListArray (1, n) [1 .. n] :: ST s (STUArray s Int Int) 12 | sigma2 <- newListArray (1, n) (repeat 0) :: ST s (STUArray s Int Int) 13 | writeArray sigma2 1 1 14 | forM_ [2 .. n] $ \i -> do 15 | prime <- readArray isPrime i 16 | when prime $ do 17 | writeArray sigma2 i $ 1 + i * i 18 | forM_ [i^2, i^2 + i .. n] $ \j -> do 19 | prime' <- readArray isPrime j 20 | when prime' $ do 21 | writeArray isPrime j False 22 | let q = j `div` i 23 | minPrime' <- readArray minPrimePart q 24 | if (minPrime' `mod` i == 0) 25 | then writeArray minPrimePart j (minPrime' * i) 26 | else writeArray minPrimePart j i 27 | d' <- readArray minPrimePart j 28 | when (d' == j) $ do 29 | s <- readArray sigma2 q 30 | writeArray sigma2 j $ s * i * i + 1 31 | forM_ [2 .. n] $ \i -> do 32 | d1 <- readArray minPrimePart i 33 | let d2 = i `div` d1 34 | when (d1 /= i) $ do 35 | s1 <- readArray sigma2 d1 36 | s2 <- readArray sigma2 d2 37 | writeArray sigma2 i (s1 * s2) 38 | return sigma2 39 | 40 | perfect n = root * root == n where 41 | root = isqrt n 42 | 43 | main = print $ sum $ map fst $ filter (perfect . snd) sigma2 where 44 | sigma2 = assocs $ eratos 64000000 45 | 46 | -------------------------------------------------------------------------------- /src/214.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.EulerPhi (phiTo) 2 | import Common.Numbers.Primes (testPrime) 3 | import qualified Data.Vector.Unboxed as V 4 | import qualified Data.Vector.Unboxed.Mutable as MV 5 | import Control.Monad (forM_) 6 | 7 | phiChainLength :: Int -> [Int] 8 | phiChainLength n = V.toList $ V.create $ do 9 | r <- MV.new (n + 1) 10 | MV.write r 1 1 11 | forM_ [2 .. n] $ \i -> do 12 | let j = phis V.! i 13 | v <- MV.read r j 14 | MV.write r i (v + 1) 15 | return r 16 | where 17 | phis = V.fromList (0 : phiTo n) 18 | 19 | solve n = sum $ map fst ret 20 | where 21 | ret = filter (\p -> snd p == 25 && testPrime (fst p)) $ zip [0 ..] (phiChainLength n) 22 | 23 | main = print $ solve 40000000 24 | -------------------------------------------------------------------------------- /src/216.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Primes (primesTo) 2 | import Common.Numbers.Numbers (tonelliShanks) 3 | import Common.Utils (isqrt) 4 | import Control.Monad (forM_) 5 | import Data.Maybe (fromJust) 6 | import qualified Data.Vector.Unboxed as V 7 | import qualified Data.Vector.Unboxed.Mutable as MV 8 | 9 | solve :: Int -> Int 10 | solve n = length $ filter id vs 11 | where 12 | ps = filter (\p -> p `rem` 8 == 1 || p `rem` 8 == 7) $ primesTo $ isqrt (2*n*n) 13 | vs = drop 2 $ V.toList $ V.create $ do 14 | vs <- MV.replicate (n+1) True 15 | forM_ ps $ \p -> do 16 | let pick m = min m (p-m) 17 | let m = pick $ fromJust $ tonelliShanks ((p+1) `quot` 2) p 18 | let check = if 2*m*m-1 == p then drop 1 else id 19 | let excludes = check [m, m + p .. n] ++ dropWhile (<=0) [-m, -m + p .. n] 20 | forM_ excludes $ \i -> do 21 | MV.write vs i False 22 | return vs 23 | 24 | main = print $ solve 50000000 25 | -------------------------------------------------------------------------------- /src/22.hs: -------------------------------------------------------------------------------- 1 | import Data.List 2 | import Data.Char 3 | 4 | scoreOfName :: String -> Int 5 | scoreOfName s = foldl' (\n c -> n + (ord c - ord 'A' + 1)) 0 s 6 | 7 | solve :: String -> Int 8 | solve input = score 9 | where names' = filter (\s -> (length s) >= 2) (groupBy (\a b -> ((a == ',') == (b == ','))) input) 10 | names = sort $ map (tail . init) names' 11 | pairs = zip names [1 .. ] 12 | score = sum $ map (\(n, i) -> (scoreOfName n) * i) pairs 13 | 14 | main = (readFile "input/p022_names.txt") >>= (print . solve) 15 | -------------------------------------------------------------------------------- /src/222.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad (forM_, when, liftM) 2 | import Control.Monad.ST (runST, ST) 3 | import Data.Bits (shiftL, shiftR, (.&.), (.|.)) 4 | import qualified Data.Vector.Unboxed.Mutable as V 5 | 6 | save :: Int -> Int -> Double 7 | save a b = r1 + r2 - h 8 | where 9 | r1 = fromIntegral a 10 | r2 = fromIntegral b 11 | h = sqrt $ (r1 + r2) ^ 2 - (100 - r1 - r2) ^ 2 12 | 13 | solve :: Double 14 | solve = runST $ do 15 | dp <- V.replicate (21 * (u + 1)) (-1) :: ST s (V.MVector s Double) 16 | forM_ [0 .. 20] $ \i -> V.unsafeWrite dp (encode i (2^i)) $ fromIntegral $ 2 * (i + 30) 17 | forM_ [1 .. u] $ \mask -> 18 | forM_ [0 .. 20] $ \i -> 19 | when (((mask `shiftR` i) .&. 1) == 1) $ do 20 | v <- V.unsafeRead dp (encode i mask) 21 | forM_ [0 .. 20] $ \j -> do 22 | let mask' = mask .|. (1 `shiftL` j) 23 | when (mask' /= mask) $ 24 | V.unsafeModify dp (update (v + fromIntegral ((30 + j) * 2) - save (30 + i) (30 + j))) (encode j mask') 25 | liftM minimum $ sequence [ V.unsafeRead dp (encode i u) | i <- [0 .. 20] ] 26 | where 27 | u = (2^21) - 1 :: Int 28 | update v (-1) = v 29 | update a b = min a b 30 | encode i mask = mask * 21 + i 31 | 32 | main = print $ round (1000 * solve) 33 | -------------------------------------------------------------------------------- /src/225.hs: -------------------------------------------------------------------------------- 1 | import qualified Data.Set as S 2 | 3 | test :: Int -> Bool 4 | test modulo = go (1, 1, 1, S.empty) 5 | where 6 | go (a, b, c, coll) | S.member (a, b, c) coll = True 7 | | d == 0 = False 8 | | otherwise = go (b, c, d, S.insert (a, b, c) coll) 9 | where d = (a + b + c) `mod` modulo 10 | 11 | main = print $ (filter test [3, 5 ..]) !! 123 12 | -------------------------------------------------------------------------------- /src/23.hs: -------------------------------------------------------------------------------- 1 | import Common.List (nub', minus) 2 | 3 | sumOfDivisors n = sum $ filter (\x -> n `mod` x == 0) [1 .. (n - 1)] 4 | 5 | abundant = [ x | x <- [1 .. 28123], sumOfDivisors x > x ] 6 | magicNumber' = nub' [ x + y | x <- abundant, y <- abundant, x + y <= 28123 ] 7 | magicNumber = [1 .. 28123] `minus` magicNumber' 8 | 9 | main = print $ sum magicNumber 10 | 11 | -------------------------------------------------------------------------------- /src/231.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Primes (primesTo) 3 | 4 | count n p = sum $ takeWhile (/= 0) ps where 5 | ps = (n `div` p) : map (\x -> x `div` p) ps 6 | 7 | main = print $ sum $ [ p * ((count n p) - (count m p) - (count (n - m) p)) | p <- primes ] where 8 | primes = primesTo n 9 | n = 20000000 10 | m = 15000000 11 | -------------------------------------------------------------------------------- /src/232.hs: -------------------------------------------------------------------------------- 1 | import qualified Data.MemoCombinators as Memo 2 | import Text.Printf (printf) 3 | 4 | -- the probability that p2 wins when p1 scores a, and p2 scores b (p1 first). 5 | win :: Int -> Int -> Double 6 | win a b = Memo.memo2 Memo.integral Memo.integral win' a b 7 | where 8 | win' a b | a >= 100 = 0.0 9 | | b >= 100 = 1.0 10 | | otherwise = maximum $ do 11 | t1 <- [1 .. 8] 12 | t2 <- [1 .. 8] 13 | let prob1 = 0.5 ** (fromIntegral t1) 14 | let prob2 = 0.5 ** (fromIntegral t2) 15 | let d1 = 2 ^ (t1 - 1) 16 | let d2 = 2 ^ (t2 - 1) 17 | return $ (prob1 / 2 * (win a (b + d1)) + prob2 / 2 * (win (a + 1) (b + d2)) + (1 - prob2) / 2 * (win (a + 1) b)) / (1 - (1 - prob1) / 2) 18 | 19 | main = printf "%.8f\n" $ win 0 0 20 | -------------------------------------------------------------------------------- /src/239.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Numbers (binomial, factorial) 2 | import Text.Printf (printf) 3 | import Data.Ratio 4 | 5 | -- there are 25 primes below 100, answer = C(25,3) * #{permutation that 22 primes not in there natural position among remaining 97 numbers} 6 | -- using inclusion-exclusion principle. 7 | 8 | main = printf "%.12f\n" (ret :: Double) 9 | where 10 | ret = fromRational $ (binomial 25 3 * foolish22) % factorial 100 11 | foolish22 = sum $ [ factorial (97 - i) * (-1)^i * binomial 22 i | i <- [0 .. 22] ] 12 | -------------------------------------------------------------------------------- /src/24.hs: -------------------------------------------------------------------------------- 1 | import Data.List (permutations, sort) 2 | 3 | main = putStrLn $ (sort (permutations ['0' .. '9'])) !! 999999 4 | -------------------------------------------------------------------------------- /src/240.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Numbers (multiBinomial) 2 | import Data.List (group) 3 | 4 | g d f | d == 0 = [[]] 5 | | otherwise = concatMap (\f0 -> map (f0:) (g (d - 1) f0)) [1 .. f] 6 | 7 | combinations :: Int -> Int -> Int -> Int -> [[Int]] 8 | combinations d f top s = concatMap r possibles 9 | where 10 | possibles = filter (\xs -> sum xs == s) $ g top f :: [[Int]] 11 | r xs = map (\ys -> xs ++ ys) $ g (d - top) (last xs) 12 | 13 | solve d f top s = sum $ map count combs 14 | where 15 | combs = combinations d f top s 16 | count xs = multiBinomial $ map length (group xs) 17 | 18 | main = print $ solve 20 12 10 70 19 | -------------------------------------------------------------------------------- /src/249.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Primes (primesTo, testPrime) 3 | import qualified Data.Vector.Unboxed as V 4 | import Data.Vector.Unboxed ((!)) 5 | import Data.List (foldl') 6 | 7 | dynamic :: Int -> [Int] -> V.Vector Int -> V.Vector Int 8 | dynamic _ [] dp = dp 9 | dynamic modulo (x:xs) dp = dynamic modulo xs dp' where 10 | dp' = V.fromList $ map (\i -> (dp!i + dp!((i - x) `mod` n)) `rem` modulo) [0 .. n - 1] 11 | n = V.length dp 12 | 13 | solve n modulo = dynamic modulo primes dp where 14 | dp = V.fromList (1 : replicate (sum primes) 0) 15 | primes = primesTo n 16 | 17 | main = print $ foldl' helper 0 $ zip [0 .. ] $ V.toList (solve 5000 modulo) where 18 | helper s (i, ways) = if testPrime i 19 | then (s + ways) `rem` modulo 20 | else s 21 | modulo = 10^16 22 | -------------------------------------------------------------------------------- /src/25.hs: -------------------------------------------------------------------------------- 1 | main = print $ snd . head $ rest where 2 | fib' = 1 : 1 : zipWith (+) fib' (tail fib') 3 | fib = zip fib' [1 .. ] 4 | rest = dropWhile (\(f, index) -> (length . show $ f) < 1000) fib 5 | -------------------------------------------------------------------------------- /src/250.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Numbers (powMod) 3 | import qualified Data.Vector.Unboxed as V 4 | import Data.Vector.Unboxed ((!)) 5 | 6 | dynamic :: Int -> Int -> V.Vector Int -> Int 7 | dynamic _ 0 dp = V.head dp 8 | dynamic modulo x dp = dynamic modulo (x - 1) dp' where 9 | dp' = V.fromList $ map (\i -> (dp!i + dp!((i - r) `mod` n)) `mod` modulo) [0 .. n - 1] 10 | r = powMod x x 250 11 | n = V.length dp 12 | 13 | solve n modulo = pred $ dynamic modulo n dp where 14 | dp = V.fromList (1 : replicate 249 0) 15 | 16 | main = print $ solve 250250 (10^16) 17 | -------------------------------------------------------------------------------- /src/258.hs: -------------------------------------------------------------------------------- 1 | 2 | import Control.Monad (forM_, when) 3 | import qualified Data.Vector.Unboxed.Mutable as MV 4 | import qualified Data.Vector.Unboxed as V 5 | import Data.Vector.Unboxed ((!)) 6 | 7 | modulo :: Int 8 | modulo = 20092010 9 | 10 | sumMod :: Int -> Int -> Int 11 | sumMod a b = (a + b) `mod` modulo 12 | 13 | mulMat :: Int -> V.Vector Int -> V.Vector Int -> V.Vector Int 14 | mulMat k a b = V.create $ do 15 | ret <- MV.replicate k 0 16 | forM_ [0 .. k - 1] $ \i -> do 17 | when ((a!i) /= 0) $ do 18 | forM_ [0 .. k - 1] $ \j -> do 19 | let v = (a!i) * (b!j) 20 | if (i + j >= k) 21 | then (update ret (i + j - k) v) >> (update ret (i + j - k + 1) v) 22 | else update ret (i + j) v 23 | return ret where 24 | update vec i d = do 25 | v <- MV.unsafeRead vec i 26 | MV.unsafeWrite vec i $ sumMod v d 27 | 28 | powMat :: Int -> Int -> V.Vector Int -> V.Vector Int 29 | powMat k p x = unit `seq` x `seq` helper k p x unit where 30 | unit = V.fromList $ (1 : (replicate (k - 1) 0)) 31 | helper k 0 a r = r 32 | helper k p a r = a' `seq` r' `seq` helper k (p `div` 2) a' r' where 33 | a' = mulMat k a a 34 | r' = if (odd p) 35 | then mulMat k r a 36 | else r 37 | 38 | solve :: Int -> [Int] -> [Int] -> Int -> Int 39 | solve k a f n = foldl sumMod 0 $ zipWith (*) f (V.toList power) where 40 | b = V.fromList $ reverse a 41 | baseMat = V.fromList $ 0 : 1 : (replicate (k - 2) 0) 42 | power = powMat k n baseMat 43 | 44 | main = print $ solve 2000 a f (10^18) where 45 | a = (replicate 1998 0) ++ [1, 1] 46 | f = replicate 2000 1 47 | 48 | -------------------------------------------------------------------------------- /src/26.hs: -------------------------------------------------------------------------------- 1 | -- <=> find minimal positive integer x satifying 10^x=1 (mod d) 2 | 3 | import Data.List (unfoldr, maximumBy) 4 | import Data.Function (on) 5 | 6 | cycleLength :: Int -> Int 7 | cycleLength n = 1 + length (unfoldr helper (10 `mod` n)) where 8 | helper 1 = Nothing 9 | helper x = Just (x, (x * 10) `mod` n) 10 | 11 | main = print $ maximumBy (compare `on` cycleLength) $ filter (\x -> x `mod` 2 /= 0 && x `mod` 5 /= 0) [3 .. 999] 12 | -------------------------------------------------------------------------------- /src/265.hs: -------------------------------------------------------------------------------- 1 | import Data.Bits (shiftL, shiftR, (.&.)) 2 | import Data.List (sort) 3 | 4 | n = 5 :: Int 5 | 6 | check :: Int -> Bool 7 | check x = sum xs == sum0 && sort xs == [0 .. mask] 8 | where 9 | xs = map (\d -> (shift d) .&. mask) [-n + 1 .. 2^n - n] 10 | sum0 = sum [0 .. mask] 11 | shift d | d < 0 = x `shiftL` (-d) 12 | | d >= 0 = x `shiftR` d 13 | mask = (1 `shiftL` n) - 1 14 | 15 | numbers = helper 0 (2^n-n) (2^(n-1)) 16 | where 17 | helper n 0 0 = [n] 18 | helper _ _ 0 = [] 19 | helper _ 0 _ = [] 20 | helper n d d1 = helper (n*2) (d-1) d1 ++ helper (n*2+1) (d-1) (d1-1) 21 | 22 | main = print $ sum $ filter check numbers 23 | -------------------------------------------------------------------------------- /src/266.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Primes (primesTo) 3 | import Data.List (sort) 4 | import Control.Monad (filterM) 5 | 6 | product1 [] = 1 7 | product1 xs = product xs 8 | 9 | powerset xs = filterM (const [True, False]) xs 10 | 11 | primes :: [Integer] 12 | primes = map toInteger $ primesTo 190 13 | 14 | n = product primes 15 | 16 | scanZip [] _ = [] 17 | scanZip _ [] = [] 18 | scanZip xs'@(x:xs) ys'@(y:ys) = case compare ((x*y)^2) n of 19 | LT -> (x*y) : scanZip xs ys' 20 | _ -> scanZip xs' ys 21 | 22 | solve = ret `mod` (10^16) where 23 | first21 = take 21 primes 24 | last21 = drop 21 primes 25 | xs = sort $ map product1 $ powerset first21 26 | ys = reverse $ sort $ map product1 $ powerset last21 27 | ret = maximum $ scanZip xs ys 28 | 29 | main = print solve 30 | -------------------------------------------------------------------------------- /src/267.hs: -------------------------------------------------------------------------------- 1 | import Data.Ratio 2 | import Text.Printf (printf) 3 | import qualified Common.Numbers.Numbers as N 4 | 5 | binomial :: [Integer] 6 | binomial = [ N.binomial 1000 k | k <- [0 .. 1000] ] 7 | 8 | win :: Double -> Int 9 | win f = times 10 | where 11 | base = (1 + 2*f) / (1 - f) 12 | times = floor $ log' (10**9) - 1000 * log' (1-f) :: Int 13 | log' x = log x / log base 14 | 15 | chance :: Double -> Rational 16 | chance = eval . win 17 | where eval times = (sum [binomial !! k | k <- [times .. 1000]]) % (2^1000) 18 | 19 | findMaximal :: Ord a => (Double -> a) -> Double 20 | findMaximal f = helper 0.0 1.0 0 21 | where 22 | helper l r iter | iter > 1000 = l 23 | | v1 < v2 = helper l mid2 (iter + 1) 24 | | otherwise = helper mid1 r (iter + 1) 25 | where 26 | mid1 = (r - l) / 3 + l 27 | mid2 = (r - l) / 3 * 2 + l 28 | v1 = f mid1 29 | v2 = f mid2 30 | 31 | main = printf "%.12f\n" (fromRational (chance (findMaximal win)) :: Double) 32 | -------------------------------------------------------------------------------- /src/269.hs: -------------------------------------------------------------------------------- 1 | 2 | -- Almost 3 roots. 3 | -- Estimate the middle result in allowance to give a result when evaluating the polynomial via Horner's rule. 4 | 5 | import Data.Array.Unboxed 6 | import Data.Array.ST 7 | import Control.Monad (when, forM_, guard) 8 | import Control.Monad.ST 9 | import Prelude hiding (read) 10 | 11 | n = 16 12 | r = 9 * (n `div` 2) 13 | 14 | write :: (MArray a e m, Ix i) => a i e -> i -> e -> m () 15 | write = writeArray 16 | 17 | read :: (MArray a e m, Ix i) => a i e -> i -> m e 18 | read = readArray 19 | 20 | add arr ix v = do 21 | v' <- read arr ix 22 | write arr ix (v + v') 23 | 24 | count r1 r2 r3 mu = runST $ do 25 | dp <- newArray ((0, -r, -r, -r), (n, r, r, r)) 0 :: ST s (STUArray s (Int, Int, Int, Int) Int) 26 | write dp (n, 0, 0, 0) 1 27 | forM_ [n, n - 1 .. 1] $ \i -> do 28 | forM_ [-r .. r] $ \a -> do 29 | forM_ [-r .. r] $ \b -> do 30 | forM_ [-r .. r] $ \c -> do 31 | v <- read dp (i, a, b, c) 32 | when (v /= 0) $ do 33 | let digits = if (i == 1) then [1 .. 9] else [0 .. 9] 34 | forM_ digits $ \d -> do 35 | let a' = a * (-r1) + d 36 | let b' = b * (-r2) + d 37 | let c' = c * (-r3) + d 38 | when (between (-r, r) a' b' c') $ do 39 | add dp (i - 1, a', b', c') v 40 | ret <- read dp (0, 0, 0, 0) 41 | return $ mu * ret 42 | where 43 | between (l, r) a b c = (between' a) && (between' b) && (between' c) where 44 | between' a = (l <= a) && (a <= r) 45 | 46 | solve = 10^(n-1) + s1 + s2 + s3 where 47 | s1 = sum $ do 48 | r1 <- [1 .. 9] 49 | r2 <- [r1+1 .. 9] 50 | r3 <- [r2+1 .. 9] 51 | guard (r1*r2*r3 <= 9) 52 | return $ count r1 r2 r3 1 53 | s2 = sum $ do 54 | r1 <- [1 .. 9] 55 | r2 <- [r1+1 .. 9] 56 | guard (r1*r2 <= 9) 57 | return $ count r1 r1 r2 (-1) 58 | s3 = sum $ do 59 | r <- [1 .. 9] 60 | return $ count r r r 1 61 | 62 | main = print $ solve 63 | -------------------------------------------------------------------------------- /src/27.hs: -------------------------------------------------------------------------------- 1 | import Data.Foldable (maximumBy) 2 | import Data.Function (on) 3 | import Common.Numbers.Primes (testPrime) 4 | import Common.List (maximumBy') 5 | 6 | produceLength (a, b) = length $ takeWhile (testPrime . (\n -> n^2+a*n+b)) [0 .. ] 7 | 8 | main = print $ uncurry (*) result where 9 | result = maximumBy' (compare `on` produceLength) $ [ (a,b) | a <- [-999 .. 999], b <- [-999 .. 999] ] 10 | -------------------------------------------------------------------------------- /src/271.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Numbers (crt2, inverse') 3 | import Common.Numbers.Primes (primesTo) 4 | import Control.Monad (foldM) 5 | 6 | primes :: [Integer] 7 | primes = map toInteger $ primesTo 43 -- product primes == 13082761331670030 8 | 9 | get p = [ (p, x) | x <- [1 .. p - 1], (x ^ 3) `mod` p == 1 ] 10 | 11 | solve :: [(Integer, Integer)] 12 | solve = foldM (\(ps, a) xs -> map (\(p, x) -> (ps * p, crt2 (ps, a) (p, x))) xs) (1, 1) $ map get primes 13 | 14 | main = print $ pred $ sum $ map snd solve 15 | -------------------------------------------------------------------------------- /src/28.hs: -------------------------------------------------------------------------------- 1 | solve n = 4 * part1 - 6 * part2 - 3 where 2 | part1 = sum [x^2 | x <- [1, 3 .. n]] 3 | part2 = sum [2, 4 .. n - 1] 4 | 5 | main = print $ solve 1001 6 | -------------------------------------------------------------------------------- /src/286.hs: -------------------------------------------------------------------------------- 1 | import qualified Data.MemoCombinators as Memo 2 | import Text.Printf (printf) 3 | 4 | prob :: Double -> Double 5 | prob q = dp 50 20 6 | where 7 | dp n k = Memo.memo2 Memo.integral Memo.integral dp' n k 8 | where 9 | dp' 0 0 = 1 10 | dp' n k | n < k = 0 11 | | k < 0 = 0 12 | | otherwise = (dp (n - 1) k) * (1 - hit) + (dp (n - 1) (k - 1)) * hit 13 | where 14 | hit = 1 - (fromIntegral n) / q 15 | 16 | solve :: Double 17 | solve = helper 50 53 0 18 | where 19 | helper l r iter | iter > 1000 = l 20 | | v > 0.02 = helper mid r (iter + 1) 21 | | otherwise = helper l mid (iter + 1) 22 | where 23 | mid = (l + r) / 2 24 | v = prob mid 25 | 26 | main = printf "%.10f\n" solve 27 | -------------------------------------------------------------------------------- /src/29.hs: -------------------------------------------------------------------------------- 1 | import Data.List (nub) 2 | 3 | main = print $ length $ nub [ a^b | a <- [2 .. 100], b <- [2 .. 100] ] 4 | -------------------------------------------------------------------------------- /src/3.hs: -------------------------------------------------------------------------------- 1 | maxFactor x = helper x 2 where 2 | divide x p = until (\x -> x `mod` p /= 0) (`div` p) x 3 | helper x p | x < p * p = x 4 | | x `mod` p == 0 = max p $ helper (divide x p) (p + 1) 5 | | otherwise = helper x (p + 1) 6 | 7 | main = print $ maxFactor 600851475143 8 | -------------------------------------------------------------------------------- /src/30.hs: -------------------------------------------------------------------------------- 1 | import Data.List (unfoldr) 2 | 3 | sumOfDigit5 = sum . map (^5) . unfoldr helper where 4 | helper 0 = Nothing 5 | helper x = Just (x `mod` 10, x `div` 10) 6 | 7 | main = print $ sum $ filter (\x -> x == (sumOfDigit5 x)) [2 .. 999999] 8 | -------------------------------------------------------------------------------- /src/304.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeFamilies #-} 2 | 3 | import qualified Common.Numbers.Primes as P 4 | import qualified Common.Matrix.Matrix as M 5 | import Common.NumMod.MkNumMod 6 | import Data.List (foldl') 7 | 8 | mkNumMod True 1234567891011 9 | type Zn = Int1234567891011 10 | 11 | primes = take 100000 $ filter P.testPrime [10^14 .. ] :: [Int] 12 | 13 | fibonacci :: Int -> Zn 14 | fibonacci n = (base `M.power` n) M.! (1, 2) 15 | where 16 | base = M.fromList 2 2 [1, 1, 1, 0] 17 | 18 | main = print $ foldl' (+) 0 $ map fibonacci primes 19 | -------------------------------------------------------------------------------- /src/307.hs: -------------------------------------------------------------------------------- 1 | import Text.Printf (printf) 2 | import qualified Data.Vector.Unboxed as V 3 | 4 | logs :: V.Vector Double 5 | logs = V.fromList ps 6 | where 7 | xs = [ log (fromIntegral k) | k <- [1 .. 1000000] ] 8 | ps = zipWith (+) xs (0:ps) 9 | 10 | logSum :: Int -> Int -> Double 11 | logSum a b | a > b = 0 12 | | otherwise = ask b - ask (a-1) 13 | where ask 0 = 0 14 | ask k = logs V.! (k-1) 15 | 16 | binomial_log :: Int -> Int -> Double 17 | binomial_log n k = logSum (n - k + 1) n - logSum 1 k 18 | 19 | permutation_log :: Int -> Int -> Double 20 | permutation_log n k = logSum (n - k + 1) n 21 | 22 | solve :: Int -> Int -> Double 23 | solve n k = 1 - below2 24 | where 25 | total = (fromIntegral k) * (log $ fromIntegral n) 26 | below2 = sum $ map f [0 .. k `div` 2] 27 | f x = exp $ binomial_log n (k-x) + permutation_log (k-x) x + permutation_log k (k-x) - (fromIntegral x) * log 2 - total 28 | 29 | main = printf "%.10f\n" $ solve 1000000 20000 30 | 31 | {- Since Haskell doesn't provide a `long double` primitive, 32 | now this code is suffering from precision issue. 33 | The following C++ code provides the correct answer. 34 | 35 | #include 36 | 37 | using namespace std; 38 | 39 | const int maxN = 1000000 + 10; 40 | 41 | typedef long double ld; 42 | 43 | ld logs[maxN]; 44 | 45 | ld binomial_log(int n, int k) { 46 | return logs[n] - logs[n - k] - logs[k]; 47 | } 48 | 49 | ld permutation_log(int n, int k) { 50 | return logs[n] - logs[n - k]; 51 | } 52 | 53 | int main() { 54 | for (int i = 1; i < maxN; ++i) { 55 | logs[i] = logs[i - 1] + log(ld(i)); 56 | } 57 | int n = 1000000, k = 20000; 58 | double ret = 1, total = k * log(ld(n)); 59 | for (int i = 0; i <= k / 2; ++i) { 60 | ret -= exp(binomial_log(n, k - i) + permutation_log(k - i, i) + permutation_log(k, k - i) - i * log(2.0) - total); 61 | } 62 | printf("%.10f\n", double(ret)); 63 | return 0; 64 | } 65 | 66 | -} 67 | -------------------------------------------------------------------------------- /src/31.hs: -------------------------------------------------------------------------------- 1 | -- dynamic programming 2 | 3 | dp :: [Int] -> Int -> [Int] 4 | dp v p = ret where 5 | ret = [ (v !! i) + (f i) | i <- [0 .. (length v) - 1] ] 6 | f i = if i >= p 7 | then ret !! (i - p) 8 | else 0 9 | 10 | main = print $ v !! 200 where 11 | v = foldl dp dp0 [1, 2, 5, 10, 20, 50, 100, 200] 12 | dp0 = 1 : (take 200 $ repeat 0) 13 | -------------------------------------------------------------------------------- /src/310.hs: -------------------------------------------------------------------------------- 1 | 2 | import Data.Bits (xor) 3 | import Data.Array.Unboxed 4 | import Data.Array.ST 5 | import Control.Monad 6 | import Control.Monad.ST 7 | import Data.List (sort, nub) 8 | 9 | grundy :: Int -> UArray Int Int 10 | grundy n = runSTUArray $ do 11 | ret <- newArray (0, n) 0 12 | forM_ [1 .. n] $ \i -> do 13 | sgs <- forM [1 .. (isqrt i)] $ \j -> readArray ret (i - j * j) 14 | writeArray ret i (mex sgs) 15 | return ret 16 | where isqrt = floor . sqrt . fromIntegral 17 | mex xs = if null xs'' 18 | then length xs' 19 | else fst $ head xs'' 20 | where 21 | xs' = zip [0 .. ] $ (nub . sort) xs 22 | xs'' = dropWhile (\(x, y) -> x == y) xs' 23 | 24 | solve n = answer where 25 | sg = grundy n 26 | bound = maximum (elems sg) 27 | count :: UArray Int Int 28 | count = runSTUArray $ do 29 | ret <- newArray (0, bound) 0 30 | forM_ [0 .. n] $ \i -> do 31 | v <- readArray ret (sg!i) 32 | writeArray ret (sg!i) (v + 1) 33 | return ret 34 | a = sum $ do 35 | i <- [0 .. bound] 36 | j <- [0 .. bound] 37 | k <- [0 .. bound] 38 | guard $ (i `xor` j `xor` k) == 0 39 | return $ (count!i) * (count!j) * (count!k) 40 | b = count!0 41 | c = count!0 * n 42 | answer = (a + 5 * b + 3 * c) `div` 6 43 | 44 | main = print $ solve 100000 45 | -------------------------------------------------------------------------------- /src/317.hs: -------------------------------------------------------------------------------- 1 | import Text.Printf (printf) 2 | 3 | v = 20.0 :: Double 4 | g = 9.81 :: Double 5 | y_min = -100.0 :: Double 6 | y_max = v * v / 2 / g 7 | 8 | f y = pi * v4 / g2 * y - pi * v2 / g * y * y 9 | where 10 | v2 = v * v 11 | v4 = v2 * v2 12 | g2 = g * g 13 | 14 | main = printf "%.4f\n" $ f y_max - f y_min 15 | -------------------------------------------------------------------------------- /src/32.hs: -------------------------------------------------------------------------------- 1 | import Data.List 2 | 3 | findAll :: Int -> [Int] 4 | findAll a = [ a*b | b <- [1 .. 987], check a b ] where 5 | check a b = ['1' .. '9'] == (sort $ (show a) ++ (show b) ++ (show $ a*b)) 6 | 7 | main = print $ sum l where 8 | l = nub $ foldl' (++) [] [ findAll x | x <- [1 .. 9876] ] 9 | -------------------------------------------------------------------------------- /src/323.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Numbers (binomial) 2 | import Text.Printf (printf) 3 | 4 | f :: [Double] 5 | f = 0 : map g [1 .. 32] 6 | where 7 | g :: Integer -> Double 8 | g n = b / (a - 1) 9 | where 10 | a, b :: Double 11 | a = 2.0 ** (fromIntegral n) 12 | b = sum [ fromIntegral (binomial n k) * (f !! fromIntegral k) | k <- [0 .. n - 1] ] + a 13 | 14 | main = putStrLn $ printf "%.10f" (f !! 32) 15 | -------------------------------------------------------------------------------- /src/33.hs: -------------------------------------------------------------------------------- 1 | 2 | main = print b where 3 | magic = [ (a,c) | a <- [1 .. 9], b <- [1 .. 9], c <- [a+1 .. 9], (10*a+b)*c == (10*b+c)*a || (10*b+a)*c == (10*c+b)*a ] 4 | (numerator, denominator) = unzip magic 5 | a' = product numerator 6 | b' = product denominator 7 | g = gcd a' b' 8 | a = a' `div` g 9 | b = b' `div` g 10 | 11 | -------------------------------------------------------------------------------- /src/34.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Numbers (factorial) 2 | import Data.List (unfoldr) 3 | 4 | sumOfDF x = sum $ map factorial $ unfoldr helper x where 5 | helper 0 = Nothing 6 | helper x = Just (x `mod` 10, x `div` 10) 7 | 8 | main = print $ sum l where 9 | l = [ x | x <- [10 .. 7*(factorial 9)], x == (sumOfDF x) ] 10 | -------------------------------------------------------------------------------- /src/345.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad (forM_, when) 2 | import Control.Monad.ST 3 | import Data.Array.ST 4 | import Data.Array ((!)) 5 | import Data.Bits ((.|.)) 6 | 7 | readInput :: IO [[Int]] 8 | readInput = readFile "input/p345_input.txt" >>= process 9 | where process d = return $ map (map read . words) (lines d) 10 | 11 | solve :: [[Int]] -> Int 12 | solve input = runST $ do 13 | let n = length input 14 | matrix0 <- newArray ((0, 0), (n - 1, n - 1)) 0 :: ST s (STArray s (Int, Int) Int) 15 | dp <- newArray ((0, 0), (n - 1, 2^n-1)) (-1) :: ST s (STArray s (Int, Int) Int) 16 | forM_ [0 .. n - 1] $ \i -> 17 | forM_ [0 .. n - 1] $ \j -> 18 | writeArray matrix0 (i, j) $ (input !! i) !! j 19 | matrix <- freeze matrix0 20 | forM_ [0 .. n - 1] $ \i -> writeArray dp (0, 2^i) $ matrix ! (0, i) 21 | forM_ [0 .. n - 2] $ \i -> 22 | forM_ [0 .. (2^n) - 1] $ \mask -> do 23 | val <- readArray dp (i, mask) 24 | when (val /= (-1)) $ 25 | forM_ [0 .. n - 1] $ \j -> do 26 | let mask0 = mask .|. (2^j) 27 | when (mask0 /= mask) $ do 28 | let val0 = val + matrix ! (i + 1, j) 29 | old <- readArray dp (i + 1, mask0) 30 | writeArray dp (i + 1, mask0) (max old val0) 31 | readArray dp (n - 1, 2^n-1) 32 | 33 | main = readInput >>= (print . solve) 34 | -------------------------------------------------------------------------------- /src/346.hs: -------------------------------------------------------------------------------- 1 | import Common.Utils (isqrt) 2 | import Common.List (nub') 3 | 4 | n = 10^12 :: Int 5 | root = isqrt n 6 | 7 | get :: Int -> [Int] 8 | get m = tail $ takeWhile (<= n) $ go (m + 1) 9 | where 10 | go x = x : go (x * m + 1) 11 | 12 | repunits :: [Int] 13 | repunits = 1 : nub' (concatMap get [2 .. root]) 14 | 15 | main = print $ sum repunits 16 | -------------------------------------------------------------------------------- /src/347.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Primes (primesTo) 2 | import Common.List (maximum') 3 | 4 | n = 10000000 :: Int 5 | 6 | primes = primesTo n :: [Int] 7 | 8 | solve :: Int -> Int -> Int 9 | solve p q = maximum' xs 10 | where 11 | ps = p : map (\p0 -> p0 * p) ps 12 | qs = q : map (\q0 -> q0 * q) qs 13 | xs = [ p0 * q0 | p0 <- takeWhile (<= n) ps, q0 <- takeWhile (<= n `div` p0) qs ] 14 | 15 | main = print $ sum [ solve p q | p <- primes, q <- takeWhile (\q -> q <= n `div` p && q < p) primes ] 16 | -------------------------------------------------------------------------------- /src/35.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Primes (testPrime) 2 | import Common.List (rotate, nub') 3 | import Control.Monad (foldM) 4 | 5 | rotateNumber :: Int -> [Int] 6 | rotateNumber x = nub' $ map (\y -> read (rotate y s)) [1 .. length s] where 7 | s = show x 8 | 9 | main = print $ length result where 10 | primes = filter testPrime $ nub' $ foldM helper 0 $ replicate 6 [1, 3, 7, 9] where 11 | helper a xs = a : map (\x -> a * 10 + x) xs 12 | result = 2 : 5 : filter helper primes where 13 | helper x = all (\y -> y `elem` primes) (rotateNumber x) 14 | 15 | -------------------------------------------------------------------------------- /src/356.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeFamilies #-} 2 | 3 | import qualified Common.Matrix.Matrix as M 4 | import Common.NumMod.MkNumMod 5 | 6 | mkNumMod True 100000000 7 | type Zn = Int100000000 8 | 9 | solve :: Integer -> Zn 10 | solve n = (((mat `M.power` p) `M.multiply` initial) M.! (1, 1)) - 1 11 | where 12 | p = 987654321 :: Int 13 | mat = M.fromList 3 3 [0, 1, 0, 0, 0, 1, fromInteger $ -n, 0, 2^n] 14 | initial = M.fromList 3 1 [3, 2^n, 4^n] 15 | 16 | main = print $ sum [ solve i | i <- [1 .. 30] ] 17 | -------------------------------------------------------------------------------- /src/357.hs: -------------------------------------------------------------------------------- 1 | 2 | import Data.Array.Unboxed 3 | import Data.Array.ST 4 | import Control.Monad (forM_) 5 | import Control.Monad 6 | import Common.Utils (isqrt) 7 | 8 | primesTo :: Int -> UArray Int Bool 9 | primesTo m = runSTUArray $ do 10 | sieve <- newArray (2, m) True 11 | let root = isqrt m 12 | forM_ [2 .. root] $ \i -> do 13 | isPrime <- readArray sieve i 14 | when isPrime $ do 15 | forM_ [i^2, i^2+i .. m] $ \j -> do 16 | writeArray sieve j False 17 | return sieve 18 | 19 | primes = primesTo (10^8) 20 | primeList = map fst $ filter (id . snd) $ assocs primes 21 | 22 | solve = solveIter primeList 0 where 23 | solveIter [] sum = sum 24 | solveIter (p:ps) sum = solveIter ps sum' where 25 | sum' = sum + delta 26 | k = p - 1 27 | root = isqrt k 28 | wanted = and $ do 29 | d <- [1 .. root] 30 | guard ((k `mod` d) == 0) 31 | return $ primes ! (d + k `div` d) 32 | delta = if wanted then k else 0 33 | 34 | main = print solve 35 | -------------------------------------------------------------------------------- /src/36.hs: -------------------------------------------------------------------------------- 1 | import Data.List (unfoldr, reverse) 2 | import Data.Char (chr, ord) 3 | 4 | decToBin :: Int -> String 5 | decToBin x = reverse $ unfoldr helper x where 6 | helper 0 = Nothing 7 | helper x = Just (chr ((ord '0') + (x `mod` 2)), x `div` 2) 8 | 9 | palindromic xs = xs == reverse xs 10 | 11 | main = print $ sum $ [ x | x <- [1 .. 999999], palindromic (show x), palindromic (decToBin x) ] 12 | -------------------------------------------------------------------------------- /src/365.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.MapReduce (mapReduce) 3 | import Common.Numbers.Primes (primesTo) 4 | import Common.Numbers.Numbers (inverse') 5 | import Data.List (tails) 6 | import Data.Array.ST 7 | import Data.Array.Unboxed 8 | import Control.Monad.ST 9 | import Control.Monad 10 | 11 | combinations :: Int -> [a] -> [[a]] 12 | combinations 0 _ = [[]] 13 | combinations n xs = [y:ys | y:xs' <- tails xs, ys <- combinations (n-1) xs'] 14 | 15 | crt3 :: [(Int, Int)] -> Int 16 | crt3 xs = ((a * m1) + (b * m2) + (c * m3)) `mod` n where 17 | (p1, m1) = xs!!0 18 | (p2, m2) = xs!!1 19 | (p3, m3) = xs!!2 20 | n = p1 * p2 * p3 21 | a = ((inverse' (p2 * p3) p1) * (p2 * p3)) `mod` n 22 | b = ((inverse' (p1 * p3) p2) * (p1 * p3)) `mod` n 23 | c = ((inverse' (p1 * p2) p3) * (p1 * p2)) `mod` n 24 | 25 | factorialInverse p = runSTUArray $ do 26 | inv <- newListArray (0, p - 1) (take p (1:1:(repeat 0))) 27 | forM_ [2 .. p - 1] $ \i -> do 28 | x <- readArray inv (p `mod` i) 29 | writeArray inv i $ (x * (p - (p `div` i))) `mod` p 30 | forM_ [2 .. p - 1] $ \i -> do 31 | x <- readArray inv (i - 1) 32 | y <- readArray inv i 33 | writeArray inv i $ (x * y) `mod` p 34 | return inv 35 | 36 | factorial p = runSTUArray $ do 37 | ret <- newListArray (0, p - 1) (take p (1:(repeat 0))) 38 | forM_ [1 .. p - 1] $ \i -> do 39 | x <- readArray ret (i - 1) 40 | writeArray ret i $ (x * i) `mod` p 41 | return ret 42 | 43 | -- Lucas theorem 44 | lucas p n m = productMod (zipWith (lucas' p) (expand n p) (expand m p)) where 45 | expand 0 p = [] 46 | expand n p = (n `mod` p) : expand (n `div` p) p 47 | xs = factorial p 48 | ys = factorialInverse p 49 | lucas' p n m = case compare n m of 50 | LT -> 0 51 | _ -> ((xs!n) * (ys!m) * (ys!(n-m))) `mod` p 52 | productMod xs = foldl helper 1 xs where 53 | helper accum x = (accum * x) `mod` p 54 | 55 | solve = mapReduce 23 solve sum [0 .. (length primes) - 1] where 56 | primes = dropWhile (<= 1000) $ primesTo 5000 57 | binomials = zip primes $ map (\p -> lucas p (10^18) (10^9)) primes 58 | solve i = sum $ map (\r -> crt3 (h:r)) rs where 59 | h = binomials !! i 60 | rs = combinations 2 $ drop (i + 1) binomials 61 | 62 | main = print solve 63 | -------------------------------------------------------------------------------- /src/37.hs: -------------------------------------------------------------------------------- 1 | import Data.List (all) 2 | import Common.Numbers.Primes (testPrime) 3 | 4 | main = print $ ret - (2 + 3 + 5 + 7) where 5 | ret = sum $ filter check $ concat $ map get [2, 3, 5, 7] 6 | check x = (testPrime x) && (all testPrime (takeWhile (< x) (map (\d -> x `mod` d) ds))) where 7 | ds = 10 : map (* 10) ds 8 | get x = if testPrime x 9 | then x : concat (map (\y -> get (x * 10 + y)) [1, 3, 7, 9]) 10 | else [] 11 | 12 | -------------------------------------------------------------------------------- /src/371.hs: -------------------------------------------------------------------------------- 1 | import qualified Data.Array.Unboxed as A 2 | import qualified Data.Array.MArray as MA 3 | import Data.Array.ST (runSTUArray) 4 | import Data.Ix (Ix) 5 | import Control.Monad (forM_) 6 | import Text.Printf (printf) 7 | 8 | import Common.Utils (modifyArray, initArray) 9 | 10 | type DPArray = A.UArray (Int, Bool) Double 11 | 12 | addArray :: Num e => (MA.MArray a e m, Ix i) => a i e -> i -> e -> m () 13 | addArray a i d = modifyArray a (+ d) i 14 | 15 | go :: DPArray -> (DPArray, Double) 16 | go dp0 = getProbability $ runSTUArray $ do 17 | dp1 <- MA.newArray ((0, False), (500, True)) 0 18 | forM_ [0 .. 499] $ \s -> do 19 | let v = dp0 A.! (s, False) 20 | addArray dp1 (s, False) $ v * (fromIntegral s + 1) / 1000 21 | addArray dp1 (s, True) $ v * 1 / 1000 22 | addArray dp1 (s + 1, False) $ v * (998 - 2 * fromIntegral s) / 1000 23 | let v = dp0 A.! (s, True) 24 | addArray dp1 (s, True) $ v * (fromIntegral s + 1) / 1000 25 | addArray dp1 (s + 1, True) $ v * (998 - 2 * fromIntegral s) / 1000 26 | return dp1 27 | where 28 | getProbability a = (a, v) 29 | where v = sum [ a A.! (s, b) | s <- [0 .. 499], b <- [False, True] ] 30 | 31 | solve = succ $ sum $ map snd $ take 500 $ iterate (go . fst) (init, 1) 32 | where 33 | init :: DPArray 34 | init = runSTUArray $ initArray ((0, False), (500, True)) 0 [((0, False), 1/1000), ((0, True), 1/1000), ((1, False), 998/1000)] 35 | 36 | main = printf "%.8f\n" solve 37 | -------------------------------------------------------------------------------- /src/378.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeFamilies #-} 2 | 3 | -- TODO: ~15 minutes, needs profiling 4 | 5 | import Control.Monad (forM_, when) 6 | import Control.Monad.ST (runST, ST) 7 | import Control.Monad.Primitive 8 | import qualified Data.Vector.Unboxed as V 9 | import qualified Data.Vector.Unboxed.Mutable as MV 10 | import qualified Common.DataStructure.Fenwick as F 11 | import Common.NumMod.MkNumMod 12 | 13 | import Prelude hiding (read) 14 | 15 | mkNumMod True 1000000000000000000 16 | type Zn = Int1000000000000000000 17 | 18 | (!) = (V.!) 19 | 20 | read :: (PrimMonad m, MV.Unbox a) => MV.MVector (PrimState m) a -> Int -> m a 21 | read = MV.unsafeRead 22 | 23 | write :: (PrimMonad m, MV.Unbox a) => MV.MVector (PrimState m) a -> Int -> a -> m () 24 | write = MV.unsafeWrite 25 | 26 | eratos :: Int -> V.Vector Int 27 | eratos n = V.create $ do 28 | isPrime <- MV.replicate (n + 1) True 29 | minPrimePart <- V.thaw $ V.fromList [0 .. n] 30 | sumOfDivisors <- MV.replicate (n + 1) 2 31 | write sumOfDivisors 1 1 32 | forM_ [2 .. n] $ \i -> do 33 | prime <- read isPrime i 34 | when prime $ 35 | forM_ [i^2, i^2 + i .. n] $ \j -> do 36 | prime' <- read isPrime j 37 | when prime' $ do 38 | write isPrime j False 39 | let q = j `div` i 40 | minPrime' <- read minPrimePart q 41 | if minPrime' `mod` i == 0 42 | then write minPrimePart j (minPrime' * i) 43 | else write minPrimePart j i 44 | d1 <- read minPrimePart j 45 | when (d1 == j) $ do 46 | s <- read sumOfDivisors q 47 | write sumOfDivisors j (s + 1) 48 | forM_ [2 .. n] $ \i -> do 49 | d1 <- read minPrimePart i 50 | let d2 = i `div` d1 51 | when (d1 /= i) $ do 52 | s1 <- read sumOfDivisors d1 53 | s2 <- read sumOfDivisors d2 54 | write sumOfDivisors i (s1 * s2) 55 | return sumOfDivisors 56 | 57 | buildDT :: Int -> V.Vector Int 58 | buildDT n = V.fromList $ map f [0 .. n] 59 | where 60 | d = eratos (n + 1) 61 | f 0 = 0 62 | f i | odd i = (d!i) * (d!((i + 1) `div` 2)) 63 | | otherwise = (d!(i `div` 2)) * (d!(i + 1)) 64 | 65 | solve :: Int -> Zn 66 | solve n = runST $ do 67 | let dT = buildDT n 68 | let maxd = V.maximum dT 69 | dp1 <- F.make maxd :: ST s (F.Fenwick (ST s) Zn) 70 | dp2 <- F.make maxd 71 | dp3 <- F.make maxd 72 | V.forM_ (V.drop 1 dT) $ \d -> do 73 | F.modify dp1 (+) d 1 74 | F.askLR dp1 (+) (d + 1) maxd >>= F.modify dp2 (+) d 75 | F.askLR dp2 (+) (d + 1) maxd >>= F.modify dp3 (+) d 76 | F.ask dp3 (+) maxd 77 | 78 | main = print $ solve 60000000 79 | -------------------------------------------------------------------------------- /src/38.hs: -------------------------------------------------------------------------------- 1 | import Data.List (sort) 2 | import Control.Monad (guard) 3 | 4 | concatProduct :: Int -> String 5 | concatProduct n = head $ dropWhile (\s -> (length s) < 9) prefix where 6 | prefix :: [String] 7 | prefix = [] : zipWith (++) prefix [ show (n * i) | i <- [1 .. 9] ] 8 | 9 | main = print $ maximum $ do 10 | x <- [1 .. 9999] 11 | let y = concatProduct x 12 | guard $ sort y == ['1' .. '9'] 13 | return ((read y) :: Int) 14 | -------------------------------------------------------------------------------- /src/381.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Primes (primesTo) 3 | import Common.Numbers.Numbers (inverse') 4 | import Data.Array.Unboxed 5 | import Data.Array.ST 6 | import Control.Monad (forM_) 7 | import Control.Monad 8 | 9 | primes = drop 2 $ primesTo (10^8) 10 | 11 | primeFactorial p = (-1 - a - ab - abc - abcd) `mod` p where 12 | a = p - 1 -- inverse' (p - 1) p 13 | b = inverse' (p - 2) p 14 | c = inverse' (p - 3) p 15 | d = inverse' (p - 4) p 16 | ab = (a * b) `mod` p 17 | abc = (ab * c) `mod` p 18 | abcd = (abc * d) `mod` p 19 | 20 | solve = sum $ map primeFactorial primes 21 | 22 | main = print solve 23 | -------------------------------------------------------------------------------- /src/39.hs: -------------------------------------------------------------------------------- 1 | import Data.Function (on) 2 | import Data.List (maximumBy) 3 | 4 | rightTriple p = [ (a,b,c) | a <- [1 .. p `div` 3], b <- [a .. ((p - a) `div` 2)], let c = p - a - b, a * a + b * b == c * c] 5 | 6 | main = print $ maximumBy (compare `on` length . rightTriple) [1 .. 1000] 7 | -------------------------------------------------------------------------------- /src/394.hs: -------------------------------------------------------------------------------- 1 | import Text.Printf (printf) 2 | 3 | solve :: Double -> Double 4 | solve x = 2/9 * x**3 - 2/3 * log x + 7/9 5 | 6 | main = printf "%.10f\n" $ solve (1/40) 7 | -------------------------------------------------------------------------------- /src/4.hs: -------------------------------------------------------------------------------- 1 | import Data.List (sort, reverse) 2 | import Common.List (nub') 3 | 4 | main = print $ head $ filter palindromic $ (reverse . sort . nub') [ x * y | x <- [100 .. 999], y <- [100 .. 999] ] where 5 | palindromic x = s == (reverse s) where 6 | s = show x 7 | -------------------------------------------------------------------------------- /src/40.hs: -------------------------------------------------------------------------------- 1 | import Data.Char 2 | 3 | main = print $ product $ map digitToInt [ numberSeq !! i | i <- [1, 10, 100, 1000, 10000, 100000, 1000000] ] 4 | where numberSeq = '0' : (take 1000000 $ concatMap show [1 .. ]) 5 | -------------------------------------------------------------------------------- /src/401.hs: -------------------------------------------------------------------------------- 1 | import Data.List (foldl') 2 | 3 | sumModulo :: Int -> [Int] -> Int 4 | sumModulo m xs = foldl' helper 0 xs where 5 | helper accum x = (accum + (x `mod` m)) `mod` m 6 | 7 | sumSquared :: Int -> Int -> Int -> Int 8 | sumSquared m l r = case compare l r of 9 | GT -> 0 10 | _ -> ((sumSquared' m r) - (sumSquared' m (l - 1))) `mod` m 11 | where 12 | sumSquared' m n = fromInteger (((n' * (1 + n') * (1 + 2 * n')) `div` 6) `mod` m') where 13 | n' = toInteger n 14 | m' = toInteger m 15 | 16 | sigma2 :: Int -> Int -> Int 17 | sigma2 m n = (part1 + part2) `mod` m where 18 | root = (floor . sqrt . fromIntegral) n 19 | upper = n `div` (root + 1) 20 | part1 = sumModulo m [ (((((n `div` i) `mod` m) * i) `mod` m) * i) `mod` m | i <- [1 .. upper] ] 21 | part2 = sumModulo m $ do 22 | k <- [1 .. root] 23 | let lo = n `div` (k + 1) + 1 24 | let hi = n `div` k 25 | return $ (k * (sumSquared m lo hi)) `mod` m 26 | 27 | main = print $ sigma2 (10^9) (10^15) 28 | -------------------------------------------------------------------------------- /src/407.hs: -------------------------------------------------------------------------------- 1 | 2 | import Data.List (maximum) 3 | import Data.Array 4 | import Data.Array.ST 5 | import Control.Monad (forM_, liftM, filterM, when) 6 | import Control.Monad.ST 7 | import Common.Numbers.Numbers (inverse') 8 | 9 | data SieveItem = SieveItem { 10 | isP :: Bool, 11 | minP :: Int, 12 | minPExp :: Int 13 | } deriving (Show) 14 | 15 | maxN = 10^7 16 | sieve = eratos maxN 17 | 18 | eratos :: Int -> Array Int SieveItem 19 | eratos n = runSTArray $ do 20 | sieve <- newListArray (2, n) $ zipWith3 SieveItem (repeat True) [2 .. n] (repeat 1) 21 | forM_ [2 .. n] $ \i -> do 22 | isPrime <- liftM isP (readArray sieve i) 23 | when isPrime $ do 24 | forM_ [i^2, i^2 + i .. n] $ \j -> do 25 | isPrime' <- liftM isP (readArray sieve j) 26 | when isPrime' $ do 27 | let q = j `div` i 28 | qp <- liftM minP (readArray sieve q) 29 | qExp <- liftM minPExp (readArray sieve q) 30 | let jExp = if qp == i then (qExp + 1) else 1 31 | writeArray sieve j $ SieveItem False i jExp 32 | return sieve 33 | 34 | maxIdempotent 1 = 0 35 | maxIdempotent n = maximum idempotents 36 | where 37 | factorize 1 = [] 38 | factorize n = p : (factorize (n `div` p)) where p = (minP (sieve!n)) ^ (minPExp (sieve!n)) 39 | primitiveFactors = factorize n 40 | factors = map product (properPowerset primitiveFactors) 41 | idempotents = 1 : [ inv * p | p <- factors, let q = n `div` p, let inv = inverse' p q ] 42 | powerset xs = filterM (const [True, False]) xs 43 | properPowerset [] = [] 44 | properPowerset (x:[]) = [] 45 | properPowerset xs = tail $ reverse $ tail $ powerset xs 46 | 47 | main = print $ sum $ map maxIdempotent [1 .. maxN] 48 | -------------------------------------------------------------------------------- /src/41.hs: -------------------------------------------------------------------------------- 1 | 2 | import Data.List (permutations) 3 | import Common.Numbers.Primes (testPrime) 4 | 5 | -- 8 or 9-digit pandigital is divisable by 3 6 | main = print $ maximum candidate where 7 | candidate = filter testPrime $ map read (permutations "1234567") :: [Int] 8 | -------------------------------------------------------------------------------- /src/42.hs: -------------------------------------------------------------------------------- 1 | import Data.List 2 | import Data.Char 3 | 4 | solve :: String -> Int 5 | solve input = length triangleWord 6 | where words' = filter (\s -> (length s) >= 2) (groupBy (\a b -> ((a == ',') == (b == ','))) input) 7 | words = sort $ map (tail . init) words' 8 | wordValue s = sum $ map (\c -> ord c - ord 'A' + 1) s 9 | triangleNumber = [ (n * (n + 1)) `div` 2 | n <- [1 .. 100] ] 10 | triangleWord = [ x | x <- words, (wordValue x) `elem` triangleNumber ] 11 | 12 | main = readFile "input/p042_words.txt" >>= (print . solve) 13 | -------------------------------------------------------------------------------- /src/429.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Primes (primesTo) 2 | import Common.Numbers.Numbers (powMod) 3 | 4 | solve n modulo = productMod modulo $ map (\x -> ((powMod x (countExponent n x) modulo)^2 + 1) `mod` modulo) primes where 5 | productMod m xs = foldl helper 1 xs where 6 | helper accum x = (accum * x) `mod` m 7 | primes = primesTo n 8 | countExponent n p = sum $ takeWhile (/= 0) rs where 9 | rs = (n `div` p) : map (\x -> x `div` p) rs 10 | 11 | main = print $ solve (10^8) (10^9+9) 12 | -------------------------------------------------------------------------------- /src/43.hs: -------------------------------------------------------------------------------- 1 | 2 | import Data.List (permutations, tails) 3 | 4 | -- somehow a bit slow 5 | check :: [Integer] -> Integer -> Bool 6 | check [] x = True 7 | check (y:ys) x 8 | | (x `mod` 1000) `mod` y == 0 = check ys (x `div` 10) 9 | | otherwise = False 10 | 11 | main = print $ sum $ filter (check [17,13,11,7,5,3,2]) candidate 12 | where candidate = [ read x :: Integer | x <- (permutations "0123456789"), head x /= '0' ] 13 | -------------------------------------------------------------------------------- /src/432.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Utils (isqrt, if', submasks) 3 | import Common.Numbers.EulerPhi (phiTo) 4 | import Data.List (foldl') 5 | import Data.Bits 6 | import Control.Monad (guard) 7 | import qualified Data.MemoCombinators as Memo 8 | import qualified Data.Vector.Unboxed as V 9 | 10 | infixl 6 <+> 11 | (<+>) a b = (a + b) `rem` modulo 12 | modulo = 10^9 :: Int 13 | 14 | n = 10^11 :: Int 15 | n' = truncate $ (fromIntegral n) ** (2 / 3) 16 | 17 | bigPhi' = V.fromList $ bigPhi'' where 18 | phi' = 0 : drop 1 (phiTo n') 19 | bigPhi'' = 0 : zipWith (<+>) phi' bigPhi'' 20 | 21 | bigPhi m = if m <= n' 22 | then bigPhi' V.! m 23 | else Memo.bits bigPhiMemo m where 24 | bigPhiMemo m = (f - r1 - r2 + modulo + modulo) `rem` modulo where 25 | f = (m `rem` modulo) * ((m - 1) `rem` modulo) `quot` 2 `rem` modulo 26 | root = isqrt m 27 | r1 = foldl' (<+>) 0 $ map helper [1 .. root] where 28 | helper r = (bigPhi r) * (m `quot` r - m `quot` (r + 1)) `rem` modulo 29 | r2 = foldl' (<+>) 0 $ map helper [2 .. m `quot` (root + 1)] where 30 | helper d = bigPhi (m `quot` d) 31 | 32 | dynamic :: Int -> Int -> Int 33 | dynamic n 0 = (bigPhi n) + 1 34 | dynamic n mask = Memo.memo2 Memo.bits (Memo.arrayRange (0, 127)) dynamicMemo n mask where 35 | dynamicMemo n mask = if' (m == 0) 0 $ (<+>) ((bigPhi m) + 1) $ sum $ do 36 | sub <- submasks mask 37 | let cnt = foldl' (<+>) 0 $ do 38 | sub2 <- submasks mask 39 | guard $ (sub2 .&. sub) == sub 40 | return $ (miuMask ((complement sub) .&. sub2)) * (dynamic m sub2) 41 | let part1 = filterMask (sub .&. mask) 42 | let part2 = filterMask ((complement sub) .&. mask) 43 | let multiplier = (product part1) * (product (map pred part2)) - 1 44 | return $ cnt * multiplier `rem` modulo 45 | where 46 | m = n `quot` p 47 | p = product $ filterMask mask 48 | miuMask x = if' (odd (popCount x)) (modulo - 1) 1 49 | filterMask mask = map snd $ filter pred $ zip [0 .. 6] [2, 3, 5, 7, 11, 13, 17] where 50 | pred (i, x) = (mask .&. (1 `shiftL` i)) /= 0 51 | 52 | main = print $ dynamic ((10^11) * 510510) 127 53 | -------------------------------------------------------------------------------- /src/435.hs: -------------------------------------------------------------------------------- 1 | import qualified Common.Matrix.Matrix as M 2 | import qualified Common.Numbers.Numbers as N 3 | import Common.NumMod.NumMod 4 | 5 | modulo = 1307674368000 :: Int 6 | 7 | fibonacci :: Int -> Int -> IntMod 8 | fibonacci n m = head $ M.fromList 2 2 (map (fromInt m) [1, 1, 1, 0]) `M.power` (n-1) 9 | where 10 | head = \m -> m M.! (1, 1) 11 | 12 | f :: Int -> Int -> IntMod 13 | f n x = fromInt modulo $ b `div` a 14 | where 15 | m = modulo * a :: Int 16 | x' = fromInt m x :: IntMod 17 | a = x * x + x - 1 :: Int 18 | b = toInt $ f1 * (x' `N.fastpow` (n+2)) + f2 * (x' `N.fastpow` (n+1)) - x' 19 | f1 = fibonacci n m 20 | f2 = fibonacci (n + 1) m 21 | 22 | main = print $ sum [ f (10^15) i | i <- [1 .. 100] ] 23 | -------------------------------------------------------------------------------- /src/44.hs: -------------------------------------------------------------------------------- 1 | import qualified Data.Set as S 2 | import Data.List (sort) 3 | import Common.List (nub') 4 | 5 | {-- analysis: 6 | - It is equvilant to consider Q_n = n*(3n-1), denote the answer as Q_c/2, 7 | - then there exists a and b, with Q_b-Q_a=Q_c, by factorization, we get (b-a)(3b+3a-1)=Q_c, 8 | - then we can enumerate the divisor b-a, solve the equations to get a & b, and verify Q_a+Q_b by binary search. 9 | --} 10 | 11 | isPentagonal :: Integer -> Bool 12 | isPentagonal x = helper 1 (ceiling $ sqrt (fromIntegral x)) where 13 | helper l r 14 | | l > r = False 15 | | l == r = l * (3 * l - 1) == x 16 | | l < r = case (compare x midValue) of 17 | EQ -> True 18 | LT -> helper l (mid - 1) 19 | GT -> helper (mid + 1) r 20 | where mid = (l + r) `div` 2 21 | midValue = mid * (3 * mid - 1) 22 | 23 | pFactor :: Integer -> [Integer] 24 | pFactor x = nub' f where 25 | factor x = [ d | d <- [1 .. x], x `mod` d == 0 ] 26 | f1 = factor x 27 | f2 = factor (3*x-1) 28 | f = [ a*b | a <- f1, b <- f2 ] 29 | 30 | checkDiff index = any (\(a,b) -> isPentagonal (a*(3*a-1)+b*(3*b-1))) candidate where 31 | x = index * (3 * index - 1) 32 | f = pFactor index 33 | candidate = [ ((plus - minus) `div` 2, (plus + minus) `div` 2) | minus <- f, (x `div` minus + 1) `mod` 3 == 0, let plus = (x `div` minus + 1) `div` 3, plus > minus, even (plus - minus) ] 34 | 35 | main = print $ n*(3*n-1) `div` 2 where 36 | n = head $ dropWhile (not . checkDiff) [1 .. ] 37 | 38 | -------------------------------------------------------------------------------- /src/443.hs: -------------------------------------------------------------------------------- 1 | 2 | import Control.Arrow (first) 3 | import System.Random (mkStdGen) 4 | import Common.Numbers.Primes (factorize, toDivisors) 5 | 6 | solve :: Int -> Int 7 | solve n = n + 2 * k 8 | where 9 | k = fst . last $ takeWhile (\(a, _) -> a <= n) p3 10 | p3 = (20, mkStdGen 23) : map next p3 11 | next (n, g) = (n + k, g0) 12 | where 13 | (ds, g0) = toDivisors `first` factorize g (2 * n - 1) 14 | k = minimum [((n `div` d) + 1) * d - n | d <- drop 1 ds] 15 | 16 | main = print $ solve (10^15) 17 | -------------------------------------------------------------------------------- /src/45.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.List (intersect) 3 | 4 | triangle = [ n * (n + 1) `div` 2 | n <- [1 .. ] ] 5 | pentagonal = [ n * (3 * n - 1) `div` 2 | n <- [1 .. ] ] 6 | hexagonal = [ n * (2 * n - 1) | n <- [1 .. ] ] 7 | 8 | main = print $ is !! 2 9 | where is = triangle `intersect` (pentagonal `intersect` hexagonal) 10 | -------------------------------------------------------------------------------- /src/458.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeFamilies #-} 2 | 3 | import qualified Common.Matrix.Matrix as M 4 | import Common.NumMod.MkNumMod 5 | 6 | mkNumMod True 1000000000 7 | type Zn = Int1000000000 8 | 9 | solve :: Int -> Zn 10 | solve n = sum $ M.toList $ (matrix `M.power` (n - 1)) `M.multiply` from 11 | where 12 | matrix = M.fromLists [ [1, 1, 1, 1, 1, 1] 13 | , [6, 1, 1, 1, 1, 1] 14 | , [0, 5, 1, 1, 1, 1] 15 | , [0, 0, 4, 1, 1, 1] 16 | , [0, 0, 0, 3, 1, 1] 17 | , [0, 0, 0, 0, 2, 1] 18 | ] 19 | from = M.fromList 6 1 [7, 0, 0, 0, 0, 0] 20 | 21 | main = print $ solve (10^12) 22 | -------------------------------------------------------------------------------- /src/46.hs: -------------------------------------------------------------------------------- 1 | import qualified Data.Set as S 2 | import Common.Numbers.Primes (testPrime) 3 | 4 | findIt :: (S.Set Int) -> Int -> Int 5 | findIt p n = if testPrime n 6 | then findIt (S.insert n p) (n + 2) 7 | else if any (\x -> S.member (n - x) p) square2 then findIt p (n + 2) else n 8 | where square2 = takeWhile (\x -> x < n) [ 2*a*a | a <- [1 .. ] ] 9 | 10 | main = print $ findIt (S.fromList [2]) 3 11 | -------------------------------------------------------------------------------- /src/47.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Primes (primes') 3 | 4 | countPrimeFactors x = helper x primes' 0 where 5 | divide x p = until (\x -> x `rem` p /= 0) (`div` p) x 6 | helper x (p:ps) r | r >= 4 = 4 -- optimization 7 | | x < p * p = r + 1 8 | | x `rem` p == 0 = helper (divide x p) ps (r + 1) 9 | | otherwise = helper x ps r 10 | 11 | solve = helper pf 1 where 12 | pf = [ countPrimeFactors x | x <- [1 .. ] ] 13 | helper xs@(a:b:c:d:_) n = if a>=4 && b>=4 && c>=4 && d>=4 14 | then n 15 | else helper (tail xs) (n + 1) 16 | 17 | main = print solve 18 | 19 | -------------------------------------------------------------------------------- /src/479.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Numbers (powMod, inverse) 3 | import Data.List (foldl') 4 | 5 | solve :: Int 6 | solve = foldl' helper 0 $ -n : (map count [1 .. n]) where 7 | modulo = 10^9+7 8 | n = 10^6 9 | count k = ((powMod ((1 - k * k) `mod` modulo) (n + 1) modulo) + (modulo - 1)) * (inverse k modulo) `mod` modulo * (inverse (-k) modulo) `mod` modulo 10 | helper x y = (x + y) `mod` modulo 11 | 12 | main = print solve 13 | -------------------------------------------------------------------------------- /src/48.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Numbers (powMod) 3 | 4 | main = print $ (sum (map (\x -> powMod x x modulo) [1 .. 1000])) `mod` modulo where 5 | modulo = 10000000000 :: Integer 6 | 7 | -------------------------------------------------------------------------------- /src/49.hs: -------------------------------------------------------------------------------- 1 | import qualified Data.Set as S 2 | import Data.List (sort) 3 | import Common.Numbers.Primes (primesTo) 4 | 5 | main = putStrLn $ concatMap show [a,b,c] where 6 | prime4 = dropWhile (< 1000) (primesTo 10000) 7 | prime4S = S.fromList prime4 8 | perm = sort . show 9 | (a,b,c) = head $ [ (a,b,c) 10 | | a <- prime4, b <- prime4, 11 | a /= 1487, a < b, 12 | let c = 2 * b - a, 13 | perm a == perm b, perm a == perm c, 14 | S.member c prime4S ] 15 | 16 | -------------------------------------------------------------------------------- /src/491.hs: -------------------------------------------------------------------------------- 1 | 2 | import Control.Monad.ST 3 | import Control.Monad (forM_, when) 4 | import Data.Array 5 | import Data.Array.ST 6 | 7 | maskBound :: Int 8 | maskBound = (3^10) - 1 9 | 10 | encode :: [Int] -> Int 11 | encode x = foldl helper 0 (zip x [3^i | i <- [0 .. 9]]) where 12 | helper accum (bit, pow) = accum + bit * pow 13 | 14 | decode :: Int -> [Int] 15 | decode x = helper x 10 where 16 | helper x 0 = [] 17 | helper x n = (x `mod` 3) : (helper (x `div` 3) (n - 1)) 18 | 19 | increase :: Int -> [Int] -> [Int] 20 | increase digit x = (take digit x) ++ [(x!!digit) + 1] ++ (drop (digit + 1) x) 21 | 22 | dynamic :: Int -> Array (Int, Int) Int -> Array (Int, Int) Int 23 | dynamic 0 dp = dp 24 | dynamic p dp = dynamic (p - 1) $ runSTArray $ do 25 | ret <- newArray ((0, 0), (maskBound, 10)) 0 26 | forM_ [0 .. maskBound] $ \mask -> do 27 | let bits = decode mask 28 | forM_ [0 .. 10] $ \modulo -> do 29 | let v = dp!(mask, modulo) 30 | when (v /= 0) $ do 31 | forM_ [0 .. 9] $ \digit -> do 32 | when (((bits!!digit) /= 2) && (p /= 20 || digit /= 0)) $ do 33 | let mask' = encode (increase digit bits) 34 | let modulo' = (modulo + ((if (even p) then 10 else 1) * digit)) `mod` 11 35 | accumArray ret (mask', modulo') v 36 | return ret 37 | where 38 | accumArray arr idx delta = do 39 | x <- readArray arr idx 40 | writeArray arr idx (x + delta) 41 | 42 | solve = (dynamic 20 initArray) ! (maskBound, 0) where 43 | initArray = runSTArray $ do 44 | ret <- newArray ((0, 0), (maskBound, 10)) 0 45 | writeArray ret (0, 0) 1 46 | return ret 47 | 48 | main = print solve 49 | -------------------------------------------------------------------------------- /src/492.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.MapReduce (mapReduce) 3 | import Common.Numbers.Primes (testPrime) 4 | import Common.Numbers.Numbers (inverse, powMod) 5 | import Data.Maybe (isJust) 6 | import Data.List (find) 7 | 8 | type Mat2 = (Int, Int, Int, Int) 9 | 10 | multMat (a, b, c, d) (x, y, z, w) m = (a', b', c', d') where 11 | a' = (a * x + b * z) `mod` m 12 | b' = (a * y + b * w) `mod` m 13 | c' = (c * x + d * z) `mod` m 14 | d' = (c * y + d * w) `mod` m 15 | 16 | addMat (a, b, c, d) (x, y, z, w) m = (a', b', c', d') where 17 | a' = (a + x) `mod` m 18 | b' = (b + y) `mod` m 19 | c' = (c + z) `mod` m 20 | d' = (d + w) `mod` m 21 | 22 | powMat mat p m = helper mat p m (1, 0, 0, 1) where 23 | helper a 0 m ret = ret 24 | helper a p m ret = if odd p 25 | then helper a' p' m (multMat ret a m) 26 | else helper a' p' m ret where 27 | a' = multMat a a m 28 | p' = p `div` 2 29 | 30 | solve n p = ret where 31 | n' = fromIntegral $ powMod (2 :: Integer) (toInteger (n - 1)) (toInteger (p * p - 1)) 32 | base = (0, p - 1, 1, 11) 33 | inv = (11, 1, p - 1, 0) 34 | mat = addMat (powMat base n' p) (powMat inv n' p) p 35 | ret = ((((first mat) - 5) `mod` p) * (inverse 6 p)) `mod` p 36 | first (a, _, _, _) = a 37 | 38 | chunkSize = 10000 39 | 40 | generatePrimes xs = mapReduce chunkSize (\x -> (x, testPrime x)) reduce xs where 41 | reduce = (map fst) . (filter snd) 42 | 43 | main = print $ mapReduce chunkSize (solve (10^15)) sum primes where 44 | primes = generatePrimes [a + 1, a + 3 .. a + b] :: [Int] 45 | a = 10^9 46 | b = 10^7 47 | -------------------------------------------------------------------------------- /src/493.hs: -------------------------------------------------------------------------------- 1 | 2 | import Data.Array 3 | import Data.Array.ST 4 | import Control.Monad 5 | import Control.Monad.ST 6 | import Text.Printf 7 | 8 | comb n m = (product [m + 1 .. n]) `div` (product [1 .. n - m]) 9 | 10 | dynamic :: Int -> Array (Int, Int) Int -> Double 11 | dynamic 8 dp = a / b where 12 | count = [ dp!(20,k) | k <- [1 .. 7] ] 13 | a = fromIntegral $ sum $ zipWith (*) count [1 .. 7] 14 | b = fromIntegral $ sum count 15 | dynamic n dp = dynamic (n + 1) $ runSTArray $ do 16 | ret <- thaw dp 17 | forM_ [0 .. 20] $ \m -> do 18 | forM_ [0 .. n] $ \k -> do 19 | when (k /= 0) $ do 20 | forM_ (take 10 [1 .. m]) $ \i -> do 21 | let a = dp!(m - i, k - 1) 22 | b <- readArray ret (m, k) 23 | writeArray ret (m, k) (b + a * (comb 10 i)) 24 | return ret 25 | 26 | solve = dynamic 1 initArray where 27 | initArray = runSTArray $ do 28 | ret <- newArray ((0, 0), (20, 7)) 0 29 | writeArray ret (0, 0) 1 30 | return ret 31 | 32 | main = putStrLn $ printf "%.9f" solve 33 | -------------------------------------------------------------------------------- /src/498.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Numbers (inverse') 3 | import Data.List (foldl') 4 | 5 | product' xs p = foldl' helper 1 xs where 6 | helper accum x = (accum * x) `mod` p 7 | 8 | binomial n m p = if n < m 9 | then 0 10 | else if (n > p) 11 | then (binomial n' m' p) * (binomial n'' m'' p) `mod` p 12 | else ((a * b) `mod` p) * c `mod` p 13 | where 14 | n' = n `div` p 15 | m' = m `div` p 16 | n'' = n `mod` p 17 | m'' = m `mod` p 18 | a = product' [1 .. n] p 19 | b = product' [inverse' i p | i <- [1 .. m]] p 20 | c = product' [inverse' i p | i <- [1 .. n - m]] p 21 | 22 | modulo = 999999937 23 | n = 10^13 24 | m = 10^12 25 | d = 10^4 26 | 27 | main = print $ (binomial n d modulo) * (binomial (n - d - 1) (m - d - 1) modulo) `mod` modulo 28 | -------------------------------------------------------------------------------- /src/5.hs: -------------------------------------------------------------------------------- 1 | main = print (foldl lcm 1 [1 .. 20]) -------------------------------------------------------------------------------- /src/50.hs: -------------------------------------------------------------------------------- 1 | 2 | import Data.Array 3 | import Data.Array.ST 4 | import Control.Monad (forM_, when) 5 | import Control.Monad.ST 6 | import Data.Function (on) 7 | import Common.List (maximumBy') 8 | 9 | isPrimeTo m = runSTArray $ do 10 | sieve <- newArray (2, m) True :: ST s (STArray s Int Bool) 11 | let root = (floor . sqrt . fromIntegral) m 12 | forM_ [2 .. root] $ \i -> do 13 | isPrime <- readArray sieve i 14 | when isPrime $ do 15 | forM_ [i^2, i^2+i .. m] $ \j -> do 16 | writeArray sieve j False 17 | return sieve 18 | 19 | primesTo m = map fst $ filter (id . snd) $ assocs $ isPrimeTo m 20 | 21 | isPrimeTable = isPrimeTo 1000000 22 | isPrime 0 = False 23 | isPrime 1 = False 24 | isPrime x = isPrimeTable ! x 25 | 26 | solve :: [Int] -> (Int, Int) 27 | solve [] = (0, 0) 28 | solve primes@(p:ps) = maximumBy' cmp [best, (solve ps)] where 29 | cmp = compare `on` snd 30 | sum = takeWhile (<= 1000000) (scanl1 (+) primes) 31 | can = filter (isPrime . fst) (zip sum [1 .. ]) 32 | best = maximumBy' cmp can 33 | 34 | -- the low bound of answer is 21, so we only need to consider the primes below 1000000/20=50000. 35 | main = print $ fst $ solve $ primesTo 50000 36 | 37 | -------------------------------------------------------------------------------- /src/500.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Primes (primesTo) 3 | import Common.Numbers.Numbers (powMod) 4 | import qualified Data.Set as S 5 | 6 | primesN = take 500500 $ primesTo (500500 * 15) 7 | 8 | modulo = 500500507 9 | 10 | data Item = Item { 11 | base :: Int, 12 | expLog2 :: Int 13 | } deriving (Eq) 14 | 15 | ordKey :: Item -> Double 16 | ordKey x = fromIntegral (expLog2 x) + logBase 2 (log ((fromIntegral . base) x)) 17 | 18 | instance Ord Item where 19 | a `compare` b = (ordKey a) `compare` (ordKey b) 20 | 21 | solveIter :: Int -> S.Set Item -> Int 22 | solveIter 0 items = foldl helper 1 (S.toList items) where 23 | helper accum item = accum * (powMod (base item) ((2 ^ (expLog2 item) - 1) :: Integer) modulo) `mod` modulo 24 | solveIter count items = solveIter (count - 1) items'' where 25 | minItem = S.findMin items 26 | items' = S.deleteMin items 27 | items'' = S.insert (Item (base minItem) ((expLog2 minItem) + 1)) items' 28 | 29 | solve = solveIter 500500 $ S.fromList (zipWith Item primesN (repeat 0)) 30 | 31 | main = print solve 32 | 33 | -------------------------------------------------------------------------------- /src/501.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Primes (primesTo, countPrime') 3 | import qualified Data.Map as M 4 | 5 | iroot x p = floor $ (fromIntegral x) ** (1/p) 6 | 7 | n = 10^12 :: Int 8 | piMap = M.fromList $ countPrime' n 9 | count = (M.!) piMap 10 | 11 | main = print $ a + b + c + d where 12 | primes4 = zip [1 .. ] $ primesTo $ iroot n 4 13 | primes2 = primesTo $ iroot n 2 14 | a = count $ iroot n 7 15 | b = sum $ map f primes4 where 16 | f (i, p) = count (iroot (n `div` p) 3) - i 17 | c = sum $ map f primes4 where 18 | f (i, p) = count (n `div` (p^3)) - i 19 | d = rec 1 1 1 primes2 where 20 | rec _ _ _ [] = 0 21 | rec 1 x i (p:ps) = if (p*p*p > n) 22 | then 0 23 | else (rec 2 (x*p) (i+1) ps) + (rec 1 x (i+1) ps) 24 | rec 2 x i (p:ps) = if (x*p*p > n) 25 | then 0 26 | else (count (n `div` (x*p))) - i + (rec 2 x (i+1) ps) where 27 | -------------------------------------------------------------------------------- /src/504.hs: -------------------------------------------------------------------------------- 1 | 2 | import Data.Array.Unboxed 3 | import Data.Array.ST 4 | import Control.Monad (forM_, guard) 5 | import Control.Monad.ST 6 | 7 | isSquared x = root * root == x where 8 | root = (floor . sqrt . fromIntegral) x 9 | 10 | lattices m = runSTUArray $ do 11 | ret <- newArray ((1, 1), (m, m)) 0 :: ST s (STUArray s (Int, Int) Int) 12 | forM_ [1 .. m] $ \i -> do 13 | forM_ [1 .. m] $ \j -> do 14 | writeArray ret (i, j) (count i j) 15 | return ret where 16 | count a b = sum $ map get [0 .. a] where 17 | get x = (y `div` a - (if (y `mod` a == 0) then 1 else 0)) + 1 where 18 | y = b * x 19 | 20 | solve m = ret where 21 | lat = lattices m 22 | ret = length $ do 23 | a <- [1 .. m] 24 | b <- [1 .. m] 25 | c <- [1 .. m] 26 | d <- [1 .. m] 27 | let nLattices = lat!(a,b) + lat!(c,b) + lat!(a,d) + lat!(c,d) - a - b - c - d + 1 28 | guard $ isSquared nLattices 29 | return nLattices 30 | 31 | main = print $ solve 100 32 | -------------------------------------------------------------------------------- /src/506.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeFamilies #-} 2 | 3 | import qualified Common.Matrix.Matrix as M 4 | import Common.NumMod.MkNumMod 5 | 6 | mkNumMod True 123454321 7 | type Zn = Int123454321 8 | 9 | initial = [1, 2, 3, 4, 32, 123, 43, 2123, 432, 1234, 32123, 43212, 34321, 23432, 123432] 10 | suffix = [234321, 343212, 432123, 321234, 123432, 432123, 212343, 432123, 123432, 321234, 432123, 343212, 234321, 123432, 123432] 11 | 12 | solve :: Zn 13 | solve = sum [ calculate i | i <- [1 .. 15] ] 14 | where 15 | n = 10^14 :: Int 16 | (q, r) = n `quotRem` 15 17 | calculate i = ((matrix `M.power` c) `M.multiply` init) M.! (1, 1) 18 | where 19 | c = q + (if i <= r then 1 else 0) 20 | matrix = M.fromList 3 3 [1, 1, 0, 0, 10^6, suffix !! (i - 1), 0, 0, 1] 21 | init = M.fromList 3 1 [0, initial !! (i - 1), 1] 22 | 23 | main = print solve 24 | -------------------------------------------------------------------------------- /src/509.hs: -------------------------------------------------------------------------------- 1 | 2 | import Data.Bits (xor) 3 | 4 | solve :: Integer -> Integer 5 | solve n = sum [ (cnt!!i) * (cnt!!j) * (cnt!!k) | i <- [0 .. 62], j <- [0 .. 62], k <- [0 .. 62], (i `xor` j `xor` k) /= 0] where 6 | cnt = [ (n `div` (2^i) + 1) `div` 2 | i <- [0 .. 62] ] 7 | 8 | main = print $ (solve n) `mod` modulo where 9 | modulo = 1234567890 10 | n = 123456787654321 11 | 12 | -------------------------------------------------------------------------------- /src/51.hs: -------------------------------------------------------------------------------- 1 | 2 | import Data.Char (chr, ord) 3 | import Common.Utils (if') 4 | import Common.Numbers.Primes (testPrime) 5 | 6 | type Mask = [Int] 7 | 8 | substitute :: Mask -> Int -> Int 9 | substitute mask d = read (map (\x -> chr (x + ord '0')) (map (\x -> if' (x == -1) d x) mask)) 10 | 11 | goMask :: Int -> Int -> Int -> Mask -> Int 12 | goMask top dep free mask = if dep == 0 13 | then if' (free == 3) (compute mask) maxBound 14 | else minimum $ map (\x -> goMask top (dep - 1) (free' x) (mask ++ [x])) can 15 | where 16 | free' x = free + (if' (x == -1) 1 0) 17 | can | top == dep = -1 : [1 .. 9] 18 | | dep == 1 = [1, 3, 7, 9] 19 | | otherwise = [-1 .. 9] 20 | 21 | compute :: Mask -> Int 22 | compute mask = if' (total == 8) (head primes) maxBound where 23 | can = if' (head mask == -1) [1 .. 9] [0 .. 9] 24 | converted = map (substitute mask) can 25 | primes = filter testPrime converted 26 | total = length primes 27 | 28 | main = print $ goMask 6 6 0 [] 29 | 30 | -- consider all valid masks, we can get some key observations: 31 | -- 0. the answer is 6-digit long; 32 | -- 1. the last digit must be 1,3,7,9; 33 | -- 2. there should be exactly 3 free digits, otherwise, there will be at least 3 generated numbers divisable by 3. 34 | -------------------------------------------------------------------------------- /src/510.hs: -------------------------------------------------------------------------------- 1 | import Control.Parallel (pseq, par) 2 | 3 | solve :: Int -> Int -> Int -> Int 4 | solve n a b = (x' + y' + f) * count * (count + 1) `div` 2 where 5 | x = a * a 6 | y = b * b 7 | f = x * y 8 | g = (a + b) * (a + b) 9 | x' = x * g 10 | y' = y * g 11 | count = n `div` y' 12 | 13 | enumerate :: Int -> (Int, Int) -> (Int, Int) -> Int 14 | enumerate n x@(a, b) y@(c, d) = if (f * f > n) 15 | then 0 16 | else rec1 `par` rec2 `pseq` (cur + rec1 + rec2) where 17 | z@(e, f) = (a + c, b + d) 18 | cur = solve n e f 19 | rec1 = enumerate n x z 20 | rec2 = enumerate n y z 21 | 22 | main = print $ (enumerate n (0, 1) (1, 1)) + (solve n 1 1) where 23 | n = 10^9 24 | -------------------------------------------------------------------------------- /src/511.hs: -------------------------------------------------------------------------------- 1 | 2 | import Control.Monad (filterM, forM_) 3 | import qualified Data.Vector.Unboxed.Mutable as MV 4 | import qualified Data.Vector.Unboxed as V 5 | import Data.Vector.Unboxed ((!)) 6 | 7 | m = 10^9 8 | k = 4321 9 | n = 1234567898765 10 | pd = [5, 41, 25343, 237631] 11 | divisor = map product xs where 12 | xs = filterM (const [False, True]) pd 13 | 14 | conv :: V.Vector Int -> V.Vector Int -> V.Vector Int 15 | conv a b = V.create $ do 16 | ret <- MV.replicate k 0 17 | forM_ [0 .. k - 1] $ \i -> do 18 | forM_ [0 .. k - 1] $ \j -> do 19 | let k' = (i + j) `mod` k 20 | let v = ((a!i) * (b!j)) `mod` m 21 | v' <- MV.read ret k' 22 | MV.write ret k' $ (v + v') `mod` m 23 | return ret 24 | 25 | power :: V.Vector Int -> Int -> V.Vector Int 26 | power a p = helper a p init where 27 | init = V.fromListN k (1 : repeat 0) 28 | helper a 0 ret = ret `seq` ret 29 | helper a p ret = if odd p 30 | then helper a' p' (conv ret a) 31 | else helper a' p' ret where 32 | a' = conv a a 33 | p' = p `div` 2 34 | 35 | solve = poly ! (n `mod` k) where 36 | d = map (\x -> k - (x `mod` k)) divisor 37 | base = V.fromList $ map (\x -> count x d) [0 .. k - 1] where 38 | count x xs = length $ filter (== x) xs 39 | poly = power base n 40 | 41 | main = print solve 42 | -------------------------------------------------------------------------------- /src/512.hs: -------------------------------------------------------------------------------- 1 | 2 | import qualified Data.MemoCombinators as Memo 3 | 4 | divideEach :: Int -> [(Int, Int)] 5 | divideEach n = a ++ b where 6 | root = floor $ sqrt $ fromIntegral n 7 | a = zip (map (\x -> n `div` x) [1 .. root]) $ repeat 1 8 | k = n `div` (root + 1) 9 | b = reverse $ map helper [1 .. k] where 10 | helper k = (k, r - l + 1) where 11 | l = (n `div` (k + 1)) + 1 12 | r = n `div` k 13 | 14 | bigPhi :: Int -> Int 15 | bigPhi = Memo.bits bigPhi' where 16 | bigPhi' n = n * (n + 1) `div` 2 - sub where 17 | sub = sum $ map (\(k, cnt) -> cnt * (bigPhi k)) dpair 18 | dpair = tail $ divideEach n 19 | 20 | f :: Int -> [Int] 21 | f 1 = [1] 22 | f n = ((bigPhi n) - sub) : rec where 23 | rec = f (n `div` 2) 24 | sub = sum $ zipWith (*) a rec 25 | a = 1 : map (*2) a 26 | 27 | solve = head $ f 500000000 28 | 29 | main = print solve 30 | -------------------------------------------------------------------------------- /src/514.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.MapReduce (mapReduce) 3 | import Control.Monad (guard) 4 | import Data.Array.Unboxed 5 | import Text.Printf (printf) 6 | 7 | countBelow n (x1, y1) (x2, y2) = sum [ count x | x <- [0 .. n] ] where 8 | count x = (clamp y (-1) n) + 1 where 9 | y = (y2 - y1) * (x - x1) `div` (x2 - x1) + y1 10 | clamp y a b = min (max y a) b 11 | 12 | countOn n (x1, y1) (x2, y2) strict = if strict 13 | then count (min x1 x2) (max x1 x2) 14 | else count 0 n 15 | where 16 | d = gcd (x2 - x1) (y2 - y1) 17 | dx = (x2 - x1) `div` d 18 | dy = (y2 - y1) `div` d 19 | count a b = (helper [(x1 + i * dx, y1 + i * dy) | i <- [0 .. ]]) + (helper [(x1 - i * dx, y1 - i * dy) | i <- [1 .. ]]) where 20 | helper = length . (takeWhile (\(x, y) -> x >= a && x <= b && y >= 0 && y <= n)) 21 | 22 | countExcludes n p1@(x1, y1) p2@(x2, y2) = if (x1 == x2) 23 | then countExcludes n (y2, x2) (y1, x1) 24 | else if x1 < x2 25 | then below - on 26 | else (n + 1) * (n + 1) - below + (on' - on) 27 | where 28 | below = countBelow n p1 p2 29 | on = countOn n p1 p2 True 30 | on' = countOn n p1 p2 False 31 | 32 | solve :: Int -> Double 33 | solve n = mapReduce n solve sum pts where 34 | pts = [ (i, j) | i <- [0 .. n], j <- [0 .. n] ] :: [(Int, Int)] 35 | prob = 1.0 / (fromIntegral (n + 1)) :: Double 36 | probPowers' = 1 : map (\x -> x * (1 - prob)) probPowers' 37 | probPowers = listArray (0, (n + 1) * (n + 1)) probPowers' :: Array Int Double 38 | solve p1 = sum $ [solve' (p1, p2) | p2 <- pts, p1 /= p2] 39 | solve' (p1, p2) = prob * prob * (probPowers!excluded) * area where 40 | excluded = countExcludes n p1 p2 41 | area = (fromIntegral ((fst p1) * (snd p2) - (fst p2) * (snd p1))) / 2 42 | 43 | main = printf "%.5f\n" (solve 100) 44 | 45 | -------------------------------------------------------------------------------- /src/515.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Primes (testPrime) 3 | import Common.Numbers.Numbers (inverse') 4 | 5 | main = print $ sum $ [ inverse' (k - 1) p | p <- [a .. a + b - 1], testPrime p ] where 6 | k = 10^5 7 | a = 10^9 8 | b = 10^5 9 | -------------------------------------------------------------------------------- /src/516.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Primes (testPrime) 3 | import Control.Monad (foldM) 4 | import Data.List (sort) 5 | 6 | genBase :: Int -> [Int] 7 | genBase n = do 8 | a <- takeWhile (\x -> x <= n) as 9 | b <- takeWhile (\x -> x * a <= n) bs 10 | c <- takeWhile (\x -> x * a * b <= n) cs 11 | return $ a * b * c where 12 | as = 1 : map (* 2) as 13 | bs = 1 : map (* 3) bs 14 | cs = 1 : map (* 5) cs 15 | 16 | solve :: Int -> Int 17 | solve n = (sum (map count v1)) `mod` (2^32) where 18 | v1 = genBase n 19 | v2 = map (+ 1) $ filter (\x -> x /= 1 && x /= 2 && x /= 4 && (testPrime (x + 1))) v1 20 | v3 = sort $ foldM helper 1 v2 where 21 | helper a b = if a <= (n `div` b) 22 | then [a, a * b] 23 | else [a] 24 | count x = (sum (takeWhile (\y -> y <= (n `div` x)) v3)) * x 25 | 26 | main = print $ solve (10^12) 27 | -------------------------------------------------------------------------------- /src/517.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Utils (if') 3 | import Common.Numbers.Numbers (inverseTo) 4 | import Common.Numbers.Primes (testPrime) 5 | import Data.Array.Unboxed 6 | import Data.List (foldl') 7 | import Control.DeepSeq (deepseq) 8 | 9 | infixl 6 .+. 10 | (.+.) a b = (a + b) `rem` modulo 11 | infixl 7 .*. 12 | (.*.) a b = (a * b) `rem` modulo 13 | modulo = 1000000007 :: Int 14 | 15 | facts :: UArray Int Int 16 | facts = listArray (0, n) facts' where 17 | facts' = 1 : zipWith (.*.) facts' [1 .. n] 18 | n = 11111111 19 | 20 | invfacts :: UArray Int Int 21 | invfacts = invs `deepseq` listArray (0, n) invfacts' where 22 | invs = drop 1 $ inverseTo n modulo 23 | invfacts' = 1 : zipWith (.*.) invfacts' invs 24 | n = 11111111 25 | 26 | binomial :: Int -> Int -> Int 27 | binomial n m = if' (m < 0 || n < m) 0 $ a .*. b .*. c where 28 | a = facts ! n 29 | b = invfacts ! m 30 | c = invfacts ! (n - m) 31 | 32 | count p = foldl' (.+.) 0 [ helper i | i <- [0 .. (floor root)] ] where 33 | c = binomial 34 | root = sqrt (fromIntegral p) :: Double 35 | helper k1 = (((k1 + k3 - 1) `c` (k3 - 1)) + ((k1 + k2) `c` k2) - ((k1 + k3 - 1) `c` (k3 - 1))) `mod` modulo where 36 | k2 = floor $ (fromIntegral p) - (fromIntegral k1) * root 37 | k3 = max 0 $ floor $ (fromIntegral p) - (fromIntegral (k1 + 1)) * root + 1 38 | 39 | main = print $ foldl' (\a b -> a .+. (count b)) 0 $ filter testPrime [111 .. 10010000] 40 | -------------------------------------------------------------------------------- /src/519.hs: -------------------------------------------------------------------------------- 1 | import Data.Array.Unboxed 2 | import Data.Array.ST 3 | import Control.Monad (forM_) 4 | import Control.Monad.ST 5 | import Common.Utils (isqrt) 6 | import qualified Common.MonadRef as R 7 | 8 | solve :: Int -> Int 9 | solve n = dp ! (n, 1) 10 | where 11 | dp = runSTUArray $ do 12 | dp <- newArray ((0, 0), (n, maxH)) 0 :: ST s (STUArray s (Int, Int) Int) 13 | writeArray dp (0, 0) 1 14 | forM_ [1 .. n] $ \i -> do 15 | forM_ [1 .. min i maxH] $ \j -> do 16 | v <- R.new 0 17 | forM_ [0 .. min maxH (j + 1)] $ \k -> do 18 | let colors = color j k 19 | ways <- readArray dp (i - j, k) 20 | R.modify_' v (+ (ways * colors)) 21 | R.modify_' v (`mod` 1000000000) 22 | writeArray dp (i, j) =<< (R.read v) 23 | return dp 24 | color 1 0 = 3 25 | color _ 0 = 6 26 | color 1 1 = 2 27 | color _ 1 = 4 28 | color _ _ = 1 29 | maxH = isqrt (2 * n) + 10 30 | 31 | main = print $ solve 20000 32 | -------------------------------------------------------------------------------- /src/52.hs: -------------------------------------------------------------------------------- 1 | import Data.List (group, sort) 2 | 3 | check number = (length . group) ps == 1 4 | where ps = map (sort . (\x -> show (number * x))) [1 .. 6] 5 | 6 | main = print $ head $ dropWhile (not . check) [100002, 100005 .. ] 7 | 8 | -------------------------------------------------------------------------------- /src/523.hs: -------------------------------------------------------------------------------- 1 | import Text.Printf (printf) 2 | 3 | -- assume the first n-1 elements are sorted, and the last element is x, 4 | -- it takes 2^(x-1) steps to sort the whole list. 5 | 6 | main = putStrLn $ printf "%.2f" $ sum $ map f [1 .. 30] 7 | where 8 | f :: Int -> Double 9 | f n = (2^(n-1) - 1) / fromIntegral n 10 | -------------------------------------------------------------------------------- /src/527.hs: -------------------------------------------------------------------------------- 1 | import qualified Data.MemoCombinators as Memo 2 | import Text.Printf (printf) 3 | 4 | b :: Int -> Double 5 | b n = Memo.bits b' n 6 | where 7 | b' 1 = 1.0 8 | b' 2 = 1.5 9 | b' n = 1 + ((b x) * fromIntegral x + (b y) * fromIntegral y) / fromIntegral n 10 | where x = (n - 1) `div` 2 11 | y = n `div` 2 12 | 13 | -- https://en.wikipedia.org/wiki/Euler%E2%80%93Mascheroni_constant#Asymptotic_expansions 14 | h :: Int -> Double 15 | h n | n < 100 = sum $ map (\x -> 1.0 / fromIntegral x) [1 .. n] 16 | | otherwise = gamma + log n1 + 1 / 2 / n1 - 1 / 12 / n2 + 1 / 120 / n4 17 | where 18 | gamma = 0.5772156649 19 | n1 = fromIntegral n :: Double 20 | n2 = n1 * n1 21 | n4 = n2 * n2 22 | 23 | r :: Int -> Double 24 | r n = 2 * (h n) * (n1 + 1) / n1 - 3 25 | where n1 = fromIntegral n :: Double 26 | 27 | main = putStrLn $ printf "%.8f" (r n - b n) 28 | where n = 10^10 29 | -------------------------------------------------------------------------------- /src/53.hs: -------------------------------------------------------------------------------- 1 | 2 | pascal :: [[Integer]] 3 | pascal = [1] : map (\xs -> zipWith (+) (0 : xs) (xs ++ [0])) pascal 4 | 5 | main = print $ length $ filter (>1000000) l where 6 | l = concat $ take 101 pascal 7 | -------------------------------------------------------------------------------- /src/537.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeFamilies #-} 2 | 3 | -- TODO: needs profiling to improve performance. 4 | {- 5 | real 4m6.950s 6 | user 4m5.785s 7 | sys 0m1.039s 8 | -} 9 | 10 | 11 | import qualified Common.Polynomial.Polynomial as P 12 | import Common.NumMod.MkNumMod 13 | import Common.Numbers.Primes (primes) 14 | import Common.Numbers.Numbers (fastpow) 15 | 16 | mkNumMod True 1004535809 17 | type Zn = Int1004535809 18 | 19 | newtype Poly = Poly (P.Polynomial Zn) 20 | 21 | instance Num Poly where 22 | Poly p1 + Poly p2 = Poly $ p1 + p2 23 | Poly p1 - Poly p2 = Poly $ p1 - p2 24 | Poly p1 * Poly p2 = Poly $ P.fromList $ take 20001 . P.toList $ p1 * p2 25 | fromInteger = Poly . fromInteger 26 | 27 | poly :: Poly 28 | poly = Poly . P.fromList $ map toZn $ 1 : zipWith (-) (tail primeList) primeList 29 | where 30 | primeList = take 20001 primes 31 | toZn = fromInteger . toInteger 32 | 33 | main = print $ p P.! 20000 34 | where Poly p = poly `fastpow` (20000 :: Int) 35 | -------------------------------------------------------------------------------- /src/54.hs: -------------------------------------------------------------------------------- 1 | import Data.List 2 | import Data.Function (on) 3 | import Data.Char (ord) 4 | import Data.Maybe (fromJust) 5 | 6 | type Card = (Int, Char) 7 | 8 | cardValue :: Card -> Int 9 | cardValue = fst 10 | 11 | cardSuit :: Card -> Char 12 | cardSuit = snd 13 | 14 | sameSuit :: [Card] -> Bool 15 | sameSuit cs = length (groupBy (\c1 c2 -> cardSuit c1 == cardSuit c2) cs) == 1 16 | 17 | consecutiveValue :: [Card] -> Bool 18 | consecutiveValue cs = vs == [head vs .. last vs] where 19 | vs = sort $ map cardValue cs 20 | 21 | highCard :: [Card] -> Maybe [Int] 22 | highCard cs = Just $ reverse vs where 23 | vs = sort $ map cardValue cs 24 | 25 | onePair :: [Card] -> Maybe [Int] 26 | onePair cs = case eq2 of 27 | Nothing -> Nothing 28 | Just x -> Just $ (head x) : (reverse (filter (/= (head x)) vs)) 29 | where 30 | vs = sort $ map cardValue cs 31 | g = group vs 32 | eq2 = find (\x -> length x == 2) g 33 | 34 | twoPairs :: [Card] -> Maybe [Int] 35 | twoPairs cs 36 | | length g == 3 = Just [max p1 p2, min p1 p2, rest] 37 | | otherwise = Nothing where 38 | vs = sort $ map cardValue cs 39 | g = group vs 40 | g1 = filter (\x -> length x == 1) g 41 | g2 = filter (\x -> length x == 2) g 42 | p1 = head (head g2) 43 | p2 = head (last g2) 44 | rest = head (head g1) 45 | 46 | threeOfKind :: [Card] -> Maybe [Int] 47 | threeOfKind cs 48 | | not (null g3) = Just $ x : (reverse (filter (/= x) vs)) 49 | | otherwise = Nothing where 50 | vs = sort $ map cardValue cs 51 | g3 = filter (\x -> length x == 3) (group vs) 52 | x = head (head g3) 53 | 54 | straight :: [Card] -> Maybe [Int] 55 | straight cs 56 | | consecutiveValue cs = Just $ reverse $ sort $ map cardValue cs 57 | | otherwise = Nothing 58 | 59 | flush :: [Card] -> Maybe [Int] 60 | flush cs 61 | | sameSuit cs = Just $ reverse $ sort $ map cardValue cs 62 | | otherwise = Nothing 63 | 64 | fullHouse :: [Card] -> Maybe [Int] 65 | fullHouse cs 66 | | length g == 2 && length g2 == 2 = Just [head g3, head g2] 67 | | otherwise = Nothing where 68 | vs = sort $ map cardValue cs 69 | g = sortBy (compare `on` length) (group vs) 70 | g2 = head g 71 | g3 = last g 72 | 73 | fourOfKind :: [Card] -> Maybe [Int] 74 | fourOfKind cs 75 | | length g == 2 && length g1 == 1 = Just [head g4, head g1] 76 | | otherwise = Nothing where 77 | vs = sort $ map cardValue cs 78 | g = sortBy (compare `on` length) (group vs) 79 | g1 = head g 80 | g4 = last g 81 | 82 | straightFlush :: [Card] -> Maybe [Int] 83 | straightFlush cs 84 | | consecutiveValue cs && sameSuit cs = Just $ reverse $ sort $ map cardValue cs 85 | | otherwise = Nothing 86 | 87 | royalFlush :: [Card] -> Maybe [Int] 88 | royalFlush cs 89 | | consecutiveValue cs && sameSuit cs && vs!!0 == 10 = Just [] 90 | | otherwise = Nothing where 91 | vs = sort $ map cardValue cs 92 | 93 | parseCard :: String -> Card 94 | parseCard [a,b] = (v, b) where 95 | v 96 | | a == 'T' = 10 97 | | a == 'J' = 11 98 | | a == 'Q' = 12 99 | | a == 'K' = 13 100 | | a == 'A' = 14 101 | | otherwise = ord a - ord '0' 102 | 103 | calScore :: [Card] -> (Int, [Int]) 104 | calScore c = (10 - index, fromJust (result!!index)) where 105 | func = [royalFlush, straightFlush, fourOfKind, fullHouse, flush, straight, threeOfKind, twoPairs, onePair, highCard] 106 | result = [ f c | f <- func ] 107 | helper mxs = case mxs of 108 | Nothing -> False 109 | otherwise -> True 110 | index = fromJust (findIndex helper result) 111 | 112 | is1Winner :: [Card] -> [Card] -> Bool 113 | is1Winner c1 c2 = (calScore c1) > (calScore c2) 114 | 115 | solveSingle :: String -> Bool 116 | solveSingle s = is1Winner c1 c2 where 117 | cards = map parseCard $ filter (\s -> length s == 2) $ groupBy (\c1 c2 -> (c1 == ' ') == (c2 == ' ')) s 118 | c1 = take 5 cards 119 | c2 = drop 5 cards 120 | 121 | solve :: String -> Int 122 | solve input = foldl (\s x -> s + (if x then 1 else 0)) 0 win 123 | where win = map solveSingle (lines input) 124 | 125 | main = readFile "input/p054_poker.txt" >>= (print . solve) 126 | -------------------------------------------------------------------------------- /src/543.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.InfiniteSequence (fibnoacci) 2 | import Common.Numbers.Primes (primesTo') 3 | import qualified Data.Vector.Unboxed as V 4 | import Data.List (foldl') 5 | 6 | -- Goldbach's conjecture 7 | 8 | fib :: [Int] 9 | fib = reverse $ take 45 fibnoacci 10 | 11 | isPrimeTable = fst $ primesTo' (head fib) 12 | 13 | contrib n = length $ takeWhile (>= n) fib 14 | 15 | fromBool :: Bool -> Int 16 | fromBool True = 1 17 | fromBool False = 0 18 | 19 | solve :: Int 20 | solve = foldl' (\r i -> r + contrib i * f i) 0 [1 .. to] 21 | where 22 | to = head fib 23 | f i | i <= 7 = [0, 0, 1, 1, 1, 2, 2, 3] !! i 24 | | even i = i `quot` 2 - 1 25 | | otherwise = fromBool (isPrimeTable V.! i) + fromBool (isPrimeTable V.! (i - 2)) + i `quot` 2 - 2 26 | 27 | main = print solve 28 | -------------------------------------------------------------------------------- /src/545.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Primes (testPrime, factorize, toDivisors) 2 | import System.Random (mkStdGen) 3 | 4 | -- real 3m47.134s 5 | -- user 3m45.945s 6 | -- sys 0m1.108s 7 | 8 | -- http://mathworld.wolfram.com/BernoulliNumber.html 9 | test :: Int -> Bool 10 | test n = [2, 3, 5, 23, 29] == filter testPrime ds 11 | where 12 | ds = map succ $ toDivisors $ fst $ factorize (mkStdGen 23) n 13 | 14 | main = print (xs !! 99999) 15 | where 16 | xs = filter test [308, 308*2 .. ] 17 | -------------------------------------------------------------------------------- /src/55.hs: -------------------------------------------------------------------------------- 1 | 2 | isPalindrome :: Eq a => [a] -> Bool 3 | isPalindrome xs = xs == (reverse xs) 4 | 5 | isLychrel :: Integer -> Bool 6 | isLychrel x = helper 1 x where 7 | helper n x 8 | | n >= 50 = True 9 | | isPalindrome (show y) = False 10 | | otherwise = helper (n + 1) y 11 | where y = x + ((read . reverse . show) x) 12 | 13 | main = print $ length $ filter isLychrel [1 .. 9999] 14 | -------------------------------------------------------------------------------- /src/56.hs: -------------------------------------------------------------------------------- 1 | 2 | sumOfDigit :: Integer -> Integer 3 | sumOfDigit = sum . map (read . (\x -> [x])) . show 4 | 5 | main = print $ maximum [ sumOfDigit (a^b) | a <- [1 .. 99], b <- [1 .. 99] ] 6 | -------------------------------------------------------------------------------- /src/561.hs: -------------------------------------------------------------------------------- 1 | count :: Int -> Int 2 | count 0 = 0 3 | count n = (n `div` 2) + count (n `div` 2) 4 | 5 | -- solve (4*n) 6 | solve :: Int -> Int 7 | solve n = (m + 1) * (n + count (n+1)) 8 | where m = 904961 9 | 10 | main = print $ solve (10^12 `div` 4) 11 | -------------------------------------------------------------------------------- /src/57.hs: -------------------------------------------------------------------------------- 1 | -- a/b -> (a+2b)/(a+b) 2 | 3 | main = print $ length $ filter (\(a,b) -> length (show a) > length (show b)) (take 1000 sqrt2) 4 | where sqrt2 = (3,2) : map (\(a,b) -> (a+2*b,a+b)) sqrt2 5 | -------------------------------------------------------------------------------- /src/58.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Primes (testPrime) 3 | 4 | solve :: [Int] -> [Int] -> [Int] -> Int -> Int -> Int 5 | solve seq1 seq2 seq3 p dep = if ptotal * 10 < total 6 | then dep * 2 - 1 7 | else solve (tail seq1) (tail seq2) (tail seq3) ptotal (dep + 1) 8 | where 9 | wrap' True = 1 10 | wrap' False = 0 11 | wrap = wrap' . testPrime . head 12 | total = 4 * dep - 3 13 | ptotal = p + (wrap seq1) + (wrap seq2) + (wrap seq3) 14 | 15 | main = print $ solve seq1 seq2 seq3 0 2 where 16 | seq1 = [ 4*n^2-10*n+7 | n <- [2 .. ] ] 17 | seq2 = [ 4*n^2+1 | n <- [1 .. ] ] 18 | seq3 = [ 4*n^2-6*n+3 | n <- [2 .. ] ] 19 | 20 | -------------------------------------------------------------------------------- /src/59.hs: -------------------------------------------------------------------------------- 1 | import qualified Data.Text as T 2 | import Data.List (group, sort, maximumBy) 3 | import Data.Function (on) 4 | import Data.Bits (xor) 5 | import Data.Char (ord, chr, isAlpha) 6 | 7 | group3 a b c _ [] = (reverse a, reverse b, reverse c) 8 | group3 a b c n (x:xs) = case (n `mod` 3) of 9 | 0 -> group3 (x:a) b c (n + 1) xs 10 | 1 -> group3 a (x:b) c (n + 1) xs 11 | 2 -> group3 a b (x:c) (n + 1) xs 12 | 13 | comb3 [] [] [] = [] 14 | comb3 [a] [] [] = [a] 15 | comb3 [a] [b] [] = [a, b] 16 | comb3 (a:as) (b:bs) (c:cs) = a:b:c:(comb3 as bs cs) 17 | 18 | findKey :: [Int] -> Int 19 | findKey xs = maximumBy (compare `on` score) [(ord 'a') .. (ord 'z')] where 20 | score key = length $ filter (isAlpha . chr) $ map (xor key) xs 21 | 22 | solve :: String -> Int 23 | solve input = sum result where 24 | t = T.pack input 25 | ts = T.split (== ',') t 26 | xs = map (read . (T.unpack)) ts :: [Int] 27 | (a,b,c) = group3 [] [] [] 0 xs 28 | decrypte xs = map (xor (findKey xs)) xs 29 | result = comb3 (decrypte a) (decrypte b) (decrypte c) 30 | 31 | main = readFile "input/p059_cipher.txt" >>= (print . solve) 32 | -------------------------------------------------------------------------------- /src/6.hs: -------------------------------------------------------------------------------- 1 | main = print diff where 2 | diff = sum1 - sum2 3 | sum1 = (sum [1 .. 100]) ^ 2 4 | sum2 = sum (map (^2) [1 .. 100]) 5 | -------------------------------------------------------------------------------- /src/60.hs: -------------------------------------------------------------------------------- 1 | import Data.Array 2 | import Common.Numbers.Primes (primesTo, testPrime) 3 | 4 | primeList = primesTo 9999 :: [Int] 5 | primeArray = listArray (0, (length primeList) - 1) primeList 6 | 7 | canCatArray = listArray (0, (length primeList) - 1) [ catArray (fst p) (snd p) | p <- (zip primeList [0 .. ]) ] where 8 | check x y = (testPrime (cat x y)) && (testPrime (cat y x)) where 9 | cat x y = read $ (show x) ++ (show y) 10 | catArray x index = listArray (0, index - 1) [ check x y | y <- take index primeList ] 11 | 12 | main = print $ minimum [ dfs i [i] 1 | i <- [0 .. (length primeList) - 1] ] where 13 | dfs :: Int -> [Int] -> Int -> Int -- cur, (p:ps), size, result 14 | dfs _ ps 5 = score ps where 15 | score = foldl (\s index -> s + primeArray!index) 0 16 | dfs cur ps size = minimum $ maxBound : rec where 17 | canAdd x ps = and [ (canCatArray!index)!x | index <- ps ] 18 | rec = [ dfs next (next:ps) (size + 1) | next <- [0 .. cur-1], canAdd next ps ] 19 | 20 | -------------------------------------------------------------------------------- /src/61.hs: -------------------------------------------------------------------------------- 1 | 2 | vertices = concatMap process withIndex where 3 | process (xs, index) = zip (filter check (takeWhile (\x -> x < 10000) xs)) (repeat index) 4 | withIndex = zip [triangle, square, pentagonal, hexagonal, heptagonal, octagonal] [1 .. 6] 5 | triangle = [ n * (n + 1) `div` 2 | n <- [1 .. ] ] 6 | square = [ n * n | n <- [1 .. ] ] 7 | pentagonal = [ n * (3 * n - 1) `div` 2 | n <- [1 .. ] ] 8 | hexagonal = [ n * (2 * n - 1) | n <- [1 .. ] ] 9 | heptagonal = [ n * (5 * n - 3) `div` 2 | n <- [1 .. ] ] 10 | octagonal = [ n * (3 * n - 2) | n <- [1 .. ] ] 11 | check x = (length s == 4) && (s!!0 /= '0') && (s!!2 /= '0') where 12 | s = show x 13 | 14 | main = sequence_ [ dfs [v] 1 | v <- vertices, snd v == 1 ] where 15 | dfs :: [(Int, Int)] -> Int -> IO () 16 | dfs vs 6 = if (t2 $ fst $ head vs) == (f2 $ fst $ last vs) 17 | then print $ sum $ map fst vs 18 | else return () 19 | dfs vs size = sequence_ [ dfs (v:vs) (size + 1) | v <- next ] where 20 | last2 = t2 (fst $ head vs) 21 | indexes = map snd vs 22 | next = filter (\(number, index) -> (f2 number == last2 && (index `notElem` indexes))) vertices 23 | f2 x = take 2 (show x) 24 | t2 x = drop 2 (show x) 25 | 26 | -------------------------------------------------------------------------------- /src/62.hs: -------------------------------------------------------------------------------- 1 | import Data.List (sort, group, findIndex) 2 | import Data.Maybe (fromJust) 3 | 4 | main = print $ index^3 where 5 | scubes = map (sort . show) [ n^3 | n <- [0 .. 10000] ] 6 | can = map head $ filter (\x -> length x == 5) (group $ sort scubes) 7 | index = fromJust (findIndex (\x -> x `elem` can) scubes) 8 | -------------------------------------------------------------------------------- /src/63.hs: -------------------------------------------------------------------------------- 1 | 2 | count base = length $ filter (\(a, b) -> nLength a == b) $ takeWhile (\(a, b) -> nLength a >= b) can where 3 | can = [ (base^i, i) | i <- [1 .. ] ] 4 | nLength = length . show 5 | 6 | main = print $ 1 + sum [ count i | i <- [2 .. 9] ] 7 | -------------------------------------------------------------------------------- /src/64.hs: -------------------------------------------------------------------------------- 1 | import qualified Data.Map as M 2 | import Common.Utils (isqrt) 3 | 4 | period :: Int -> Int -> Int -> Int -> Int -> M.Map (Int, Int) Int -> Int 5 | period n root a b index map = 6 | case M.lookup (a, b) map of 7 | Just index2 -> index - index2 8 | otherwise -> period n root a' b' (index+1) (M.insert (a, b) index map) 9 | where 10 | a' = (n - b * b) `div` a 11 | x = (root + b) `div` a' 12 | b' = x * a' - b 13 | 14 | findPeriod n = period n root 1 root 0 M.empty where 15 | root = isqrt n 16 | 17 | main = print $ length $ filter (odd . findPeriod) irrational where 18 | isSquared x = (isqrt x)^2 == x 19 | irrational = filter (not . isSquared) [1 .. 10000] 20 | 21 | -- analysis: 22 | -- denote the state (a,b) as a / (sqrt n - b), we can prove that a|n-b^2 by induction. 23 | -- then by recursion, a'=(n-b^2)/a, b'=x*a'-b, where x=(root+b)/a 24 | -------------------------------------------------------------------------------- /src/65.hs: -------------------------------------------------------------------------------- 1 | import Data.Ratio 2 | import Data.Char (ord) 3 | 4 | main = print $ sumOfDigit $ numerator answer where 5 | sumOfDigit x = sum $ map (\c -> ord c - ord '0') (show x) 6 | eTerm = 2 : concatMap (\x -> [1, x, 1]) [2, 4 .. ] 7 | answer = 1 / (foldr (\x y -> 1 / (x + y)) (0 % 1) (take 100 eTerm)) 8 | -------------------------------------------------------------------------------- /src/66.hs: -------------------------------------------------------------------------------- 1 | import Data.List (maximumBy) 2 | import Data.Function (on) 3 | import Common.Utils (isqrt) 4 | 5 | isSquared x = (isqrt x) ^ 2 == x 6 | 7 | diophantine d = filter (\(x,y) -> x^2-d*y^2 == 1) convergent where 8 | root = isqrt d 9 | cf = helper d root 1 root 10 | convergent = tail $ zip xs ys 11 | xs = 1 : root : (zipWith3 (\a b c -> a * b + c) cf (tail xs) xs) 12 | ys = 0 : 1 : (zipWith3 (\a b c -> a * b + c) cf (tail ys) ys) 13 | helper n root a b = x : (helper n root a' b') where 14 | a' = (n - b * b) `div` a 15 | x = (root + b) `div` a' 16 | b' = x * a' - b 17 | 18 | main = print $ maximumBy (compare `on` (fst . head . diophantine)) nonSquare where 19 | nonSquare = filter (not . isSquared) [1 .. 1000] 20 | 21 | -- http://en.wikipedia.org/wiki/Pell's_equation 22 | -------------------------------------------------------------------------------- /src/67.hs: -------------------------------------------------------------------------------- 1 | 2 | fromString :: [[String]] -> [[Int]] 3 | fromString s = map (\x -> map (\y -> read y) x) s 4 | 5 | dp :: Int -> [[Int]] -> [Int] 6 | dp 0 triangle = head triangle 7 | dp level triangle = zipWith (+) row (zipWith max (0 : bak) (bak ++ [0])) 8 | where row = head triangle 9 | bak = dp (level - 1) (tail triangle) 10 | 11 | solve :: String -> Int 12 | solve input = maximum (dp (n - 1) (fromString triangle)) 13 | where triangle = reverse (map words (lines input)) 14 | n = length triangle 15 | 16 | main = (readFile "input/p067_triangle.txt") >>= (print . solve) 17 | -------------------------------------------------------------------------------- /src/68.hs: -------------------------------------------------------------------------------- 1 | import Data.Array 2 | import Data.List (permutations) 3 | import Common.List (rotate, unique) 4 | 5 | solve :: Array Int Int -> [String] 6 | solve permutation = if unique [ sum (pick indexes) | indexes <- gs ] 7 | then [showDigit (minimum $ map (concatMap pick) $ map (\r -> rotate r gs) [1 .. 5])] 8 | else [] where 9 | gs = [ [1,6,7], [2,7,8], [3,8,9], [4,9,10], [5,10,6] ] 10 | pick xs = map (\x -> permutation!x) xs 11 | showDigit xs = concatMap show xs 12 | 13 | main = putStrLn $ maximum $ concatMap (\p -> solve (toArray (10:p))) (permutations [1 .. 9]) where 14 | toArray xs = listArray (1, length xs) xs 15 | -------------------------------------------------------------------------------- /src/69.hs: -------------------------------------------------------------------------------- 1 | import Data.Array 2 | import Common.Numbers.Primes (primesTo) 3 | 4 | find num (p:ps) = if num * p > 1000000 5 | then num 6 | else find (num * p) ps 7 | 8 | main = print $ find 1 (primesTo 1000) 9 | -------------------------------------------------------------------------------- /src/7.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Primes (primes') 2 | 3 | main = print (primes' !! 10000) 4 | -------------------------------------------------------------------------------- /src/70.hs: -------------------------------------------------------------------------------- 1 | import Data.List (sort) 2 | import Data.Function (on) 3 | import Common.Numbers.Primes (primesTo) 4 | import Common.List (minimumBy') 5 | 6 | main = print $ (fst answer) * (snd answer) where 7 | primes = primesTo 5000 8 | candidate = [ (p,q) | p <- primes, q <- primes, p*q <= 10000000, check p q ] 9 | value :: (Int, Int) -> Double 10 | value (p,q) = p' * q' / (p' - 1) / (q' - 1) where 11 | p' = fromIntegral p 12 | q' = fromIntegral q 13 | check p q = f (p * q) == f (phi p q) where 14 | f = sort . show 15 | phi p q = (p - 1) * (q - 1) 16 | answer = minimumBy' (compare `on` value) candidate 17 | 18 | -- nice try! 19 | -- although I can't ensure this method produces the best answer :( 20 | -------------------------------------------------------------------------------- /src/71.hs: -------------------------------------------------------------------------------- 1 | import Data.Ratio 2 | import Data.List (foldl1') 3 | import Common.List (maximum') 4 | 5 | calculate d = n % d where 6 | n = d * 3 `div` 7 7 | 8 | main = print $ numerator (maximum' [ calculate d | d <- [1 .. 1000000], d `mod` 7 /= 0 ]) 9 | -------------------------------------------------------------------------------- /src/72.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.EulerPhi (phiTo) 3 | 4 | main = print $ pred $ sum $ phiTo 1000000 5 | -------------------------------------------------------------------------------- /src/73.hs: -------------------------------------------------------------------------------- 1 | 2 | farey (a,b) n = if r == 0 3 | then (k, n) 4 | else farey (a,b) (n - 1) 5 | where (k, r) = divMod (1 + a * n) b 6 | 7 | farey2 (a,b) (c,d) n = (p,q) where 8 | k = (n + b) `div` d 9 | p = k * c - a 10 | q = k * d - b 11 | 12 | count a b n = go a (farey a n) b n 0 where 13 | go a b f n r = if b == f 14 | then r 15 | else go b next f n $! (r + 1) -- strict 16 | where next = farey2 a b n 17 | 18 | main = print $ count (1,3) (1,2) 12000 19 | 20 | -- http://en.wikipedia.org/wiki/Farey_sequence 21 | -------------------------------------------------------------------------------- /src/74.hs: -------------------------------------------------------------------------------- 1 | import Data.Tuple (swap) 2 | import Data.List (unfoldr) 3 | import Data.Array 4 | import qualified Data.Set as S 5 | 6 | factorial = 1 : zipWith (*) [1 .. ] factorial 7 | 8 | go' x = sum [ factorial !! x | x <- s ] where 9 | s = unfoldr helper x 10 | helper 0 = Nothing 11 | helper x = Just $ swap $ divMod x 10 12 | 13 | nexts = listArray (0, lim) [ go' x | x <- [0 .. lim] ] where 14 | lim = 2177280 15 | 16 | count x = count' x S.empty 0 where 17 | count' :: Int -> S.Set Int -> Int -> Int 18 | count' x m s 19 | | s > 60 = s 20 | | S.member x m = s 21 | | otherwise = count' next (S.insert x m) (s + 1) 22 | where next = nexts!x 23 | 24 | main = print $ length $ filter (\x -> count x == 60) [1 .. 1000000] 25 | -------------------------------------------------------------------------------- /src/75.hs: -------------------------------------------------------------------------------- 1 | 2 | import Data.Array.MArray 3 | import Data.Array.IO 4 | import Control.Monad (foldM, mapM_) 5 | import Common.Utils (isqrt, if') 6 | 7 | type IntArray = IOArray Int Int 8 | 9 | limit = 1500000 :: Int 10 | limit' = isqrt $ limit `div` 2 11 | candidate = [ (m, n) | m <- [1 .. limit'], n <- [1 .. m - 1], gcd m n == 1, odd (m + n) ] 12 | 13 | incArray :: IntArray -> Int -> IO () 14 | incArray arr index = (readArray arr index) >>= ((writeArray arr index) . succ) 15 | 16 | update :: Int -> Int -> IntArray -> IO () 17 | update m n arr = do 18 | let a = m^2 - n^2 19 | let b = 2*m*n 20 | let c = m^2 + n^2 21 | let p = a + b + c 22 | let xs = takeWhile (\x -> x <= limit) [p, p + p .. ] 23 | mapM_ (\x -> incArray arr x) xs 24 | 25 | main = do 26 | arr <- newArray (0, limit) 0 :: IO IntArray 27 | mapM (\(m ,n) -> update m n arr) candidate 28 | (foldM helper (0, arr) [0 .. limit]) >>= (print . fst) 29 | where helper (s, arr) index = do 30 | val <- readArray arr index 31 | return $ if' (val == 1) (s + 1, arr) (s, arr) 32 | 33 | -------------------------------------------------------------------------------- /src/76.hs: -------------------------------------------------------------------------------- 1 | 2 | rec :: Int -> [Int] 3 | rec 1 = repeat 1 4 | rec n = result where 5 | result = zipWith (+) last ((replicate n 0) ++ result) 6 | last = (rec (n - 1)) ++ [0] 7 | 8 | main = print $ pred $ (rec 100) !! 100 9 | -------------------------------------------------------------------------------- /src/77.hs: -------------------------------------------------------------------------------- 1 | import Data.List (findIndex) 2 | import Data.Maybe (fromJust) 3 | import Common.Numbers.Primes (primesTo) 4 | 5 | primes = primesTo 100 6 | primesN = length primes 7 | 8 | dp = [ rec n | n <- [0 .. primesN] ] where 9 | rec 0 = 1 : (replicate 100 0) 10 | rec n = result where 11 | result = zipWith (+) (dp!!(n-1)) ((replicate number 0) ++ result) 12 | number = primes !! (n - 1) 13 | 14 | ways = [ (dp!!primesN)!!x | x <- [0 .. 100] ] 15 | 16 | main = (print . fromJust) (findIndex (\x -> x > 5000) ways) 17 | -------------------------------------------------------------------------------- /src/78.hs: -------------------------------------------------------------------------------- 1 | import Data.Array.IArray 2 | 3 | modulo = 1000000 :: Int 4 | 5 | ways :: Array Int Int 6 | ways = listArray (0, 100000) [ dp n | n <- [0 .. 100000] ] where 7 | dp 0 = 1 8 | dp n = helper 1 1 where 9 | helper j r = if val1 >= 0 10 | then (acc + (helper (j + 1) (-r))) `mod` modulo 11 | else 0 where 12 | val1 = n - ((3 * j * j - j) `div` 2) 13 | val2 = n - ((3 * j * j + j) `div` 2) 14 | acc1 = r * (ways ! val1) 15 | acc2 = if (val2 >= 0) 16 | then r * (ways ! val2) 17 | else 0 18 | acc = acc1 + acc2 19 | 20 | find0 ((index, 0) : _) = index 21 | find0 (_ : xs) = find0 xs 22 | 23 | main = print $ find0 $ assocs ways 24 | 25 | -- http://en.wikipedia.org/wiki/Pentagonal_number_theorem 26 | 27 | -------------------------------------------------------------------------------- /src/79.hs: -------------------------------------------------------------------------------- 1 | 2 | import Data.Graph (topSort, buildG) 3 | import Data.List 4 | import Data.Char (digitToInt) 5 | 6 | solve :: [String] -> String 7 | solve logs' = intersect (concatMap show result) (concat logs') where 8 | md2i = map digitToInt 9 | logs = map md2i logs' 10 | buildEdges [x,y,z] = [(x,y), (y,z)] 11 | edges = concatMap buildEdges logs 12 | g = buildG (0,9) edges 13 | result = topSort g 14 | 15 | main = (readFile "input/p079_keylog.txt") >>= (putStrLn . solve . lines) 16 | -------------------------------------------------------------------------------- /src/8.hs: -------------------------------------------------------------------------------- 1 | import Data.Char (digitToInt) 2 | 3 | solve input = maximum $ rec 12 digits where 4 | digits = map digitToInt $ concat $ words input 5 | rec 0 xs = xs 6 | rec n xs = zipWith (*) xs $ rec (n - 1) (tail xs) 7 | 8 | main = (print . solve) =<< readFile "input/p008_input.txt" 9 | -------------------------------------------------------------------------------- /src/80.hs: -------------------------------------------------------------------------------- 1 | 2 | import Data.List ((\\)) 3 | import Data.Char (digitToInt) 4 | import Common.Utils (isqrt) 5 | 6 | go :: Integer -> Int 7 | go number = sumOfDigit100 decimial where 8 | root = isqrt number 9 | target = number * 10^200 10 | bsearch :: Integer -> Integer -> Integer 11 | bsearch l r = if l == r 12 | then l 13 | else case compare (mid*mid) target of 14 | EQ -> mid 15 | LT -> bsearch mid r 16 | GT -> bsearch l (mid - 1) 17 | where mid = 1 + (l + r) `div` 2 18 | decimial = bsearch (root*10^100) ((root+1)*10^100) 19 | sumOfDigit100 x = sum $ map digitToInt (take 100 $ show x) 20 | 21 | main = print $ sum [ go x | x <- nonSquare ] where 22 | nonSquare = [1 .. 100] \\ [ i*i | i <- [1 .. 10] ] 23 | -------------------------------------------------------------------------------- /src/81.hs: -------------------------------------------------------------------------------- 1 | import Data.Array.ST 2 | import Control.Monad 3 | import Control.Monad.ST 4 | 5 | getShortest :: [[Int]] -> Int 6 | getShortest mat = runST $ do 7 | dp <- newArray ((0, 0), (n - 1, m - 1)) 0 :: ST s (STArray s (Int, Int) Int) 8 | forM_ [0 .. n - 1] $ \i -> do 9 | forM_ [0 .. m - 1] $ \j -> do 10 | update dp i j 11 | readArray dp (n - 1, m - 1) 12 | where 13 | n = length mat 14 | m = length $ mat!!0 15 | update :: STArray s (Int, Int) Int -> Int -> Int -> ST s () 16 | update dp 0 0 = writeArray dp (0, 0) ((mat!!0)!!0) 17 | update dp 0 j = do 18 | go <- readArray dp (0, j - 1) 19 | writeArray dp (0, j) (go + ((mat!!0)!!j)) 20 | update dp i 0 = do 21 | go <- readArray dp (i - 1, 0) 22 | writeArray dp (i, 0) (go + ((mat!!i)!!0)) 23 | update dp i j = do 24 | go1 <- readArray dp (i - 1, j) 25 | go2 <- readArray dp (i, j - 1) 26 | let go = min go1 go2 27 | writeArray dp (i, j) (go + ((mat!!i)!!j)) 28 | 29 | comma :: String -> [Int] 30 | comma [] = [] 31 | comma (',' : xs) = comma xs 32 | comma s = (read a) : (comma b) 33 | where (a, b) = span (/= ',') s 34 | 35 | readInput :: IO [[Int]] 36 | readInput = (readFile "input/p081_matrix.txt") >>= (return . (map comma) . words) 37 | 38 | main = readInput >>= (print . getShortest) 39 | -------------------------------------------------------------------------------- /src/82.hs: -------------------------------------------------------------------------------- 1 | import Data.STRef 2 | import Data.Array.ST 3 | import Data.Array 4 | import Control.Monad 5 | import Control.Monad.ST 6 | import Data.List (sortBy, groupBy) 7 | import Data.Function (on) 8 | 9 | readInput :: IO [[Int]] 10 | readInput = (readFile "input/p082_matrix.txt") >>= (return . (map comma) . words) where 11 | comma [] = [] 12 | comma (',' : xs) = comma xs 13 | comma s = (read a) : (comma b) 14 | where (a, b) = span (/= ',') s 15 | 16 | type Vertex = Int 17 | type Edge = (Vertex, Vertex, Int) 18 | 19 | extractEdge :: [[Int]] -> (Int, [Edge]) 20 | extractEdge mat' = (n * m + 2, concat [ part1, part2, part3 ]) where 21 | part1 = do 22 | (x, y) <- [ (x, y) | x <- [0 .. n - 1], y <- [0 .. m - 1] ] 23 | (dx, dy) <- dirs 24 | guard $ within (x + dx) (y + dy) 25 | return $ (label x y, label (x + dx) (y + dy), mat!(x + dx, y + dy)) 26 | part2 = [ (n*m, label i 0, mat!(i,0)) | i <- [0 .. n - 1] ] 27 | part3 = [ (label i (m-1), n*m+1, 0) | i <- [0 .. n - 1] ] 28 | n = length mat' 29 | m = length $ mat'!!0 30 | mat = listArray ((0, 0), (n - 1, m - 1)) (concat mat') :: Array (Int, Int) Int 31 | dirs = [(1, 0), (-1, 0), (0, 1)] 32 | within x y = (x >= 0) && (y >= 0) && (x < n) && (y < m) 33 | label x y = x * m + y 34 | 35 | buildG :: [Edge] -> Int -> Array Vertex [Edge] 36 | buildG edges n = runSTArray $ do 37 | arr <- newArray (0, n - 1) [] :: ST s (STArray s Vertex [Edge]) 38 | let groupedEdges = groupBy bar $ sortBy foo edges 39 | forM_ groupedEdges $ \es -> writeArray arr ((from . head) es) es 40 | return arr 41 | where 42 | from (u, v, w) = u 43 | foo = compare `on` from 44 | bar x y = (from x) == (from y) 45 | 46 | dijkstra :: Int -> Int -> Int -> Array Vertex [Edge] -> Int 47 | dijkstra n s t edges = runST $ do 48 | dist <- newArray (0, n - 1) (maxBound `div` 2) :: ST s (STArray s Int Int) 49 | vis <- newArray (0, n - 1) False :: ST s (STArray s Int Bool) 50 | writeArray dist s 0 51 | forM_ [1 .. n] $ \_ -> do 52 | cur <- extractMin n dist vis 53 | when (cur /= (-1)) $ forM_ (edges!cur) $ \(u, v, w) -> relax dist u v w 54 | readArray dist t 55 | where 56 | relax dist u v w = do 57 | old <- readArray dist v 58 | new <- (readArray dist u) >>= (return . (+w)) 59 | writeArray dist v (min old new) 60 | extractMin :: Int -> STArray s Int Int -> STArray s Int Bool -> ST s Int 61 | extractMin n dist vis = do 62 | best <- newSTRef (-1) 63 | bestDistance <- newSTRef maxBound 64 | forM_ [0 .. n - 1] $ \u -> do 65 | vis' <- readArray vis u 66 | dist' <- readArray dist u 67 | temp1 <- readSTRef best 68 | temp2 <- readSTRef bestDistance 69 | when ((not vis') && ((temp1 == (-1)) || (dist' < temp2))) $ (writeSTRef best u) >> (writeSTRef bestDistance dist') 70 | ret <- readSTRef best 71 | when (ret /= -1) $ writeArray vis ret True 72 | return ret 73 | 74 | main = do 75 | input <- readInput 76 | let (n, e) = extractEdge input 77 | let g = buildG e n 78 | print $ g `seq` dijkstra n (n - 2) (n - 1) g 79 | -------------------------------------------------------------------------------- /src/83.hs: -------------------------------------------------------------------------------- 1 | import Data.STRef 2 | import Data.Array.ST 3 | import Data.Array 4 | import Control.Monad 5 | import Control.Monad.ST 6 | import Data.List (sortBy, groupBy) 7 | import Data.Function (on) 8 | 9 | readInput :: IO [[Int]] 10 | readInput = (readFile "input/p083_matrix.txt") >>= (return . (map comma) . words) where 11 | comma [] = [] 12 | comma (',' : xs) = comma xs 13 | comma s = (read a) : (comma b) 14 | where (a, b) = span (/= ',') s 15 | 16 | type Vertex = Int 17 | type Edge = (Vertex, Vertex, Int) 18 | 19 | extractEdge :: [[Int]] -> (Int, [Edge]) 20 | extractEdge mat' = (n * m + 2, concat [ part1, part2, part3 ]) where 21 | part1 = do 22 | (x, y) <- [ (x, y) | x <- [0 .. n - 1], y <- [0 .. m - 1] ] 23 | (dx, dy) <- dirs 24 | guard $ within (x + dx) (y + dy) 25 | return $ (label x y, label (x + dx) (y + dy), mat!(x + dx, y + dy)) 26 | part2 = [ (n*m, label 0 0, mat!(0,0)) ] 27 | part3 = [ (label (n-1) (m-1), n*m+1, 0) ] 28 | n = length mat' 29 | m = length $ mat'!!0 30 | mat = listArray ((0, 0), (n - 1, m - 1)) (concat mat') :: Array (Int, Int) Int 31 | dirs = [(1, 0), (-1, 0), (0, 1), (0, -1)] 32 | within x y = (x >= 0) && (y >= 0) && (x < n) && (y < m) 33 | label x y = x * m + y 34 | 35 | buildG :: [Edge] -> Int -> Array Vertex [Edge] 36 | buildG edges n = runSTArray $ do 37 | arr <- newArray (0, n - 1) [] :: ST s (STArray s Vertex [Edge]) 38 | let groupedEdges = groupBy bar $ sortBy foo edges 39 | forM_ groupedEdges $ \es -> writeArray arr ((from . head) es) es 40 | return arr 41 | where 42 | from (u, v, w) = u 43 | foo = compare `on` from 44 | bar x y = (from x) == (from y) 45 | 46 | dijkstra :: Int -> Int -> Int -> Array Vertex [Edge] -> Int 47 | dijkstra n s t edges = runST $ do 48 | dist <- newArray (0, n - 1) (maxBound `div` 2) :: ST s (STArray s Int Int) 49 | vis <- newArray (0, n - 1) False :: ST s (STArray s Int Bool) 50 | writeArray dist s 0 51 | forM_ [1 .. n] $ \_ -> do 52 | cur <- extractMin n dist vis 53 | when (cur /= (-1)) $ forM_ (edges!cur) $ \(u, v, w) -> relax dist u v w 54 | readArray dist t 55 | where 56 | relax dist u v w = do 57 | old <- readArray dist v 58 | new <- (readArray dist u) >>= (return . (+w)) 59 | writeArray dist v (min old new) 60 | extractMin :: Int -> STArray s Int Int -> STArray s Int Bool -> ST s Int 61 | extractMin n dist vis = do 62 | best <- newSTRef (-1) 63 | bestDistance <- newSTRef maxBound 64 | forM_ [0 .. n - 1] $ \u -> do 65 | vis' <- readArray vis u 66 | dist' <- readArray dist u 67 | temp1 <- readSTRef best 68 | temp2 <- readSTRef bestDistance 69 | when ((not vis') && ((temp1 == (-1)) || (dist' < temp2))) $ (writeSTRef best u) >> (writeSTRef bestDistance dist') 70 | ret <- readSTRef best 71 | when (ret /= -1) $ writeArray vis ret True 72 | return ret 73 | 74 | main = do 75 | input <- readInput 76 | let (n, e) = extractEdge input 77 | let g = buildG e n 78 | print $ g `seq` dijkstra n (n - 2) (n - 1) g 79 | -------------------------------------------------------------------------------- /src/84.hs: -------------------------------------------------------------------------------- 1 | 2 | import Data.List (findIndex, sortBy) 3 | import Data.Function (on) 4 | import Data.Maybe (fromJust) 5 | import Data.Array 6 | import Data.Array.ST 7 | import Control.Monad (forM_) 8 | import Control.Monad.ST 9 | import Text.Printf 10 | 11 | squares = ["GO", "A1", "CC1", "A2", "T1", "R1", "B1", "CH1", "B2", "B3", "JAIL", "C1", "U1", "C2", "C3", "R2", "D1", "CC2", "D2", "D3", "FP", "E1", "CH2", "E2", "E3", "R3", "F1", "F2", "U2", "F3", "G2J", "G1", "G2", "CC3", "G3", "R4", "CH3", "H1", "T2", "H2"] 12 | nDice = 4 13 | nSquare = length squares 14 | 15 | getIndex :: String -> Int 16 | getIndex square = fromJust $ findIndex (== square) squares 17 | 18 | fall :: String -> [String] 19 | fall "G2J" = ["JAIL"] 20 | fall cc@('C':'C':c) = "GO" : "JAIL" : replicate 14 cc 21 | fall ch@('C':'H':c) = "GO" : "JAIL" : "C1" : "E3" : "H2" : "R1" : nextR : nextR : nextU : back3 : replicate 6 ch where 22 | index = getIndex ch 23 | back3 = squares !! ((index - 3) `mod` nSquare) 24 | nextR = case c of 25 | "1" -> "R2" 26 | "2" -> "R3" 27 | "3" -> "R1" 28 | nextU = case c of 29 | "1" -> "U1" 30 | "2" -> "U2" 31 | "3" -> "U1" 32 | fall x = [x] 33 | 34 | type State = (Int, Int) -- (sqr, doubles) 35 | type StateArray = Array State Double 36 | 37 | go' :: State -> Double -> [(State, Double)] 38 | go' (sqr, doubles) prob = concat $ do 39 | x <- [1 .. nDice] 40 | y <- [1 .. nDice] 41 | let doubles' = if x == y then (doubles + 1) else 0 42 | let sqr' = squares !! ((sqr + x + y) `mod` nSquare) 43 | let (sqr'', doubles'') = tryGoJail (sqr', doubles') 44 | let falls = fall sqr'' 45 | let prob'' = prob / ((fromIntegral nDice) ^ 2) / (fromIntegral (length falls)) 46 | return $ zip (zip (map getIndex falls) (repeat doubles'')) (repeat prob'') where 47 | tryGoJail (_, 3) = ("JAIL", 0) 48 | tryGoJail x = x 49 | 50 | go :: StateArray -> StateArray 51 | go probs = runSTArray $ do 52 | ret <- newArray ((0, 0), (nSquare - 1, 2)) 0 :: ST s (STArray s State Double) 53 | forM_ [0 .. nSquare - 1] $ \sqr -> do 54 | forM_ [0 .. 2] $ \doubles -> do 55 | let expands = go' (sqr, doubles) (probs!(sqr, doubles)) 56 | forM_ expands $ \((sqr', doubles'), prob') -> do 57 | old <- readArray ret (sqr', doubles') 58 | writeArray ret (sqr', doubles') (old + prob') 59 | return ret 60 | 61 | goIter :: StateArray -> Int -> StateArray 62 | goIter probs 0 = probs 63 | goIter probs count = goIter (go probs) (count - 1) 64 | 65 | solve :: Array Int Double 66 | solve = runSTArray $ do 67 | ret <- newArray (0, nSquare - 1) 0 :: ST s (STArray s Int Double) 68 | let probs = goIter init 233 69 | forM_ [0 .. nSquare - 1] $ \sqr -> do 70 | writeArray ret sqr ((probs!(sqr, 0)) + (probs!(sqr, 1)) + (probs!(sqr, 2))) 71 | return ret 72 | where init = listArray ((0, 0), (nSquare - 1, 2)) (1 : repeat 0) 73 | 74 | main = putStrLn $ concat $ map (printNum . fst) $ take 3 $ reverse $ sortBy (compare `on` snd) (assocs solve) where 75 | printNum :: Int -> String 76 | printNum = printf "%02d" 77 | -------------------------------------------------------------------------------- /src/85.hs: -------------------------------------------------------------------------------- 1 | 2 | import Control.Applicative 3 | import Data.Function (on) 4 | import Common.List (minimumBy') 5 | 6 | limit = 2000000 7 | item = takeWhile (\(x,y) -> y < limit) [ (n, (1 + n) * n `div` 2) | n <- [1 .. ] ] 8 | 9 | near (x,y) = abs (y - limit) 10 | 11 | main = print $ fst $ minimumBy' (compare `on` near) $ comb <$> item <*> item 12 | where comb (a,b) (c,d) = (a*c, b*d) 13 | 14 | -------------------------------------------------------------------------------- /src/86.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Utils (isqrt) 3 | 4 | isSquared x = root * root == x where 5 | root = isqrt x 6 | 7 | accumulate (x:xs) = result where 8 | result = x : zipWith (+) xs result 9 | 10 | count n = sum $ map find possible where 11 | possible = [ m | m <- [1 .. 2 * n], isSquared (m * m + n * n) ] 12 | find m = max (hi - lo + 1) 0 where 13 | lo = (m `div` 2) + (m `mod` 2) 14 | hi = min (m - 1) n 15 | 16 | main = print r where 17 | sols = [ count n | n <- [1 .. ] ] 18 | acc = zip [1 .. ] $ accumulate sols 19 | r = fst $ head $ dropWhile ((<= 1000000) . snd) acc 20 | 21 | -------------------------------------------------------------------------------- /src/87.hs: -------------------------------------------------------------------------------- 1 | import Common.Numbers.Primes (primesTo) 2 | import Common.List (nub') 3 | 4 | limit = 50000000 5 | primes = primesTo 7072 6 | 7 | numbers :: [Int] 8 | numbers = do 9 | x <- primes 10 | y <- takeWhile (\n -> n^3+x^2 <= limit) primes 11 | z <- takeWhile (\n -> x^2+y^3+n^4 <= limit) primes 12 | return (x^2+y^3+z^4) 13 | 14 | main = print $ length $ nub' numbers 15 | -------------------------------------------------------------------------------- /src/88.hs: -------------------------------------------------------------------------------- 1 | 2 | import Control.Monad (forM_, when) 3 | import Control.Monad.ST 4 | import Data.Array 5 | import Data.Array.ST 6 | import Data.List (nub) 7 | 8 | maxK = 12000 9 | 10 | solve :: Array Int Int 11 | solve = runSTArray $ do 12 | ret <- newArray (1, maxK) maxBound :: ST s (STArray s Int Int) 13 | dfs ret 0 1 0 2 14 | return ret 15 | where 16 | update ret idx val = do 17 | old <- readArray ret idx 18 | writeArray ret idx (min val old) 19 | dfs ret count product sum last = do 20 | forM_ [last .. maxK] $ \d -> do 21 | let product' = product * d 22 | let sum' = sum + d 23 | let count' = count + 1 24 | let k' = product' - sum' + count' 25 | when (k' <= maxK) $ do 26 | update ret k' product' 27 | dfs ret count' product' sum' d 28 | 29 | main = print $ (sum . nub . drop 1 . elems) solve 30 | -------------------------------------------------------------------------------- /src/89.hs: -------------------------------------------------------------------------------- 1 | 2 | roman :: String -> String 3 | roman ('I':'I':'I':'I':r) = 'I':'V':roman r 4 | roman ('V':'I':'I':'I':'I': r) = 'I':'X':roman r 5 | roman ('X':'X':'X':'X':r) = 'X':'L':roman r 6 | roman ('L':'X':'X':'X':'X':r) = 'X':'C':roman r 7 | roman ('C':'C':'C':'C':r) = 'C':'D':roman r 8 | roman ('D':'C':'C':'C':'C':r) = 'C':'M':roman r 9 | roman (x:r) = x:roman r 10 | roman [] = [] 11 | 12 | solve :: String -> Int 13 | solve s = count r - count r' where 14 | r = words s 15 | r' = map roman r 16 | count = sum . (map length) 17 | 18 | main = (readFile "input/p089_roman.txt") >>= (print . solve) 19 | -------------------------------------------------------------------------------- /src/9.hs: -------------------------------------------------------------------------------- 1 | main = print (head tripleProduct) 2 | where tripleProduct = [ a*b*c | a <- [1 .. 1000], b <- [1 .. 1000 - a], c <- [1000 - a - b], a^2 + b^2 == c^2 ] 3 | -------------------------------------------------------------------------------- /src/90.hs: -------------------------------------------------------------------------------- 1 | 2 | import Control.Monad (filterM, forM) 3 | import Data.List (nub, find) 4 | 5 | cubes = filter ((== 6) . length) $ filterM (const [True, False]) [0 .. 9] 6 | 7 | solve = (flip div) 2 $ length . (filter id) $ do 8 | c1 <- cubes 9 | c2 <- cubes 10 | return $ checkCube c1 c2 where 11 | checkCube c1 c2 = and $ map (\x -> maybeToBool (find (== x) combs)) [ x^2 | x <- [1 .. 9] ] where 12 | combs = combCube c1 c2 13 | maybeToBool Nothing = False 14 | maybeToBool _ = True 15 | combCube c1 c2 = nub $ concat $ do 16 | c1' <- map warp c1 17 | c2' <- map warp c2 18 | x <- c1' 19 | y <- c2' 20 | return [x * 10 + y, y * 10 + x] 21 | where 22 | warp 6 = [6, 9] 23 | warp 9 = [6, 9] 24 | warp x = [x] 25 | 26 | main = print $ solve 27 | -------------------------------------------------------------------------------- /src/91.hs: -------------------------------------------------------------------------------- 1 | 2 | count n = 3*n*n + x where 3 | x = sum $ do 4 | x <- [1 .. n] 5 | y <- [1 .. n] 6 | let g = gcd x y 7 | return $ (min ((n - y) * g `div` x) (x * g `div` y)) + (min ((n - x) * g `div` y) (y * g `div` x)) 8 | 9 | main = print $ count 50 10 | -------------------------------------------------------------------------------- /src/92.hs: -------------------------------------------------------------------------------- 1 | import Data.Array 2 | import Data.Char (digitToInt) 3 | import Data.List (foldl') 4 | 5 | limit = 1000 6 | 7 | endAt89' :: Int -> Bool 8 | endAt89' 89 = True 9 | endAt89' 1 = False 10 | endAt89' x = endAt89 $ next x 11 | where next x = sum $ map ((^2).digitToInt) $ show x 12 | 13 | dp = listArray (1, limit) [ endAt89' x | x <- [1 .. limit] ] 14 | 15 | endAt89 :: Int -> Bool 16 | endAt89 x 17 | | x <= limit = dp!x 18 | | otherwise = endAt89' x 19 | 20 | boolToInt False = 0 21 | boolToInt True = 1 22 | 23 | main = print $ foldl' (\s x -> s + (boolToInt $ endAt89 x)) 0 [1 .. 10000000] 24 | -------------------------------------------------------------------------------- /src/93.hs: -------------------------------------------------------------------------------- 1 | import Data.Ratio 2 | import Data.List (sort, nub, maximumBy) 3 | import Data.Function (on) 4 | import Common.Utils (if') 5 | 6 | ratio2Integer :: (Ratio Integer) -> Integer 7 | ratio2Integer r = if' (a `mod` b == 0) (a `div` b) (-1) where 8 | a = numerator r 9 | b = denominator r 10 | 11 | solve :: [Integer] -> Integer 12 | solve xs = getConsecutive $ concat [ dfs (kill n rs) (Just (rs !! n)) | n <- [0 .. 3] ] where 13 | kill n xs = (take n xs) ++ (drop (n + 1) xs) 14 | rs = map (\x -> x % 1) xs 15 | dfs :: [Ratio Integer] -> Maybe (Ratio Integer) -> [Maybe (Ratio Integer)] 16 | dfs _ Nothing = [] 17 | dfs [] value = [value] 18 | dfs can value = concat ret where 19 | ret = do 20 | useIndex <- [0 .. (pred . length) can] 21 | let newCan = kill useIndex can 22 | op <- [1 .. 6] 23 | let newValue = value >>= (apply op (can !! useIndex)) 24 | return $ dfs newCan newValue 25 | apply 1 x y = Just $ x + y 26 | apply 2 x y = Just $ x - y 27 | apply 3 x y = Just $ y - x 28 | apply 4 x y = Just $ x * y 29 | apply 5 x 0 = Nothing 30 | apply 5 x y = Just $ x / y 31 | apply 6 0 y = Nothing 32 | apply 6 x y = Just $ y / x 33 | 34 | getConsecutive :: [Maybe (Ratio Integer)] -> Integer 35 | getConsecutive rs = pred $ snd $ head $ dropWhile (\(x, y) -> x == y) $ zip xs [1 .. ] where 36 | xs :: [Integer] 37 | xs = dropWhile (<= 0) $ nub . sort $ map (\(Just x) -> ratio2Integer x) $ filter (\x -> x /= Nothing) rs 38 | 39 | main = print $ helper 0 $ snd $ maximumBy (compare `on` fst) [ (solve x, x) | x <- comb4 ] where 40 | comb4 = do 41 | a <- [1 .. 9] 42 | b <- [a + 1 .. 9] 43 | c <- [b + 1 .. 9] 44 | d <- [c + 1 .. 9] 45 | return [a, b, c, d] 46 | helper ret [] = ret 47 | helper ret (x:xs) = helper (ret * 10 + x) xs 48 | -------------------------------------------------------------------------------- /src/94.hs: -------------------------------------------------------------------------------- 1 | {- 2 | - two possible cases: 3 | - b=a+1: ((3a-1)/2)^2 - 3h^2 = 1 4 | - b=a-1: ((3a+1)/2)^2 - 3h^2 = 1 5 | -} 6 | 7 | import Common.Utils (isqrt) 8 | 9 | diophantine d = filter (\(x,y) -> x^2-d*y^2 == 1) convergent where 10 | root = isqrt d 11 | cf = helper d root 1 root 12 | convergent = tail $ zip xs ys 13 | xs = 1 : root : (zipWith3 (\a b c -> a * b + c) cf (tail xs) xs) 14 | ys = 0 : 1 : (zipWith3 (\a b c -> a * b + c) cf (tail ys) ys) 15 | helper n root a b = x : (helper n root a' b') where 16 | a' = (n - b * b) `div` a 17 | x = (root + b) `div` a' 18 | b' = x * a' - b 19 | 20 | getCase1 (x, y) = if ((2 * x + 1) `mod` 3 == 0) && ((b * h) `mod` 2 == 0) 21 | then a + a + b 22 | else -1 23 | where 24 | a = (2 * x + 1) `div` 3 25 | b = a + 1 26 | h = y 27 | 28 | getCase2 (x, y) = if ((2 * x - 1) `mod` 3 == 0) && ((b * h) `mod` 2 == 0) 29 | then a + a + b 30 | else -1 31 | where 32 | a = (2 * x - 1) `div` 3 33 | b = a - 1 34 | h = y 35 | 36 | main = print $ sum $ filter (\x -> x >= 3 && x <= 10^9) perimeter where 37 | candidate = takeWhile ((<= 10^9) . fst) $ diophantine 3 38 | perimeter = [ getCase1 p | p <- candidate ] ++ [ getCase2 p | p <- candidate ] 39 | 40 | -------------------------------------------------------------------------------- /src/95.hs: -------------------------------------------------------------------------------- 1 | -- run with flags +RTS -K512m -A32m 2 | 3 | import qualified Data.Set as S 4 | import Data.List (foldl') 5 | import Data.Array.ST 6 | import Data.Array.IArray ((!), listArray, Array) 7 | import Control.Monad 8 | import Control.Monad.ST 9 | import Common.Utils (isqrt) 10 | 11 | bound = 1000000 12 | 13 | amicable n = (succ . sum) $ do 14 | d <- [ 2 .. (isqrt n) ] 15 | if (n `mod` d == 0) 16 | then if (d * d == n) 17 | then return d 18 | else return $ d + (n `div` d) 19 | else return 0 20 | 21 | amnext :: [Int] 22 | amnext = 0 : 0 : map amicable [2 .. bound] 23 | 24 | cyclen :: [Int] 25 | cyclen = runST $ do 26 | let amnextArr = listArray (0, (length amnext) - 1) amnext 27 | arr <- newArray (0, bound) 0 :: ST s (STArray s Int Int) 28 | forM_ [1 .. bound] $ \n -> do 29 | old <- readArray arr n 30 | when (old == 0) $ do 31 | let res = go amnextArr n S.empty [] 32 | update arr res 33 | getElems arr 34 | where 35 | go :: Array Int Int -> Int -> S.Set Int -> [Int] -> [Int] 36 | go amnext cur s ret 37 | | cur > bound = (-1:ret) 38 | | S.member cur s = (cur:ret) 39 | | otherwise = go amnext (amnext!cur) (S.insert cur s) (cur:ret) 40 | setValue :: STArray s Int Int -> [Int] -> Int -> ST s () 41 | setValue arr xs val = forM_ xs $ \x -> writeArray arr x val 42 | update :: STArray s Int Int -> [Int] -> ST s () 43 | update arr (-1:xs) = setValue arr xs (-1) 44 | update arr (x:xs) = do 45 | setValue arr (x:t1) ((length t1) + 1) 46 | setValue arr (tail t2) (-1) 47 | where (t1, t2) = span (/= x) xs 48 | 49 | main = print result where 50 | result = fst $ foldl' cmp (0, 0) $ zip [0 .. ] cyclen 51 | cmp (a1,v1) (a2,v2) = case compare v1 v2 of 52 | LT -> (a2, v2) 53 | _ -> (a1, v1) 54 | 55 | -------------------------------------------------------------------------------- /src/96.hs: -------------------------------------------------------------------------------- 1 | import Data.List (groupBy, sort, sortBy) 2 | import Data.Function (on) 3 | import Data.Bits 4 | import Data.Char (ord) 5 | import Data.Foldable (toList) 6 | import qualified Data.Sequence as S 7 | 8 | readInput :: IO [[String]] 9 | readInput = readFile "input/p096_sudoku.txt" >>= (return . process) where 10 | process dat = map (drop 2) $ groupBy (\x y -> ((head x) == 'G') && ((head y) /= 'G')) $ words dat 11 | 12 | getIndex :: Int -> (Int, Int) -> Int 13 | getIndex 0 (x, y) = x * 9 + y 14 | getIndex 1 (x, y) = x 15 | getIndex 2 (x, y) = y 16 | getIndex 3 (x, y) = ((x `div` 3) * 3) + (y `div` 3) 17 | 18 | nextCord :: (Int, Int) -> (Int, Int) 19 | nextCord (x, 8) = (x + 1, 0) 20 | nextCord (x, y) = (x, y + 1) 21 | 22 | cordList :: [(Int, Int)] 23 | cordList = take 81 $ (0, 0) : map nextCord cordList 24 | 25 | dfs :: S.Seq Int -> S.Seq Int -> S.Seq (S.Seq Int) -> [[Int]] 26 | dfs puzzle ret mask 27 | | null validCandidate = [toList ret] 28 | | otherwise = concat $ recResults d 29 | where 30 | validCandidate :: [([Int], (Int, Int))] 31 | validCandidate = map (\(x,y,z) -> ((getCandidate mask x y), x)) $ filter (\(x,y,z) -> z == 0) (zip3 cordList (toList puzzle) (toList ret)) 32 | getCandidate mask cord d = filter helper candidate where 33 | candidate = [ x | x <- [1 .. 9], (d == 0) || (d == x) ] :: [Int] 34 | helper d = checkMask mask cord d 35 | cord@(x,y) = snd $ head $ sortBy (compare `on` (length . fst)) validCandidate 36 | d = S.index puzzle (getIndex 0 cord) 37 | rec d 38 | | checkMask mask cord d = dfs puzzle (updateResult ret d cord) (applyMask mask cord d) 39 | | otherwise = [] 40 | updateResult ret d cord = S.update (getIndex 0 cord) d ret 41 | checkMask mask cord d = (not . or) r where 42 | r = do 43 | i <- [0 .. 2] 44 | let m = S.index mask i 45 | let m = S.index mask i 46 | let index = getIndex (i + 1) cord 47 | let bit = testBit (S.index m index) d 48 | return bit 49 | applyMask mask cord d = S.fromList r where 50 | r = do 51 | i <- [0 .. 2] 52 | let m = S.index mask i 53 | let index = getIndex (i + 1) cord 54 | let set = setBit (S.index m index) d 55 | return $ S.update index set m 56 | recResults 0 = [ rec d | d <- [1 .. 9] ] 57 | recResults d = [ rec d ] 58 | 59 | solve :: [String] -> [[Int]] 60 | solve puzzle = dfs sudoku (S.fromList (replicate 81 0)) (S.fromList (replicate 3 setup)) where 61 | setup = S.fromList (replicate 9 0) 62 | sudoku = S.fromList $ map (\c -> ord c - ord '0') (concat puzzle) 63 | 64 | first3 :: [Int] -> Int 65 | first3 (x:y:z:xs) = x * 100 + y * 10 + z 66 | 67 | main = readInput >>= (print . sum . (map (first3 . head . solve))) 68 | -------------------------------------------------------------------------------- /src/97.hs: -------------------------------------------------------------------------------- 1 | 2 | import Common.Numbers.Numbers (powMod) 3 | 4 | main = print $ 1 + (28433 * (powMod 2 (7830457 :: Int) modulo) `mod` modulo) where 5 | modulo = 10^10 :: Integer 6 | -------------------------------------------------------------------------------- /src/98.hs: -------------------------------------------------------------------------------- 1 | import Data.List (groupBy, sort) 2 | import Data.Char (ord) 3 | import Control.Monad (guard) 4 | import Data.Array.IArray 5 | import Common.Utils (isqrt) 6 | 7 | readInput :: IO [String] 8 | readInput = (readFile "input/p098_words.txt") >>= (return . foo) where 9 | foo input = map bar $ filter (\s -> (length s) >= 2) $ groupBy (\a b -> ((a == ',') == (b == ','))) input 10 | bar (x:xs) = take ((length xs) - 1) xs 11 | 12 | squares :: [Int] 13 | squares = [ n*n | n <- [1 .. ] ] 14 | 15 | isSquared x = (root * root) == x where 16 | root = isqrt x 17 | 18 | anagram word1 word2 = (sort word1) == (sort word2) 19 | 20 | score word1 word2 = maximum (0 : ret) where 21 | l = length word1 22 | ub = (10 ^ l) - 1 23 | lb = 10 ^ (l - 1) 24 | sqr = takeWhile (\x -> x <= ub) $ dropWhile (\x -> x < lb) squares 25 | check x = and $ do 26 | i <- [0 .. l - 1] 27 | j <- [i + 1 .. l - 1] 28 | return $ (s!!i == s!!j && word1!!i == word1!!j) || (s!!i /= s!!j && word1!!i /= word1!!j) 29 | where s = show x 30 | replace x = y where 31 | s = show x 32 | mapping = zip word1 s 33 | y = rec word2 0 34 | rec [] ret = ret 35 | rec (x:xs) ret = rec xs $ ret * 10 + (find mapping x) 36 | find (m:ms) x = case compare (fst m) x of 37 | EQ -> ord (snd m) - (ord '0') 38 | _ -> find ms x 39 | ret = do 40 | x <- sqr 41 | guard $ check x 42 | let y = replace x 43 | guard $ length (show y) == l 44 | guard $ isSquared y 45 | return $ max x y 46 | 47 | solve :: [String] -> Int 48 | solve s = maximum $ do 49 | i <- [1 .. n] 50 | j <- [i + 1 .. n] 51 | guard $ anagram (arr!i) (arr!j) 52 | return $ score (arr!i) (arr!j) 53 | where 54 | n = length s 55 | arr = listArray (1, n) s :: Array Int String 56 | 57 | main = readInput >>= (print . solve) 58 | -------------------------------------------------------------------------------- /src/99.hs: -------------------------------------------------------------------------------- 1 | import Data.List (maximumBy) 2 | import Data.Function (on) 3 | 4 | splitByComma :: String -> (Int, Int) 5 | splitByComma s = (read a, read (tail b)) 6 | where (a, b) = span (\x -> x /= ',') s 7 | 8 | readInput :: IO [(Int, Int)] 9 | readInput = readFile "input/p099_base_exp.txt" >>= (return . map splitByComma . words) 10 | 11 | solve :: [(Int, Int)] -> Int 12 | solve xs = fst $ maximumBy (compare `on` value) (zip [1 .. ] xs) 13 | where value (index, (a, b)) = (fromIntegral b) * (log (fromIntegral a)) 14 | 15 | main = readInput >>= (print . solve) 16 | --------------------------------------------------------------------------------