我最近在网上阅读了一些关于函数式编程的知识，我认为我对它背后的概念有了基本的了解。
我很好奇如何在纯功能编程语言中解决涉及某种状态的日常编程问题。
例如：“C编程语言”一书中的单词计数程序将如何用纯函数式语言实现？
只要解决方案采用纯粹的功能方式，欢迎任何贡献。
以下是本书中的单词计数C代码：
#include <stdio.h>
#define IN 1 /* inside a word */
#define OUT 0 /* outside a word */
/* count lines, words, and characters in input */
main()
{
int c, nl, nw, nc, state;
state = OUT;
nl = nw = nc = 0;
while ((c = getchar()) != EOF) {
++nc;
if (c == '\n')
++nl;
if (c == ' ' || c == '\n' || c = '\t')
state = OUT;
else if (state == OUT) {
state = IN;
++nw;
}
}
printf("%d %d %d\n", nl, nw, nc);
}
答案 0 :(得分：9)
基本上，在功能上，你需要根据当前字符和当前状态划分从一些状态转换的纯操作中获取数据流的IO操作。
来自Tikhon的Haskell解决方案非常干净，但对输入数据执行三次传递，将导致整个输入包含在内存中，直到计算结果为止。您可以逐步处理数据，我在下面使用Text包，但没有其他高级Haskell工具（可以通过非Haskellers的可理解性来清理它）。
首先我们有序言：
{-# LANGUAGE BangPatterns #-}
import Data.Text.Lazy as T
import Data.Text.Lazy.IO as TIO
然后我们定义我们的数据结构来保存进程的状态（字符，单词和行的数量以及状态IN / OUT）：
data Counts = Cnt { nc, nl, nw :: !Int
, state :: State }
deriving (Eq, Ord, Show)
data State = IN | OUT
deriving (Eq, Ord, Show)
现在我定义一个“零”状态只是为了方便使用。我通常会创建一些辅助函数或使用像lense这样的包来使Counts结构中的每个字段递增变得简单，但是没有这个答案：
zeros :: Counts
zeros = Cnt 0 0 0 OUT
现在我将你的一系列if / else语句翻译成纯状态机：
op :: Counts -> Char -> Counts
op c '\n' = c { nc = nc c + 1, nw = nw c + 1, nl = nl c + 1, state=OUT }
op c ch | ch == ' ' || ch == '\t' = c { nc = nc c + 1, state=OUT }
| state c == OUT = c { nc = nc c + 1, nw = nw c + 1, state = IN }
| otherwise = c { nc = nc c + 1 }
最后，main函数只获取输入流并将操作折叠为字符：
main = do
contents <- TIO.getContents
print $ T.foldl' op zeros contents
import Data.Text.Lazy as T
import Data.Text.Lazy.IO as TIO
op (nc, nw, nl, st) ch
| ch == '\n' = (nc + 1, nw + 1 , nl + 1, True)
| ch == ' ' || ch == '\t' = (nc + 1, nw , nl , True)
| st = (nc + 1, nw + 1 , nl , False)
| otherwise = (nc + 1, nw , nl , st)
main = do
contents <- TIO.getContents
print $ T.foldl' op (0,0,0,True) contents
import语句使我们可以访问我们使用的getContents和foldl'函数。
op函数使用了一堆守卫 - 像| ch = '\n'这样的部分 - 基本上就像是C if / elseif / else系列。
元组( ... , ... , ... , ... )包含我们所有的状态。 Haskell变量是不可变的，因此我们通过在先前变量的值中添加一个（或不添加）来创建新元组。
答案 1 :(得分：6)
一种简单的方法是读入输入，然后使用一些简单的函数来获取行/字/字符数。像这样的东西会起作用：
count :: String -> (Int, Int, Int)
count str = (length $ lines str, length $ words str, length str)
main :: IO ()
main = fmap count getContents >>= print
这不是完全相同，但它已经接近了。
这非常简单。给定一个字符串，我们可以将其转换为具有标准lines函数的行列表和具有标准words函数的单词列表。由于String只是[Char]，length会返回字符数。这就是我们如何获得三项计数。 （供参考，length $ lines str与length (lines str)相同。）
重要的想法是IO - 读取输入并将其打印出来 - 与实际逻辑分离。
此外，我们不是通过字符跟踪输入字符来跟踪某些状态，而是通过将简单函数应用于输入来获得实际数字。这些函数都只是标准库函数的组合。
答案 2 :(得分：5)
在循环中有四个状态变量，nc，nw，nl和state，加上下一个字符c。循环记住从最后一次循环开始的nc，nw，nl和state，并且c通过循环改变每次迭代。想象一下，你将这些变量从循环中取出并将它们放在一个向量中：[state，nc，nw，nl]。然后将循环结构更改为一个带有两个参数的函数，第一个是向量[state，nc，nw，nl]，第二个是c，并返回一个新的向量，其更新值为nc，nw，nl和州。在C-ish伪代码中：
f([state, nc, nw, nl], c) {
++nc;
if (c == '\n')
++nl;
if (c == ' ' || c == '\n' || c = '\t')
state = OUT;
else if (state == OUT) {
state = IN;
++nw;
}
return [state, nc, nw, nl];
}
现在你可以用向量[OUT，0,0,0]和字符串中的第一个字符（“hello，world”，比如说）调用该函数，它将返回一个新的向量[IN，1， 0,0]。使用这个新向量和第二个字符'e'再次调用f，它返回[IN，2,0,0]。对字符串中的其余字符重复此操作，最后一次调用将返回[IN，12,2,0]，与C代码打印的值相同。 基本思想是将状态变量从循环中取出，将循环的内容转换为函数，并将状态变量的向量和下一个输入作为参数传递给该函数，并返回一个新的状态向量作为结果。有一个名为reduce的函数可以做到这一点。
以下是如何在Clojure中执行此操作（格式化以强调返回的向量）：
(defn f [[state nc nw nl] c]
(let [nl (if (= c \n)(inc nl) nl)]
(cond
(or (= c \space)(= c \n)(= c \t)) [:out (inc nc) nw nl]
(= state :out) [:in (inc nc) (inc nw) nl]
true [state (inc nc) nw nl]
)))
(defn wc [s] (reduce f [:out 0 0 0] s))
(wc "hello, world")
返回（并在repl中打印）[：in 12 2 0]
答案 3 :(得分：5)
这是我在Scheme中使用纯函数，严格，单通道，尾递归解决方案的镜头：
(define (word-count input-port)
(let loop ((c (read-char input-port))
(nl 0)
(nw 0)
(nc 0)
(state 'out))
(cond ((eof-object? c)
(printf "nl: ~s, nw: ~s, nc: ~s\n" nl nw nc))
((char=? c #\newline)
(loop (read-char input-port) (add1 nl) nw (add1 nc) 'out))
((char-whitespace? c)
(loop (read-char input-port) nl nw (add1 nc) 'out))
((eq? state 'out)
(loop (read-char input-port) nl (add1 nw) (add1 nc) 'in))
(else
(loop (read-char input-port) nl nw (add1 nc) state)))))
word-count收到input port作为参数;请注意，不会创建其他数据结构（结构，元组，向量等），而是将所有状态保存在参数中。例如，用于计算包含此文件的文件中的单词：
hello, world
调用以下程序：
(call-with-input-file "/path/to/file" word-count)
> nl: 0, nw: 2, nc: 12
答案 4 :(得分：4)
提到了Common Lisp，但它不是纯函数式编程语言，并且它的标准不支持TCO。个别实施。
尾递归版，如果编译器支持它：
(defun word-count (&optional (stream *standard-input*))
(labels ((word-count-aux (in-p chars words lines)
(case (read-char stream nil :eof)
(:eof (values chars words lines))
(#\newline (word-count-aux nil (1+ chars) words (1+ lines)))
((#\space #\tab) (word-count-aux nil (1+ chars) words lines))
(otherwise (word-count-aux t
(1+ chars)
(if in-p words (1+ words))
lines)))))
(word-count-aux nil 0 0 0)))
但由于TCO不符合标准，便携式版本看起来更像是这样：
(defun word-count (&optional (stream *standard-input*)
&aux (in-p nil) (chars 0) (words 0) (lines 0) char)
(loop while (setf char (read-char stream nil nil)) do
(case char
(#\newline (setf in-p nil) (incf lines))
((#\space #\tab) (setf in-p nil))
(otherwise (unless in-p (incf words)) (setf in-p t)))
(incf chars))
(values chars words lines))
以上不再是功能。
我们可以用更高阶stream-map：
(defun stream-map (function stream)
(loop for char = (read-char stream nil nil)
while char do (funcall function char)))
(defun word-count (&optional (stream *standard-input*)
&aux (in-p nil) (chars 0) (words 0) (lines 0) char)
(stream-map (lambda (char)
(incf chars)
(when (eql char #\newline)
(incf lines))
(if (member char '(#\space #\newline #\tab))
(setf in-p nil)
(unless in-p
(incf words)
(setf in-p t))))
stream)
(values chars words lines))
闭包修改了状态。为了摆脱这种情况，我们可以实现stream-reduce。
(defun stream-reduce (function stream &key initial-value)
(let ((value initial-value))
(loop for char = (read-char stream nil nil)
while char
do (setf value (funcall function value char)))
value))
(defun word-count (&optional (stream *standard-input*))
(rest (stream-reduce
(lambda (state char)
(destructuring-bind (in-p chars words lines) state
(case char
(#\newline (list nil (1+ chars) words (1+ lines)))
((#\space #\tab) (list nil (1+ chars) words lines))
(otherwise (list t
(1+ chars)
(if in-p words (1+ words))
lines)))))
stream
:initial-value (list nil 0 0 0))))
答案 5 :(得分：4)
这是程序的Scheme版本，来自我的blog，它实现了整个Unix字数统计程序，包括参数和文件处理。关键功能是wc，它纯粹是功能性的。它将所有局部变量移动到本地函数的参数（通过named-let定义），这是将命令循环转换为函数式的标准习惯用法。手册页和代码如下所示：
NAME
wc -- word count
SYNOPSIS
wc [ -lwc ] [ name ... ]
DESCRIPTION
Wc counts lines, words and characters in the named files,
or in the standard input if no name appears. A word is a
maximal string of characters delimited by spaces, tabs or
newlines.
If the optional argument is present, just the specified
counts (lines, words, or characters) are selected by the
letters l, w or c.
#! /usr/bin/scheme --script
(define l-flag #t)
(define w-flag #t)
(define c-flag #t)
(define (update-flags fs)
(if (not (member #\l fs)) (set! l-flag #f))
(if (not (member #\w fs)) (set! w-flag #f))
(if (not (member #\c fs)) (set! c-flag #f)))
(define (put-dec n width)
(let* ((n-str (number->string n)))
(display (make-string (- width (string-length n-str)) #\space))
(display n-str)))
(define (wc)
(let loop ((inword #f) (c (read-char)) (ls 0) (ws 0) (cs 0))
(cond ((eof-object? c) (values ls ws cs))
((char=? c #\newline)
(loop #f (read-char) (add1 ls) ws (add1 cs)))
((not (member c '(#\space #\newline #\tab)))
(if inword
(loop #t (read-char) ls ws (add1 cs))
(loop #t (read-char) ls (add1 ws) (add1 cs))))
(else (loop #f (read-char) ls ws (add1 cs))))))
(define (main args)
(when (and (pair? args) (char=? (string-ref (car args) 0) #\-))
(update-flags (cdr (string->list (car args))))
(set! args (cdr args)))
(if (null? args)
(let-values (((ls ws cs) (wc)))
(when l-flag (display ls) (display " "))
(when w-flag (display ws) (display " "))
(when c-flag (display cs) (display " "))
(newline))
(let loop ((args args) (l-tot 0) (w-tot 0) (c-tot 0))
(if (null? args)
(begin (when l-flag (put-dec l-tot 12))
(when w-flag (put-dec w-tot 12))
(when c-flag (put-dec c-tot 12)))
(with-input-from-file (car args)
(lambda ()
(let-values (((ls ws cs) (wc)))
(when l-flag (put-dec ls 12))
(when w-flag (put-dec ws 12))
(when c-flag (put-dec cs 12))
(display " ") (display (car args)) (newline)
(loop (cdr args) (+ l-tot ls) (+ w-tot ws) (+ c-tot cs)))))))))
(main (cdr (command-line)))
答案 6 :(得分：2)
这是基于此处发布的Clojure示例的解决方案，但在CL中使用递归。
(defstruct (state (:constructor make-state (state chars words lines)))
state chars words lines)
(defun wc (state stream)
(symbol-macrolet ((s (state-state state))
(c (state-chars state))
(w (state-words state))
(l (state-lines state)))
(case (read-char stream nil :eof)
(:eof state)
(#\Newline (wc (make-state :out (1+ c) w (1+ l)) stream))
(#\Space (wc (make-state :out (1+ c) w l) stream))
(t (if (eq s :out)
(wc (make-state :in (1+ c) (1+ w) l) stream)
(wc (make-state :in (1+ c) w l) stream))))))
(with-input-from-string (stream "Hello Functional Programming World")
(wc (make-state :out 0 0 0) stream))
;;; =＆GT; #S（状态：状态：IN：字符34：字4：LINES 0）
答案 7 :(得分：2)
我相信你可以更优雅地写这个，同时仍然只迭代输入一次，但是你需要让GHC做更多工作，当然使用-O2。
我还没有编译这段代码，更不用说它的速度与Thomas DuBuisson的答案相比，但这应该表明基本的方向。
{-# LANGUAGE BangPatterns #-}
import Data.List
wordcount = snd . foldl' go (False,0)
where go (!b,!n) !c = if elem c [' ','\t','\n'] then (False,n)
else (True, n + if b then 0 else 1)
linecount = foldl' go 0
where go !n !c = n + if c == '\n' then 1 else 0
main = interact $ show . go
where go x = (linecount x, wordcount x, foldl' (\!n _ ->n+1) 0 x)
如果我正确理解了流融合，那么GHC应该将wordcount和linecount内联到main，将三个foldl'命令合并为一个，很有希望，并开始重新排列if检查。我希望它当然也会elem和foldl'内联。
如果没有，你当然可以强制内联并可能创建一个简单的融合规则，但也许默认值就足够了。或者也许一些简单的改变会产生预期的效果。
顺便说一下，我之所以写foldl' (\n _ ->n+1) 0 x只是因为我听说length传闻不好，但也许length工作得很好，另一个值得剖析的变化。
答案 8 :(得分：2)
在Haskell中使用严格的IO而不是懒惰。只有单词，但你可以轻松实现字符和行。需要text和conduit个包：
module Main
where
import Control.Applicative
import Data.Conduit
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import qualified Data.Conduit.Text as CT
import qualified Data.Text as T
import System.Environment
main :: IO ()
main = do args <- getArgs
print <$> (runResourceT $
CB.sourceFile (args !! 0)
$$ CB.lines
=$= CT.decode CT.utf8
=$= CL.map T.words
=$ CL.fold (\acc words -> acc + length words) 0)
答案 9 :(得分：1)
以下是使用match和for循环宏的Typed Racket中的版本：
(: word-count : Input-Port -> Void)
(define (word-count in)
(define-values (nl nw nc st)
(for/fold: ([nl : Integer 0] [nw : Integer 0] [nc : Integer 0]
[state : (U 'in 'out) 'out])
([c (in-input-port-chars in)])
(match* (c state)
[(#\newline _) (values (add1 nl) nw (add1 nc) 'out)]
[((? char-whitespace?) _)
(values (add1 nl) nw (add1 nc) 'out)]
[(_ 'out) (values nl (add1 nw) (add1 nc) 'in)]
[(_ _) (values nl nw (add1 nc) state)])))
(printf "nl: ~s, nw: ~s, nc: ~s\n" nl nw nc))
答案 10 :(得分：1)
这是一个Haskell实现，我试图接近原始C程序所遵循的方法。迭代经常变为折叠操作，包含状态的变量最终作为传递给fold的操作的第一个参数。
-- Count characters, words, and lines in an input string.
wordCount::String->(Int, Int, Int)
wordCount str = (c,w,l)
where (inWord,c,w,l) = foldl op (False,0,0,1) str
where op (inWord,c,w,l) next | next == '\n' = (False,c+1,w,l+1)
| next == '\t' || next == ' ' = (False,c+1,w,l)
| inWord == False = (True,c+1,w+1,l)
| otherwise = (True,c+1,w,l)
main = interact $ show . wordCount