1 ! Copyright (C) 2008 Slava Pestov.
\r
2 ! See http://factorcode.org/license.txt for BSD license.
\r
3 USING: accessors assocs math kernel shuffle generalizations
\r
4 words quotations arrays combinators sequences math.vectors
\r
5 io.styles prettyprint vocabs sorting io generic
\r
6 math.statistics math.order combinators.lib locals.types
\r
10 : badness ( word -- n )
\r
90 : vsum ( pairs -- pair ) { 0 0 } [ v+ ] reduce ;
\r
92 GENERIC: noise ( obj -- pair )
\r
94 M: word noise badness 1 2array ;
\r
96 M: wrapper noise wrapped>> noise ;
\r
98 M: let noise body>> noise ;
\r
100 M: wlet noise body>> noise ;
\r
102 M: lambda noise body>> noise ;
\r
104 M: object noise drop { 0 0 } ;
\r
106 M: quotation noise [ noise ] map vsum { 1/4 1/2 } v+ ;
\r
108 M: array noise [ noise ] map vsum ;
\r
110 : noise-factor ( x y -- z ) / 100 * >integer ;
\r
112 : quot-noise-factor ( quot -- n )
\r
113 #! For very short words, noise doesn't count so much
\r
114 #! (so dup foo swap bar isn't penalized as badly).
\r
116 { [ over 4 <= ] [ >r drop 0 r> ] }
\r
117 { [ over 15 >= ] [ >r 2 * r> ] }
\r
121 ! short words are easier to read
\r
122 { [ dup 10 <= ] [ >r 2 / r> ] }
\r
123 { [ dup 5 <= ] [ >r 3 / r> ] }
\r
124 ! long words are penalized even more
\r
125 { [ dup 25 >= ] [ >r 2 * r> 20 max ] }
\r
126 { [ dup 20 >= ] [ >r 5/3 * r> ] }
\r
127 { [ dup 15 >= ] [ >r 3/2 * r> ] }
\r
129 } cond noise-factor ;
\r
131 GENERIC: word-noise-factor ( word -- factor )
\r
133 M: word word-noise-factor
\r
134 def>> quot-noise-factor ;
\r
136 M: lambda-word word-noise-factor
\r
137 "lambda" word-prop quot-noise-factor ;
\r
139 : flatten-generics ( words -- words' )
\r
141 dup generic? [ "methods" word-prop values ] [ 1array ] if
\r
144 : noisy-words ( -- alist )
\r
145 all-words flatten-generics
\r
146 [ dup word-noise-factor ] { } map>assoc
\r
147 sort-values reverse ;
\r
149 : noise. ( alist -- )
\r
150 standard-table-style [
\r
152 [ [ pprint-cell ] [ pprint-cell ] bi* ] with-row
\r
156 : vocab-noise-factor ( vocab -- factor )
\r
157 words flatten-generics
\r
158 [ word-noise-factor dup 20 < [ drop 0 ] when ] map
\r
160 [ [ sum ] [ length 5 max ] bi /i ]
\r
165 : noisy-vocabs ( -- alist )
\r
166 vocabs [ dup vocab-noise-factor ] { } map>assoc
\r
167 sort-values reverse ;
\r
169 : noise-report ( -- )
\r
170 "NOISY WORDS:" print
\r
171 noisy-words 80 head noise.
\r
173 "NOISY VOCABS:" print
\r
174 noisy-vocabs 80 head noise. ;
\r