Вы можете заметить, что, в примере 3, каждая строка кода сопровождается комментарием, которая поясняет изменения на стеке. Так как все операции и манипуляции, в данном примере, производятся только с вещественным стеком, мы это никак не обозначаем, когда слово будет работать с обоими стеками сразу, вещественный стек будем выделять так: «F: A B A*B=S -> S A B», изменения целочисленного стека дополнительно выделять не будем. Существует еще и стек возвратов. Будьте осторожны, любые неосторожные манипуляции приведут к некорректным результатам, в лучшем случае, в худшем вызовут сообщения об ошибке.

Так же обратите внимание, что комментарии выравниваются так чтобы они выстроились в вертикальную линию, даже те строчки, в которых нет кода, исключительно для удобства чтения (транслятор Форта «проглотил» знаки табуляции, поэтому между кодом и комментарием остался 1 пробел).

рис 12

Пример 5. Здесь вычисляется объем куба и площадь его боковой поверхности. Вначале приведем работу с целочисленным аргументом.

: B5 ( A -> V=A^3 S=6*A^2 )

DUP 2DUP      \ A -> A A A A

* *            \ A A A A -> A A^3

SWAP            \ A A^3 -> A^3 A

DUP * 6 *      \ A^3 A -> A^3 A^2*6 – V=A^3 S=6*A^2

;

Поясним код:

Во второй строчке кода 2DUP, в отличие от DUP дублирует сразу 2 верхних элемента, совместное использование (DUP и 2DUP) оставляют четыре числа A.

В третьей, два умножения «* *» приводят к вычислению куба ( A A A A -> A A*A*A=A^3 ).

В четвертой, SWAP меняет куб числа «A» с ним самим местами ( A A^3 -> A^3 A ).

В пятой, «DUP *» (A^3 A -> A^3 A*A ), возводит в квадрат число на вершине стека, а «6 *» умножает его на шесть. В результате получаем площадь боковой поверхности.

Вызовем написанное слово с параметром 15 (сторона куба):

15 B5

Ok ( 3375 1350 )

3375=15*15*15 и 1350=6*15*15, все верно, слово работает корректно.

То же самое с вещественными числами:

: B5 ( A -> V S )      \ V=A^3 S=6*A^2

FDUP FDUP FDUP      \ A -> A A A A – 2FDUP SP-Forth не понимает

F* F*                  \ A A A A -> A A*A*A=A^3

FSWAP                  \ A A^3 -> A^3 A

FDUP F*            \ A^3 A -> A^3 A*A

6E F*                  \ A^3 A*A -> A^3 6*A^2

;

Проверим написанный код, возьмем куб со стороной 1,5:

15E-1 B5 F. F.

13.500000 3.3750000 Ok      \ 6*1.5^2 = 13.5 1.5^3 = 3.375

Помните, что оператор «F.» печатает то, что лежит на вершине стека. Если вам нужен другой порядок можно применить FSWAP, так при необходимости вывести сперва объем, как в стековой нотации, можно набрать следующее:

15E-1 B5 FSWAP F. F.

3.3750000 13.500000 Ok

рис 13

Самостоятельно напишите слово «B5.» для вещественного варианта и корректный вывод результатов с целочисленного стека в первом случае.

Пример 6. Здесь необходимо вычислить объем и площадь поверхности прямоугольного параллелепипеда, через его ребра.

: B6 ( A B C -> S V )      \ S=2*(A*B+B*C+A*C) V=A*B*C )

DUP 2OVER      \ A B C -> A B C C A B

DUP 2OVER      \ A B C C A B -> A B C C A B B C A

ROT *            \ A B C C A B B C A -> A B C C A B C A*B

ROT ROT * +      \ A B C C A B C A*B -> A B C C A (A*B+B*C)

ROT ROT * +      \ A B C C A A*B+B*C -> A B C (A*B+B*C+C*A)

2*            \ A B C (A*B+B*C+C*A) -> A B C (A*B+B*C+C*A)*2

SWAP 2SWAP      \ A B C (A*B+B*C+C*A)*2 -> (A*B+B*C+C*A)*2 C A B

* * ;            \ (A*B+B*C+C*A)*2 (C*A*B)

Где (A*B+B*C+C*A)*2 – это площадь поверхности, а (C*A*B) – объем.

В данном примере появляется 3 параметра, что не слишком усложняет задачу, и по-прежнему мы не будем использовать переменные в явном виде, манипулируя только с данными на стеке.

В коде для вещественных чисел надо, чтобы число элементов не превышало максимума, из-за его ограниченности произойдет ошибка. Проверим сколько вмещает наша система, для этого наберем следующие команды:

FDEPTH            \ Это слово возвращает количество элементов в вещественном стеке

Ok ( 0 )            \ 0 элементов

5E-1 FDEPTH      \ введем 1-ое число

Ok ( 0 1 )      \ 1 элемент на вещественном стеке

5E-1 FDEPTH      \ введем 2-ое число

Ok ( 0 1 2 )      \ 2 элемента

5E-1 FDEPTH      \ введем 3-е число

Ok ( 0 1 2 3 )      \ 3

5E-1 FDEPTH      \ введем 4-ое число

Ok ( 0 1 2 3 4 )      \ 4

5E-1 FDEPTH      \ введем 5-ое число

Ok ( [6].. 1 2 3 4 5 )

5E-1 FDEPTH      \ введем 6-ое число

Ok ( [7].. 2 3 4 5 6 )

5E-1 FDEPTH      \ введем 7-ое число

Ok ( [8].. 3 4 5 6 7 )

5E-1 FDEPTH      \ ошибка !!!

Если после ошибки ввести «F.» получим:

infinity Ok

После ошибки лучше перезапустить SP-Forth. Так же не забывайте о подключении библиотек заново для работы с вещественными числами. Существует слово DEPTH для обычного стека, которое также оставляет количество его элементов, не считая возвращаемый параметр, но для целочисленного стека.

рис 15

Перепишем Пример 6 для вещественных чисел.

: B6 ( A B C -> S V )      \ S=2*(A*B+B*C+A*C) V=A*B*C )

FOVER FOVER F+      \ A B C -> A B C (B+C)

FROT FROT F*            \ A B C (B+C) -> A (B+C) B*C

FROT                  \ A (B+C) B*C -> (B+C) B*C A

FOVER FOVER F*      \ (B+C) B*C A -> (B+C) B*C A B*C*A

F.                  \ 1-ый результат – объем

FROT F* F+ 2.E F*      \ (B+C) B*C A -> {B*C+A*(B+C)}*2

F.                  \ 2-ой результат S=2*(A*B+B*C+A*C)

;

Теперь можно проверить как работает написанное слово:

рис 16

1E-1 2E-1 3E-1 B6

0.0060000 0.2200000 Ok

Объем прямоугольного параллелепипеда 0,006=0,1*0,2*0,3 и площадь его поверхности 0,22=2*(0,1*0,2+0,2*0,3+0,1*0,3).

Проведите тесты с целочисленным вариантом. Как вывести результаты, нужны ли дополнительные манипуляции со стеком? Последний вариант получился не универсальным, печать результатов в самом слове. Можете это исправить как уже было сделано ранее?

Пример 7. Зная радиус окружности, посчитаем его длину и площадь.

: B7 ( R -> L S)             \ L=2*Pi*R и S=Pi*R^2

DUP 2* 314 *             \ R -> R R*2*314=L

SWAP             \ R L -> L R

DUP 314 * *             \ L R -> L R*R*314=S

;

Целочисленный вариант принимает целое значение радиуса и выдает результат в 100 раз больше. Надеюсь по комментариям стековой нотации работа слова понятна (она довольно тривиальна).

Результаты теста с ранее написанным словом «.2»:

рис 17

Для печати с тем же порядком как в стековой нотации наберите «1 B7 SWAP .2 .2»

Код для вещественного аргумента:

: B7 ( R -> L S) \ L=2*Pi*R и S=Pi*R^2

FDUP 2E F* 314E-2 F* \ R -> R 2*Pi*R=L

FSWAP             \ R L -> L R

FDUP 314E-2 F* F*       \ L R -> L R*R*3.14=S

;

Вычислим длину окружности и площадь круга радиусом 0,1:

1E-1 B7 F. F.

0.0314000 0.6280000 Ok

0.0314000=0,1*0,1*3,14 и 0.6280000= 2*3,14*0,1. Результаты теста корректны.

рис 19

1E-1 2E-1 B8 F.

0.1500000 Ok

0.15 = (0.1+0.2)/2 – ИСТИНА

Пример 9. Среднее геометрическое двух чисел – это квадратный корень из их произведения. Сразу напишем код для вещественного аргумента, так как возможности извлечение корня для целых чисел в системе SP-Forth нет, для этого придётся переводить целое число в вещественное извлечь квадратный корень, затем перевести обратно в целый вид, поэтому здесь такие хлопоты не оправданы, но если где-то вам это понадобится, то такое возможно.

: B9 ( A B -> SQRT[A*B] ) F* FSQRT ;

Очень короткий и понятный код, который тестируем ниже:

3E-1 75E-1 B9 F.

1.5000000 Ok \ 1,5 = Корень_Квадратный_из(0,3*7,5) – ИСТИНА

рис 20

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

: MIDDLE_ARITHMETIC ( A B -> [A+B]/2 ) F+ 2E F/ ;

: MIDDLE_GEOMETRIC ( A B -> SQRT[A*B] ) F* FSQRT ;

За грамотные английские названия не ручаюсь.

Пример 10. Вход два числа, не равные нулю. Вычислим сумму, разность, произведение и частное их квадратов, те есть:

: B10 ( A B -> A^2+B^2 A^2-B^2 A^2*B^2 A^2/B^2 )

SWAP DUP * SWAP DUP *       \ A B ->A^2 B^2

2DUP +                   \ A^2 B^2 -> A^2 B^2 (A^2+B^2)=(+)

ROT ROT 2DUP –             \ A^2 B^2 (+) -> (+) A^2 B^2 (A^2-B^2)=(-)

ROT ROT 2DUP *             \ (+) A^2 B^2 (-) -> (+) (-) A^2 B^2 (A^2*B^2)=(*)

ROT ROT /                   \ (+) (-) A^2 B^2 (*) -> (+) (-) (*) (A^2/B^2 )=(/)

;

Протестируем на числах 4 и 2.

4 2 B10

Ok ( 20 12 64 4 )

Всё корректно, проверяйте самостоятельно. В комментариях я сократил сумму, разность и произведение квадратов до соответствующих операций в скобках. Специально подобраны такие числа, чтобы результат деления был целочисленным, но это не обязательно – код для вещественных аргументов избавит нас от таких неудобств:

: B10 ( A B -> A^2+B^2 A^2-B^2 A^2*B^2 A^2/B^2 )

FSWAP FDUP F*             \ A B -> B A^2

FSWAP FDUP F*             \ B A^2 -> A^2 B^2

FOVER FOVER F+             \ A^2 B^2 -> A^2 B^2 (A^2+B^2)=(+)

FROT FROT FOVER FOVER F-       \ A^2 B^2 (+) -> (+) A^2 B^2 (A^2-B^2)=(-)

FROT FROT FOVER FOVER F*       \ (+) A^2 B^2 (-) -> (+) (-) A^2 B^2 (A^2*B^2)=(*)

FROT FROT F/             \ (+) (-) A^2 B^2 (*) -> (+) (-) (*) (A^2/B^2)=(/)

;

Тест примера 10:

1E-1 2E-1 B10 F. F. F. F.

0.2500000 0.0004000 -0.0300000 0.0500000 Ok

Не забываем, что оператор F. Печатает число с вершины стека, поэтому сначала печатается частное, затем произведение, после чего разность и в конце сумма.

0,25 = 0,01/0,04; 0,0004 = 0,01*0,04; -0,03 = 0,01-0,04; 0,05 = 0,01+0,04.

Если вам нужен другой порядок вывода результатов, то самостоятельно решите эту задачу для обоих вариантов, слова ниписаны в соответствии со стековой нотацией.

Полезные слова (если переименовать и разбить некоторые из приведенных выше, то получим список, который можете использовать как свою маленькую математическую библиотеку):

: SquarePerimeter       ( a -> P=4*a ) 4E F* ;

: SquareArea             ( a -> S=a*a ) FDUP F* ;

: RectanglePerimeter       ( a b -> P=2*[a+b] ) F+ 2E F* ;

: RectangleArea             ( a b -> S=a*b ) F* ;

: CircleLength             ( r -> l=2*Pi*r ) 2E FPI F* F* ;

: CircleArea             ( r -> S=Pi*r*r ) FDUP F* FPI F* ;

: CubeVolume                   ( a -> V=a*a*a ) FDUP FDUP F* F* ;

: CubeLateralSurfaceArea       ( a -> S=6*a*a ) FDUP F* 6E F* ;

: RectangularPrismVolume             ( a b c -> V=a*b*c ) F* F* ;

: RectangularPrismLateralSurfaceArea       ( a b c -> S=2*[a*b+b*c+a*c] ) FOVER FOVER F+ FROT FROT F* FSWAP FROT F* F+ 2E F* ;

: ArithmeticMean       ( a b -> [A+B]/2 ) F+ 2E F/ ;

: GeometricMean       ( a b -> SQRT[A*B] ) F* FSQRT ;

Тесты проведите самостоятельно.