[英]Shortening Knuth's algorithm M (mixed-radix numbers) in Haskell
這是我實現Knuth算法M的C ++代碼,它生成混合基數:
#include "visit.h"
void algorithmM(vector<int>& m)
{
m.insert(m.begin(),2);
const int n=m.size();
vector<int> a(n,0);
M2:
visit(false,a);
int j=n-1;
M4:
if (a[j]==m[j]-1) {a[j]=0;--j;goto M4;}
if (j==0) return;
else {a[j]++;goto M2;}
}
int main()
{
vector<int> m;
int i;
while(std::cin>>i)
{if(i<0) continue;
m.push_back(i);
}
algorithmM(m);
return 0;
}
這是“visit.h”的代碼:
#include <iostream>
#include <vector>
using std::vector;
using std::cout;
template<class T> void visit(bool first,vector<T>& l)
{
size_t dt=first?0:1;
for(typename vector<T>::iterator i=l.begin()+dt;i!=l.end();++i)
cout<<*i;
cout<<'\n';
}
C ++代碼非常接近Knuth的偽代碼。 現在,這是使用可變數組的命令式Haskell實現:
import Data.Array.IO
import Control.Monad.State
import Data.IORef
data CountList = CountList {intlist::[Int],count::Int}
lenarr arr = do
b<-getBounds arr
return (snd b)
takeInput :: State (String,Int) [Int]
takeInput = do
(s,count)<-get
let g=reads s
if g==[] then return []
else do
put (snd(head g),count+1)
l<-takeInput
return $ (fst(head g)):l
takeInput2 :: String->CountList
takeInput2 s = let (l,ss)=runState (takeInput) (s,0)
in CountList l (snd ss)
fillArray :: CountList->IO((IOArray Int Int),(IOArray Int Int))
fillArray l = do
arr<-newArray (0,(count l)) 0
x<-nowfill 1 (intlist l) arr
y<-newArray (0,(count l)) 0
writeArray x 0 2
return (x,y)
where nowfill i l arr = do
if l==[] then return arr
else do
writeArray arr i (head l)
nowfill (i+1) (tail l) arr
visit ::(IOArray Int Int)->Int->IO ()
visit x i = do
c<-lenarr x
if i>c then putStrLn ""
else do
a<-readArray x i
putStr (show a)
visit x (i+1)
maj :: (IOArray Int Int)->(IOArray Int Int)->Int->IO((IOArray Int Int),Int)
maj m a j = do
valaj <- readArray a j
valmj <- readArray m j
if valaj==valmj-1 then
do
writeArray a j 0
maj m a (j-1)
else
return (a,j)
m5 :: (IOArray Int Int)->Int->IO((IOArray Int Int),Int)
m5 a j = if j==0 then
return (a,j)
else do
valaj<-readArray a j
writeArray a j (valaj+1)
return (a,j)
algorithmM0 m a = do
visit a 1
n<-lenarr m
(a',j)<-maj m a n
(a'',j')<-m5 a' j
if j'==0 then
return ()
else
algorithmM0 m a''
algorithmM = do
l<-getLine
let mycountlist = takeInput2 l
(m,a)<-fillArray mycountlist
algorithmM0 m a
main :: IO ()
main = algorithmM
我也有一個更實用的方法,使用Haskell中的列表,雖然較小,但我不想放大帖子。
你能否就如何縮小Haskell代碼給我一些建議?
我認為使用像Haskell這樣的高級語言的主要原因是編寫更少的代碼,但我認為這不會發生,所以我認為我做錯了。
功能方法非常簡潔:
algom = sequence . map (\n -> [0..n-1])
algom [2,3,4]
-- [[1,1,1],[1,1,2],[1,1,3],[1,1,4],[1,2,1],[1,2,2],[1,2,3],[1,2,4],[1,3,1],[1,3,2],[1,3,3],[1,3,4],[2,1,1],[2,1,2],[2,1,3],[2,1,4],[2,2,1],[2,2,2],[2,2,3],[2,2,4],[2,3,1],[2,3,2],[2,3,3],[2,3,4]]
即使你實現了算法M的較短版本,它仍然會在IO monad中,因此任何使用它的代碼也必須在IO monad中(如果使用ST數組,則必須在ST monad中)。
除非有迫切的理由使用可變陣列,否則我會堅持使用功能版本。
在任何情況下,這里是算法M的可變數組版本:
import Data.Array.MArray (getBounds,writeArray,readArray,newArray,getElems)
import Data.Array.IO
import Control.Monad.Loops (untilM_)
next :: IOArray Int Int -> IOArray Int Int -> IO Bool
next rarr arr = -- radix array, digit array
do (first,last) <- getBounds arr
let go k | k < first = return True -- end reached
go k = do d <- readArray arr k
r <- readArray rarr k
let newd = d+1
if newd >= r
then do writeArray arr k 0
go (k-1)
else do writeArray arr k newd
return False -- more to come
go last
showArray :: IOArray Int Int -> IO ()
showArray arr = do
nums <- getElems arr
putStrLn $ show nums
(-->) = flip fmap
main = do nums <- getContents --> words --> map read --> takeWhile (>= 0)
let n = length nums
rarr <- newListArray (1,n) nums
arr <- newArray (1,n) 0
untilM_ (showArray arr) (next rarr arr)
算法M的純粹部分確實很短:
algorithmM = mapM (\n -> [0..n-1])
例如,這是ghci中的一個運行:
> algorithmM [2,3]
[[0,0],[0,1],[0,2],[1,0],[1,1],[1,2]]
在它周圍放置一個輸入/輸出循環也很容易。 例如,我們可以添加
main = readLn >>= mapM_ print . algorithmM
編譯並運行包含這兩行(!)的程序,您將看到如下內容:
% ./test
[2,3]
[0,0]
[0,1]
[0,2]
[1,0]
[1,1]
[1,2]
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.