spacepaste

Paste details

reply | raw

  1.  
  2. #!/usr/bin/env bash
  3. # -*- mode: scheme -*-
  4. exec guile $0
  5. # !#
  7. ;;; wordcount.scm --- meeting the challenge with Guile, fast version
  9. ;; Copyright (C) 2017
  10. ;; Arne Babenhauserheide <arne_bab@web.de> and Linus Björnstam
  12. ;; Author: Arne Babenhauserheide <arne_bab@web.de> and Linus Björnstam
  14. ;; This library is free software; you can redistribute it and/or
  15. ;; modify it under the terms of the GNU Lesser General Public
  16. ;; License as published by the Free Software Foundation; either
  17. ;; version 3 of the License, or (at your option) any later version.
  19. ;; This library is distributed in the hope that it will be useful,
  20. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  22. ;; Lesser General Public License for more details.
  24. ;; You should have received a copy of the GNU Lesser General Public
  25. ;; License along with this library. If not, see
  26. ;; <http://www.gnu.org/licenses/>.
  28. ;;; Commentary:
  30. ;; The wordcount challenge pits programming languages against each
  31. ;; other in a battle of counting words in unicode text.
  32. ;;
  33. ;; See https://github.com/juditacs/wordcount
  34. ;;
  35. ;; wordcount_reference.scm holds an alternative version written for
  36. ;; clarity but not speed.
  38. ;;; Code:
  40. (import (ice-9 rdelim)
  41. (ice-9 hash-table))
  43. (define (count-or-unicode>? a b)
  44. (let ((Na (car a))(Nb (car b)))
  45. (or (> Na Nb)
  46. (and (= Na Nb)
  47. (string<? (cdr a) (cdr b))))))
  49. (define (skip-whitespace port)
  50. (let ([ch (peek-char port)])
  51. (or (eof-object? ch) (not (char-whitespace? ch))
  52. (begin (read-char port)
  53. (skip-whitespace port)))))
  55. (define (count-words port)
  56. (define buf '())
  57. (define (read-word port)
  58. (skip-whitespace port)
  59. (cond
  60. ((null? buf)
  61. (let ((line (read-delimited "\t" port)))
  62. (cond
  63. ((eof-object? line) line)
  64. (else (set! buf (apply append (map (λ (x) (string-split x #\space))
  65. (string-split line #\newline))))
  66. (read-word port)))))
  67. (else
  68. (let ((word (car buf)))
  69. (set! buf (cdr buf))
  70. word))))
  71. (define count (make-hash-table 100000))
  72. (define (add-word next)
  73. (hash-set! count next
  74. (1+ (hash-ref count next 0))))
  75. (let loop ((next (read-word port)))
  76. (unless (eof-object? next)
  77. (unless (string-null? next)
  78. (add-word next))
  79. (loop (read-word port))))
  80. (sort! ;; destructive sort to save memory
  81. (hash-map->list (lambda (key val) (cons val key)) count)
  82. count-or-unicode>?))
  84. (for-each
  85. (lambda (x) (format #t "~a\t~a\n" (cdr x) (car x)))
  86. (count-words (current-input-port)))
  87.  
Powered by spacepaste. Paste removal.