Forth http://fforum.winglion.ru/ |
|
*посчитать частоту повторения слов в файле http://fforum.winglion.ru/viewtopic.php?f=19&t=2602 |
Страница 1 из 1 |
Автор: | VoidVolker [ Ср май 19, 2010 15:59 ] |
Заголовок сообщения: | *посчитать частоту повторения слов в файле |
Дано имя файла. Необходимо посчитать количество уникальных лексем в файле, затем вывести собранную информацию в удобном виде. \ посчитать количество уникальных лексем в заданном файле, вывести результат в stdout ТЗ подправлено mOleg |
Автор: | горький [ Пт июн 04, 2010 12:39 ] |
Заголовок сообщения: | Re: *посчитать частоту повторения слов в файле |
Не удержался и написал программу, которая решает сразу две задачи: первоначальную и изменённую. Программа написана для SPF и работает с бинарным деревом. Код: 0
CELL -- T.WORD CELL -- T.COUNT CELL -- T.LEFT CELL -- T.RIGHT CONSTANT /TNODE VARIABLE TREE ( NODEALLOC создает новый узел дерева a1, возвращает адрес нового узла - a2) : NODEALLOC ( a1 -- a2 ) /TNODE ALLOCATE THROW >R R@ SWAP ! R> ; ( STRALLOC копирует строку a1 u1 в строку со счетчиком a2 ) : STRALLOC ( a1 u1 -- a2 ) DUP 1+ ALLOCATE THROW >R DUP R@ C! R@ 1+ SWAP CMOVE R> ; ( NEWNODE создает новый узел дерева a2 и копирует туда слово a1 u1, если оно ненулевой длины) : NEWNODE ( a1 u1 a2 -- ) OVER IF NODEALLOC >R STRALLOC R@ T.WORD ! 1 R@ T.COUNT ! 0 R@ T.LEFT ! 0 R> T.RIGHT ! ELSE DROP 2DROP THEN ; ( ADDWORD вставляет новое слово a1 u1 в дерево a2 или добавляет 1 к счетчику уже имеющегося в дереве a2 слова) : ADDWORD ( a1 u1 a2 -- ) DUP @ 0= IF NEWNODE EXIT THEN @ >R 2DUP R@ T.WORD @ COUNT COMPARE DUP 0= IF 2DROP DROP 1 R> T.COUNT +! EXIT THEN -1 = IF R> T.LEFT RECURSE ELSE R> T.RIGHT RECURSE THEN ; ( _TPRINT печатает счетчик и слово из текущего узла дерева а) : _TPRINT ( a --) DUP T.COUNT @ . @ COUNT TYPE CR ; ( TPRINT печатает счетчики и слова из дерева a ) : TPRINT ( a --) @ ?DUP IF DUP T.LEFT RECURSE DUP _TPRINT T.RIGHT RECURSE THEN ; ( _NODECOUNT считает количество узлов дерева a) VARIABLE #NODE : _NODECOUNT ( a --) @ ?DUP IF 1 #NODE +! DUP T.LEFT RECURSE T.RIGHT RECURSE THEN ; ( NODECOUNT возвращает количество узлов дерева a) : NODECOUNT ( a -- n) 0 #NODE ! _NODECOUNT #NODE @ ; ( SPLIT делит строку a1 u1 по подстроке a2 u2 на строки a3 u3 и a4 u4 и возвращает флаг успешности -1, в случае отсутствия в строке a1 u1 подстроки a2 u2 возвращает неизмененную строку a1 u1 и флаг успешности 0) : SPLIT ( a1 u1 a2 u2 -- a3 u3 a4 u4 -1 | a1 u1 0 ) DUP >R 2OVER DROP >R SEARCH IF SWAP R@ OVER R> - 2SWAP R@ + SWAP R> - -1 EXIT THEN 2R> 2DROP 0 ; ( TRAILING убирает пробелы из начала строки) : TRAILING ( a1 u1 -- a2 u2) BEGIN OVER C@ BL = WHILE 1 -1 D+ REPEAT ; ( ADDWORDS добавляет слова из строки a u в дерево TREE) : ADDWORDS ( a u --) BEGIN TRAILING S" " SPLIT WHILE 2SWAP TREE ADDWORD REPEAT TREE ADDWORD ; ( ADDFILE добавляет слова из файла с дескриптором fd в дерево TREE) : ADDFILE ( fd --) BEGIN DUP PAD 1022 ROT READ-LINE THROW WHILE PAD SWAP ADDWORDS REPEAT DROP ; : lexfreq ( a u --) R/O OPEN-FILE THROW ADDFILE CLOSE-FILE THROW TREE TPRINT ." Unique lexems: " TREE NODECOUNT . CR ; |
Автор: | chess [ Пт июн 11, 2010 15:20 ] |
Заголовок сообщения: | Re: *посчитать частоту повторения слов в файле |
Отдыхая от отпуска. Код: \ читать файл в первый буфер \ и выделить второй буфер для координат лексем( a u ) из первого буфера : file->heap \ af uf -- ab1 ub1 ab2 R/O OPEN-FILE THROW f) f ! \ открыть файл f @ FILE-SIZE THROW DROP s) s ! \ определить его размер memd( ALLOCATE THROW ) \ определить процедуру выделения памяти в хипе s @ memd s @ bf) bf 2! \ выделить первый буфер - под файл bf 2@ f @ READ-FILE THROW DROP \ скопировать файл в первый буфер f @ CLOSE-FILE THROW bf 2@ \ закрыть файл s @ CELLS memd ; \ выделить второй буфер для координат лексем \ дать область поиска второй лексемы и координаты первой лексемы : get-lex \ a u -- a u al ul 1 | 0 OVER + ae) ae ! DUP ab) ab ! at) at ! fle) fle 0! BEGIN at @ C@ BL > IF at @ abl) abl ! 1 fle ! THEN at 1+! at @ ae @ > fle @ OR UNTIL fle @ IF fle 0! BEGIN at @ C@ BL 1+ < IF at @ ael) ael ! 1 fle ! THEN at 1+! at @ ae @ > fle @ OR UNTIL fle @ IF ael @ ae @ ael @ - abl @ ael @ abl @ - TRUE ELSE FALSE THEN ELSE FALSE THEN ; \ сбросить координаты лексем во второй буфер : aulex->buf \ ab1 ub1 ab2 -- cn ab2 ab) ab ! dp) dp 0! cl) cl 0! BEGIN get-lex IF ab @ dp @ + 2! 8 dp +! cl 1+! ELSE cl @ ab @ EXIT THEN AGAIN ; \ число экземпляров каждой уникальной лексемы и число уникальных лексем : lexfreq ( af uf -- ) file->heap ( af uf -- ab1 ub1 ab2 ) ROT 2DUP buf) buf 2! -ROT aulex->buf ( ab1 ub1 ab2 -- cn ab2 ) a) a ! cn) cn ! o) c1) 0 c1 ! c2) 0 c2 ! all) all 0! BEGIN a @ c1 @ 8 * + 2@ 2DUP D0= 0= IF o 2! cn @ c1 @ DO a @ I 8 * + 2@ 2DUP D0= IF 2DROP ELSE o 2@ COMPARE 0= IF c2 1+! 0. a @ I 8 * + 2! THEN THEN LOOP c2 @ . o 2@ TYPE CR all 1+! ELSE 2DROP THEN 0 c2 ! c1 1+! c1 @ cn @ > UNTIL CR all @ . ." уникальных лексем " CR buf 2@ FREE THROW FREE THROW ; \ освободить память в хипе \ EOF ' ANSI>OEM TO ANSI><OEM STARTLOG S" g:\SPF-419\devel\~chess\MUSOR\q3.f" lexfreq лог Код: 4 \ 1 форт 3 : 2 Q3 2 n 2 -- 2 n' 2 DUP 1 2- 1 2* 1 1- 2 * 1 24 1 / 3 ; 2 SEE 1 ассм 3 q3 2 $ 1 -2 1 B=aA 1 C=B 1 1C<< 1 C-- 1 *C 1 *B 1 18 1 B=# 1 CDQ 1 /B 2 S1 1 100 1 1 1 DO 1 I 1 . 1 LOOP 37 уникальных лексем Ok ПС. Использовал механизм лок. слов. |
Автор: | mOleg [ Пт июл 16, 2010 18:08 ] |
Заголовок сообщения: | Re: *посчитать частоту повторения слов в файле |
ну вот и я решил побаловаться. Правда, в первую очередь код иллюстрирует идею (использовать стандартный словарь для подсчета слов) source file: lx.fts использовать вместе с форком так lexfreq "file.name" потом ~~ можно и из командной строки: fork lx.fts lexfreq "file.name" ~~ BYE >out.log |
Автор: | mOleg [ Пн июл 19, 2010 14:57 ] |
Заголовок сообщения: | Re: *посчитать частоту повторения слов в файле |
продолжаем баловаться (небольшая модификация предыдущего варианта) введена дополнительная переменная, которая влияет на поведение слов в словаре STAT в одном случае увеличивается счетчик повторений слова, в другом - выводится информация о этом самом счетчике, и слове соответственно. source file: lx.fts |
Автор: | mOleg [ Пн июл 19, 2010 15:54 ] |
Заголовок сообщения: | Re: *посчитать частоту повторения слов в файле |
а теперь добавилась обрабока коментариев: source file: lx.fts |
Страница 1 из 1 | Часовой пояс: UTC + 3 часа [ Летнее время ] |
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group http://www.phpbb.com/ |