Forth http://fforum.winglion.ru/ |
|
Возможность работать с многомерными массивами http://fforum.winglion.ru/viewtopic.php?f=18&t=2627 |
Страница 3 из 4 |
Автор: | Hishnik [ Вс авг 08, 2010 20:56 ] |
Заголовок сообщения: | Re: Возможность работать с многомерными массивами |
chess писал(а): Все проще. Вот пример: Только он несколько надуман. И в конце кода не хватает DROP. Реальные операции с массивами редко содержат вот такие цепочки действий. |
Автор: | chess [ Пт авг 13, 2010 16:27 ] |
Заголовок сообщения: | Re: Возможность работать с многомерными массивами |
Ввел динамические многомерные массивы(безымянные). Реализация стат. массивов изменена для совместимости с ними. Код: \ многомерные массивы(одномерные - частный случай многомерных при k=1) \ дублировать n параметров на стеке : NDUP ( p*n n -- p*n p*n) CELLS >R SP@ DUP R@ - R@ MOVE SP@ R> - SP! ; : ARRAY \ N1 N2 .. Nk k -- создание массива n! n NDUP n NDUP n 2* 1+ CELLS hlen! CREATE HERE a! n , n 1 ?DO * LOOP CELLS hlen + ALLOT n 1+ 1 DO I CELLS a + ! LOOP 1 n 2* 1+ n 1+ DO I n 1+ = IF NIP DUP ELSE * DUP THEN I CELLS a + ! LOOP DROP DOES> ; \ слово ARRAY формирует сл. структуру данных: \ ------------------------- ЗАГОЛОВОК---------------------------------- --- ДАННЫЕ --- \ k Nk Nk-1 ........ N1 1 Nk-1 Nk-1*Nk-2 ................... Nk-1*..*N1 N1 ........... Nn \ 1 пределы координат коэф-ты для расчета номера элемента по его координатам собственно массив : [DIM ( A -- k дать мерность массива ) @ ; : [HLEN ( A -- LEN длина заголовка массива ) @ 2* 1+ CELLS ; : [SIZE \ A -- N=N1*..*Nk дать размер массива в байтах >R 1 R@ DUP @ 1+ CELLS + R> CELL+ DO I @ * CELL +LOOP CELLS ; : [LIMC \ A -- N1 ... Nk k дать пределы по координатам и их кол-во DUP DUP @ CELLS + DO I @ -4 +LOOP ; : [A0 ( A -- A[0] дать адрес первого элемента массива) B=A [HLEN A+B ; : C[A \ CRD A -- A[i] дать адрес элемента массива по его координатам >R 0 R@ DUP @ 1+ CELLS + DUP R@ @ CELLS + SWAP DO SWAP I @ * + CELL +LOOP CELLS R@ [HLEN + R> + ; : C[@ ( CRD A -- N читать элемент по его координатам ) C[A @ ; : C[! ( n CRD A -- писать элемент по его координатам ) C[A ! ; : N[C \ N A -- K1 .. Kk получение координат элемента по его номеру >R R@ DUP @ 1+ CELLS + R> DUP @ 2* CELLS + DO I @ /MOD SWAP -4 +LOOP DROP ; \ операции над одним массивом : [MAX \ A -- NMAX DUP [A0 >R [SIZE >R 0x80000001 R> R@ + R> DO I @ MAX CELL +LOOP ; : [MIN \ A -- NMAX DUP [A0 >R [SIZE >R 0x7FFFFFFF R> R@ + R> DO I @ MIN CELL +LOOP ; \ обнулить массив : [ERASE ( A --) DUP [A0 SWAP [SIZE ERASE ; \ заполнить массив со стека параметров : S[! ( n..n A -- ) DUP [A0 >R [SIZE R@ + R> DO I ! CELL +LOOP ; M: 1O[ \ A -- a d DUP >R DUP [A0 >R [SIZE R@ + R> DO I DUP @ ; M: ]1O \ a d -- A SWAP ! CELL +LOOP R> ; : [NOT ( A -- ) 1O[ INVERT ]1O ; : [NEG ( A -- ) 1O[ NEGATE ]1O ; : [ABS ( A -- ) 1O[ ABS ]1O ; \ операции над массивом и константой \ заполнить массив константой : [#! ( A # -- ) n! DUP [A0 >R [SIZE R@ + R> DO n I ! CELL +LOOP ; \ заполнить часть массива (от CRD-BEG до CRD-END включительно) константой : C[#! ( CRD-BEG CRD-END A # --) >R DUP >R C[A R> SWAP >R C[A R> CELL+ SWAP R> -ROT DO DUP I ! CELL +LOOP DROP ; M: #[ \ A # -- A d # n! DUP >R [A0 >R [SIZE R@ + R> DO I DUP @ n ; M: ]# \ A d # -- A SWAP ! CELL +LOOP R> ; : [+# #[ + ]# ; : [-# #[ - ]# ; : [*# #[ * ]# ; : [/# #[ * ]# ; : [%# #[ MOD ]# ; : [|# #[ OR ]# ; : [^# #[ XOR ]# ; : [&# #[ AND ]# ; \ операции над двумя массивами M: 2O[ \ A1 A2 -- d1 d2 [A0 a2! DUP DUP >R [A0 a1! [SIZE 0 DO I a1 + @ I a2 + @ ; M: ]2O \ d1 d2 -- A1 I a1 + ! CELL +LOOP R> ; : [+ ( A1 A2 -- A1 = A1 + A2) 2O[ + ]2O ; : [- ( A1 A2 -- A1 = A1 - A2) 2O[ - ]2O ; : [* ( A1 A2 -- A1 = A1 * A2) 2O[ * ]2O ; : [/ ( A1 A2 -- A1 = A1 / A2) 2O[ / ]2O ; : [% ( A1 A2 -- A1 = A1 MOD A2) 2O[ MOD ]2O ; : [| ( A1 A2 -- A1 = A1 OR A2) 2O[ OR ]2O ; : [^ ( A1 A2 -- A1 = A1 XOR A2) 2O[ XOR ]2O ; : [& ( A1 A2 -- A1 = A1 AND A2) 2O[ AND ]2O ; \ создание копий статических массивов в хипе : [DUP \ A -- A A1 a! a [HLEN a [SIZE + u! u ALLOCATE THROW a1! a a1 u MOVE a a1 ; \ создание безымянных динамических многомерных массивов в хипе : HARRAY \ N1 N2 .. Nk k -- addr n! n NDUP n NDUP n 2* 1+ CELLS hlen! n 1 ?DO * LOOP CELLS hlen + ALLOCATE THROW a! n a ! n 1+ 1 DO I CELLS a + ! LOOP 1 n 2* 1+ n 1+ DO I n 1+ = IF NIP DUP ELSE * DUP THEN I CELLS a + ! LOOP DROP a ; \ удалить массив из хипа : [DROP ( A -- ) FREE THROW ; \ утилиты : [DUMP ( A -- ) DUP [SIZE SWAP [A0 SWAP DUMP CR ; ps. Динамические массивы по структуре полностью идентичны статическим, поэтому к ним применимы все операции для статических массивов. |
Автор: | chess [ Пн авг 23, 2010 20:30 ] |
Заголовок сообщения: | Re: Возможность работать с многомерными массивами |
Убрал ошибки и ускорил код для работы с массивами( http://chess2007.nm.ru/arrays.f ) |
Автор: | WingLion [ Вт авг 24, 2010 21:06 ] |
Заголовок сообщения: | Re: Возможность работать с многомерными массивами |
Можно записывать в классику "кодинга ради кодинга". p.s. "я крокодил, крокожу и буду крокодить!" (c)... |
Автор: | вопрос [ Вт авг 24, 2010 22:24 ] |
Заголовок сообщения: | Re: Возможность работать с многомерными массивами |
Цитата: p.s. "я крокодил, крокожу и буду крокодить!" (c)... а чья цитата? |
Автор: | WingLion [ Вт авг 24, 2010 22:48 ] |
Заголовок сообщения: | Re: Возможность работать с многомерными массивами |
вопрос писал(а): а чья цитата? Подозреваю, что Л.П.Берия. |
Автор: | chess [ Вс сен 05, 2010 08:00 ] |
Заголовок сообщения: | Re: Возможность работать с многомерными массивами |
Добавил матрицы Код: \ многомерные массивы(одномерные - частный случай многомерных при n=1) : SPCOPY ( am n -- ) CELLS SP@ 2 CELLS + -ROT CMOVE> ; \ скопировать n параметров на стеке в память \ создание стат. массива : ARRAY ( Ln..L1 n --) n! n 1+ 2* CELLS hlen! CREATE HERE a! n , a CELL+ n SPCOPY n 1 ?DO * LOOP CELLS DUP size! hlen + ALLOT 1 st! n 0 DO I IF I CELLS a + @ st * is st THEN st I n 1+ + CELLS a + ! LOOP size hlen a + CELL- ! DOES> ; \ слово ARRAY формирует сл. структуру данных: \ ------------------------- ЗАГОЛОВОК---------------------------------------- ----- ДАННЫЕ ----- \ n Ln Ln-1 ...... L1 1 L1 L1*L2 ................... L1*..*Ln-1 SIZE N(0)..N(L1*..Ln - 1) \ мерн-ть пределы координат коэффициенты для расчета номера элемента размер собственно массив : [DIM ( A -- n) @ ; \ дать мерность : [HLEN ( A -- LEN) @ 1+ 8 * ; \ длина заголовка в байтах : [A0 ( A -- A[0]) DUP [HLEN + ; \ дать адрес первого элемента : [SIZE ( A -- S=L1*..*Ln) [A0 CELL- @ ; \ дать размер массива в байтах : [LIM ( A -- Ln .. L1) DUP CELL+ SWAP DUP @ CELLS + DO I @ -4 +LOOP ; \ дать пределы \ A+4 A A DIM : C[A ( CRD A -- A[i]) \ дать адрес элемента по координатам a! 0 st! a a [HLEN + CELL- a a [DIM 1+ CELLS + DO I @ * st + is st CELL +LOOP st CELLS a [A0 + ; : C[! ( n CRD A --) C[A ! ; \ записать элемент по координатам : C[@ ( CRD A -- n) C[A @ ; \ читать элемент по координатам : N[C ( N A -- CRD) \ получение координат по номеру >R R@ DUP @ 1+ CELLS + R> DUP @ 2* CELLS + DO I @ /MOD SWAP -4 +LOOP DROP ; \ операции над одним массивом : [MAX ( A -- NMAX) DUP [A0 >R [SIZE >R 0x80000001 R> R@ + R> DO I @ MAX CELL +LOOP ; : [MIN ( A -- NMAX) DUP [A0 >R [SIZE >R 0x7FFFFFFF R> R@ + R> DO I @ MIN CELL +LOOP ; : [ERASE ( A --) DUP [A0 SWAP [SIZE ERASE ; \ обнулить массив : S[! ( n..n A -- ) >R R@ [A0 R@ [SIZE R> [A0 + CELL- DO I ! -4 +LOOP ; \ заполнить массив со стека параметров M: 1O[ ( A -- a d) DUP >R DUP [A0 >R [SIZE R@ + R> DO I DUP @ ; M: ]1O ( a d -- A) SWAP ! CELL +LOOP R> ; : [NOT ( A -- A) 1O[ INVERT ]1O ; : [NEG ( A -- A) 1O[ NEGATE ]1O ; : [ABS ( A -- A) 1O[ ABS ]1O ; \ операции над массивом и константой : [#! ( A # -- ) n! DUP [A0 >R [SIZE R@ + R> DO n I ! CELL +LOOP ; \ заполнить массив константой : C[#! ( CRD-BEG CRD-END A # --) \ заполнить от CRD-BEG до CRD-END включительно >R DUP >R C[A R> SWAP >R C[A R> CELL+ SWAP R> -ROT DO DUP I ! CELL +LOOP DROP ; M: #[ ( A # -- A d #) n! DUP >R DUP [A0 >R [SIZE R@ + R> DO I DUP @ n ; M: ]# ( A d # -- A) SWAP ! CELL +LOOP R> ; : [+# #[ + ]# ; : [-# #[ - ]# ; : [*# #[ * ]# ; : [/# #[ * ]# ; : [%# #[ MOD ]# ; : [|# #[ OR ]# ; : [^# #[ XOR ]# ; : [&# #[ AND ]# ; \ операции над двумя массивами M: 2O[ ( A1 A2 -- d1 d2) [A0 a2! DUP DUP >R [A0 a1! [SIZE 0 DO I a1 + @ I a2 + @ ; M: ]2O ( d1 d2 -- A1) I a1 + ! CELL +LOOP R> ; : [+ ( A1 A2 -- A1 = A1 + A2) 2O[ + ]2O ; : [- ( A1 A2 -- A1 = A1 - A2) 2O[ - ]2O ; : [* ( A1 A2 -- A1 = A1 * A2) 2O[ * ]2O ; : [/ ( A1 A2 -- A1 = A1 / A2) 2O[ / ]2O ; : [% ( A1 A2 -- A1 = A1 MOD A2) 2O[ MOD ]2O ; : [| ( A1 A2 -- A1 = A1 OR A2) 2O[ OR ]2O ; : [^ ( A1 A2 -- A1 = A1 XOR A2) 2O[ XOR ]2O ; : [& ( A1 A2 -- A1 = A1 AND A2) 2O[ AND ]2O ; \ сравнение массивов : [COMPARE ( A1 A2 -- 0|1) a2! a1! TRUE a1 [HLEN a1 [SIZE + 0 DO I a1 + @ I a2 + @ <> IF DROP FALSE LEAVE THEN CELL +LOOP ; \ безымянные динамические массивы в хипе : [DUP ( A -- A A1) \ создание копий массивов в хипе a! a [HLEN a [SIZE + u! u ALLOCATE THROW a1! a a1 u MOVE a a1 ; : [DROP ( A -- ) FREE THROW ; \ удалить массив из хипа : SPDUP ( p*n n -- p*n p*n) \ дублировать n параметров на стеке CELLS >R SP@ DUP R@ - R@ CMOVE> SP@ R> - SP! ; : SPDROP ( p*n n -- ) \ удалить n параметров на стеке 1+ CELLS SP@ + SP! ; : HARRAY ( Ln..L1 n -- addr) \ создание безымянных динамических массивов в хипе n! n 1+ 2* CELLS hlen! n SPDUP n 1 ?DO * LOOP CELLS DUP size! hlen + ALLOCATE THROW a! n a ! a CELL+ n SPCOPY n SPDROP size hlen a + CELL- ! 1 st! n 0 DO I IF I CELLS a + @ st * is st THEN st I n 1+ + CELLS a + ! LOOP a ; \ утилиты : [DUMP ( A -- ) DUP [A0 SWAP [SIZE DUMP CR ; \ только элементы : [HDUMP ( A -- ) DUP [HLEN DUMP CR ; \ только заголовок : [ADUMP ( A -- ) DUP DUP [HLEN SWAP [SIZE + DUMP CR ; \ заголовок и элементы : SPREV ( p*n n -- p'*n) \ реверс n элементов стека A-- D=P ( D-нач.адрес) $ 2 #A<< A+D ( A-кон.адрес) L1: B=@D C=@A @A=B @D=C $ 4 Da $ -4 Aa A=D? L1 J>= DROP ; : ARR. ( A -- ) \ координатная распечатка массива a! a [SIZE CELL / 0 DO CR I a N[C a [DIM SPREV a [DIM 0 DO . LOOP a [A0 I CELLS + @ SPACE . LOOP CR ; \ положить на стек N чисел с шагом 1 начиная c Nbeg : i. ( Nbeg N -- Nbeg Nbeg+1..Nbeg+N ) OVER + SWAP DO I LOOP ; \ Алгебра матриц \ Сумма матриц реализуется через [+ \ Произведение матрицы на скаляр реализуется через [*# \ Произведение матрицы на матрицу : M*M ( A1 A2 -- A) a2! a1! 0 sum! a2 [LIM Lx2! Ly2! a1 [LIM Lx1! Ly1! Lx1 Ly2 <> IF CR ." Matrix no valid" CR EXIT THEN Ly1 Lx2 2 HARRAY a! 0 col2! 0 str1! BEGIN BEGIN Lx1 0 DO str1 I a1 C[@ I col2 a2 C[@ * sum + is sum LOOP sum str1 col2 a C[! 0 is sum col2 1+ is col2 col2 Lx2 = UNTIL 0 is col2 str1 1+ is str1 str1 Ly1 = UNTIL a ; : .BL ( q n -- ) >R DUP >R ABS 0 <# #S R> SIGN #> R> OVER - 0 MAX DUP IF 0 DO BL EMIT LOOP ELSE DROP THEN TYPE ; : MT. ( A -- ) a! a [LIM Lx! Ly! CR \ распечатка матрицы Ly 0 DO Lx 0 DO J I a C[A @ 10 .BL LOOP CR LOOP ; \ EOF 4 3 2 ARRAY MT1 1 12 i. MT1 S[! 3 4 2 ARRAY MT2 1 12 i. MT2 S[! STARTLOG MT1 MT. MT2 MT. MT1 MT2 M*M MT. лог. Код: 1 2 3 4 5 6 7 8 9 10 11 12 1 2 3 4 5 6 7 8 9 10 11 12 38 44 50 56 83 98 113 128 128 152 176 200 173 206 239 272 Ok PS. Для удаления массивов в хипе (после их использования) можно завести массив для сборки мусора, куда складывать адреса дин. массивов и и сделать [DROP по всем элементам этого массива и удалить этот массив. |
Автор: | WingLion [ Вс сен 05, 2010 08:47 ] |
Заголовок сообщения: | Re: Возможность работать с многомерными массивами |
А где умножение матрицы на вектор? |
Автор: | chess [ Вс сен 05, 2010 14:02 ] |
Заголовок сообщения: | Re: Возможность работать с многомерными массивами |
WingLion писал(а): А где умножение матрицы на вектор? Ну вектор можно рассматривать как матрицу с одной строкой(или одним столбцом): Код: 1 3 2 ARRAY VC1 10 3 i. VC1 S[! \ определим вектор 3 4 2 ARRAY MT2 1 12 i. MT2 S[! STARTLOG VC1 MT. MT2 MT. VC1 MT2 M*M MT. лог. Код: 10 11 12
1 2 3 4 5 6 7 8 9 10 11 12 173 206 239 272 Ok |
Автор: | Victor__v [ Вт янв 29, 2019 11:52 ] |
Заголовок сообщения: | Re: Возможность работать с многомерными массивами |
Как получить адрес элемента в многомерном массиве? А то у меня ошибка адресации происходит К примеру, есть 2-мерный массив 3 на 4 (arr[3][4]) Вычисление адреса элемента делаю по коэффициентам (пытался понять код chess'а выше) Итак, для первой мерности k=1, для второй k=3 на входе слова соот-но две координаты и указатель на массив. Я делал с конца Соот-но примерно Код: : TEST >R \ mas-addr 0 >R \ sm 3 * RP@ +! 1 * RP@ +! 2R> CELLS + ; Вот он и работает НЕКОРРЕКТНО Если на входе 0 1, то смещение будет равно 12 А если 3 0, то смещение опять будет равно 12! Где я совершил ошибку? Отмечу, что мне нужен код работающий в любой размерности (2, 3,4 и пр.) |
Автор: | KPG [ Вт янв 29, 2019 14:48 ] |
Заголовок сообщения: | Re: Возможность работать с многомерными массивами |
А так? Код: : TEST
0 2>R 3 * RP@ +! 1 * RP@ +! 2R> CELLS + ; |
Автор: | Victor__v [ Вт янв 29, 2019 15:22 ] |
Заголовок сообщения: | Re: Возможность работать с многомерными массивами |
KPG писал(а): А так? Код: : TEST 0 2>R 3 * RP@ +! 1 * RP@ +! 2R> CELLS + ; На удивление тот же логический косяк. По разным координатам выдаётся один и тот же адрес! 0 1 3 0 Выдаст один и тот же адрес, а это плохо, бателька |
Автор: | KPG [ Вт янв 29, 2019 15:27 ] |
Заголовок сообщения: | Re: Возможность работать с многомерными массивами |
Victor__v писал(а): Выдаст один и тот же адрес, а это плохо, бателька А в каких Форт проверялось и какая промежуточная печать в коде делалась? |
Автор: | Hishnik [ Вт янв 29, 2019 15:45 ] |
Заголовок сообщения: | Re: Возможность работать с многомерными массивами |
Victor__v писал(а): Если на входе 0 1, то смещение будет равно 12 А если 3 0, то смещение опять будет равно 12! Так это ведь одно и то же. Если первая размерность массива равна 3, то индексы будут 0, 1, 2. Индекс 3 - это уже переход на следующую строку массива. |
Автор: | KPG [ Вт янв 29, 2019 15:57 ] |
Заголовок сообщения: | Re: Возможность работать с многомерными массивами |
Hishnik писал(а): Victor__v писал(а): Если на входе 0 1, то смещение будет равно 12 А если 3 0, то смещение опять будет равно 12! Так это ведь одно и то же. Если первая размерность массива равна 3, то индексы будут 0, 1, 2. Индекс 3 - это уже переход на следующую строку массива. т.е. CELLS необходимо добавить при каждой операции умножения и убрать в конце кода |
Страница 3 из 4 | Часовой пояс: UTC + 3 часа [ Летнее время ] |
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group http://www.phpbb.com/ |