haskell - C++ 和 Haskell 中的树遍历

Question

我是 Haskell 新手。我试图了解 haskell 处理递归函数调用及其惰性求值的能力如何。我所做的实验就是简单地用 C++ 和 Haskell 构建二叉搜索树，并分别按后序遍历它们。 C++ 实现是带有辅助堆栈的标准实现。 (我只是在访问该元素后将其打印出来)。

这是我的 Haskell 代码:

module Main (main) where

import System.Environment (getArgs)
import System.IO
import System.Exit
import Control.Monad(when)
import qualified Data.ByteString as S

main = do
     args <- getArgs
     when (length args < 1) $ do
          putStrLn "Missing input files"
          exitFailure

     content <- readFile (args !! 0)
     --preorderV print $ buildTree content
     mapM_ print $ traverse POST $ buildTree content
     putStrLn "end"


data BSTree a = EmptyTree | Node a (BSTree a) (BSTree a) deriving (Show)
data Mode = IN | POST | PRE

singleNode :: a -> BSTree a
singleNode x = Node x EmptyTree EmptyTree

bstInsert :: (Ord a) => a -> BSTree a -> BSTree a
bstInsert x EmptyTree = singleNode x
bstInsert x (Node a left right)
          | x == a = Node a left right
          | x < a  = Node a (bstInsert x left) right
          | x > a  = Node a left (bstInsert x right)

buildTree :: String -> BSTree String
buildTree = foldr bstInsert EmptyTree . words

preorder :: BSTree a -> [a]
preorder EmptyTree = []
preorder (Node x left right) = [x] ++ preorder left ++ preorder right

inorder :: BSTree a -> [a]
inorder EmptyTree = []
inorder (Node x left right) = inorder left ++ [x] ++ inorder right

postorder :: BSTree a -> [a]
postorder EmptyTree = []
postorder (Node x left right) = postorder left ++  postorder right ++[x]

traverse :: Mode -> BSTree a -> [a]
traverse x tree = case x of IN   -> inorder tree
                            POST -> postorder tree
                            PRE  -> preorder tree


preorderV :: (a->IO ()) -> BSTree a -> IO ()
preorderV f EmptyTree = return ()
preorderV f (Node x left right) = do 
                                     f x
                                     preorderV f left
                                     preorderV f right

我的测试结果表明 C++ 明显优于 Haskell:

C++性能:(请注意，first15000.txt大约是first3000.txt的5倍)

time ./speedTestForTraversal first3000.txt > /dev/null 

real    0m0.158s
user    0m0.156s
sys     0m0.000s
time ./speedTestForTraversal first15000.txt > /dev/null 

real    0m0.923s
user    0m0.916s
sys     0m0.004s

Haskell 具有相同的输入文件:

time ./speedTestTreeTraversal first3000.txt > /dev/null 

real    0m0.500s
user    0m0.488s
sys     0m0.008s
time ./speedTestTreeTraversal first15000.txt > /dev/null 

real    0m3.511s
user    0m3.436s
sys     0m0.072s

正如我所料，haskell 应该与 C++ 相差不远。我犯了什么错误吗？有什么方法可以改进我的 haskell 代码吗？

谢谢

编辑:2014 年 10 月 18 日

经过多次测试，haskell 的遍历仍然明显慢于 C++ 实现。我想对 Cirdec 的回答给予充分的评价，因为他指出了我的 haskell 实现的低效率。然而，我最初的问题是比较 C++ 和 haskell 的实现。因此，我想保持这个问题的开放性，并发布我的 C++ 代码以鼓励进一步讨论。

#include <iostream>
#include <string>
#include <boost/algorithm/string.hpp>
#include <fstream>
#include <stack>
using namespace std;
using boost::algorithm::trim;
using boost::algorithm::split;


template<typename T>
class Node
{
public:
    Node(): val(0), l(NULL), r(NULL), p(NULL) {};
    Node(const T &v): val(v), l(NULL), r(NULL), p(NULL) {}
    Node* getLeft() {return l;}
    Node* getRight(){return r;}
    Node* getParent() {return p;}
    void  setLeft(Node *n) {l = n;}
    void  setRight(Node *n) {r = n;}
    void  setParent(Node *n) {p = n;}
    T  &getVal() {return val;}
    Node* getSucc() {return NULL;}
    Node* getPred() {return NULL;}
private:
    T val;
    Node *l;
    Node *r;
    Node *p;
};

template<typename T>
void destoryOne(Node<T>* n)
{
    delete n;
    n = NULL;
}

template<typename T>
void printOne(Node<T>* n)
{
    if (n!=NULL)
    std::cout << n->getVal() << std::endl;
}




template<typename T>
class BinarySearchTree
{
public:
    typedef void (*Visit)(Node<T> *);

    BinarySearchTree(): root(NULL) {}
    void delNode(const T &val){};
    void insertNode(const T &val){
    if (root==NULL)
        root = new Node<T>(val);
    else {
        Node<T> *ptr = root;
        Node<T> *ancester = NULL;
        while(ptr && ptr->getVal()!=val) {
        ancester = ptr;
        ptr = (val < ptr->getVal()) ? ptr->getLeft() : ptr->getRight(); 
        }
        if (ptr==NULL) {
        Node<T> *n = new Node<T>(val);
        if (val < ancester->getVal())
            ancester->setLeft(n);
        else
            ancester->setRight(n);
        } // else the node exists already so ignore!
    }
    }
    ~BinarySearchTree() {
    destoryTree(root);
    }
    void destoryTree(Node<T>* rootN) {
    iterativePostorder(&destoryOne);
    }

    void iterativePostorder(Visit fn) {
    std::stack<Node<T>* > internalStack;
    Node<T> *p = root;
    Node<T> *q = root;
    while(p) {
        while (p->getLeft()) {
        internalStack.push(p);
        p = p->getLeft();
        }
        while (p && (p->getRight()==NULL || p->getRight()==q)) {
        fn(p);
        q = p;
        if (internalStack.empty())
            return;
        else {
            p = internalStack.top();
            internalStack.pop();
        }
        }
        internalStack.push(p);
        p = p->getRight();
    }
    }


    Node<T> * getRoot(){ return root;}
private:
    Node<T> *root;
};



int main(int argc, char *argv[])
{
    BinarySearchTree<string> bst;
    if (argc<2) {
    cout << "Missing input file" << endl;
    return 0;
    }
    ifstream inputFile(argv[1]);
    if (inputFile.fail()) {
    cout << "Fail to open file " << argv[1] << endl;
    return 0;
    }
    while (!inputFile.eof()) {
    string word;
    inputFile >> word;
    trim(word);
    if (!word.empty()) {
        bst.insertNode(word);
    }
    }

    bst.iterativePostorder(&printOne);

    return 0;
}

编辑:2014 年 10 月 20 日克里斯在下面的回答非常彻底，我可以重复结果。

Answer 1

与++的列表串联速度很慢，每次发生++时，都必须遍历其第一个参数到末尾才能找到在哪里添加第二个参数。您可以看到第一个参数是如何在 standard prelude 的 ++ 定义中一直遍历到 [] 的。 :

(++) :: [a] -> [a] -> [a]
[]     ++ ys = ys
(x:xs) ++ ys = x : (xs ++ ys)

当递归使用++时，必须对每一级递归重复此遍历，这是低效的。

还有另一种构建列表的方法:如果您在开始构建列表之前知道列表末尾会出现什么内容，则可以在结尾已经就位的情况下构建它。我们看一下postorder

的定义

postorder :: BSTree a -> [a]
postorder EmptyTree = []
postorder (Node x left right) = postorder left ++ postorder right ++ [x]

当我们创建postorder left时，我们已经知道它后面会发生什么，它将是postorder right++ [x]，所以构建是有意义的树的左侧列表，右侧列表以及已就位的节点的值。同样，当我们使后序正确时，我们已经知道它后面应该是什么，即x。我们可以通过创建一个辅助函数来实现这一点，该函数为列表的其余部分传递累积值

postorder :: BSTree a -> [a]
postorder tree = go tree []
    where
        go EmptyTree rest = rest
        go (Node x left right) rest = go left (go right (x:rest))

当使用 15k 单词的字典作为输入运行时，在我的机器上速度大约是两倍。让我们进一步探讨一下，看看我们是否可以获得更深入的理解。如果我们使用函数组合 (.) 和应用程序 ($) 而不是嵌套括号来重写 postorder 定义，我们就会得到

postorder :: BSTree a -> [a]
postorder tree = go tree []
    where
        go EmptyTree rest = rest
        go (Node x left right) rest = go left . go right . (x:) $ rest

我们甚至可以删除 rest 参数和函数应用 $，并以稍微更无点的风格编写

postorder :: BSTree a -> [a]
postorder tree = go tree []
    where
        go EmptyTree = id
        go (Node x left right) = go left . go right . (x:)

现在我们可以看到我们做了什么。我们用函数 [a] -> [a] 替换了列表 [a]，该函数将列表添加到现有列表的前面。空列表被替换为不向列表开头添加任何内容的函数，即标识函数 id。单例列表 [x] 被替换为将 x 添加到列表开头的函数 (x:)。列表串联 a++ b 替换为函数组合 f 。 g - 首先添加 g 将添加到列表开头的内容，然后添加 f 将添加到该列表开头的内容。