haskell代码片段

最新推荐文章于 2024-06-14 09:36:09 发布

lambda_z

最新推荐文章于 2024-06-14 09:36:09 发布

阅读量1.5k

点赞数

CC 4.0 BY-SA版权

分类专栏： Haskell/OCaml 文章标签： haskell import server socket returning immutable

本文链接：https://blog.youkuaiyun.com/sw2wolf/article/details/6797669

Haskell/OCaml 专栏收录该内容

10 篇文章

订阅专栏

这篇博客展示了Haskell编程的一些实例，包括菲波那契数列、素数生成、汉明数和克拉兹问题的解决方案。还探讨了不可变数据结构的使用，并给出了一个使用IORef进行读写的例子。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

-- 经典的菲波纳契数列的函数定义，求每一个位置上的数值
fib 1 = 1
fib 2 = 1
fib n = fib(n-1) + fib(n-2)

-- 产生一个无限长的fib数列
fib_l n = fib n : fib_l (n+1)

take 10 (fib_l 1) ＝> [1,1,2,3,5,8,13,21,34,55]

--另一个更快解法

fibs = fibgen 1 1
fibgen n1 n2 = n1 : fibgen n2 (n1+n2)

--求解素数的一个无限数列方法：

prime = sieve [2..]
sieve (x:xs) = x : sieve (filter (\y ->y `rem` x /= 0) xs)
take 25 prime => [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]

--打印头 100 个汉明数（以2、3、5 的阶乘为因子的正整数）

main = print (take 100 hamming)

hamming = 1 : (map (2*) hamming) ~~ (map (3*) hamming) ~~ (map (5*) hamming)
where
xxs@(x:xs) ~~ yys@(y:ys)
| x==y = (x : xs~~ys)
| x<y = x:xs~~yys
| otherwise = (y : xxs~~ys)

--克拉兹(Collatz)问题

module Main where

import Data.Tuple
import Data.List (sortBy)
import Data.Function (on)

chain' :: Integer -> [Integer]
chain' 1 = [1]
chain' n
| n <= 0 = []
| even n = n : chain' (n `div` 2)
| odd n = n : chain' (n * 3 + 1)

main :: IO ()
main = do
let seqx = map (\x -> (x, length $ chain' x)) [999999,999997..3]
print . fst .head $ sortBy (flip compare `on` snd) seqx

--更快的解法

module Main where

import Data.Tuple
import Data.List (sortBy, iterate)
import Data.Function (on)

chain' :: Integer -> Int
chain' n
| n < 1 = 0
| otherwise = 1 + (length $ (takeWhile (> 1) $ iterate (\x ->if even x then x `div` 2 else x * 3 + 1) n))

main :: IO ()
main = do
let seqx = map (\x -> (x, chain' x)) [999999,999997..3]
print . fst .head $ sortBy (flip compare `on` snd) seqx

--对可变（mutable）变量的读写

incRef :: IORef Int -> IO ( )

incRef var = do
val <- readIORef var
writeIORef var (val+1)

type MyDataStructure = [Int]
type ConcMyData = IORef MyDataStructure
main = do
sharedData <- newIORef []
//...
atomicModifyIORef sharedData (\xs -> (1:xs,()))

fact n = runST (do
r < - newSTRef 1
for (1,n) (\x -> do
val < - readSTRef r
writeSTRef r (val * x))
readSTRef r)

for :: (Int,Int) -> (Int -> ST s ()) -> ST s ()
for (i,j) k = sequence_ (map k [i..j])

--String和ByteString互相转换

toBS :: String -> BS.ByteString
toBS = BS.pack . map (fromIntegral . fromEnum)

fromBS :: BS.ByteString -> String
fromBS = map (toEnum . fromIntegral) . BS.unpack

--Associated Array

import Data.Map

makeMap ks vs = fromList $ zip ks vs
mymap = makeMap ['a','b','c'] [1,2,3]

--文件操作

readUtf8File :: FilePath -> IO String
readUtf8File filePath = do

h <- openFile filePath ReadMode
hSetEncoding h utf8
hSetEncoding stdout utf8
hGetContents h

betterStdGen :: IO StdGen
betterStdGen = alloca $ \p -> do
h <- openBinaryFile "/dev/urandom" ReadMode
hGetBuf h p $ sizeOf (undefined :: Int)
hClose h
mkStdGen <$> peek p

--模拟for循环的函数

nTimes :: Int -> IO () -> IO ()
nTimes 0 do_this = return ()
nTimes n do_this = do {
do_this;
nTimes (n-1) do_this;
}

main = nTimes 10 (hPutStr stdout "Hello") --重复输出10个"Hello"

-- for(i=0; i<100; i++) {}
for :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
for start test step body = loop start where
loop x = if test x
then body x >> loop (step x)
else return ()

main = for 0 (< 100) (+ 1) $ \i -> do
-- do something with i
print i

--如果值有空格就加上引号

> [k ++ "=" ++ c ++ v ++ c | (k,v) <- [("key1","123"),("key2","abc 456")] ,let c = ['\"' | anyisSpace v]]
["key1=123","key2=\"abc 456\""]

--转义

escapeHTML = concatMap f
where
f '\"' = """

f '\'' = "'"
f '<' = "<"
f '>' = ">"
f '&' = "&"
f '\n' = "<br/>"
f x = [x]

escapeCGI = concatMap f
where
f x

| isAlphaNum x || x `elem` "-" = [x]
| x == ' ' = "+"
| otherwise = '%' : ['0' | length s == 1] ++ s
where s = showHex (ord x) ""

--位操作

let w4 = (w32 `shiftR` 24) .&. 0xff
w3 = (w32 `shiftR` 16).&. 0xff
w2 = (w32 `shiftR` 8).&. 0xff
w1 = w32 .&. 0xff

return $! (w4 `shiftL` 24) .|. (w3 `shiftL` 16).|. (w2 `shiftL` 8) .|. (w1)

十六进制

> readHex "41A"
[(1050,"")]

--指数运算

精确结果
(^) :: (Num a, Integral b) => a -> b -> a
(^^) :: (Fractional a, Integral b) => a -> b -> a

近似结果
(**) :: Floating a => a -> a -> a

--数组操作

import qualified Data.Vector.Generic as G

import qualified Data.Vector.Unboxed.Mutable as M

replicateM n action = do
mu <- M.unsafeNew n
let go !i | i < n = action >>= M.unsafeWrite mu i >> go (i+1)
| otherwise = G.unsafeFreeze mu
go 0

import Data.List
import Data.Function

type Key = String
type Score = Int
data Thing = Thing {key :: Key, score :: Score } deriving (Show)

myNub = nubBy ((==) `on` key)
mySort = sortBy (compare `on` (negate .score))

selectFinest = myNub . mySort

在ghci中测试:
Prelude> :load Test.hs
*Main> selectFinest [Thing "a" 7, Thing "b" 5, Thing "a" 10]
[Thing {key = "a", score = 10},Thing {key = "b", score = 5}]

--解码 X509 文件

import Data.ByteString (ByteString)
import Data.Certificate.PEM
import Data.Certificate.X509
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L

decode :: ByteString -> Either String X509
decode pem =
    case parsePEMCert pem of
        Nothing       -> Left "certificate not in PEM format"
        Just certdata -> decodeCertificate $ L.fromChunks [certdata]

main :: IO ()
main = print . decode =<< B.readFile "ca-cert.pem"

--使用状态

import Control.Monad.State
import Test.QuickCheck

tThis = take 5 .show . mybreak (>4000000) $ [1..10^7]
tPrel = take 5 . show . prelbreak (>4000000) $ [1..10^7]

prelbreak p xs = (takeWhile (not . p) xs, dropWhile (not . p) xs) -- fast, more or less as implemented in prelude

mybreak p xs = evalState (brk p) ([], xs) -- stateful, slow
brk p = do
(notsat, remaining) <- get
case remaining of
[] -> return (notsat, remaining)
(r:rs) -> if p r
then return (notsat, remaining)
else do put (notsat++[r], rs)
brk p

--As an example of using the ST monad with mutable arrays, here is an implementation of the Sieve of Erathostenes:

--runSTUArray is a specialized form of runST which allows you to build an array using mutation on the inside, 
--before freezing it and returning it as an immutable array. newArray, readArray and writeArray do 
what you'd expect.

import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed

primesUpto :: Int -> [Int]
primesUpto n = [p | (p, True) <- assocs $ sieve n] 

sieve :: Int -> UArray Int Bool
sieve n = runSTUArray $ do
     sieve <- newArray (2, n) True
     forM_ [2..n] $ \p -> do
         isPrime <- readArray sieve p
         when isPrime $ do
             forM_ [p*2, p*3 .. n] $ \k -> do
                   writeArray sieve k False
     return sieve


--让用户输入很多行， 以空行结束

.递归实现

import Prelude hiding (readList)
import Control.Applicative
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
import Data.Maybe

readList :: IO [String]
readList = do
  l <- getLine
  if null l
    then return []
    else (l :) <$> readList


.非递归实现
通用的many组合子可用于任何applicative函子

many :: Applicative f => f a -> f [a]

IO函子不是Applicative的实例, 但我们可以在其上面加一层MaybeT transformer来解决此问题。MaybeT将是我们区别成功/失败的方法。

readList :: IO [String]
readList = fmap (fromMaybe []) $ runMaybeT $ many $ do
  l <- lift getLine
  guard $ not $ null l
  return l

.lift getLine以MaybeT的角度(总是成功)将getLine从IO String提升(lift)至MaybeT IO String
.guard是MonadZero类的函数，用于检查条件是否有效。它与assert函数相似，但它用于流程控制而不是调试
.如果guard没有放弃计算，将简单返回刚读入的行