фортеры - Python Challenge 6-10

Python Challenge 6-10

By exs. Saturday, June 2, 2007 10:23:25 AM

Продолжение решений The Python Challenge на SPF. Требуется версия не ниже spf-devel-20070601.

Задачка 6

Задание похожее на то что встречалось ранее, требуется пройти по цепочке файлов, каждый из которых содержит имя cледующего файла в цепочке. Распаковываем требуемые по условию файлы в каталог 6.

Решение

<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>STR@ </span><span style='color:#000084; '>~ac/lib/str5.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>/STRING </span><span style='color:#000084; '>lib/include/string.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>NUMBER </span><span style='color:#000084; '>~ygrek/lib/parse.f</span>

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>filename</span><span style='color:#808080; '> ( n -- s )</span><span style='color:#000084; font-weight:bold; '> " </span><span style='color:#0000ff; '>6\{n}.txt</span><span style='color:#000084; font-weight:bold; '>"</span><span style='color:#000084; font-weight:bold; '> ;</span>

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>prompt </span><span style='color:#000084; font-weight:bold; '>S" </span><span style='color:#0000ff; '>Next nothing is </span><span style='color:#000084; font-weight:bold; '>"</span><span style='color:#000084; font-weight:bold; '> ;</span>

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>extract</span><span style='color:#808080; '> ( a u -- n )</span>
   prompt <span style='color:#000084; font-weight:bold; '>SEARCH </span><span style='color:#000084; font-weight:bold; '>0= </span><span style='color:#800000; '>IF </span><span style='color:#000084; font-weight:bold; '>2DROP </span><span style='color:#008c00; '>0 </span><span style='color:#000084; font-weight:bold; '>EXIT </span><span style='color:#800000; '>THEN</span>
   prompt <span style='color:#000084; font-weight:bold; '>NIP</span> /STRING
   NUMBER <span style='color:#000084; font-weight:bold; '>0= </span><span style='color:#800000; '>IF </span><span style='color:#008c00; '>0 </span><span style='color:#000084; font-weight:bold; '>EXIT </span><span style='color:#800000; '>THEN</span><span style='color:#000084; font-weight:bold; '> ;</span>

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>next</span>
   <span style='color:#800000; '>BEGIN</span>
    <span style='color:#000084; font-weight:bold; '>DUP </span><span style='color:#000084; font-weight:bold; '>CR </span><span style='color:#000084; font-weight:bold; '>." </span><span style='color:#0000ff; '>GO TO </span><span style='color:#000084; font-weight:bold; '>" </span><span style='color:#000084; font-weight:bold; '>.</span>
    filename
    <span style='color:#000084; font-weight:bold; '>>R</span>
    <span style='color:#000084; font-weight:bold; '>R@</span> STR@ FILE <span style='color:#000084; font-weight:bold; '>R></span> STRFREE
    <span style='color:#000084; font-weight:bold; '>2DUP </span><span style='color:#000084; font-weight:bold; '>CR </span><span style='color:#000084; font-weight:bold; '>TYPE</span>
    extract
    <span style='color:#000084; font-weight:bold; '>DUP </span><span style='color:#000084; font-weight:bold; '>0=</span>
   <span style='color:#800000; '>UNTIL</span>
   <span style='color:#000084; font-weight:bold; '>DROP</span>
   <span style='color:#000084; font-weight:bold; '>CR </span><span style='color:#000084; font-weight:bold; '>." </span><span style='color:#0000ff; '>STOP</span><span style='color:#000084; font-weight:bold; '>"</span><span style='color:#000084; font-weight:bold; '> ;</span>

<span style='color:#008c00; '>90052</span> next

И в результате получим 'Collect the comments.' Оказывается у файлов в zip архиве есть комментарии - выдрать их простым способом не получится - поэтому пришлось опять подсмотреть ответ :-(

Задачка 7

Требуется из заданного рисунка выбрать несколько пикселей и преобразовать их цветовые компоненты в коды символов. Либы для работы с PNG изображениями нетути и поэтому качаем файл и преобразовав его каким-нибудь сторонним софтом в формат BMP (24-битный), переименовываем в 7.bmp

Решение

Слово doit выводит красную компоненту требуемых пикселей как символы на стандартный выход. Словом TYPE>STR мы перехватываем этот вывод в строку, выделяем часть закодированную числами, разбиваем по запятым с помощью bac4th слова split ( a u f <--> s1 ) (разбивает строку a u символами, на которых функция f даст TRUE и генерирует вызов для каждой последовательности между этими символами с автоматическим выделением и снятием памяти), заметьте что функция f генерируется автоматически (и удаляется на обратном ходу) словом byChar ( char <--> f ).

<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>CBMP24 </span><span style='color:#000084; '>~ygrek/lib/spec/bmp.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>TYPE>STR </span><span style='color:#000084; '>~ygrek/lib/typestr.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>/STRING </span><span style='color:#000084; '>lib/include/string.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>split </span><span style='color:#000084; '>~profit/lib/bac4th-str.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>NUMBER </span><span style='color:#000084; '>~ygrek/lib/parse.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>SPLIT- </span><span style='color:#000084; '>~pinka/samples/2005/lib/split.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>FINE-HEAD </span><span style='color:#000084; '>~pinka/samples/2005/lib/split-white.f</span>

CBMP24 NEW img
<span style='color:#000084; font-weight:bold; '>S" </span><span style='color:#0000ff; '>7.bmp</span><span style='color:#000084; font-weight:bold; '>"</span> img :load-file

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>doit</span>
   img sizeX <span style='color:#000084; font-weight:bold; '>@ </span><span style='color:#008c00; '>0 </span><span style='color:#800000; '>DO</span>
     <span style='color:#800000; '>I </span><span style='color:#008c00; '>45</span> img :rgb <span style='color:#000084; font-weight:bold; '>2DROP </span><span style='color:#000084; font-weight:bold; '>EMIT</span>
   <span style='color:#008c00; '>7 </span><span style='color:#800000; '>+LOOP</span><span style='color:#000084; font-weight:bold; '> ;</span>

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>solve</span>
   <span style='color:#800000; '>['] </span><span style='color:#000084; font-weight:bold; '>doit</span> TYPE>STR STR@ <span style='color:#000084; font-weight:bold; '>2DUP </span><span style='color:#000084; font-weight:bold; '>CR </span><span style='color:#000084; font-weight:bold; '>TYPE</span>
   <span style='color:#000084; font-weight:bold; '>S" </span><span style='color:#0000ff; '>[</span><span style='color:#000084; font-weight:bold; '>" </span><span style='color:#000084; font-weight:bold; '>SEARCH </span><span style='color:#000084; font-weight:bold; '>0= </span><span style='color:#000084; font-weight:bold; '>ABORT" </span><span style='color:#0000ff; '>BAD1</span><span style='color:#000084; font-weight:bold; '>"</span>
   <span style='color:#008c00; '>1</span> /STRING
   <span style='color:#000084; font-weight:bold; '>S" </span><span style='color:#0000ff; '>]</span><span style='color:#000084; font-weight:bold; '>"</span> SPLIT- <span style='color:#000084; font-weight:bold; '>0= </span><span style='color:#000084; font-weight:bold; '>ABORT" </span><span style='color:#0000ff; '>BAD2</span><span style='color:#000084; font-weight:bold; '>"</span>
   <span style='color:#000084; font-weight:bold; '>2SWAP </span><span style='color:#000084; font-weight:bold; '>2DROP</span>
   <span style='color:#000084; font-weight:bold; '>2DUP </span><span style='color:#000084; font-weight:bold; '>CR </span><span style='color:#000084; font-weight:bold; '>TYPE</span>
   <span style='color:#000084; font-weight:bold; '>CR</span>
   START{
     <span style='color:#800000; '>[CHAR] </span><span style='color:#0000ff; '>,</span> byChar split
     <span style='color:#000084; font-weight:bold; '>DUP</span> STR@
     FINE-HEAD FINE-TAIL NUMBER <span style='color:#000084; font-weight:bold; '>0= </span><span style='color:#000084; font-weight:bold; '>ABORT" </span><span style='color:#0000ff; '>not number</span><span style='color:#000084; font-weight:bold; '>" </span><span style='color:#000084; font-weight:bold; '>EMIT</span>
   }EMERGE
<span style='color:#000084; font-weight:bold; '>;</span>

solve

Задачка 8

Требуется расквотировать две строки - произвольные символы задаются либо явно, либо последовательностью \xXX для символа с шестнадцатеричным кодом XX, либо \r для символа перевода строки.
В результате получаем нечто, на поверку представляющее собой BZip упакованные данные. Распаковав их (сторонним софтом) получим логин и пароль для доступа к следующим уровням.

Решение

<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>NUMBER </span><span style='color:#000084; '>~ygrek/lib/parse.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>/STRING </span><span style='color:#000084; '>lib/include/string.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>TYPE>STR </span><span style='color:#000084; '>~ygrek/lib/typestr.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>OCCUPY </span><span style='color:#000084; '>~pinka/samples/2005/lib/append-file.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>UPPERCASE </span><span style='color:#000084; '>~ac/lib/string/uppercase.f</span>

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>peek</span><span style='color:#808080; '> ( a u -- c ) </span><span style='color:#000084; font-weight:bold; '>0= </span><span style='color:#000084; font-weight:bold; '>THROW </span><span style='color:#000084; font-weight:bold; '>C@</span><span style='color:#000084; font-weight:bold; '> ;</span>
<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>next</span><span style='color:#808080; '> ( a u -- a1 u1 c ) </span><span style='color:#000084; font-weight:bold; '>2DUP</span> peek <span style='color:#000084; font-weight:bold; '>>R </span><span style='color:#008c00; '>1</span> /STRING <span style='color:#000084; font-weight:bold; '>R></span><span style='color:#000084; font-weight:bold; '> ;</span>
<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>HEX-NUMBER</span><span style='color:#808080; '> ( a u -- n ) </span><span style='color:#000084; font-weight:bold; '>BASE </span><span style='color:#000084; font-weight:bold; '>@ </span><span style='color:#000084; font-weight:bold; '>>R </span><span style='color:#000084; font-weight:bold; '>HEX</span> NUMBER <span style='color:#000084; font-weight:bold; '>R> </span><span style='color:#000084; font-weight:bold; '>BASE </span><span style='color:#000084; font-weight:bold; '>!</span><span style='color:#000084; font-weight:bold; '> ;</span>

<span style='color:#000084; font-weight:bold; '>CREATE </span><span style='color:#000084; font-weight:bold; '>buf </span><span style='color:#008c00; '>2 </span><span style='color:#000084; font-weight:bold; '>ALLOT</span>

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>decode\xXX</span><span style='color:#808080; '> ( a u -- a2 u2 c )</span>
   next
   <span style='color:#000084; font-weight:bold; '>DUP </span><span style='color:#800000; '>[CHAR] </span><span style='color:#0000ff; '>r </span><span style='color:#000084; font-weight:bold; '>= </span><span style='color:#800000; '>IF </span><span style='color:#000084; font-weight:bold; '>DROP </span><span style='color:#008c00; '>0x0D </span><span style='color:#000084; font-weight:bold; '>EXIT </span><span style='color:#800000; '>THEN</span>
   <span style='color:#800000; '>[CHAR] </span><span style='color:#0000ff; '>x </span><span style='color:#000084; font-weight:bold; '><> </span><span style='color:#000084; font-weight:bold; '>ABORT" </span><span style='color:#0000ff; '>ERROR1</span><span style='color:#000084; font-weight:bold; '>"</span>
   <span style='color:#000084; font-weight:bold; '>DUP </span><span style='color:#008c00; '>2 </span><span style='color:#000084; font-weight:bold; '>< </span><span style='color:#000084; font-weight:bold; '>ABORT" </span><span style='color:#0000ff; '>ERROR2</span><span style='color:#000084; font-weight:bold; '>"</span>
   <span style='color:#008c00; '>2</span> /GIVE
   <span style='color:#000084; font-weight:bold; '>2DUP</span> UPPERCASE HEX-NUMBER <span style='color:#000084; font-weight:bold; '>0= </span><span style='color:#000084; font-weight:bold; '>ABORT" </span><span style='color:#0000ff; '>ERROR3</span><span style='color:#000084; font-weight:bold; '>"</span><span style='color:#000084; font-weight:bold; '> ;</span>

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>decode</span><span style='color:#808080; '> ( a u -- )</span>
   <span style='color:#800000; '>BEGIN</span>
    next <span style='color:#000084; font-weight:bold; '>DUP </span><span style='color:#800000; '>[CHAR] </span><span style='color:#0000ff; '>\ </span><span style='color:#000084; font-weight:bold; '>= </span><span style='color:#800000; '>IF </span><span style='color:#000084; font-weight:bold; '>DROP</span> decode\xXX <span style='color:#800000; '>THEN</span>
    <span style='color:#000084; font-weight:bold; '>EMIT</span>
    <span style='color:#000084; font-weight:bold; '>DUP </span><span style='color:#000084; font-weight:bold; '>0=</span>
   <span style='color:#800000; '>UNTIL </span><span style='color:#000084; font-weight:bold; '>2DROP</span><span style='color:#000084; font-weight:bold; '> ;</span>

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>un </span><span style='color:#000084; font-weight:bold; '>S" </span><span style='color:#0000ff; '>BZh91AY&SYA\xaf\x82\r\x00\x00\x01\x01\x80\x02\xc0\x02\x00 \x00!\x9ah3M\x07<]\xc9\x14\xe1BA\x06\xbe\x084</span><span style='color:#000084; font-weight:bold; '>"</span><span style='color:#000084; font-weight:bold; '> ;</span>
<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>pw </span><span style='color:#000084; font-weight:bold; '>S" </span><span style='color:#0000ff; '>BZh91AY&SY\x94$|\x0e\x00\x00\x00\x81\x00\x03$ \x00!\x9ah3M\x13<]\xc9\x14\xe1BBP\x91\xf08</span><span style='color:#000084; font-weight:bold; '>"</span><span style='color:#000084; font-weight:bold; '> ;</span>

un <span style='color:#800000; '>' </span><span style='color:#000084; font-weight:bold; '>decode</span> TYPE>STR <span style='color:#000084; font-weight:bold; '>DUP</span> STR@ <span style='color:#000084; font-weight:bold; '>S" </span><span style='color:#0000ff; '>8login.bz2</span><span style='color:#000084; font-weight:bold; '>"</span> OCCUPY STRFREE
pw <span style='color:#800000; '>' </span><span style='color:#000084; font-weight:bold; '>decode</span> TYPE>STR <span style='color:#000084; font-weight:bold; '>DUP</span> STR@ <span style='color:#000084; font-weight:bold; '>S" </span><span style='color:#0000ff; '>8password.bz2</span><span style='color:#000084; font-weight:bold; '>"</span> OCCUPY STRFREE
<span style='color:#000084; font-weight:bold; '>CR </span><span style='color:#000084; font-weight:bold; '>.( </span><span style='color:#0000ff; '>DONE</span><span style='color:#000084; font-weight:bold; '>)</span>

Задачка 9

Задание с красноречивым названием 'connect the dots'. Задан набор координат, проведя линии соединяющие последовательно точки заданные этими координатами получим рисунок.

Решение

Для отрисовки воспользуемся обьектно-ориентированной OpenGL библиотечкой. Уже привычная последовательность [CHAR] , byChar split для выдирания чисел обрамлена в скобки %[ ... ]% для создания списка чисел. Слово % ( n -- ) внутри этих скобок добавляет n в новый список. Остальное - вспомогательный код для создания линий и отображения их в GL окне.

<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>replace-str- </span><span style='color:#000084; '>~pinka/samples/2005/lib/replace-str.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>GLWindow</span>     <span style='color:#000084; '>~ygrek/lib/joopengl/GLWindow.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>lst(</span>         <span style='color:#000084; '>~ygrek/lib/list/ext.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>split</span>        <span style='color:#000084; '>~profit/lib/bac4th-str.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>NUMBER</span>       <span style='color:#000084; '>~ygrek/lib/parse.f</span>

<span style='color:#000084; font-weight:bold; '>" </span><span style='color:#0000ff; '>146,399,163,403,170,393,169,391,166,386,170,381,170,371,170,355,169,346,167,335,170,329,170,320,170,</span>
<span style='color:#0000ff; '>310,171,301,173,290,178,289,182,287,188,286,190,286,192,291,194,296,195,305,194,307,191,312,190,316,</span>
<span style='color:#0000ff; '>190,321,192,331,193,338,196,341,197,346,199,352,198,360,197,366,197,373,196,380,197,383,196,387,192,</span>
<span style='color:#0000ff; '>389,191,392,190,396,189,400,194,401,201,402,208,403,213,402,216,401,219,397,219,393,216,390,215,385,</span>
<span style='color:#0000ff; '>215,379,213,373,213,365,212,360,210,353,210,347,212,338,213,329,214,319,215,311,215,306,216,296,218,</span>
<span style='color:#0000ff; '>290,221,283,225,282,233,284,238,287,243,290,250,291,255,294,261,293,265,291,271,291,273,289,278,287,</span>
<span style='color:#0000ff; '>279,285,281,280,284,278,284,276,287,277,289,283,291,286,294,291,296,295,299,300,301,304,304,320,305,</span>
<span style='color:#0000ff; '>327,306,332,307,341,306,349,303,354,301,364,301,371,297,375,292,384,291,386,302,393,324,391,333,387,</span>
<span style='color:#0000ff; '>328,375,329,367,329,353,330,341,331,328,336,319,338,310,341,304,341,285,341,278,343,269,344,262,346,</span>
<span style='color:#0000ff; '>259,346,251,349,259,349,264,349,273,349,280,349,288,349,295,349,298,354,293,356,286,354,279,352,268,</span>
<span style='color:#0000ff; '>352,257,351,249,350,234,351,211,352,197,354,185,353,171,351,154,348,147,342,137,339,132,330,122,327,</span>
<span style='color:#0000ff; '>120,314,116,304,117,293,118,284,118,281,122,275,128,265,129,257,131,244,133,239,134,228,136,221,137,</span>
<span style='color:#0000ff; '>214,138,209,135,201,132,192,130,184,131,175,129,170,131,159,134,157,134,160,130,170,125,176,114,176,</span>
<span style='color:#0000ff; '>102,173,103,172,108,171,111,163,115,156,116,149,117,142,116,136,115,129,115,124,115,120,115,115,117,</span>
<span style='color:#0000ff; '>113,120,109,122,102,122,100,121,95,121,89,115,87,110,82,109,84,118,89,123,93,129,100,130,108,132,110,</span>
<span style='color:#0000ff; '>133,110,136,107,138,105,140,95,138,86,141,79,149,77,155,81,162,90,165,97,167,99,171,109,171,107,161,</span>
<span style='color:#0000ff; '>111,156,113,170,115,185,118,208,117,223,121,239,128,251,133,259,136,266,139,276,143,290,148,310,151,</span>
<span style='color:#0000ff; '>332,155,348,156,353,153,366,149,379,147,394,146,399</span><span style='color:#000084; font-weight:bold; '>" </span><span style='color:#000084; font-weight:bold; '>VALUE </span><span style='color:#000084; font-weight:bold; '>s1</span>

<span style='color:#000084; font-weight:bold; '>" </span><span style='color:#0000ff; '>156,141,165,135,169,131,176,130,187,134,191,140,191,146,186,150,179,155,175,157,168,157,163,157,159,</span>
<span style='color:#0000ff; '>157,158,164,159,175,159,181,157,191,154,197,153,205,153,210,152,212,147,215,146,218,143,220,132,220,</span>
<span style='color:#0000ff; '>125,217,119,209,116,196,115,185,114,172,114,167,112,161,109,165,107,170,99,171,97,167,89,164,81,162,</span>
<span style='color:#0000ff; '>77,155,81,148,87,140,96,138,105,141,110,136,111,126,113,129,118,117,128,114,137,115,146,114,155,115,</span>
<span style='color:#0000ff; '>158,121,157,128,156,134,157,136,156,136</span><span style='color:#000084; font-weight:bold; '>" </span><span style='color:#000084; font-weight:bold; '>VALUE </span><span style='color:#000084; font-weight:bold; '>s2</span>

s1<span style='color:#000084; font-weight:bold; '> " </span><span style='color:#0000ff; '>{CRLF}</span><span style='color:#000084; font-weight:bold; '>" </span><span style='color:#000084; font-weight:bold; '>""</span> replace-str-
s2<span style='color:#000084; font-weight:bold; '> " </span><span style='color:#0000ff; '>{CRLF}</span><span style='color:#000084; font-weight:bold; '>" </span><span style='color:#000084; font-weight:bold; '>""</span> replace-str-

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>str-to-list</span><span style='color:#808080; '> ( s -- list )</span>
   STR@ %[ START{ <span style='color:#800000; '>[CHAR] </span><span style='color:#0000ff; '>,</span> byChar split <span style='color:#000084; font-weight:bold; '>DUP</span> STR@ NUMBER <span style='color:#000084; font-weight:bold; '>0= </span><span style='color:#000084; font-weight:bold; '>THROW</span> %n }EMERGE ]%<span style='color:#000084; font-weight:bold; '> ;</span>

s1 str-to-list <span style='color:#000084; font-weight:bold; '>VALUE </span><span style='color:#000084; font-weight:bold; '>list1</span>
s2 str-to-list <span style='color:#000084; font-weight:bold; '>VALUE </span><span style='color:#000084; font-weight:bold; '>list2</span>

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>list-to-graph </span><span style='color:#000084; font-weight:bold; '>{</span> list <span style='color:#000084; font-weight:bold; '>|</span><span style='color:#008c00; '> graph data </span><span style='color:#000084; font-weight:bold; '>--</span><span style='color:#808080; '> graph</span><span style='color:#000084; font-weight:bold; '> }</span>
   Graph2D :new <span style='color:#000084; font-weight:bold; '>-></span> graph
   list length <span style='color:#008c00; '>2</span> / graph :points!
   list
   <span style='color:#800000; '>BEGIN</span>
     <span style='color:#000084; font-weight:bold; '>DUP</span> cdr empty? <span style='color:#000084; font-weight:bold; '>0=</span>
   <span style='color:#800000; '>WHILE</span>
     <span style='color:#000084; font-weight:bold; '>DUP</span> car DS>F
     cdr <span style='color:#000084; font-weight:bold; '>DUP</span> car DS>F <span style='color:#000084; font-weight:bold; '>FNEGATE</span> graph :point!
     cdr
   <span style='color:#800000; '>REPEAT</span>
   <span style='color:#000084; font-weight:bold; '>DROP</span>
   graph<span style='color:#000084; font-weight:bold; '> ;</span>

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>draw </span><span style='color:#000084; font-weight:bold; '>{</span> plot2d <span style='color:#000084; font-weight:bold; '>|</span><span style='color:#008c00; '> w</span><span style='color:#000084; font-weight:bold; '> }</span>
   GLWindow :new <span style='color:#000084; font-weight:bold; '>-></span> w
   <span style='color:#008c00; '>0</span> w :create
   <span style='color:#000084; font-weight:bold; '>S" </span><span style='color:#0000ff; '>connect the dots</span><span style='color:#000084; font-weight:bold; '>"</span> w :setText
   w :maximize

   plot2d w :add
   plot2d :autoScale

   w :show
   w :run
   w :free<span style='color:#000084; font-weight:bold; '> ;</span>

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>main </span><span style='color:#000084; font-weight:bold; '>{</span> l1 l2 <span style='color:#000084; font-weight:bold; '>|</span><span style='color:#008c00; '> plot graph</span><span style='color:#000084; font-weight:bold; '> }</span>
   GLPlot2D :new<span style='color:#800000; '> </span><span style='color:#000084; font-weight:bold; '>TO</span> plot

   l1 list-to-graph<span style='color:#800000; '> </span><span style='color:#000084; font-weight:bold; '>TO</span> graph
   Magenta graph <color <span style='color:#000084; font-weight:bold; '>@</span> :set
   graph plot :add

   l2 list-to-graph<span style='color:#800000; '> </span><span style='color:#000084; font-weight:bold; '>TO</span> graph
   Yellow graph <color <span style='color:#000084; font-weight:bold; '>@</span> :set
   graph plot :add

   plot draw<span style='color:#000084; font-weight:bold; '> ;</span>

list1 list2 main <span style='color:#000084; font-weight:bold; '>BYE</span>

Отгадать - что же изображено на рисунке - оставим упражнением читателю :)

Задачка 10

Требуется определить длину 30-го элемента последовательности. Последовательность задана несколькими первыми элементами : (1), (1 1), (2 1), (1 2 1 1), (1 1 1 2 2 1),...
Алгоритм конструирования элементов - образно говоря - "что вижу, то пишу" : 1 - один один - 1 1 - две единицы - 2 1 - один два один один - 1 2 1 1 - один один один два два один - 1 1 1 2 2 1 - три один два два один один - итд.

Решение

Последовательность представим в виде списка. Слово sequence бежит по списку запоминая сколько одинаковых элементов подряд расположено, возвращает начало необработанной части списка, значение и счёт этих значений (cdr ( node -- next ), car ( node -- value )). Слово look&say компонует результат в новый список.

<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>lst( </span><span style='color:#000084; '>~ygrek/lib/list/ext.f</span>
<span style='color:#000084; font-weight:bold; '>REQUIRE </span><span style='color:#000084; font-weight:bold; '>{ </span><span style='color:#000084; '>lib/ext/locals.f</span>

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>sequence </span><span style='color:#000084; font-weight:bold; '>{</span> lst <span style='color:#000084; font-weight:bold; '>|</span><span style='color:#008c00; '> val cnt </span><span style='color:#000084; font-weight:bold; '>--</span><span style='color:#808080; '> lst1 val cnt</span><span style='color:#000084; font-weight:bold; '> }</span>
   lst empty? <span style='color:#000084; font-weight:bold; '>ABORT" </span><span style='color:#0000ff; '>assertion failed</span><span style='color:#000084; font-weight:bold; '>"</span>
   lst car<span style='color:#800000; '> </span><span style='color:#000084; font-weight:bold; '>TO</span> val
   <span style='color:#008c00; '>1</span><span style='color:#800000; '> </span><span style='color:#000084; font-weight:bold; '>TO</span> cnt
   lst cdr
   <span style='color:#800000; '>BEGIN</span>
    <span style='color:#000084; font-weight:bold; '>DUP</span> empty? <span style='color:#800000; '>IF</span> val cnt <span style='color:#000084; font-weight:bold; '>EXIT </span><span style='color:#800000; '>THEN</span>
    <span style='color:#000084; font-weight:bold; '>DUP</span> car val <span style='color:#000084; font-weight:bold; '><> </span><span style='color:#800000; '>IF</span> val cnt <span style='color:#000084; font-weight:bold; '>EXIT </span><span style='color:#800000; '>THEN</span>
    cnt <span style='color:#000084; font-weight:bold; '>1+</span><span style='color:#800000; '> </span><span style='color:#000084; font-weight:bold; '>TO</span> cnt
    cdr
   <span style='color:#800000; '>AGAIN</span><span style='color:#000084; font-weight:bold; '> ;</span>

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>look&say</span><span style='color:#808080; '> ( lst -- lst2 )</span>
   %[
   <span style='color:#800000; '>BEGIN</span>
    <span style='color:#000084; font-weight:bold; '>DUP</span> empty? <span style='color:#000084; font-weight:bold; '>0=</span>
   <span style='color:#800000; '>WHILE</span>
    sequence % %
   <span style='color:#800000; '>REPEAT</span>
   <span style='color:#000084; font-weight:bold; '>DROP</span> ]%<span style='color:#000084; font-weight:bold; '> ;</span>

<span style='color:#000084; font-weight:bold; '>: </span><span style='color:#000084; font-weight:bold; '>morris</span><span style='color:#808080; '> ( n -- lst )</span>
   lst( <span style='color:#008c00; '>1</span> % )lst
   <span style='color:#000084; font-weight:bold; '>SWAP </span><span style='color:#008c00; '>0 </span><span style='color:#800000; '>?DO</span>
    <span style='color:#000084; font-weight:bold; '>DUP</span>
    look&say <span style='color:#000084; font-weight:bold; '>SWAP</span> FREE-LIST
   <span style='color:#800000; '>LOOP</span><span style='color:#000084; font-weight:bold; '> ;</span>

<span style='color:#008c00; '>30</span> morris length <span style='color:#000084; font-weight:bold; '>.</span>

Продолжение следует :)

Показательные выступления bac4th'аРаспечатка стека возвратов