111 lines
3.4 KiB
Haskell
111 lines
3.4 KiB
Haskell
{-# LANGUAGE BangPatterns #-}
|
|
|
|
import Data.Time (diffUTCTime, getCurrentTime)
|
|
import Text.Printf (printf)
|
|
import Data.Bits (shiftR, testBit, setBit)
|
|
import Control.DeepSeq (force, NFData)
|
|
import Control.Exception (evaluate)
|
|
|
|
-- 计时函数
|
|
time :: NFData a => String -> IO a -> IO a
|
|
time label action = do
|
|
start <- getCurrentTime
|
|
result <- action
|
|
result' <- evaluate (force result)
|
|
end <- getCurrentTime
|
|
printf "%s took time: %.6f seconds\n" label (realToFrac (diffUTCTime end start) :: Double)
|
|
return result'
|
|
|
|
-- 反转十进制数字（辅助函数）
|
|
reverseDecimal :: Integer -> Integer
|
|
reverseDecimal = go 0
|
|
where
|
|
go acc 0 = acc
|
|
go acc x = let (q, r) = quotRem x 10
|
|
in go (acc * 10 + r) q
|
|
|
|
-- 十进制回文检查
|
|
isDecimalPalindromic :: Integer -> Bool
|
|
isDecimalPalindromic n = n == reverseDecimal n
|
|
|
|
-- 二进制回文检查（使用位运算）
|
|
isBinaryPalindromic :: Integer -> Bool
|
|
isBinaryPalindromic n
|
|
| n < 0 = False
|
|
| otherwise = n == reverseBinary n
|
|
where
|
|
-- 计算二进制位数
|
|
bitLength :: Integer -> Int
|
|
bitLength 0 = 1
|
|
bitLength x = go 0 x
|
|
where
|
|
go !len 0 = len
|
|
go !len y = go (len + 1) (y `shiftR` 1)
|
|
|
|
-- 反转二进制位
|
|
reverseBinary :: Integer -> Integer
|
|
reverseBinary x = go 0 (bitLength x) x
|
|
where
|
|
go !acc 0 _ = acc
|
|
go !acc !len y
|
|
| testBit y 0 = go (acc `setBit` (len - 1)) (len - 1) (y `shiftR` 1)
|
|
| otherwise = go acc (len - 1) (y `shiftR` 1)
|
|
|
|
-- 简单方法：遍历所有数字
|
|
mainSimple :: Integer -> IO ()
|
|
mainSimple limit = do
|
|
let nums = [0..limit]
|
|
palindromes = filter (\n -> isDecimalPalindromic n && isBinaryPalindromic n) nums
|
|
result = sum palindromes
|
|
print result
|
|
|
|
-- 生成指定长度的十进制回文数（优化版）
|
|
palindromesOfLength :: Int -> [Integer]
|
|
palindromesOfLength 1 = [0..9]
|
|
palindromesOfLength len
|
|
| even len = buildPalindromes evenPalindrome halfRange
|
|
| otherwise = buildPalindromes oddPalindrome halfRange
|
|
where
|
|
halfLen = (len + 1) `div` 2
|
|
start = 10^(halfLen-1)
|
|
end = 10^halfLen - 1
|
|
halfRange = [start..end]
|
|
|
|
buildPalindromes :: (Integer -> Integer) -> [Integer] -> [Integer]
|
|
buildPalindromes f = map f
|
|
|
|
evenPalindrome :: Integer -> Integer
|
|
evenPalindrome half =
|
|
let s = half
|
|
reversed = reverseDecimal s
|
|
shift = 10^halfLen
|
|
in s * shift + reversed
|
|
|
|
oddPalindrome :: Integer -> Integer
|
|
oddPalindrome half =
|
|
let s = half
|
|
power = halfLen - 1
|
|
shift = 10^power
|
|
reversed = reverseDecimal (s `quot` 10)
|
|
in s * shift + reversed
|
|
|
|
-- 快速方法：生成回文数而非遍历
|
|
mainQuick :: Integer -> IO ()
|
|
mainQuick limit = do
|
|
let maxLength = length (show (limit - 1))
|
|
-- 限制每个长度生成的回文数不超过limit
|
|
limitedPalindromes = takeWhile (<= limit) $ concatMap palindromesOfLength [1..maxLength]
|
|
validPalindromes = filter isBinaryPalindromic limitedPalindromes
|
|
result = sum validPalindromes
|
|
print result
|
|
|
|
-- 主函数
|
|
main :: IO ()
|
|
main = do
|
|
let limit = 1000000
|
|
putStrLn "=== mainSimple (朴素遍历法) ==="
|
|
time "mainSimple" $ mainSimple limit
|
|
|
|
putStrLn "\n=== mainQuick (回文数生成法) ==="
|
|
time "mainQuick" $ mainQuick limit
|