Forth и другие саморасширяющиеся системы программирования Locations of visitors to this page
Текущее время: Пт апр 20, 2018 04:54

...
Google Search
Forth-FAQ Spy Grafic

Часовой пояс: UTC + 3 часа [ Летнее время ]




Начать новую тему Ответить на тему  [ Сообщений: 39 ]  На страницу Пред.  1, 2, 3
Автор Сообщение
 Заголовок сообщения: Re: Возможность работать с многомерными массивами
СообщениеДобавлено: Вс авг 08, 2010 20:56 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6269
Благодарил (а): 14 раз.
Поблагодарили: 99 раз.
chess писал(а):
Все проще. Вот пример:

Только он несколько надуман. И в конце кода не хватает DROP. Реальные операции с массивами редко содержат вот такие цепочки действий.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Возможность работать с многомерными массивами
СообщениеДобавлено: Пт авг 13, 2010 16:27 
Не в сети
Аватара пользователя

Зарегистрирован: Чт июл 20, 2006 11:31
Сообщения: 2105
Откуда: Екб
Благодарил (а): 0 раз.
Поблагодарили: 34 раз.
Ввел динамические многомерные массивы(безымянные).
Реализация стат. массивов изменена для совместимости с ними.

Код:
\ многомерные массивы(одномерные - частный случай многомерных при 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


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Возможность работать с многомерными массивами
СообщениеДобавлено: Пн авг 23, 2010 20:30 
Не в сети
Аватара пользователя

Зарегистрирован: Чт июл 20, 2006 11:31
Сообщения: 2105
Откуда: Екб
Благодарил (а): 0 раз.
Поблагодарили: 34 раз.
Убрал ошибки и ускорил код для работы с массивами( http://chess2007.nm.ru/arrays.f )

_________________
С уважением, chess


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Возможность работать с многомерными массивами
СообщениеДобавлено: Вт авг 24, 2010 21:06 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 13:19
Сообщения: 3565
Откуда: St.Petersburg
Благодарил (а): 4 раз.
Поблагодарили: 72 раз.
Можно записывать в классику "кодинга ради кодинга".

p.s. "я крокодил, крокожу и буду крокодить!" (c)...

_________________
С уважением, WingLion
Forth-CPU . RuF09WE
Мой Форт
Отсутствие бана это не заслуга юзера, а недоработка модератора (с)


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Возможность работать с многомерными массивами
СообщениеДобавлено: Вт авг 24, 2010 22:24 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
Цитата:
p.s. "я крокодил, крокожу и буду крокодить!" (c)...

а чья цитата?


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Возможность работать с многомерными массивами
СообщениеДобавлено: Вт авг 24, 2010 22:48 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 13:19
Сообщения: 3565
Откуда: St.Petersburg
Благодарил (а): 4 раз.
Поблагодарили: 72 раз.
вопрос писал(а):
а чья цитата?

Подозреваю, что Л.П.Берия.

_________________
С уважением, WingLion
Forth-CPU . RuF09WE
Мой Форт
Отсутствие бана это не заслуга юзера, а недоработка модератора (с)


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Возможность работать с многомерными массивами
СообщениеДобавлено: Вс сен 05, 2010 08:00 
Не в сети
Аватара пользователя

Зарегистрирован: Чт июл 20, 2006 11:31
Сообщения: 2105
Откуда: Екб
Благодарил (а): 0 раз.
Поблагодарили: 34 раз.
Добавил матрицы
Код:
\ многомерные массивы(одномерные - частный случай многомерных при 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 по всем элементам этого массива и удалить этот массив.

_________________
С уважением, chess


Последний раз редактировалось chess Пн сен 06, 2010 09:31, всего редактировалось 1 раз.

Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Возможность работать с многомерными массивами
СообщениеДобавлено: Вс сен 05, 2010 08:47 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 13:19
Сообщения: 3565
Откуда: St.Petersburg
Благодарил (а): 4 раз.
Поблагодарили: 72 раз.
А где умножение матрицы на вектор?

_________________
С уважением, WingLion
Forth-CPU . RuF09WE
Мой Форт
Отсутствие бана это не заслуга юзера, а недоработка модератора (с)


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Возможность работать с многомерными массивами
СообщениеДобавлено: Вс сен 05, 2010 14:02 
Не в сети
Аватара пользователя

Зарегистрирован: Чт июл 20, 2006 11:31
Сообщения: 2105
Откуда: Екб
Благодарил (а): 0 раз.
Поблагодарили: 34 раз.
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

_________________
С уважением, chess


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 39 ]  На страницу Пред.  1, 2, 3

Часовой пояс: UTC + 3 часа [ Летнее время ]


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 3


Вы не можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

cron
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
phpBB сборка от FladeX // Русская поддержка phpBB