: B5 ( A -> V S ) DUP 2DUP * * SWAP DUP * 6 * ; \ V=A^3 S=6*A^2
Поясним код:
DUP 2DUP ( A -> A A A A )
2DUP, в отличие от DUP дублирует сразу 2 верхних элемента
* * ( A A A A -> A A*A*A=A^3 )
двойное применение операции умножения дает в результате куб
SWAP ( A A^3 -> A^3 A )
SWAP просто поменял местами два верхних элемента на стеке
DUP * (A^3 A -> A^3 A*A )
возвели в квадрат число на вершине стека
6 * (A^3 A*A -> A^3 6*A^2)
и умножили его на 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
Пример 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 для обычного стека, которое также оставляет количество его элементов, не считая возвращаемый параметр.
Теперь перепишем Пример 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)
F. \ 2-ой результат S=2*(A*B+B*C+A*C)
;
Теперь можно проверить как работает написанное слово:
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 раз больше. Надеюсь по комментариям стековой нотации работа слова понятна (она довольно тривиальна).
Код для вещественного аргумента:
: 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. Результаты теста корректны.
Пример 8. Простая задачка на вычисление среднего арифметического двух целых чисел:
: B8 ( A B -> [A+B]/2 ) + 2/ ;
1 3 B8
Ok ( 2 )
Мини-код работает правильно (1+3)/2=2. Ниже приведем код для вещественного аргумента:
: B8 ( A B -> [A+B]/2 )
F+ 2E F/ ;
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) ИСТИНА
Этот и предыдущий примеры можно оформить красиво, для дальнейшего использования в математических вычислениях или в других программах, как ваши библиотечные функции.
: 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) 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) 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.
Если вам нужен другой порядок вывода результатов, то самостоятельно решите эту задачу.
BEGIN 11-20
Пример 11. Отличается от 10-ого примера незначительными поправками. Просто заменяем квадрат на модуль: код «DUP *» на «ABS».
: B11 ( A B -> {|A|+|B|} {|A|-|B|} {|A|*|B|} {|A|/|B|} )
SWAP ABS SWAP ABS \ A B ->|A| |B|
2DUP + \ |A| |B|-> |A| |B| (|A|+|B|)
ROT ROT 2DUP \ |A| |B| (|A|+|B|) -> (|A|+|B|) |A| |B| (|A|-|B|)
ROT ROT 2DUP * \ (+) |A| |B| (-) -> (+) (-) |A| |B| (|A|*|B|)
ROT ROT / \ (+) (-) |A| |B| (*)-> (+) (-) (*) (|A|/|B|)
;
В случае для вещественных аргументов:
: B11 ( A B -> {|A|+|B|} {|A|-|B|} {|A|*|B|} {|A|/|B|} )
FSWAP FABS \ A B -> B |A|
FSWAP FABS \ B |A| -> |A| |B|
FOVER FOVER F+ \ |A| |B|-> |A| |B| (|A|+|B|)
FROT FROT FOVER FOVER F- \ |A| |B| (|A|+|B|) -> (|A|+|B|) |A| |B| (|A|-|B|)
FROT FROT FOVER FOVER F* \ (+) |A| |B| (-) -> (+) (-) |A| |B| (|A|*|B|)
FROT FROT F/ \ (+) (-) |A| |B| (*)-> (+) (-) (*) (|A|/|B|)
;
В комментариях (скобках) соответствующие сумма, разность, произведение и частное взяты в фигурные скобки для визуального выделения элементов на стеке. Обычные скобки в данном случае применять нельзя, так как они обозначают комментарий и являются зарезервированными словами Форта и системы программирования SP-Forth в частности.
Тест на корректность работы написанных слов произведите самостоятельно.
Пример 12. Вычислить гипотенузу и периметр прямоугольного треугольника по его катетам. Так как мы имеем дело с квадратным корнем, сразу приведем код для случая вещественного аргумента.
: B12 ( A B -> C P ) \ C=Квадратный_Корень(A^2+B^2) P=A+B+C
FOVER FDUP F* \ A B -> A B A^2
FOVER FDUP F* \ A B A^2 -> A B A^2 B^2
F+ FSQRT \ A B A^2 B^2 -> A B Квадратный_Корень(A^2+B^2)=C
FROT FROT F+ \ A B C -> C A+B
FOVER F+ \ C A+B -> C A+B+C=P
;
Проверим на прямоугольном треугольнике с катетами 3 и 5:
3E 4E B12 F. F. \ вызываем нашу подпрограмму и печатаем результат
12.000000 5.0000000 Ok
3^2+4^2=25. Квадратный корень из 25=5. 5+3+4=12 что является истиной. В данном случае специально подобрана Пифагорова тройка, для простоты проверки. Проверим общий случай:
3E 5E B12 F. F.
13.830952 5.8309519 Ok