Вкратце, процедура преобразования происходит так:

1) выделяется блок из входного потока,
2) формируется матрица всех перестановок, полученных в результате
циклического сдвига блока,
3) все перестановки сортируются в соответствии с лексикографическим
порядком символов каждой перестановки,
4) на выход подается последний столбец матрицы и номер строки,
соответствующей оригинальному блоку.

STARTLOG

REQUIRE "" devel/~ac/lib/str5.f

\ -------- раздел подготовка текста -----------

\ увеличить на единицу 'adr' и добавить в него символ с кодом 'c'
: add_chr ( c adr -- adr )
   1+ SWAP OVER C! ;

\ добавить символ с кодом 'c' в позицию 'adr+1'
\ если это пробел или перевод строк то добавить пробел если его там нет
: add_chr? ( c adr -- adr )
   >R DUP DUP DUP DUP 32 = >R 10 = >R 13 = >R 9 = R> R> R> + + + R> SWAP
   IF     >R R@ C@ 32 = R> SWAP
      IF    NIP
      ELSE   NIP 32 SWAP add_chr
      THEN
   ELSE    add_chr
   THEN ;
   
\ переработать строку 's1' в строку 'adr' убрав переводы строк и лишние пробелы
: prpr_txt ( s1 -- s1 adr )
   CR CR ." входной текст:" CR DUP STR@ 2DUP TYPE DUMP
   DUP STR@ DROP ALLOCATE THROW 2DUP
   SWAP STR@ ROT 32 SWAP add_chr 1-
   BEGIN
   >R OVER C@ R>
   add_chr?
   >R 1- DUP 0 = >R SWAP 1+ SWAP R> R> SWAP
   UNTIL
   DROP 2DROP
   CR CR ." переработанный текст:" 2DUP SWAP STR@ NIP 2DUP CR TYPE DUMP ;

\ -------- раздел выделение груп слов ---------

\ вернуть не ноль если в 'adr u' есть пробел
: wrds? ( adr u -- i )
   1 - 0
   BEGIN    
   >R OVER C@ 32 = R> SWAP IF DROP TRUE THEN >R
   DUP 0= >R 1 - SWAP 1 + SWAP R> R@ + R> SWAP
   UNTIL NIP NIP ;

\ вернуть неноль если 'adr u' ограничен пробелами 'с наружи' и имеет хотябы один пробел внутри
: wrd_gr? ( adr u -- i )
   2DUP wrds? >R OVER + C@ SWAP 1 - C@ 32 = SWAP 32 = * R> * ;

\ временый буфер хранения адресов найденых групп
0x1000 ALLOCATE THROW VALUE tmp_b

\ сброс 'верхнего' значения 'tmp_b'  и уменьшение счетчика на единицу
: tmp_b_drop ( -- )
   tmp_b  @ 1 - DUP tmp_b ! 4 * tmp_b DUP 8 + SWAP 4 + ROT MOVE ;

\ сброс n-го адреса буфера 'tmp_b'
: tmp_b_drop_n ( n -- )
   tmp_b DUP @ DUP 1 - SWAP >R OVER ! \ n adr \ n2
   DUP >R 2DUP SWAP 4 * + >R SWAP 1 + 4 * + R> R> R>
   4 * +  OVER - MOVE ;

\ получить адрес 'n' из буфера 'tmp_b'
: tmp_b_n@ ( n -- adr ) 4 * tmp_b + @ ;   

\ получить 'ерхний' адрес  из буфера 'tmp_b'
: tmp_b@ ( -- adr ) 4 tmp_b + @ ;   

\  искать в тексте группы длинной 'l', сложить адреса начал груп и количество их в масив 'tmp_b' 
: srch_grp_l ( adr u l -- )
   CR CR ." начат поиск груп слов длиннной '" DUP . ." ' символов в области: '" >R 2DUP SWAP . . R> ." '"
   DUP >R - SWAP  R> 0 tmp_b 4 + \ u adr l k tmp_b
   BEGIN
   >R >R >R DUP R@ wrd_gr? R> R> ROT R> SWAP
      IF
      >R 1 + >R >R DUP R> R> ROT R@ ! R> 4 +
      THEN >R >R >R
   SWAP DUP 0= >R 1 - SWAP 1 + R> R> R> ROT R> SWAP
   UNTIL
   DROP NIP NIP NIP
   tmp_b !
   ." найдено '" tmp_b @ . ." ' групп" ;

\ -------- анализ совпадения груп ---------------------------------

\ сравнить строку длиной 'l' и началами в буфере 'tmp_b' с  остальными и выдать количекство совпадений
: srch_cmpr ( l -- )
   CR CR ." поиск совпадений в списке фраз:" tmp_b @ 0 DO CR I 1 + DUP . 4 * tmp_b + @ OVER TYPE LOOP
   0 tmp_b @ 1 -
   BEGIN
   DUP 1 + tmp_b_n@ SWAP >R SWAP >R SWAP >R R@ tmp_b@ R@ COMPARE 0= R> R> ROT R> SWAP
      IF SWAP 1 + SWAP DUP 1 + tmp_b_drop_n 1 - THEN
   1 - DUP 1 <                       
   UNTIL DROP SWAP
   CR CR ." группа слов длиной: '" DUP . ." ' символов '" tmp_b@ SWAP TYPE ." '   повторяется '" . ." ' раз(а)" CR ;

\ анализ совпадающих груп
: rpt_gr. ( l -- )
   BEGIN tmp_b @ 1 > 
   WHILE DUP srch_cmpr tmp_b_drop
   REPEAT DROP ;

\ -------- итого программа ---------------------------------------
: search_rpt_grp
   " { S' test.txt' FILE}" prpr_txt  \ здесь указать файл с текстом на анализ
   SWAP DUP >R STR@ NIP DUP R> STRFREE
   BEGIN
   >R 2DUP R@ srch_grp_l R@ rpt_gr. R> 1- DUP 3 <     
   UNTIL
   2DROP DROP   
   ; search_rpt_grp