Автор |
Сообщение |
|
|
Заголовок сообщения: |
Re: *посчитать частоту повторения слов в файле |
|
|
а теперь добавилась обрабока коментариев: source file: lx.fts \ 16.07.2010 ~mOleg \ Сopyright [C] 2009 mOleg mOlegg@ya.ru \ решение задачки viewtopic.php?f=19&t=2602 для конкурса
vocs/ vocab.fts vocs/ deref.fts
\ Дано имя файла. \ Необходимо посчитать количество уникальных лексем в файле, \ затем вывести собранную информацию в удобном виде.
VOCABULARY STAT
USER tail \ хвост списка сообщений
\ создать в текущем словаре лексему, которая при каждом вызове \ будет себя увеличивать на 1 : lex ( asc # --> ) CREATED 1 , \ счетчик повторений HERE tail A@ A, tail A! \ связка в односвязный список DOES> 1 SWAP +! ;
\ если имя уже есть в текущем словаре : ?lex ( asc # --> ) DDUP WHO STAT SEARCH-NAME *IF LINK>C EXECUTE DDROP ;THEN DROP lex ;CREATE ;
\ выполнить действие ?lex над каждым словом во входном потоке : (stat) ( --> ) ALSO STAT DEFINITIONS BEGIN NextWord *WHILE ?lex REPEAT DDROP RECENT ;
\ посчитать количество уникальных лексем в заданном файле : lexfreq ( / filename --> ) ParseFileName FileSource ['] (stat) EvalSrcWith ;
\ отобразить статистику по словам : ~~ ( --> ) tail BEGIN A@ *WHILE CR DUP CELL - @ . ." \t" DUP WBA TYPE REPEAT DROP ;
ALSO STAT DEFINITIONS \ теперь слова в коментариях не будут считаться ALIAS \ \ IMMEDIATE ALIAS ( ( IMMEDIATE RECENT
а теперь добавилась обрабока коментариев:
[pre]source file: lx.fts [b][color=#C0C0C0]\ 16.07.2010 ~mOleg[/color] [color=#C0C0C0]\ Сopyright [C] 2009 mOleg mOlegg@ya.ru[/color] [color=#C0C0C0]\ решение задачки http://fforum.winglion.ru/viewtopic.php?f=19&t=2602 для конкурса[/color]
[color=#00F000]vocs/ vocab.fts[/color] [color=#00F000]vocs/ deref.fts[/color]
[color=#C0C0C0]\ Дано имя файла.[/color] [color=#C0C0C0]\ Необходимо посчитать количество уникальных лексем в файле,[/color] [color=#C0C0C0]\ затем вывести собранную информацию в удобном виде.[/color]
[color=#FF8000]VOCABULARY STAT[/color]
[color=#FF8000]USER tail[/color] [color=#C0C0C0]\ хвост списка сообщений[/color]
[color=#C0C0C0]\ создать в текущем словаре лексему, которая при каждом вызове[/color] [color=#C0C0C0]\ будет себя увеличивать на 1[/color] [color=#FF8000]: lex[/color] [color=#0080C0]( asc # --> )[/color] CREATED [color=#00F000]1[/color] , [color=#C0C0C0]\ счетчик повторений[/color] HERE tail A@ A, tail A! [color=#C0C0C0]\ связка в односвязный список[/color] DOES> [color=#00F000]1[/color] SWAP +! [color=#FF8000];[/color]
[color=#C0C0C0]\ если имя уже есть в текущем словаре[/color] [color=#FF8000]: ?lex[/color] [color=#0080C0]( asc # --> )[/color] DDUP WHO STAT SEARCH-NAME [color=#00A0A0]*IF[/color] LINK>C [color=#C00000]EXECUTE[/color] DDROP [color=#FF8000];THEN[/color] DROP lex [color=#FF8000];CREATE[/color] [color=#FF8000];[/color]
[color=#C0C0C0]\ выполнить действие ?lex над каждым словом во входном потоке[/color] [color=#FF8000]: (stat)[/color] [color=#0080C0]( --> )[/color] [color=#FF00FF]ALSO[/color] STAT [color=#FF00FF]DEFINITIONS[/color] [color=#00A0A0]BEGIN[/color] NextWord [color=#00A0A0]*WHILE[/color] ?lex [color=#00A0A0]REPEAT[/color] DDROP [color=#FF00FF]RECENT[/color] [color=#FF8000];[/color]
[color=#C0C0C0]\ посчитать количество уникальных лексем в заданном файле[/color] [color=#FF8000]: lexfreq[/color] [color=#0080C0]( / filename --> )[/color] ParseFileName FileSource [color=#00F000]['] (stat)[/color] EvalSrcWith [color=#FF8000];[/color]
[color=#C0C0C0]\ отобразить статистику по словам[/color] [color=#FF8000]: ~~[/color] [color=#0080C0]( --> )[/color] tail [color=#00A0A0]BEGIN[/color] A@ [color=#00A0A0]*WHILE[/color] CR DUP CELL - @ . [color=#00F000]." \t"[/color] DUP WBA TYPE [color=#00A0A0]REPEAT[/color] DROP [color=#FF8000];[/color]
[color=#FF00FF]ALSO[/color] STAT [color=#FF00FF]DEFINITIONS[/color] [color=#C0C0C0]\ теперь слова в коментариях не будут считаться[/color] [color=#FF8000]ALIAS \ \[/color] [color=#C00000]IMMEDIATE[/color] [color=#FF8000]ALIAS ( ([/color] [color=#C00000]IMMEDIATE[/color] [color=#FF00FF]RECENT[/color][/b][/pre]
|
|
|
|
Добавлено: Пн июл 19, 2010 15:54 |
|
|
|
|
|
Заголовок сообщения: |
Re: *посчитать частоту повторения слов в файле |
|
|
продолжаем баловаться (небольшая модификация предыдущего варианта) введена дополнительная переменная, которая влияет на поведение слов в словаре STAT в одном случае увеличивается счетчик повторений слова, в другом - выводится информация о этом самом счетчике, и слове соответственно. source file: lx.fts \ 16.07.2010 ~mOleg \ Сopyright [C] 2009 mOleg mOlegg@ya.ru \ решение задачки viewtopic.php?f=19&t=2602 для конкурса
vocs/ vocab.fts vocs/ deref.fts
\ Дано имя файла. \ Необходимо посчитать количество уникальных лексем в файле, \ затем вывести собранную информацию в удобном виде.
VOCABULARY STAT
USER-VECT mode \ режим работы
\ увеличить значение счетчика по addr на 1 : inc ( addr --> ) 1 SWAP +! ; \ отобразить значение счетчика по addr и его имя : info ( addr --> ) DUP @ . ." \t - " WBA TYPE CR ;
\ создать в текущем словаре лексему, которая при каждом вызове \ будет себя увеличивать на 1 : lex ( asc # --> ) CREATED 1 , \ счетчик повторений DOES> mode ;
\ если имя уже есть в текущем словаре : ?lex ( asc # --> ) DDUP WHO STAT SEARCH-NAME *IF LINK>C EXECUTE DDROP ;THEN DROP lex ;CREATE ;
\ выполнить действие ?lex над каждым словом во входном потоке : (stat) ( --> ) ALSO STAT DEFINITIONS ['] inc IS mode BEGIN NextWord *WHILE ?lex REPEAT DDROP RECENT ;
\ посчитать количество уникальных лексем в заданном файле : lexfreq ( / filename --> ) ParseFileName FileSource ['] (stat) EvalSrcWith ;
\ отобразить статистику по словам : ~~ ( --> ) ['] info IS mode WHO STAT <: LINK>C EXECUTE ;> WITH-VOC ;
продолжаем баловаться (небольшая модификация предыдущего варианта) введена дополнительная переменная, которая влияет на поведение слов в словаре STAT в одном случае увеличивается счетчик повторений слова, в другом - выводится информация о этом самом счетчике, и слове соответственно.
[pre]source file: lx.fts [b][color=#C0C0C0]\ 16.07.2010 ~mOleg[/color] [color=#C0C0C0]\ Сopyright [C] 2009 mOleg mOlegg@ya.ru[/color] [color=#C0C0C0]\ решение задачки http://fforum.winglion.ru/viewtopic.php?f=19&t=2602 для конкурса[/color]
[color=#00F000]vocs/ vocab.fts[/color] [color=#00F000]vocs/ deref.fts[/color]
[color=#C0C0C0]\ Дано имя файла.[/color] [color=#C0C0C0]\ Необходимо посчитать количество уникальных лексем в файле,[/color] [color=#C0C0C0]\ затем вывести собранную информацию в удобном виде.[/color]
[color=#FF8000]VOCABULARY STAT[/color]
[color=#FF8000]USER-VECT mode[/color] [color=#C0C0C0]\ режим работы[/color]
[color=#C0C0C0]\ увеличить значение счетчика по addr на 1[/color] [color=#FF8000]: inc[/color] [color=#0080C0]( addr --> )[/color] [color=#00F000]1[/color] SWAP +! [color=#FF8000];[/color] [color=#C0C0C0]\ отобразить значение счетчика по addr и его имя[/color] [color=#FF8000]: info[/color] [color=#0080C0]( addr --> )[/color] DUP @ . [color=#00F000]." \t - "[/color] WBA TYPE CR [color=#FF8000];[/color]
[color=#C0C0C0]\ создать в текущем словаре лексему, которая при каждом вызове[/color] [color=#C0C0C0]\ будет себя увеличивать на 1[/color] [color=#FF8000]: lex[/color] [color=#0080C0]( asc # --> )[/color] CREATED [color=#00F000]1[/color] , [color=#C0C0C0]\ счетчик повторений[/color] DOES> mode [color=#FF8000];[/color]
[color=#C0C0C0]\ если имя уже есть в текущем словаре[/color] [color=#FF8000]: ?lex[/color] [color=#0080C0]( asc # --> )[/color] DDUP WHO STAT SEARCH-NAME [color=#00A0A0]*IF[/color] LINK>C [color=#C00000]EXECUTE[/color] DDROP [color=#FF8000];THEN[/color] DROP lex [color=#FF8000];CREATE[/color] [color=#FF8000];[/color]
[color=#C0C0C0]\ выполнить действие ?lex над каждым словом во входном потоке[/color] [color=#FF8000]: (stat)[/color] [color=#0080C0]( --> )[/color] [color=#FF00FF]ALSO[/color] STAT [color=#FF00FF]DEFINITIONS[/color] [color=#00F000]['] inc[/color] IS mode [color=#00A0A0]BEGIN[/color] NextWord [color=#00A0A0]*WHILE[/color] ?lex [color=#00A0A0]REPEAT[/color] DDROP [color=#FF00FF]RECENT[/color] [color=#FF8000];[/color]
[color=#C0C0C0]\ посчитать количество уникальных лексем в заданном файле[/color] [color=#FF8000]: lexfreq[/color] [color=#0080C0]( / filename --> )[/color] ParseFileName FileSource [color=#00F000]['] (stat)[/color] EvalSrcWith [color=#FF8000];[/color]
[color=#C0C0C0]\ отобразить статистику по словам[/color] [color=#FF8000]: ~~[/color] [color=#0080C0]( --> )[/color] [color=#00F000]['] info[/color] IS mode WHO STAT [color=#FF8000]<: LINK>C[/color] [color=#C00000]EXECUTE[/color] [color=#FF8000];>[/color] WITH-VOC [color=#FF8000];[/color] [/b][/pre]
|
|
|
|
Добавлено: Пн июл 19, 2010 14:57 |
|
|
|
|
|
Заголовок сообщения: |
Re: *посчитать частоту повторения слов в файле |
|
|
ну вот и я решил побаловаться. Правда, в первую очередь код иллюстрирует идею (использовать стандартный словарь для подсчета слов) source file: lx.fts \ 16.07.2010 ~mOleg \ Сopyright [C] 2009 mOleg mOlegg@ya.ru \ решение задачки viewtopic.php?f=19&t=2602 для конкурса
vocs/ vocab.fts
\ Дано имя файла. \ Необходимо посчитать количество уникальных лексем в файле, \ затем вывести собранную информацию в удобном виде.
VOCABULARY STAT
\ создать в текущем словаре лексему, которая при каждом вызове \ будет себя увеличивать на 1 : lex ( asc # --> ) CREATED 1 , DOES> 1 SWAP +! ;
\ если имя уже есть в текущем словаре, выполнить его, иначе создать новое имя : ?lex ( asc # --> ) DDUP WHO STAT SEARCH-NAME *IF LINK>C EXECUTE DDROP ;THEN DROP lex ;CREATE ;
\ выполнить действие ?lex над каждым словом во входном потоке : (stat) ( --> ) ALSO STAT DEFINITIONS BEGIN NextWord *WHILE ?lex REPEAT DDROP RECENT ;
\ посчитать количество уникальных лексем в заданном файле : lexfreq ( / filename --> ) ParseFileName FileSource ['] (stat) EvalSrcWith ;
\ отобразить статистику по словам : ~~ ( --> ) WHO STAT <: CR DUP LINK>C CFL + @ . ." \t" ID. ;> WITH-VOC ;
использовать вместе с форком так lexfreq "file.name" потом ~~ можно и из командной строки: fork lx.fts lexfreq "file.name" ~~ BYE >out.log
ну вот и я решил побаловаться. Правда, в первую очередь код иллюстрирует идею (использовать стандартный словарь для подсчета слов)
[pre]source file: lx.fts [b][color=#C0C0C0]\ 16.07.2010 ~mOleg[/color] [color=#C0C0C0]\ Сopyright [C] 2009 mOleg mOlegg@ya.ru[/color] [color=#C0C0C0]\ решение задачки http://fforum.winglion.ru/viewtopic.php?f=19&t=2602 для конкурса[/color]
[color=#00F000]vocs/ vocab.fts[/color]
[color=#C0C0C0]\ Дано имя файла.[/color] [color=#C0C0C0]\ Необходимо посчитать количество уникальных лексем в файле,[/color] [color=#C0C0C0]\ затем вывести собранную информацию в удобном виде.[/color]
[color=#FF8000]VOCABULARY STAT[/color]
[color=#C0C0C0]\ создать в текущем словаре лексему, которая при каждом вызове[/color] [color=#C0C0C0]\ будет себя увеличивать на 1[/color] [color=#FF8000]: lex[/color] [color=#0080C0]( asc # --> )[/color] CREATED [color=#00F000]1[/color] , DOES> [color=#00F000]1[/color] SWAP +! [color=#FF8000];[/color]
[color=#C0C0C0]\ если имя уже есть в текущем словаре, выполнить его, иначе создать новое имя[/color] [color=#FF8000]: ?lex[/color] [color=#0080C0]( asc # --> )[/color] DDUP WHO STAT SEARCH-NAME [color=#00A0A0]*IF[/color] LINK>C [color=#C00000]EXECUTE[/color] DDROP [color=#FF8000];THEN[/color] DROP lex [color=#FF8000];CREATE[/color] [color=#FF8000];[/color]
[color=#C0C0C0]\ выполнить действие ?lex над каждым словом во входном потоке[/color] [color=#FF8000]: (stat)[/color] [color=#0080C0]( --> )[/color] [color=#FF00FF]ALSO[/color] STAT [color=#FF00FF]DEFINITIONS[/color] [color=#00A0A0]BEGIN[/color] NextWord [color=#00A0A0]*WHILE[/color] ?lex [color=#00A0A0]REPEAT[/color] DDROP [color=#FF00FF]RECENT[/color] [color=#FF8000];[/color]
[color=#C0C0C0]\ посчитать количество уникальных лексем в заданном файле[/color] [color=#FF8000]: lexfreq[/color] [color=#0080C0]( / filename --> )[/color] ParseFileName FileSource [color=#00F000]['] (stat)[/color] EvalSrcWith [color=#FF8000];[/color]
[color=#C0C0C0]\ отобразить статистику по словам[/color] [color=#FF8000]: ~~[/color] [color=#0080C0]( --> )[/color] WHO STAT [color=#FF8000]<: CR[/color] DUP LINK>C CFL + @ . [color=#00F000]." \t"[/color] ID. [color=#FF8000];>[/color] WITH-VOC [color=#FF8000];[/color] [/b][/pre]
использовать вместе с [url=http://fforum.winglion.ru/viewtopic.php?p=28004#p28004]форком[/url] так lexfreq "file.name"
потом ~~
можно и из командной строки: fork lx.fts lexfreq "file.name" ~~ BYE >out.log
|
|
|
|
Добавлено: Пт июл 16, 2010 18:08 |
|
|
|
|
|
Заголовок сообщения: |
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 ПС. Использовал механизм лок. слов.
Отдыхая от отпуска. :) [code]\ читать файл в первый буфер \ и выделить второй буфер для координат лексем( 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[/code] лог [code]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 уникальных лексем[/code] Ok ПС. Использовал механизм лок. слов.
|
|
|
|
Добавлено: Пт июн 11, 2010 15:20 |
|
|
|
|
|
Заголовок сообщения: |
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 ;
Не удержался и написал программу, которая решает сразу две задачи: первоначальную и изменённую. Программа написана для SPF и работает с бинарным деревом. [code] 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 ; [/code]
|
|
|
|
Добавлено: Пт июн 04, 2010 12:39 |
|
|
|
|
|
Заголовок сообщения: |
*посчитать частоту повторения слов в файле |
|
|
Дано имя файла. Необходимо посчитать количество уникальных лексем в файле, затем вывести собранную информацию в удобном виде. \ посчитать количество уникальных лексем в заданном файле, вывести результат в stdout : lexfreq ( / filename --> ) ; ТЗ подправлено mOleg
Дано имя файла. Необходимо посчитать количество уникальных лексем в файле, затем вывести собранную информацию в удобном виде.
[pre]\ посчитать количество уникальных лексем в заданном файле, вывести результат в stdout : lexfreq ( / filename --> ) ;[/pre]
[color=#FF0000][size=50]ТЗ подправлено mOleg[/size][/color]
|
|
|
|
Добавлено: Ср май 19, 2010 15:59 |
|
|
|
|