在Haskell缩短Knuth的算法M（混合基数号） [英] Shortening Knuth's algorithm M (mixed-radix numbers) in Haskell

问题描述

这是我的执行Knuth的算法M中的C ++ code产生混合基数数字：

This is the C++ code of my implementation of Knuth's algorithm M that produces mixed-radix numbers:

#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的code：

This is the code of "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 + + code是非常接近Knuth的伪code。而现在，这是使用可变数组势在必行Haskell的实现：

The C++ code is very close to the Knuth's pseudocode. And now this is an imperative Haskell implementation using mutable arrays:

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中使用列表功能更强大的方法，它是较小的，但我不想要放大的帖子。

I also have and a more functional approach using lists in Haskell which is smaller but I don't want to enlarge the post.

能否请您给我如何缩小哈斯克尔code一些建议吗？

Can you please give me some advice on how to shrink the Haskell code?

我觉得用象Haskell一个高级语言的主要原因是为了少写code，但我不认为这会发生在这里，所以我想，我做错了什么。

I think that the main reason of using a high-level language like Haskell is to write less code but I don't think this happens here so I suppose that I am doing something wrong.

推荐答案

功能的做法是很简洁：

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]]

即使你实现的算法米的短版本，它仍然会在IO单子，所以使用它也会有任何code是在IO单子（或ST单子，如果你使用ST阵列。）

Even if you implement a shorter version of Algorithm M it will still be in the IO monad, and so any code that uses it will also have to be in the IO monad (or the ST monad if you use ST arrays.)

除非有pressing理由使用可变数组，我只想坚持与功能版本。

Unless there is a pressing reason to use a mutable array, I would just stick with the functional version.

在任何情况下，这里是算法米的可变数组版本：

In any case, here is a mutable array version of Algorithm 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)

这篇关于在Haskell缩短Knuth的算法M（混合基数号）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！