ASTA@DULRUU51.BITNET (10/22/90)
Hello 48-Users,
This file contains some programs which handle with arrays and lists.
Short decsription:
------------------
A<-->L array to list and reverse
This program converts an array to the corresponding list and
viceversa, eg:
[[ 1 2 ] {{ 1 2 }
[ 3 4 ] <--> { 3 4 }
[ 5 6 ] { 5 6 }}
[ 3.5 -8 ] <--> { 3.5 -8 }
The format of the list must of course "looks" like an array, say
a list of list of numbers, each sublist with the same length.
trn Transponse
A generic transpose function for matrices and lists. The list must have
the format of a n*m-matrix, but is allowed to contain any object.
{{ 'foo' 'bar' 1.234 } {{ 'foo' << swap >> }
{ << swap >> { } "!" }} <--> { { } 'bar' }
{ "!" 1.234 }}
MOP Matrix Operation
Revised 'MOP' (Matrix OPeration): A program, which executes any
algebraic operation or program on every element of an 1 or 2
dimensional array.
usage:
======
2: <array>
1: <algebraic function> or <program>
MOP
2: <name of array>
1: <algebraic function> or <program>
MOP
e.g.:
=====
2: [[ 1 2.3 ]
[ -3 4.4 ]
[ 1 -1.1 ]]
1: 'LOG(SQR(X))-3'
MOP
2: [[ 1 2.3 ]
[ -3 4.4 ]
[ 1 -1.1 ]]
1: << IF X 1 < THEN X DUP R->C ELSE X END >>
MOP
2: '&DAT'
1: 'INV(X)'
MOP
2: '&DAT'
1: << X INV >>
MOP
The algebraic operation must have 'x' as argument. I know, this
sucks, but calling by reference like 'MOP(INV(<array>)*3-2)' is
not possible (or does anybody know a way ??)
& := the Sigma-sign
The name 'MOP' was created by Schrulli B. thanx ;-)
V<-->M vector to matrix and reverse
Converts a vector to a matrix and viceversa.
[ -9 2.3 4 ] <---> [[ -9 2.3 4 ]]
M->V matrix to vectors
Another "OBJ->" command. It puts all vectors of a matrix to the stack:
[[ 1 2.3 ] [ 1 2.3 ]
[ -3 4.4 ] ---> [ -3 4.4 ]
[ 1 -1.1 ]] [ 1 -1.1 ]
3
V->M vectors to matrix
The corresponding function to M->V It takes n vectors from the stack
and builds one matrix.
[ 1 2.3 ] [[ 1 2.3 ]
[ -3 4.4 ] ---> [ -3 4.4 ]
[ 1 -1.1 ] [ 1 -1.1 ]]
3
GETR get a row from a matrix
[[ 1 2.3 ]
[ -3 4.4 ] ---> [ 1 2.3 ]
[ 1 -1.1 ]]
1
GETC get a column from a matrix
[[ 1 2.3 ] [[ 1 ]
[ -3 4.4 ] ---> [ -3 ]
[ 1 -1.1 ]] [ 1 ]]
1
DELR delete a row from a matrix
[[ 1 2.3 ]
[ -3 4.4 ] ---> [[ -3 4.4 ]
[ 1 -1.1 ]] [ 1 -1.1 ]]
1
DELC delete a collumn from a matrix
[[ 1 2.3 ] [[ 2.3 ]
[ -3 4.4 ] ---> [ 4.4 ]
[ 1 -1.1 ]] [ -1.1 ]]
1
PUTR put a row to a matrix
Inserts or overwrites a vector into a matrix as a row.
A positive row-number indicates inserting, a negative overwriting.
[[ 1 2.3 ] [[ 0 0 ]
[ -3 4.4 ] [ 1 2.3 ]
[ 1 -1.1 ]] ---> [ -3 4.4 ]
1 [ 1 -1.1 ]]
[ 0 0 ]
[[ 1 2.3 ] [[ 0 0 ]
[ -3 4.4 ] ---> [ -3 4.4 ]
[ 1 -1.1 ]] [ 1 -1.1 ]]
-1
[ 0 0 ]
PUTC put a column to a matrix
Inserts or overwrites a vector into a matrix as a column.
A positive column-number indicates inserting, a negative overwriting.
[[ 1 2.3 ] [[ 0 1 2.3 ]
[ -3 4.4 ] ---> [ 0 -3 4.4 ]
[ 1 -1.1 ]] [ 0 1 -1.1 ]]
1
[ 0 0 0 ]
[[ 1 2.3 ] [[ 0 0 ]
[ -3 4.4 ] ---> [ 0 4.4 ]
[ 1 -1.1 ]] [ 0 -1.1 ]]
-1
[ 0 0 0 ]
-----------------------------------------------------------------------------
| General Student Board | asta@rz.uni-ulm.de | asta@rz.uni-ulm.dbp.de |
| c/o Ulli Horlacher | asta@dulruu51.bitnet | 50184::asta (DECnet/BelWUe) |
| University of Ulm | ----------------------------------------------------|
| D-7900 Ulm, Germany | "Waiting for the prompt" -Marillion |
-----------------------------------------------------------------------------
%%HP: T(3)A(D)F(.);
DIR
DELC
\<< SWAP trn SWAP
DELR trn
\>>
DELR
\<< \-> a
\<< M\->V DUP a -
2 + ROLL DROP 1 -
V\->M
\>>
\>>
PUTC
\<< ROT trn ROT
ROT PUTR trn
\>>
PUTR
\<< \-> a v
\<< M\->V
IF a 0 <
THEN DUP a
+ 2 + ROLL DROP v
OVER a + 2 + ROLLD
ELSE v OVER
a - 3 + ROLLD 1 +
END V\->M
\>>
\>>
V\->M
\<< OVER SIZE 1
GET \-> n m
\<< 0 n 1 -
FOR i i m *
n i - + ROLL OBJ\->
DROP
NEXT n m 2
\->LIST \->ARRY
\>>
\>>
M\->V
\<< OBJ\-> OBJ\->
DROP \-> n m
\<< 1 n
FOR i m 1
\->LIST \->ARRY n i - m
* i + ROLLD
NEXT n
\>>
\>>
GETR
\<< \-> r
\<< M\->V DUP r -
2 + PICK \-> a
\<< DROPN a
\>>
\>>
\>>
GETC
\<< SWAP TRN SWAP
GETR trn
\>>
CST { A\<-\->L trn
MOP V\<-\->M V\->M M\->V
GETR GETC PUTR PUTC
DELR DELC }
A\<-\->L
\<<
IF DUP TYPE 5
==
THEN
IF DUP 1
GET TYPE 5 ==
THEN \-> a
\<< 1 a
SIZE
FOR i a
i GET OBJ\-> 1 \->LIST
\->ARRY
NEXT a
SIZE V\->M
\>>
ELSE OBJ\-> 1
\->LIST \->ARRY
END
ELSE
IF DUP SIZE
SIZE 2 ==
THEN M\->V {
} SWAP 1
FOR i i 1
+ ROLL OBJ\-> 1 GET
\->LIST 1 \->LIST + -1
STEP
ELSE OBJ\-> 1
GET \->LIST
END
END
\>>
trn
\<<
IF DUP TYPE 5
==
THEN
IF DUP 1
GET TYPE 5 \=/
THEN 1
\->LIST
END DUP
SIZE OVER 1 GET
SIZE \-> l n m
\<< 1 m
FOR i 1 n
FOR j l
j GET i GET
NEXT n
\->LIST
NEXT m
\->LIST
\>>
IF DUP SIZE
1 == OVER 1 GET
TYPE 5 == AND
THEN OBJ\->
DROP
END
ELSE
IF DUP SIZE
SIZE 1 ==
THEN V\<-\->M
END TRN
IF DUP SIZE
1 GET 1 ==
THEN V\<-\->M
END
END
\>>
MOP
\<< 1 CF DEPTH
\->LIST DUP \-> s
\<< LIST\-> DROP
\-> a o
\<< a DUP
IFERR RCL
1 SF SWAP DROP
THEN
END 1
OVER SIZE LIST\-> 1 -
IF
THEN *
END
IFERR
FOR i
IF 1
FS?
THEN
a
END i
OVER i GET 'X' STO
o EVAL
IFERR
PUT
THEN
ROT (1,0) * ROT ROT
PUT
END
NEXT
THEN
DROP2 'X' PURGE
IF 1
FS?
THEN
STO
ELSE
DROP
END
CLEAR s LIST\-> DROP
"MOP Error:
" ERRM
+ DOERR
ELSE
IF 1
FC?
THEN
SWAP
END
DROP
END 1 CF
'X' PURGE
\>>
\>>
\>>
V\<-\->M
\<<
IF DUP SIZE
SIZE 1 ==
THEN 1 V\->M
ELSE M\->V DROP
END
\>>
END