Haskell C+中的树遍历+；哈斯克尔呢

我是哈斯克尔的新手。我试图弄清楚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

具有相同输入文件的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;
}

#包括
#包括
#包括
#包括
#包括
使用名称空间std；
使用boost:：algorithm:：trim；
使用boost:：algorithm:：split；
模板
类节点
{
公众：
Node（）：val（0），l（NULL），r（NULL），p（NULL）{}；
节点（常数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*getsuch（）{return NULL；}
Node*getPred（）{return NULL；}
私人：
T值；
节点*l；
节点*r；
节点*p；
};
模板
void destoryOne（节点*n）
{
删除n；
n=零；
}
模板
void printOne（节点*n）
{
如果（n！=NULL）
std:：cout getVal（）getVal（）！=val）{
ancester=ptr；
ptr=（valgetVal（））？ptr->getLeft（）：ptr->getRight（）；
}
如果（ptr==NULL）{
节点*n=新节点（val）；
如果（valgetVal（））
ancester->setLeft（n）；
其他的
ancester->setRight（n）；
}//否则该节点已经存在，请忽略！
}
}
~BinarySearchTree（）{
树（根）；
}
void destoryTree（节点*rootN）{
迭代PostOrder（&destoryOne）；
}
作废迭代邮购（访问fn）{
std：：堆栈内部堆栈；
节点*p=根；
节点*q=根；
while（p）{
而（p->getLeft（））{
内压（p）；
p=p->getLeft（）；
}
而（p&（p->getRight（）==NULL | | p->getRight（）==q））{
fn（p）；
q=p；
if（internalStack.empty（））
返回；
否则{
p=internalStack.top（）；
internalStack.pop（）；
}
}
内压（p）；
p=p->getRight（）；
}
}
Node*getRoot（）{return root；}
私人：
节点*根；
};
int main（int argc，char*argv[]）
{
二元搜索树；
如果（argc列表与
++
的连接速度较慢，则每次发生
++
时，必须将其第一个参数遍历到底，以找到添加第二个参数的位置。您可以从以下位置查看第一个参数如何遍历到
++
定义中的
[]
：

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

构建列表还有另一种方法：如果你在开始构建列表之前知道列表末尾会出现什么，那么你可以在列表末尾已经准备好的情况下构建它。让我们看看
postorder

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

当我们把
postorder left
设置为
postorder right++[x]时，我们已经知道后面会发生什么
，因此，为树的左侧构建列表，其中包含右侧和节点中已经存在的值是有意义的。类似地，当我们将
postorder right
，我们已经知道它后面应该是什么，即
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 :: 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:）

.List concatenation

a++b

替换为函数组合

f.g

-首先将

g

将要添加的内容添加到列表的开头，然后将

f

将要添加的内容添加到列表的开头。

我生成了一个文件，其中包含所有小写ASCII上的4个字母字符串字母表

abcdefghijklmnopqrstuvwxyz

由空格分隔；我认为我的顺序正确，因此代码生成的树是完全平衡的

我选择这个长度是因为在我的计算机上它需要3.4秒，很像你的3.5s Haskell跑步。我之所以称它为

26_4.txt

，原因很明显。听起来你的数据集实际上接近264个单词，所以它的长度也相当

运行时的下限应该是

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

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

import System.IO
main = do
    mylist <- readFile "26_4.txt"
    mapM_ putStrLn (words mylist)

import System.IO
import qualified Data.Map.Strict as Map

balancedTree = Map.fromList . map (\k -> (k, ()))

serializeTree = map fst . Map.toList

main = do
    mylist <- readFile "26_4.txt"
    mapM_ putStrLn (serializeTree $ balancedTree $ words mylist)

postorder :: BSTree a -> [a]
postorder t = go [] [t]
    where go xs [] = xs
          go xs (EmptyTree : ts) = go xs ts
          go xs (Node x a b : ts) = go (x : xs) (b : a : ts)

data BSTree a = EmptyTree
          | Node  !a !(BSTree a) !(BSTree a) deriving (Show)