From: Ben Pfaff Date: Mon, 27 Sep 2021 05:35:44 +0000 (-0700) Subject: Implement the MATRIX command. X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?p=pspp;a=commitdiff_plain;h=ff7ae14592cbdbebc4e4322424db95663ea7e166 Implement the MATRIX command. --- diff --git a/NEWS b/NEWS index 811c4d9de2..aa3b8620ed 100644 --- a/NEWS +++ b/NEWS @@ -6,9 +6,8 @@ Please send PSPP bug reports to bug-gnu-pspp@gnu.org. Changes from 1.4.1 to 1.5.3: - * The DEFINE and MCONVERT commands are now implemented. - - * The MATRIX DATA command is now fully implemented. + * The DEFINE, MATRIX, MCONVERT, and MATRIX DATA commands are now + implemented. * An error in the displayed signficance of oneway anova contrasts tests has been corrected. diff --git a/doc/automake.mk b/doc/automake.mk index cb277a2e88..6d2e6ebcc6 100644 --- a/doc/automake.mk +++ b/doc/automake.mk @@ -121,6 +121,7 @@ FIGURE_SYNTAX = \ doc/pspp-figures/descriptives.sps \ doc/pspp-figures/flip.sps \ doc/pspp-figures/frequencies.sps \ + doc/pspp-figures/matrix-print.sps \ doc/pspp-figures/means.sps \ doc/pspp-figures/one-sample-t.sps \ doc/pspp-figures/independent-samples-t.sps \ diff --git a/doc/matrices.texi b/doc/matrices.texi index 85d38fa54b..58dea2f31b 100644 --- a/doc/matrices.texi +++ b/doc/matrices.texi @@ -607,3 +607,2083 @@ explicitly request removing the existing data. The @cmd{MCONVERT} command requires its input to be a matrix file. Use @cmd{MATRIX DATA} to convert text input into matrix file format. @xref{MATRIX DATA}, for details. + +@node MATRIX +@section MATRIX +@vindex MATRIX +@vindex END MATRIX + +@display +@t{MATRIX.} +@dots{}@i{matrix commands}@dots{} +@t{END MATRIX.} +@end display + +@noindent +The following basic matrix commands are supported: + +@display +@t{COMPUTE} @i{variable}[@t{(}@i{index}[@t{,}@i{index}]@t{)}]@t{=}@i{expression}@t{.} +@t{CALL} @i{procedure}@t{(}@i{argument}@t{,} @dots{}). +@t{PRINT} [@i{expression}] + [@t{/FORMAT}@t{=}@i{format}] + [@t{/TITLE}@t{=}@i{title}] + [@t{/SPACE}@t{=}@{@t{NEWPAGE} @math{|} @i{n}@}] + [@{@t{/RLABELS}@t{=}@i{string}@dots{} @math{|} @t{/RNAMES}@t{=}@i{expression}@}] + [@{@t{/CLABELS}@t{=}@i{string}@dots{} @math{|} @t{/CNAMES}@t{=}@i{expression}@}]@t{.} +@end display + +@noindent +The following matrix commands offer support for flow control: + +@display +@t{DO IF} @i{expression}@t{.} + @dots{}@i{matrix commands}@dots{} +[@t{ELSE IF} @i{expression}@t{.} + @dots{}@i{matrix commands}@dots{}]@dots{} +[@t{ELSE} + @dots{}@i{matrix commands}@dots{}] +@t{END IF}@t{.} + +@t{LOOP} [@i{var}@t{=}@i{first} @t{TO} @i{last} [@t{BY} @i{step}]] [@t{IF} @i{expression}]@t{.} + @dots{}@i{matrix commands}@dots{} +@t{END LOOP} [@t{IF} @i{expression}]@t{.} + +@t{BREAK}@t{.} +@end display + +@noindent +The following matrix commands support matrix input and output: + +@display +@t{READ} @i{variable}[@t{(}@i{index}[@t{,}@i{index}]@t{)}] + [@t{/FILE}@t{=}@i{file}] + @t{/FIELD}@t{=}@i{first} @t{TO} @i{last} [@t{BY} @i{width}] + [@t{/FORMAT}@t{=}@i{format}] + [@t{/SIZE}@t{=}@i{expression}] + [@t{/MODE}@t{=}@{@t{RECTANGULAR} @math{|} @t{SYMMETRIC}@}] + [@t{/REREAD}]@t{.} +@t{WRITE} @i{expression} + [@t{/OUTFILE}@t{=}@i{file}] + @t{/FIELD}@t{=}@i{first} @t{TO} @i{last} [@t{BY} @i{width}] + [@t{/MODE}@t{=}@{@t{RECTANGULAR} @math{|} @t{TRIANGULAR}@}] + [@t{/HOLD}] + [@t{/FORMAT}@t{=}@i{format}]@t{.} +@t{GET} @i{variable}[@t{(}@i{index}[@t{,}@i{index}]@t{)}] + [@t{/FILE}@t{=}@{@i{file} @math{|} @t{*}@}] + [@t{/VARIABLES}@t{=}@i{variable}@dots{}] + [@t{/NAMES}@t{=}@i{expression}] + [@t{/MISSING}@t{=}@{@t{ACCEPT} @math{|} @t{OMIT} @math{|} @i{number}@}] + [@t{/SYSMIS}@t{=}@{@t{OMIT} @math{|} @i{number}@}]@t{.} +@t{SAVE} @i{expression} + [@t{/OUTFILE}@t{=}@{@i{file} @math{|} @t{*}@}] + [@t{/VARIABLES}@t{=}@i{variable}@dots{}] + [@t{/NAMES}@t{=}@i{expression}] + [@t{/STRINGS}@t{=}@i{variable}@dots{}]@t{.} +@t{MGET} [@t{/FILE}@t{=}@i{file}] + [@t{/TYPE}@t{=}@{@t{COV} @math{|} @t{CORR} @math{|} @t{MEAN} @math{|} @t{STDDEV} @math{|} @t{N} @math{|} @t{COUNT}@}]@t{.} +@t{MSAVE} @i{expression} + @t{/TYPE}@t{=}@{@t{COV} @math{|} @t{CORR} @math{|} @t{MEAN} @math{|} @t{STDDEV} @math{|} @t{N} @math{|} @t{COUNT}@} + [@t{/OUTFILE}@t{=}@i{file}] + [@t{/VARIABLES}@t{=}@i{variable}@dots{}] + [@t{/SNAMES}@t{=}@i{variable}@dots{}] + [@t{/SPLIT}@t{=}@i{expression}] + [@t{/FNAMES}@t{=}@i{variable}@dots{}] + [@t{/FACTOR}@t{=}@i{expression}]@t{.} +@end display + +@noindent +The following matrix commands provide additional support: + +@display +@t{DISPLAY} [@{@t{DICTIONARY} @math{|} @t{STATUS}@}]@t{.} +@t{RELEASE} @i{variable}@dots{}@t{.} +@end display + +@code{MATRIX} and @code{END MATRIX} enclose a special @pspp{} +sub-language, called the matrix language. The matrix language does +not require an active dataset to be defined and only a few of the +matrix language commands work with any datasets that are defined. +Each instance of @code{MATRIX}@dots{}@code{END MATRIX} is a separate +program whose state is independent of any instance, so that variables +declared within a matrix program are forgotten at its end. + +The matrix language works with matrices, where a @dfn{matrix} is a +rectangular array of real numbers. An @math{@var{n}@times{}@var{m}} +matrix has @var{n} rows and @var{m} columns. Some special cases are +important: a @math{@var{n}@times{}1} matrix is a @dfn{column vector}, +a @math{1@times{}@var{n}} is a @dfn{row vector}, and a +@math{1@times{}1} matrix is a @dfn{scalar}. + +The matrix language also has limited support for matrices that contain +8-byte strings instead of numbers. Strings longer than 8 bytes are +truncated, and shorter strings are padded with spaces. String +matrices are mainly useful for labeling rows and columns when printing +numerical matrices with the @code{MATRIX PRINT} command. Arithmetic +operations on string matrices will not produce useful results. The +user should not mix strings and numbers within a matrix. + +The matrix language does not work with cases. A variable in the +matrix language represents a single matrix. + +The matrix language does not support missing values. + +@code{MATRIX} is a procedure, so it cannot be enclosed inside @code{DO +IF}, @code{LOOP}, etc. + +Macros may be used within a matrix program, and macros may expand to +include entire matrix programs. The @code{DEFINE} command may not +appear within a matrix program. @xref{DEFINE}, for more information +about macros. + +The following sections describe the details of the matrix language: +first, the syntax of matrix expressions, then each of the supported +commands. The @code{COMMENT} command (@pxref{COMMENT}) is also +supported. + +@node Matrix Expressions +@subsection Matrix Expressions + +Many matrix commands use expressions. A matrix expression may use the +following operators, listed in descending order of operator +precedence. Within a single level, operators associate from left to +right. + +@itemize @bullet +@item +Function call @t{()} and matrix construction @t{@{@}} + +@item +Indexing @t{()} + +@item +Unary @t{+} and @t{-} + +@item +Integer sequence @t{:} + +@item +Exponentiation @t{**} and @t{&**} + +@item +Multiplication @t{*} and @t{&*}, and division @t{/} and @t{&/} + +@item +Addition @t{+} and subtraction @t{-} + +@item +Relational @t{< <= = >= > <>} + +@item +Logical @t{NOT} + +@item +Logical @t{AND} + +@item +Logical @t{OR} and @t{XOR} +@end itemize + +@xref{Matrix Functions}, for the available matrix functions. The +remaining operators are described in more detail below. + +@cindex restricted expressions +Expressions appear in the matrix language in some contexts where there +would be ambiguity whether @samp{/} is an operator or a separator +between subcommands. In these contexts, only the operators with +higher precedence than @samp{/} are allowed outside parentheses. +Later sections call these @dfn{restricted expressions}. + +@node Matrix Construction Operator +@subsubsection Matrix Construction Operator @t{@{@}} + +Use the @t{@{}@t{@}} operator to construct matrices. Within +the curly braces, commas separate elements within a row and semicolons +separate rows. The following examples show a @math{2@times{}3} +matrix, a @math{1@times{}4} row vector, a @math{3@times{}1} column +vector, and a scalar. + +@multitable @columnfractions .4 .05 .4 +@item @t{@{1, 2, 3; 4, 5, 6@}} +@tab @result{} +@tab +@ifnottex +@t{[1 2 3] @* [4 5 6]} +@end ifnottex +@iftex +@math{\left(\matrix{1 & 2 & 3 \cr 4 & 5 & 6}\right)} +@end iftex +@ +@item @t{@{3.14, 6.28, 9.24, 12.57@}} +@tab @result{} +@tab +@ifnottex +[3.14 6.28 9.42 12.57] +@end ifnottex +@iftex +@math{(\matrix{3.14 & 6.28 & 9.42 & 12.57})} +@end iftex +@ +@item @t{@{1.41; 1.73; 2@}} +@tab @result{} +@tab +@ifnottex +@t{[1.41] @* [1.73] @* [2.00]} +@end ifnottex +@iftex +@math{(\matrix{1.41 & 1.73 & 2.00})} +@end iftex +@ +@item @t{@{5@}} +@tab @result{} +@tab 5 +@end multitable + +Curly braces are not limited to holding numeric literals. They can +contain calculations, and they can paste together matrices and vectors +in any way as long as the result is rectangular. For example, if +@samp{m} is matrix @code{@{1, 2; 3, 4@}}, @samp{r} is row vector +@code{@{5, 6@}}, and @samp{c} is column vector @code{@{7, 8@}}, then +curly braces can be used as follows: + +@multitable @columnfractions .4 .05 .4 +@item @t{@{m, c; r, 10@}} +@tab @result{} +@tab +@ifnottex +@t{[1 2 7] @* [3 4 8] @* [5 6 10]} +@end ifnottex +@iftex +@math{\left(\matrix{1 & 2 & 7 \cr 3 & 4 & 8 \cr 5 & 6 & 10}\right)} +@end iftex +@ +@item @t{@{c, 2 * c, T(r)@}} +@tab @result{} +@tab +@ifnottex +@t{[7 14 5] @* [8 16 6]} +@end ifnottex +@iftex +@math{\left(\matrix{7 & 14 & 5 \cr 8 & 16 & 6}\right)} +@end iftex +@end multitable + +The final example above uses the transposition function @code{T}. + +@node Matrix Sequence Operator +@subsubsection Integer Sequence Operator @samp{:} + +The syntax @code{@var{first}:@var{last}:@var{step}} yields a row +vector of consecutive integers from @var{first} to @var{last} counting +by @var{step}. The final @code{:@var{step}} is optional and +defaults to 1 when omitted. + +Each of @var{first}, @var{last}, and @var{step} must be a scalar and +should be an integer (any fractional part is discarded). Because +@samp{:} has a high precedence, operands other than numeric literals +must usually be parenthesized. + +When @var{step} is positive (or omitted) and @math{@var{end} < +@var{start}}, or if @var{step} is negative and @math{@var{end} > +@var{start}}, then the result is an empty matrix. If @var{step} is 0, +then @pspp{} reports an error. + +Here are some examples: + +@multitable @columnfractions .4 .05 .4 +@item @t{1:6} @tab @result{} @tab @t{@{1, 2, 3, 4, 5, 6@}} +@item @t{1:6:2} @tab @result{} @tab @t{@{1, 3, 5@}} +@item @t{-1:-5:-1} @tab @result{} @tab @t{@{-1, -2, -3, -4, -5@}} +@item @t{-1:-5} @tab @result{} @tab @t{@{@}} +@item @t{2:1:0} @tab @result{} @tab (error) +@end multitable + +@node Matrix Index Operator +@subsubsection Index Operator @code{()} + +The result of the submatrix or indexing operator, written +@code{@var{m}(@var{rindex}, @var{cindex})}, contains the rows of +@var{m} whose indexes are given in vector @var{rindex} and the columns +whose indexes are given in vector @var{cindex}. + +In the simplest case, if @var{rindex} and @var{cindex} are both +scalars, the result is also a scalar: + +@multitable @columnfractions .4 .05 .4 +@item @t{@{10, 20; 30, 40@}(1, 1)} @tab @result{} @tab @t{10} +@item @t{@{10, 20; 30, 40@}(1, 2)} @tab @result{} @tab @t{20} +@item @t{@{10, 20; 30, 40@}(2, 1)} @tab @result{} @tab @t{30} +@item @t{@{10, 20; 30, 40@}(2, 2)} @tab @result{} @tab @t{40} +@end multitable + +If the index arguments have multiple elements, then the result +includes multiple rows or columns: + +@multitable @columnfractions .4 .05 .4 +@item @t{@{10, 20; 30, 40@}(1:2, 1)} @tab @result{} @tab @t{@{10; 30@}} +@item @t{@{10, 20; 30, 40@}(2, 1:2)} @tab @result{} @tab @t{@{30, 40@}} +@item @t{@{10, 20; 30, 40@}(1:2, 1:2)} @tab @result{} @tab @t{@{10, 20; 30, 40@}} +@end multitable + +The special argument @samp{:} may stand in for all the rows or columns +in the matrix being indexed, like this: + +@multitable @columnfractions .4 .05 .4 +@item @t{@{10, 20; 30, 40@}(:, 1)} @tab @result{} @tab @t{@{10; 30@}} +@item @t{@{10, 20; 30, 40@}(2, :)} @tab @result{} @tab @t{@{30, 40@}} +@item @t{@{10, 20; 30, 40@}(:, :)} @tab @result{} @tab @t{@{10, 20; 30, 40@}} +@end multitable + +The index arguments do not have to be in order, and they may contain +repeated values, like this: + +@multitable @columnfractions .4 .05 .4 +@item @t{@{10, 20; 30, 40@}(@{2, 1@}, 1)} @tab @result{} @tab @t{@{30; 10@}} +@item @t{@{10, 20; 30, 40@}(2, @{2; 2; 1@})} @tab @result{} @tab @t{@{40, 40, 30@}} +@item @t{@{10, 20; 30, 40@}(2:1:-1, :)} @tab @result{} @tab @t{@{30, 40; 10, 20@}} +@end multitable + +When the matrix being indexed is a row or column vector, only a single +index argument is needed, like this: + +@multitable @columnfractions .4 .05 .4 +@item @t{@{11, 12, 13, 14, 15@}(2:4)} @tab @result{} @tab @t{@{12, 13, 14@}} +@item @t{@{11; 12; 13; 14; 15@}(2:4)} @tab @result{} @tab @t{@{12; 13; 14@}} +@end multitable + +When an index is not an integer, @pspp{} discards the fractional part. +It is an error for an index to be less than 1 or greater than the +number of rows or columns: + +@multitable @columnfractions .4 .05 .4 +@item @t{@{11, 12, 13, 14@}(@{2.5, 4.6@})} @tab @result{} @tab @t{@{12, 14@}} +@item @t{@{11; 12; 13; 14@}(0)} @tab @result{} @tab (error) +@end multitable + +@node Matrix Unary Operators +@subsubsection Unary Operators + +The unary operators take a single operand of any dimensions and +operate on each of its elements independently. The unary operators +are: + +@table @code +@item - +Inverts the sign of each element. + +@item + +No change. + +@item NOT +Logical inversion: each positive value becomes 0 and each zero or +negative value becomes 1. +@end table + +Examples: + +@multitable @columnfractions .4 .05 .4 +@item @t{-@{1, -2; 3, -4@}} @tab @result{} @tab @t{@{-1, 2; -3, 4@}} +@item @t{+@{1, -2; 3, -4@}} @tab @result{} @tab @t{@{1, -2; 3, -4@}} +@item @t{NOT @{1, 0; -1, 1@}} @tab @result{} @tab @t{@{0, 1; 1, 0@}} +@end multitable + +@node Matrix Elementwise Binary Operators +@subsubsection Elementwise Binary Operators + +The elementwise binary operators require their operands to be matrices +with the same dimensions. Alternatively, if one operand is a scalar, +then its value is treated as if it were duplicated to the dimensions +of the other operand. The result is a matrix of the same size as the +operands, in which each element is the result of the applying the +operator to the corresponding elements of the operands. + +The elementwise binary operators are listed below. + +@itemize @bullet +@item +The arithmetic operators, for familiar arithmetic operations: + +@table @asis +@item @code{+} +Addition. + +@item @code{-} +Subtraction. + +@item @code{*} +Multiplication, if one operand is a scalar. (Otherwise this is matrix +multiplication, described below.) + +@item @code{/} or @code{&/} +Division. + +@item @code{&*} +Multiplication. + +@item @code{&**} +Exponentiation. +@end table + +@item +The relational operators, whose results are 1 when a comparison is +true and 0 when it is false: + +@table @asis +@item @code{<} or @code{LT} +Less than. + +@item @code{<=} or @code{LE} +Less than or equal. + +@item @code{=} or @code{EQ} +Equal. + +@item @code{>} or @code{GT} +Greater than. + +@item @code{>=} or @code{GE} +Greater than or equal. + +@item @code{<>} or @code{~=} or @code{NE} +Not equal. +@end table + +@item +The logical operators, which treat positive operands as true and +nonpositive operands as false. They yield 0 for false and 1 for true: + +@table @code +@item AND +True if both operands are true. + +@item OR +True if at least one operand is true. + +@item XOR +True if exactly one operand is true. +@end table +@end itemize + +Examples: + +@multitable @columnfractions .4 .05 .4 +@item @t{1 + 2} @tab @result{} @tab @t{3} +@item @t{1 + @{3; 4@}} @tab @result{} @tab @t{@{4; 5@}} +@item @t{@{66, 77; 88, 99@} + 5} @tab @result{} @tab @t{@{71, 82; 93, 104@}} +@item @t{@{4, 8; 3, 7@} + @{1, 0; 5, 2@}} @tab @result{} @tab @t{@{5, 8; 8, 9@}} +@item @t{@{1, 2; 3, 4@} < @{4, 3; 2, 1@}} @tab @result{} @tab @t{@{1, 1; 0, 0@}} +@item @t{@{1, 3; 2, 4@} >= 3} @tab @result{} @tab @t{@{0, 1; 0, 1@}} +@item @t{@{0, 0; 1, 1@} AND @{0, 1; 0, 1@}} @tab @result{} @tab @t{@{0, 0; 0, 1@}} +@end multitable + +@node Matrix Multiplication Operator +@subsubsection Matrix Multiplication Operator @samp{*} + +If @code{A} is an @math{@var{m}@times{}@var{n}} matrix and @code{B} is +an @math{@var{n}@times{}@var{p}} matrix, then @code{A*B} is the +@math{@var{m}@times{}@var{p}} matrix multiplication product @code{C}. +@pspp{} reports an error if the number of columns in @code{A} differs +from the number of rows in @code{B}. + +The @code{*} operator performs elementwise multiplication (see above) +if one of its operands is a scalar. + +No built-in operator yields the inverse of matrix multiplication. +Instead, multiply by the result of @code{INV} or @code{GINV}. + +Some examples: + +@multitable @columnfractions .4 .05 .4 +@item @t{@{1, 2, 3@} * @{4; 5; 6@}} @tab @result{} @tab @t{32} +@item @t{@{4; 5; 6@} * @{1, 2, 3@}} @tab @result{} @tab @t{@{4,@w{ } 8, 12; @*@w{ }5, 10, 15; @*@w{ }6, 12, 18@}} +@end multitable + +@node Matrix Exponentiation Operator +@subsubsection Matrix Exponentiation Operator @code{**} + +The result of @code{A**B} is defined as follows when @code{A} is a +square matrix and @code{B} is an integer scalar: + +@itemize @bullet +@item +For @code{B > 0}, @code{A**B} is @code{A*@dots{}*A}, where there are +@code{B} @samp{A}s. (@pspp{} implements this efficiently for large +@code{B}, using exponentiation by squaring.) + +@item +For @code{B < 0}, @code{A**B} is @code{INV(A**(-B))}. + +@item +For @code{B = 0}, @code{A**B} is the identity matrix. +@end itemize + +@noindent +@pspp{} reports an error if @code{A} is not square or @code{B} is not +an integer. + +Examples: + +@multitable @columnfractions .4 .05 .4 +@item @t{@{2, 5; 1, 4@}**3} @tab @result{} @tab @t{@{48, 165; 33, 114@}} +@item @t{@{2, 5; 1, 4@}**0} @tab @result{} @tab @t{@{1, 0; 0, 1@}} +@item @t{10*@{4, 7; 2, 6@}**-1} @tab @result{} @tab @t{@{6, -7; -2, 4@}} +@end multitable + +@node Matrix Functions +@subsection Matrix Functions + +The matrix language support numerous functions in multiple categories. +The following subsections document each of the currently supported +functions. The first letter of each parameter's name indicate the +required argument type: + +@table @var +@item s +A scalar. + +@item n +A nonnegative integer scalar. (Non-integers are accepted and silently +rounded down to the nearest integer.) + +@item V +A row or column vector. + +@item M +A matrix. +@end table + +@node Matrix Elementwise Functions +@subsubsection Elementwise Functions + +These functions act on each element of their argument independently, +like the elementwise operators (@pxref{Matrix Elementwise Binary +Operators}). + +@deffn {Matrix Function} ABS (@var{M}) +Takes the absolute value of each element of @var{M}. + +@t{ABS(@{-1, 2; -3, 0@}) @result{} @{1, 2; 3, 0@}} +@end deffn + +@deffn {Matrix Function} ARSIN (@var{M}) +@deffnx {Matrix Function} ARTAN (@var{M}) +Computes the inverse sine or tangent, respectively, of each element in +@var{M}. The results are in radians, between @math{-\pi/2} and +@math{+\pi/2}, inclusive. + +The value of @math{\pi} can be computed as @code{4*ARTAN(1)}. + +@t{ARSIN(@{-1, 0, 1@}) @result{} @{-1.57, 0, 1.57@}} (approximately) + +@t{ARTAN(@{-5, -1, 1, 5@}) @result{} @{-1.37, -.79, .79, 1.37@}} (approximately) +@end deffn + +@deffn {Matrix Function} COS (@var{M}) +@deffnx {Matrix Function} SIN (@var{M}) +Computes the cosine or sine, respectively, of each element in @var{M}, +which must be in radians. + +@t{COS(@{0.785, 1.57; 3.14, 1.57 + 3.14@}) @result{} @{.71, 0; -1, 0@}} (approximately) +@end deffn + +@deffn {Matrix Function} EXP (@var{M}) +Computes @math{e^x} for each element @var{x} in @var{M}. + +@t{EXP(@{2, 3; 4, 5@}) @result{} @{7.39, 20.09; 54.6, 148.4@}} (approximately) +@end deffn + +@deffn {Matrix Function} LG10 (@var{M}) +@deffnx {Matrix Function} LN (@var{M}) +Takes the logarithm with base 10 or base @math{e}, respectively, of +each element in @var{M}. + +@t{LG10(@{1, 10, 100, 1000@}) @result{} @{0, 1, 2, 3@}} @* +@t{LG10(0) @result{}} (error) + +@t{LN(@{EXP(1), 1, 2, 3, 4@}) @result{} @{1, 0, .69, 1.1, 1.39@}} (approximately) @* +@t{LN(0) @result{}} (error) +@end deffn + +@deffn {Matrix Function} MOD (@var{M}, @var{s}) +Takes each element in @var{M} modulo nonzero scalar value @var{s}, +that is, the remainder of division by @var{s}. The sign of the result +is the same as the sign of the dividend. + +@t{MOD(@{5, 4, 3, 2, 1, 0@}, 3) @result{} @{2, 1, 0, 2, 1, 0@}} @* +@t{MOD(@{5, 4, 3, 2, 1, 0@}, -3) @result{} @{2, 1, 0, 2, 1, 0@}} @* +@t{MOD(@{-5, -4, -3, -2, -1, 0@}, 3) @result{} @{-2, -1, 0, -2, -1, 0@}} @* +@t{MOD(@{-5, -4, -3, -2, -1, 0@}, -3) @result{} @{-2, -1, 0, -2, -1, 0@}} @* +@t{MOD(@{5, 4, 3, 2, 1, 0@}, 1.5) @result{} @{.5, 1.0, .0, .5, 1.0, .0@}} @* +@t{MOD(@{5, 4, 3, 2, 1, 0@}, 0) @result{}} (error) +@end deffn + +@deffn {Matrix Function} RND (@var{M}) +@deffnx {Matrix Function} TRUNC (@var{M}) +Rounds each element of @var{M} to an integer. @code{RND} rounds to +the nearest integer, with halves rounded to even integers, and +@code{TRUNC} rounds toward zero. + +@t{RND(@{-1.6, -1.5, -1.4@}) @result{} @{-2, -2, -1@}} @* +@t{RND(@{-.6, -.5, -.4@}) @result{} @{-1, 0, 0@}} @* +@t{RND(@{.4, .5, .6@} @result{} @{0, 0, 1@}} @* +@t{RND(@{1.4, 1.5, 1.6@}) @result{} @{1, 2, 2@}} + +@t{TRUNC(@{-1.6, -1.5, -1.4@}) @result{} @{-1, -1, -1@}} @* +@t{TRUNC(@{-.6, -.5, -.4@}) @result{} @{0, 0, 0@}} @* +@t{TRUNC(@{.4, .5, .6@} @result{} @{0, 0, 0@}} @* +@t{TRUNC(@{1.4, 1.5, 1.6@}) @result{} @{1, 1, 1@}} +@end deffn + +@deffn {Matrix Function} SQRT (@var{M}) +Takes the square root of each element of @var{M}, which must not be +negative. + +@t{SQRT(@{0, 1, 2, 4, 9, 81@}) @result{} @{0, 1, 1.41, 2, 3, 9@}} (approximately) @* +@t{SQRT(-1) @result{}} (error) +@end deffn + +@node Matrix Logical Functions +@subsubsection Logical Functions + +@deffn {Matrix Function} ALL (@var{M}) +Returns a scalar with value 1 if all of the elements in @var{M} are +nonzero, or 0 if at least one element is zero. + +@t{ALL(@{1, 2, 3@} < @{2, 3, 4@}) @result{} 1} @* +@t{ALL(@{2, 2, 3@} < @{2, 3, 4@}) @result{} 0} @* +@t{ALL(@{2, 3, 3@} < @{2, 3, 4@}) @result{} 0} @* +@t{ALL(@{2, 3, 4@} < @{2, 3, 4@}) @result{} 0} +@end deffn + +@deffn {Matrix Function} ANY (@var{M}) +Returns a scalar with value 1 if any of the elements in @var{M} is +nonzero, or 0 if all of them are zero. + +@t{ANY(@{1, 2, 3@} < @{2, 3, 4@}) @result{} 1} @* +@t{ANY(@{2, 2, 3@} < @{2, 3, 4@}) @result{} 1} @* +@t{ANY(@{2, 3, 3@} < @{2, 3, 4@}) @result{} 1} @* +@t{ANY(@{2, 3, 4@} < @{2, 3, 4@}) @result{} 0} +@end deffn + +@node Matrix Construction Functions +@subsubsection Matrix Construction Functions + +@deffn {Matrix Function} BLOCK (@var{M1}, @dots{}, @var{Mn}) +Returns a block diagonal matrix with as many rows as the sum of its +arguments' row counts and as many columns as the sum of their columns. +Each argument matrix is placed along the main diagonal of the result, +and all other elements are zero. + +@format +@t{BLOCK(@{1, 2; 3, 4@}, 5, @{7; 8; 9@}, @{10, 11@}) @result{} + 1 2 0 0 0 0 + 3 4 0 0 0 0 + 0 0 5 0 0 0 + 0 0 0 7 0 0 + 0 0 0 8 0 0 + 0 0 0 9 0 0 + 0 0 0 0 10 11} +@end format +@end deffn + +@deffn {Matrix Function} IDENT (@var{n}) +@deffnx {Matrix Function} IDENT (@var{nr}, @var{nc}) +Returns an identity matrix, whose main diagonal elements are one and +whose other elements are zero. The returned matrix has @var{n} rows +and columns or @var{nr} rows and @var{nc} columns, respectively. + +@format +@t{IDENT(1) @result{} 1 +IDENT(2) @result{} + 1 0 + 0 1 +IDENT(3, 5) @result{} + 1 0 0 0 0 + 0 1 0 0 0 + 0 0 1 0 0 +IDENT(5, 3) @result{} + 1 0 0 + 0 1 0 + 0 0 1 + 0 0 0 + 0 0 0} +@end format +@end deffn + +@deffn {Matrix Function} MAGIC (@var{n}) +Returns an @math{@var{n}@times{}@var{n}} matrix that contains each of +the integers @math{1@dots{}@var{n}} once, in which each column, each +row, and each diagonal sums to @math{n(n^2+1)/2}. There are many +magic squares with given dimensions, but this function always returns +the same one for a given value of @var{n}. + +@t{MAGIC(3) @result{} @{8, 1, 6; 3, 5, 7; 4, 9, 2@}} @* +@t{MAGIC(4) @result{} @{1, 5, 12, 16; 15, 11, 6, 2; 14, 8, 9, 3; 4, 10, 7, 13@}} +@end deffn + +@deffn {Matrix Function} MAKE (@var{nr}, @var{nc}, @var{s}) +Returns an @math{@var{nr}@times{}@var{nc}} matrix whose elements are +all @var{s}. + +@t{MAKE(1, 2, 3) @result{} @{3, 3@}} @* +@t{MAKE(2, 1, 4) @result{} @{4; 4@}} @* +@t{MAKE(2, 3, 5) @result{} @{5, 5, 5; 5, 5, 5@}} +@end deffn + +@deffn {Matrix Function} MDIAG (@var{V}) +@anchor{MDIAG} Given @var{n}-element vector @var{V}, returns a +@math{@var{n}@times{}@var{n}} matrix whose main diagonal is copied +from @var{V}. The other elements in the returned vector are zero. + +Use @code{CALL SETDIAG} (@pxref{CALL SETDIAG}) to replace the main +diagonal of a matrix in-place. + +@format +@t{MDIAG(@{1, 2, 3, 4@}) @result{} + 1 0 0 0 + 0 2 0 0 + 0 0 3 0 + 0 0 0 4} +@end format +@end deffn + +@deffn {Matrix Function} RESHAPE (@var{M}, @var{nr}, @var{nc}) +Returns an @math{@var{nr}@times{}@var{nc}} matrix whose elements come +from @var{M}, which must have the same number of elements as the new +matrix, copying elements from @var{M} to the new matrix row by row. + +@format +@t{RESHAPE(1:12, 1, 12) @result{} + 1 2 3 4 5 6 7 8 9 10 11 12 +RESHAPE(1:12, 2, 6) @result{} + 1 2 3 4 5 6 + 7 8 9 10 11 12 +RESHAPE(1:12, 3, 4) @result{} + 1 2 3 4 + 5 6 7 8 + 9 10 11 12 +RESHAPE(1:12, 4, 3) @result{} + 1 2 3 + 4 5 6 + 7 8 9 + 10 11 12} +@end format +@end deffn + +@deffn {Matrix Function} T (@var{M}) +@deffnx {Matrix Function} TRANSPOS (@var{M}) +Returns @var{M} with rows exchanged for columns. + +@t{T(@{1, 2, 3@}) @result{} @{1; 2; 3@}} @* +@t{T(@{1; 2; 3@}) @result{} @{1, 2, 3@}} +@end deffn + +@deffn {Matrix Function} UNIFORM (@var{nr}, @var{nc}) +Returns a @math{@var{nr}@times{}@var{nc}} matrix in which each element +is randomly chosen from a uniform distribution of real numbers between +0 and 1. Random number generation honors the current seed setting +(@pxref{SET SEED}). + +The following example shows one possible output, but of course every +result will be different (given different seeds): + +@format +@t{UNIFORM(4, 5)*10 @result{} + 7.71 2.99 .21 4.95 6.34 + 4.43 7.49 8.32 4.99 5.83 + 2.25 .25 1.98 7.09 7.61 + 2.66 1.69 2.64 .88 1.50} +@end format +@end deffn + +@node Matrix Minimum and Maximum and Sum Functions +@subsubsection Minimum, Maximum, and Sum Functions + +@deffn {Matrix Function} CMIN (@var{M}) +@deffnx {Matrix Function} CMAX (@var{M}) +@deffnx {Matrix Function} CSUM (@var{M}) +@deffnx {Matrix Function} CSSQ (@var{M}) +Returns a row vector with the same number of columns as @var{M}, in +which each element is the minimum, maximum, sum, or sum of squares, +respectively, of the elements in the same column of @var{M}. + +@t{CMIN(@{1, 2, 3; 4, 5, 6; 7, 8, 9@} @result{} @{1, 2, 3@}} @* +@t{CMAX(@{1, 2, 3; 4, 5, 6; 7, 8, 9@} @result{} @{7, 8, 9@}} @* +@t{CSUM(@{1, 2, 3; 4, 5, 6; 7, 8, 9@} @result{} @{12, 15, 18@}} @* +@t{CSSQ(@{1, 2, 3; 4, 5, 6; 7, 8, 9@} @result{} @{66, 93, 126@}} +@end deffn + +@deffn {Matrix Function} MMIN (@var{M}) +@deffnx {Matrix Function} MMAX (@var{M}) +@deffnx {Matrix Function} MSUM (@var{M}) +@deffnx {Matrix Function} MSSQ (@var{M}) +Returns the minimum, maximum, sum, or sum of squares, respectively, of +the elements of @var{M}. + +@t{MMIN(@{1, 2, 3; 4, 5, 6; 7, 8, 9@} @result{} 1} @* +@t{MMAX(@{1, 2, 3; 4, 5, 6; 7, 8, 9@} @result{} 9} @* +@t{MSUM(@{1, 2, 3; 4, 5, 6; 7, 8, 9@} @result{} 45} @* +@t{MSSQ(@{1, 2, 3; 4, 5, 6; 7, 8, 9@} @result{} 285} +@end deffn + +@deffn {Matrix Function} RMIN (@var{M}) +@deffnx {Matrix Function} RMAX (@var{M}) +@deffnx {Matrix Function} RSUM (@var{M}) +@deffnx {Matrix Function} RSSQ (@var{M}) +Returns a column vector with the same number of rows as @var{M}, in +which each element is the minimum, maximum, sum, or sum of squares, +respectively, of the elements in the same row of @var{M}. + +@t{RMIN(@{1, 2, 3; 4, 5, 6; 7, 8, 9@} @result{} @{1; 4; 7@}} @* +@t{RMAX(@{1, 2, 3; 4, 5, 6; 7, 8, 9@} @result{} @{3; 6; 9@}} @* +@t{RSUM(@{1, 2, 3; 4, 5, 6; 7, 8, 9@} @result{} @{6; 15; 24@}} @* +@t{RSSQ(@{1, 2, 3; 4, 5, 6; 7, 8, 9@} @result{} @{14; 77; 194@}} +@end deffn + +@deffn {Matrix Function} SSCP (@var{M}) +Returns @math{@var{M}^T @times{} @var{M}}. + +@t{SSCP(@{1, 2, 3; 4, 5, 6@}) @result{} @{17, 22, 27; 22, 29, 36; 27, 36, 45@}} +@end deffn + +@deffn {Matrix Function} TRACE (@var{M}) +Returns the sum of the elements along @var{M}'s main diagonal, +equivalent to @code{MSUM(DIAG(@var{M}))}. + +@t{TRACE(MDIAG(1:5)) @result{} 15} +@end deffn + +@node Matrix Property Functions +@subsubsection Matrix Property Functions + +@deffn {Matrix Function} NROW (@var{M}) +@deffnx {Matrix Function} NCOL (@var{M}) +Returns the number of row or columns, respectively, in @var{M}. + +@format +@t{NROW(@{1, 0; -2, -3; 3, 3@}) @result{} 3 +NROW(1:5) @result{} 1 + +NCOL(@{1, 0; -2, -3; 3, 3@}) @result{} 2 +NCOL(1:5) @result{} 5} +@end format +@end deffn + +@deffn {Matrix Function} DIAG (@var{M}) +Returns a column vector containing a copy of @var{M}'s main diagonal. +The vector's length is the lesser of @code{NCOL(@var{M})} and +@code{NROW(@var{M})}. + +@t{DIAG(@{1, 0; -2, -3; 3, 3@}) @result{} @{1; -3@}} +@end deffn + +@node Matrix Rank Ordering Functions +@subsubsection Matrix Rank Ordering Functions + +The @code{GRADE} and @code{RANK} functions each take a matrix @var{M} +and return a matrix @var{r} with the same dimensions. Each element in +@var{r} ranges between 1 and the number of elements @var{n} in +@var{M}, inclusive. When the elements in @var{M} all have unique +values, both of these functions yield the same results: the smallest +element in @var{M} corresponds to value 1 in @var{r}, the next +smallest to 2, and so on, up to the largest to @var{n}. When multiple +elements in @var{M} have the same value, these functions use different +rules for handling the ties. + +@deffn {Matrix Function} GRADE (@var{M}) +Returns a ranking of @var{M}, turning duplicate values into sequential +ranks. The returned matrix always contains each of the integers 1 +through the number of elements in the matrix exactly once. + +@t{GRADE(@{1, 0, 3; 3, 1, 2; 3, 0, 5@})} @result{} @t{@{3, 1, 6; 7, 4, 5; 8, 2, 9@}} +@end deffn + +@deffn {Matrix Function} RNKORDER (@var{M}) +Returns a ranking of @var{M}, turning duplicate values into the mean +of their sequential ranks. + +@t{RNKORDER(@{1, 0, 3; 3, 1, 2; 3, 0, 5@})} @*@w{ }@result{} @t{@{3.5, 1.5, 7; 7, 3.5, 5; 7, 1.5, 9@}} +@end deffn + +@noindent +One may use @code{GRADE} to sort a vector: + +@example +COMPUTE v(GRADE(v))=v. /* Sort v in ascending order. +COMPUTE v(GRADE(-v))=v. /* Sort v in descending order. +@end example + +@node Matrix Algebra Functions +@subsubsection Matrix Algebra Functions + +@deffn {Matrix Function} CHOL (@var{M}) +Matrix @var{M} must be an @math{@var{n}@times{}@var{n}} symmetric +positive-definite matrix. Returns an @math{@var{n}@times{}@var{n}} +matrix @var{B} such that @math{@var{B}^T@times{}@var{B}=@var{M}}. + +@format +@t{CHOL(@{4, 12, -16; 12, 37, -43; -16, -43, 98@}) @result{} + 2 6 -8 + 0 1 5 + 0 0 3} +@end format +@end deffn + +@deffn {Matrix Function} DESIGN (@var{M}) +Returns a design matrix for @var{M}. The design matrix has the same +number of rows as @var{M}. Each column @var{c} in @var{M}, from left +to right, yields a group of columns in the output. For each unique +value @var{v} in @var{c}, from top to bottom, add a column to the +output in which @var{v} becomes 1 and other values become 0. + +@pspp{} issues a warning if a column only contains a single unique value. + +@format +@t{DESIGN(@{1; 2; 3@}) @result{} @{1, 0, 0; 0, 1, 0; 0, 0, 1@}} +@t{DESIGN(@{5; 8; 5@}) @result{} @{1, 0; 0, 1; 1, 0@}} +@t{DESIGN(@{1, 5; 2, 8; 3, 5@})} + @result{} @t{@{1, 0, 0, 1, 0; 0, 1, 0, 0, 1; 0, 0, 1, 1, 0@}} +@t{DESIGN(@{5; 5; 5@})} @result{} (warning) +@end format +@end deffn + +@deffn {Matrix Function} DET (@var{M}) +Returns the determinant of square matrix @var{M}. + +@t{DET(@{3, 7; 1, -4@}) @result{} -19} +@end deffn + +@deffn {Matrix Function} EVAL (@var{M}) +@anchor{EVAL} +Returns a column vector containing the eigenvalues of symmetric matrix +@var{M}, sorted in ascending order. + +Use @code{CALL EIGEN} (@pxref{CALL EIGEN}) to compute eigenvalues and +eigenvectors of a matrix. + +@t{EVAL(@{2, 0, 0; 0, 3, 4; 0, 4, 9@}) @result{} @{11; 2; 1@}} +@end deffn + +@deffn {Matrix Function} GINV (@var{M}) +Returns the @math{@var{k}@times{}@var{n}} matrix @var{A} that is the +@dfn{generalized inverse} of @math{@var{n}@times{}@var{k}} matrix +@var{M}, defined such that +@math{@var{M}@times{}@var{A}@times{}@var{M}=@var{M}} and +@math{@var{A}@times{}@var{M}@times{}@var{A}=@var{A}}. + +@t{GINV(@{1, 2@}) @result{} @{.2; .4@}} (approximately) @* +@t{@{1:9@} * GINV(1:9) * @{1:9@} @result{} @{1:9@}} (approximately) +@end deffn + +@deffn {Matrix Function} GSCH (@var{M}) +@var{M} must be a @math{@var{n}@times{}@var{m}} matrix, @math{@var{m} +@geq{} @var{n}}, with rank @var{n}. Returns an +@math{@var{n}@times{}@var{n}} orthonormal basis for @var{M}, obtained +using the Gram-Schmidt process. + +@t{GSCH(@{3, 2; 1, 2@}) * SQRT(10) @result{} @{3, -1; 1, 3@}} (approximately) +@end deffn + +@deffn {Matrix Function} INV (@var{M}) +Returns the @math{@var{n}@times{}@var{n}} matrix @var{A} that is the +inverse of @math{@var{n}@times{}@var{n}} matrix @var{M}, defined such +that @math{@var{M}@times{}@var{A} = @var{A}@times{}@var{M} = I}, where +@var{I} is the identity matrix. @var{M} must not be singular, that +is, @math{\det(@var{M}) @ne{} 0}. + +@t{INV(@{4, 7; 2, 6@}) @result{} @{.6, -.7; -.2, .4@}} (approximately) +@end deffn + +@deffn {Matrix Function} KRONEKER (@var{Ma}, @var{Mb}) +Returns the @math{@var{pm}@times{}@var{qn}} matrix @var{P} that is the +@dfn{Kroneker product} of @math{@var{m}@times{}@var{n}} matrix +@var{Ma} and @math{@var{p}@times{}@var{q}} matrix @var{Mb}. One may +view @var{P} as the concatenation of multiple +@math{@var{p}@times{}@var{q}} blocks, each of which is the scalar +product of @var{Mb} by a different element of @var{Ma}. For example, +when @code{A} is a @math{2@times{}2} matrix, @code{KRONEKER(A, B)} is +equivalent to @code{@{A(1,1)*B, A(1,2)*B; A(2,1)*B, A(2,2)*B@}}. + +@format +@t{KRONEKER(@{1, 2; 3, 4@}, @{0, 5; 6, 7@}) @result{} + 0 5 0 10 + 6 7 12 14 + 0 15 0 20 + 18 21 24 28} +@end format +@end deffn + +@deffn {Matrix Function} RANK (@var{M}) +Returns the rank of matrix @var{M}, a integer scalar whose value is +the dimension of the vector space spanned by its columns or, +equivalently, by its rows. + +@format +@t{RANK(@{1, 0, 1; -2, -3, 1; 3, 3, 0@}) @result{} 2 +RANK(@{1, 1, 0, 2; -1, -1, 0, -2@}) @result{} 1 +RANK(@{1, -1; 1, -1; 0, 0; 2, -2@}) @result{} 1 +RANK(@{1, 2, 1; -2, -3, 1; 3, 5, 0@}) @result{} 2 +RANK(@{1, 0, 2; 2, 1, 0; 3, 2, 1@}) @result{} 3} +@end format +@end deffn + +@deffn {Matrix Function} SOLVE (@var{Ma}, @var{Mb}) +@var{Ma} must be an @math{@var{n}@times{}@var{n}} matrix, with +@math{\det(@var{Ma}) @ne{} 0}, and @var{Mb} an +@math{@var{n}@times{}@var{k}} matrix. Returns an +@math{@var{n}@times{}@var{k}} matrix @var{X} such that @math{@var{Ma} +@times{} @var{X} = @var{Mb}}. + +All of the following examples show approximate results: + +@format +@t{SOLVE(@{2, 3; 4, 9@}, @{6, 2; 15, 5@}) @result{} + 1.50 .50 + 1.00 .33 +SOLVE(@{1, 3, -2; 3, 5, 6; 2, 4, 3@}, @{5; 7; 8@}) @result{} + -15.00 + 8.00 + 2.00 +SOLVE(@{2, 1, -1; -3, -1, 2; -2, 1, 2@}, @{8; -11; -3@}) @result{} + 2.00 + 3.00 + -1.00} +@end format +@end deffn + +@deffn {Matrix Function} SVAL (@var{M}) +@anchor{SVAL} + +Given @math{@var{n}@times{}@var{k}} matrix @var{M}, returns a +@math{\min(@var{n},@var{k})}-element column vector containing the +singular values of @var{M} in descending order. + +Use @code{CALL SVD} (@pxref{CALL SVD}) to compute the full singular +value decomposition of a matrix. + +@format +@t{SVAL(@{1, 1; 0, 0@}) @result{} @{1.41; .00@} +SVAL(@{1, 0, 1; 0, 1, 1; 0, 0, 0@}) @result{} @{1.73; 1.00; .00@} +SVAL(@{2, 4; 1, 3; 0, 0; 0, 0@}) @result{} @{5.46; .37@}} +@end format +@end deffn + +@deffn {Matrix Function} SWEEP (@var{M}, @var{nk}) +Given @math{@var{r}@times{}@var{c}} matrix @var{M} and integer scalar +@math{k = @var{nk}} such that @math{1 @leq{} k @leq{} +\min(@var{r},@var{c})}, returns the @math{@var{r}@times{}@var{c}} +sweep matrix @var{A}. + +If @math{@var{M}_{kk} @ne{} 0}, then: + +@display +@math{@var{A}_{kk} = 1/@var{M}_{kk}}, +@math{@var{A}_{ik} = -@var{M}_{ik}/@var{M}_{kk} @r{for} i @ne{} k}, +@math{@var{A}_{kj} = @var{M}_{kj}/@var{M}_{kk} @r{for} j @ne{} k, @r{and}} +@math{@var{A}_{ij} = @var{M}_{ij} - @var{M}_{ik}@var{M}_{kj}/@var{M}_{kk} @r{for} i @ne{} k @r{and} j @ne{} k}. +@end display + +If @math{@var{M}_{kk} = 0}, then: + +@display +@math{@var{A}_{ik} = @var{A}_{ki} = 0 @r{and}} +@math{@var{A}_{ij} = @var{M}_{ij}, @r{for} i @ne{} k @r{and} j @ne{} k}. +@end display + +Given @t{M = @{0, 1, 2; 3, 4, 5; 6, 7, 8@}}, then (approximately): + +@format +@t{SWEEP(M, 1) @result{} + .00 .00 .00 + .00 4.00 5.00 + .00 7.00 8.00 +SWEEP(M, 2) @result{} + -.75 -.25 .75 + .75 .25 1.25 + .75 -1.75 -.75 +SWEEP(M, 3) @result{} + -1.50 -.75 -.25 + -.75 -.38 -.63 + .75 .88 .13} +@end format +@end deffn + +@node Matrix Statistical Distribution Functions +@subsubsection Matrix Statistical Distribution Functions + +The matrix language can calculate several functions of standard +statistical distributions using the same syntax and semantics as in +@pspp{} transformation expressions. @xref{Statistical Distribution +Functions}, for details. + +The matrix language extends the PDF, CDF, SIG, IDF, NPDF, and NCDF +functions by allowing the first parameters to each of these functions +to be a vector or matrix with any dimensions. In addition, +@code{CDF.BVNOR} and @code{PDF.BVNOR} allow either or both of their +first two parameters to be vectors or matrices; if both are non-scalar +then they must have the same dimensions. In each case, the result is +a matrix or vector with the same dimensions as the input populated +with elementwise calculations. + +@node Matrix EOF Function +@subsubsection EOF Function + +This function works with files being used on the @code{READ} statement. + +@deffn {Matrix Function} EOF (@var{file}) +@anchor{EOF Matrix Function} + +Given a file handle or file name @var{file}, returns an integer scalar +1 if the last line in the file has been read or 0 if more lines are +available. Determining this requires attempting to read another line, +which means that @code{REREAD} on the next @code{READ} command +following @code{EOF} on the same file will be ineffective. +@end deffn + +The @code{EOF} function gives a matrix program the flexibility to read +a file with text data without knowing the length of the file in +advance. For example, the following program will read all the lines +of data in @file{data.txt}, each consisting of three numbers, as rows +in matrix @code{data}: + +@verbatim +MATRIX. +COMPUTE data={}. +LOOP IF NOT EOF('data.txt'). + READ row/FILE='data.txt'/FIELD=1 TO 1000/SIZE={1,3}. + COMPUTE data={data; row}. +END LOOP. +PRINT data. +END MATRIX. + +@end verbatim + +@node Matrix COMPUTE Command +@subsection The @code{COMPUTE} Command + +@display +@t{COMPUTE} @i{variable}[@t{(}@i{index}[@t{,}@i{index}]@t{)}]@t{=}@i{expression}@t{.} +@end display + +The @code{COMPUTE} command evaluates an expression and assigns the +result to a variable or a submatrix of a variable. Assigning to a +submatrix uses the same syntax as the index operator (@pxref{Matrix +Index Operator}). + +@node Matrix CALL command +@subsection The @code{CALL} Command + +A matrix function returns a single result. The @code{CALL} command +implements procedures, which take a similar syntactic form to +functions but yield results by modifying their arguments rather than +returning a value. + +Output arguments to a @code{CALL} procedure must be a single variable +name. + +The following procedures are implemented via @code{CALL} to allow them +to return multiple results. For these procedures, the output +arguments need not name existing variables; if they do, then their +previous values are replaced: + +@table @asis +@item @t{CALL EIGEN(@var{M}, @var{evec}, @var{eval})} +@anchor{CALL EIGEN} + +Computes the eigenvalues and eigenvector of symmetric +@math{@var{n}@times{}@var{n}} matrix @var{M}. Assigns the +eigenvectors of @var{M} to the columns of +@math{@var{n}@times{}@var{n}} matrix @var{evec} and the eigenvalues in +descending order to @var{n}-element column vector @var{eval}. + +Use the @code{EVAL} function (@pxref{EVAL}) to compute just the +eigenvalues of a symmetric matrix. + +For example, the following matrix language commands: +@example +CALL EIGEN(@{1, 0; 0, 1@}, evec, eval). +PRINT evec. +PRINT eval. + +CALL EIGEN(@{3, 2, 4; 2, 0, 2; 4, 2, 3@}, evec2, eval2). +PRINT evec2. +PRINT eval2. +@end example + +@noindent +yield this output: + +@example +evec + 1 0 + 0 1 + +eval + 1 + 1 + +evec2 + -.6666666667 .0000000000 .7453559925 + -.3333333333 -.8944271910 -.2981423970 + -.6666666667 .4472135955 -.5962847940 + +eval2 + 8.0000000000 + -1.0000000000 + -1.0000000000 +@end example + +@item @t{CALL SVD(@var{M}, @var{U}, @var{S}, @var{V})} +@anchor{CALL SVD} + +Computes the singular value decomposition of +@math{@var{n}@times{}@var{k}} matrix @var{M}, assigning @var{S} a +@math{@var{n}@times{}@var{k}} diagonal matrix and to @var{U} and +@var{V} unitary @math{@var{k}@times{}@var{k}} matrices such that +@math{@var{M} = @var{U}@times{}@var{S}@times{}@var{V}^T}. The main +diagonal of @var{Q} contains the singular values of @var{M}. + +Use the @code{SVAL} function (@pxref{SVAL}) to compute just the +singular values of a matrix. + +For example, the following matrix program: + +@example +CALL SVD(@{3, 2, 2; 2, 3, -2@}, u, s, v). +PRINT (u * s * T(v))/FORMAT F5.1. +@end example + +@noindent +yields this output: + +@example +(u * s * T(v)) + 3.0 2.0 2.0 + 2.0 3.0 -2.0 +@end example +@end table + +The final procedure is implemented via @code{CALL} to allow it to +modify a matrix instead of returning a modified version. For this +procedure, the output argument must name an existing variable. + +@table @asis +@item @t{CALL SETDIAG(@var{M}, @var{V})} +@anchor{CALL SETDIAG} + +Replaces the main diagonal of @math{@var{n}@times{}@var{p}} matrix +@var{M} by the contents of @var{k}-element vector @var{V}. If +@math{@var{k} = 1}, so that @var{V} is a scalar, replaces all of the +diagonal elements of @var{M} by @var{V}. If @math{@var{k} < +\min(@var{n},@var{p})}, only the upper @var{k} diagonal elements are +replaced; if @math{@var{k} > \min(@var{n},@var{p})}, then the +extra elements of @var{V} are ignored. + +Use the @code{MDIAG} function (@pxref{MDIAG}) to construct a new +matrix with a specified main diagonal. + +For example, this matrix program: + +@example +COMPUTE x=@{1, 2, 3; 4, 5, 6; 7, 8, 9@}. +CALL SETDIAG(x, 10). +PRINT x. +@end example + +@noindent +outputs the following: + +@example +x + 10 2 3 + 4 10 6 + 7 8 10 +@end example +@end table + +@node Matrix PRINT Command +@subsection The @code{PRINT} Command + +@display +@t{PRINT} [@i{expression}] + [@t{/FORMAT}@t{=}@i{format}] + [@t{/TITLE}@t{=}@i{title}] + [@t{/SPACE}@t{=}@{@t{NEWPAGE} @math{|} @i{n}@}] + [@{@t{/RLABELS}@t{=}@i{string}@dots{} @math{|} @t{/RNAMES}@t{=}@i{expression}@}] + [@{@t{/CLABELS}@t{=}@i{string}@dots{} @math{|} @t{/CNAMES}@t{=}@i{expression}@}]@t{.} +@end display + +The @code{PRINT} command is commonly used to display a matrix. It +evaluates the restricted @var{expression}, if present, and outputs it +either as text or a pivot table, depending on the setting of +@code{MDISPLAY} (@pxref{SET MDISPLAY}). + +Use the @code{FORMAT} subcommand to specify a format, such as +@code{F8.2}, for displaying the matrix elements. @code{FORMAT} is +optional for numerical matrices. When it is omitted, @pspp{} chooses +how to format entries automatically using @var{m}, the magnitude of +the largest-magnitude element in the matrix to be displayed: + +@enumerate +@item +If @math{@var{m} < 10^{11}} and the matrix's elements are all +integers, @pspp{} chooses the narrowest @code{F} format that fits +@var{m} plus a sign. For example, if the matrix is @t{@{1:10@}}, then +@math{m = 10}, which fits in 3 columns with room for a sign, the +format is @code{F3.0}. + +@item +Otherwise, if @math{@var{m} @geq{} 10^9} or @math{@var{m} @leq{} +10^{-4}}, @pspp{} scales all of the numbers in the matrix by +@math{10^x}, where @var{x} is the exponent that would be used to +display @var{m} in scientific notation. For example, for +@math{@var{m} = 5.123@times{}10^{20}}, the scale factor is +@math{10^{20}}. @pspp{} displays the scaled values in format +@code{F13.10} and notes the scale factor in the output. + +@item +Otherwise, @pspp{} displays the matrix values, without scaling, in +format @code{F13.10}. +@end enumerate + +The optional @code{TITLE} subcommand specifies a title for the output +text or table, as a quoted string. When it is omitted, the syntax of +the matrix expression is used as the title. + +Use the @code{SPACE} subcommand to request extra space above the +matrix output. With a numerical argument, it adds the specified +number of lines of blank space above the matrix. With @code{NEWPAGE} +as an argument, it prints the matrix at the top of a new page. The +@code{SPACE} subcommand has no effect when a matrix is output as a +pivot table. + +The @code{RLABELS} and @code{RNAMES} subcommands, which are mutually +exclusive, can supply a label to accompany each row in the output. +With @code{RLABELS}, specify the labels as comma-separated strings or +other tokens. With @code{RNAMES}, specify a single expression that +evaluates to a vector of strings. Either way, if there are more +labels than rows, the extra labels are ignored, and if there are more +rows than labels, the extra rows are unlabeled. For output to a pivot +table with @code{RLABELS}, the labels can be any length; otherwise, +the labels are truncated to 8 bytes. + +The @code{CLABELS} and @code{CNAMES} subcommands work for labeling +columns as @code{RLABELS} and @code{RNAMES} do for labeling rows. + +When the @var{expression} is omitted, @code{PRINT} does not output a +matrix. Instead, it outputs only the text specified on @code{TITLE}, +if any, preceded by any space specified on the @code{SPACE} +subcommand, if any. Any other subcommands are ignored, and the +command acts as if @code{MDISPLAY} is set to @code{TEXT} regardless of +its actual setting. + +The following syntax demonstrates two different ways to label the rows +and columns of a matrix with @code{PRINT}: + +@example +MATRIX. +COMPUTE m=@{1, 2, 3; 4, 5, 6; 7, 8, 9@}. +PRINT m/RLABELS=a, b, c/CLABELS=x, y, z. + +COMPUTE rlabels=@{"a", "b", "c"@}. +COMPUTE clabels=@{"x", "y", "z"@}. +PRINT m/RNAMES=rlabels/CNAMES=clabels. +END MATRIX. +@end example + +@noindent +With @code{MDISPLAY=TEXT} (the default), this program outputs the +following (twice): + +@example +m + x y z +a 1 2 3 +b 4 5 6 +c 7 8 9 +@end example + +@noindent +With @samp{SET MDISPLAY=TABLES.} added above @samp{MATRIX.}, the +output becomes the following (twice): + +@psppoutput {matrix-print} + +@node Matrix DO IF Command +@subsection The @code{DO IF} Command + +@display +@t{DO IF} @i{expression}@t{.} + @dots{}@i{matrix commands}@dots{} +[@t{ELSE IF} @i{expression}@t{.} + @dots{}@i{matrix commands}@dots{}]@dots{} +[@t{ELSE} + @dots{}@i{matrix commands}@dots{}] +@t{END IF}@t{.} +@end display + +A @code{DO IF} command evaluates its expression argument. If the +@code{DO IF} expression evaluates to true, then @pspp{} executes the +associated commands. Otherwise, @pspp{} evaluates the expression on +each @code{ELSE IF} clause (if any) in order, and executes the +commands associated with the first one that yields a true value. +Finally, if the @code{DO IF} and all the @code{ELSE IF} expressions +all evaluate to false, @pspp{} executes the commands following the +@code{ELSE} clause (if any). + +Each expression on @code{DO IF} and @code{ELSE IF} must evaluate to a +scalar. Positive scalars are considered to be true, and scalars that +are zero or negative are considered to be false. + +The following matrix language fragment sets @samp{b} to the term +following @samp{a} in the +@url{https://en.wikipedia.org/wiki/Juggler_sequence, Juggler +sequence}: + +@example +DO IF MOD(a, 2) = 0. + COMPUTE b = TRUNC(a &** (1/2)). +ELSE. + COMPUTE b = TRUNC(a &** (3/2)). +END IF. +@end example + +@node Matrix LOOP and BREAK Commands +@subsection The @code{LOOP} and @code{BREAK} Commands + +@display +@t{LOOP} [@i{var}@t{=}@i{first} @t{TO} @i{last} [@t{BY} @i{step}]] [@t{IF} @i{expression}]@t{.} + @dots{}@i{matrix commands}@dots{} +@t{END LOOP} [@t{IF} @i{expression}]@t{.} + +@t{BREAK}@t{.} +@end display + +The @code{LOOP} command executes a nested group of matrix commands, +called the loop's @dfn{body}, repeatedly. It has three optional +clauses that control how many times the loop body executes. +Regardless of these clauses, the global @code{MXLOOPS} setting, which +defaults to 40, also limits the number of iterations of a loop. To +iterate more times, raise the maximum with @code{SET MXLOOPS} outside +of the @code{MATRIX} command (@pxref{SET MXLOOPS}). + +The optional index clause causes @var{var} to be assigned successive +values on each trip through the loop: first @var{first}, then +@math{@var{first} + @var{step}}, then @math{@var{first} + 2 @times{} +@var{step}}, and so on. The loop ends when @math{@var{var} > +@var{last}}, for positive @var{step}, or @math{@var{var} < +@var{last}}, for negative @var{step}. If @var{step} is not specified, +it defaults to 1. All the index clause expressions must evaluate to +scalars, and non-integers are rounded toward zero. If @var{step} +evaluates as zero (or rounds to zero), then the loop body never +executes. + +The optional @code{IF} on @code{LOOP} is evaluated before each +iteration through the loop body. If its expression, which must +evaluate to a scalar, is zero or negative, then the loop terminates +without executing the loop body. + +The optional @code{IF} on @code{END LOOP} is evaluated after each +iteration through the loop body. If its expression, which must +evaluate to a scalar, is zero or negative, then the loop terminates. + +The following computes and prints @math{l(n)}, whose value is the +number of steps in the +@url{https://en.wikipedia.org/wiki/Juggler_sequence, Juggler sequence} +for @math{n}, for @math{n} from 2 to 10 inclusive: + +@example +COMPUTE l = @{@}. +LOOP n = 2 TO 10. + COMPUTE a = n. + LOOP i = 1 TO 100. + DO IF MOD(a, 2) = 0. + COMPUTE a = TRUNC(a &** (1/2)). + ELSE. + COMPUTE a = TRUNC(a &** (3/2)). + END IF. + END LOOP IF a = 1. + COMPUTE l = @{l; i@}. +END LOOP. +PRINT l. +@end example + +@menu +* Matrix BREAK Command:: +@end menu + +@node Matrix BREAK Command +@subsubsection The @code{BREAK} Command + +The @code{BREAK} command may be used inside a loop body, ordinarily +within a @code{DO IF} command. If it is executed, then the loop +terminates immediately, jumping to the command just following +@code{END LOOP}. When multiple @code{LOOP} commands nest, +@code{BREAK} terminates the innermost loop. + +The following example is a revision of the one above that shows how +@code{BREAK} could substitute for the index and @code{IF} clauses on +@code{LOOP} and @code{END LOOP}: + +@example +COMPUTE l = @{@}. +LOOP n = 2 TO 10. + COMPUTE a = n. + COMPUTE i = 1. + LOOP. + DO IF MOD(a, 2) = 0. + COMPUTE a = TRUNC(a &** (1/2)). + ELSE. + COMPUTE a = TRUNC(a &** (3/2)). + END IF. + DO IF a = 1. + BREAK. + END IF. + COMPUTE i = i + 1. + END LOOP. + COMPUTE l = @{l; i@}. +END LOOP. +PRINT l. +@end example + +@node Matrix READ and WRITE Commands +@subsection The @code{READ} and @code{WRITE} Commands + +The @code{READ} and @code{WRITE} commands perform matrix input and +output with text files. They share the following syntax for +specifying how data is divided among input lines: + +@display +@t{/FIELD}@t{=}@i{first} @t{TO} @i{last} [@t{BY} @i{width}] +[@t{/FORMAT}@t{=}@i{format}] +@end display + +Both commands require the @code{FIELD} subcommand. It specifies the +range of columns, from @var{first} to @var{last}, inclusive, that the +data occupies on each line of the file. The leftmost column is column +1. The columns must be literal numbers, not expressions. To use +entire lines, even if they might be very long, specify a column range +such as @code{1 TO 100000}. + +The @code{FORMAT} subcommand is optional for numerical matrices. For +string matrix input and output, specify an @code{A} format. In +addition to @code{FORMAT}, the optional @code{BY} specification on +@code{FIELD} determine the meaning of each text line: + +@itemize @bullet +@item +With neither @code{BY} nor @code{FORMAT}, the numbers in the text file +are in @code{F} format separated by spaces or commas. For +@code{WRITE}, @pspp{} uses as many digits of precision as needed to +accurately represent the numbers in the matrix. + +@item +@code{BY @i{width}} divides the input area into fixed-width fields +with the given @i{width}. The input area must be a multiple of +@i{width} columns wide. Numbers are read or written as +@code{F@i{width}.0} format. + +@item +@code{FORMAT=@i{count}F} divides the input area into @i{count} +equal-width fields per line. The input area must be a multiple of +@i{count} columns wide. Another format type may be substituted for +@code{F}. + +@item +@code{FORMAT=F@i{w}}[@code{.@i{d}}] divides the input area into fixed-width +fields with width @i{w}. The input area must be a multiple of @i{w} +columns wide. Another format type may be substituted for @code{F}. +The @code{READ} command disregards @i{d}. + +@item +@code{FORMAT=F} specifies format @code{F} without indicating a field +width. Another format type may be substituted for @code{F}. The +@code{WRITE} command accepts this form, but it has no effect unless +@code{BY} is also used to specify a field width. +@end itemize + +If @code{BY} and @code{FORMAT} both specify or imply a field width, +then they must indicate the same field width. + +@node Matrix READ Command +@subsubsection The @code{READ} Command + +@display +@t{READ} @i{variable}[@t{(}@i{index}[@t{,}@i{index}]@t{)}] + [@t{/FILE}@t{=}@i{file}] + @t{/FIELD}@t{=}@i{first} @t{TO} @i{last} [@t{BY} @i{width}] + [@t{/FORMAT}@t{=}@i{format}] + [@t{/SIZE}@t{=}@i{expression}] + [@t{/MODE}@t{=}@{@t{RECTANGULAR} @math{|} @t{SYMMETRIC}@}] + [@t{/REREAD}]@t{.} +@end display + +The @code{READ} command reads from a text file into a matrix variable. +Specify the target variable just after the command name, either just a +variable name to create or replace an entire variable, or a variable +name followed by an indexing expression to replace a submatrix of an +existing variable. + +The @code{FILE} subcommand is required in the first @code{READ} +command that appears within @code{MATRIX}. It specifies the text file +to be read, either as a file name in quotes or a file handle +previously declared on @code{FILE HANDLE} (@pxref{FILE HANDLE}). +Later @code{READ} commands (in syntax order) use the previous +referenced file if @code{FILE} is omitted. + +The @code{FIELD} and @code{FORMAT} subcommands specify how input lines +are interpreted. @code{FIELD} is required, but @code{FORMAT} is +optional. @xref{Matrix READ and WRITE Commands}, for details. + +The @code{SIZE} subcommand is required for reading into an entire +variable. Its restricted expression argument should evaluate to a +2-element vector @code{@{@var{n},@w{ }@var{m}@}} or +@code{@{@var{n};@w{ }@var{m}@}}, which indicates a +@math{@var{n}@times{}@var{m}} matrix destination. A scalar @var{n} is +also allowed and indicates a @math{@var{n}@times{}1} column vector +destination. When the destination is a submatrix, @code{SIZE} is +optional, and if it is present then it must match the size of the +submatrix. + +By default, or with @code{MODE=RECTANGULAR}, the command reads an +entry for every row and column. With @code{MODE=SYMMETRIC}, the +command reads only the entries on and below the matrix's main +diagonal, and copies the entries above the main diagonal from the +corresponding symmetric entries below it. Only square matrices +may use @code{MODE=SYMMETRIC}. + +Ordinarily, each @code{READ} command starts from a new line in the +text file. Specify the @code{REREAD} subcommand to instead start from +the last line read by the previous @code{READ} command. This has no +effect for the first @code{READ} command to read from a particular +file. It is also ineffective just after a command that uses the +@code{EOF} matrix function (@pxref{EOF Matrix Function}) on a +particular file, because @code{EOF} has to try to read the next line +from the file to determine whether the file contains more input. + +@subsubheading Example 1: Basic Use + +The following matrix program reads the same matrix @code{@{1, 2, 4; 2, +3, 5; 4, 5, 6@}} into matrix variables @code{v}, @code{w}, and +@code{x}: + +@example +READ v /FILE='input.txt' /FIELD=1 TO 100 /SIZE=@{3, 3@}. +READ w /FIELD=1 TO 100 /SIZE=@{3; 3@} /MODE=SYMMETRIC. +READ x /FIELD=1 TO 100 BY 1/SIZE=@{3, 3@} /MODE=SYMMETRIC. +@end example + +@noindent +given that @file{input.txt} contains the following: + +@example +1, 2, 4 +2, 3, 5 +4, 5, 6 +1 +2 3 +4 5 6 +1 +23 +456 +@end example + +The @code{READ} command will read as many lines of input as needed for +a particular row, so it's also acceptable to break any of the lines +above into multiple lines. For example, the first line @code{1, 2, 4} +could be written with a line break following either or both commas. + +@subsubheading Example 2: Reading into a Submatrix + +The following reads a @math{5@times{}5} matrix from @file{input2.txt}, +reversing the order of the rows: + +@example +COMPUTE m = MAKE(5, 5, 0). +LOOP r = 5 TO 1 BY -1. + READ m(r, :) /FILE='input2.txt' /FIELD=1 TO 100. +END LOOP. +@end example + +@subsubheading Example 3: Using @code{REREAD} + +Suppose each of the 5 lines in a file @file{input3.txt} starts with an +integer @var{count} followed by @var{count} numbers, e.g.: + +@example +1 5 +3 1 2 3 +5 6 -1 2 5 1 +2 8 9 +3 1 3 2 +@end example + +@noindent +Then, the following reads this file into a matrix @code{m}: + +@example +COMPUTE m = MAKE(5, 5, 0). +LOOP i = 1 TO 5. + READ count /FILE='input3.txt' /FIELD=1 TO 1 /SIZE=1. + READ m(i, 1:count) /FIELD=3 TO 100 /REREAD. +END LOOP. +@end example + +@node Matrix WRITE Command +@subsubsection The @code{WRITE} Command + +@display +@t{WRITE} @i{expression} + [@t{/OUTFILE}@t{=}@i{file}] + @t{/FIELD}@t{=}@i{first} @t{TO} @i{last} [@t{BY} @i{width}] + [@t{/FORMAT}@t{=}@i{format}] + [@t{/MODE}@t{=}@{@t{RECTANGULAR} @math{|} @t{TRIANGULAR}@}] + [@t{/HOLD}]@t{.} +@end display + +The @code{WRITE} command evaluates @i{expression} and writes its value +to a text file in a specified format. Write the expression to +evaluate just after the command name. + +The @code{OUTFILE} subcommand is required in the first @code{WRITE} +command that appears within @code{MATRIX}. It specifies the text file +to be written, either as a file name in quotes or a file handle +previously declared on @code{FILE HANDLE} (@pxref{FILE HANDLE}). +Later @code{WRITE} commands (in syntax order) use the previous +referenced file if @code{FILE} is omitted. + +The @code{FIELD} and @code{FORMAT} subcommands specify how output +lines are formed. @code{FIELD} is required, but @code{FORMAT} is +optional. @xref{Matrix READ and WRITE Commands}, for details. + +By default, or with @code{MODE=RECTANGULAR}, the command writes an +entry for every row and column. With @code{MODE=TRIANGULAR}, the +command writes only the entries on and below the matrix's main +diagonal. Entries above the diagonal are not written. Only square +matrices may be written with @code{MODE=TRIANGULAR}. + +Ordinarily, each @code{WRITE} command writes complete lines to the +output file. With @code{HOLD}, the final line written by @code{WRITE} +will be held back for the next @code{WRITE} command to augment. This +can be useful to write more than one matrix on a single output line. + +@subsubheading Example 1: Basic Usage + +This matrix program: + +@example +WRITE @{1, 2; 3, 4@} /OUTFILE='matrix.txt' /FIELD=1 TO 80. +@end example + +@noindent +writes the following to @file{matrix.txt}: + +@example + 1 2 + 3 4 +@end example + +@subsubheading Example 2: Triangular Matrix + +This matrix program: + +@example +WRITE MAGIC(5) /OUTFILE='matrix.txt' /FIELD=1 TO 80 BY 5 /MODE=TRIANGULAR. +@end example + +@noindent +writes the following to @file{matrix.txt}: + +@example + 17 + 23 5 + 4 6 13 + 10 12 19 21 + 11 18 25 2 9 +@end example + +@node Matrix GET Command +@subsection The @code{GET} Command + +@display +@t{GET} @i{variable}[@t{(}@i{index}[@t{,}@i{index}]@t{)}] + [@t{/FILE}@t{=}@{@i{file} @math{|} @t{*}@}] + [@t{/VARIABLES}@t{=}@i{variable}@dots{}] + [@t{/NAMES}@t{=}@i{variable}] + [@t{/MISSING}@t{=}@{@t{ACCEPT} @math{|} @t{OMIT} @math{|} @i{number}@}] + [@t{/SYSMIS}@t{=}@{@t{OMIT} @math{|} @i{number}@}]@t{.} +@end display + +The @code{READ} command reads numeric data from an SPSS system file, +SPSS/PC+ system file, or SPSS portable file into a matrix variable or +submatrix: + +@itemize @bullet +@item +To read data into a variable, specify just its name following +@code{GET}. The variable need not already exist; if it does, it is +replaced. The variable will have as many columns as there are +variables specified on the @code{VARIABLES} subcommand and as many +rows as there are cases in the input file. + +@item +To read data into a submatrix, specify the name of an existing +variable, followed by an indexing expression, just after @code{GET}. +The submatrix must have as many columns as variables specified on +@code{VARIABLES} and as many rows as cases in the input file. +@end itemize + +Specify the name or handle of the file to be read on @code{FILE}. Use +@samp{*}, or simply omit the @code{FILE} subcommand, to read from the +active file. Reading from the active file is only permitted if it was +already defined outside @code{MATRIX}. + +List the variables to be read as columns in the matrix on the +@code{VARIABLES} subcommand. The list can use @code{TO} for +collections of variables or @code{ALL} for all variables. If +@code{VARIABLES} is omitted, all variables are read. Only numeric +variables may be read. + +If a variable is named on @code{NAMES}, then the names of the +variables read as data columns are stored in a string vector within +the given name, replacing any existing matrix variable with that name. +Variable names are truncated to 8 bytes. + +The @code{MISSING} and @code{SYSMIS} subcommands control the treatment +of missing values in the input file. By default, any user- or +system-missing data in the variables being read from the input causes +an error that prevents @code{GET} from executing. To accept missing +values, specify one of the following settings on @code{MISSING}: + +@table @asis +@item @code{ACCEPT} +Accept user-missing values with no change. + +By default, system-missing values still yield an error. Use the +@code{SYSMIS} subcommand to change this treatment: + +@table @asis +@item @code{OMIT} +Skip any case that contains a system-missing value. + +@item @i{number} +Recode the system-missing value to @i{number}. +@end table + +@item @code{OMIT} +Skip any case that contains any user- or system-missing value. + +@item @i{number} +Recode all user- and system-missing values to @i{number}. +@end table + +The @code{SYSMIS} subcommand has an effect only with +@code{MISSING=ACCEPT}. + +@node Matrix SAVE Command +@subsection The @code{SAVE} Command + +@display +@t{SAVE} @i{expression} + [@t{/OUTFILE}@t{=}@{@i{file} @math{|} @t{*}@}] + [@t{/VARIABLES}@t{=}@i{variable}@dots{}] + [@t{/NAMES}@t{=}@i{expression}] + [@t{/STRINGS}@t{=}@i{variable}@dots{}]@t{.} +@end display + +The @code{SAVE} matrix command evaluates @i{expression} and writes the +resulting matrix to an SPSS system file. In the system file, each +matrix row becomes a case and each column becomes a variable. + +Specify the name or handle of the SPSS system file on the +@code{OUTFILE} subcommand, or @samp{*} to write the output as the new +active file. The @code{OUTFILE} subcommand is required on the first +@code{SAVE} command, in syntax order, within @code{MATRIX}. For +@code{SAVE} commands after the first, the default output file is the +same as the previous. + +When multiple @code{SAVE} commands write to one destination within a +single @code{MATRIX}, the later commands append to the same output +file. All the matrices written to the file must have the same number +of columns. The @code{VARIABLES}, @code{NAMES}, and @code{STRINGS} +subcommands are honored only for the first @code{SAVE} command that +writes to a given file. + +By default, @code{SAVE} names the variables in the output file +@code{COL1} through @code{COL@i{n}}. Use @code{VARIABLES} or +@code{NAMES} to give the variables meaningful names. The +@code{VARIABLES} subcommand accepts a comma-separated list of variable +names. Its alternative, @code{NAMES}, instead accepts an expression +that must evaluate to a row or column string vector of names. The +number of names need not exactly match the number of columns in the +matrix to be written: extra names are ignored; extra columns use +default names. + +By default, @code{SAVE} assumes that the matrix to be written is all +numeric. To write string columns, specify a comma-separated list of +the string columns' variable names on @code{STRINGS}. + +@node Matrix MGET Command +@subsection The @code{MGET} Command + +@display +@t{MGET} [@t{/FILE}@t{=}@i{file}] + [@t{/TYPE}@t{=}@{@t{COV} @math{|} @t{CORR} @math{|} @t{MEAN} @math{|} @t{STDDEV} @math{|} @t{N} @math{|} @t{COUNT}@}]@t{.} +@end display + +The @code{MGET} command reads the data from a matrix file +(@pxref{Matrix Files}) into matrix variables. + +All of @code{MGET}'s subcommands are optional. Specify the name or +handle of the matrix file to be read on the @code{FILE} subcommand; if +it is omitted, then the command reads the active file. + +By default, @code{MGET} reads all of the data from the matrix file. +Specify a space-delimited list of matrix types on @code{TYPE} to limit +the kinds of data to the one specified: + +@table @code +@item COV +Covariance matrix. + +@item CORR +Correlation coefficient matrix. + +@item MEAN +Vector of means. + +@item STDDEV +Vector of standard deviations. + +@item N +Vector of case counts. + +@item COUNT +Vector of counts. +@end table + +@code{MGET} reads the entire matrix file and automatically names, +creates, and populates matrix variables using its contents. It +constructs the name of each variable by concatenating the following: + +@itemize @bullet +@item +A 2-character prefix that identifies the type of the matrix: + +@table @code +@item CV +Covariance matrix. + +@item CR +Correlation coefficient matrix. + +@item MN +Vector of means. + +@item SD +Vector of standard deviations. + +@item NC +Vector of case counts. + +@item CN +Vector of counts. +@end table + +@item +If the matrix file has factor variables, @code{F@i{n}}, where @i{n} is +a number identifying a group of factors: @code{F1} for the first +group, @code{F2} for the second, and so on. This part is omitted for +pooled data (where the factors all have the system-missing value). + +@item +If the matrix file has split file variables, @code{S@i{n}}, where +@i{n} is a number identifying a split group: @code{S1} for the first +group, @code{S2} for the second, and so on. +@end itemize + +If @code{MGET} chooses the name of an existing variable, it issues a +warning and does not change the variable. + +@node Matrix MSAVE Command +@subsection The @code{MSAVE} Command + +@display +@t{MSAVE} @i{expression} + @t{/TYPE}@t{=}@{@t{COV} @math{|} @t{CORR} @math{|} @t{MEAN} @math{|} @t{STDDEV} @math{|} @t{N} @math{|} @t{COUNT}@} + [@t{/FACTOR}@t{=}@i{expression}] + [@t{/SPLIT}@t{=}@i{expression}] + [@t{/OUTFILE}@t{=}@i{file}] + [@t{/VARIABLES}@t{=}@i{variable}@dots{}] + [@t{/SNAMES}@t{=}@i{variable}@dots{}] + [@t{/FNAMES}@t{=}@i{variable}@dots{}]@t{.} +@end display + +The @code{MSAVE} command evaluates the @i{expression} specified just +after the command name, and writes the resulting matrix to a matrix +file (@pxref{Matrix Files}). + +The @code{TYPE} subcommand is required. It specifies the +@code{ROWTYPE_} to write along with this matrix. + +The @code{FACTOR} and @code{SPLIT} subcommands are required on the +first @code{MSAVE} if and only if the matrix file has factor or split +variables, respectively. After that, their values are carried along +from one @code{MSAVE} command to the next in syntax order as defaults. +Each one takes an expression that must evaluate to a vector with the +same number of entries as the matrix has factor or split variables, +respectively. Each @code{MSAVE} only writes data for a single +combination of factor and split variables, so many @code{MSAVE} +commands (or one inside a loop) may be needed to write a complete set. + +The remaining @code{MSAVE} subcommands define the format of the matrix +file. All of the @code{MSAVE} commands within a given matrix program +write to the same matrix file, so these subcommands are only +meaningful on the first @code{MSAVE} command within a matrix program. +(If they are given again on later @code{MSAVE} commands, then they +must have the same values as on the first.) + +The @code{OUTFILE} subcommand specifies the name or handle of the +matrix file to be written. Output must go to an external file, not a +data set or the active file. + +The @code{VARIABLES} subcommand specifies a comma-separated list of +the names of the continuous variables to be written to the matrix +file. The @code{TO} keyword can be used to define variables named +with consecutive integer suffixes. These names become column names +and names that appear in @code{VARNAME_} in the matrix file. +@code{ROWTYPE_} and @code{VARNAME_} are not allowed on +@code{VARIABLES}. If @code{VARIABLES} is omitted, then @pspp{} uses +the names @code{COL1}, @code{COL2}, and so on. + +The @code{FNAMES} subcommand may be used to supply a comma-separated +list of factor variable names. The default names are @code{FAC1}, +@code{FAC2}, and so on. + +The @code{SNAMES} subcommand can supply a comma-separated list of +split variable names. The default names are @code{SPL1}, @code{SPL2}, +and so on. + +@node Matrix DISPLAY Command +@subsection The @code{DISPLAY} Command + +@display +@t{DISPLAY} [@{@t{DICTIONARY} @math{|} @t{STATUS}@}]@t{.} +@end display + +The @code{DISPLAY} command makes @pspp{} display a table with the name +and dimensions of each matrix variable. The @code{DICTIONARY} and +@code{STATUS} keywords are accepted but have no effect. + +@node Matrix RELEASE Command +@subsection The @code{RELEASE} Command + +@display +@t{RELEASE} @i{variable}@dots{}@t{.} +@end display + +The @code{RELEASE} command accepts a comma-separated list of matrix +variable names. It deletes each variable and releases the memory +associated with it. + +The @code{END MATRIX} command releases all matrix variables. diff --git a/doc/pspp-figures/matrix-print.sps b/doc/pspp-figures/matrix-print.sps new file mode 100644 index 0000000000..240ed2172a --- /dev/null +++ b/doc/pspp-figures/matrix-print.sps @@ -0,0 +1,7 @@ +SET MDISPLAY=TABLES. +MATRIX. +COMPUTE m={1, 2, 3; 4, 5, 6; 7, 8, 9}. +COMPUTE rlabels={"a", "b", "c"}. +COMPUTE clabels={"x", "y", "z"}. +PRINT m/RNAMES=rlabels/CNAMES=clabels. +END MATRIX. diff --git a/doc/pspp.texi b/doc/pspp.texi index 6c4771e944..204feada58 100644 --- a/doc/pspp.texi +++ b/doc/pspp.texi @@ -90,6 +90,15 @@ graphic user interface @end quotation @end macro +@ifnottex +@macro times{} +× +@end macro +@macro ne{} +≠ +@end macro +@end ifnottex + @c A macro to indicate variable names used in examples. @c NOT metasyntactical variables - for that use @var @macro exvar{VAR} diff --git a/doc/utilities.texi b/doc/utilities.texi index 19b5b4230c..18a45095e9 100644 --- a/doc/utilities.texi +++ b/doc/utilities.texi @@ -506,6 +506,7 @@ SET /CC@{A,B,C,D,E@}=@{'@var{npre},@var{pre},@var{suf},@var{nsuf}','@var{npre}.@var{pre}.@var{suf}.@var{nsuf}'@} /DECIMAL=@{DOT,COMMA@} /FORMAT=@var{fmt_spec} + /MDISPLAY=@{TEXT,TABLES@} /SMALL=@var{number} /WIB=@{NATIVE,MSBFIRST,LSBFIRST,VAX@} /WRB=@{NATIVE,ISL,ISB,IDL,IDB,VF,VD,VG,ZS,ZL@} @@ -692,10 +693,12 @@ Japanese as spoken in Japan). @item MXLOOPS @anchor{SET MXLOOPS} -The maximum number of iterations for an uncontrolled loop (@pxref{LOOP}). -The default @var{max_loops} is 40. +The maximum number of iterations for an uncontrolled loop +(@pxref{LOOP}), and for any loop in the matrix language (@pxref{Matrix +LOOP and BREAK Commands}). The default @var{max_loops} is 40. @item SEED +@anchor{SET SEED} The initial pseudo-random number seed. Set it to a real number or to RANDOM, to obtain an initial seed from the current time of day. @@ -744,6 +747,15 @@ The default @subcmd{DOT} setting causes the decimal point character to be Allows the default numeric input/output format to be specified. The default is F8.2. @xref{Input and Output Formats}. +@item MDISPLAY +@anchor{SET MDISPLAY} + +Controls how the @code{PRINT} command within +@code{MATRIX}@dots{}@code{END MATRIX} outputs matrices. With the +default @subcmd{TEXT}, @code{PRINT} outputs matrices as text. Change +this setting to @code{TABLES} to instead output matrices as pivot +tables. @xref{Matrix PRINT Command}, for more information. + @item SMALL This controls how @pspp{} formats small numbers in pivot tables, in cases where @pspp{} does not otherwise have a well-defined format for diff --git a/src/data/settings.c b/src/data/settings.c index 313fed0baf..4bc36494fd 100644 --- a/src/data/settings.c +++ b/src/data/settings.c @@ -48,6 +48,9 @@ struct settings /* Format of reals in output (SET WRB). */ enum float_format output_float_format; + /* MATRIX...END MATRIX settings. */ + enum settings_mdisplay mdisplay; + int viewlength; int viewwidth; bool safer_mode; @@ -90,6 +93,7 @@ static struct settings the_settings = { .input_float_format = FLOAT_NATIVE_DOUBLE, .output_integer_format = INTEGER_NATIVE, .output_float_format = FLOAT_NATIVE_DOUBLE, + .mdisplay = SETTINGS_MDISPLAY_TEXT, .viewlength = 24, .viewwidth = 79, .safer_mode = false, @@ -701,3 +705,15 @@ settings_set_show_variables (enum settings_value_show s) { the_settings.show_variables = s; } + +enum settings_mdisplay +settings_get_mdisplay (void) +{ + return the_settings.mdisplay; +} + +void +settings_set_mdisplay (enum settings_mdisplay mdisplay) +{ + the_settings.mdisplay = mdisplay; +} diff --git a/src/data/settings.h b/src/data/settings.h index d7c616d9e0..9f6b94a888 100644 --- a/src/data/settings.h +++ b/src/data/settings.h @@ -187,4 +187,13 @@ void settings_set_output_routing (enum settings_output_type, enum settings_output_devices settings_get_output_routing ( enum settings_output_type); +enum settings_mdisplay + { + SETTINGS_MDISPLAY_TEXT, + SETTINGS_MDISPLAY_TABLES + }; + +enum settings_mdisplay settings_get_mdisplay (void); +void settings_set_mdisplay (enum settings_mdisplay); + #endif /* !settings_h */ diff --git a/src/language/command.def b/src/language/command.def index 9b3ff8a729..88cbaf5cbe 100644 --- a/src/language/command.def +++ b/src/language/command.def @@ -30,6 +30,7 @@ DEF_CMD (S_ANY, 0, "FINISH", cmd_finish) DEF_CMD (S_ANY, 0, "HOST", cmd_host) DEF_CMD (S_ANY, 0, "INCLUDE", cmd_include) DEF_CMD (S_ANY, 0, "INSERT", cmd_insert) +DEF_CMD (S_ANY, 0, "MATRIX", cmd_matrix) DEF_CMD (S_ANY, 0, "MCONVERT", cmd_mconvert) DEF_CMD (S_ANY, 0, "N OF CASES", cmd_n_of_cases) DEF_CMD (S_ANY, F_ABBREV, "N", cmd_n_of_cases) @@ -210,7 +211,6 @@ UNIMPL_CMD ("KM", "Kaplan-Meier") UNIMPL_CMD ("LOGLINEAR", "General model fitting") UNIMPL_CMD ("MANOVA", "Multivariate analysis of variance") UNIMPL_CMD ("MAPS", "Geographical display") -UNIMPL_CMD ("MATRIX", "Matrix processing") UNIMPL_CMD ("MIXED", "Mixed linear models") UNIMPL_CMD ("MODEL CLOSE", "Close server connection") UNIMPL_CMD ("MODEL HANDLE", "Define server connection") diff --git a/src/language/stats/automake.mk b/src/language/stats/automake.mk index 88c64abece..460e95e707 100644 --- a/src/language/stats/automake.mk +++ b/src/language/stats/automake.mk @@ -51,6 +51,7 @@ language_stats_sources = \ src/language/stats/jonckheere-terpstra.h \ src/language/stats/mann-whitney.c \ src/language/stats/mann-whitney.h \ + src/language/stats/matrix.c \ src/language/stats/means.c \ src/language/stats/means.h \ src/language/stats/means-calc.c \ diff --git a/src/language/stats/matrix.c b/src/language/stats/matrix.c new file mode 100644 index 0000000000..b1ec91474d --- /dev/null +++ b/src/language/stats/matrix.c @@ -0,0 +1,9010 @@ +/* PSPP - a program for statistical analysis. + Copyright (C) 2021 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "data/any-reader.h" +#include "data/any-writer.h" +#include "data/casereader.h" +#include "data/casewriter.h" +#include "data/data-in.h" +#include "data/data-out.h" +#include "data/dataset.h" +#include "data/dictionary.h" +#include "data/file-handle-def.h" +#include "language/command.h" +#include "language/data-io/data-reader.h" +#include "language/data-io/data-writer.h" +#include "language/data-io/file-handle.h" +#include "language/lexer/format-parser.h" +#include "language/lexer/lexer.h" +#include "language/lexer/variable-parser.h" +#include "libpspp/array.h" +#include "libpspp/assertion.h" +#include "libpspp/compiler.h" +#include "libpspp/hmap.h" +#include "libpspp/i18n.h" +#include "libpspp/intern.h" +#include "libpspp/misc.h" +#include "libpspp/str.h" +#include "libpspp/string-array.h" +#include "libpspp/stringi-set.h" +#include "libpspp/u8-line.h" +#include "math/distributions.h" +#include "math/random.h" +#include "output/driver.h" +#include "output/output-item.h" +#include "output/pivot-table.h" + +#include "gl/c-ctype.h" +#include "gl/c-strcase.h" +#include "gl/ftoastr.h" +#include "gl/minmax.h" +#include "gl/xsize.h" + +#include "gettext.h" +#define _(msgid) gettext (msgid) +#define N_(msgid) (msgid) + +struct matrix_state; + +/* A variable in the matrix language. */ +struct matrix_var + { + struct hmap_node hmap_node; /* In matrix_state's 'vars' hmap. */ + char *name; /* UTF-8. */ + gsl_matrix *value; /* NULL, if the variable is uninitialized. */ + }; + +/* All the MSAVE commands within a matrix program share common configuration, + provided by the first MSAVE command within the program. This structure + encapsulates this configuration. */ +struct msave_common + { + /* Common configuration for all MSAVEs. */ + struct msg_location *location; /* Range of lines for first MSAVE. */ + struct file_handle *outfile; /* Output file for all the MSAVEs. */ + struct string_array variables; /* VARIABLES subcommand. */ + struct string_array fnames; /* FNAMES subcommand. */ + struct string_array snames; /* SNAMES subcommand. */ + + /* Collects and owns factors and splits. The individual msave_command + structs point to these but do not own them. (This is because factors + and splits can be carried over from one MSAVE to the next, so it's + easiest to just take the most recent.) */ + struct matrix_expr **factors; + size_t n_factors, allocated_factors; + struct matrix_expr **splits; + size_t n_splits, allocated_splits; + + /* Execution state. */ + struct dictionary *dict; + struct casewriter *writer; + }; + +/* A file used by one or more READ commands. */ +struct read_file + { + /* Parse state. */ + struct file_handle *file; + + /* Execution state. */ + struct dfm_reader *reader; + char *encoding; + }; + +static struct read_file *read_file_create (struct matrix_state *, + struct file_handle *); +static struct dfm_reader *read_file_open (struct read_file *); + +/* A file used by one or more WRITE comamnds. */ +struct write_file + { + /* Parse state. */ + struct file_handle *file; + + /* Execution state. */ + struct dfm_writer *writer; + char *encoding; + struct u8_line *held; /* Output held by a previous WRITE with /HOLD. */ + }; + +static struct write_file *write_file_create (struct matrix_state *, + struct file_handle *); +static struct dfm_writer *write_file_open (struct write_file *); +static void write_file_destroy (struct write_file *); + +/* A file used by one or more SAVE commands. */ +struct save_file + { + /* Parse state. */ + struct file_handle *file; + struct dataset *dataset; + struct string_array variables; + struct matrix_expr *names; + struct stringi_set strings; + + /* Execution state. */ + bool error; + struct casewriter *writer; + struct dictionary *dict; + struct msg_location *location; + }; + +/* State of an entire matrix program. */ +struct matrix_state + { + /* State passed into MATRIX from outside. */ + struct dataset *dataset; + struct session *session; + struct lexer *lexer; + + /* Matrix program's own state. */ + struct hmap vars; /* Dictionary of matrix variables. */ + bool in_loop; /* True if parsing within a LOOP. */ + + /* MSAVE. */ + struct msave_common *msave_common; + + /* READ. */ + struct file_handle *prev_read_file; + struct read_file **read_files; + size_t n_read_files; + + /* WRITE. */ + struct file_handle *prev_write_file; + struct write_file **write_files; + size_t n_write_files; + + /* SAVE. */ + struct file_handle *prev_save_file; + struct save_file **save_files; + size_t n_save_files; + }; + +/* Finds and returns the variable with the given NAME (case-insensitive) within + S, if there is one, or a null pointer if there is not. */ +static struct matrix_var * +matrix_var_lookup (struct matrix_state *s, struct substring name) +{ + struct matrix_var *var; + + HMAP_FOR_EACH_WITH_HASH (var, struct matrix_var, hmap_node, + utf8_hash_case_substring (name, 0), &s->vars) + if (!utf8_sscasecmp (ss_cstr (var->name), name)) + return var; + + return NULL; +} + +/* Creates and returns a new variable named NAME within S. There must not + already be a variable with the same (case-insensitive) name. The variable + is created uninitialized. */ +static struct matrix_var * +matrix_var_create (struct matrix_state *s, struct substring name) +{ + struct matrix_var *var = xmalloc (sizeof *var); + *var = (struct matrix_var) { .name = ss_xstrdup (name) }; + hmap_insert (&s->vars, &var->hmap_node, utf8_hash_case_substring (name, 0)); + return var; +} + +/* Replaces VAR's value by VALUE. Takes ownership of VALUE. */ +static void +matrix_var_set (struct matrix_var *var, gsl_matrix *value) +{ + gsl_matrix_free (var->value); + var->value = value; +} + +/* Matrix function catalog. */ + +/* The third argument to F() is a "prototype". For most prototypes, the first + letter (before the _) represents the return type and each other letter + (after the _) is an argument type. The types are: + + - "m": A matrix of unrestricted dimensions. + + - "d": A scalar. + + - "v": A row or column vector. + + - "e": Primarily for the first argument, this is a matrix with + unrestricted dimensions treated elementwise. Each element in the matrix + is passed to the implementation function separately. + + - "n": This gets passed the "const struct matrix_expr *" that represents + the expression. This allows the evaluation function to grab the source + location of arguments so that it can report accurate error locations. + This type doesn't correspond to an argument passed in by the user. + + The fourth argument is an optional constraints string. For this purpose the + first argument is named "a", the second "b", and so on. The following kinds + of constraints are supported. For matrix arguments, the constraints are + applied to each value in the matrix separately: + + - "a(0,1)" or "a[0,1]": 0 < a < 1 or 0 <= a <= 1, respectively. Any + integer may substitute for 0 and 1. Half-open constraints (] and [) are + also supported. + + - "ai": Restrict a to integer values. + + - "a>0", "a<0", "a>=0", "a<=0", "a!=0". + + - "ab", "a<=b", "a>=b", "b!=0". +*/ +#define MATRIX_FUNCTIONS \ + F(ABS, "ABS", m_e, NULL) \ + F(ALL, "ALL", d_m, NULL) \ + F(ANY, "ANY", d_m, NULL) \ + F(ARSIN, "ARSIN", m_e, "a[-1,1]") \ + F(ARTAN, "ARTAN", m_e, NULL) \ + F(BLOCK, "BLOCK", m_any, NULL) \ + F(CHOL, "CHOL", m_mn, NULL) \ + F(CMIN, "CMIN", m_m, NULL) \ + F(CMAX, "CMAX", m_m, NULL) \ + F(COS, "COS", m_e, NULL) \ + F(CSSQ, "CSSQ", m_m, NULL) \ + F(CSUM, "CSUM", m_m, NULL) \ + F(DESIGN, "DESIGN", m_mn, NULL) \ + F(DET, "DET", d_m, NULL) \ + F(DIAG, "DIAG", m_m, NULL) \ + F(EVAL, "EVAL", m_mn, NULL) \ + F(EXP, "EXP", m_e, NULL) \ + F(GINV, "GINV", m_m, NULL) \ + F(GRADE, "GRADE", m_m, NULL) \ + F(GSCH, "GSCH", m_mn, NULL) \ + F(IDENT, "IDENT", IDENT, NULL) \ + F(INV, "INV", m_m, NULL) \ + F(KRONEKER, "KRONEKER", m_mm, NULL) \ + F(LG10, "LG10", m_e, "a>0") \ + F(LN, "LN", m_e, "a>0") \ + F(MAGIC, "MAGIC", m_d, "ai>=3") \ + F(MAKE, "MAKE", m_ddd, "ai>=0 bi>=0") \ + F(MDIAG, "MDIAG", m_v, NULL) \ + F(MMAX, "MMAX", d_m, NULL) \ + F(MMIN, "MMIN", d_m, NULL) \ + F(MOD, "MOD", m_md, "b!=0") \ + F(MSSQ, "MSSQ", d_m, NULL) \ + F(MSUM, "MSUM", d_m, NULL) \ + F(NCOL, "NCOL", d_m, NULL) \ + F(NROW, "NROW", d_m, NULL) \ + F(RANK, "RANK", d_m, NULL) \ + F(RESHAPE, "RESHAPE", m_mddn, NULL) \ + F(RMAX, "RMAX", m_m, NULL) \ + F(RMIN, "RMIN", m_m, NULL) \ + F(RND, "RND", m_e, NULL) \ + F(RNKORDER, "RNKORDER", m_m, NULL) \ + F(RSSQ, "RSSQ", m_m, NULL) \ + F(RSUM, "RSUM", m_m, NULL) \ + F(SIN, "SIN", m_e, NULL) \ + F(SOLVE, "SOLVE", m_mmn, NULL) \ + F(SQRT, "SQRT", m_e, "a>=0") \ + F(SSCP, "SSCP", m_m, NULL) \ + F(SVAL, "SVAL", m_m, NULL) \ + F(SWEEP, "SWEEP", m_mdn, NULL) \ + F(T, "T", m_m, NULL) \ + F(TRACE, "TRACE", d_m, NULL) \ + F(TRANSPOS, "TRANSPOS", m_m, NULL) \ + F(TRUNC, "TRUNC", m_e, NULL) \ + F(UNIFORM, "UNIFORM", m_ddn, "ai>=0 bi>=0") \ + F(PDF_BETA, "PDF.BETA", m_edd, "a[0,1] b>0 c>0") \ + F(CDF_BETA, "CDF.BETA", m_edd, "a[0,1] b>0 c>0") \ + F(IDF_BETA, "IDF.BETA", m_edd, "a[0,1] b>0 c>0") \ + F(RV_BETA, "RV.BETA", d_dd, "a>0 b>0") \ + F(NCDF_BETA, "NCDF.BETA", m_eddd, "a>=0 b>0 c>0 d>0") \ + F(NPDF_BETA, "NCDF.BETA", m_eddd, "a>=0 b>0 c>0 d>0") \ + F(CDF_BVNOR, "CDF.BVNOR", m_eed, "c[-1,1]") \ + F(PDF_BVNOR, "PDF.BVNOR", m_eed, "c[-1,1]") \ + F(CDF_CAUCHY, "CDF.CAUCHY", m_edd, "c>0") \ + F(IDF_CAUCHY, "IDF.CAUCHY", m_edd, "a(0,1) c>0") \ + F(PDF_CAUCHY, "PDF.CAUCHY", m_edd, "c>0") \ + F(RV_CAUCHY, "RV.CAUCHY", d_dd, "b>0") \ + F(CDF_CHISQ, "CDF.CHISQ", m_ed, "a>=0 b>0") \ + F(CHICDF, "CHICDF", m_ed, "a>=0 b>0") \ + F(IDF_CHISQ, "IDF.CHISQ", m_ed, "a[0,1) b>0") \ + F(PDF_CHISQ, "PDF.CHISQ", m_ed, "a>=0 b>0") \ + F(RV_CHISQ, "RV.CHISQ", d_d, "a>0") \ + F(SIG_CHISQ, "SIG.CHISQ", m_ed, "a>=0 b>0") \ + F(CDF_EXP, "CDF.EXP", m_ed, "a>=0 b>=0") \ + F(IDF_EXP, "IDF.EXP", m_ed, "a[0,1) b>0") \ + F(PDF_EXP, "PDF.EXP", m_ed, "a>=0 b>0") \ + F(RV_EXP, "RV.EXP", d_d, "a>0") \ + F(PDF_XPOWER, "PDF.XPOWER", m_edd, "b>0 c>=0") \ + F(RV_XPOWER, "RV.XPOWER", d_dd, "a>0 c>=0") \ + F(CDF_F, "CDF.F", m_edd, "a>=0 b>0 c>0") \ + F(FCDF, "FCDF", m_edd, "a>=0 b>0 c>0") \ + F(IDF_F, "IDF.F", m_edd, "a[0,1) b>0 c>0") \ + F(PDF_F, "PDF.F", m_edd, "a>=0 b>0 c>0") \ + F(RV_F, "RV.F", d_dd, "a>0 b>0") \ + F(SIG_F, "SIG.F", m_edd, "a>=0 b>0 c>0") \ + F(CDF_GAMMA, "CDF.GAMMA", m_edd, "a>=0 b>0 c>0") \ + F(IDF_GAMMA, "IDF.GAMMA", m_edd, "a[0,1] b>0 c>0") \ + F(PDF_GAMMA, "PDF.GAMMA", m_edd, "a>=0 b>0 c>0") \ + F(RV_GAMMA, "RV.GAMMA", d_dd, "a>0 b>0") \ + F(PDF_LANDAU, "PDF.LANDAU", m_e, NULL) \ + F(RV_LANDAU, "RV.LANDAU", d_none, NULL) \ + F(CDF_LAPLACE, "CDF.LAPLACE", m_edd, "c>0") \ + F(IDF_LAPLACE, "IDF.LAPLACE", m_edd, "a(0,1) c>0") \ + F(PDF_LAPLACE, "PDF.LAPLACE", m_edd, "c>0") \ + F(RV_LAPLACE, "RV.LAPLACE", d_dd, "b>0") \ + F(RV_LEVY, "RV.LEVY", d_dd, "b(0,2]") \ + F(RV_LVSKEW, "RV.LVSKEW", d_ddd, "b(0,2] c[-1,1]") \ + F(CDF_LOGISTIC, "CDF.LOGISTIC", m_edd, "c>0") \ + F(IDF_LOGISTIC, "IDF.LOGISTIC", m_edd, "a(0,1) c>0") \ + F(PDF_LOGISTIC, "PDF.LOGISTIC", m_edd, "c>0") \ + F(RV_LOGISTIC, "RV.LOGISTIC", d_dd, "b>0") \ + F(CDF_LNORMAL, "CDF.LNORMAL", m_edd, "a>=0 b>0 c>0") \ + F(IDF_LNORMAL, "IDF.LNORMAL", m_edd, "a[0,1) b>0 c>0") \ + F(PDF_LNORMAL, "PDF.LNORMAL", m_edd, "a>=0 b>0 c>0") \ + F(RV_LNORMAL, "RV.LNORMAL", d_dd, "a>0 b>0") \ + F(CDF_NORMAL, "CDF.NORMAL", m_edd, "c>0") \ + F(IDF_NORMAL, "IDF.NORMAL", m_edd, "a(0,1) c>0") \ + F(PDF_NORMAL, "PDF.NORMAL", m_edd, "c>0") \ + F(RV_NORMAL, "RV.NORMAL", d_dd, "b>0") \ + F(CDFNORM, "CDFNORM", m_e, NULL) \ + F(PROBIT, "PROBIT", m_e, "a(0,1)") \ + F(NORMAL, "NORMAL", m_e, "a>0") \ + F(PDF_NTAIL, "PDF.NTAIL", m_edd, "b>0 c>0") \ + F(RV_NTAIL, "RV.NTAIL", d_dd, "a>0 b>0") \ + F(CDF_PARETO, "CDF.PARETO", m_edd, "a>=b b>0 c>0") \ + F(IDF_PARETO, "IDF.PARETO", m_edd, "a[0,1) b>0 c>0") \ + F(PDF_PARETO, "PDF.PARETO", m_edd, "a>=b b>0 c>0") \ + F(RV_PARETO, "RV.PARETO", d_dd, "a>0 b>0") \ + F(CDF_RAYLEIGH, "CDF.RAYLEIGH", m_ed, "b>0") \ + F(IDF_RAYLEIGH, "IDF.RAYLEIGH", m_ed, "a[0,1] b>0") \ + F(PDF_RAYLEIGH, "PDF.RAYLEIGH", m_ed, "b>0") \ + F(RV_RAYLEIGH, "RV.RAYLEIGH", d_d, "a>0") \ + F(PDF_RTAIL, "PDF.RTAIL", m_edd, NULL) \ + F(RV_RTAIL, "RV.RTAIL", d_dd, NULL) \ + F(CDF_T, "CDF.T", m_ed, "b>0") \ + F(TCDF, "TCDF", m_ed, "b>0") \ + F(IDF_T, "IDF.T", m_ed, "a(0,1) b>0") \ + F(PDF_T, "PDF.T", m_ed, "b>0") \ + F(RV_T, "RV.T", d_d, "a>0") \ + F(CDF_T1G, "CDF.T1G", m_edd, NULL) \ + F(IDF_T1G, "IDF.T1G", m_edd, "a(0,1)") \ + F(PDF_T1G, "PDF.T1G", m_edd, NULL) \ + F(RV_T1G, "RV.T1G", d_dd, NULL) \ + F(CDF_T2G, "CDF.T2G", m_edd, NULL) \ + F(IDF_T2G, "IDF.T2G", m_edd, "a(0,1)") \ + F(PDF_T2G, "PDF.T2G", m_edd, NULL) \ + F(RV_T2G, "RV.T2G", d_dd, NULL) \ + F(CDF_UNIFORM, "CDF.UNIFORM", m_edd, "a<=c b<=c") \ + F(IDF_UNIFORM, "IDF.UNIFORM", m_edd, "a[0,1] b<=c") \ + F(PDF_UNIFORM, "PDF.UNIFORM", m_edd, "a<=c b<=c") \ + F(RV_UNIFORM, "RV.UNIFORM", d_dd, "a<=b") \ + F(CDF_WEIBULL, "CDF.WEIBULL", m_edd, "a>=0 b>0 c>0") \ + F(IDF_WEIBULL, "IDF.WEIBULL", m_edd, "a[0,1) b>0 c>0") \ + F(PDF_WEIBULL, "PDF.WEIBULL", m_edd, "a>=0 b>0 c>0") \ + F(RV_WEIBULL, "RV.WEIBULL", d_dd, "a>0 b>0") \ + F(CDF_BERNOULLI, "CDF.BERNOULLI", m_ed, "ai[0,1] b[0,1]") \ + F(PDF_BERNOULLI, "PDF.BERNOULLI", m_ed, "ai[0,1] b[0,1]") \ + F(RV_BERNOULLI, "RV.BERNOULLI", d_d, "a[0,1]") \ + F(CDF_BINOM, "CDF.BINOM", m_edd, "bi>0 c[0,1]") \ + F(PDF_BINOM, "PDF.BINOM", m_edd, "ai>=0<=b bi>0 c[0,1]") \ + F(RV_BINOM, "RV.BINOM", d_dd, "ai>0 b[0,1]") \ + F(CDF_GEOM, "CDF.GEOM", m_ed, "ai>=1 b[0,1]") \ + F(PDF_GEOM, "PDF.GEOM", m_ed, "ai>=1 b[0,1]") \ + F(RV_GEOM, "RV.GEOM", d_d, "a[0,1]") \ + F(CDF_HYPER, "CDF.HYPER", m_eddd, "ai>=0<=d bi>0 ci>0<=b di>0<=b") \ + F(PDF_HYPER, "PDF.HYPER", m_eddd, "ai>=0<=d bi>0 ci>0<=b di>0<=b") \ + F(RV_HYPER, "RV.HYPER", d_ddd, "ai>0 bi>0<=a ci>0<=a") \ + F(PDF_LOG, "PDF.LOG", m_ed, "a>=1 b(0,1]") \ + F(RV_LOG, "RV.LOG", d_d, "a(0,1]") \ + F(CDF_NEGBIN, "CDF.NEGBIN", m_edd, "a>=1 bi c(0,1]") \ + F(PDF_NEGBIN, "PDF.NEGBIN", m_edd, "a>=1 bi c(0,1]") \ + F(RV_NEGBIN, "RV.NEGBIN", d_dd, "ai b(0,1]") \ + F(CDF_POISSON, "CDF.POISSON", m_ed, "ai>=0 b>0") \ + F(PDF_POISSON, "PDF.POISSON", m_ed, "ai>=0 b>0") \ + F(RV_POISSON, "RV.POISSON", d_d, "a>0") + +/* Properties of a matrix function. + + These come straight from the macro invocations above. */ +struct matrix_function_properties + { + const char *name; + const char *constraints; + }; + +/* Minimum and maximum argument counts for each matrix function prototype. */ +enum { IDENT_MIN_ARGS = 1, IDENT_MAX_ARGS = 2 }; +enum { d_d_MIN_ARGS = 1, d_d_MAX_ARGS = 1 }; +enum { d_dd_MIN_ARGS = 2, d_dd_MAX_ARGS = 2 }; +enum { d_ddd_MIN_ARGS = 3, d_ddd_MAX_ARGS = 3 }; +enum { d_m_MIN_ARGS = 1, d_m_MAX_ARGS = 1 }; +enum { d_none_MIN_ARGS = 0, d_none_MAX_ARGS = 0 }; +enum { m_any_MIN_ARGS = 1, m_any_MAX_ARGS = INT_MAX }; +enum { m_d_MIN_ARGS = 1, m_d_MAX_ARGS = 1 }; +enum { m_ddd_MIN_ARGS = 3, m_ddd_MAX_ARGS = 3 }; +enum { m_ddn_MIN_ARGS = 2, m_ddn_MAX_ARGS = 2 }; +enum { m_e_MIN_ARGS = 1, m_e_MAX_ARGS = 1 }; +enum { m_ed_MIN_ARGS = 2, m_ed_MAX_ARGS = 2 }; +enum { m_edd_MIN_ARGS = 3, m_edd_MAX_ARGS = 3 }; +enum { m_eddd_MIN_ARGS = 4, m_eddd_MAX_ARGS = 4 }; +enum { m_eed_MIN_ARGS = 3, m_eed_MAX_ARGS = 3 }; +enum { m_m_MIN_ARGS = 1, m_m_MAX_ARGS = 1 }; +enum { m_md_MIN_ARGS = 2, m_md_MAX_ARGS = 2 }; +enum { m_mddn_MIN_ARGS = 3, m_mddn_MAX_ARGS = 3 }; +enum { m_mdn_MIN_ARGS = 2, m_mdn_MAX_ARGS = 2 }; +enum { m_mm_MIN_ARGS = 2, m_mm_MAX_ARGS = 2 }; +enum { m_mmn_MIN_ARGS = 2, m_mmn_MAX_ARGS = 2 }; +enum { m_mn_MIN_ARGS = 1, m_mn_MAX_ARGS = 1 }; +enum { m_v_MIN_ARGS = 1, m_v_MAX_ARGS = 1 }; + +/* C function prototype for each matrix function prototype. */ +typedef double matrix_proto_d_none (void); +typedef double matrix_proto_d_d (double); +typedef double matrix_proto_d_dd (double, double); +typedef double matrix_proto_d_dd (double, double); +typedef double matrix_proto_d_ddd (double, double, double); +typedef gsl_matrix *matrix_proto_m_d (double); +typedef gsl_matrix *matrix_proto_m_ddd (double, double, double); +typedef gsl_matrix *matrix_proto_m_ddn (double, double, + const struct matrix_expr *); +typedef gsl_matrix *matrix_proto_m_m (gsl_matrix *); +typedef gsl_matrix *matrix_proto_m_mn (gsl_matrix *, + const struct matrix_expr *); +typedef double matrix_proto_m_e (double); +typedef gsl_matrix *matrix_proto_m_md (gsl_matrix *, double); +typedef gsl_matrix *matrix_proto_m_mdn (gsl_matrix *, double, + const struct matrix_expr *); +typedef double matrix_proto_m_ed (double, double); +typedef gsl_matrix *matrix_proto_m_mddn (gsl_matrix *, double, double, + const struct matrix_expr *); +typedef double matrix_proto_m_edd (double, double, double); +typedef double matrix_proto_m_eddd (double, double, double, double); +typedef double matrix_proto_m_eed (double, double, double); +typedef gsl_matrix *matrix_proto_m_mm (gsl_matrix *, gsl_matrix *); +typedef gsl_matrix *matrix_proto_m_mmn (gsl_matrix *, gsl_matrix *, + const struct matrix_expr *); +typedef gsl_matrix *matrix_proto_m_v (gsl_vector *); +typedef double matrix_proto_d_m (gsl_matrix *); +typedef gsl_matrix *matrix_proto_m_any (gsl_matrix *[], size_t n); +typedef gsl_matrix *matrix_proto_IDENT (double, double); + +#define F(ENUM, STRING, PROTO, CONSTRAINTS) \ + static matrix_proto_##PROTO matrix_eval_##ENUM; +MATRIX_FUNCTIONS +#undef F + +/* Matrix expression data structure and parsing. */ + +/* A node in a matrix expression. */ +struct matrix_expr + { + enum matrix_op + { + /* Functions. */ +#define F(ENUM, STRING, PROTO, CONSTRAINTS) MOP_F_##ENUM, + MATRIX_FUNCTIONS +#undef F + + /* Elementwise and scalar arithmetic. */ + MOP_NEGATE, /* unary - */ + MOP_ADD_ELEMS, /* + */ + MOP_SUB_ELEMS, /* - */ + MOP_MUL_ELEMS, /* &* */ + MOP_DIV_ELEMS, /* / and &/ */ + MOP_EXP_ELEMS, /* &** */ + MOP_SEQ, /* a:b */ + MOP_SEQ_BY, /* a:b:c */ + + /* Matrix arithmetic. */ + MOP_MUL_MAT, /* * */ + MOP_EXP_MAT, /* ** */ + + /* Relational. */ + MOP_GT, /* > */ + MOP_GE, /* >= */ + MOP_LT, /* < */ + MOP_LE, /* <= */ + MOP_EQ, /* = */ + MOP_NE, /* <> */ + + /* Logical. */ + MOP_NOT, /* NOT */ + MOP_AND, /* AND */ + MOP_OR, /* OR */ + MOP_XOR, /* XOR */ + + /* {}. */ + MOP_PASTE_HORZ, /* a, b, c, ... */ + MOP_PASTE_VERT, /* a; b; c; ... */ + MOP_EMPTY, /* {} */ + + /* Sub-matrices. */ + MOP_VEC_INDEX, /* x(y) */ + MOP_VEC_ALL, /* x(:) */ + MOP_MAT_INDEX, /* x(y,z) */ + MOP_ROW_INDEX, /* x(y,:) */ + MOP_COL_INDEX, /* x(:,z) */ + + /* Literals. */ + MOP_NUMBER, + MOP_VARIABLE, + + /* Oddball stuff. */ + MOP_EOF, /* EOF('file') */ + } + op; + + union + { + /* Nonterminal expression nodes. */ + struct + { + struct matrix_expr **subs; + size_t n_subs; + }; + + /* Terminal expression nodes. */ + double number; /* MOP_NUMBER. */ + struct matrix_var *variable; /* MOP_VARIABLE. */ + struct read_file *eof; /* MOP_EOF. */ + }; + + /* The syntax location corresponding to this expression node, for use in + error messages. This is always nonnull for terminal expression nodes. + For most others, it is null because it can be computed lazily if and + when it is needed. + + Use matrix_expr_location() instead of using this member directly, so + that it gets computed lazily if needed. */ + struct msg_location *location; + }; + +static void +matrix_expr_location__ (const struct matrix_expr *e, + const struct msg_location **minp, + const struct msg_location **maxp) +{ + struct msg_location *loc = e->location; + if (loc) + { + const struct msg_location *min = *minp; + if (loc->start.line + && (!min + || loc->start.line < min->start.line + || (loc->start.line == min->start.line + && loc->start.column < min->start.column))) + *minp = loc; + + const struct msg_location *max = *maxp; + if (loc->end.line + && (!max + || loc->end.line > max->end.line + || (loc->end.line == max->end.line + && loc->end.column > max->end.column))) + *maxp = loc; + + return; + } + + assert (e->op != MOP_NUMBER && e->op != MOP_VARIABLE && e->op != MOP_EOF); + for (size_t i = 0; i < e->n_subs; i++) + matrix_expr_location__ (e->subs[i], minp, maxp); +} + +/* Returns the source code location corresponding to expression E, computing it + lazily if needed. */ +static const struct msg_location * +matrix_expr_location (const struct matrix_expr *e_) +{ + struct matrix_expr *e = CONST_CAST (struct matrix_expr *, e_); + if (!e) + return NULL; + + if (!e->location) + { + const struct msg_location *min = NULL; + const struct msg_location *max = NULL; + matrix_expr_location__ (e, &min, &max); + if (min && max) + { + e->location = msg_location_dup (min); + e->location->end = max->end; + } + } + return e->location; +} + +/* Sets e->location to the tokens in S's lexer from offset START_OFS to the + token before the current one. Has no effect if E already has a location or + if E is null. */ +static void +matrix_expr_add_location (struct matrix_state *s, int start_ofs, + struct matrix_expr *e) +{ + if (e && !e->location) + e->location = lex_ofs_location (s->lexer, start_ofs, + lex_ofs (s->lexer) - 1); +} + +/* Frees E and all the data and sub-expressions that it references. */ +static void +matrix_expr_destroy (struct matrix_expr *e) +{ + if (!e) + return; + + switch (e->op) + { +#define F(ENUM, STRING, PROTO, CONSTRAINTS) case MOP_F_##ENUM: +MATRIX_FUNCTIONS +#undef F + case MOP_NEGATE: + case MOP_ADD_ELEMS: + case MOP_SUB_ELEMS: + case MOP_MUL_ELEMS: + case MOP_DIV_ELEMS: + case MOP_EXP_ELEMS: + case MOP_SEQ: + case MOP_SEQ_BY: + case MOP_MUL_MAT: + case MOP_EXP_MAT: + case MOP_GT: + case MOP_GE: + case MOP_LT: + case MOP_LE: + case MOP_EQ: + case MOP_NE: + case MOP_NOT: + case MOP_AND: + case MOP_OR: + case MOP_XOR: + case MOP_EMPTY: + case MOP_PASTE_HORZ: + case MOP_PASTE_VERT: + case MOP_VEC_INDEX: + case MOP_VEC_ALL: + case MOP_MAT_INDEX: + case MOP_ROW_INDEX: + case MOP_COL_INDEX: + for (size_t i = 0; i < e->n_subs; i++) + matrix_expr_destroy (e->subs[i]); + free (e->subs); + break; + + case MOP_NUMBER: + case MOP_VARIABLE: + case MOP_EOF: + break; + } + msg_location_destroy (e->location); + free (e); +} + +/* Creates and returns a new matrix_expr with type OP, which must be a + nonterminal type. Initializes the new matrix_expr with the N_SUBS + expressions in SUBS as subexpressions. */ +static struct matrix_expr * +matrix_expr_create_subs (enum matrix_op op, struct matrix_expr **subs, + size_t n_subs) +{ + struct matrix_expr *e = xmalloc (sizeof *e); + *e = (struct matrix_expr) { + .op = op, + .subs = xmemdup (subs, n_subs * sizeof *subs), + .n_subs = n_subs + }; + return e; +} + +static struct matrix_expr * +matrix_expr_create_0 (enum matrix_op op) +{ + struct matrix_expr *sub; + return matrix_expr_create_subs (op, &sub, 0); +} + +static struct matrix_expr * +matrix_expr_create_1 (enum matrix_op op, struct matrix_expr *sub) +{ + return matrix_expr_create_subs (op, &sub, 1); +} + +static struct matrix_expr * +matrix_expr_create_2 (enum matrix_op op, + struct matrix_expr *sub0, struct matrix_expr *sub1) +{ + struct matrix_expr *subs[] = { sub0, sub1 }; + return matrix_expr_create_subs (op, subs, sizeof subs / sizeof *subs); +} + +static struct matrix_expr * +matrix_expr_create_3 (enum matrix_op op, struct matrix_expr *sub0, + struct matrix_expr *sub1, struct matrix_expr *sub2) +{ + struct matrix_expr *subs[] = { sub0, sub1, sub2 }; + return matrix_expr_create_subs (op, subs, sizeof subs / sizeof *subs); +} + +/* Creates and returns a new MOP_NUMBER expression node to contain NUMBER. */ +static struct matrix_expr * +matrix_expr_create_number (double number) +{ + struct matrix_expr *e = xmalloc (sizeof *e); + *e = (struct matrix_expr) { + .op = MOP_NUMBER, + .number = number, + }; + return e; +} + +static struct matrix_expr *matrix_expr_parse (struct matrix_state *); + +/* A binary operator for matrix_parse_binary_operator(). */ +struct matrix_operator_syntax + { + /* Exactly one of these specifies the operator syntax. */ + enum token_type token; /* A token, e.g. T_ASTERISK. */ + const char *id; /* An identifier, e.g. "XOR". */ + const char *phrase; /* A token phrase, e.g. "&**". */ + + /* The matrix operator corresponding to the syntax. */ + enum matrix_op op; + }; + +static bool +matrix_operator_syntax_match (struct lexer *lexer, + const struct matrix_operator_syntax *syntax, + size_t n_syntax, enum matrix_op *op) +{ + const struct matrix_operator_syntax *end = &syntax[n_syntax]; + for (const struct matrix_operator_syntax *syn = syntax; syn < end; syn++) + if (syn->id ? lex_match_id (lexer, syn->id) + : syn->phrase ? lex_match_phrase (lexer, syn->phrase) + : lex_match (lexer, syn->token)) + { + *op = syn->op; + return true; + } + return false; +} + +/* Parses a binary operator level in the recursive descent parser, returning a + matrix expression if successful or a null pointer otherwise. PARSE_NEXT + must be the function to parse the next level of precedence. The N_SYNTAX + elements of SYNTAX must specify the syntax and matrix_expr node type to + parse at this level. */ +static struct matrix_expr * +matrix_parse_binary_operator ( + struct matrix_state *s, + struct matrix_expr *(*parse_next) (struct matrix_state *), + const struct matrix_operator_syntax *syntax, size_t n_syntax) +{ + struct matrix_expr *lhs = parse_next (s); + if (!lhs) + return NULL; + + for (;;) + { + enum matrix_op op; + if (!matrix_operator_syntax_match (s->lexer, syntax, n_syntax, &op)) + return lhs; + + struct matrix_expr *rhs = parse_next (s); + if (!rhs) + { + matrix_expr_destroy (lhs); + return NULL; + } + lhs = matrix_expr_create_2 (op, lhs, rhs); + } +} + +/* Parses a comma-separated list of expressions within {}, transforming them + into MOP_PASTE_HORZ operators. Returns the new expression or NULL on + error. */ +static struct matrix_expr * +matrix_parse_curly_comma (struct matrix_state *s) +{ + static const struct matrix_operator_syntax op = { + .token = T_COMMA, .op = MOP_PASTE_HORZ + }; + return matrix_parse_binary_operator (s, matrix_expr_parse, &op, 1); +} + +/* Parses a semicolon-separated list of expressions within {}, transforming + them into MOP_PASTE_VERT operators. Returns the new expression or NULL on + error. */ +static struct matrix_expr * +matrix_parse_curly_semi (struct matrix_state *s) +{ + if (lex_token (s->lexer) == T_RCURLY) + { + /* {} is a special case for a 0×0 matrix. */ + return matrix_expr_create_0 (MOP_EMPTY); + } + + static const struct matrix_operator_syntax op = { + .token = T_SEMICOLON, .op = MOP_PASTE_VERT + }; + return matrix_parse_binary_operator (s, matrix_parse_curly_comma, &op, 1); +} + +struct matrix_function + { + const char *name; + enum matrix_op op; + size_t min_args, max_args; + }; + +static struct matrix_expr *matrix_expr_parse (struct matrix_state *); + +static bool +word_matches (const char **test, const char **name) +{ + size_t test_len = strcspn (*test, "."); + size_t name_len = strcspn (*name, "."); + if (test_len == name_len) + { + if (buf_compare_case (*test, *name, test_len)) + return false; + } + else if (test_len < 3 || test_len > name_len) + return false; + else + { + if (buf_compare_case (*test, *name, test_len)) + return false; + } + + *test += test_len; + *name += name_len; + if (**test != **name) + return false; + + if (**test == '.') + { + (*test)++; + (*name)++; + } + return true; +} + +/* Returns 0 if TOKEN and FUNC do not match, + 1 if TOKEN is an acceptable abbreviation for FUNC, + 2 if TOKEN equals FUNC. */ +static int +compare_function_names (const char *token_, const char *func_) +{ + const char *token = token_; + const char *func = func_; + while (*token || *func) + if (!word_matches (&token, &func)) + return 0; + return !c_strcasecmp (token_, func_) ? 2 : 1; +} + +static const struct matrix_function * +matrix_parse_function_name (const char *token) +{ + static const struct matrix_function functions[] = + { +#define F(ENUM, STRING, PROTO, CONSTRAINTS) \ + { STRING, MOP_F_##ENUM, PROTO##_MIN_ARGS, PROTO##_MAX_ARGS }, + MATRIX_FUNCTIONS +#undef F + }; + enum { N_FUNCTIONS = sizeof functions / sizeof *functions }; + + for (size_t i = 0; i < N_FUNCTIONS; i++) + { + if (compare_function_names (token, functions[i].name) > 0) + return &functions[i]; + } + return NULL; +} + +static bool +matrix_parse_function (struct matrix_state *s, const char *token, + struct matrix_expr **exprp) +{ + *exprp = NULL; + if (lex_next_token (s->lexer, 1) != T_LPAREN) + return false; + + int start_ofs = lex_ofs (s->lexer); + if (lex_match_id (s->lexer, "EOF")) + { + lex_get (s->lexer); + struct file_handle *fh = fh_parse (s->lexer, FH_REF_FILE, s->session); + if (!fh) + return true; + + if (!lex_force_match (s->lexer, T_RPAREN)) + { + fh_unref (fh); + return true; + } + + struct read_file *rf = read_file_create (s, fh); + + struct matrix_expr *e = xmalloc (sizeof *e); + *e = (struct matrix_expr) { .op = MOP_EOF, .eof = rf }; + matrix_expr_add_location (s, start_ofs, e); + *exprp = e; + return true; + } + + const struct matrix_function *f = matrix_parse_function_name (token); + if (!f) + return false; + + struct matrix_expr *e = xmalloc (sizeof *e); + *e = (struct matrix_expr) { .op = f->op }; + + lex_get_n (s->lexer, 2); + if (lex_token (s->lexer) != T_RPAREN) + { + size_t allocated_subs = 0; + do + { + struct matrix_expr *sub = matrix_expr_parse (s); + if (!sub) + goto error; + + if (e->n_subs >= allocated_subs) + e->subs = x2nrealloc (e->subs, &allocated_subs, sizeof *e->subs); + e->subs[e->n_subs++] = sub; + } + while (lex_match (s->lexer, T_COMMA)); + } + if (!lex_force_match (s->lexer, T_RPAREN)) + goto error; + + if (e->n_subs < f->min_args || e->n_subs > f->max_args) + { + if (f->min_args == f->max_args) + msg_at (SE, e->location, + ngettext ("Matrix function %s requires %zu argument.", + "Matrix function %s requires %zu arguments.", + f->min_args), + f->name, f->min_args); + else if (f->min_args == 1 && f->max_args == 2) + msg_at (SE, e->location, + ngettext ("Matrix function %s requires 1 or 2 arguments, " + "but %zu was provided.", + "Matrix function %s requires 1 or 2 arguments, " + "but %zu were provided.", + e->n_subs), + f->name, e->n_subs); + else if (f->min_args == 1 && f->max_args == INT_MAX) + msg_at (SE, e->location, + _("Matrix function %s requires at least one argument."), + f->name); + else + NOT_REACHED (); + + goto error; + } + + matrix_expr_add_location (s, start_ofs, e); + + *exprp = e; + return true; + +error: + matrix_expr_destroy (e); + return true; +} + +static struct matrix_expr * +matrix_parse_primary__ (struct matrix_state *s) +{ + if (lex_is_number (s->lexer)) + { + double number = lex_number (s->lexer); + lex_get (s->lexer); + + return matrix_expr_create_number (number); + } + else if (lex_is_string (s->lexer)) + { + char string[sizeof (double)]; + buf_copy_str_rpad (string, sizeof string, lex_tokcstr (s->lexer), ' '); + lex_get (s->lexer); + + double number; + memcpy (&number, string, sizeof number); + + return matrix_expr_create_number (number); + } + else if (lex_match (s->lexer, T_LPAREN)) + { + struct matrix_expr *e = matrix_expr_parse (s); + if (!e || !lex_force_match (s->lexer, T_RPAREN)) + { + matrix_expr_destroy (e); + return NULL; + } + return e; + } + else if (lex_match (s->lexer, T_LCURLY)) + { + struct matrix_expr *e = matrix_parse_curly_semi (s); + if (!e || !lex_force_match (s->lexer, T_RCURLY)) + { + matrix_expr_destroy (e); + return NULL; + } + return e; + } + else if (lex_token (s->lexer) == T_ID) + { + struct matrix_expr *retval; + if (matrix_parse_function (s, lex_tokcstr (s->lexer), &retval)) + return retval; + + struct matrix_var *var = matrix_var_lookup (s, lex_tokss (s->lexer)); + if (!var) + { + lex_error (s->lexer, _("Unknown variable %s."), + lex_tokcstr (s->lexer)); + return NULL; + } + lex_get (s->lexer); + + struct matrix_expr *e = xmalloc (sizeof *e); + *e = (struct matrix_expr) { .op = MOP_VARIABLE, .variable = var }; + return e; + } + else if (lex_token (s->lexer) == T_ALL) + { + struct matrix_expr *retval; + if (matrix_parse_function (s, "ALL", &retval)) + return retval; + } + + lex_error (s->lexer, NULL); + return NULL; +} + +static struct matrix_expr * +matrix_parse_primary (struct matrix_state *s) +{ + int start_ofs = lex_ofs (s->lexer); + struct matrix_expr *e = matrix_parse_primary__ (s); + matrix_expr_add_location (s, start_ofs, e); + return e; +} + +static struct matrix_expr *matrix_parse_postfix (struct matrix_state *); + +static bool +matrix_parse_index_expr (struct matrix_state *s, + struct matrix_expr **indexp, + struct msg_location **locationp) +{ + if (lex_match (s->lexer, T_COLON)) + { + if (locationp) + *locationp = lex_get_location (s->lexer, -1, -1); + *indexp = NULL; + return true; + } + else + { + *indexp = matrix_expr_parse (s); + if (locationp && *indexp) + *locationp = msg_location_dup (matrix_expr_location (*indexp)); + return *indexp != NULL; + } +} + +static struct matrix_expr * +matrix_parse_postfix (struct matrix_state *s) +{ + struct matrix_expr *lhs = matrix_parse_primary (s); + if (!lhs || !lex_match (s->lexer, T_LPAREN)) + return lhs; + + struct matrix_expr *i0; + if (!matrix_parse_index_expr (s, &i0, NULL)) + { + matrix_expr_destroy (lhs); + return NULL; + } + if (lex_match (s->lexer, T_RPAREN)) + return (i0 + ? matrix_expr_create_2 (MOP_VEC_INDEX, lhs, i0) + : matrix_expr_create_1 (MOP_VEC_ALL, lhs)); + else if (lex_match (s->lexer, T_COMMA)) + { + struct matrix_expr *i1; + if (!matrix_parse_index_expr (s, &i1, NULL) + || !lex_force_match (s->lexer, T_RPAREN)) + { + matrix_expr_destroy (lhs); + matrix_expr_destroy (i0); + matrix_expr_destroy (i1); + return NULL; + } + return (i0 && i1 ? matrix_expr_create_3 (MOP_MAT_INDEX, lhs, i0, i1) + : i0 ? matrix_expr_create_2 (MOP_ROW_INDEX, lhs, i0) + : i1 ? matrix_expr_create_2 (MOP_COL_INDEX, lhs, i1) + : lhs); + } + else + { + lex_error_expecting (s->lexer, "`)'", "`,'"); + return NULL; + } +} + +static struct matrix_expr * +matrix_parse_unary (struct matrix_state *s) +{ + int start_ofs = lex_ofs (s->lexer); + + struct matrix_expr *e; + if (lex_match (s->lexer, T_DASH)) + { + struct matrix_expr *sub = matrix_parse_unary (s); + if (!sub) + return NULL; + e = matrix_expr_create_1 (MOP_NEGATE, sub); + } + else if (lex_match (s->lexer, T_PLUS)) + { + e = matrix_parse_unary (s); + if (!e) + return NULL; + } + else + return matrix_parse_postfix (s); + + matrix_expr_add_location (s, start_ofs, e); + e->location->start = lex_ofs_start_point (s->lexer, start_ofs); + return e; +} + +static struct matrix_expr * +matrix_parse_seq (struct matrix_state *s) +{ + struct matrix_expr *start = matrix_parse_unary (s); + if (!start || !lex_match (s->lexer, T_COLON)) + return start; + + struct matrix_expr *end = matrix_parse_unary (s); + if (!end) + { + matrix_expr_destroy (start); + return NULL; + } + + if (lex_match (s->lexer, T_COLON)) + { + struct matrix_expr *increment = matrix_parse_unary (s); + if (!increment) + { + matrix_expr_destroy (start); + matrix_expr_destroy (end); + return NULL; + } + return matrix_expr_create_3 (MOP_SEQ_BY, start, end, increment); + } + else + return matrix_expr_create_2 (MOP_SEQ, start, end); +} + +static struct matrix_expr * +matrix_parse_exp (struct matrix_state *s) +{ + static const struct matrix_operator_syntax syntax[] = { + { .token = T_EXP, .op = MOP_EXP_MAT }, + { .phrase = "&**", .op = MOP_EXP_ELEMS }, + }; + size_t n_syntax = sizeof syntax / sizeof *syntax; + + return matrix_parse_binary_operator (s, matrix_parse_seq, syntax, n_syntax); +} + +static struct matrix_expr * +matrix_parse_mul_div (struct matrix_state *s) +{ + static const struct matrix_operator_syntax syntax[] = { + { .token = T_ASTERISK, .op = MOP_MUL_MAT }, + { .token = T_SLASH, .op = MOP_DIV_ELEMS }, + { .phrase = "&*", .op = MOP_MUL_ELEMS }, + { .phrase = "&/", .op = MOP_DIV_ELEMS }, + }; + size_t n_syntax = sizeof syntax / sizeof *syntax; + + return matrix_parse_binary_operator (s, matrix_parse_exp, syntax, n_syntax); +} + +static struct matrix_expr * +matrix_parse_add_sub (struct matrix_state *s) +{ + struct matrix_expr *lhs = matrix_parse_mul_div (s); + if (!lhs) + return NULL; + + for (;;) + { + enum matrix_op op; + if (lex_match (s->lexer, T_PLUS)) + op = MOP_ADD_ELEMS; + else if (lex_match (s->lexer, T_DASH)) + op = MOP_SUB_ELEMS; + else if (lex_token (s->lexer) == T_NEG_NUM) + op = MOP_ADD_ELEMS; + else + return lhs; + + struct matrix_expr *rhs = matrix_parse_mul_div (s); + if (!rhs) + { + matrix_expr_destroy (lhs); + return NULL; + } + lhs = matrix_expr_create_2 (op, lhs, rhs); + } +} + +static struct matrix_expr * +matrix_parse_relational (struct matrix_state *s) +{ + static const struct matrix_operator_syntax syntax[] = { + { .token = T_GT, .op = MOP_GT }, + { .token = T_GE, .op = MOP_GE }, + { .token = T_LT, .op = MOP_LT }, + { .token = T_LE, .op = MOP_LE }, + { .token = T_EQUALS, .op = MOP_EQ }, + { .token = T_EQ, .op = MOP_EQ }, + { .token = T_NE, .op = MOP_NE }, + }; + size_t n_syntax = sizeof syntax / sizeof *syntax; + + return matrix_parse_binary_operator (s, matrix_parse_add_sub, + syntax, n_syntax); +} + +static struct matrix_expr * +matrix_parse_not (struct matrix_state *s) +{ + int start_ofs = lex_ofs (s->lexer); + if (lex_match (s->lexer, T_NOT)) + { + struct matrix_expr *sub = matrix_parse_not (s); + if (!sub) + return NULL; + + struct matrix_expr *e = matrix_expr_create_1 (MOP_NOT, sub); + matrix_expr_add_location (s, start_ofs, e); + e->location->start = lex_ofs_start_point (s->lexer, start_ofs); + return e; + } + else + return matrix_parse_relational (s); +} + +static struct matrix_expr * +matrix_parse_and (struct matrix_state *s) +{ + static const struct matrix_operator_syntax op = { + .token = T_AND, .op = MOP_AND + }; + + return matrix_parse_binary_operator (s, matrix_parse_not, &op, 1); +} + +static struct matrix_expr * +matrix_expr_parse__ (struct matrix_state *s) +{ + static const struct matrix_operator_syntax syntax[] = { + { .token = T_OR, .op = MOP_OR }, + { .id = "XOR", .op = MOP_XOR }, + }; + size_t n_syntax = sizeof syntax / sizeof *syntax; + + return matrix_parse_binary_operator (s, matrix_parse_and, syntax, n_syntax); +} + +static struct matrix_expr * +matrix_expr_parse (struct matrix_state *s) +{ + int start_ofs = lex_ofs (s->lexer); + struct matrix_expr *e = matrix_expr_parse__ (s); + matrix_expr_add_location (s, start_ofs, e); + return e; +} + +/* Matrix expression evaluation. */ + +/* Iterates over all the elements in matrix M, setting Y and X to the row and + column indexes, respectively, and pointing D to the entry at each + position. */ +#define MATRIX_FOR_ALL_ELEMENTS(D, Y, X, M) \ + for (size_t Y = 0; Y < (M)->size1; Y++) \ + for (size_t X = 0; X < (M)->size2; X++) \ + for (double *D = gsl_matrix_ptr ((M), Y, X); D; D = NULL) + +static bool +is_vector (const gsl_matrix *m) +{ + return m->size1 <= 1 || m->size2 <= 1; +} + +static gsl_vector +to_vector (gsl_matrix *m) +{ + return (m->size1 == 1 + ? gsl_matrix_row (m, 0).vector + : gsl_matrix_column (m, 0).vector); +} + +static double +matrix_eval_ABS (double d) +{ + return fabs (d); +} + +static double +matrix_eval_ALL (gsl_matrix *m) +{ + MATRIX_FOR_ALL_ELEMENTS (d, y, x, m) + if (*d == 0.0) + return 0.0; + return 1.0; +} + +static double +matrix_eval_ANY (gsl_matrix *m) +{ + MATRIX_FOR_ALL_ELEMENTS (d, y, x, m) + if (*d != 0.0) + return 1.0; + return 0.0; +} + +static double +matrix_eval_ARSIN (double d) +{ + return asin (d); +} + +static double +matrix_eval_ARTAN (double d) +{ + return atan (d); +} + +static gsl_matrix * +matrix_eval_BLOCK (gsl_matrix *m[], size_t n) +{ + size_t r = 0; + size_t c = 0; + for (size_t i = 0; i < n; i++) + { + r += m[i]->size1; + c += m[i]->size2; + } + gsl_matrix *block = gsl_matrix_calloc (r, c); + r = c = 0; + for (size_t i = 0; i < n; i++) + { + for (size_t y = 0; y < m[i]->size1; y++) + for (size_t x = 0; x < m[i]->size2; x++) + gsl_matrix_set (block, r + y, c + x, gsl_matrix_get (m[i], y, x)); + r += m[i]->size1; + c += m[i]->size2; + } + return block; +} + +static gsl_matrix * +matrix_eval_CHOL (gsl_matrix *m, const struct matrix_expr *e) +{ + if (!gsl_linalg_cholesky_decomp1 (m)) + { + for (size_t y = 0; y < m->size1; y++) + for (size_t x = y + 1; x < m->size2; x++) + gsl_matrix_set (m, y, x, gsl_matrix_get (m, x, y)); + + for (size_t y = 0; y < m->size1; y++) + for (size_t x = 0; x < y; x++) + gsl_matrix_set (m, y, x, 0); + return m; + } + else + { + msg_at (SE, e->subs[0]->location, + _("Input to CHOL function is not positive-definite.")); + return NULL; + } +} + +static gsl_matrix * +matrix_eval_col_extremum (gsl_matrix *m, bool min) +{ + if (m->size1 <= 1) + return m; + else if (!m->size2) + return gsl_matrix_alloc (1, 0); + + gsl_matrix *cext = gsl_matrix_alloc (1, m->size2); + for (size_t x = 0; x < m->size2; x++) + { + double ext = gsl_matrix_get (m, 0, x); + for (size_t y = 1; y < m->size1; y++) + { + double value = gsl_matrix_get (m, y, x); + if (min ? value < ext : value > ext) + ext = value; + } + gsl_matrix_set (cext, 0, x, ext); + } + return cext; +} + +static gsl_matrix * +matrix_eval_CMAX (gsl_matrix *m) +{ + return matrix_eval_col_extremum (m, false); +} + +static gsl_matrix * +matrix_eval_CMIN (gsl_matrix *m) +{ + return matrix_eval_col_extremum (m, true); +} + +static double +matrix_eval_COS (double d) +{ + return cos (d); +} + +static gsl_matrix * +matrix_eval_col_sum (gsl_matrix *m, bool square) +{ + if (m->size1 == 0) + return m; + else if (!m->size2) + return gsl_matrix_alloc (1, 0); + + gsl_matrix *result = gsl_matrix_alloc (1, m->size2); + for (size_t x = 0; x < m->size2; x++) + { + double sum = 0; + for (size_t y = 0; y < m->size1; y++) + { + double d = gsl_matrix_get (m, y, x); + sum += square ? pow2 (d) : d; + } + gsl_matrix_set (result, 0, x, sum); + } + return result; +} + +static gsl_matrix * +matrix_eval_CSSQ (gsl_matrix *m) +{ + return matrix_eval_col_sum (m, true); +} + +static gsl_matrix * +matrix_eval_CSUM (gsl_matrix *m) +{ + return matrix_eval_col_sum (m, false); +} + +static int +compare_double_3way (const void *a_, const void *b_) +{ + const double *a = a_; + const double *b = b_; + return *a < *b ? -1 : *a > *b; +} + +static gsl_matrix * +matrix_eval_DESIGN (gsl_matrix *m, const struct matrix_expr *e) +{ + double *tmp = xmalloc (m->size1 * m->size2 * sizeof *tmp); + gsl_matrix m2 = gsl_matrix_view_array (tmp, m->size2, m->size1).matrix; + gsl_matrix_transpose_memcpy (&m2, m); + + for (size_t y = 0; y < m2.size1; y++) + qsort (tmp + y * m2.size2, m2.size2, sizeof *tmp, compare_double_3way); + + size_t *n = xcalloc (m2.size1, sizeof *n); + size_t n_total = 0; + for (size_t i = 0; i < m2.size1; i++) + { + double *row = tmp + m2.size2 * i; + for (size_t j = 0; j < m2.size2; ) + { + size_t k; + for (k = j + 1; k < m2.size2; k++) + if (row[j] != row[k]) + break; + row[n[i]++] = row[j]; + j = k; + } + + if (n[i] <= 1) + msg_at (MW, e->subs[0]->location, + _("Column %zu in DESIGN argument has constant value."), i + 1); + else + n_total += n[i]; + } + + gsl_matrix *result = gsl_matrix_alloc (m->size1, n_total); + size_t x = 0; + for (size_t i = 0; i < m->size2; i++) + { + if (n[i] <= 1) + continue; + + const double *unique = tmp + m2.size2 * i; + for (size_t j = 0; j < n[i]; j++, x++) + { + double value = unique[j]; + for (size_t y = 0; y < m->size1; y++) + gsl_matrix_set (result, y, x, gsl_matrix_get (m, y, i) == value); + } + } + + free (n); + free (tmp); + + return result; +} + +static double +matrix_eval_DET (gsl_matrix *m) +{ + gsl_permutation *p = gsl_permutation_alloc (m->size1); + int signum; + gsl_linalg_LU_decomp (m, p, &signum); + gsl_permutation_free (p); + return gsl_linalg_LU_det (m, signum); +} + +static gsl_matrix * +matrix_eval_DIAG (gsl_matrix *m) +{ + gsl_matrix *diag = gsl_matrix_alloc (MIN (m->size1, m->size2), 1); + for (size_t i = 0; i < diag->size1; i++) + gsl_matrix_set (diag, i, 0, gsl_matrix_get (m, i, i)); + return diag; +} + +static bool +is_symmetric (const gsl_matrix *m) +{ + if (m->size1 != m->size2) + return false; + + for (size_t y = 0; y < m->size1; y++) + for (size_t x = 0; x < y; x++) + if (gsl_matrix_get (m, y, x) != gsl_matrix_get (m, x, y)) + return false; + + return true; +} + +static int +compare_double_desc (const void *a_, const void *b_) +{ + const double *a = a_; + const double *b = b_; + return *a > *b ? -1 : *a < *b; +} + +static gsl_matrix * +matrix_eval_EVAL (gsl_matrix *m, const struct matrix_expr *e) +{ + if (!is_symmetric (m)) + { + msg_at (SE, e->subs[0]->location, + _("Argument of EVAL must be symmetric.")); + return NULL; + } + + gsl_eigen_symm_workspace *w = gsl_eigen_symm_alloc (m->size1); + gsl_matrix *eval = gsl_matrix_alloc (m->size1, 1); + gsl_vector v_eval = to_vector (eval); + gsl_eigen_symm (m, &v_eval, w); + gsl_eigen_symm_free (w); + + assert (v_eval.stride == 1); + qsort (v_eval.data, v_eval.size, sizeof *v_eval.data, compare_double_desc); + + return eval; +} + +static double +matrix_eval_EXP (double d) +{ + return exp (d); +} + +/* From https://gist.github.com/turingbirds/5e99656e08dbe1324c99, where it was + marked as: + + Charl Linssen + Feb 2016 + PUBLIC DOMAIN */ +static gsl_matrix * +matrix_eval_GINV (gsl_matrix *A) +{ + size_t n = A->size1; + size_t m = A->size2; + bool swap = m > n; + gsl_matrix *tmp_mat = NULL; + if (swap) + { + /* libgsl SVD can only handle the case m <= n, so transpose matrix. */ + tmp_mat = gsl_matrix_alloc (m, n); + gsl_matrix_transpose_memcpy (tmp_mat, A); + A = tmp_mat; + size_t i = m; + m = n; + n = i; + } + + /* Do SVD. */ + gsl_matrix *V = gsl_matrix_alloc (m, m); + gsl_vector *u = gsl_vector_alloc (m); + + gsl_vector *tmp_vec = gsl_vector_alloc (m); + gsl_linalg_SV_decomp (A, V, u, tmp_vec); + gsl_vector_free (tmp_vec); + + /* Compute Σ⁻¹. */ + gsl_matrix *Sigma_pinv = gsl_matrix_alloc (m, n); + gsl_matrix_set_zero (Sigma_pinv); + double cutoff = 1e-15 * gsl_vector_max (u); + + for (size_t i = 0; i < m; ++i) + { + double x = gsl_vector_get (u, i); + gsl_matrix_set (Sigma_pinv, i, i, x > cutoff ? 1.0 / x : 0); + } + + /* libgsl SVD yields "thin" SVD. Pad to full matrix by adding zeros. */ + gsl_matrix *U = gsl_matrix_calloc (n, n); + for (size_t i = 0; i < n; i++) + for (size_t j = 0; j < m; j++) + gsl_matrix_set (U, i, j, gsl_matrix_get (A, i, j)); + + /* Two dot products to obtain pseudoinverse. */ + gsl_matrix *tmp_mat2 = gsl_matrix_alloc (m, n); + gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1., V, Sigma_pinv, 0., tmp_mat2); + + gsl_matrix *A_pinv; + if (swap) + { + A_pinv = gsl_matrix_alloc (n, m); + gsl_blas_dgemm (CblasNoTrans, CblasTrans, 1., U, tmp_mat2, 0., A_pinv); + } + else + { + A_pinv = gsl_matrix_alloc (m, n); + gsl_blas_dgemm (CblasNoTrans, CblasTrans, 1., tmp_mat2, U, 0., A_pinv); + } + + gsl_matrix_free (tmp_mat); + gsl_matrix_free (tmp_mat2); + gsl_matrix_free (U); + gsl_matrix_free (Sigma_pinv); + gsl_vector_free (u); + gsl_matrix_free (V); + + return A_pinv; +} + +struct grade + { + size_t y, x; + double value; + }; + +static int +grade_compare_3way (const void *a_, const void *b_) +{ + const struct grade *a = a_; + const struct grade *b = b_; + + return (a->value < b->value ? -1 + : a->value > b->value ? 1 + : a->y < b->y ? -1 + : a->y > b->y ? 1 + : a->x < b->x ? -1 + : a->x > b->x); +} + +static gsl_matrix * +matrix_eval_GRADE (gsl_matrix *m) +{ + size_t n = m->size1 * m->size2; + struct grade *grades = xmalloc (n * sizeof *grades); + + size_t i = 0; + MATRIX_FOR_ALL_ELEMENTS (d, y, x, m) + grades[i++] = (struct grade) { .y = y, .x = x, .value = *d }; + qsort (grades, n, sizeof *grades, grade_compare_3way); + + for (size_t i = 0; i < n; i++) + gsl_matrix_set (m, grades[i].y, grades[i].x, i + 1); + + free (grades); + + return m; +} + +static double +dot (gsl_vector *a, gsl_vector *b) +{ + double result = 0.0; + for (size_t i = 0; i < a->size; i++) + result += gsl_vector_get (a, i) * gsl_vector_get (b, i); + return result; +} + +static double +norm2 (gsl_vector *v) +{ + double result = 0.0; + for (size_t i = 0; i < v->size; i++) + result += pow2 (gsl_vector_get (v, i)); + return result; +} + +static double +norm (gsl_vector *v) +{ + return sqrt (norm2 (v)); +} + +static gsl_matrix * +matrix_eval_GSCH (gsl_matrix *v, const struct matrix_expr *e) +{ + if (v->size2 < v->size1) + { + msg_at (SE, e->subs[0]->location, + _("GSCH requires its argument to have at least as many columns " + "as rows, but it has dimensions %zu×%zu."), + v->size1, v->size2); + return NULL; + } + if (!v->size1 || !v->size2) + return v; + + gsl_matrix *u = gsl_matrix_calloc (v->size1, v->size2); + size_t ux = 0; + for (size_t vx = 0; vx < v->size2; vx++) + { + gsl_vector u_i = gsl_matrix_column (u, ux).vector; + gsl_vector v_i = gsl_matrix_column (v, vx).vector; + + gsl_vector_memcpy (&u_i, &v_i); + for (size_t j = 0; j < ux; j++) + { + gsl_vector u_j = gsl_matrix_column (u, j).vector; + double scale = dot (&u_j, &u_i) / norm2 (&u_j); + for (size_t k = 0; k < u_i.size; k++) + gsl_vector_set (&u_i, k, (gsl_vector_get (&u_i, k) + - scale * gsl_vector_get (&u_j, k))); + } + + double len = norm (&u_i); + if (len > 1e-15) + { + gsl_vector_scale (&u_i, 1.0 / len); + if (++ux >= v->size1) + break; + } + } + + if (ux < v->size1) + { + msg_at (SE, e->subs[0]->location, + _("%zu×%zu argument to GSCH contains only " + "%zu linearly independent columns."), + v->size1, v->size2, ux); + gsl_matrix_free (u); + return NULL; + } + + u->size2 = v->size1; + return u; +} + +static gsl_matrix * +matrix_eval_IDENT (double s1, double s2) +{ + gsl_matrix *m = gsl_matrix_alloc (s1, s2); + MATRIX_FOR_ALL_ELEMENTS (d, y, x, m) + *d = x == y; + return m; +} + +static void +invert_matrix (gsl_matrix *x) +{ + gsl_permutation *p = gsl_permutation_alloc (x->size1); + int signum; + gsl_linalg_LU_decomp (x, p, &signum); + gsl_linalg_LU_invx (x, p); + gsl_permutation_free (p); +} + +static gsl_matrix * +matrix_eval_INV (gsl_matrix *m) +{ + invert_matrix (m); + return m; +} + +static gsl_matrix * +matrix_eval_KRONEKER (gsl_matrix *a, gsl_matrix *b) +{ + gsl_matrix *k = gsl_matrix_alloc (a->size1 * b->size1, + a->size2 * b->size2); + size_t y = 0; + for (size_t ar = 0; ar < a->size1; ar++) + for (size_t br = 0; br < b->size1; br++, y++) + { + size_t x = 0; + for (size_t ac = 0; ac < a->size2; ac++) + for (size_t bc = 0; bc < b->size2; bc++, x++) + { + double av = gsl_matrix_get (a, ar, ac); + double bv = gsl_matrix_get (b, br, bc); + gsl_matrix_set (k, y, x, av * bv); + } + } + return k; +} + +static double +matrix_eval_LG10 (double d) +{ + return log10 (d); +} + +static double +matrix_eval_LN (double d) +{ + return log (d); +} + +static void +matrix_eval_MAGIC_odd (gsl_matrix *m, size_t n) +{ + /* Siamese method: https://en.wikipedia.org/wiki/Siamese_method. */ + size_t y = 0; + size_t x = n / 2; + for (size_t i = 1; i <= n * n; i++) + { + gsl_matrix_set (m, y, x, i); + + size_t y1 = !y ? n - 1 : y - 1; + size_t x1 = x + 1 >= n ? 0 : x + 1; + if (gsl_matrix_get (m, y1, x1) == 0) + { + y = y1; + x = x1; + } + else + y = y + 1 >= n ? 0 : y + 1; + } +} + +static void +magic_exchange (gsl_matrix *m, size_t y1, size_t x1, size_t y2, size_t x2) +{ + double a = gsl_matrix_get (m, y1, x1); + double b = gsl_matrix_get (m, y2, x2); + gsl_matrix_set (m, y1, x1, b); + gsl_matrix_set (m, y2, x2, a); +} + +static void +matrix_eval_MAGIC_doubly_even (gsl_matrix *m, size_t n) +{ + size_t x, y; + + /* A. Umar, "On the Construction of Even Order Magic Squares", + https://arxiv.org/ftp/arxiv/papers/1202/1202.0948.pdf. */ + x = y = 0; + for (size_t i = 1; i <= n * n / 2; i++) + { + gsl_matrix_set (m, y, x, i); + if (++y >= n) + { + y = 0; + x++; + } + } + + x = n - 1; + y = 0; + for (size_t i = n * n; i > n * n / 2; i--) + { + gsl_matrix_set (m, y, x, i); + if (++y >= n) + { + y = 0; + x--; + } + } + + for (size_t y = 0; y < n; y++) + for (size_t x = 0; x < n / 2; x++) + { + unsigned int d = gsl_matrix_get (m, y, x); + if (d % 2 != (y < n / 2)) + magic_exchange (m, y, x, y, n - x - 1); + } + + size_t y1 = n / 2; + size_t y2 = n - 1; + size_t x1 = n / 2 - 1; + size_t x2 = n / 2; + magic_exchange (m, y1, x1, y2, x1); + magic_exchange (m, y1, x2, y2, x2); +} + +static void +matrix_eval_MAGIC_singly_even (gsl_matrix *m, size_t n) +{ + /* A. Umar, "On the Construction of Even Order Magic Squares", + https://arxiv.org/ftp/arxiv/papers/1202/1202.0948.pdf. */ + size_t x, y; + + x = y = 0; + for (size_t i = 1; ; i++) + { + gsl_matrix_set (m, y, x, i); + if (++y == n / 2 - 1) + y += 2; + else if (y >= n) + { + y = 0; + if (++x >= n / 2) + break; + } + } + + x = n - 1; + y = 0; + for (size_t i = n * n; ; i--) + { + gsl_matrix_set (m, y, x, i); + if (++y == n / 2 - 1) + y += 2; + else if (y >= n) + { + y = 0; + if (--x < n / 2) + break; + } + } + for (size_t y = 0; y < n; y++) + if (y != n / 2 - 1 && y != n / 2) + for (size_t x = 0; x < n / 2; x++) + { + unsigned int d = gsl_matrix_get (m, y, x); + if (d % 2 != (y < n / 2)) + magic_exchange (m, y, x, y, n - x - 1); + } + + size_t a0 = (n * n - 2 * n) / 2 + 1; + for (size_t i = 0; i < n / 2; i++) + { + size_t a = a0 + i; + gsl_matrix_set (m, n / 2, i, a); + gsl_matrix_set (m, n / 2 - 1, i, (n * n + 1) - a); + } + for (size_t i = 0; i < n / 2; i++) + { + size_t a = a0 + i + n / 2; + gsl_matrix_set (m, n / 2 - 1, n - i - 1, a); + gsl_matrix_set (m, n / 2, n - i - 1, (n * n + 1) - a); + } + for (size_t x = 1; x < n / 2; x += 2) + magic_exchange (m, n / 2, x, n / 2 - 1, x); + for (size_t x = n / 2 + 2; x <= n - 3; x += 2) + magic_exchange (m, n / 2, x, n / 2 - 1, x); + size_t x1 = n / 2 - 2; + size_t x2 = n / 2 + 1; + size_t y1 = n / 2 - 2; + size_t y2 = n / 2 + 1; + magic_exchange (m, y1, x1, y2, x1); + magic_exchange (m, y1, x2, y2, x2); +} + +static gsl_matrix * +matrix_eval_MAGIC (double n_) +{ + size_t n = n_; + + gsl_matrix *m = gsl_matrix_calloc (n, n); + if (n % 2) + matrix_eval_MAGIC_odd (m, n); + else if (n % 4) + matrix_eval_MAGIC_singly_even (m, n); + else + matrix_eval_MAGIC_doubly_even (m, n); + return m; +} + +static gsl_matrix * +matrix_eval_MAKE (double r, double c, double value) +{ + gsl_matrix *m = gsl_matrix_alloc (r, c); + MATRIX_FOR_ALL_ELEMENTS (d, y, x, m) + *d = value; + return m; +} + +static gsl_matrix * +matrix_eval_MDIAG (gsl_vector *v) +{ + gsl_matrix *m = gsl_matrix_calloc (v->size, v->size); + gsl_vector diagonal = gsl_matrix_diagonal (m).vector; + gsl_vector_memcpy (&diagonal, v); + return m; +} + +static double +matrix_eval_MMAX (gsl_matrix *m) +{ + return gsl_matrix_max (m); +} + +static double +matrix_eval_MMIN (gsl_matrix *m) +{ + return gsl_matrix_min (m); +} + +static gsl_matrix * +matrix_eval_MOD (gsl_matrix *m, double divisor) +{ + MATRIX_FOR_ALL_ELEMENTS (d, y, x, m) + *d = fmod (*d, divisor); + return m; +} + +static double +matrix_eval_MSSQ (gsl_matrix *m) +{ + double mssq = 0.0; + MATRIX_FOR_ALL_ELEMENTS (d, y, x, m) + mssq += *d * *d; + return mssq; +} + +static double +matrix_eval_MSUM (gsl_matrix *m) +{ + double msum = 0.0; + MATRIX_FOR_ALL_ELEMENTS (d, y, x, m) + msum += *d; + return msum; +} + +static double +matrix_eval_NCOL (gsl_matrix *m) +{ + return m->size2; +} + +static double +matrix_eval_NROW (gsl_matrix *m) +{ + return m->size1; +} + +static double +matrix_eval_RANK (gsl_matrix *m) +{ + gsl_vector *tau = gsl_vector_alloc (MIN (m->size1, m->size2)); + gsl_linalg_QR_decomp (m, tau); + gsl_vector_free (tau); + + return gsl_linalg_QRPT_rank (m, -1); +} + +static gsl_matrix * +matrix_eval_RESHAPE (gsl_matrix *m, double r_, double c_, + const struct matrix_expr *e) +{ + bool r_ok = r_ >= 0 && r_ < SIZE_MAX; + bool c_ok = c_ >= 0 && c_ < SIZE_MAX; + if (!r_ok || !c_ok) + { + msg_at (SE, + !r_ok ? e->subs[1]->location : e->subs[2]->location, + _("Arguments 2 and 3 to RESHAPE must be integers.")); + return NULL; + } + size_t r = r_; + size_t c = c_; + if (size_overflow_p (xtimes (r, xmax (c, 1))) || c * r != m->size1 * m->size2) + { + struct msg_location *loc = msg_location_dup (e->subs[1]->location); + loc->end = e->subs[2]->location->end; + msg_at (SE, loc, _("Product of RESHAPE size arguments (%zu×%zu = %zu) " + "differs from product of matrix dimensions " + "(%zu×%zu = %zu)."), + r, c, r * c, + m->size1, m->size2, m->size1 * m->size2); + msg_location_destroy (loc); + return NULL; + } + + gsl_matrix *dst = gsl_matrix_alloc (r, c); + size_t y1 = 0; + size_t x1 = 0; + MATRIX_FOR_ALL_ELEMENTS (d, y2, x2, m) + { + gsl_matrix_set (dst, y1, x1, *d); + if (++x1 >= c) + { + x1 = 0; + y1++; + } + } + return dst; +} + +static gsl_matrix * +matrix_eval_row_extremum (gsl_matrix *m, bool min) +{ + if (m->size2 <= 1) + return m; + else if (!m->size1) + return gsl_matrix_alloc (0, 1); + + gsl_matrix *rext = gsl_matrix_alloc (m->size1, 1); + for (size_t y = 0; y < m->size1; y++) + { + double ext = gsl_matrix_get (m, y, 0); + for (size_t x = 1; x < m->size2; x++) + { + double value = gsl_matrix_get (m, y, x); + if (min ? value < ext : value > ext) + ext = value; + } + gsl_matrix_set (rext, y, 0, ext); + } + return rext; +} + +static gsl_matrix * +matrix_eval_RMAX (gsl_matrix *m) +{ + return matrix_eval_row_extremum (m, false); +} + +static gsl_matrix * +matrix_eval_RMIN (gsl_matrix *m) +{ + return matrix_eval_row_extremum (m, true); +} + +static double +matrix_eval_RND (double d) +{ + return rint (d); +} + +struct rank + { + size_t y, x; + double value; + }; + +static int +rank_compare_3way (const void *a_, const void *b_) +{ + const struct rank *a = a_; + const struct rank *b = b_; + + return a->value < b->value ? -1 : a->value > b->value; +} + +static gsl_matrix * +matrix_eval_RNKORDER (gsl_matrix *m) +{ + size_t n = m->size1 * m->size2; + struct rank *ranks = xmalloc (n * sizeof *ranks); + size_t i = 0; + MATRIX_FOR_ALL_ELEMENTS (d, y, x, m) + ranks[i++] = (struct rank) { .y = y, .x = x, .value = *d }; + qsort (ranks, n, sizeof *ranks, rank_compare_3way); + + for (size_t i = 0; i < n; ) + { + size_t j; + for (j = i + 1; j < n; j++) + if (ranks[i].value != ranks[j].value) + break; + + double rank = (i + j + 1.0) / 2.0; + for (size_t k = i; k < j; k++) + gsl_matrix_set (m, ranks[k].y, ranks[k].x, rank); + + i = j; + } + + free (ranks); + + return m; +} + +static gsl_matrix * +matrix_eval_row_sum (gsl_matrix *m, bool square) +{ + if (m->size1 == 0) + return m; + else if (!m->size1) + return gsl_matrix_alloc (0, 1); + + gsl_matrix *result = gsl_matrix_alloc (m->size1, 1); + for (size_t y = 0; y < m->size1; y++) + { + double sum = 0; + for (size_t x = 0; x < m->size2; x++) + { + double d = gsl_matrix_get (m, y, x); + sum += square ? pow2 (d) : d; + } + gsl_matrix_set (result, y, 0, sum); + } + return result; +} + +static gsl_matrix * +matrix_eval_RSSQ (gsl_matrix *m) +{ + return matrix_eval_row_sum (m, true); +} + +static gsl_matrix * +matrix_eval_RSUM (gsl_matrix *m) +{ + return matrix_eval_row_sum (m, false); +} + +static double +matrix_eval_SIN (double d) +{ + return sin (d); +} + +static gsl_matrix * +matrix_eval_SOLVE (gsl_matrix *m1, gsl_matrix *m2, const struct matrix_expr *e) +{ + if (m1->size1 != m2->size1) + { + struct msg_location *loc = msg_location_dup (e->subs[0]->location); + loc->end = e->subs[1]->location->end; + + msg_at (SE, e->location, + _("SOLVE arguments must have the same number of rows.")); + msg_at (SN, e->subs[0]->location, + _("Argument 1 has dimensions %zu×%zu."), m1->size1, m1->size2); + msg_at (SN, e->subs[1]->location, + _("Argument 2 has dimensions %zu×%zu."), m2->size1, m2->size2); + + msg_location_destroy (loc); + return NULL; + } + + gsl_matrix *x = gsl_matrix_alloc (m2->size1, m2->size2); + gsl_permutation *p = gsl_permutation_alloc (m1->size1); + int signum; + gsl_linalg_LU_decomp (m1, p, &signum); + for (size_t i = 0; i < m2->size2; i++) + { + gsl_vector bi = gsl_matrix_column (m2, i).vector; + gsl_vector xi = gsl_matrix_column (x, i).vector; + gsl_linalg_LU_solve (m1, p, &bi, &xi); + } + gsl_permutation_free (p); + return x; +} + +static double +matrix_eval_SQRT (double d) +{ + return sqrt (d); +} + +static gsl_matrix * +matrix_eval_SSCP (gsl_matrix *m) +{ + gsl_matrix *sscp = gsl_matrix_alloc (m->size2, m->size2); + gsl_blas_dgemm (CblasTrans, CblasNoTrans, 1.0, m, m, 0.0, sscp); + return sscp; +} + +static gsl_matrix * +matrix_eval_SVAL (gsl_matrix *m) +{ + gsl_matrix *tmp_mat = NULL; + if (m->size2 > m->size1) + { + tmp_mat = gsl_matrix_alloc (m->size2, m->size1); + gsl_matrix_transpose_memcpy (tmp_mat, m); + m = tmp_mat; + } + + /* Do SVD. */ + gsl_matrix *V = gsl_matrix_alloc (m->size2, m->size2); + gsl_vector *S = gsl_vector_alloc (m->size2); + gsl_vector *work = gsl_vector_alloc (m->size2); + gsl_linalg_SV_decomp (m, V, S, work); + + gsl_matrix *vals = gsl_matrix_alloc (m->size2, 1); + for (size_t i = 0; i < m->size2; i++) + gsl_matrix_set (vals, i, 0, gsl_vector_get (S, i)); + + gsl_matrix_free (V); + gsl_vector_free (S); + gsl_vector_free (work); + gsl_matrix_free (tmp_mat); + + return vals; +} + +static gsl_matrix * +matrix_eval_SWEEP (gsl_matrix *m, double d, const struct matrix_expr *e) +{ + if (d < 1 || d > SIZE_MAX) + { + msg_at (SE, e->subs[1]->location, + _("Scalar argument to SWEEP must be integer.")); + return NULL; + } + size_t k = d - 1; + if (k >= MIN (m->size1, m->size2)) + { + msg_at (SE, e->subs[1]->location, + _("Scalar argument to SWEEP must be integer less than or " + "equal to the smaller of the matrix argument's rows and " + "columns.")); + return NULL; + } + + double m_kk = gsl_matrix_get (m, k, k); + if (fabs (m_kk) > 1e-19) + { + gsl_matrix *a = gsl_matrix_alloc (m->size1, m->size2); + MATRIX_FOR_ALL_ELEMENTS (a_ij, i, j, a) + { + double m_ij = gsl_matrix_get (m, i, j); + double m_ik = gsl_matrix_get (m, i, k); + double m_kj = gsl_matrix_get (m, k, j); + *a_ij = (i != k && j != k ? m_ij * m_kk - m_ik * m_kj + : i != k ? -m_ik + : j != k ? m_kj + : 1.0) / m_kk; + } + return a; + } + else + { + for (size_t i = 0; i < m->size1; i++) + { + gsl_matrix_set (m, i, k, 0); + gsl_matrix_set (m, k, i, 0); + } + return m; + } +} + +static double +matrix_eval_TRACE (gsl_matrix *m) +{ + double sum = 0; + size_t n = MIN (m->size1, m->size2); + for (size_t i = 0; i < n; i++) + sum += gsl_matrix_get (m, i, i); + return sum; +} + +static gsl_matrix * +matrix_eval_T (gsl_matrix *m) +{ + return matrix_eval_TRANSPOS (m); +} + +static gsl_matrix * +matrix_eval_TRANSPOS (gsl_matrix *m) +{ + if (m->size1 == m->size2) + { + gsl_matrix_transpose (m); + return m; + } + else + { + gsl_matrix *t = gsl_matrix_alloc (m->size2, m->size1); + gsl_matrix_transpose_memcpy (t, m); + return t; + } +} + +static double +matrix_eval_TRUNC (double d) +{ + return trunc (d); +} + +static gsl_matrix * +matrix_eval_UNIFORM (double r_, double c_, const struct matrix_expr *e) +{ + size_t r = r_; + size_t c = c_; + if (size_overflow_p (xtimes (r, xmax (c, 1)))) + { + struct msg_location *loc = msg_location_dup (e->subs[0]->location); + loc->end = e->subs[1]->location->end; + + msg_at (SE, loc, + _("Product of arguments to UNIFORM exceeds memory size.")); + + msg_location_destroy (loc); + return NULL; + } + + gsl_matrix *m = gsl_matrix_alloc (r, c); + MATRIX_FOR_ALL_ELEMENTS (d, y, x, m) + *d = gsl_ran_flat (get_rng (), 0, 1); + return m; +} + +static double +matrix_eval_PDF_BETA (double x, double a, double b) +{ + return gsl_ran_beta_pdf (x, a, b); +} + +static double +matrix_eval_CDF_BETA (double x, double a, double b) +{ + return gsl_cdf_beta_P (x, a, b); +} + +static double +matrix_eval_IDF_BETA (double P, double a, double b) +{ + return gsl_cdf_beta_Pinv (P, a, b); +} + +static double +matrix_eval_RV_BETA (double a, double b) +{ + return gsl_ran_beta (get_rng (), a, b); +} + +static double +matrix_eval_NCDF_BETA (double x, double a, double b, double lambda) +{ + return ncdf_beta (x, a, b, lambda); +} + +static double +matrix_eval_NPDF_BETA (double x, double a, double b, double lambda) +{ + return npdf_beta (x, a, b, lambda); +} + +static double +matrix_eval_CDF_BVNOR (double x0, double x1, double r) +{ + return cdf_bvnor (x0, x1, r); +} + +static double +matrix_eval_PDF_BVNOR (double x0, double x1, double r) +{ + return gsl_ran_bivariate_gaussian_pdf (x0, x1, 1, 1, r); +} + +static double +matrix_eval_CDF_CAUCHY (double x, double a, double b) +{ + return gsl_cdf_cauchy_P ((x - a) / b, 1); +} + +static double +matrix_eval_IDF_CAUCHY (double P, double a, double b) +{ + return a + b * gsl_cdf_cauchy_Pinv (P, 1); +} + +static double +matrix_eval_PDF_CAUCHY (double x, double a, double b) +{ + return gsl_ran_cauchy_pdf ((x - a) / b, 1) / b; +} + +static double +matrix_eval_RV_CAUCHY (double a, double b) +{ + return a + b * gsl_ran_cauchy (get_rng (), 1); +} + +static double +matrix_eval_CDF_CHISQ (double x, double df) +{ + return gsl_cdf_chisq_P (x, df); +} + +static double +matrix_eval_CHICDF (double x, double df) +{ + return matrix_eval_CDF_CHISQ (x, df); +} + +static double +matrix_eval_IDF_CHISQ (double P, double df) +{ + return gsl_cdf_chisq_Pinv (P, df); +} + +static double +matrix_eval_PDF_CHISQ (double x, double df) +{ + return gsl_ran_chisq_pdf (x, df); +} + +static double +matrix_eval_RV_CHISQ (double df) +{ + return gsl_ran_chisq (get_rng (), df); +} + +static double +matrix_eval_SIG_CHISQ (double x, double df) +{ + return gsl_cdf_chisq_Q (x, df); +} + +static double +matrix_eval_CDF_EXP (double x, double a) +{ + return gsl_cdf_exponential_P (x, 1. / a); +} + +static double +matrix_eval_IDF_EXP (double P, double a) +{ + return gsl_cdf_exponential_Pinv (P, 1. / a); +} + +static double +matrix_eval_PDF_EXP (double x, double a) +{ + return gsl_ran_exponential_pdf (x, 1. / a); +} + +static double +matrix_eval_RV_EXP (double a) +{ + return gsl_ran_exponential (get_rng (), 1. / a); +} + +static double +matrix_eval_PDF_XPOWER (double x, double a, double b) +{ + return gsl_ran_exppow_pdf (x, a, b); +} + +static double +matrix_eval_RV_XPOWER (double a, double b) +{ + return gsl_ran_exppow (get_rng (), a, b); +} + +static double +matrix_eval_CDF_F (double x, double df1, double df2) +{ + return gsl_cdf_fdist_P (x, df1, df2); +} + +static double +matrix_eval_FCDF (double x, double df1, double df2) +{ + return matrix_eval_CDF_F (x, df1, df2); +} + +static double +matrix_eval_IDF_F (double P, double df1, double df2) +{ + return idf_fdist (P, df1, df2); +} + +static double +matrix_eval_RV_F (double df1, double df2) +{ + return gsl_ran_fdist (get_rng (), df1, df2); +} + +static double +matrix_eval_PDF_F (double x, double df1, double df2) +{ + return gsl_ran_fdist_pdf (x, df1, df2); +} + +static double +matrix_eval_SIG_F (double x, double df1, double df2) +{ + return gsl_cdf_fdist_Q (x, df1, df2); +} + +static double +matrix_eval_CDF_GAMMA (double x, double a, double b) +{ + return gsl_cdf_gamma_P (x, a, 1. / b); +} + +static double +matrix_eval_IDF_GAMMA (double P, double a, double b) +{ + return gsl_cdf_gamma_Pinv (P, a, 1. / b); +} + +static double +matrix_eval_PDF_GAMMA (double x, double a, double b) +{ + return gsl_ran_gamma_pdf (x, a, 1. / b); +} + +static double +matrix_eval_RV_GAMMA (double a, double b) +{ + return gsl_ran_gamma (get_rng (), a, 1. / b); +} + +static double +matrix_eval_PDF_LANDAU (double x) +{ + return gsl_ran_landau_pdf (x); +} + +static double +matrix_eval_RV_LANDAU (void) +{ + return gsl_ran_landau (get_rng ()); +} + +static double +matrix_eval_CDF_LAPLACE (double x, double a, double b) +{ + return gsl_cdf_laplace_P ((x - a) / b, 1); +} + +static double +matrix_eval_IDF_LAPLACE (double P, double a, double b) +{ + return a + b * gsl_cdf_laplace_Pinv (P, 1); +} + +static double +matrix_eval_PDF_LAPLACE (double x, double a, double b) +{ + return gsl_ran_laplace_pdf ((x - a) / b, 1); +} + +static double +matrix_eval_RV_LAPLACE (double a, double b) +{ + return a + b * gsl_ran_laplace (get_rng (), 1); +} + +static double +matrix_eval_RV_LEVY (double c, double alpha) +{ + return gsl_ran_levy (get_rng (), c, alpha); +} + +static double +matrix_eval_RV_LVSKEW (double c, double alpha, double beta) +{ + return gsl_ran_levy_skew (get_rng (), c, alpha, beta); +} + +static double +matrix_eval_CDF_LOGISTIC (double x, double a, double b) +{ + return gsl_cdf_logistic_P ((x - a) / b, 1); +} + +static double +matrix_eval_IDF_LOGISTIC (double P, double a, double b) +{ + return a + b * gsl_cdf_logistic_Pinv (P, 1); +} + +static double +matrix_eval_PDF_LOGISTIC (double x, double a, double b) +{ + return gsl_ran_logistic_pdf ((x - a) / b, 1) / b; +} + +static double +matrix_eval_RV_LOGISTIC (double a, double b) +{ + return a + b * gsl_ran_logistic (get_rng (), 1); +} + +static double +matrix_eval_CDF_LNORMAL (double x, double m, double s) +{ + return gsl_cdf_lognormal_P (x, log (m), s); +} + +static double +matrix_eval_IDF_LNORMAL (double P, double m, double s) +{ + return gsl_cdf_lognormal_Pinv (P, log (m), s);; +} + +static double +matrix_eval_PDF_LNORMAL (double x, double m, double s) +{ + return gsl_ran_lognormal_pdf (x, log (m), s); +} + +static double +matrix_eval_RV_LNORMAL (double m, double s) +{ + return gsl_ran_lognormal (get_rng (), log (m), s); +} + +static double +matrix_eval_CDF_NORMAL (double x, double u, double s) +{ + return gsl_cdf_gaussian_P (x - u, s); +} + +static double +matrix_eval_IDF_NORMAL (double P, double u, double s) +{ + return u + gsl_cdf_gaussian_Pinv (P, s); +} + +static double +matrix_eval_PDF_NORMAL (double x, double u, double s) +{ + return gsl_ran_gaussian_pdf ((x - u) / s, 1) / s; +} + +static double +matrix_eval_RV_NORMAL (double u, double s) +{ + return u + gsl_ran_gaussian (get_rng (), s); +} + +static double +matrix_eval_CDFNORM (double x) +{ + return gsl_cdf_ugaussian_P (x); +} + +static double +matrix_eval_PROBIT (double P) +{ + return gsl_cdf_ugaussian_Pinv (P); +} + +static double +matrix_eval_NORMAL (double s) +{ + return gsl_ran_gaussian (get_rng (), s); +} + +static double +matrix_eval_PDF_NTAIL (double x, double a, double sigma) +{ + return gsl_ran_gaussian_tail_pdf (x, a, sigma);; +} + +static double +matrix_eval_RV_NTAIL (double a, double sigma) +{ + return gsl_ran_gaussian_tail (get_rng (), a, sigma); +} + +static double +matrix_eval_CDF_PARETO (double x, double a, double b) +{ + return gsl_cdf_pareto_P (x, b, a); +} + +static double +matrix_eval_IDF_PARETO (double P, double a, double b) +{ + return gsl_cdf_pareto_Pinv (P, b, a); +} + +static double +matrix_eval_PDF_PARETO (double x, double a, double b) +{ + return gsl_ran_pareto_pdf (x, b, a); +} + +static double +matrix_eval_RV_PARETO (double a, double b) +{ + return gsl_ran_pareto (get_rng (), b, a); +} + +static double +matrix_eval_CDF_RAYLEIGH (double x, double sigma) +{ + return gsl_cdf_rayleigh_P (x, sigma); +} + +static double +matrix_eval_IDF_RAYLEIGH (double P, double sigma) +{ + return gsl_cdf_rayleigh_Pinv (P, sigma); +} + +static double +matrix_eval_PDF_RAYLEIGH (double x, double sigma) +{ + return gsl_ran_rayleigh_pdf (x, sigma); +} + +static double +matrix_eval_RV_RAYLEIGH (double sigma) +{ + return gsl_ran_rayleigh (get_rng (), sigma); +} + +static double +matrix_eval_PDF_RTAIL (double x, double a, double sigma) +{ + return gsl_ran_rayleigh_tail_pdf (x, a, sigma); +} + +static double +matrix_eval_RV_RTAIL (double a, double sigma) +{ + return gsl_ran_rayleigh_tail (get_rng (), a, sigma); +} + +static double +matrix_eval_CDF_T (double x, double df) +{ + return gsl_cdf_tdist_P (x, df); +} + +static double +matrix_eval_TCDF (double x, double df) +{ + return matrix_eval_CDF_T (x, df); +} + +static double +matrix_eval_IDF_T (double P, double df) +{ + return gsl_cdf_tdist_Pinv (P, df); +} + +static double +matrix_eval_PDF_T (double x, double df) +{ + return gsl_ran_tdist_pdf (x, df); +} + +static double +matrix_eval_RV_T (double df) +{ + return gsl_ran_tdist (get_rng (), df); +} + +static double +matrix_eval_CDF_T1G (double x, double a, double b) +{ + return gsl_cdf_gumbel1_P (x, a, b); +} + +static double +matrix_eval_IDF_T1G (double P, double a, double b) +{ + return gsl_cdf_gumbel1_Pinv (P, a, b); +} + +static double +matrix_eval_PDF_T1G (double x, double a, double b) +{ + return gsl_ran_gumbel1_pdf (x, a, b); +} + +static double +matrix_eval_RV_T1G (double a, double b) +{ + return gsl_ran_gumbel1 (get_rng (), a, b); +} + +static double +matrix_eval_CDF_T2G (double x, double a, double b) +{ + return gsl_cdf_gumbel1_P (x, a, b); +} + +static double +matrix_eval_IDF_T2G (double P, double a, double b) +{ + return gsl_cdf_gumbel1_Pinv (P, a, b); +} + +static double +matrix_eval_PDF_T2G (double x, double a, double b) +{ + return gsl_ran_gumbel1_pdf (x, a, b); +} + +static double +matrix_eval_RV_T2G (double a, double b) +{ + return gsl_ran_gumbel1 (get_rng (), a, b); +} + +static double +matrix_eval_CDF_UNIFORM (double x, double a, double b) +{ + return gsl_cdf_flat_P (x, a, b); +} + +static double +matrix_eval_IDF_UNIFORM (double P, double a, double b) +{ + return gsl_cdf_flat_Pinv (P, a, b); +} + +static double +matrix_eval_PDF_UNIFORM (double x, double a, double b) +{ + return gsl_ran_flat_pdf (x, a, b); +} + +static double +matrix_eval_RV_UNIFORM (double a, double b) +{ + return gsl_ran_flat (get_rng (), a, b); +} + +static double +matrix_eval_CDF_WEIBULL (double x, double a, double b) +{ + return gsl_cdf_weibull_P (x, a, b); +} + +static double +matrix_eval_IDF_WEIBULL (double P, double a, double b) +{ + return gsl_cdf_weibull_Pinv (P, a, b); +} + +static double +matrix_eval_PDF_WEIBULL (double x, double a, double b) +{ + return gsl_ran_weibull_pdf (x, a, b); +} + +static double +matrix_eval_RV_WEIBULL (double a, double b) +{ + return gsl_ran_weibull (get_rng (), a, b); +} + +static double +matrix_eval_CDF_BERNOULLI (double k, double p) +{ + return k ? 1 : 1 - p; +} + +static double +matrix_eval_PDF_BERNOULLI (double k, double p) +{ + return gsl_ran_bernoulli_pdf (k, p); +} + +static double +matrix_eval_RV_BERNOULLI (double p) +{ + return gsl_ran_bernoulli (get_rng (), p); +} + +static double +matrix_eval_CDF_BINOM (double k, double n, double p) +{ + return gsl_cdf_binomial_P (k, p, n); +} + +static double +matrix_eval_PDF_BINOM (double k, double n, double p) +{ + return gsl_ran_binomial_pdf (k, p, n); +} + +static double +matrix_eval_RV_BINOM (double n, double p) +{ + return gsl_ran_binomial (get_rng (), p, n); +} + +static double +matrix_eval_CDF_GEOM (double k, double p) +{ + return gsl_cdf_geometric_P (k, p); +} + +static double +matrix_eval_PDF_GEOM (double k, double p) +{ + return gsl_ran_geometric_pdf (k, p); +} + +static double +matrix_eval_RV_GEOM (double p) +{ + return gsl_ran_geometric (get_rng (), p); +} + +static double +matrix_eval_CDF_HYPER (double k, double a, double b, double c) +{ + return gsl_cdf_hypergeometric_P (k, c, a - c, b); +} + +static double +matrix_eval_PDF_HYPER (double k, double a, double b, double c) +{ + return gsl_ran_hypergeometric_pdf (k, c, a - c, b); +} + +static double +matrix_eval_RV_HYPER (double a, double b, double c) +{ + return gsl_ran_hypergeometric (get_rng (), c, a - c, b); +} + +static double +matrix_eval_PDF_LOG (double k, double p) +{ + return gsl_ran_logarithmic_pdf (k, p); +} + +static double +matrix_eval_RV_LOG (double p) +{ + return gsl_ran_logarithmic (get_rng (), p); +} + +static double +matrix_eval_CDF_NEGBIN (double k, double n, double p) +{ + return gsl_cdf_negative_binomial_P (k, p, n); +} + +static double +matrix_eval_PDF_NEGBIN (double k, double n, double p) +{ + return gsl_ran_negative_binomial_pdf (k, p, n); +} + +static double +matrix_eval_RV_NEGBIN (double n, double p) +{ + return gsl_ran_negative_binomial (get_rng (), p, n); +} + +static double +matrix_eval_CDF_POISSON (double k, double mu) +{ + return gsl_cdf_poisson_P (k, mu); +} + +static double +matrix_eval_PDF_POISSON (double k, double mu) +{ + return gsl_ran_poisson_pdf (k, mu); +} + +static double +matrix_eval_RV_POISSON (double mu) +{ + return gsl_ran_poisson (get_rng (), mu); +} + +static double +matrix_op_eval (enum matrix_op op, double a, double b) +{ + switch (op) + { + case MOP_ADD_ELEMS: return a + b; + case MOP_SUB_ELEMS: return a - b; + case MOP_MUL_ELEMS: return a * b; + case MOP_DIV_ELEMS: return a / b; + case MOP_EXP_ELEMS: return pow (a, b); + case MOP_GT: return a > b; + case MOP_GE: return a >= b; + case MOP_LT: return a < b; + case MOP_LE: return a <= b; + case MOP_EQ: return a == b; + case MOP_NE: return a != b; + case MOP_AND: return (a > 0) && (b > 0); + case MOP_OR: return (a > 0) || (b > 0); + case MOP_XOR: return (a > 0) != (b > 0); + +#define F(ENUM, STRING, PROTO, CONSTRAINTS) case MOP_F_##ENUM: + MATRIX_FUNCTIONS +#undef F + case MOP_NEGATE: + case MOP_SEQ: + case MOP_SEQ_BY: + case MOP_MUL_MAT: + case MOP_EXP_MAT: + case MOP_NOT: + case MOP_PASTE_HORZ: + case MOP_PASTE_VERT: + case MOP_EMPTY: + case MOP_VEC_INDEX: + case MOP_VEC_ALL: + case MOP_MAT_INDEX: + case MOP_ROW_INDEX: + case MOP_COL_INDEX: + case MOP_NUMBER: + case MOP_VARIABLE: + case MOP_EOF: + NOT_REACHED (); + } + NOT_REACHED (); +} + +static const char * +matrix_op_name (enum matrix_op op) +{ + switch (op) + { + case MOP_ADD_ELEMS: return "+"; + case MOP_SUB_ELEMS: return "-"; + case MOP_MUL_ELEMS: return "&*"; + case MOP_DIV_ELEMS: return "&/"; + case MOP_EXP_ELEMS: return "&**"; + case MOP_GT: return ">"; + case MOP_GE: return ">="; + case MOP_LT: return "<"; + case MOP_LE: return "<="; + case MOP_EQ: return "="; + case MOP_NE: return "<>"; + case MOP_AND: return "AND"; + case MOP_OR: return "OR"; + case MOP_XOR: return "XOR"; + +#define F(ENUM, STRING, PROTO, CONSTRAINTS) case MOP_F_##ENUM: + MATRIX_FUNCTIONS +#undef F + case MOP_NEGATE: + case MOP_SEQ: + case MOP_SEQ_BY: + case MOP_MUL_MAT: + case MOP_EXP_MAT: + case MOP_NOT: + case MOP_PASTE_HORZ: + case MOP_PASTE_VERT: + case MOP_EMPTY: + case MOP_VEC_INDEX: + case MOP_VEC_ALL: + case MOP_MAT_INDEX: + case MOP_ROW_INDEX: + case MOP_COL_INDEX: + case MOP_NUMBER: + case MOP_VARIABLE: + case MOP_EOF: + NOT_REACHED (); + } + NOT_REACHED (); +} + +static bool +is_scalar (const gsl_matrix *m) +{ + return m->size1 == 1 && m->size2 == 1; +} + +static double +to_scalar (const gsl_matrix *m) +{ + assert (is_scalar (m)); + return gsl_matrix_get (m, 0, 0); +} + +static gsl_matrix * +matrix_expr_evaluate_elementwise (const struct matrix_expr *e, + enum matrix_op op, + gsl_matrix *a, gsl_matrix *b) +{ + if (is_scalar (b)) + { + double be = to_scalar (b); + for (size_t r = 0; r < a->size1; r++) + for (size_t c = 0; c < a->size2; c++) + { + double *ae = gsl_matrix_ptr (a, r, c); + *ae = matrix_op_eval (op, *ae, be); + } + return a; + } + else if (is_scalar (a)) + { + double ae = to_scalar (a); + for (size_t r = 0; r < b->size1; r++) + for (size_t c = 0; c < b->size2; c++) + { + double *be = gsl_matrix_ptr (b, r, c); + *be = matrix_op_eval (op, ae, *be); + } + return b; + } + else if (a->size1 == b->size1 && a->size2 == b->size2) + { + for (size_t r = 0; r < a->size1; r++) + for (size_t c = 0; c < a->size2; c++) + { + double *ae = gsl_matrix_ptr (a, r, c); + double be = gsl_matrix_get (b, r, c); + *ae = matrix_op_eval (op, *ae, be); + } + return a; + } + else + { + msg_at (SE, matrix_expr_location (e), + _("The operands of %s must have the same dimensions or one " + "must be a scalar."), + matrix_op_name (op)); + msg_at (SN, matrix_expr_location (e->subs[0]), + _("The left-hand operand is a %zu×%zu matrix."), + a->size1, a->size2); + msg_at (SN, matrix_expr_location (e->subs[1]), + _("The right-hand operand is a %zu×%zu matrix."), + b->size1, b->size2); + return NULL; + } +} + +static gsl_matrix * +matrix_expr_evaluate_mul_mat (const struct matrix_expr *e, + gsl_matrix *a, gsl_matrix *b) +{ + if (is_scalar (a) || is_scalar (b)) + return matrix_expr_evaluate_elementwise (e, MOP_MUL_ELEMS, a, b); + + if (a->size2 != b->size1) + { + msg_at (SE, e->location, + _("Matrices not conformable for multiplication.")); + msg_at (SN, matrix_expr_location (e->subs[0]), + _("The left-hand operand is a %zu×%zu matrix."), + a->size1, a->size2); + msg_at (SN, matrix_expr_location (e->subs[1]), + _("The right-hand operand is a %zu×%zu matrix."), + b->size1, b->size2); + return NULL; + } + + gsl_matrix *c = gsl_matrix_alloc (a->size1, b->size2); + gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1.0, a, b, 0.0, c); + return c; +} + +static void +swap_matrix (gsl_matrix **a, gsl_matrix **b) +{ + gsl_matrix *tmp = *a; + *a = *b; + *b = tmp; +} + +static void +mul_matrix (gsl_matrix **z, const gsl_matrix *x, const gsl_matrix *y, + gsl_matrix **tmp) +{ + gsl_blas_dgemm (CblasNoTrans, CblasNoTrans, 1.0, x, y, 0.0, *tmp); + swap_matrix (z, tmp); +} + +static void +square_matrix (gsl_matrix **x, gsl_matrix **tmp) +{ + mul_matrix (x, *x, *x, tmp); +} + +static gsl_matrix * +matrix_expr_evaluate_exp_mat (const struct matrix_expr *e, + gsl_matrix *x_, gsl_matrix *b) +{ + gsl_matrix *x = x_; + if (x->size1 != x->size2) + { + msg_at (SE, matrix_expr_location (e->subs[0]), + _("Matrix exponentation with ** requires a square matrix on " + "the left-hand size, not one with dimensions %zu×%zu."), + x->size1, x->size2); + return NULL; + } + if (!is_scalar (b)) + { + msg_at (SE, matrix_expr_location (e->subs[1]), + _("Matrix exponentiation with ** requires a scalar on the " + "right-hand side, not a matrix with dimensions %zu×%zu."), + b->size1, b->size2); + return NULL; + } + double bf = to_scalar (b); + if (bf != floor (bf) || bf <= LONG_MIN || bf > LONG_MAX) + { + msg_at (SE, matrix_expr_location (e->subs[1]), + _("Exponent %.1f in matrix multiplication is non-integer " + "or outside the valid range."), bf); + return NULL; + } + long int bl = bf; + + gsl_matrix *y_ = gsl_matrix_alloc (x->size1, x->size2); + gsl_matrix *y = y_; + gsl_matrix_set_identity (y); + if (bl == 0) + return y; + + gsl_matrix *t_ = gsl_matrix_alloc (x->size1, x->size2); + gsl_matrix *t = t_; + for (unsigned long int n = labs (bl); n > 1; n /= 2) + if (n & 1) + { + mul_matrix (&y, x, y, &t); + square_matrix (&x, &t); + } + else + square_matrix (&x, &t); + + mul_matrix (&y, x, y, &t); + if (bf < 0) + invert_matrix (y); + + /* Garbage collection. + + There are three matrices: 'x_', 'y_', and 't_', and 'x', 'y', and 't' are + a permutation of them. We are returning one of them; that one must not be + destroyed. We must not destroy 'x_' because the caller owns it. */ + if (y != y_) + gsl_matrix_free (y_); + if (y != t_) + gsl_matrix_free (t_); + + return y; +} + +static void +note_operand_size (const gsl_matrix *m, const struct matrix_expr *e) +{ + msg_at (SN, matrix_expr_location (e), + _("This operand is a %zu×%zu matrix."), m->size1, m->size2); +} + +static void +note_nonscalar (const gsl_matrix *m, const struct matrix_expr *e) +{ + if (!is_scalar (m)) + note_operand_size (m, e); +} + +static gsl_matrix * +matrix_expr_evaluate_seq (const struct matrix_expr *e, + gsl_matrix *start_, gsl_matrix *end_, + gsl_matrix *by_) +{ + if (!is_scalar (start_) || !is_scalar (end_) || (by_ && !is_scalar (by_))) + { + msg_at (SE, matrix_expr_location (e), + _("All operands of : operator must be scalars.")); + + note_nonscalar (start_, e->subs[0]); + note_nonscalar (end_, e->subs[1]); + if (by_) + note_nonscalar (by_, e->subs[2]); + return NULL; + } + + long int start = to_scalar (start_); + long int end = to_scalar (end_); + long int by = by_ ? to_scalar (by_) : 1; + + if (!by) + { + msg_at (SE, matrix_expr_location (e->subs[2]), + _("The increment operand to : must be nonzero.")); + return NULL; + } + + long int n = (end >= start && by > 0 ? (end - start + by) / by + : end <= start && by < 0 ? (start - end - by) / -by + : 0); + gsl_matrix *m = gsl_matrix_alloc (1, n); + for (long int i = 0; i < n; i++) + gsl_matrix_set (m, 0, i, start + i * by); + return m; +} + +static gsl_matrix * +matrix_expr_evaluate_not (gsl_matrix *a) +{ + MATRIX_FOR_ALL_ELEMENTS (d, y, x, a) + *d = !(*d > 0); + return a; +} + +static gsl_matrix * +matrix_expr_evaluate_paste_horz (const struct matrix_expr *e, + gsl_matrix *a, gsl_matrix *b) +{ + if (a->size1 != b->size1) + { + if (!a->size1 || !a->size2) + return b; + else if (!b->size1 || !b->size2) + return a; + + msg_at (SE, matrix_expr_location (e), + _("This expression tries to horizontally join matrices with " + "differing numbers of rows.")); + note_operand_size (a, e->subs[0]); + note_operand_size (b, e->subs[1]); + return NULL; + } + + gsl_matrix *c = gsl_matrix_alloc (a->size1, a->size2 + b->size2); + for (size_t y = 0; y < a->size1; y++) + { + for (size_t x = 0; x < a->size2; x++) + gsl_matrix_set (c, y, x, gsl_matrix_get (a, y, x)); + for (size_t x = 0; x < b->size2; x++) + gsl_matrix_set (c, y, x + a->size2, gsl_matrix_get (b, y, x)); + } + return c; +} + +static gsl_matrix * +matrix_expr_evaluate_paste_vert (const struct matrix_expr *e, + gsl_matrix *a, gsl_matrix *b) +{ + if (a->size2 != b->size2) + { + if (!a->size1 || !a->size2) + return b; + else if (!b->size1 || !b->size2) + return a; + + msg_at (SE, matrix_expr_location (e), + _("This expression tries to vertically join matrices with " + "differing numbers of columns.")); + note_operand_size (a, e->subs[0]); + note_operand_size (b, e->subs[1]); + return NULL; + } + + gsl_matrix *c = gsl_matrix_alloc (a->size1 + b->size1, a->size2); + for (size_t x = 0; x < a->size2; x++) + { + for (size_t y = 0; y < a->size1; y++) + gsl_matrix_set (c, y, x, gsl_matrix_get (a, y, x)); + for (size_t y = 0; y < b->size1; y++) + gsl_matrix_set (c, y + a->size1, x, gsl_matrix_get (b, y, x)); + } + return c; +} + +static gsl_vector * +matrix_to_vector (gsl_matrix *m) +{ + assert (m->owner); + gsl_vector v = to_vector (m); + assert (v.block == m->block || !v.block); + assert (!v.owner); + v.owner = 1; + m->owner = 0; + gsl_matrix_free (m); + return xmemdup (&v, sizeof v); +} + +enum index_type { + IV_ROW, + IV_COLUMN, + IV_VECTOR +}; + +struct index_vector + { + size_t *indexes; + size_t n; + }; +#define INDEX_VECTOR_INIT (struct index_vector) { .n = 0 } + +static void +index_vector_uninit (struct index_vector *iv) +{ + if (iv) + free (iv->indexes); +} + +static bool +matrix_normalize_index_vector (const gsl_matrix *m, + const struct matrix_expr *me, size_t size, + enum index_type index_type, size_t other_size, + struct index_vector *iv) +{ + if (m) + { + if (!is_vector (m)) + { + switch (index_type) + { + case IV_VECTOR: + msg_at (SE, matrix_expr_location (me), + _("Vector index must be scalar or vector, not a " + "%zu×%zu matrix."), + m->size1, m->size2); + break; + + case IV_ROW: + msg_at (SE, matrix_expr_location (me), + _("Matrix row index must be scalar or vector, not a " + "%zu×%zu matrix."), + m->size1, m->size2); + break; + + case IV_COLUMN: + msg_at (SE, matrix_expr_location (me), + _("Matrix column index must be scalar or vector, not a " + "%zu×%zu matrix."), + m->size1, m->size2); + break; + } + return false; + } + + gsl_vector v = to_vector (CONST_CAST (gsl_matrix *, m)); + *iv = (struct index_vector) { + .indexes = xnmalloc (v.size, sizeof *iv->indexes), + .n = v.size, + }; + for (size_t i = 0; i < v.size; i++) + { + double index = gsl_vector_get (&v, i); + if (index < 1 || index >= size + 1) + { + switch (index_type) + { + case IV_VECTOR: + msg_at (SE, matrix_expr_location (me), + _("Index %g is out of range for vector " + "with %zu elements."), index, size); + break; + + case IV_ROW: + msg_at (SE, matrix_expr_location (me), + _("%g is not a valid row index for " + "a %zu×%zu matrix."), + index, size, other_size); + break; + + case IV_COLUMN: + msg_at (SE, matrix_expr_location (me), + _("%g is not a valid column index for " + "a %zu×%zu matrix."), + index, other_size, size); + break; + } + + index_vector_uninit (iv); + return false; + } + iv->indexes[i] = index - 1; + } + return true; + } + else + { + *iv = (struct index_vector) { + .indexes = xnmalloc (size, sizeof *iv->indexes), + .n = size, + }; + for (size_t i = 0; i < size; i++) + iv->indexes[i] = i; + return true; + } +} + +static gsl_matrix * +matrix_expr_evaluate_vec_all (const struct matrix_expr *e, + gsl_matrix *sm) +{ + if (!is_vector (sm)) + { + msg_at (SE, matrix_expr_location (e->subs[0]), + _("Vector index operator may not be applied to " + "a %zu×%zu matrix."), + sm->size1, sm->size2); + return NULL; + } + + return sm; +} + +static gsl_matrix * +matrix_expr_evaluate_vec_index (const struct matrix_expr *e, + gsl_matrix *sm, gsl_matrix *im) +{ + if (!matrix_expr_evaluate_vec_all (e, sm)) + return NULL; + + gsl_vector sv = to_vector (sm); + struct index_vector iv; + if (!matrix_normalize_index_vector (im, e->subs[1], + sv.size, IV_VECTOR, 0, &iv)) + return NULL; + + gsl_matrix *dm = gsl_matrix_alloc (sm->size1 == 1 ? 1 : iv.n, + sm->size1 == 1 ? iv.n : 1); + gsl_vector dv = to_vector (dm); + for (size_t dx = 0; dx < iv.n; dx++) + { + size_t sx = iv.indexes[dx]; + gsl_vector_set (&dv, dx, gsl_vector_get (&sv, sx)); + } + index_vector_uninit (&iv); + + return dm; +} + +static gsl_matrix * +matrix_expr_evaluate_mat_index (gsl_matrix *sm, + gsl_matrix *im0, const struct matrix_expr *eim0, + gsl_matrix *im1, const struct matrix_expr *eim1) +{ + struct index_vector iv0; + if (!matrix_normalize_index_vector (im0, eim0, sm->size1, + IV_ROW, sm->size2, &iv0)) + return NULL; + + struct index_vector iv1; + if (!matrix_normalize_index_vector (im1, eim1, sm->size2, + IV_COLUMN, sm->size1, &iv1)) + { + index_vector_uninit (&iv0); + return NULL; + } + + gsl_matrix *dm = gsl_matrix_alloc (iv0.n, iv1.n); + for (size_t dy = 0; dy < iv0.n; dy++) + { + size_t sy = iv0.indexes[dy]; + + for (size_t dx = 0; dx < iv1.n; dx++) + { + size_t sx = iv1.indexes[dx]; + gsl_matrix_set (dm, dy, dx, gsl_matrix_get (sm, sy, sx)); + } + } + index_vector_uninit (&iv0); + index_vector_uninit (&iv1); + return dm; +} + +#define F(ENUM, STRING, PROTO, CONSTRAINTS) \ + static gsl_matrix *matrix_expr_evaluate_##PROTO ( \ + const struct matrix_function_properties *, gsl_matrix *[], \ + const struct matrix_expr *, matrix_proto_##PROTO *); +MATRIX_FUNCTIONS +#undef F + +static bool +check_scalar_arg (const char *name, gsl_matrix *subs[], + const struct matrix_expr *e, size_t index) +{ + if (!is_scalar (subs[index])) + { + msg_at (SE, matrix_expr_location (e->subs[index]), + _("Function %s argument %zu must be a scalar, " + "not a %zu×%zu matrix."), + name, index + 1, subs[index]->size1, subs[index]->size2); + return false; + } + return true; +} + +static bool +check_vector_arg (const char *name, gsl_matrix *subs[], + const struct matrix_expr *e, size_t index) +{ + if (!is_vector (subs[index])) + { + msg_at (SE, matrix_expr_location (e->subs[index]), + _("Function %s argument %zu must be a vector, " + "not a %zu×%zu matrix."), + name, index + 1, subs[index]->size1, subs[index]->size2); + return false; + } + return true; +} + +static bool +to_scalar_args (const char *name, gsl_matrix *subs[], + const struct matrix_expr *e, double d[]) +{ + for (size_t i = 0; i < e->n_subs; i++) + { + if (!check_scalar_arg (name, subs, e, i)) + return false; + d[i] = to_scalar (subs[i]); + } + return true; +} + +static int +parse_constraint_value (const char **constraintsp) +{ + char *tail; + long retval = strtol (*constraintsp, &tail, 10); + assert (tail > *constraintsp); + *constraintsp = tail; + return retval; +} + +enum matrix_argument_relop + { + MRR_GT, /* > */ + MRR_GE, /* >= */ + MRR_LT, /* < */ + MRR_LE, /* <= */ + MRR_NE, /* <> */ + }; + +static void +argument_inequality_error ( + const struct matrix_function_properties *props, const struct matrix_expr *e, + size_t ai, gsl_matrix *a, size_t y, size_t x, + size_t bi, double b, + enum matrix_argument_relop relop) +{ + const struct msg_location *loc = matrix_expr_location (e); + switch (relop) + { + case MRR_GE: + msg_at (ME, loc, _("Argument %zu to matrix function %s must be greater " + "than or equal to argument %zu."), + ai + 1, props->name, bi + 1); + break; + + case MRR_GT: + msg_at (ME, loc, _("Argument %zu to matrix function %s must be greater " + "than argument %zu."), + ai + 1, props->name, bi + 1); + break; + + case MRR_LE: + msg_at (ME, loc, _("Argument %zu to matrix function %s must be less than " + "or equal to argument %zu."), + ai + 1, props->name, bi + 1); + break; + + case MRR_LT: + msg_at (ME, loc, _("Argument %zu to matrix function %s must be less than " + "argument %zu."), + ai + 1, props->name, bi + 1); + break; + + case MRR_NE: + msg_at (ME, loc, _("Argument %zu to matrix function %s must not be equal " + "to argument %zu."), + ai + 1, props->name, bi + 1); + break; + } + + const struct msg_location *a_loc = matrix_expr_location (e->subs[ai]); + if (is_scalar (a)) + msg_at (SN, a_loc, _("Argument %zu is %g."), + ai + 1, gsl_matrix_get (a, y, x)); + else + msg_at (SN, a_loc, _("Row %zu, column %zu of argument %zu is %g."), + y + 1, x + 1, ai + 1, gsl_matrix_get (a, y, x)); + + msg_at (SN, matrix_expr_location (e->subs[bi]), + _("Argument %zu is %g."), bi + 1, b); +} + +static void +argument_value_error ( + const struct matrix_function_properties *props, const struct matrix_expr *e, + size_t ai, gsl_matrix *a, size_t y, size_t x, + double b, + enum matrix_argument_relop relop) +{ + const struct msg_location *loc = matrix_expr_location (e); + switch (relop) + { + case MRR_GE: + msg_at (SE, loc, _("Argument %zu to matrix function %s must be greater " + "than or equal to %g."), + ai + 1, props->name, b); + break; + + case MRR_GT: + msg_at (SE, loc, _("Argument %zu to matrix function %s must be greater " + "than %g."), + ai + 1, props->name, b); + break; + + case MRR_LE: + msg_at (SE, loc, _("Argument %zu to matrix function %s must be less than " + "or equal to %g."), + ai + 1, props->name, b); + break; + + case MRR_LT: + msg_at (SE, loc, _("Argument %zu to matrix function %s must be less than " + "%g."), + ai + 1, props->name, b); + break; + + case MRR_NE: + msg_at (SE, loc, _("Argument %zu to matrix function %s must not be equal " + "to %g."), + ai + 1, props->name, b); + break; + } + + const struct msg_location *a_loc = matrix_expr_location (e->subs[ai]); + if (is_scalar (a)) + { + if (relop != MRR_NE) + msg_at (SN, a_loc, _("Argument %zu is %g."), + ai + 1, gsl_matrix_get (a, y, x)); + } + else + msg_at (SN, a_loc, _("Row %zu, column %zu of argument %zu is %g."), + y + 1, x + 1, ai + 1, gsl_matrix_get (a, y, x)); +} + +static bool +matrix_argument_relop_is_satisfied (double a, double b, + enum matrix_argument_relop relop) +{ + switch (relop) + { + case MRR_GE: return a >= b; + case MRR_GT: return a > b; + case MRR_LE: return a <= b; + case MRR_LT: return a < b; + case MRR_NE: return a != b; + } + + NOT_REACHED (); +} + +static enum matrix_argument_relop +matrix_argument_relop_flip (enum matrix_argument_relop relop) +{ + switch (relop) + { + case MRR_GE: return MRR_LE; + case MRR_GT: return MRR_LT; + case MRR_LE: return MRR_GE; + case MRR_LT: return MRR_GT; + case MRR_NE: return MRR_NE; + } + + NOT_REACHED (); +} + +static bool +check_constraints (const struct matrix_function_properties *props, + gsl_matrix *args[], const struct matrix_expr *e) +{ + size_t n_args = e->n_subs; + const char *constraints = props->constraints; + if (!constraints) + return true; + + size_t arg_index = SIZE_MAX; + while (*constraints) + { + if (*constraints >= 'a' && *constraints <= 'd') + { + arg_index = *constraints++ - 'a'; + assert (arg_index < n_args); + } + else if (*constraints == '[' || *constraints == '(') + { + assert (arg_index < n_args); + bool open_lower = *constraints++ == '('; + int minimum = parse_constraint_value (&constraints); + assert (*constraints == ','); + constraints++; + int maximum = parse_constraint_value (&constraints); + assert (*constraints == ']' || *constraints == ')'); + bool open_upper = *constraints++ == ')'; + + MATRIX_FOR_ALL_ELEMENTS (d, y, x, args[arg_index]) + if ((open_lower ? *d <= minimum : *d < minimum) + || (open_upper ? *d >= maximum : *d > maximum)) + { + if (!is_scalar (args[arg_index])) + msg_at (SE, matrix_expr_location (e->subs[arg_index]), + _("Row %zu, column %zu of argument %zu to matrix " + "function %s is %g, which is outside " + "the valid range %c%d,%d%c."), + y + 1, x + 1, arg_index + 1, props->name, *d, + open_lower ? '(' : '[', + minimum, maximum, + open_upper ? ')' : ']'); + else + msg_at (SE, matrix_expr_location (e->subs[arg_index]), + _("Argument %zu to matrix function %s is %g, " + "which is outside the valid range %c%d,%d%c."), + arg_index + 1, props->name, *d, + open_lower ? '(' : '[', + minimum, maximum, + open_upper ? ')' : ']'); + return false; + } + } + else if (*constraints == 'i') + { + constraints++; + MATRIX_FOR_ALL_ELEMENTS (d, y, x, args[arg_index]) + if (*d != floor (*d)) + { + if (!is_scalar (args[arg_index])) + msg_at (SE, matrix_expr_location (e->subs[arg_index]), + _("Argument %zu to matrix function %s, which must be " + "integer, contains non-integer value %g in " + "row %zu, column %zu."), + arg_index + 1, props->name, *d, y + 1, x + 1); + else + msg_at (SE, matrix_expr_location (e->subs[arg_index]), + _("Argument %zu to matrix function %s, which must be " + "integer, has non-integer value %g."), + arg_index + 1, props->name, *d); + return false; + } + } + else if (*constraints == '>' + || *constraints == '<' + || *constraints == '!') + { + enum matrix_argument_relop relop; + switch (*constraints++) + { + case '>': + if (*constraints == '=') + { + constraints++; + relop = MRR_GE; + } + else + relop = MRR_GT; + break; + + case '<': + if (*constraints == '=') + { + constraints++; + relop = MRR_LE; + } + else + relop = MRR_LT; + break; + + case '!': + assert (*constraints == '='); + constraints++; + relop = MRR_NE; + break; + + default: + NOT_REACHED (); + } + + if (*constraints >= 'a' && *constraints <= 'd') + { + size_t a_index = arg_index; + size_t b_index = *constraints - 'a'; + assert (a_index < n_args); + assert (b_index < n_args); + + /* We only support one of the two arguments being non-scalar. + It's easier to support only the first one being non-scalar, so + flip things around if it's the other way. */ + if (!is_scalar (args[b_index])) + { + assert (is_scalar (args[a_index])); + size_t tmp_index = a_index; + a_index = b_index; + b_index = tmp_index; + relop = matrix_argument_relop_flip (relop); + } + + double b = to_scalar (args[b_index]); + MATRIX_FOR_ALL_ELEMENTS (a, y, x, args[a_index]) + if (!matrix_argument_relop_is_satisfied (*a, b, relop)) + { + argument_inequality_error ( + props, e, + a_index, args[a_index], y, x, + b_index, b, + relop); + return false; + } + } + else + { + int comparand = parse_constraint_value (&constraints); + + MATRIX_FOR_ALL_ELEMENTS (d, y, x, args[arg_index]) + if (!matrix_argument_relop_is_satisfied (*d, comparand, relop)) + { + argument_value_error ( + props, e, + arg_index, args[arg_index], y, x, + comparand, + relop); + return false; + } + } + } + else + { + assert (*constraints == ' '); + constraints++; + arg_index = SIZE_MAX; + } + } + return true; +} + +static gsl_matrix * +matrix_expr_evaluate_d_none (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_d_none *f) +{ + assert (e->n_subs == 0); + + if (!check_constraints (props, subs, e)) + return NULL; + + gsl_matrix *m = gsl_matrix_alloc (1, 1); + gsl_matrix_set (m, 0, 0, f ()); + return m; +} + +static gsl_matrix * +matrix_expr_evaluate_d_d (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_d_d *f) +{ + assert (e->n_subs == 1); + + double d; + if (!to_scalar_args (props->name, subs, e, &d) + || !check_constraints (props, subs, e)) + return NULL; + + gsl_matrix *m = gsl_matrix_alloc (1, 1); + gsl_matrix_set (m, 0, 0, f (d)); + return m; +} + +static gsl_matrix * +matrix_expr_evaluate_d_dd (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_d_dd *f) +{ + assert (e->n_subs == 2); + + double d[2]; + if (!to_scalar_args (props->name, subs, e, d) + && !check_constraints (props, subs, e)) + return NULL; + + gsl_matrix *m = gsl_matrix_alloc (1, 1); + gsl_matrix_set (m, 0, 0, f (d[0], d[1])); + return m; +} + +static gsl_matrix * +matrix_expr_evaluate_d_ddd (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_d_ddd *f) +{ + assert (e->n_subs == 3); + + double d[3]; + if (!to_scalar_args (props->name, subs, e, d) + || !check_constraints (props, subs, e)) + return NULL; + + gsl_matrix *m = gsl_matrix_alloc (1, 1); + gsl_matrix_set (m, 0, 0, f (d[0], d[1], d[2])); + return m; +} + +static gsl_matrix * +matrix_expr_evaluate_m_d (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_d *f) +{ + assert (e->n_subs == 1); + + double d; + return (to_scalar_args (props->name, subs, e, &d) + && check_constraints (props, subs, e) + ? f(d) + : NULL); +} + +static gsl_matrix * +matrix_expr_evaluate_m_ddd (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_ddd *f) +{ + assert (e->n_subs == 3); + + double d[3]; + return (to_scalar_args (props->name, subs, e, d) + && check_constraints (props, subs, e) + ? f(d[0], d[1], d[2]) + : NULL); +} + +static gsl_matrix * +matrix_expr_evaluate_m_ddn (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_ddn *f) +{ + assert (e->n_subs == 2); + + double d[2]; + return (to_scalar_args (props->name, subs, e, d) + && check_constraints (props, subs, e) + ? f(d[0], d[1], e) + : NULL); +} + +static gsl_matrix * +matrix_expr_evaluate_m_m (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_m *f) +{ + assert (e->n_subs == 1); + return check_constraints (props, subs, e) ? f (subs[0]) : NULL; +} + +static gsl_matrix * +matrix_expr_evaluate_m_mn (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_mn *f) +{ + assert (e->n_subs == 1); + return check_constraints (props, subs, e) ? f (subs[0], e) : NULL; +} + +static gsl_matrix * +matrix_expr_evaluate_m_e (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_e *f) +{ + assert (e->n_subs == 1); + + if (!check_constraints (props, subs, e)) + return NULL; + + MATRIX_FOR_ALL_ELEMENTS (a, y, x, subs[0]) + *a = f (*a); + return subs[0]; +} + +static gsl_matrix * +matrix_expr_evaluate_m_md (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_md *f) +{ + assert (e->n_subs == 2); + return (check_scalar_arg (props->name, subs, e, 1) + && check_constraints (props, subs, e) + ? f (subs[0], to_scalar (subs[1])) + : NULL); +} + +static gsl_matrix * +matrix_expr_evaluate_m_mdn (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_mdn *f) +{ + assert (e->n_subs == 2); + return (check_scalar_arg (props->name, subs, e, 1) + && check_constraints (props, subs, e) + ? f (subs[0], to_scalar (subs[1]), e) + : NULL); +} + +static gsl_matrix * +matrix_expr_evaluate_m_ed (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_ed *f) +{ + assert (e->n_subs == 2); + if (!check_scalar_arg (props->name, subs, e, 1) + || !check_constraints (props, subs, e)) + return NULL; + + double b = to_scalar (subs[1]); + MATRIX_FOR_ALL_ELEMENTS (a, y, x, subs[0]) + *a = f (*a, b); + return subs[0]; +} + +static gsl_matrix * +matrix_expr_evaluate_m_mddn (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_mddn *f) +{ + assert (e->n_subs == 3); + if (!check_scalar_arg (props->name, subs, e, 1) + || !check_scalar_arg (props->name, subs, e, 2) + || !check_constraints (props, subs, e)) + return NULL; + return f (subs[0], to_scalar (subs[1]), to_scalar (subs[2]), e); +} + +static gsl_matrix * +matrix_expr_evaluate_m_edd (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_edd *f) +{ + assert (e->n_subs == 3); + if (!check_scalar_arg (props->name, subs, e, 1) + || !check_scalar_arg (props->name, subs, e, 2) + || !check_constraints (props, subs, e)) + return NULL; + + double b = to_scalar (subs[1]); + double c = to_scalar (subs[2]); + MATRIX_FOR_ALL_ELEMENTS (a, y, x, subs[0]) + *a = f (*a, b, c); + return subs[0]; +} + +static gsl_matrix * +matrix_expr_evaluate_m_eddd (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_eddd *f) +{ + assert (e->n_subs == 4); + for (size_t i = 1; i < 4; i++) + if (!check_scalar_arg (props->name, subs, e, i)) + return NULL; + + if (!check_constraints (props, subs, e)) + return NULL; + + double b = to_scalar (subs[1]); + double c = to_scalar (subs[2]); + double d = to_scalar (subs[3]); + MATRIX_FOR_ALL_ELEMENTS (a, y, x, subs[0]) + *a = f (*a, b, c, d); + return subs[0]; +} + +static gsl_matrix * +matrix_expr_evaluate_m_eed (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_eed *f) +{ + assert (e->n_subs == 3); + if (!check_scalar_arg (props->name, subs, e, 2)) + return NULL; + + if (!is_scalar (subs[0]) && !is_scalar (subs[1]) + && (subs[0]->size1 != subs[1]->size1 || subs[0]->size2 != subs[1]->size2)) + { + struct msg_location *loc = msg_location_dup (e->subs[0]->location); + loc->end = e->subs[1]->location->end; + + msg_at (ME, loc, + _("Arguments 1 and 2 to %s have dimensions %zu×%zu and " + "%zu×%zu, but %s requires these arguments either to have " + "the same dimensions or for one of them to be a scalar."), + props->name, + subs[0]->size1, subs[0]->size2, + subs[1]->size1, subs[1]->size2, + props->name); + + msg_location_destroy (loc); + return NULL; + } + + if (!check_constraints (props, subs, e)) + return NULL; + + double c = to_scalar (subs[2]); + + if (is_scalar (subs[0])) + { + double a = to_scalar (subs[0]); + MATRIX_FOR_ALL_ELEMENTS (b, y, x, subs[1]) + *b = f (a, *b, c); + return subs[1]; + } + else + { + double b = to_scalar (subs[1]); + MATRIX_FOR_ALL_ELEMENTS (a, y, x, subs[0]) + *a = f (*a, b, c); + return subs[0]; + } +} + +static gsl_matrix * +matrix_expr_evaluate_m_mm (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_mm *f) +{ + assert (e->n_subs == 2); + return check_constraints (props, subs, e) ? f (subs[0], subs[1]) : NULL; +} + +static gsl_matrix * +matrix_expr_evaluate_m_mmn (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_mmn *f) +{ + assert (e->n_subs == 2); + return check_constraints (props, subs, e) ? f (subs[0], subs[1], e) : NULL; +} + +static gsl_matrix * +matrix_expr_evaluate_m_v (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_v *f) +{ + assert (e->n_subs == 1); + if (!check_vector_arg (props->name, subs, e, 0) + || !check_constraints (props, subs, e)) + return NULL; + gsl_vector v = to_vector (subs[0]); + return f (&v); +} + +static gsl_matrix * +matrix_expr_evaluate_d_m (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_d_m *f) +{ + assert (e->n_subs == 1); + + if (!check_constraints (props, subs, e)) + return NULL; + + gsl_matrix *m = gsl_matrix_alloc (1, 1); + gsl_matrix_set (m, 0, 0, f (subs[0])); + return m; +} + +static gsl_matrix * +matrix_expr_evaluate_m_any (const struct matrix_function_properties *props, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_m_any *f) +{ + return check_constraints (props, subs, e) ? f (subs, e->n_subs) : NULL; +} + +static gsl_matrix * +matrix_expr_evaluate_IDENT (const struct matrix_function_properties *props_ UNUSED, + gsl_matrix *subs[], const struct matrix_expr *e, + matrix_proto_IDENT *f) +{ + static const struct matrix_function_properties p1 = { + .name = "IDENT", + .constraints = "ai>=0" + }; + static const struct matrix_function_properties p2 = { + .name = "IDENT", + .constraints = "ai>=0 bi>=0" + }; + const struct matrix_function_properties *props = e->n_subs == 1 ? &p1 : &p2; + + assert (e->n_subs <= 2); + + double d[2]; + return (to_scalar_args (props->name, subs, e, d) + && check_constraints (props, subs, e) + ? f (d[0], d[e->n_subs - 1]) + : NULL); +} + +static gsl_matrix * +matrix_expr_evaluate (const struct matrix_expr *e) +{ + if (e->op == MOP_NUMBER) + { + gsl_matrix *m = gsl_matrix_alloc (1, 1); + gsl_matrix_set (m, 0, 0, e->number); + return m; + } + else if (e->op == MOP_VARIABLE) + { + const gsl_matrix *src = e->variable->value; + if (!src) + { + msg_at (SE, e->location, + _("Uninitialized variable %s used in expression."), + e->variable->name); + return NULL; + } + + gsl_matrix *dst = gsl_matrix_alloc (src->size1, src->size2); + gsl_matrix_memcpy (dst, src); + return dst; + } + else if (e->op == MOP_EOF) + { + struct dfm_reader *reader = read_file_open (e->eof); + gsl_matrix *m = gsl_matrix_alloc (1, 1); + gsl_matrix_set (m, 0, 0, !reader || dfm_eof (reader)); + return m; + } + + enum { N_LOCAL = 3 }; + gsl_matrix *local_subs[N_LOCAL]; + gsl_matrix **subs = (e->n_subs < N_LOCAL + ? local_subs + : xmalloc (e->n_subs * sizeof *subs)); + + for (size_t i = 0; i < e->n_subs; i++) + { + subs[i] = matrix_expr_evaluate (e->subs[i]); + if (!subs[i]) + { + for (size_t j = 0; j < i; j++) + gsl_matrix_free (subs[j]); + if (subs != local_subs) + free (subs); + return NULL; + } + } + + gsl_matrix *result = NULL; + switch (e->op) + { +#define F(ENUM, STRING, PROTO, CONSTRAINTS) \ + case MOP_F_##ENUM: \ + { \ + static const struct matrix_function_properties props = { \ + .name = STRING, \ + .constraints = CONSTRAINTS, \ + }; \ + result = matrix_expr_evaluate_##PROTO (&props, subs, e, \ + matrix_eval_##ENUM); \ + } \ + break; + MATRIX_FUNCTIONS +#undef F + + case MOP_NEGATE: + gsl_matrix_scale (subs[0], -1.0); + result = subs[0]; + break; + + case MOP_ADD_ELEMS: + case MOP_SUB_ELEMS: + case MOP_MUL_ELEMS: + case MOP_DIV_ELEMS: + case MOP_EXP_ELEMS: + case MOP_GT: + case MOP_GE: + case MOP_LT: + case MOP_LE: + case MOP_EQ: + case MOP_NE: + case MOP_AND: + case MOP_OR: + case MOP_XOR: + result = matrix_expr_evaluate_elementwise (e, e->op, subs[0], subs[1]); + break; + + case MOP_NOT: + result = matrix_expr_evaluate_not (subs[0]); + break; + + case MOP_SEQ: + result = matrix_expr_evaluate_seq (e, subs[0], subs[1], NULL); + break; + + case MOP_SEQ_BY: + result = matrix_expr_evaluate_seq (e, subs[0], subs[1], subs[2]); + break; + + case MOP_MUL_MAT: + result = matrix_expr_evaluate_mul_mat (e, subs[0], subs[1]); + break; + + case MOP_EXP_MAT: + result = matrix_expr_evaluate_exp_mat (e, subs[0], subs[1]); + break; + + case MOP_PASTE_HORZ: + result = matrix_expr_evaluate_paste_horz (e, subs[0], subs[1]); + break; + + case MOP_PASTE_VERT: + result = matrix_expr_evaluate_paste_vert (e, subs[0], subs[1]); + break; + + case MOP_EMPTY: + result = gsl_matrix_alloc (0, 0); + break; + + case MOP_VEC_INDEX: + result = matrix_expr_evaluate_vec_index (e, subs[0], subs[1]); + break; + + case MOP_VEC_ALL: + result = matrix_expr_evaluate_vec_all (e, subs[0]); + break; + + case MOP_MAT_INDEX: + result = matrix_expr_evaluate_mat_index (subs[0], + subs[1], e->subs[1], + subs[2], e->subs[2]); + break; + + case MOP_ROW_INDEX: + result = matrix_expr_evaluate_mat_index (subs[0], + subs[1], e->subs[1], + NULL, NULL); + break; + + case MOP_COL_INDEX: + result = matrix_expr_evaluate_mat_index (subs[0], + NULL, NULL, + subs[1], e->subs[1]); + break; + + case MOP_NUMBER: + case MOP_VARIABLE: + case MOP_EOF: + NOT_REACHED (); + } + + for (size_t i = 0; i < e->n_subs; i++) + if (subs[i] != result) + gsl_matrix_free (subs[i]); + if (subs != local_subs) + free (subs); + return result; +} + +static bool +matrix_expr_evaluate_scalar (const struct matrix_expr *e, const char *context, + double *d) +{ + gsl_matrix *m = matrix_expr_evaluate (e); + if (!m) + return false; + + if (!is_scalar (m)) + { + msg_at (SE, matrix_expr_location (e), + _("Expression for %s must evaluate to scalar, " + "not a %zu×%zu matrix."), + context, m->size1, m->size2); + gsl_matrix_free (m); + return false; + } + + *d = to_scalar (m); + gsl_matrix_free (m); + return true; +} + +static bool +matrix_expr_evaluate_integer (const struct matrix_expr *e, const char *context, + long int *integer) +{ + double d; + if (!matrix_expr_evaluate_scalar (e, context, &d)) + return false; + + d = trunc (d); + if (d < LONG_MIN || d > LONG_MAX) + { + msg_at (SE, matrix_expr_location (e), + _("Expression for %s is outside the integer range."), context); + return false; + } + *integer = d; + return true; +} + +/* Matrix lvalues. + + An lvalue is an expression that can appear on the left side of a COMPUTE + command and in other contexts that assign values. + + An lvalue is parsed once, with matrix_lvalue_parse(). It can then be + evaluated (with matrix_lvalue_evaluate()) and assigned (with + matrix_lvalue_assign()). + + There are three kinds of lvalues: + + - A variable name. A variable used as an lvalue need not be initialized, + since the assignment will initialize. + + - A subvector, e.g. "var(index0)". The variable must be initialized and + must have the form of a vector (it must have 1 column or 1 row). + + - A submatrix, e.g. "var(index0, index1)". The variable must be + initialized. */ +struct matrix_lvalue + { + struct matrix_var *var; /* Destination variable. */ + struct matrix_expr *indexes[2]; /* Index expressions, if any. */ + size_t n_indexes; /* Number of indexes. */ + + struct msg_location *var_location; /* Variable name. */ + struct msg_location *full_location; /* Variable name plus indexing. */ + struct msg_location *index_locations[2]; /* Index expressions. */ + }; + +/* Frees LVALUE. */ +static void +matrix_lvalue_destroy (struct matrix_lvalue *lvalue) +{ + if (lvalue) + { + msg_location_destroy (lvalue->var_location); + msg_location_destroy (lvalue->full_location); + for (size_t i = 0; i < lvalue->n_indexes; i++) + { + matrix_expr_destroy (lvalue->indexes[i]); + msg_location_destroy (lvalue->index_locations[i]); + } + free (lvalue); + } +} + +/* Parses and returns an lvalue at the current position in S's lexer. Returns + null on parse failure. On success, the caller must eventually free the + lvalue. */ +static struct matrix_lvalue * +matrix_lvalue_parse (struct matrix_state *s) +{ + if (!lex_force_id (s->lexer)) + return NULL; + + struct matrix_lvalue *lvalue = xzalloc (sizeof *lvalue); + int start_ofs = lex_ofs (s->lexer); + lvalue->var_location = lex_get_location (s->lexer, 0, 0); + lvalue->var = matrix_var_lookup (s, lex_tokss (s->lexer)); + if (lex_next_token (s->lexer, 1) == T_LPAREN) + { + if (!lvalue->var) + { + msg (SE, _("Undefined variable %s."), lex_tokcstr (s->lexer)); + goto error; + } + + lex_get_n (s->lexer, 2); + + if (!matrix_parse_index_expr (s, &lvalue->indexes[0], + &lvalue->index_locations[0])) + goto error; + lvalue->n_indexes++; + + if (lex_match (s->lexer, T_COMMA)) + { + if (!matrix_parse_index_expr (s, &lvalue->indexes[1], + &lvalue->index_locations[1])) + goto error; + lvalue->n_indexes++; + } + if (!lex_force_match (s->lexer, T_RPAREN)) + goto error; + + lvalue->full_location = lex_ofs_location (s->lexer, start_ofs, + lex_ofs (s->lexer) - 1); + } + else + { + if (!lvalue->var) + lvalue->var = matrix_var_create (s, lex_tokss (s->lexer)); + lex_get (s->lexer); + } + return lvalue; + +error: + matrix_lvalue_destroy (lvalue); + return NULL; +} + +static bool +matrix_lvalue_evaluate_vector (struct matrix_expr *e, size_t size, + enum index_type index_type, size_t other_size, + struct index_vector *iv) +{ + gsl_matrix *m; + if (e) + { + m = matrix_expr_evaluate (e); + if (!m) + return false; + } + else + m = NULL; + + bool ok = matrix_normalize_index_vector (m, e, size, index_type, + other_size, iv); + gsl_matrix_free (m); + return ok; +} + +/* Evaluates the indexes in LVALUE into IV0 and IV1, owned by the caller. + Returns true if successful, false if evaluating the expressions failed or if + LVALUE otherwise can't be used for an assignment. + + On success, the caller retains ownership of the index vectors, which are + suitable for passing to matrix_lvalue_assign(). If not used for that + purpose then they need to eventually be freed (with + index_vector_uninit()). */ +static bool +matrix_lvalue_evaluate (struct matrix_lvalue *lvalue, + struct index_vector *iv0, + struct index_vector *iv1) +{ + *iv0 = INDEX_VECTOR_INIT; + *iv1 = INDEX_VECTOR_INIT; + if (!lvalue->n_indexes) + return true; + + /* Validate destination matrix exists and has the right shape. */ + gsl_matrix *dm = lvalue->var->value; + if (!dm) + { + msg_at (SE, lvalue->var_location, + _("Undefined variable %s."), lvalue->var->name); + return false; + } + else if (dm->size1 == 0 || dm->size2 == 0) + { + msg_at (SE, lvalue->full_location, _("Cannot index %zu×%zu matrix %s."), + dm->size1, dm->size2, lvalue->var->name); + return false; + } + else if (lvalue->n_indexes == 1) + { + if (!is_vector (dm)) + { + msg_at (SE, lvalue->full_location, + _("Can't use vector indexing on %zu×%zu matrix %s."), + dm->size1, dm->size2, lvalue->var->name); + return false; + } + return matrix_lvalue_evaluate_vector (lvalue->indexes[0], + MAX (dm->size1, dm->size2), + IV_VECTOR, 0, iv0); + } + else + { + assert (lvalue->n_indexes == 2); + if (!matrix_lvalue_evaluate_vector (lvalue->indexes[0], dm->size1, + IV_ROW, dm->size2, iv0)) + return false; + + if (!matrix_lvalue_evaluate_vector (lvalue->indexes[1], dm->size2, + IV_COLUMN, dm->size1, iv1)) + { + index_vector_uninit (iv0); + return false; + } + return true; + } +} + +static bool +matrix_lvalue_assign_vector (struct matrix_lvalue *lvalue, + struct index_vector *iv, + gsl_matrix *sm, const struct msg_location *lsm) +{ + /* Convert source matrix 'sm' to source vector 'sv'. */ + if (!is_vector (sm)) + { + msg_at (SE, lvalue->full_location, + _("Only an %zu-element vector may be assigned to this " + "%zu-element subvector of %s."), + iv->n, iv->n, lvalue->var->name); + msg_at (SE, lsm, + _("The source is an %zu×%zu matrix."), + sm->size1, sm->size2); + return false; + } + gsl_vector sv = to_vector (sm); + if (iv->n != sv.size) + { + msg_at (SE, lvalue->full_location, + _("Only an %zu-element vector may be assigned to this " + "%zu-element subvector of %s."), + iv->n, iv->n, lvalue->var->name); + msg_at (SE, lsm, ngettext ("The source vector has %zu element.", + "The source vector has %zu elements.", + sv.size), + sv.size); + return false; + } + + /* Assign elements. */ + gsl_vector dv = to_vector (lvalue->var->value); + for (size_t x = 0; x < iv->n; x++) + gsl_vector_set (&dv, iv->indexes[x], gsl_vector_get (&sv, x)); + return true; +} + +static bool +matrix_lvalue_assign_matrix (struct matrix_lvalue *lvalue, + struct index_vector *iv0, + struct index_vector *iv1, + gsl_matrix *sm, const struct msg_location *lsm) +{ + gsl_matrix *dm = lvalue->var->value; + + /* Convert source matrix 'sm' to source vector 'sv'. */ + bool wrong_rows = iv0->n != sm->size1; + bool wrong_columns = iv1->n != sm->size2; + if (wrong_rows || wrong_columns) + { + if (wrong_rows && wrong_columns) + msg_at (SE, lvalue->full_location, + _("Numbers of indexes for assigning to %s differ from the " + "size of the source matrix."), + lvalue->var->name); + else if (wrong_rows) + msg_at (SE, lvalue->full_location, + _("Number of row indexes for assigning to %s differs from " + "number of rows in source matrix."), + lvalue->var->name); + else + msg_at (SE, lvalue->full_location, + _("Number of column indexes for assigning to %s differs from " + "number of columns in source matrix."), + lvalue->var->name); + + if (wrong_rows) + { + if (lvalue->indexes[0]) + msg_at (SN, lvalue->index_locations[0], + ngettext ("There is %zu row index.", + "There are %zu row indexes.", + iv0->n), + iv0->n); + else + msg_at (SN, lvalue->index_locations[0], + ngettext ("Destination matrix %s has %zu row.", + "Destination matrix %s has %zu rows.", + iv0->n), + lvalue->var->name, iv0->n); + } + + if (wrong_columns) + { + if (lvalue->indexes[1]) + msg_at (SN, lvalue->index_locations[1], + ngettext ("There is %zu column index.", + "There are %zu column indexes.", + iv1->n), + iv1->n); + else + msg_at (SN, lvalue->index_locations[1], + ngettext ("Destination matrix %s has %zu column.", + "Destination matrix %s has %zu columns.", + iv1->n), + lvalue->var->name, iv1->n); + } + + msg_at (SN, lsm, _("The source matrix is %zu×%zu."), + sm->size1, sm->size2); + return false; + } + + /* Assign elements. */ + for (size_t y = 0; y < iv0->n; y++) + { + size_t f0 = iv0->indexes[y]; + for (size_t x = 0; x < iv1->n; x++) + { + size_t f1 = iv1->indexes[x]; + gsl_matrix_set (dm, f0, f1, gsl_matrix_get (sm, y, x)); + } + } + return true; +} + +/* Assigns rvalue SM to LVALUE, whose index vectors IV0 and IV1 were previously + obtained with matrix_lvalue_evaluate(). Returns true if successful, false + on error. Always takes ownership of M. LSM should be the source location + to use for errors related to SM. */ +static bool +matrix_lvalue_assign (struct matrix_lvalue *lvalue, + struct index_vector *iv0, struct index_vector *iv1, + gsl_matrix *sm, const struct msg_location *lsm) +{ + if (!lvalue->n_indexes) + { + gsl_matrix_free (lvalue->var->value); + lvalue->var->value = sm; + return true; + } + else + { + bool ok = (lvalue->n_indexes == 1 + ? matrix_lvalue_assign_vector (lvalue, iv0, sm, lsm) + : matrix_lvalue_assign_matrix (lvalue, iv0, iv1, sm, lsm)); + index_vector_uninit (iv0); + index_vector_uninit (iv1); + gsl_matrix_free (sm); + return ok; + } +} + +/* Evaluates and then assigns SM to LVALUE. Always takes ownership of M. LSM + should be the source location to use for errors related to SM.*/ +static bool +matrix_lvalue_evaluate_and_assign (struct matrix_lvalue *lvalue, + gsl_matrix *sm, + const struct msg_location *lsm) +{ + struct index_vector iv0, iv1; + if (!matrix_lvalue_evaluate (lvalue, &iv0, &iv1)) + { + gsl_matrix_free (sm); + return false; + } + + return matrix_lvalue_assign (lvalue, &iv0, &iv1, sm, lsm); +} + +/* Matrix command data structure. */ + +/* An array of matrix commands. */ +struct matrix_commands + { + struct matrix_command **commands; + size_t n; + }; + +static bool matrix_commands_parse (struct matrix_state *, + struct matrix_commands *, + const char *command_name, + const char *stop1, const char *stop2); +static void matrix_commands_uninit (struct matrix_commands *); + +/* A single matrix command. */ +struct matrix_command + { + /* The type of command. */ + enum matrix_command_type + { + MCMD_COMPUTE, + MCMD_PRINT, + MCMD_DO_IF, + MCMD_LOOP, + MCMD_BREAK, + MCMD_DISPLAY, + MCMD_RELEASE, + MCMD_SAVE, + MCMD_READ, + MCMD_WRITE, + MCMD_GET, + MCMD_MSAVE, + MCMD_MGET, + MCMD_EIGEN, + MCMD_SETDIAG, + MCMD_SVD, + } + type; + + /* Source lines for this command. */ + struct msg_location *location; + + union + { + struct matrix_compute + { + struct matrix_lvalue *lvalue; + struct matrix_expr *rvalue; + } + compute; + + struct matrix_print + { + struct matrix_expr *expression; + bool use_default_format; + struct fmt_spec format; + char *title; + int space; /* -1 means NEWPAGE. */ + + struct print_labels + { + struct string_array literals; /* CLABELS/RLABELS. */ + struct matrix_expr *expr; /* CNAMES/RNAMES. */ + } + *rlabels, *clabels; + } + print; + + struct matrix_do_if + { + struct do_if_clause + { + struct matrix_expr *condition; + struct matrix_commands commands; + } + *clauses; + size_t n_clauses; + } + do_if; + + struct matrix_loop + { + /* Index. */ + struct matrix_var *var; + struct matrix_expr *start; + struct matrix_expr *end; + struct matrix_expr *increment; + + /* Loop conditions. */ + struct matrix_expr *top_condition; + struct matrix_expr *bottom_condition; + + /* Commands. */ + struct matrix_commands commands; + } + loop; + + struct matrix_display + { + struct matrix_state *state; + } + display; + + struct matrix_release + { + struct matrix_var **vars; + size_t n_vars; + } + release; + + struct matrix_save + { + struct matrix_expr *expression; + struct save_file *sf; + } + save; + + struct matrix_read + { + struct read_file *rf; + struct matrix_lvalue *dst; + struct matrix_expr *size; + int c1, c2; + enum fmt_type format; + int w; + bool symmetric; + bool reread; + } + read; + + struct matrix_write + { + struct write_file *wf; + struct matrix_expr *expression; + int c1, c2; + + /* If this is nonnull, WRITE uses this format. + + If this is NULL, WRITE uses free-field format with as many + digits of precision as needed. */ + struct fmt_spec *format; + + bool triangular; + bool hold; + } + write; + + struct matrix_get + { + struct matrix_lvalue *dst; + struct dataset *dataset; + struct file_handle *file; + char *encoding; + struct var_syntax *vars; + size_t n_vars; + struct matrix_var *names; + + /* Treatment of missing values. */ + struct + { + enum + { + MGET_ERROR, /* Flag error on command. */ + MGET_ACCEPT, /* Accept without change, user-missing only. */ + MGET_OMIT, /* Drop this case. */ + MGET_RECODE /* Recode to 'substitute'. */ + } + treatment; + double substitute; /* MGET_RECODE only. */ + } + user, system; + } + get; + + struct matrix_msave + { + struct msave_common *common; + struct matrix_expr *expr; + const char *rowtype; + const struct matrix_expr *factors; + const struct matrix_expr *splits; + } + msave; + + struct matrix_mget + { + struct matrix_state *state; + struct file_handle *file; + char *encoding; + struct stringi_set rowtypes; + } + mget; + + struct matrix_eigen + { + struct matrix_expr *expr; + struct matrix_var *evec; + struct matrix_var *eval; + } + eigen; + + struct matrix_setdiag + { + struct matrix_var *dst; + struct matrix_expr *expr; + } + setdiag; + + struct matrix_svd + { + struct matrix_expr *expr; + struct matrix_var *u; + struct matrix_var *s; + struct matrix_var *v; + } + svd; + }; + }; + +static struct matrix_command *matrix_command_parse (struct matrix_state *); +static bool matrix_command_execute (struct matrix_command *); +static void matrix_command_destroy (struct matrix_command *); + +/* COMPUTE. */ + +static struct matrix_command * +matrix_compute_parse (struct matrix_state *s) +{ + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { + .type = MCMD_COMPUTE, + .compute = { .lvalue = NULL }, + }; + + struct matrix_compute *compute = &cmd->compute; + compute->lvalue = matrix_lvalue_parse (s); + if (!compute->lvalue) + goto error; + + if (!lex_force_match (s->lexer, T_EQUALS)) + goto error; + + compute->rvalue = matrix_expr_parse (s); + if (!compute->rvalue) + goto error; + + return cmd; + +error: + matrix_command_destroy (cmd); + return NULL; +} + +static void +matrix_compute_execute (struct matrix_command *cmd) +{ + struct matrix_compute *compute = &cmd->compute; + gsl_matrix *value = matrix_expr_evaluate (compute->rvalue); + if (!value) + return; + + matrix_lvalue_evaluate_and_assign (compute->lvalue, value, + matrix_expr_location (compute->rvalue)); +} + +/* PRINT. */ + +static void +print_labels_destroy (struct print_labels *labels) +{ + if (labels) + { + string_array_destroy (&labels->literals); + matrix_expr_destroy (labels->expr); + free (labels); + } +} + +static void +parse_literal_print_labels (struct matrix_state *s, + struct print_labels **labelsp) +{ + lex_match (s->lexer, T_EQUALS); + print_labels_destroy (*labelsp); + *labelsp = xzalloc (sizeof **labelsp); + while (lex_token (s->lexer) != T_SLASH + && lex_token (s->lexer) != T_ENDCMD + && lex_token (s->lexer) != T_STOP) + { + struct string label = DS_EMPTY_INITIALIZER; + while (lex_token (s->lexer) != T_COMMA + && lex_token (s->lexer) != T_SLASH + && lex_token (s->lexer) != T_ENDCMD + && lex_token (s->lexer) != T_STOP) + { + if (!ds_is_empty (&label)) + ds_put_byte (&label, ' '); + + if (lex_token (s->lexer) == T_STRING) + ds_put_cstr (&label, lex_tokcstr (s->lexer)); + else + { + char *rep = lex_next_representation (s->lexer, 0, 0); + ds_put_cstr (&label, rep); + free (rep); + } + lex_get (s->lexer); + } + string_array_append_nocopy (&(*labelsp)->literals, + ds_steal_cstr (&label)); + + if (!lex_match (s->lexer, T_COMMA)) + break; + } +} + +static bool +parse_expr_print_labels (struct matrix_state *s, struct print_labels **labelsp) +{ + lex_match (s->lexer, T_EQUALS); + struct matrix_expr *e = matrix_parse_exp (s); + if (!e) + return false; + + print_labels_destroy (*labelsp); + *labelsp = xzalloc (sizeof **labelsp); + (*labelsp)->expr = e; + return true; +} + +static struct matrix_command * +matrix_print_parse (struct matrix_state *s) +{ + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { + .type = MCMD_PRINT, + .print = { + .use_default_format = true, + } + }; + + if (lex_token (s->lexer) != T_SLASH && lex_token (s->lexer) != T_ENDCMD) + { + size_t depth = 0; + for (size_t i = 0; ; i++) + { + enum token_type t = lex_next_token (s->lexer, i); + if (t == T_LPAREN || t == T_LBRACK || t == T_LCURLY) + depth++; + else if ((t == T_RPAREN || t == T_RBRACK || t == T_RCURLY) && depth) + depth--; + else if ((t == T_SLASH && !depth) || t == T_ENDCMD || t == T_STOP) + { + if (i > 0) + cmd->print.title = lex_next_representation (s->lexer, 0, i - 1); + break; + } + } + + cmd->print.expression = matrix_parse_exp (s); + if (!cmd->print.expression) + goto error; + } + + while (lex_match (s->lexer, T_SLASH)) + { + if (lex_match_id (s->lexer, "FORMAT")) + { + lex_match (s->lexer, T_EQUALS); + if (!parse_format_specifier (s->lexer, &cmd->print.format)) + goto error; + cmd->print.use_default_format = false; + } + else if (lex_match_id (s->lexer, "TITLE")) + { + lex_match (s->lexer, T_EQUALS); + if (!lex_force_string (s->lexer)) + goto error; + free (cmd->print.title); + cmd->print.title = ss_xstrdup (lex_tokss (s->lexer)); + lex_get (s->lexer); + } + else if (lex_match_id (s->lexer, "SPACE")) + { + lex_match (s->lexer, T_EQUALS); + if (lex_match_id (s->lexer, "NEWPAGE")) + cmd->print.space = -1; + else if (lex_force_int_range (s->lexer, "SPACE", 1, INT_MAX)) + { + cmd->print.space = lex_integer (s->lexer); + lex_get (s->lexer); + } + else + goto error; + } + else if (lex_match_id (s->lexer, "RLABELS")) + parse_literal_print_labels (s, &cmd->print.rlabels); + else if (lex_match_id (s->lexer, "CLABELS")) + parse_literal_print_labels (s, &cmd->print.clabels); + else if (lex_match_id (s->lexer, "RNAMES")) + { + if (!parse_expr_print_labels (s, &cmd->print.rlabels)) + goto error; + } + else if (lex_match_id (s->lexer, "CNAMES")) + { + if (!parse_expr_print_labels (s, &cmd->print.clabels)) + goto error; + } + else + { + lex_error_expecting (s->lexer, "FORMAT", "TITLE", "SPACE", + "RLABELS", "CLABELS", "RNAMES", "CNAMES"); + goto error; + } + + } + return cmd; + +error: + matrix_command_destroy (cmd); + return NULL; +} + +static bool +matrix_is_integer (const gsl_matrix *m) +{ + for (size_t y = 0; y < m->size1; y++) + for (size_t x = 0; x < m->size2; x++) + { + double d = gsl_matrix_get (m, y, x); + if (d != floor (d)) + return false; + } + return true; +} + +static double +matrix_max_magnitude (const gsl_matrix *m) +{ + double max = 0.0; + for (size_t y = 0; y < m->size1; y++) + for (size_t x = 0; x < m->size2; x++) + { + double d = fabs (gsl_matrix_get (m, y, x)); + if (d > max) + max = d; + } + return max; +} + +static bool +format_fits (struct fmt_spec format, double x) +{ + char *s = data_out (&(union value) { .f = x }, NULL, + &format, settings_get_fmt_settings ()); + bool fits = *s != '*' && !strchr (s, 'E'); + free (s); + return fits; +} + +static struct fmt_spec +default_format (const gsl_matrix *m, int *log_scale) +{ + *log_scale = 0; + + double max = matrix_max_magnitude (m); + + if (matrix_is_integer (m)) + for (int w = 1; w <= 12; w++) + { + struct fmt_spec format = { .type = FMT_F, .w = w }; + if (format_fits (format, -max)) + return format; + } + + if (max >= 1e9 || max <= 1e-4) + { + char s[64]; + snprintf (s, sizeof s, "%.1e", max); + + const char *e = strchr (s, 'e'); + if (e) + *log_scale = atoi (e + 1); + } + + return (struct fmt_spec) { .type = FMT_F, .w = 13, .d = 10 }; +} + +static char * +trimmed_string (double d) +{ + struct substring s = ss_buffer ((char *) &d, sizeof d); + ss_rtrim (&s, ss_cstr (" ")); + return ss_xstrdup (s); +} + +static struct string_array * +print_labels_get (const struct print_labels *labels, size_t n, + const char *prefix, bool truncate) +{ + if (!labels) + return NULL; + + struct string_array *out = xzalloc (sizeof *out); + if (labels->literals.n) + string_array_clone (out, &labels->literals); + else if (labels->expr) + { + gsl_matrix *m = matrix_expr_evaluate (labels->expr); + if (m && is_vector (m)) + { + gsl_vector v = to_vector (m); + for (size_t i = 0; i < v.size; i++) + string_array_append_nocopy (out, trimmed_string ( + gsl_vector_get (&v, i))); + } + gsl_matrix_free (m); + } + + while (out->n < n) + { + if (labels->expr) + string_array_append_nocopy (out, xasprintf ("%s%zu", prefix, + out->n + 1)); + else + string_array_append (out, ""); + } + while (out->n > n) + string_array_delete (out, out->n - 1); + + if (truncate) + for (size_t i = 0; i < out->n; i++) + { + char *s = out->strings[i]; + s[strnlen (s, 8)] = '\0'; + } + + return out; +} + +static void +matrix_print_space (int space) +{ + if (space < 0) + output_item_submit (page_break_item_create ()); + for (int i = 0; i < space; i++) + output_log ("%s", ""); +} + +static void +matrix_print_text (const struct matrix_print *print, const gsl_matrix *m, + struct fmt_spec format, int log_scale) +{ + matrix_print_space (print->space); + if (print->title) + output_log ("%s", print->title); + if (log_scale != 0) + output_log (" 10 ** %d X", log_scale); + + struct string_array *clabels = print_labels_get (print->clabels, + m->size2, "col", true); + if (clabels && format.w < 8) + format.w = 8; + struct string_array *rlabels = print_labels_get (print->rlabels, + m->size1, "row", true); + + if (clabels) + { + struct string line = DS_EMPTY_INITIALIZER; + if (rlabels) + ds_put_byte_multiple (&line, ' ', 8); + for (size_t x = 0; x < m->size2; x++) + ds_put_format (&line, " %*s", format.w, clabels->strings[x]); + output_log_nocopy (ds_steal_cstr (&line)); + } + + double scale = pow (10.0, log_scale); + bool numeric = fmt_is_numeric (format.type); + for (size_t y = 0; y < m->size1; y++) + { + struct string line = DS_EMPTY_INITIALIZER; + if (rlabels) + ds_put_format (&line, "%-8s", rlabels->strings[y]); + + for (size_t x = 0; x < m->size2; x++) + { + double f = gsl_matrix_get (m, y, x); + char *s = (numeric + ? data_out (&(union value) { .f = f / scale}, NULL, + &format, settings_get_fmt_settings ()) + : trimmed_string (f)); + ds_put_format (&line, " %s", s); + free (s); + } + output_log_nocopy (ds_steal_cstr (&line)); + } + + string_array_destroy (rlabels); + free (rlabels); + string_array_destroy (clabels); + free (clabels); +} + +static void +create_print_dimension (struct pivot_table *table, enum pivot_axis_type axis, + const struct print_labels *print_labels, size_t n, + const char *name, const char *prefix) +{ + struct string_array *labels = print_labels_get (print_labels, n, prefix, + false); + struct pivot_dimension *d = pivot_dimension_create (table, axis, name); + for (size_t i = 0; i < n; i++) + pivot_category_create_leaf ( + d->root, (labels + ? pivot_value_new_user_text (labels->strings[i], SIZE_MAX) + : pivot_value_new_integer (i + 1))); + if (!labels) + d->hide_all_labels = true; + string_array_destroy (labels); + free (labels); +} + +static void +matrix_print_tables (const struct matrix_print *print, const gsl_matrix *m, + struct fmt_spec format, int log_scale) +{ + struct pivot_table *table = pivot_table_create__ ( + pivot_value_new_user_text (print->title ? print->title : "", SIZE_MAX), + "Matrix Print"); + + create_print_dimension (table, PIVOT_AXIS_ROW, print->rlabels, m->size1, + N_("Rows"), "row"); + create_print_dimension (table, PIVOT_AXIS_COLUMN, print->clabels, m->size2, + N_("Columns"), "col"); + + struct pivot_footnote *footnote = NULL; + if (log_scale != 0) + { + char *s = xasprintf ("× 10**%d", log_scale); + footnote = pivot_table_create_footnote ( + table, pivot_value_new_user_text_nocopy (s)); + } + + double scale = pow (10.0, log_scale); + bool numeric = fmt_is_numeric (format.type); + for (size_t y = 0; y < m->size1; y++) + for (size_t x = 0; x < m->size2; x++) + { + double f = gsl_matrix_get (m, y, x); + struct pivot_value *v; + if (numeric) + { + v = pivot_value_new_number (f / scale); + v->numeric.format = format; + } + else + v = pivot_value_new_user_text_nocopy (trimmed_string (f)); + if (footnote) + pivot_value_add_footnote (v, footnote); + pivot_table_put2 (table, y, x, v); + } + + pivot_table_submit (table); +} + +static void +matrix_print_execute (const struct matrix_print *print) +{ + if (print->expression) + { + gsl_matrix *m = matrix_expr_evaluate (print->expression); + if (!m) + return; + + int log_scale = 0; + struct fmt_spec format = (print->use_default_format + ? default_format (m, &log_scale) + : print->format); + + if (settings_get_mdisplay () == SETTINGS_MDISPLAY_TEXT) + matrix_print_text (print, m, format, log_scale); + else + matrix_print_tables (print, m, format, log_scale); + + gsl_matrix_free (m); + } + else + { + matrix_print_space (print->space); + if (print->title) + output_log ("%s", print->title); + } +} + +/* DO IF. */ + +static bool +matrix_do_if_clause_parse (struct matrix_state *s, + struct matrix_do_if *ifc, + bool parse_condition, + size_t *allocated_clauses) +{ + if (ifc->n_clauses >= *allocated_clauses) + ifc->clauses = x2nrealloc (ifc->clauses, allocated_clauses, + sizeof *ifc->clauses); + struct do_if_clause *c = &ifc->clauses[ifc->n_clauses++]; + *c = (struct do_if_clause) { .condition = NULL }; + + if (parse_condition) + { + c->condition = matrix_expr_parse (s); + if (!c->condition) + return false; + } + + return matrix_commands_parse (s, &c->commands, "DO IF", "ELSE", "END IF"); +} + +static struct matrix_command * +matrix_do_if_parse (struct matrix_state *s) +{ + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { + .type = MCMD_DO_IF, + .do_if = { .n_clauses = 0 } + }; + + size_t allocated_clauses = 0; + do + { + if (!matrix_do_if_clause_parse (s, &cmd->do_if, true, &allocated_clauses)) + goto error; + } + while (lex_match_phrase (s->lexer, "ELSE IF")); + + if (lex_match_id (s->lexer, "ELSE") + && !matrix_do_if_clause_parse (s, &cmd->do_if, false, &allocated_clauses)) + goto error; + + if (!lex_match_phrase (s->lexer, "END IF")) + NOT_REACHED (); + return cmd; + +error: + matrix_command_destroy (cmd); + return NULL; +} + +static bool +matrix_do_if_execute (struct matrix_do_if *cmd) +{ + for (size_t i = 0; i < cmd->n_clauses; i++) + { + struct do_if_clause *c = &cmd->clauses[i]; + if (c->condition) + { + double d; + if (!matrix_expr_evaluate_scalar (c->condition, + i ? "ELSE IF" : "DO IF", + &d) || d <= 0) + continue; + } + + for (size_t j = 0; j < c->commands.n; j++) + if (!matrix_command_execute (c->commands.commands[j])) + return false; + return true; + } + return true; +} + +/* LOOP. */ + +static struct matrix_command * +matrix_loop_parse (struct matrix_state *s) +{ + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { .type = MCMD_LOOP, .loop = { .var = NULL } }; + + struct matrix_loop *loop = &cmd->loop; + if (lex_token (s->lexer) == T_ID && lex_next_token (s->lexer, 1) == T_EQUALS) + { + struct substring name = lex_tokss (s->lexer); + loop->var = matrix_var_lookup (s, name); + if (!loop->var) + loop->var = matrix_var_create (s, name); + + lex_get (s->lexer); + lex_get (s->lexer); + + loop->start = matrix_expr_parse (s); + if (!loop->start || !lex_force_match (s->lexer, T_TO)) + goto error; + + loop->end = matrix_expr_parse (s); + if (!loop->end) + goto error; + + if (lex_match (s->lexer, T_BY)) + { + loop->increment = matrix_expr_parse (s); + if (!loop->increment) + goto error; + } + } + + if (lex_match_id (s->lexer, "IF")) + { + loop->top_condition = matrix_expr_parse (s); + if (!loop->top_condition) + goto error; + } + + bool was_in_loop = s->in_loop; + s->in_loop = true; + bool ok = matrix_commands_parse (s, &loop->commands, "LOOP", + "END LOOP", NULL); + s->in_loop = was_in_loop; + if (!ok) + goto error; + + if (!lex_match_phrase (s->lexer, "END LOOP")) + NOT_REACHED (); + + if (lex_match_id (s->lexer, "IF")) + { + loop->bottom_condition = matrix_expr_parse (s); + if (!loop->bottom_condition) + goto error; + } + + return cmd; + +error: + matrix_command_destroy (cmd); + return NULL; +} + +static void +matrix_loop_execute (struct matrix_loop *cmd) +{ + long int value = 0; + long int end = 0; + long int increment = 1; + if (cmd->var) + { + if (!matrix_expr_evaluate_integer (cmd->start, "LOOP", &value) + || !matrix_expr_evaluate_integer (cmd->end, "TO", &end) + || (cmd->increment + && !matrix_expr_evaluate_integer (cmd->increment, "BY", + &increment))) + return; + + if (increment > 0 ? value > end + : increment < 0 ? value < end + : true) + return; + } + + int mxloops = settings_get_mxloops (); + for (int i = 0; i < mxloops; i++) + { + if (cmd->var) + { + if (cmd->var->value + && (cmd->var->value->size1 != 1 || cmd->var->value->size2 != 1)) + { + gsl_matrix_free (cmd->var->value); + cmd->var->value = NULL; + } + if (!cmd->var->value) + cmd->var->value = gsl_matrix_alloc (1, 1); + + gsl_matrix_set (cmd->var->value, 0, 0, value); + } + + if (cmd->top_condition) + { + double d; + if (!matrix_expr_evaluate_scalar (cmd->top_condition, "LOOP IF", + &d) || d <= 0) + return; + } + + for (size_t j = 0; j < cmd->commands.n; j++) + if (!matrix_command_execute (cmd->commands.commands[j])) + return; + + if (cmd->bottom_condition) + { + double d; + if (!matrix_expr_evaluate_scalar (cmd->bottom_condition, + "END LOOP IF", &d) || d > 0) + return; + } + + if (cmd->var) + { + value += increment; + if (increment > 0 ? value > end : value < end) + return; + } + } +} + +/* BREAK. */ + +static struct matrix_command * +matrix_break_parse (struct matrix_state *s) +{ + if (!s->in_loop) + { + msg (SE, _("BREAK not inside LOOP.")); + return NULL; + } + + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { .type = MCMD_BREAK }; + return cmd; +} + +/* DISPLAY. */ + +static struct matrix_command * +matrix_display_parse (struct matrix_state *s) +{ + while (lex_token (s->lexer) != T_ENDCMD) + { + if (!lex_match_id (s->lexer, "DICTIONARY") + && !lex_match_id (s->lexer, "STATUS")) + { + lex_error_expecting (s->lexer, "DICTIONARY", "STATUS"); + return NULL; + } + } + + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { .type = MCMD_DISPLAY, .display = { s } }; + return cmd; +} + +static int +compare_matrix_var_pointers (const void *a_, const void *b_) +{ + const struct matrix_var *const *ap = a_; + const struct matrix_var *const *bp = b_; + const struct matrix_var *a = *ap; + const struct matrix_var *b = *bp; + return strcmp (a->name, b->name); +} + +static void +matrix_display_execute (struct matrix_display *cmd) +{ + const struct matrix_state *s = cmd->state; + + struct pivot_table *table = pivot_table_create (N_("Matrix Variables")); + struct pivot_dimension *attr_dimension + = pivot_dimension_create (table, PIVOT_AXIS_COLUMN, N_("Attribute")); + pivot_category_create_group (attr_dimension->root, N_("Dimension"), + N_("Rows"), N_("Columns")); + pivot_category_create_leaves (attr_dimension->root, N_("Size (kB)")); + + const struct matrix_var **vars = xmalloc (hmap_count (&s->vars) * sizeof *vars); + size_t n_vars = 0; + + const struct matrix_var *var; + HMAP_FOR_EACH (var, struct matrix_var, hmap_node, &s->vars) + if (var->value) + vars[n_vars++] = var; + qsort (vars, n_vars, sizeof *vars, compare_matrix_var_pointers); + + struct pivot_dimension *rows = pivot_dimension_create ( + table, PIVOT_AXIS_ROW, N_("Variable")); + for (size_t i = 0; i < n_vars; i++) + { + const struct matrix_var *var = vars[i]; + pivot_category_create_leaf ( + rows->root, pivot_value_new_user_text (var->name, SIZE_MAX)); + + size_t r = var->value->size1; + size_t c = var->value->size2; + double values[] = { r, c, r * c * sizeof (double) / 1024 }; + for (size_t j = 0; j < sizeof values / sizeof *values; j++) + pivot_table_put2 (table, j, i, pivot_value_new_integer (values[j])); + } + free (vars); + pivot_table_submit (table); +} + +/* RELEASE. */ + +static struct matrix_command * +matrix_release_parse (struct matrix_state *s) +{ + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { .type = MCMD_RELEASE }; + + size_t allocated_vars = 0; + while (lex_token (s->lexer) == T_ID) + { + struct matrix_var *var = matrix_var_lookup (s, lex_tokss (s->lexer)); + if (var) + { + if (cmd->release.n_vars >= allocated_vars) + cmd->release.vars = x2nrealloc (cmd->release.vars, &allocated_vars, + sizeof *cmd->release.vars); + cmd->release.vars[cmd->release.n_vars++] = var; + } + else + lex_error (s->lexer, _("Variable name expected.")); + lex_get (s->lexer); + + if (!lex_match (s->lexer, T_COMMA)) + break; + } + + return cmd; +} + +static void +matrix_release_execute (struct matrix_release *cmd) +{ + for (size_t i = 0; i < cmd->n_vars; i++) + { + struct matrix_var *var = cmd->vars[i]; + gsl_matrix_free (var->value); + var->value = NULL; + } +} + +/* SAVE. */ + +static struct save_file * +save_file_create (struct matrix_state *s, struct file_handle *fh, + struct string_array *variables, + struct matrix_expr *names, + struct stringi_set *strings) +{ + for (size_t i = 0; i < s->n_save_files; i++) + { + struct save_file *sf = s->save_files[i]; + if (fh_equal (sf->file, fh)) + { + fh_unref (fh); + + string_array_destroy (variables); + matrix_expr_destroy (names); + stringi_set_destroy (strings); + + return sf; + } + } + + struct save_file *sf = xmalloc (sizeof *sf); + *sf = (struct save_file) { + .file = fh, + .dataset = s->dataset, + .variables = *variables, + .names = names, + .strings = STRINGI_SET_INITIALIZER (sf->strings), + }; + + stringi_set_swap (&sf->strings, strings); + stringi_set_destroy (strings); + + s->save_files = xrealloc (s->save_files, + (s->n_save_files + 1) * sizeof *s->save_files); + s->save_files[s->n_save_files++] = sf; + return sf; +} + +static struct casewriter * +save_file_open (struct save_file *sf, gsl_matrix *m, + const struct msg_location *save_location) +{ + if (sf->writer || sf->error) + { + if (sf->writer) + { + size_t n_variables = caseproto_get_n_widths ( + casewriter_get_proto (sf->writer)); + if (m->size2 != n_variables) + { + const char *file_name = (sf->file == fh_inline_file () ? "*" + : fh_get_name (sf->file)); + msg_at (SE, save_location, + _("Cannot save %zu×%zu matrix to %s because the " + "first SAVE to %s in this matrix program wrote a " + "%zu-column matrix."), + m->size1, m->size2, file_name, file_name, n_variables); + msg_at (SE, sf->location, + _("This is the location of the first SAVE to %s."), + file_name); + return NULL; + } + } + return sf->writer; + } + + bool ok = true; + struct dictionary *dict = dict_create (get_default_encoding ()); + + /* Fill 'names' with user-specified names if there were any, either from + sf->variables or sf->names. */ + struct string_array names = { .n = 0 }; + if (sf->variables.n) + string_array_clone (&names, &sf->variables); + else if (sf->names) + { + gsl_matrix *nm = matrix_expr_evaluate (sf->names); + if (nm && is_vector (nm)) + { + gsl_vector nv = to_vector (nm); + for (size_t i = 0; i < nv.size; i++) + { + char *name = trimmed_string (gsl_vector_get (&nv, i)); + if (dict_id_is_valid (dict, name, true)) + string_array_append_nocopy (&names, name); + else + ok = false; + } + } + gsl_matrix_free (nm); + } + + struct stringi_set strings; + stringi_set_clone (&strings, &sf->strings); + + for (size_t i = 0; dict_get_var_cnt (dict) < m->size2; i++) + { + char tmp_name[64]; + const char *name; + if (i < names.n) + name = names.strings[i]; + else + { + snprintf (tmp_name, sizeof tmp_name, "COL%zu", i + 1); + name = tmp_name; + } + + int width = stringi_set_delete (&strings, name) ? 8 : 0; + struct variable *var = dict_create_var (dict, name, width); + if (!var) + { + msg_at (ME, save_location, + _("Duplicate variable name %s in SAVE statement."), name); + ok = false; + } + } + + if (!stringi_set_is_empty (&strings)) + { + size_t count = stringi_set_count (&strings); + const char *example = stringi_set_node_get_string ( + stringi_set_first (&strings)); + + if (count == 1) + msg_at (ME, save_location, + _("The SAVE command STRINGS subcommand specifies an unknown " + "variable %s."), example); + else + msg_at (ME, save_location, + ngettext ("The SAVE command STRINGS subcommand specifies %zu " + "unknown variable: %s.", + "The SAVE command STRINGS subcommand specifies %zu " + "unknown variables, including %s.", + count), + count, example); + ok = false; + } + stringi_set_destroy (&strings); + string_array_destroy (&names); + + if (!ok) + { + dict_unref (dict); + sf->error = true; + return NULL; + } + + if (sf->file == fh_inline_file ()) + sf->writer = autopaging_writer_create (dict_get_proto (dict)); + else + sf->writer = any_writer_open (sf->file, dict); + if (sf->writer) + { + sf->dict = dict; + sf->location = msg_location_dup (save_location); + } + else + { + dict_unref (dict); + sf->error = true; + } + return sf->writer; +} + +static void +save_file_destroy (struct save_file *sf) +{ + if (sf) + { + if (sf->file == fh_inline_file () && sf->writer && sf->dict) + { + dataset_set_dict (sf->dataset, sf->dict); + dataset_set_source (sf->dataset, casewriter_make_reader (sf->writer)); + } + else + { + casewriter_destroy (sf->writer); + dict_unref (sf->dict); + } + fh_unref (sf->file); + string_array_destroy (&sf->variables); + matrix_expr_destroy (sf->names); + stringi_set_destroy (&sf->strings); + msg_location_destroy (sf->location); + free (sf); + } +} + +static struct matrix_command * +matrix_save_parse (struct matrix_state *s) +{ + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { + .type = MCMD_SAVE, + .save = { .expression = NULL }, + }; + + struct file_handle *fh = NULL; + struct matrix_save *save = &cmd->save; + + struct string_array variables = STRING_ARRAY_INITIALIZER; + struct matrix_expr *names = NULL; + struct stringi_set strings = STRINGI_SET_INITIALIZER (strings); + + save->expression = matrix_parse_exp (s); + if (!save->expression) + goto error; + + while (lex_match (s->lexer, T_SLASH)) + { + if (lex_match_id (s->lexer, "OUTFILE")) + { + lex_match (s->lexer, T_EQUALS); + + fh_unref (fh); + fh = (lex_match (s->lexer, T_ASTERISK) + ? fh_inline_file () + : fh_parse (s->lexer, FH_REF_FILE, s->session)); + if (!fh) + goto error; + } + else if (lex_match_id (s->lexer, "VARIABLES")) + { + lex_match (s->lexer, T_EQUALS); + + char **names; + size_t n; + struct dictionary *d = dict_create (get_default_encoding ()); + bool ok = parse_DATA_LIST_vars (s->lexer, d, &names, &n, + PV_NO_SCRATCH | PV_NO_DUPLICATE); + dict_unref (d); + if (!ok) + goto error; + + string_array_clear (&variables); + variables = (struct string_array) { + .strings = names, + .n = n, + .allocated = n, + }; + } + else if (lex_match_id (s->lexer, "NAMES")) + { + lex_match (s->lexer, T_EQUALS); + matrix_expr_destroy (names); + names = matrix_parse_exp (s); + if (!names) + goto error; + } + else if (lex_match_id (s->lexer, "STRINGS")) + { + lex_match (s->lexer, T_EQUALS); + while (lex_token (s->lexer) == T_ID) + { + stringi_set_insert (&strings, lex_tokcstr (s->lexer)); + lex_get (s->lexer); + if (!lex_match (s->lexer, T_COMMA)) + break; + } + } + else + { + lex_error_expecting (s->lexer, "OUTFILE", "VARIABLES", "NAMES", + "STRINGS"); + goto error; + } + } + + if (!fh) + { + if (s->prev_save_file) + fh = fh_ref (s->prev_save_file); + else + { + lex_sbc_missing ("OUTFILE"); + goto error; + } + } + fh_unref (s->prev_save_file); + s->prev_save_file = fh_ref (fh); + + if (variables.n && names) + { + msg (SW, _("VARIABLES and NAMES both specified; ignoring NAMES.")); + matrix_expr_destroy (names); + names = NULL; + } + + save->sf = save_file_create (s, fh, &variables, names, &strings); + return cmd; + +error: + string_array_destroy (&variables); + matrix_expr_destroy (names); + stringi_set_destroy (&strings); + fh_unref (fh); + matrix_command_destroy (cmd); + return NULL; +} + +static void +matrix_save_execute (const struct matrix_command *cmd) +{ + const struct matrix_save *save = &cmd->save; + + gsl_matrix *m = matrix_expr_evaluate (save->expression); + if (!m) + return; + + struct casewriter *writer = save_file_open (save->sf, m, cmd->location); + if (!writer) + { + gsl_matrix_free (m); + return; + } + + const struct caseproto *proto = casewriter_get_proto (writer); + for (size_t y = 0; y < m->size1; y++) + { + struct ccase *c = case_create (proto); + for (size_t x = 0; x < m->size2; x++) + { + double d = gsl_matrix_get (m, y, x); + int width = caseproto_get_width (proto, x); + union value *value = case_data_rw_idx (c, x); + if (width == 0) + value->f = d; + else + memcpy (value->s, &d, width); + } + casewriter_write (writer, c); + } + gsl_matrix_free (m); +} + +/* READ. */ + +static struct read_file * +read_file_create (struct matrix_state *s, struct file_handle *fh) +{ + for (size_t i = 0; i < s->n_read_files; i++) + { + struct read_file *rf = s->read_files[i]; + if (rf->file == fh) + { + fh_unref (fh); + return rf; + } + } + + struct read_file *rf = xmalloc (sizeof *rf); + *rf = (struct read_file) { .file = fh }; + + s->read_files = xrealloc (s->read_files, + (s->n_read_files + 1) * sizeof *s->read_files); + s->read_files[s->n_read_files++] = rf; + return rf; +} + +static struct dfm_reader * +read_file_open (struct read_file *rf) +{ + if (!rf->reader) + rf->reader = dfm_open_reader (rf->file, NULL, rf->encoding); + return rf->reader; +} + +static void +read_file_destroy (struct read_file *rf) +{ + if (rf) + { + fh_unref (rf->file); + dfm_close_reader (rf->reader); + free (rf->encoding); + free (rf); + } +} + +static struct matrix_command * +matrix_read_parse (struct matrix_state *s) +{ + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { + .type = MCMD_READ, + .read = { .format = FMT_F }, + }; + + struct file_handle *fh = NULL; + char *encoding = NULL; + struct matrix_read *read = &cmd->read; + read->dst = matrix_lvalue_parse (s); + if (!read->dst) + goto error; + + int by = 0; + int repetitions = 0; + int record_width = 0; + bool seen_format = false; + while (lex_match (s->lexer, T_SLASH)) + { + if (lex_match_id (s->lexer, "FILE")) + { + lex_match (s->lexer, T_EQUALS); + + fh_unref (fh); + fh = fh_parse (s->lexer, FH_REF_FILE, NULL); + if (!fh) + goto error; + } + else if (lex_match_id (s->lexer, "ENCODING")) + { + lex_match (s->lexer, T_EQUALS); + if (!lex_force_string (s->lexer)) + goto error; + + free (encoding); + encoding = ss_xstrdup (lex_tokss (s->lexer)); + + lex_get (s->lexer); + } + else if (lex_match_id (s->lexer, "FIELD")) + { + lex_match (s->lexer, T_EQUALS); + + if (!lex_force_int_range (s->lexer, "FIELD", 1, INT_MAX)) + goto error; + read->c1 = lex_integer (s->lexer); + lex_get (s->lexer); + if (!lex_force_match (s->lexer, T_TO) + || !lex_force_int_range (s->lexer, "TO", read->c1, INT_MAX)) + goto error; + read->c2 = lex_integer (s->lexer) + 1; + lex_get (s->lexer); + + record_width = read->c2 - read->c1; + if (lex_match (s->lexer, T_BY)) + { + if (!lex_force_int_range (s->lexer, "BY", 1, + read->c2 - read->c1)) + goto error; + by = lex_integer (s->lexer); + lex_get (s->lexer); + + if (record_width % by) + { + msg (SE, _("BY %d does not evenly divide record width %d."), + by, record_width); + goto error; + } + } + else + by = 0; + } + else if (lex_match_id (s->lexer, "SIZE")) + { + lex_match (s->lexer, T_EQUALS); + matrix_expr_destroy (read->size); + read->size = matrix_parse_exp (s); + if (!read->size) + goto error; + } + else if (lex_match_id (s->lexer, "MODE")) + { + lex_match (s->lexer, T_EQUALS); + if (lex_match_id (s->lexer, "RECTANGULAR")) + read->symmetric = false; + else if (lex_match_id (s->lexer, "SYMMETRIC")) + read->symmetric = true; + else + { + lex_error_expecting (s->lexer, "RECTANGULAR", "SYMMETRIC"); + goto error; + } + } + else if (lex_match_id (s->lexer, "REREAD")) + read->reread = true; + else if (lex_match_id (s->lexer, "FORMAT")) + { + if (seen_format) + { + lex_sbc_only_once ("FORMAT"); + goto error; + } + seen_format = true; + + lex_match (s->lexer, T_EQUALS); + + if (lex_token (s->lexer) != T_STRING && !lex_force_id (s->lexer)) + goto error; + + const char *p = lex_tokcstr (s->lexer); + if (c_isdigit (p[0])) + { + repetitions = atoi (p); + p += strspn (p, "0123456789"); + if (!fmt_from_name (p, &read->format)) + { + lex_error (s->lexer, _("Unknown format %s."), p); + goto error; + } + lex_get (s->lexer); + } + else if (fmt_from_name (p, &read->format)) + lex_get (s->lexer); + else + { + struct fmt_spec format; + if (!parse_format_specifier (s->lexer, &format)) + goto error; + read->format = format.type; + read->w = format.w; + } + } + else + { + lex_error_expecting (s->lexer, "FILE", "FIELD", "MODE", + "REREAD", "FORMAT"); + goto error; + } + } + + if (!read->c1) + { + lex_sbc_missing ("FIELD"); + goto error; + } + + if (!read->dst->n_indexes && !read->size) + { + msg (SE, _("SIZE is required for reading data into a full matrix " + "(as opposed to a submatrix).")); + goto error; + } + + if (!fh) + { + if (s->prev_read_file) + fh = fh_ref (s->prev_read_file); + else + { + lex_sbc_missing ("FILE"); + goto error; + } + } + fh_unref (s->prev_read_file); + s->prev_read_file = fh_ref (fh); + + read->rf = read_file_create (s, fh); + fh = NULL; + if (encoding) + { + free (read->rf->encoding); + read->rf->encoding = encoding; + encoding = NULL; + } + + /* Field width may be specified in multiple ways: + + 1. BY on FIELD. + 2. The format on FORMAT. + 3. The repetition factor on FORMAT. + + (2) and (3) are mutually exclusive. + + If more than one of these is present, they must agree. If none of them is + present, then free-field format is used. + */ + if (repetitions > record_width) + { + msg (SE, _("%d repetitions cannot fit in record width %d."), + repetitions, record_width); + goto error; + } + int w = (repetitions ? record_width / repetitions + : read->w ? read->w + : by); + if (by && w != by) + { + if (repetitions) + msg (SE, _("FORMAT specifies %d repetitions with record width %d, " + "which implies field width %d, " + "but BY specifies field width %d."), + repetitions, record_width, w, by); + else + msg (SE, _("FORMAT specifies field width %d but BY specifies %d."), + w, by); + goto error; + } + read->w = w; + return cmd; + +error: + fh_unref (fh); + matrix_command_destroy (cmd); + free (encoding); + return NULL; +} + +static void +parse_error (const struct dfm_reader *reader, enum fmt_type format, + struct substring data, size_t y, size_t x, + int first_column, int last_column, char *error) +{ + int line_number = dfm_get_line_number (reader); + struct msg_location location = { + .file_name = intern_new (dfm_get_file_name (reader)), + .start = { .line = line_number, .column = first_column }, + .end = { .line = line_number, .column = last_column }, + }; + msg_at (DW, &location, _("Error reading \"%.*s\" as format %s " + "for matrix row %zu, column %zu: %s"), + (int) data.length, data.string, fmt_name (format), + y + 1, x + 1, error); + msg_location_uninit (&location); + free (error); +} + +static void +matrix_read_set_field (struct matrix_read *read, struct dfm_reader *reader, + gsl_matrix *m, struct substring p, size_t y, size_t x, + const char *line_start) +{ + const char *input_encoding = dfm_reader_get_encoding (reader); + char *error; + double f; + if (fmt_is_numeric (read->format)) + { + union value v; + error = data_in (p, input_encoding, read->format, + settings_get_fmt_settings (), &v, 0, NULL); + if (!error && v.f == SYSMIS) + error = xstrdup (_("Matrix data may not contain missing value.")); + f = v.f; + } + else + { + uint8_t s[sizeof (double)]; + union value v = { .s = s }; + error = data_in (p, input_encoding, read->format, + settings_get_fmt_settings (), &v, sizeof s, "UTF-8"); + memcpy (&f, s, sizeof f); + } + + if (error) + { + int c1 = utf8_count_columns (line_start, p.string - line_start) + 1; + int nc = ss_utf8_count_columns (p); + int c2 = c1 + MAX (1, nc) - 1; + parse_error (reader, read->format, p, y, x, c1, c2, error); + } + else + { + gsl_matrix_set (m, y, x, f); + if (read->symmetric && x != y) + gsl_matrix_set (m, x, y, f); + } +} + +static bool +matrix_read_line (struct matrix_command *cmd, struct dfm_reader *reader, + struct substring *line, const char **startp) +{ + struct matrix_read *read = &cmd->read; + if (dfm_eof (reader)) + { + msg_at (SE, cmd->location, + _("Unexpected end of file reading matrix data.")); + return false; + } + dfm_expand_tabs (reader); + struct substring record = dfm_get_record (reader); + /* XXX need to recode record into UTF-8 */ + *startp = record.string; + *line = ss_utf8_columns (record, read->c1 - 1, read->c2 - read->c1); + return true; +} + +static void +matrix_read (struct matrix_command *cmd, struct dfm_reader *reader, + gsl_matrix *m) +{ + struct matrix_read *read = &cmd->read; + for (size_t y = 0; y < m->size1; y++) + { + size_t nx = read->symmetric ? y + 1 : m->size2; + + struct substring line = ss_empty (); + const char *line_start = line.string; + for (size_t x = 0; x < nx; x++) + { + struct substring p; + if (!read->w) + { + for (;;) + { + ss_ltrim (&line, ss_cstr (" ,")); + if (!ss_is_empty (line)) + break; + if (!matrix_read_line (cmd, reader, &line, &line_start)) + return; + dfm_forward_record (reader); + } + + ss_get_bytes (&line, ss_cspan (line, ss_cstr (" ,")), &p); + } + else + { + if (!matrix_read_line (cmd, reader, &line, &line_start)) + return; + size_t fields_per_line = (read->c2 - read->c1) / read->w; + int f = x % fields_per_line; + if (f == fields_per_line - 1) + dfm_forward_record (reader); + + p = ss_substr (line, read->w * f, read->w); + } + + matrix_read_set_field (read, reader, m, p, y, x, line_start); + } + + if (read->w) + dfm_forward_record (reader); + else + { + ss_ltrim (&line, ss_cstr (" ,")); + if (!ss_is_empty (line)) + { + int line_number = dfm_get_line_number (reader); + int c1 = utf8_count_columns (line_start, + line.string - line_start) + 1; + int c2 = c1 + ss_utf8_count_columns (line) - 1; + struct msg_location location = { + .file_name = intern_new (dfm_get_file_name (reader)), + .start = { .line = line_number, .column = c1 }, + .end = { .line = line_number, .column = c2 }, + }; + msg_at (DW, &location, + _("Trailing garbage following data for matrix row %zu."), + y + 1); + msg_location_uninit (&location); + } + } + } +} + +static void +matrix_read_execute (struct matrix_command *cmd) +{ + struct matrix_read *read = &cmd->read; + struct index_vector iv0, iv1; + if (!matrix_lvalue_evaluate (read->dst, &iv0, &iv1)) + return; + + size_t size[2] = { SIZE_MAX, SIZE_MAX }; + if (read->size) + { + gsl_matrix *m = matrix_expr_evaluate (read->size); + if (!m) + return; + + if (!is_vector (m)) + { + msg_at (SE, matrix_expr_location (read->size), + _("SIZE must evaluate to a scalar or a 2-element vector, " + "not a %zu×%zu matrix."), m->size1, m->size2); + gsl_matrix_free (m); + index_vector_uninit (&iv0); + index_vector_uninit (&iv1); + return; + } + + gsl_vector v = to_vector (m); + double d[2]; + if (v.size == 1) + { + d[0] = gsl_vector_get (&v, 0); + d[1] = 1; + } + else if (v.size == 2) + { + d[0] = gsl_vector_get (&v, 0); + d[1] = gsl_vector_get (&v, 1); + } + else + { + msg_at (SE, matrix_expr_location (read->size), + _("SIZE must evaluate to a scalar or a 2-element vector, " + "not a %zu×%zu matrix."), + m->size1, m->size2), + gsl_matrix_free (m); + index_vector_uninit (&iv0); + index_vector_uninit (&iv1); + return; + } + gsl_matrix_free (m); + + if (d[0] < 0 || d[0] > SIZE_MAX || d[1] < 0 || d[1] > SIZE_MAX) + { + msg_at (SE, matrix_expr_location (read->size), + _("Matrix dimensions %g×%g specified on SIZE " + "are outside valid range."), + d[0], d[1]); + index_vector_uninit (&iv0); + index_vector_uninit (&iv1); + return; + } + + size[0] = d[0]; + size[1] = d[1]; + } + + if (read->dst->n_indexes) + { + size_t submatrix_size[2]; + if (read->dst->n_indexes == 2) + { + submatrix_size[0] = iv0.n; + submatrix_size[1] = iv1.n; + } + else if (read->dst->var->value->size1 == 1) + { + submatrix_size[0] = 1; + submatrix_size[1] = iv0.n; + } + else + { + submatrix_size[0] = iv0.n; + submatrix_size[1] = 1; + } + + if (read->size) + { + if (size[0] != submatrix_size[0] || size[1] != submatrix_size[1]) + { + msg_at (SE, cmd->location, + _("Dimensions specified on SIZE differ from dimensions " + "of destination submatrix.")); + msg_at (SN, matrix_expr_location (read->size), + _("SIZE specifies dimensions %zu×%zu."), + size[0], size[1]); + msg_at (SN, read->dst->full_location, + _("Destination submatrix has dimensions %zu×%zu."), + submatrix_size[0], submatrix_size[1]); + index_vector_uninit (&iv0); + index_vector_uninit (&iv1); + return; + } + } + else + { + size[0] = submatrix_size[0]; + size[1] = submatrix_size[1]; + } + } + + struct dfm_reader *reader = read_file_open (read->rf); + if (read->reread) + dfm_reread_record (reader, 1); + + if (read->symmetric && size[0] != size[1]) + { + msg_at (SE, cmd->location, + _("Cannot read non-square %zu×%zu matrix " + "using READ with MODE=SYMMETRIC."), + size[0], size[1]); + index_vector_uninit (&iv0); + index_vector_uninit (&iv1); + return; + } + gsl_matrix *tmp = gsl_matrix_calloc (size[0], size[1]); + matrix_read (cmd, reader, tmp); + matrix_lvalue_assign (read->dst, &iv0, &iv1, tmp, cmd->location); +} + +/* WRITE. */ + +static struct write_file * +write_file_create (struct matrix_state *s, struct file_handle *fh) +{ + for (size_t i = 0; i < s->n_write_files; i++) + { + struct write_file *wf = s->write_files[i]; + if (wf->file == fh) + { + fh_unref (fh); + return wf; + } + } + + struct write_file *wf = xmalloc (sizeof *wf); + *wf = (struct write_file) { .file = fh }; + + s->write_files = xrealloc (s->write_files, + (s->n_write_files + 1) * sizeof *s->write_files); + s->write_files[s->n_write_files++] = wf; + return wf; +} + +static struct dfm_writer * +write_file_open (struct write_file *wf) +{ + if (!wf->writer) + wf->writer = dfm_open_writer (wf->file, wf->encoding); + return wf->writer; +} + +static void +write_file_destroy (struct write_file *wf) +{ + if (wf) + { + if (wf->held) + { + dfm_put_record_utf8 (wf->writer, wf->held->s.ss.string, + wf->held->s.ss.length); + u8_line_destroy (wf->held); + free (wf->held); + } + + fh_unref (wf->file); + dfm_close_writer (wf->writer); + free (wf->encoding); + free (wf); + } +} + +static struct matrix_command * +matrix_write_parse (struct matrix_state *s) +{ + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { + .type = MCMD_WRITE, + }; + + struct file_handle *fh = NULL; + char *encoding = NULL; + struct matrix_write *write = &cmd->write; + write->expression = matrix_parse_exp (s); + if (!write->expression) + goto error; + + int by = 0; + int repetitions = 0; + int record_width = 0; + enum fmt_type format = FMT_F; + bool has_format = false; + while (lex_match (s->lexer, T_SLASH)) + { + if (lex_match_id (s->lexer, "OUTFILE")) + { + lex_match (s->lexer, T_EQUALS); + + fh_unref (fh); + fh = fh_parse (s->lexer, FH_REF_FILE, NULL); + if (!fh) + goto error; + } + else if (lex_match_id (s->lexer, "ENCODING")) + { + lex_match (s->lexer, T_EQUALS); + if (!lex_force_string (s->lexer)) + goto error; + + free (encoding); + encoding = ss_xstrdup (lex_tokss (s->lexer)); + + lex_get (s->lexer); + } + else if (lex_match_id (s->lexer, "FIELD")) + { + lex_match (s->lexer, T_EQUALS); + + if (!lex_force_int_range (s->lexer, "FIELD", 1, INT_MAX)) + goto error; + write->c1 = lex_integer (s->lexer); + lex_get (s->lexer); + if (!lex_force_match (s->lexer, T_TO) + || !lex_force_int_range (s->lexer, "TO", write->c1, INT_MAX)) + goto error; + write->c2 = lex_integer (s->lexer) + 1; + lex_get (s->lexer); + + record_width = write->c2 - write->c1; + if (lex_match (s->lexer, T_BY)) + { + if (!lex_force_int_range (s->lexer, "BY", 1, + write->c2 - write->c1)) + goto error; + by = lex_integer (s->lexer); + lex_get (s->lexer); + + if (record_width % by) + { + msg (SE, _("BY %d does not evenly divide record width %d."), + by, record_width); + goto error; + } + } + else + by = 0; + } + else if (lex_match_id (s->lexer, "MODE")) + { + lex_match (s->lexer, T_EQUALS); + if (lex_match_id (s->lexer, "RECTANGULAR")) + write->triangular = false; + else if (lex_match_id (s->lexer, "TRIANGULAR")) + write->triangular = true; + else + { + lex_error_expecting (s->lexer, "RECTANGULAR", "TRIANGULAR"); + goto error; + } + } + else if (lex_match_id (s->lexer, "HOLD")) + write->hold = true; + else if (lex_match_id (s->lexer, "FORMAT")) + { + if (has_format || write->format) + { + lex_sbc_only_once ("FORMAT"); + goto error; + } + + lex_match (s->lexer, T_EQUALS); + + if (lex_token (s->lexer) != T_STRING && !lex_force_id (s->lexer)) + goto error; + + const char *p = lex_tokcstr (s->lexer); + if (c_isdigit (p[0])) + { + repetitions = atoi (p); + p += strspn (p, "0123456789"); + if (!fmt_from_name (p, &format)) + { + lex_error (s->lexer, _("Unknown format %s."), p); + goto error; + } + has_format = true; + lex_get (s->lexer); + } + else if (fmt_from_name (p, &format)) + { + has_format = true; + lex_get (s->lexer); + } + else + { + struct fmt_spec spec; + if (!parse_format_specifier (s->lexer, &spec)) + goto error; + write->format = xmemdup (&spec, sizeof spec); + } + } + else + { + lex_error_expecting (s->lexer, "OUTFILE", "FIELD", "MODE", + "HOLD", "FORMAT"); + goto error; + } + } + + if (!write->c1) + { + lex_sbc_missing ("FIELD"); + goto error; + } + + if (!fh) + { + if (s->prev_write_file) + fh = fh_ref (s->prev_write_file); + else + { + lex_sbc_missing ("OUTFILE"); + goto error; + } + } + fh_unref (s->prev_write_file); + s->prev_write_file = fh_ref (fh); + + write->wf = write_file_create (s, fh); + fh = NULL; + if (encoding) + { + free (write->wf->encoding); + write->wf->encoding = encoding; + encoding = NULL; + } + + /* Field width may be specified in multiple ways: + + 1. BY on FIELD. + 2. The format on FORMAT. + 3. The repetition factor on FORMAT. + + (2) and (3) are mutually exclusive. + + If more than one of these is present, they must agree. If none of them is + present, then free-field format is used. + */ + if (repetitions > record_width) + { + msg (SE, _("%d repetitions cannot fit in record width %d."), + repetitions, record_width); + goto error; + } + int w = (repetitions ? record_width / repetitions + : write->format ? write->format->w + : by); + if (by && w != by) + { + if (repetitions) + msg (SE, _("FORMAT specifies %d repetitions with record width %d, " + "which implies field width %d, " + "but BY specifies field width %d."), + repetitions, record_width, w, by); + else + msg (SE, _("FORMAT specifies field width %d but BY specifies %d."), + w, by); + goto error; + } + if (w && !write->format) + { + write->format = xmalloc (sizeof *write->format); + *write->format = (struct fmt_spec) { .type = format, .w = w }; + + if (!fmt_check_output (write->format)) + goto error; + }; + + if (write->format && fmt_var_width (write->format) > sizeof (double)) + { + char s[FMT_STRING_LEN_MAX + 1]; + fmt_to_string (write->format, s); + msg (SE, _("Format %s is too wide for %zu-byte matrix eleemnts."), + s, sizeof (double)); + goto error; + } + + return cmd; + +error: + fh_unref (fh); + matrix_command_destroy (cmd); + return NULL; +} + +static void +matrix_write_execute (struct matrix_write *write) +{ + gsl_matrix *m = matrix_expr_evaluate (write->expression); + if (!m) + return; + + if (write->triangular && m->size1 != m->size2) + { + msg_at (SE, matrix_expr_location (write->expression), + _("WRITE with MODE=TRIANGULAR requires a square matrix but " + "the matrix to be written has dimensions %zu×%zu."), + m->size1, m->size2); + gsl_matrix_free (m); + return; + } + + struct dfm_writer *writer = write_file_open (write->wf); + if (!writer || !m->size1) + { + gsl_matrix_free (m); + return; + } + + const struct fmt_settings *settings = settings_get_fmt_settings (); + struct u8_line *line = write->wf->held; + for (size_t y = 0; y < m->size1; y++) + { + if (!line) + { + line = xmalloc (sizeof *line); + u8_line_init (line); + } + size_t nx = write->triangular ? y + 1 : m->size2; + int x0 = write->c1; + for (size_t x = 0; x < nx; x++) + { + char *s; + double f = gsl_matrix_get (m, y, x); + if (write->format) + { + union value v; + if (fmt_is_numeric (write->format->type)) + v.f = f; + else + v.s = (uint8_t *) &f; + s = data_out (&v, NULL, write->format, settings); + } + else + { + s = xmalloc (DBL_BUFSIZE_BOUND); + if (c_dtoastr (s, DBL_BUFSIZE_BOUND, FTOASTR_UPPER_E, 0, f) + >= DBL_BUFSIZE_BOUND) + abort (); + } + size_t len = strlen (s); + int width = u8_width (CHAR_CAST (const uint8_t *, s), len, UTF8); + if (width + x0 > write->c2) + { + dfm_put_record_utf8 (writer, line->s.ss.string, + line->s.ss.length); + u8_line_clear (line); + x0 = write->c1; + } + u8_line_put (line, x0, x0 + width, s, len); + free (s); + + x0 += write->format ? write->format->w : width + 1; + } + + if (y + 1 >= m->size1 && write->hold) + break; + dfm_put_record_utf8 (writer, line->s.ss.string, line->s.ss.length); + u8_line_clear (line); + } + if (!write->hold) + { + u8_line_destroy (line); + free (line); + line = NULL; + } + write->wf->held = line; + + gsl_matrix_free (m); +} + +/* GET. */ + +static struct matrix_command * +matrix_get_parse (struct matrix_state *s) +{ + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { + .type = MCMD_GET, + .get = { + .dataset = s->dataset, + .user = { .treatment = MGET_ERROR }, + .system = { .treatment = MGET_ERROR }, + } + }; + + struct matrix_get *get = &cmd->get; + get->dst = matrix_lvalue_parse (s); + if (!get->dst) + goto error; + + while (lex_match (s->lexer, T_SLASH)) + { + if (lex_match_id (s->lexer, "FILE")) + { + lex_match (s->lexer, T_EQUALS); + + fh_unref (get->file); + if (lex_match (s->lexer, T_ASTERISK)) + get->file = NULL; + else + { + get->file = fh_parse (s->lexer, FH_REF_FILE, s->session); + if (!get->file) + goto error; + } + } + else if (lex_match_id (s->lexer, "ENCODING")) + { + lex_match (s->lexer, T_EQUALS); + if (!lex_force_string (s->lexer)) + goto error; + + free (get->encoding); + get->encoding = ss_xstrdup (lex_tokss (s->lexer)); + + lex_get (s->lexer); + } + else if (lex_match_id (s->lexer, "VARIABLES")) + { + lex_match (s->lexer, T_EQUALS); + + if (get->n_vars) + { + lex_sbc_only_once ("VARIABLES"); + goto error; + } + + if (!var_syntax_parse (s->lexer, &get->vars, &get->n_vars)) + goto error; + } + else if (lex_match_id (s->lexer, "NAMES")) + { + lex_match (s->lexer, T_EQUALS); + if (!lex_force_id (s->lexer)) + goto error; + + struct substring name = lex_tokss (s->lexer); + get->names = matrix_var_lookup (s, name); + if (!get->names) + get->names = matrix_var_create (s, name); + lex_get (s->lexer); + } + else if (lex_match_id (s->lexer, "MISSING")) + { + lex_match (s->lexer, T_EQUALS); + if (lex_match_id (s->lexer, "ACCEPT")) + get->user.treatment = MGET_ACCEPT; + else if (lex_match_id (s->lexer, "OMIT")) + get->user.treatment = MGET_OMIT; + else if (lex_is_number (s->lexer)) + { + get->user.treatment = MGET_RECODE; + get->user.substitute = lex_number (s->lexer); + lex_get (s->lexer); + } + else + { + lex_error (s->lexer, NULL); + goto error; + } + } + else if (lex_match_id (s->lexer, "SYSMIS")) + { + lex_match (s->lexer, T_EQUALS); + if (lex_match_id (s->lexer, "OMIT")) + get->system.treatment = MGET_OMIT; + else if (lex_is_number (s->lexer)) + { + get->system.treatment = MGET_RECODE; + get->system.substitute = lex_number (s->lexer); + lex_get (s->lexer); + } + else + { + lex_error (s->lexer, NULL); + goto error; + } + } + else + { + lex_error_expecting (s->lexer, "FILE", "VARIABLES", "NAMES", + "MISSING", "SYSMIS"); + goto error; + } + } + + if (get->user.treatment != MGET_ACCEPT) + get->system.treatment = MGET_ERROR; + + return cmd; + +error: + matrix_command_destroy (cmd); + return NULL; +} + +static void +matrix_get_execute__ (struct matrix_command *cmd, struct casereader *reader, + const struct dictionary *dict) +{ + struct matrix_get *get = &cmd->get; + struct variable **vars; + size_t n_vars = 0; + + if (get->n_vars) + { + if (!var_syntax_evaluate (get->vars, get->n_vars, dict, + &vars, &n_vars, PV_NUMERIC)) + return; + } + else + { + n_vars = dict_get_var_cnt (dict); + vars = xnmalloc (n_vars, sizeof *vars); + for (size_t i = 0; i < n_vars; i++) + { + struct variable *var = dict_get_var (dict, i); + if (!var_is_numeric (var)) + { + msg_at (SE, cmd->location, _("Variable %s is not numeric."), + var_get_name (var)); + free (vars); + return; + } + vars[i] = var; + } + } + + if (get->names) + { + gsl_matrix *names = gsl_matrix_alloc (n_vars, 1); + for (size_t i = 0; i < n_vars; i++) + { + char s[sizeof (double)]; + double f; + buf_copy_str_rpad (s, sizeof s, var_get_name (vars[i]), ' '); + memcpy (&f, s, sizeof f); + gsl_matrix_set (names, i, 0, f); + } + + gsl_matrix_free (get->names->value); + get->names->value = names; + } + + size_t n_rows = 0; + gsl_matrix *m = gsl_matrix_alloc (4, n_vars); + long long int casenum = 1; + bool error = false; + for (struct ccase *c = casereader_read (reader); c; + c = casereader_read (reader), casenum++) + { + if (n_rows >= m->size1) + { + gsl_matrix *p = gsl_matrix_alloc (m->size1 * 2, n_vars); + for (size_t y = 0; y < n_rows; y++) + for (size_t x = 0; x < n_vars; x++) + gsl_matrix_set (p, y, x, gsl_matrix_get (m, y, x)); + gsl_matrix_free (m); + m = p; + } + + bool keep = true; + for (size_t x = 0; x < n_vars; x++) + { + const struct variable *var = vars[x]; + double d = case_num (c, var); + if (d == SYSMIS) + { + if (get->system.treatment == MGET_RECODE) + d = get->system.substitute; + else if (get->system.treatment == MGET_OMIT) + keep = false; + else + { + msg_at (SE, cmd->location, _("Variable %s in case %lld " + "is system-missing."), + var_get_name (var), casenum); + error = true; + } + } + else if (var_is_num_missing (var, d, MV_USER)) + { + if (get->user.treatment == MGET_RECODE) + d = get->user.substitute; + else if (get->user.treatment == MGET_OMIT) + keep = false; + else if (get->user.treatment != MGET_ACCEPT) + { + msg_at (SE, cmd->location, + _("Variable %s in case %lld has user-missing " + "value %g."), + var_get_name (var), casenum, d); + error = true; + } + } + gsl_matrix_set (m, n_rows, x, d); + } + case_unref (c); + if (error) + break; + if (keep) + n_rows++; + } + if (!error) + { + m->size1 = n_rows; + matrix_lvalue_evaluate_and_assign (get->dst, m, cmd->location); + } + else + gsl_matrix_free (m); + free (vars); +} + +static bool +matrix_open_casereader (const struct matrix_command *cmd, + const char *command_name, struct file_handle *file, + const char *encoding, struct dataset *dataset, + struct casereader **readerp, struct dictionary **dictp) +{ + if (file) + { + *readerp = any_reader_open_and_decode (file, encoding, dictp, NULL); + return *readerp != NULL; + } + else + { + if (dict_get_var_cnt (dataset_dict (dataset)) == 0) + { + msg_at (ME, cmd->location, + _("The %s command cannot read an empty active file."), + command_name); + return false; + } + *readerp = proc_open (dataset); + *dictp = dict_ref (dataset_dict (dataset)); + return true; + } +} + +static void +matrix_close_casereader (struct file_handle *file, struct dataset *dataset, + struct casereader *reader, struct dictionary *dict) +{ + dict_unref (dict); + casereader_destroy (reader); + if (!file) + proc_commit (dataset); +} + +static void +matrix_get_execute (struct matrix_command *cmd) +{ + struct matrix_get *get = &cmd->get; + struct casereader *r; + struct dictionary *d; + if (matrix_open_casereader (cmd, "GET", get->file, get->encoding, + get->dataset, &r, &d)) + { + matrix_get_execute__ (cmd, r, d); + matrix_close_casereader (get->file, get->dataset, r, d); + } +} + +/* MSAVE. */ + +static bool +variables_changed (const char *keyword, + const struct string_array *new, + const struct string_array *old) +{ + if (new->n) + { + if (!old->n) + { + msg (SE, _("%s may only be specified on MSAVE if it was specified " + "on the first MSAVE within MATRIX."), keyword); + return true; + } + else if (!string_array_equal_case (old, new)) + { + msg (SE, _("%s must specify the same variables each time within " + "a given MATRIX."), keyword); + return true; + } + } + return false; +} + +static bool +msave_common_changed (const struct msave_common *old, + const struct msave_common *new) +{ + if (new->outfile && !fh_equal (old->outfile, new->outfile)) + msg (SE, _("OUTFILE must name the same file on each MSAVE " + "within a single MATRIX command.")); + else if (variables_changed ("VARIABLES", &new->variables, &old->variables) + || variables_changed ("FNAMES", &new->fnames, &old->fnames) + || variables_changed ("SNAMES", &new->snames, &old->snames)) + msg_at (SN, old->location, + _("This is the location of the first MSAVE command.")); + else + return false; + + return true; +} + +static void +msave_common_destroy (struct msave_common *common) +{ + if (common) + { + msg_location_destroy (common->location); + fh_unref (common->outfile); + string_array_destroy (&common->variables); + string_array_destroy (&common->fnames); + string_array_destroy (&common->snames); + + for (size_t i = 0; i < common->n_factors; i++) + matrix_expr_destroy (common->factors[i]); + free (common->factors); + + for (size_t i = 0; i < common->n_splits; i++) + matrix_expr_destroy (common->splits[i]); + free (common->splits); + + dict_unref (common->dict); + casewriter_destroy (common->writer); + + free (common); + } +} + +static const char * +match_rowtype (struct lexer *lexer) +{ + static const char *rowtypes[] = { + "COV", "CORR", "MEAN", "STDDEV", "N", "COUNT" + }; + size_t n_rowtypes = sizeof rowtypes / sizeof *rowtypes; + + for (size_t i = 0; i < n_rowtypes; i++) + if (lex_match_id (lexer, rowtypes[i])) + return rowtypes[i]; + + lex_error_expecting_array (lexer, rowtypes, n_rowtypes); + return NULL; +} + +static bool +parse_var_names (struct lexer *lexer, struct string_array *sa) +{ + lex_match (lexer, T_EQUALS); + + string_array_clear (sa); + + struct dictionary *dict = dict_create (get_default_encoding ()); + char **names; + size_t n_names; + bool ok = parse_DATA_LIST_vars (lexer, dict, &names, &n_names, + PV_NO_DUPLICATE | PV_NO_SCRATCH); + dict_unref (dict); + + if (ok) + { + for (size_t i = 0; i < n_names; i++) + if (ss_equals_case (ss_cstr (names[i]), ss_cstr ("ROWTYPE_")) + || ss_equals_case (ss_cstr (names[i]), ss_cstr ("VARNAME_"))) + { + msg (SE, _("Variable name %s is reserved."), names[i]); + for (size_t j = 0; j < n_names; j++) + free (names[i]); + free (names); + return false; + } + + string_array_clear (sa); + sa->strings = names; + sa->n = sa->allocated = n_names; + } + return ok; +} + +static struct matrix_command * +matrix_msave_parse (struct matrix_state *s) +{ + int start_ofs = lex_ofs (s->lexer); + + struct msave_common *common = xmalloc (sizeof *common); + *common = (struct msave_common) { .outfile = NULL }; + + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { .type = MCMD_MSAVE, .msave = { .expr = NULL } }; + + struct matrix_expr *splits = NULL; + struct matrix_expr *factors = NULL; + + struct matrix_msave *msave = &cmd->msave; + msave->expr = matrix_parse_exp (s); + if (!msave->expr) + goto error; + + while (lex_match (s->lexer, T_SLASH)) + { + if (lex_match_id (s->lexer, "TYPE")) + { + lex_match (s->lexer, T_EQUALS); + + msave->rowtype = match_rowtype (s->lexer); + if (!msave->rowtype) + goto error; + } + else if (lex_match_id (s->lexer, "OUTFILE")) + { + lex_match (s->lexer, T_EQUALS); + + fh_unref (common->outfile); + common->outfile = fh_parse (s->lexer, FH_REF_FILE, NULL); + if (!common->outfile) + goto error; + } + else if (lex_match_id (s->lexer, "VARIABLES")) + { + if (!parse_var_names (s->lexer, &common->variables)) + goto error; + } + else if (lex_match_id (s->lexer, "FNAMES")) + { + if (!parse_var_names (s->lexer, &common->fnames)) + goto error; + } + else if (lex_match_id (s->lexer, "SNAMES")) + { + if (!parse_var_names (s->lexer, &common->snames)) + goto error; + } + else if (lex_match_id (s->lexer, "SPLIT")) + { + lex_match (s->lexer, T_EQUALS); + + matrix_expr_destroy (splits); + splits = matrix_parse_exp (s); + if (!splits) + goto error; + } + else if (lex_match_id (s->lexer, "FACTOR")) + { + lex_match (s->lexer, T_EQUALS); + + matrix_expr_destroy (factors); + factors = matrix_parse_exp (s); + if (!factors) + goto error; + } + else + { + lex_error_expecting (s->lexer, "TYPE", "OUTFILE", "VARIABLES", + "FNAMES", "SNAMES", "SPLIT", "FACTOR"); + goto error; + } + } + if (!msave->rowtype) + { + lex_sbc_missing ("TYPE"); + goto error; + } + + if (!s->msave_common) + { + if (common->fnames.n && !factors) + { + msg (SE, _("FNAMES requires FACTOR.")); + goto error; + } + if (common->snames.n && !splits) + { + msg (SE, _("SNAMES requires SPLIT.")); + goto error; + } + if (!common->outfile) + { + lex_sbc_missing ("OUTFILE"); + goto error; + } + common->location = lex_ofs_location (s->lexer, start_ofs, + lex_ofs (s->lexer)); + msg_location_remove_columns (common->location); + s->msave_common = common; + } + else + { + if (msave_common_changed (s->msave_common, common)) + goto error; + msave_common_destroy (common); + } + msave->common = s->msave_common; + + struct msave_common *c = s->msave_common; + if (factors) + { + if (c->n_factors >= c->allocated_factors) + c->factors = x2nrealloc (c->factors, &c->allocated_factors, + sizeof *c->factors); + c->factors[c->n_factors++] = factors; + } + if (c->n_factors > 0) + msave->factors = c->factors[c->n_factors - 1]; + + if (splits) + { + if (c->n_splits >= c->allocated_splits) + c->splits = x2nrealloc (c->splits, &c->allocated_splits, + sizeof *c->splits); + c->splits[c->n_splits++] = splits; + } + if (c->n_splits > 0) + msave->splits = c->splits[c->n_splits - 1]; + + return cmd; + +error: + matrix_expr_destroy (splits); + matrix_expr_destroy (factors); + msave_common_destroy (common); + matrix_command_destroy (cmd); + return NULL; +} + +static gsl_vector * +matrix_expr_evaluate_vector (const struct matrix_expr *e, const char *name) +{ + gsl_matrix *m = matrix_expr_evaluate (e); + if (!m) + return NULL; + + if (!is_vector (m)) + { + msg_at (SE, matrix_expr_location (e), + _("%s expression must evaluate to vector, " + "not a %zu×%zu matrix."), + name, m->size1, m->size2); + gsl_matrix_free (m); + return NULL; + } + + return matrix_to_vector (m); +} + +static const char * +msave_add_vars (struct dictionary *d, const struct string_array *vars) +{ + for (size_t i = 0; i < vars->n; i++) + if (!dict_create_var (d, vars->strings[i], 0)) + return vars->strings[i]; + return NULL; +} + +static struct dictionary * +msave_create_dict (const struct msave_common *common, + const struct msg_location *location) +{ + struct dictionary *dict = dict_create (get_default_encoding ()); + + const char *dup_split = msave_add_vars (dict, &common->snames); + if (dup_split) + { + /* Should not be possible because the parser ensures that the names are + unique. */ + NOT_REACHED (); + } + + dict_create_var_assert (dict, "ROWTYPE_", 8); + + const char *dup_factor = msave_add_vars (dict, &common->fnames); + if (dup_factor) + { + msg_at (SE, location, _("Duplicate or invalid FACTOR variable name %s."), + dup_factor); + goto error; + } + + dict_create_var_assert (dict, "VARNAME_", 8); + + const char *dup_var = msave_add_vars (dict, &common->variables); + if (dup_var) + { + msg_at (SE, location, _("Duplicate or invalid variable name %s."), + dup_var); + goto error; + } + + return dict; + +error: + dict_unref (dict); + return NULL; +} + +static void +matrix_msave_execute (struct matrix_command *cmd) +{ + struct matrix_msave *msave = &cmd->msave; + struct msave_common *common = msave->common; + gsl_matrix *m = NULL; + gsl_vector *factors = NULL; + gsl_vector *splits = NULL; + + m = matrix_expr_evaluate (msave->expr); + if (!m) + goto error; + + if (!common->variables.n) + for (size_t i = 0; i < m->size2; i++) + string_array_append_nocopy (&common->variables, + xasprintf ("COL%zu", i + 1)); + else if (m->size2 != common->variables.n) + { + msg_at (SE, matrix_expr_location (msave->expr), + _("Matrix on MSAVE has %zu columns but there are %zu variables."), + m->size2, common->variables.n); + goto error; + } + + if (msave->factors) + { + factors = matrix_expr_evaluate_vector (msave->factors, "FACTOR"); + if (!factors) + goto error; + + if (!common->fnames.n) + for (size_t i = 0; i < factors->size; i++) + string_array_append_nocopy (&common->fnames, + xasprintf ("FAC%zu", i + 1)); + else if (factors->size != common->fnames.n) + { + msg_at (SE, matrix_expr_location (msave->factors), + _("There are %zu factor variables, " + "but %zu factor values were supplied."), + common->fnames.n, factors->size); + goto error; + } + } + + if (msave->splits) + { + splits = matrix_expr_evaluate_vector (msave->splits, "SPLIT"); + if (!splits) + goto error; + + if (!common->snames.n) + for (size_t i = 0; i < splits->size; i++) + string_array_append_nocopy (&common->snames, + xasprintf ("SPL%zu", i + 1)); + else if (splits->size != common->snames.n) + { + msg_at (SE, matrix_expr_location (msave->splits), + _("There are %zu split variables, " + "but %zu split values were supplied."), + common->snames.n, splits->size); + goto error; + } + } + + if (!common->writer) + { + struct dictionary *dict = msave_create_dict (common, cmd->location); + if (!dict) + goto error; + + common->writer = any_writer_open (common->outfile, dict); + if (!common->writer) + { + dict_unref (dict); + goto error; + } + + common->dict = dict; + } + + bool matrix = (!strcmp (msave->rowtype, "COV") + || !strcmp (msave->rowtype, "CORR")); + for (size_t y = 0; y < m->size1; y++) + { + struct ccase *c = case_create (dict_get_proto (common->dict)); + size_t idx = 0; + + /* Split variables */ + if (splits) + for (size_t i = 0; i < splits->size; i++) + case_data_rw_idx (c, idx++)->f = gsl_vector_get (splits, i); + + /* ROWTYPE_. */ + buf_copy_str_rpad (CHAR_CAST (char *, case_data_rw_idx (c, idx++)->s), 8, + msave->rowtype, ' '); + + /* Factors. */ + if (factors) + for (size_t i = 0; i < factors->size; i++) + *case_num_rw_idx (c, idx++) = gsl_vector_get (factors, i); + + /* VARNAME_. */ + const char *varname_ = (matrix && y < common->variables.n + ? common->variables.strings[y] + : ""); + buf_copy_str_rpad (CHAR_CAST (char *, case_data_rw_idx (c, idx++)->s), 8, + varname_, ' '); + + /* Continuous variables. */ + for (size_t x = 0; x < m->size2; x++) + case_data_rw_idx (c, idx++)->f = gsl_matrix_get (m, y, x); + casewriter_write (common->writer, c); + } + +error: + gsl_matrix_free (m); + gsl_vector_free (factors); + gsl_vector_free (splits); +} + +/* MGET. */ + +static struct matrix_command * +matrix_mget_parse (struct matrix_state *s) +{ + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { + .type = MCMD_MGET, + .mget = { + .state = s, + .rowtypes = STRINGI_SET_INITIALIZER (cmd->mget.rowtypes), + }, + }; + + struct matrix_mget *mget = &cmd->mget; + + lex_match (s->lexer, T_SLASH); + while (lex_token (s->lexer) != T_ENDCMD) + { + if (lex_match_id (s->lexer, "FILE")) + { + lex_match (s->lexer, T_EQUALS); + + fh_unref (mget->file); + mget->file = fh_parse (s->lexer, FH_REF_FILE, s->session); + if (!mget->file) + goto error; + } + else if (lex_match_id (s->lexer, "ENCODING")) + { + lex_match (s->lexer, T_EQUALS); + if (!lex_force_string (s->lexer)) + goto error; + + free (mget->encoding); + mget->encoding = ss_xstrdup (lex_tokss (s->lexer)); + + lex_get (s->lexer); + } + else if (lex_match_id (s->lexer, "TYPE")) + { + lex_match (s->lexer, T_EQUALS); + while (lex_token (s->lexer) != T_SLASH + && lex_token (s->lexer) != T_ENDCMD) + { + const char *rowtype = match_rowtype (s->lexer); + if (!rowtype) + goto error; + + stringi_set_insert (&mget->rowtypes, rowtype); + } + } + else + { + lex_error_expecting (s->lexer, "FILE", "TYPE"); + goto error; + } + lex_match (s->lexer, T_SLASH); + } + return cmd; + +error: + matrix_command_destroy (cmd); + return NULL; +} + +static const struct variable * +get_a8_var (const struct msg_location *loc, + const struct dictionary *d, const char *name) +{ + const struct variable *v = dict_lookup_var (d, name); + if (!v) + { + msg_at (SE, loc, _("Matrix data file lacks %s variable."), name); + return NULL; + } + if (var_get_width (v) != 8) + { + msg_at (SE, loc, _("%s variable in matrix data file must be " + "8-byte string, but it has width %d."), + name, var_get_width (v)); + return NULL; + } + return v; +} + +static bool +var_changed (const struct ccase *ca, const struct ccase *cb, + const struct variable *var) +{ + return (ca && cb + ? !value_equal (case_data (ca, var), case_data (cb, var), + var_get_width (var)) + : ca || cb); +} + +static bool +vars_changed (const struct ccase *ca, const struct ccase *cb, + const struct dictionary *d, + size_t first_var, size_t n_vars) +{ + for (size_t i = 0; i < n_vars; i++) + { + const struct variable *v = dict_get_var (d, first_var + i); + if (var_changed (ca, cb, v)) + return true; + } + return false; +} + +static bool +vars_all_missing (const struct ccase *c, const struct dictionary *d, + size_t first_var, size_t n_vars) +{ + for (size_t i = 0; i < n_vars; i++) + if (case_num (c, dict_get_var (d, first_var + i)) != SYSMIS) + return false; + return true; +} + +static void +matrix_mget_commit_var (struct ccase **rows, size_t n_rows, + const struct dictionary *d, + const struct variable *rowtype_var, + const struct stringi_set *accepted_rowtypes, + struct matrix_state *s, + size_t ss, size_t sn, size_t si, + size_t fs, size_t fn, size_t fi, + size_t cs, size_t cn, + struct pivot_table *pt, + struct pivot_dimension *var_dimension) +{ + if (!n_rows) + goto exit; + + /* Is this a matrix for pooled data, either where there are no factor + variables or the factor variables are missing? */ + bool pooled = !fn || vars_all_missing (rows[0], d, fs, fn); + + struct substring rowtype = case_ss (rows[0], rowtype_var); + ss_rtrim (&rowtype, ss_cstr (" ")); + if (!stringi_set_is_empty (accepted_rowtypes) + && !stringi_set_contains_len (accepted_rowtypes, + rowtype.string, rowtype.length)) + goto exit; + + const char *prefix = (ss_equals_case (rowtype, ss_cstr ("COV")) ? "CV" + : ss_equals_case (rowtype, ss_cstr ("CORR")) ? "CR" + : ss_equals_case (rowtype, ss_cstr ("MEAN")) ? "MN" + : ss_equals_case (rowtype, ss_cstr ("STDDEV")) ? "SD" + : ss_equals_case (rowtype, ss_cstr ("N")) ? "NC" + : ss_equals_case (rowtype, ss_cstr ("COUNT")) ? "CN" + : NULL); + if (!prefix) + { + msg (SE, _("Matrix data file contains unknown ROWTYPE_ \"%.*s\"."), + (int) rowtype.length, rowtype.string); + goto exit; + } + + struct string name = DS_EMPTY_INITIALIZER; + ds_put_cstr (&name, prefix); + if (!pooled) + ds_put_format (&name, "F%zu", fi); + if (si > 0) + ds_put_format (&name, "S%zu", si); + + struct matrix_var *mv = matrix_var_lookup (s, ds_ss (&name)); + if (!mv) + mv = matrix_var_create (s, ds_ss (&name)); + else if (mv->value) + { + msg (SW, _("Matrix data file contains variable with existing name %s."), + ds_cstr (&name)); + goto exit_free_name; + } + + gsl_matrix *m = gsl_matrix_alloc (n_rows, cn); + size_t n_missing = 0; + for (size_t y = 0; y < n_rows; y++) + { + for (size_t x = 0; x < cn; x++) + { + struct variable *var = dict_get_var (d, cs + x); + double value = case_num (rows[y], var); + if (var_is_num_missing (var, value, MV_ANY)) + { + n_missing++; + value = 0.0; + } + gsl_matrix_set (m, y, x, value); + } + } + + int var_index = pivot_category_create_leaf ( + var_dimension->root, pivot_value_new_user_text (ds_cstr (&name), SIZE_MAX)); + double values[] = { n_rows, cn }; + for (size_t j = 0; j < sn; j++) + { + struct variable *var = dict_get_var (d, ss + j); + const union value *value = case_data (rows[0], var); + pivot_table_put2 (pt, j, var_index, + pivot_value_new_var_value (var, value)); + } + for (size_t j = 0; j < fn; j++) + { + struct variable *var = dict_get_var (d, fs + j); + const union value sysmis = { .f = SYSMIS }; + const union value *value = pooled ? &sysmis : case_data (rows[0], var); + pivot_table_put2 (pt, j + sn, var_index, + pivot_value_new_var_value (var, value)); + } + for (size_t j = 0; j < sizeof values / sizeof *values; j++) + pivot_table_put2 (pt, j + sn + fn, var_index, + pivot_value_new_integer (values[j])); + + if (n_missing) + msg (SE, ngettext ("Matrix data file variable %s contains a missing " + "value, which was treated as zero.", + "Matrix data file variable %s contains %zu missing " + "values, which were treated as zero.", n_missing), + ds_cstr (&name), n_missing); + mv->value = m; + +exit_free_name: + ds_destroy (&name); + +exit: + for (size_t y = 0; y < n_rows; y++) + case_unref (rows[y]); +} + +static void +matrix_mget_execute__ (struct matrix_command *cmd, struct casereader *r, + const struct dictionary *d) +{ + struct matrix_mget *mget = &cmd->mget; + const struct msg_location *loc = cmd->location; + const struct variable *rowtype_ = get_a8_var (loc, d, "ROWTYPE_"); + const struct variable *varname_ = get_a8_var (loc, d, "VARNAME_"); + if (!rowtype_ || !varname_) + return; + + if (var_get_dict_index (rowtype_) >= var_get_dict_index (varname_)) + { + msg_at (SE, loc, + _("ROWTYPE_ must precede VARNAME_ in matrix data file.")); + return; + } + if (var_get_dict_index (varname_) + 1 >= dict_get_var_cnt (d)) + { + msg_at (SE, loc, _("Matrix data file contains no continuous variables.")); + return; + } + + for (size_t i = 0; i < dict_get_var_cnt (d); i++) + { + const struct variable *v = dict_get_var (d, i); + if (v != rowtype_ && v != varname_ && var_get_width (v) != 0) + { + msg_at (SE, loc, + _("Matrix data file contains unexpected string variable %s."), + var_get_name (v)); + return; + } + } + + /* SPLIT variables. */ + size_t ss = 0; + size_t sn = var_get_dict_index (rowtype_); + struct ccase *sc = NULL; + size_t si = 0; + + /* FACTOR variables. */ + size_t fs = var_get_dict_index (rowtype_) + 1; + size_t fn = var_get_dict_index (varname_) - var_get_dict_index (rowtype_) - 1; + struct ccase *fc = NULL; + size_t fi = 0; + + /* Continuous variables. */ + size_t cs = var_get_dict_index (varname_) + 1; + size_t cn = dict_get_var_cnt (d) - cs; + struct ccase *cc = NULL; + + /* Pivot table. */ + struct pivot_table *pt = pivot_table_create ( + N_("Matrix Variables Created by MGET")); + struct pivot_dimension *attr_dimension = pivot_dimension_create ( + pt, PIVOT_AXIS_COLUMN, N_("Attribute")); + struct pivot_dimension *var_dimension = pivot_dimension_create ( + pt, PIVOT_AXIS_ROW, N_("Variable")); + if (sn > 0) + { + struct pivot_category *splits = pivot_category_create_group ( + attr_dimension->root, N_("Split Values")); + for (size_t i = 0; i < sn; i++) + pivot_category_create_leaf (splits, pivot_value_new_variable ( + dict_get_var (d, ss + i))); + } + if (fn > 0) + { + struct pivot_category *factors = pivot_category_create_group ( + attr_dimension->root, N_("Factors")); + for (size_t i = 0; i < fn; i++) + pivot_category_create_leaf (factors, pivot_value_new_variable ( + dict_get_var (d, fs + i))); + } + pivot_category_create_group (attr_dimension->root, N_("Dimensions"), + N_("Rows"), N_("Columns")); + + /* Matrix. */ + struct ccase **rows = NULL; + size_t allocated_rows = 0; + size_t n_rows = 0; + + struct ccase *c; + while ((c = casereader_read (r)) != NULL) + { + bool row_has_factors = fn && !vars_all_missing (c, d, fs, fn); + + enum + { + SPLITS_CHANGED, + FACTORS_CHANGED, + ROWTYPE_CHANGED, + NOTHING_CHANGED + } + change + = (sn && (!sc || vars_changed (sc, c, d, ss, sn)) ? SPLITS_CHANGED + : fn && (!fc || vars_changed (fc, c, d, fs, fn)) ? FACTORS_CHANGED + : !cc || var_changed (cc, c, rowtype_) ? ROWTYPE_CHANGED + : NOTHING_CHANGED); + + if (change != NOTHING_CHANGED) + { + matrix_mget_commit_var (rows, n_rows, d, + rowtype_, &mget->rowtypes, + mget->state, + ss, sn, si, + fs, fn, fi, + cs, cn, + pt, var_dimension); + n_rows = 0; + case_unref (cc); + cc = case_ref (c); + } + + if (n_rows >= allocated_rows) + rows = x2nrealloc (rows, &allocated_rows, sizeof *rows); + rows[n_rows++] = c; + + if (change == SPLITS_CHANGED) + { + si++; + case_unref (sc); + sc = case_ref (c); + + /* Reset the factor number, if there are factors. */ + if (fn) + { + fi = 0; + if (row_has_factors) + fi++; + case_unref (fc); + fc = case_ref (c); + } + } + else if (change == FACTORS_CHANGED) + { + if (row_has_factors) + fi++; + case_unref (fc); + fc = case_ref (c); + } + } + matrix_mget_commit_var (rows, n_rows, d, + rowtype_, &mget->rowtypes, + mget->state, + ss, sn, si, + fs, fn, fi, + cs, cn, + pt, var_dimension); + free (rows); + + case_unref (sc); + case_unref (fc); + case_unref (cc); + + if (var_dimension->n_leaves) + pivot_table_submit (pt); + else + pivot_table_unref (pt); +} + +static void +matrix_mget_execute (struct matrix_command *cmd) +{ + struct matrix_mget *mget = &cmd->mget; + struct casereader *r; + struct dictionary *d; + if (matrix_open_casereader (cmd, "MGET", mget->file, mget->encoding, + mget->state->dataset, &r, &d)) + { + matrix_mget_execute__ (cmd, r, d); + matrix_close_casereader (mget->file, mget->state->dataset, r, d); + } +} + +/* CALL EIGEN. */ + +static bool +matrix_parse_dst_var (struct matrix_state *s, struct matrix_var **varp) +{ + if (!lex_force_id (s->lexer)) + return false; + + *varp = matrix_var_lookup (s, lex_tokss (s->lexer)); + if (!*varp) + *varp = matrix_var_create (s, lex_tokss (s->lexer)); + lex_get (s->lexer); + return true; +} + +static struct matrix_command * +matrix_eigen_parse (struct matrix_state *s) +{ + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { + .type = MCMD_EIGEN, + .eigen = { .expr = NULL } + }; + + struct matrix_eigen *eigen = &cmd->eigen; + if (!lex_force_match (s->lexer, T_LPAREN)) + goto error; + eigen->expr = matrix_expr_parse (s); + if (!eigen->expr + || !lex_force_match (s->lexer, T_COMMA) + || !matrix_parse_dst_var (s, &eigen->evec) + || !lex_force_match (s->lexer, T_COMMA) + || !matrix_parse_dst_var (s, &eigen->eval) + || !lex_force_match (s->lexer, T_RPAREN)) + goto error; + + return cmd; + +error: + matrix_command_destroy (cmd); + return NULL; +} + +static void +matrix_eigen_execute (struct matrix_command *cmd) +{ + struct matrix_eigen *eigen = &cmd->eigen; + gsl_matrix *A = matrix_expr_evaluate (eigen->expr); + if (!A) + return; + if (!is_symmetric (A)) + { + msg_at (SE, cmd->location, _("Argument of EIGEN must be symmetric.")); + gsl_matrix_free (A); + return; + } + + gsl_eigen_symmv_workspace *w = gsl_eigen_symmv_alloc (A->size1); + gsl_matrix *eval = gsl_matrix_alloc (A->size1, 1); + gsl_vector v_eval = to_vector (eval); + gsl_matrix *evec = gsl_matrix_alloc (A->size1, A->size2); + gsl_eigen_symmv (A, &v_eval, evec, w); + gsl_eigen_symmv_free (w); + + gsl_eigen_symmv_sort (&v_eval, evec, GSL_EIGEN_SORT_VAL_DESC); + + gsl_matrix_free (A); + + gsl_matrix_free (eigen->eval->value); + eigen->eval->value = eval; + + gsl_matrix_free (eigen->evec->value); + eigen->evec->value = evec; +} + +/* CALL SETDIAG. */ + +static struct matrix_command * +matrix_setdiag_parse (struct matrix_state *s) +{ + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { + .type = MCMD_SETDIAG, + .setdiag = { .dst = NULL } + }; + + struct matrix_setdiag *setdiag = &cmd->setdiag; + if (!lex_force_match (s->lexer, T_LPAREN) || !lex_force_id (s->lexer)) + goto error; + + setdiag->dst = matrix_var_lookup (s, lex_tokss (s->lexer)); + if (!setdiag->dst) + { + lex_error (s->lexer, _("Unknown variable %s."), lex_tokcstr (s->lexer)); + goto error; + } + lex_get (s->lexer); + + if (!lex_force_match (s->lexer, T_COMMA)) + goto error; + + setdiag->expr = matrix_expr_parse (s); + if (!setdiag->expr) + goto error; + + if (!lex_force_match (s->lexer, T_RPAREN)) + goto error; + + return cmd; + +error: + matrix_command_destroy (cmd); + return NULL; +} + +static void +matrix_setdiag_execute (struct matrix_command *cmd) +{ + struct matrix_setdiag *setdiag = &cmd->setdiag; + gsl_matrix *dst = setdiag->dst->value; + if (!dst) + { + msg_at (SE, cmd->location, + _("SETDIAG destination matrix %s is uninitialized."), + setdiag->dst->name); + return; + } + + gsl_matrix *src = matrix_expr_evaluate (setdiag->expr); + if (!src) + return; + + size_t n = MIN (dst->size1, dst->size2); + if (is_scalar (src)) + { + double d = to_scalar (src); + for (size_t i = 0; i < n; i++) + gsl_matrix_set (dst, i, i, d); + } + else if (is_vector (src)) + { + gsl_vector v = to_vector (src); + for (size_t i = 0; i < n && i < v.size; i++) + gsl_matrix_set (dst, i, i, gsl_vector_get (&v, i)); + } + else + msg_at (SE, matrix_expr_location (setdiag->expr), + _("SETDIAG argument 2 must be a scalar or a vector, " + "not a %zu×%zu matrix."), + src->size1, src->size2); + gsl_matrix_free (src); +} + +/* CALL SVD. */ + +static struct matrix_command * +matrix_svd_parse (struct matrix_state *s) +{ + struct matrix_command *cmd = xmalloc (sizeof *cmd); + *cmd = (struct matrix_command) { + .type = MCMD_SVD, + .svd = { .expr = NULL } + }; + + struct matrix_svd *svd = &cmd->svd; + if (!lex_force_match (s->lexer, T_LPAREN)) + goto error; + svd->expr = matrix_expr_parse (s); + if (!svd->expr + || !lex_force_match (s->lexer, T_COMMA) + || !matrix_parse_dst_var (s, &svd->u) + || !lex_force_match (s->lexer, T_COMMA) + || !matrix_parse_dst_var (s, &svd->s) + || !lex_force_match (s->lexer, T_COMMA) + || !matrix_parse_dst_var (s, &svd->v) + || !lex_force_match (s->lexer, T_RPAREN)) + goto error; + + return cmd; + +error: + matrix_command_destroy (cmd); + return NULL; +} + +static void +matrix_svd_execute (struct matrix_svd *svd) +{ + gsl_matrix *m = matrix_expr_evaluate (svd->expr); + if (!m) + return; + + if (m->size1 >= m->size2) + { + gsl_matrix *A = m; + gsl_matrix *V = gsl_matrix_alloc (A->size2, A->size2); + gsl_matrix *S = gsl_matrix_calloc (A->size2, A->size2); + gsl_vector Sv = gsl_matrix_diagonal (S).vector; + gsl_vector *work = gsl_vector_alloc (A->size2); + gsl_linalg_SV_decomp (A, V, &Sv, work); + gsl_vector_free (work); + + matrix_var_set (svd->u, A); + matrix_var_set (svd->s, S); + matrix_var_set (svd->v, V); + } + else + { + gsl_matrix *At = gsl_matrix_alloc (m->size2, m->size1); + gsl_matrix_transpose_memcpy (At, m); + gsl_matrix_free (m); + + gsl_matrix *Vt = gsl_matrix_alloc (At->size2, At->size2); + gsl_matrix *St = gsl_matrix_calloc (At->size2, At->size2); + gsl_vector Stv = gsl_matrix_diagonal (St).vector; + gsl_vector *work = gsl_vector_alloc (At->size2); + gsl_linalg_SV_decomp (At, Vt, &Stv, work); + gsl_vector_free (work); + + matrix_var_set (svd->v, At); + matrix_var_set (svd->s, St); + matrix_var_set (svd->u, Vt); + } +} + +/* The main MATRIX command logic. */ + +static bool +matrix_command_execute (struct matrix_command *cmd) +{ + switch (cmd->type) + { + case MCMD_COMPUTE: + matrix_compute_execute (cmd); + break; + + case MCMD_PRINT: + matrix_print_execute (&cmd->print); + break; + + case MCMD_DO_IF: + return matrix_do_if_execute (&cmd->do_if); + + case MCMD_LOOP: + matrix_loop_execute (&cmd->loop); + break; + + case MCMD_BREAK: + return false; + + case MCMD_DISPLAY: + matrix_display_execute (&cmd->display); + break; + + case MCMD_RELEASE: + matrix_release_execute (&cmd->release); + break; + + case MCMD_SAVE: + matrix_save_execute (cmd); + break; + + case MCMD_READ: + matrix_read_execute (cmd); + break; + + case MCMD_WRITE: + matrix_write_execute (&cmd->write); + break; + + case MCMD_GET: + matrix_get_execute (cmd); + break; + + case MCMD_MSAVE: + matrix_msave_execute (cmd); + break; + + case MCMD_MGET: + matrix_mget_execute (cmd); + break; + + case MCMD_EIGEN: + matrix_eigen_execute (cmd); + break; + + case MCMD_SETDIAG: + matrix_setdiag_execute (cmd); + break; + + case MCMD_SVD: + matrix_svd_execute (&cmd->svd); + break; + } + + return true; +} + +static void +matrix_command_destroy (struct matrix_command *cmd) +{ + if (!cmd) + return; + + msg_location_destroy (cmd->location); + + switch (cmd->type) + { + case MCMD_COMPUTE: + matrix_lvalue_destroy (cmd->compute.lvalue); + matrix_expr_destroy (cmd->compute.rvalue); + break; + + case MCMD_PRINT: + matrix_expr_destroy (cmd->print.expression); + free (cmd->print.title); + print_labels_destroy (cmd->print.rlabels); + print_labels_destroy (cmd->print.clabels); + break; + + case MCMD_DO_IF: + for (size_t i = 0; i < cmd->do_if.n_clauses; i++) + { + matrix_expr_destroy (cmd->do_if.clauses[i].condition); + matrix_commands_uninit (&cmd->do_if.clauses[i].commands); + } + free (cmd->do_if.clauses); + break; + + case MCMD_LOOP: + matrix_expr_destroy (cmd->loop.start); + matrix_expr_destroy (cmd->loop.end); + matrix_expr_destroy (cmd->loop.increment); + matrix_expr_destroy (cmd->loop.top_condition); + matrix_expr_destroy (cmd->loop.bottom_condition); + matrix_commands_uninit (&cmd->loop.commands); + break; + + case MCMD_BREAK: + break; + + case MCMD_DISPLAY: + break; + + case MCMD_RELEASE: + free (cmd->release.vars); + break; + + case MCMD_SAVE: + matrix_expr_destroy (cmd->save.expression); + break; + + case MCMD_READ: + matrix_lvalue_destroy (cmd->read.dst); + matrix_expr_destroy (cmd->read.size); + break; + + case MCMD_WRITE: + matrix_expr_destroy (cmd->write.expression); + free (cmd->write.format); + break; + + case MCMD_GET: + matrix_lvalue_destroy (cmd->get.dst); + fh_unref (cmd->get.file); + free (cmd->get.encoding); + var_syntax_destroy (cmd->get.vars, cmd->get.n_vars); + break; + + case MCMD_MSAVE: + matrix_expr_destroy (cmd->msave.expr); + break; + + case MCMD_MGET: + fh_unref (cmd->mget.file); + stringi_set_destroy (&cmd->mget.rowtypes); + break; + + case MCMD_EIGEN: + matrix_expr_destroy (cmd->eigen.expr); + break; + + case MCMD_SETDIAG: + matrix_expr_destroy (cmd->setdiag.expr); + break; + + case MCMD_SVD: + matrix_expr_destroy (cmd->svd.expr); + break; + } + free (cmd); +} + +static bool +matrix_commands_parse (struct matrix_state *s, struct matrix_commands *c, + const char *command_name, + const char *stop1, const char *stop2) +{ + lex_end_of_command (s->lexer); + lex_discard_rest_of_command (s->lexer); + + size_t allocated = 0; + for (;;) + { + while (lex_token (s->lexer) == T_ENDCMD) + lex_get (s->lexer); + + if (lex_at_phrase (s->lexer, stop1) + || (stop2 && lex_at_phrase (s->lexer, stop2))) + return true; + + if (lex_at_phrase (s->lexer, "END MATRIX")) + { + msg (SE, _("Premature END MATRIX within %s."), command_name); + return false; + } + + struct matrix_command *cmd = matrix_command_parse (s); + if (!cmd) + return false; + + if (c->n >= allocated) + c->commands = x2nrealloc (c->commands, &allocated, sizeof *c->commands); + c->commands[c->n++] = cmd; + } +} + +static void +matrix_commands_uninit (struct matrix_commands *cmds) +{ + for (size_t i = 0; i < cmds->n; i++) + matrix_command_destroy (cmds->commands[i]); + free (cmds->commands); +} + +struct matrix_command_name + { + const char *name; + struct matrix_command *(*parse) (struct matrix_state *); + }; + +static const struct matrix_command_name * +matrix_command_name_parse (struct lexer *lexer) +{ + static const struct matrix_command_name commands[] = { + { "COMPUTE", matrix_compute_parse }, + { "CALL EIGEN", matrix_eigen_parse }, + { "CALL SETDIAG", matrix_setdiag_parse }, + { "CALL SVD", matrix_svd_parse }, + { "PRINT", matrix_print_parse }, + { "DO IF", matrix_do_if_parse }, + { "LOOP", matrix_loop_parse }, + { "BREAK", matrix_break_parse }, + { "READ", matrix_read_parse }, + { "WRITE", matrix_write_parse }, + { "GET", matrix_get_parse }, + { "SAVE", matrix_save_parse }, + { "MGET", matrix_mget_parse }, + { "MSAVE", matrix_msave_parse }, + { "DISPLAY", matrix_display_parse }, + { "RELEASE", matrix_release_parse }, + }; + static size_t n = sizeof commands / sizeof *commands; + + for (const struct matrix_command_name *c = commands; c < &commands[n]; c++) + if (lex_match_phrase (lexer, c->name)) + return c; + return NULL; +} + +static struct matrix_command * +matrix_command_parse (struct matrix_state *s) +{ + int start_ofs = lex_ofs (s->lexer); + size_t nesting_level = SIZE_MAX; + + struct matrix_command *c = NULL; + const struct matrix_command_name *cmd = matrix_command_name_parse (s->lexer); + if (!cmd) + lex_error (s->lexer, _("Unknown matrix command.")); + else if (!cmd->parse) + lex_error (s->lexer, _("Matrix command %s is not yet implemented."), + cmd->name); + else + { + nesting_level = output_open_group ( + group_item_create_nocopy (utf8_to_title (cmd->name), + utf8_to_title (cmd->name))); + c = cmd->parse (s); + } + + if (c) + { + c->location = lex_ofs_location (s->lexer, start_ofs, lex_ofs (s->lexer)); + msg_location_remove_columns (c->location); + lex_end_of_command (s->lexer); + } + lex_discard_rest_of_command (s->lexer); + if (nesting_level != SIZE_MAX) + output_close_groups (nesting_level); + + return c; +} + +int +cmd_matrix (struct lexer *lexer, struct dataset *ds) +{ + if (!lex_force_match (lexer, T_ENDCMD)) + return CMD_FAILURE; + + struct matrix_state state = { + .dataset = ds, + .session = dataset_session (ds), + .lexer = lexer, + .vars = HMAP_INITIALIZER (state.vars), + }; + + for (;;) + { + while (lex_match (lexer, T_ENDCMD)) + continue; + if (lex_token (lexer) == T_STOP) + { + msg (SE, _("Unexpected end of input expecting matrix command.")); + break; + } + + if (lex_match_phrase (lexer, "END MATRIX")) + break; + + struct matrix_command *c = matrix_command_parse (&state); + if (c) + { + matrix_command_execute (c); + matrix_command_destroy (c); + } + } + + struct matrix_var *var, *next; + HMAP_FOR_EACH_SAFE (var, next, struct matrix_var, hmap_node, &state.vars) + { + free (var->name); + gsl_matrix_free (var->value); + hmap_delete (&state.vars, &var->hmap_node); + free (var); + } + hmap_destroy (&state.vars); + msave_common_destroy (state.msave_common); + fh_unref (state.prev_read_file); + for (size_t i = 0; i < state.n_read_files; i++) + read_file_destroy (state.read_files[i]); + free (state.read_files); + fh_unref (state.prev_write_file); + for (size_t i = 0; i < state.n_write_files; i++) + write_file_destroy (state.write_files[i]); + free (state.write_files); + fh_unref (state.prev_save_file); + for (size_t i = 0; i < state.n_save_files; i++) + save_file_destroy (state.save_files[i]); + free (state.save_files); + + return CMD_SUCCESS; +} diff --git a/src/language/utilities/set.c b/src/language/utilities/set.c index a29e5c2ef0..9b18bfb0df 100644 --- a/src/language/utilities/set.c +++ b/src/language/utilities/set.c @@ -669,6 +669,24 @@ show_LOCALE (const struct dataset *ds UNUSED) return xstrdup (get_default_encoding ()); } +static bool +parse_MDISPLAY (struct lexer *lexer) +{ + int mdisplay = force_parse_enum (lexer, + "TEXT", SETTINGS_MDISPLAY_TEXT, + "TABLES", SETTINGS_MDISPLAY_TABLES); + if (mdisplay >= 0) + settings_set_mdisplay (mdisplay); + return mdisplay >= 0; +} + +static char * +show_MDISPLAY (const struct dataset *ds UNUSED) +{ + return xstrdup (settings_get_mdisplay () == SETTINGS_MDISPLAY_TEXT + ? "TEXT" : "TABLES"); +} + static bool parse_MESSAGES (struct lexer *lexer) { @@ -1177,6 +1195,7 @@ static const struct setting settings[] = { { "JOURNAL", parse_JOURNAL, show_JOURNAL }, { "LENGTH", parse_LENGTH, show_LENGTH }, { "LOCALE", parse_LOCALE, show_LOCALE }, + { "MDISPLAY", parse_MDISPLAY, show_MDISPLAY }, { "MESSAGES", parse_MESSAGES, show_MESSAGES }, { "MEXPAND", parse_MEXPAND, show_MEXPAND }, { "MITERATE", parse_MITERATE, show_MITERATE }, diff --git a/tests/automake.mk b/tests/automake.mk index 2ddea5c8b1..3f76cbc32a 100644 --- a/tests/automake.mk +++ b/tests/automake.mk @@ -399,6 +399,7 @@ TESTSUITE_AT = \ tests/language/stats/frequencies.at \ tests/language/stats/glm.at \ tests/language/stats/logistic.at \ + tests/language/stats/matrix.at \ tests/language/stats/means.at \ tests/language/stats/npar.at \ tests/language/stats/oneway.at \ diff --git a/tests/language/stats/matrix.at b/tests/language/stats/matrix.at new file mode 100644 index 0000000000..add4cae745 --- /dev/null +++ b/tests/language/stats/matrix.at @@ -0,0 +1,4733 @@ +AT_BANNER([MATRIX]) + +AT_SETUP([MATRIX - empty matrices]) +AT_DATA([matrix.sps], [dnl +MATRIX. +COMPUTE a={}. +PRINT a. +COMPUTE b={a; 1; 2; 3}. +PRINT b. +COMPUTE c={a, 1, 2, 3}. +PRINT c. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +a + +b + 1 + 2 + 3 + +c + 1 2 3 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - submatrices as rvalues - all columns or all rows]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(1, :). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}({1}, :). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}({1, 2}, :). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}({1, 2, 3}, :). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}({1; 3; 2}, :). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}({1, 3, 3}, :). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(1:2, :). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(1:3, :). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}({}, :). + +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(:, 1). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(:, {1}). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(:, {1, 2}). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(:, {1, 2, 3}). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(:, {1; 3; 2}). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(:, {1, 3, 3}). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(:, 1:2). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(:, 1:3). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(:, {}). + +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(:, :). + +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(0, :). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(:, 0). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(4, :). +PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(:, 4). + +PRINT {}(:,{}). +PRINT {}({},:). +PRINT {}({},{}). + +PRINT {1, 2, 3, 4}({1, 2; 3, 4}, :). +PRINT {1, 2, 3, 4}(:, {1, 2; 3, 4}). +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +{1, 2, 3; 4, 5, 6; 7, 8, 9}(1, :) + 1 2 3 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}({1}, :) + 1 2 3 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}({1, 2}, :) + 1 2 3 + 4 5 6 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}({1, 2, 3}, :) + 1 2 3 + 4 5 6 + 7 8 9 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}({1; 3; 2}, :) + 1 2 3 + 7 8 9 + 4 5 6 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}({1, 3, 3}, :) + 1 2 3 + 7 8 9 + 7 8 9 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}(1:2, :) + 1 2 3 + 4 5 6 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}(1:3, :) + 1 2 3 + 4 5 6 + 7 8 9 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}({}, :) + +{1, 2, 3; 4, 5, 6; 7, 8, 9}(:, 1) + 1 + 4 + 7 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}(:, {1}) + 1 + 4 + 7 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}(:, {1, 2}) + 1 2 + 4 5 + 7 8 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}(:, {1, 2, 3}) + 1 2 3 + 4 5 6 + 7 8 9 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}(:, {1; 3; 2}) + 1 3 2 + 4 6 5 + 7 9 8 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}(:, {1, 3, 3}) + 1 3 3 + 4 6 6 + 7 9 9 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}(:, 1:2) + 1 2 + 4 5 + 7 8 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}(:, 1:3) + 1 2 3 + 4 5 6 + 7 8 9 + +{1, 2, 3; 4, 5, 6; 7, 8, 9}(:, {}) + + + +{1, 2, 3; 4, 5, 6; 7, 8, 9}(:, :) + 1 2 3 + 4 5 6 + 7 8 9 + +matrix.sps:24.35: error: MATRIX: 0 is not a valid row index for a 3×3 matrix. + 24 | PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(0, :). + | ^ + +matrix.sps:25.38: error: MATRIX: 0 is not a valid column index for a 3×3 +matrix. + 25 | PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(:, 0). + | ^ + +matrix.sps:26.35: error: MATRIX: 4 is not a valid row index for a 3×3 matrix. + 26 | PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(4, :). + | ^ + +matrix.sps:27.38: error: MATRIX: 4 is not a valid column index for a 3×3 +matrix. + 27 | PRINT {1, 2, 3; 4, 5, 6; 7, 8, 9}(:, 4). + | ^ + +{}(:,{}) + +{}({},:) + +{}({},{}) + +matrix.sps:33.20-33.31: error: MATRIX: Matrix row index must be scalar or +vector, not a 2×2 matrix. + 33 | PRINT {1, 2, 3, 4}({1, 2; 3, 4}, :). + | ^~~~~~~~~~~~ + +matrix.sps:34.23-34.34: error: MATRIX: Matrix column index must be scalar or +vector, not a 2×2 matrix. + 34 | PRINT {1, 2, 3, 4}(:, {1, 2; 3, 4}). + | ^~~~~~~~~~~~ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - COMPUTE submatrices as lvalues]) +AT_DATA([matrix.sps], [dnl +MATRIX. +COMPUTE y={1, 2, 3; 4, 5, 6; 7, 8, 9}. + +COMPUTE x1=y. +COMPUTE x1(1, :) = {11, 12, 13}. +PRINT x1. + +COMPUTE x2=y. +COMPUTE x2(2, :) = {14, 15, 16}. +PRINT x2. + +COMPUTE x3=y. +COMPUTE x3(3, :) = {17, 18, 19}. +PRINT x3. + +COMPUTE x4=y. +COMPUTE x4(:, 1) = {11; 14; 17}. +PRINT x4. + +COMPUTE x5=y. +COMPUTE x5(:, 2) = {12; 15; 18}. +PRINT x5. + +COMPUTE x6=y. +COMPUTE x6(:, 3) = {13; 16; 19}. +PRINT x6. + +COMPUTE x7=y. +COMPUTE x7(1, 1) = 11. +PRINT x7. + +COMPUTE x8=y. +COMPUTE x8(1:2, 2:3) = {12, 13; 15, 16}. +PRINT x8. + +COMPUTE x9=y. +COMPUTE x9({3, 1}, {2; 3}) = {18, 19; 12, 13}. +PRINT x9. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +x1 + 11 12 13 + 4 5 6 + 7 8 9 + +x2 + 1 2 3 + 14 15 16 + 7 8 9 + +x3 + 1 2 3 + 4 5 6 + 17 18 19 + +x4 + 11 2 3 + 14 5 6 + 17 8 9 + +x5 + 1 12 3 + 4 15 6 + 7 18 9 + +x6 + 1 2 13 + 4 5 16 + 7 8 19 + +x7 + 11 2 3 + 4 5 6 + 7 8 9 + +x8 + 1 12 13 + 4 15 16 + 7 8 9 + +x9 + 1 12 13 + 4 5 6 + 7 18 19 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - COMPUTE submatrices as lvalues - negative]) +AT_DATA([matrix.sps], [dnl +MATRIX. +COMPUTE x={1, 2, 3; 4, 5, 6; 7, 8, 9}. +COMPUTE x(1, :) = {}. +COMPUTE x(1, :) = 15. +COMPUTE x(1, :) = {11, 12}. +COMPUTE x(1, :) = {11, 12, 13, 14}. +COMPUTE x(:, 1) = {}. +COMPUTE x(:, 1) = 15. +COMPUTE x(:, 1) = {11, 12}. +COMPUTE x(:, 1) = {11, 12, 13, 14}. +COMPUTE x(:) = 1. +COMPUTE x(0, 1) = 1. +COMPUTE x(1, 0) = 1. +COMPUTE x({1, 0, 2}, 1) = {1; 2; 3}. +COMPUTE x(4, 3) = 1. +COMPUTE x(3, 4) = 1. +COMPUTE x({1, 2; 3, 4}, 5) = 1. +COMPUTE x(3, {1, 2; 3, 4}) = 1. +PRINT x. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:3.9-3.15: error: MATRIX: Numbers of indexes for assigning to x +differ from the size of the source matrix. + 3 | COMPUTE x(1, :) = {}. + | ^~~~~~~ + +matrix.sps:3.11: note: MATRIX: There is 1 row index. + 3 | COMPUTE x(1, :) = {}. + | ^ + +matrix.sps:3.14: note: MATRIX: Destination matrix x has 3 columns. + 3 | COMPUTE x(1, :) = {}. + | ^ + +matrix.sps:3.19-3.20: note: MATRIX: The source matrix is 0×0. + 3 | COMPUTE x(1, :) = {}. + | ^~ + +matrix.sps:4.9-4.15: error: MATRIX: Number of column indexes for assigning to x +differs from number of columns in source matrix. + 4 | COMPUTE x(1, :) = 15. + | ^~~~~~~ + +matrix.sps:4.14: note: MATRIX: Destination matrix x has 3 columns. + 4 | COMPUTE x(1, :) = 15. + | ^ + +matrix.sps:4.19-4.20: note: MATRIX: The source matrix is 1×1. + 4 | COMPUTE x(1, :) = 15. + | ^~ + +matrix.sps:5.9-5.15: error: MATRIX: Number of column indexes for assigning to x +differs from number of columns in source matrix. + 5 | COMPUTE x(1, :) = {11, 12}. + | ^~~~~~~ + +matrix.sps:5.14: note: MATRIX: Destination matrix x has 3 columns. + 5 | COMPUTE x(1, :) = {11, 12}. + | ^ + +matrix.sps:5.19-5.26: note: MATRIX: The source matrix is 1×2. + 5 | COMPUTE x(1, :) = {11, 12}. + | ^~~~~~~~ + +matrix.sps:6.9-6.15: error: MATRIX: Number of column indexes for assigning to x +differs from number of columns in source matrix. + 6 | COMPUTE x(1, :) = {11, 12, 13, 14}. + | ^~~~~~~ + +matrix.sps:6.14: note: MATRIX: Destination matrix x has 3 columns. + 6 | COMPUTE x(1, :) = {11, 12, 13, 14}. + | ^ + +matrix.sps:6.19-6.34: note: MATRIX: The source matrix is 1×4. + 6 | COMPUTE x(1, :) = {11, 12, 13, 14}. + | ^~~~~~~~~~~~~~~~ + +matrix.sps:7.9-7.15: error: MATRIX: Numbers of indexes for assigning to x +differ from the size of the source matrix. + 7 | COMPUTE x(:, 1) = {}. + | ^~~~~~~ + +matrix.sps:7.11: note: MATRIX: Destination matrix x has 3 rows. + 7 | COMPUTE x(:, 1) = {}. + | ^ + +matrix.sps:7.14: note: MATRIX: There is 1 column index. + 7 | COMPUTE x(:, 1) = {}. + | ^ + +matrix.sps:7.19-7.20: note: MATRIX: The source matrix is 0×0. + 7 | COMPUTE x(:, 1) = {}. + | ^~ + +matrix.sps:8.9-8.15: error: MATRIX: Number of row indexes for assigning to x +differs from number of rows in source matrix. + 8 | COMPUTE x(:, 1) = 15. + | ^~~~~~~ + +matrix.sps:8.11: note: MATRIX: Destination matrix x has 3 rows. + 8 | COMPUTE x(:, 1) = 15. + | ^ + +matrix.sps:8.19-8.20: note: MATRIX: The source matrix is 1×1. + 8 | COMPUTE x(:, 1) = 15. + | ^~ + +matrix.sps:9.9-9.15: error: MATRIX: Numbers of indexes for assigning to x +differ from the size of the source matrix. + 9 | COMPUTE x(:, 1) = {11, 12}. + | ^~~~~~~ + +matrix.sps:9.11: note: MATRIX: Destination matrix x has 3 rows. + 9 | COMPUTE x(:, 1) = {11, 12}. + | ^ + +matrix.sps:9.14: note: MATRIX: There is 1 column index. + 9 | COMPUTE x(:, 1) = {11, 12}. + | ^ + +matrix.sps:9.19-9.26: note: MATRIX: The source matrix is 1×2. + 9 | COMPUTE x(:, 1) = {11, 12}. + | ^~~~~~~~ + +matrix.sps:10.9-10.15: error: MATRIX: Numbers of indexes for assigning to x +differ from the size of the source matrix. + 10 | COMPUTE x(:, 1) = {11, 12, 13, 14}. + | ^~~~~~~ + +matrix.sps:10.11: note: MATRIX: Destination matrix x has 3 rows. + 10 | COMPUTE x(:, 1) = {11, 12, 13, 14}. + | ^ + +matrix.sps:10.14: note: MATRIX: There is 1 column index. + 10 | COMPUTE x(:, 1) = {11, 12, 13, 14}. + | ^ + +matrix.sps:10.19-10.34: note: MATRIX: The source matrix is 1×4. + 10 | COMPUTE x(:, 1) = {11, 12, 13, 14}. + | ^~~~~~~~~~~~~~~~ + +matrix.sps:11.9-11.12: error: MATRIX: Can't use vector indexing on 3×3 matrix +x. + 11 | COMPUTE x(:) = 1. + | ^~~~ + +matrix.sps:12.11: error: MATRIX: 0 is not a valid row index for a 3×3 matrix. + 12 | COMPUTE x(0, 1) = 1. + | ^ + +matrix.sps:13.14: error: MATRIX: 0 is not a valid column index for a 3×3 +matrix. + 13 | COMPUTE x(1, 0) = 1. + | ^ + +matrix.sps:14.11-14.19: error: MATRIX: 0 is not a valid row index for a 3×3 +matrix. + 14 | COMPUTE x({1, 0, 2}, 1) = {1; 2; 3}. + | ^~~~~~~~~ + +matrix.sps:15.11: error: MATRIX: 4 is not a valid row index for a 3×3 matrix. + 15 | COMPUTE x(4, 3) = 1. + | ^ + +matrix.sps:16.14: error: MATRIX: 4 is not a valid column index for a 3×3 +matrix. + 16 | COMPUTE x(3, 4) = 1. + | ^ + +matrix.sps:17.11-17.22: error: MATRIX: Matrix row index must be scalar or +vector, not a 2×2 matrix. + 17 | COMPUTE x({1, 2; 3, 4}, 5) = 1. + | ^~~~~~~~~~~~ + +matrix.sps:18.14-18.25: error: MATRIX: Matrix column index must be scalar or +vector, not a 2×2 matrix. + 18 | COMPUTE x(3, {1, 2; 3, 4}) = 1. + | ^~~~~~~~~~~~ + +x + 1 2 3 + 4 5 6 + 7 8 9 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - subvectors as rvalues]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT {10, 20, 30}({}). +PRINT {10, 20, 30}(2). +PRINT {10, 20, 30}({2}). +PRINT {10, 20, 30}({1,3}). +PRINT {10, 20, 30}({2,3}). +PRINT {10, 20, 30}({1;3}). +PRINT {10, 20, 30}({2;3}). +PRINT {10, 20, 30}(2:3). +PRINT {10, 20, 30}(:). + +PRINT {10; 20; 30}({}). +PRINT {10; 20; 30}(2). +PRINT {10; 20; 30}({2}). +PRINT {10; 20; 30}({1,3}). +PRINT {10; 20; 30}({2,3}). +PRINT {10; 20; 30}({1;3}). +PRINT {10; 20; 30}({2;3}). +PRINT {10; 20; 30}(2:3). +PRINT {10; 20; 30}(:). + +PRINT {}({}). + +PRINT {1, 2; 3, 4}(:). +PRINT {1, 2, 3, 4}({1, 2; 3, 4}). +PRINT {1, 2, 3, 4}(0). +PRINT {1, 2, 3, 4}(5). +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +{10, 20, 30}({}) + +{10, 20, 30}(2) + 20 + +{10, 20, 30}({2}) + 20 + +{10, 20, 30}({1,3}) + 10 30 + +{10, 20, 30}({2,3}) + 20 30 + +{10, 20, 30}({1;3}) + 10 30 + +{10, 20, 30}({2;3}) + 20 30 + +{10, 20, 30}(2:3) + 20 30 + +{10, 20, 30}(:) + 10 20 30 + +{10; 20; 30}({}) + +{10; 20; 30}(2) + 20 + +{10; 20; 30}({2}) + 20 + +{10; 20; 30}({1,3}) + 10 + 30 + +{10; 20; 30}({2,3}) + 20 + 30 + +{10; 20; 30}({1;3}) + 10 + 30 + +{10; 20; 30}({2;3}) + 20 + 30 + +{10; 20; 30}(2:3) + 20 + 30 + +{10; 20; 30}(:) + 10 + 20 + 30 + +{}({}) + +matrix.sps:24.7-24.18: error: MATRIX: Vector index operator may not be applied +to a 2×2 matrix. + 24 | PRINT {1, 2; 3, 4}(:). + | ^~~~~~~~~~~~ + +matrix.sps:25.20-25.31: error: MATRIX: Vector index must be scalar or vector, +not a 2×2 matrix. + 25 | PRINT {1, 2, 3, 4}({1, 2; 3, 4}). + | ^~~~~~~~~~~~ + +matrix.sps:26.20: error: MATRIX: Index 0 is out of range for vector with 4 +elements. + 26 | PRINT {1, 2, 3, 4}(0). + | ^ + +matrix.sps:27.20: error: MATRIX: Index 5 is out of range for vector with 4 +elements. + 27 | PRINT {1, 2, 3, 4}(5). + | ^ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - COMPUTE subvectors as lvalues]) +AT_DATA([matrix.sps], [dnl +MATRIX. +COMPUTE r={1, 2, 3, 4, 5, 6, 7, 8, 9}. + +COMPUTE r1=r. +COMPUTE r1(:) = {11, 12, 13, 14, 15, 16, 17, 18, 19}. +PRINT r1. + +COMPUTE r2=r. +COMPUTE r2(:) = {11; 12; 13; 14; 15; 16; 17; 18; 19}. +PRINT r2. + +COMPUTE r3=r. +COMPUTE r3(1) = 11. +PRINT r3. + +COMPUTE r4=r. +COMPUTE r4(1:2) = {11:12}. +PRINT r4. + +COMPUTE r5=r. +COMPUTE r5({8;9}) = {18:19}. +PRINT r5. + +COMPUTE c={1, 2, 3, 4, 5, 6, 7, 8, 9}. + +COMPUTE c1=c. +COMPUTE c1(:) = {11, 12, 13, 14, 15, 16, 17, 18, 19}. +PRINT c1. + +COMPUTE c2=c. +COMPUTE c2(:) = {11; 12; 13; 14; 15; 16; 17; 18; 19}. +PRINT c2. + +COMPUTE c3=c. +COMPUTE c3(1) = 11. +PRINT c3. + +COMPUTE c4=c. +COMPUTE c4(1:2) = {11:12}. +PRINT c4. + +COMPUTE c5=c. +COMPUTE c5(8:9) = {18:19}. +PRINT c5. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +r1 + 11 12 13 14 15 16 17 18 19 + +r2 + 11 12 13 14 15 16 17 18 19 + +r3 + 11 2 3 4 5 6 7 8 9 + +r4 + 11 12 3 4 5 6 7 8 9 + +r5 + 1 2 3 4 5 6 7 18 19 + +c1 + 11 12 13 14 15 16 17 18 19 + +c2 + 11 12 13 14 15 16 17 18 19 + +c3 + 11 2 3 4 5 6 7 8 9 + +c4 + 11 12 3 4 5 6 7 8 9 + +c5 + 1 2 3 4 5 6 7 18 19 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - COMPUTE subvectors as lvalues - negative]) +AT_DATA([matrix.sps], [dnl +MATRIX. +COMPUTE r={1, 2, 3, 4, 5, 6, 7, 8, 9}. +COMPUTE r(1:3) = {1, 2; 3, 4}. +COMPUTE r(1:3) = {}. +COMPUTE r(1:3) = {1}. +COMPUTE r(1:3) = {1, 2}. +COMPUTE r(1:3) = {1, 2, 3, 4}. +COMPUTE r(1:3) = {}. +COMPUTE r(1:3) = {1}. +COMPUTE r(1:3) = {1; 2}. +COMPUTE r(1:3) = {1; 2; 3; 4}. +COMPUTE r(:) = {1; 2; 3; 4}. +COMPUTE r(0) = 5. +COMPUTE r(10) = 5. +COMPUTE r({1, 2; 3, 4}) = 1. + +COMPUTE c={1, 2, 3, 4, 5, 6, 7, 8, 9}. +COMPUTE c(1:3) = {1, 2; 3, 4}. +COMPUTE c(1:3) = {}. +COMPUTE c(1:3) = {1}. +COMPUTE c(1:3) = {1, 2}. +COMPUTE c(1:3) = {1, 2, 3, 4}. +COMPUTE c(1:3) = {}. +COMPUTE c(1:3) = {1}. +COMPUTE c(1:3) = {1; 2}. +COMPUTE c(1:3) = {1; 2; 3; 4}. +COMPUTE c(:) = {1; 2; 3; 4}. +COMPUTE c(0) = 5. +COMPUTE c(10) = 5. +COMPUTE c({1, 2; 3, 4}) = 1. + +COMPUTE m = {1, 2; 3, 4}. +COMPUTE m(5) = 1. +COMPUTE m(:) = 1. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:3.9-3.14: error: MATRIX: Only an 3-element vector may be assigned to +this 3-element subvector of r. + 3 | COMPUTE r(1:3) = {1, 2; 3, 4}. + | ^~~~~~ + +matrix.sps:3.18-3.29: error: MATRIX: The source is an 2×2 matrix. + 3 | COMPUTE r(1:3) = {1, 2; 3, 4}. + | ^~~~~~~~~~~~ + +matrix.sps:4.9-4.14: error: MATRIX: Only an 3-element vector may be assigned to +this 3-element subvector of r. + 4 | COMPUTE r(1:3) = {}. + | ^~~~~~ + +matrix.sps:4.18-4.19: error: MATRIX: The source vector has 0 elements. + 4 | COMPUTE r(1:3) = {}. + | ^~ + +matrix.sps:5.9-5.14: error: MATRIX: Only an 3-element vector may be assigned to +this 3-element subvector of r. + 5 | COMPUTE r(1:3) = {1}. + | ^~~~~~ + +matrix.sps:5.19: error: MATRIX: The source vector has 1 element. + 5 | COMPUTE r(1:3) = {1}. + | ^ + +matrix.sps:6.9-6.14: error: MATRIX: Only an 3-element vector may be assigned to +this 3-element subvector of r. + 6 | COMPUTE r(1:3) = {1, 2}. + | ^~~~~~ + +matrix.sps:6.18-6.23: error: MATRIX: The source vector has 2 elements. + 6 | COMPUTE r(1:3) = {1, 2}. + | ^~~~~~ + +matrix.sps:7.9-7.14: error: MATRIX: Only an 3-element vector may be assigned to +this 3-element subvector of r. + 7 | COMPUTE r(1:3) = {1, 2, 3, 4}. + | ^~~~~~ + +matrix.sps:7.18-7.29: error: MATRIX: The source vector has 4 elements. + 7 | COMPUTE r(1:3) = {1, 2, 3, 4}. + | ^~~~~~~~~~~~ + +matrix.sps:8.9-8.14: error: MATRIX: Only an 3-element vector may be assigned to +this 3-element subvector of r. + 8 | COMPUTE r(1:3) = {}. + | ^~~~~~ + +matrix.sps:8.18-8.19: error: MATRIX: The source vector has 0 elements. + 8 | COMPUTE r(1:3) = {}. + | ^~ + +matrix.sps:9.9-9.14: error: MATRIX: Only an 3-element vector may be assigned to +this 3-element subvector of r. + 9 | COMPUTE r(1:3) = {1}. + | ^~~~~~ + +matrix.sps:9.19: error: MATRIX: The source vector has 1 element. + 9 | COMPUTE r(1:3) = {1}. + | ^ + +matrix.sps:10.9-10.14: error: MATRIX: Only an 3-element vector may be assigned +to this 3-element subvector of r. + 10 | COMPUTE r(1:3) = {1; 2}. + | ^~~~~~ + +matrix.sps:10.18-10.23: error: MATRIX: The source vector has 2 elements. + 10 | COMPUTE r(1:3) = {1; 2}. + | ^~~~~~ + +matrix.sps:11.9-11.14: error: MATRIX: Only an 3-element vector may be assigned +to this 3-element subvector of r. + 11 | COMPUTE r(1:3) = {1; 2; 3; 4}. + | ^~~~~~ + +matrix.sps:11.18-11.29: error: MATRIX: The source vector has 4 elements. + 11 | COMPUTE r(1:3) = {1; 2; 3; 4}. + | ^~~~~~~~~~~~ + +matrix.sps:12.9-12.12: error: MATRIX: Only an 9-element vector may be assigned +to this 9-element subvector of r. + 12 | COMPUTE r(:) = {1; 2; 3; 4}. + | ^~~~ + +matrix.sps:12.16-12.27: error: MATRIX: The source vector has 4 elements. + 12 | COMPUTE r(:) = {1; 2; 3; 4}. + | ^~~~~~~~~~~~ + +matrix.sps:13.11: error: MATRIX: Index 0 is out of range for vector with 9 +elements. + 13 | COMPUTE r(0) = 5. + | ^ + +matrix.sps:14.11-14.12: error: MATRIX: Index 10 is out of range for vector with +9 elements. + 14 | COMPUTE r(10) = 5. + | ^~ + +matrix.sps:15.11-15.22: error: MATRIX: Vector index must be scalar or vector, +not a 2×2 matrix. + 15 | COMPUTE r({1, 2; 3, 4}) = 1. + | ^~~~~~~~~~~~ + +matrix.sps:18.9-18.14: error: MATRIX: Only an 3-element vector may be assigned +to this 3-element subvector of c. + 18 | COMPUTE c(1:3) = {1, 2; 3, 4}. + | ^~~~~~ + +matrix.sps:18.18-18.29: error: MATRIX: The source is an 2×2 matrix. + 18 | COMPUTE c(1:3) = {1, 2; 3, 4}. + | ^~~~~~~~~~~~ + +matrix.sps:19.9-19.14: error: MATRIX: Only an 3-element vector may be assigned +to this 3-element subvector of c. + 19 | COMPUTE c(1:3) = {}. + | ^~~~~~ + +matrix.sps:19.18-19.19: error: MATRIX: The source vector has 0 elements. + 19 | COMPUTE c(1:3) = {}. + | ^~ + +matrix.sps:20.9-20.14: error: MATRIX: Only an 3-element vector may be assigned +to this 3-element subvector of c. + 20 | COMPUTE c(1:3) = {1}. + | ^~~~~~ + +matrix.sps:20.19: error: MATRIX: The source vector has 1 element. + 20 | COMPUTE c(1:3) = {1}. + | ^ + +matrix.sps:21.9-21.14: error: MATRIX: Only an 3-element vector may be assigned +to this 3-element subvector of c. + 21 | COMPUTE c(1:3) = {1, 2}. + | ^~~~~~ + +matrix.sps:21.18-21.23: error: MATRIX: The source vector has 2 elements. + 21 | COMPUTE c(1:3) = {1, 2}. + | ^~~~~~ + +matrix.sps:22.9-22.14: error: MATRIX: Only an 3-element vector may be assigned +to this 3-element subvector of c. + 22 | COMPUTE c(1:3) = {1, 2, 3, 4}. + | ^~~~~~ + +matrix.sps:22.18-22.29: error: MATRIX: The source vector has 4 elements. + 22 | COMPUTE c(1:3) = {1, 2, 3, 4}. + | ^~~~~~~~~~~~ + +matrix.sps:23.9-23.14: error: MATRIX: Only an 3-element vector may be assigned +to this 3-element subvector of c. + 23 | COMPUTE c(1:3) = {}. + | ^~~~~~ + +matrix.sps:23.18-23.19: error: MATRIX: The source vector has 0 elements. + 23 | COMPUTE c(1:3) = {}. + | ^~ + +matrix.sps:24.9-24.14: error: MATRIX: Only an 3-element vector may be assigned +to this 3-element subvector of c. + 24 | COMPUTE c(1:3) = {1}. + | ^~~~~~ + +matrix.sps:24.19: error: MATRIX: The source vector has 1 element. + 24 | COMPUTE c(1:3) = {1}. + | ^ + +matrix.sps:25.9-25.14: error: MATRIX: Only an 3-element vector may be assigned +to this 3-element subvector of c. + 25 | COMPUTE c(1:3) = {1; 2}. + | ^~~~~~ + +matrix.sps:25.18-25.23: error: MATRIX: The source vector has 2 elements. + 25 | COMPUTE c(1:3) = {1; 2}. + | ^~~~~~ + +matrix.sps:26.9-26.14: error: MATRIX: Only an 3-element vector may be assigned +to this 3-element subvector of c. + 26 | COMPUTE c(1:3) = {1; 2; 3; 4}. + | ^~~~~~ + +matrix.sps:26.18-26.29: error: MATRIX: The source vector has 4 elements. + 26 | COMPUTE c(1:3) = {1; 2; 3; 4}. + | ^~~~~~~~~~~~ + +matrix.sps:27.9-27.12: error: MATRIX: Only an 9-element vector may be assigned +to this 9-element subvector of c. + 27 | COMPUTE c(:) = {1; 2; 3; 4}. + | ^~~~ + +matrix.sps:27.16-27.27: error: MATRIX: The source vector has 4 elements. + 27 | COMPUTE c(:) = {1; 2; 3; 4}. + | ^~~~~~~~~~~~ + +matrix.sps:28.11: error: MATRIX: Index 0 is out of range for vector with 9 +elements. + 28 | COMPUTE c(0) = 5. + | ^ + +matrix.sps:29.11-29.12: error: MATRIX: Index 10 is out of range for vector with +9 elements. + 29 | COMPUTE c(10) = 5. + | ^~ + +matrix.sps:30.11-30.22: error: MATRIX: Vector index must be scalar or vector, +not a 2×2 matrix. + 30 | COMPUTE c({1, 2; 3, 4}) = 1. + | ^~~~~~~~~~~~ + +matrix.sps:33.9-33.12: error: MATRIX: Can't use vector indexing on 2×2 matrix +m. + 33 | COMPUTE m(5) = 1. + | ^~~~ + +matrix.sps:34.9-34.12: error: MATRIX: Can't use vector indexing on 2×2 matrix +m. + 34 | COMPUTE m(:) = 1. + | ^~~~ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - COMPUTE - negative]) +AT_DATA([matrix.sps], [dnl +MATRIX. +COMPUTE x. +COMPUTE x=. +COMPUTE x(5)=1. +COMPUTE y(5)=1. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:2.10: error: COMPUTE: Syntax error at end of command: expecting `='. + +matrix.sps:3.11: error: COMPUTE: Syntax error at end of command. + +matrix.sps:4.9: error: MATRIX: Undefined variable x. + 4 | COMPUTE x(5)=1. + | ^ + +matrix.sps:5: error: COMPUTE: Undefined variable y. +]) +AT_CLEANUP + +AT_SETUP([MATRIX - elementwise arithmetic operators]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT (-(5)). +PRINT (-{1,2;3,4}). + +PRINT ({1,2;3,4} + {5,6;7,8}). +PRINT ({1,2;3,4} + 5). +PRINT (5 + {5,6;7,8}). +PRINT ({1,2;3,4} + {5,6}). + +PRINT ({1,2;3,4} - {5,6;7,8}). +PRINT ({1,2;3,4} - 5). +PRINT (5 - {5,6;7,8}). +PRINT ({1,2;3,4} - {5,6}). + +PRINT ({1,2;3,4} * 5). +PRINT (5 * {5,6;7,8}). + +PRINT ({2,4;6,8} / 2). +PRINT (12 / {1,2;3,4}). +PRINT ({2,8;18,32} / {1,2;3,4}). + +PRINT ({1,2;3,4} &* {5,6;7,8}). +PRINT ({1,2;3,4} &* 5). +PRINT (5 &* {5,6;7,8}). +PRINT ({1,2;3,4} &* {5,6}). + +PRINT ({2,4;6,8} &/ 2). +PRINT (12 &/ {1,2;3,4}). +PRINT ({2,8;18,32} &/ {1,2;3,4}). + +PRINT ({1,2;3,4} &** 2). +PRINT (2 &** {1,2;3,4}). +PRINT ({1,2;3,4} &** {2,3;4,5}). +PRINT ({1,2;3,4} &** {5,6}). +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +(-(5)) + -5 + +(-{1,2;3,4}) + -1 -2 + -3 -4 + +({1,2;3,4} + {5,6;7,8}) + 6 8 + 10 12 + +({1,2;3,4} + 5) + 6 7 + 8 9 + +(5 + {5,6;7,8}) + 10 11 + 12 13 + +matrix.sps:8.8-8.24: error: MATRIX: The operands of + must have the same +dimensions or one must be a scalar. + 8 | PRINT ({1,2;3,4} + {5,6}). + | ^~~~~~~~~~~~~~~~~ + +matrix.sps:8.8-8.16: note: MATRIX: The left-hand operand is a 2×2 matrix. + 8 | PRINT ({1,2;3,4} + {5,6}). + | ^~~~~~~~~ + +matrix.sps:8.20-8.24: note: MATRIX: The right-hand operand is a 1×2 matrix. + 8 | PRINT ({1,2;3,4} + {5,6}). + | ^~~~~ + +({1,2;3,4} - {5,6;7,8}) + -4 -4 + -4 -4 + +({1,2;3,4} - 5) + -4 -3 + -2 -1 + +(5 - {5,6;7,8}) + 0 -1 + -2 -3 + +matrix.sps:13.8-13.24: error: MATRIX: The operands of - must have the same +dimensions or one must be a scalar. + 13 | PRINT ({1,2;3,4} - {5,6}). + | ^~~~~~~~~~~~~~~~~ + +matrix.sps:13.8-13.16: note: MATRIX: The left-hand operand is a 2×2 matrix. + 13 | PRINT ({1,2;3,4} - {5,6}). + | ^~~~~~~~~ + +matrix.sps:13.20-13.24: note: MATRIX: The right-hand operand is a 1×2 matrix. + 13 | PRINT ({1,2;3,4} - {5,6}). + | ^~~~~ + +({1,2;3,4} * 5) + 5 10 + 15 20 + +(5 * {5,6;7,8}) + 25 30 + 35 40 + +({2,4;6,8} / 2) + 1 2 + 3 4 + +(12 / {1,2;3,4}) + 12 6 + 4 3 + +({2,8;18,32} / {1,2;3,4}) + 2 4 + 6 8 + +({1,2;3,4} &* {5,6;7,8}) + 5 12 + 21 32 + +({1,2;3,4} &* 5) + 5 10 + 15 20 + +(5 &* {5,6;7,8}) + 25 30 + 35 40 + +matrix.sps:25.8-25.25: error: MATRIX: The operands of &* must have the same +dimensions or one must be a scalar. + 25 | PRINT ({1,2;3,4} &* {5,6}). + | ^~~~~~~~~~~~~~~~~~ + +matrix.sps:25.8-25.16: note: MATRIX: The left-hand operand is a 2×2 matrix. + 25 | PRINT ({1,2;3,4} &* {5,6}). + | ^~~~~~~~~ + +matrix.sps:25.21-25.25: note: MATRIX: The right-hand operand is a 1×2 matrix. + 25 | PRINT ({1,2;3,4} &* {5,6}). + | ^~~~~ + +({2,4;6,8} &/ 2) + 1 2 + 3 4 + +(12 &/ {1,2;3,4}) + 12 6 + 4 3 + +({2,8;18,32} &/ {1,2;3,4}) + 2 4 + 6 8 + +({1,2;3,4} &** 2) + 1 4 + 9 16 + +(2 &** {1,2;3,4}) + 2 4 + 8 16 + +({1,2;3,4} &** {2,3;4,5}) + 1 8 + 81 1024 + +matrix.sps:34.8-34.26: error: MATRIX: The operands of &** must have the same +dimensions or one must be a scalar. + 34 | PRINT ({1,2;3,4} &** {5,6}). + | ^~~~~~~~~~~~~~~~~~~ + +matrix.sps:34.8-34.16: note: MATRIX: The left-hand operand is a 2×2 matrix. + 34 | PRINT ({1,2;3,4} &** {5,6}). + | ^~~~~~~~~ + +matrix.sps:34.22-34.26: note: MATRIX: The right-hand operand is a 1×2 matrix. + 34 | PRINT ({1,2;3,4} &** {5,6}). + | ^~~~~ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - relational operators]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT ({1, 1; 2, 2} > {1, 2; 1, 2}). +PRINT ({1, 1; 2, 2} > 1). +PRINT (2 > {1, 2; 1, 2}). +PRINT ({1, 2} > {1; 2}). + +PRINT ({1, 1; 2, 2} < {1, 2; 1, 2}). +PRINT ({1, 1; 2, 2} < 2). +PRINT (1 < {1, 2; 1, 2}). +PRINT ({1, 2} < {1; 2}). + +PRINT ({1, 1; 2, 2} <> {1, 2; 1, 2}). +PRINT ({1, 1; 2, 2} <> 2). +PRINT (1 <> {1, 2; 1, 2}). +PRINT ({1, 2} <> {1; 2}). + +PRINT ({1, 1; 2, 2} >= {1, 2; 1, 2}). +PRINT ({1, 1; 2, 2} >= 2). +PRINT (1 >= {1, 2; 1, 2}). +PRINT ({1, 2} >= {1; 2}). + +PRINT ({1, 1; 2, 2} <= {1, 2; 1, 2}). +PRINT ({1, 1; 2, 2} <= 2). +PRINT (1 <= {1, 2; 1, 2}). +PRINT ({1, 2} <= {1; 2}). + +PRINT ({1, 1; 2, 2} = {1, 2; 1, 2}). +PRINT ({1, 1; 2, 2} = 2). +PRINT (1 = {1, 2; 1, 2}). +PRINT ({1, 2} = {1; 2}). +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +({1, 1; 2, 2} > {1, 2; 1, 2}) + 0 0 + 1 0 + +({1, 1; 2, 2} > 1) + 0 0 + 1 1 + +(2 > {1, 2; 1, 2}) + 1 0 + 1 0 + +matrix.sps:5.8-5.22: error: MATRIX: The operands of > must have the same +dimensions or one must be a scalar. + 5 | PRINT ({1, 2} > {1; 2}). + | ^~~~~~~~~~~~~~~ + +matrix.sps:5.8-5.13: note: MATRIX: The left-hand operand is a 1×2 matrix. + 5 | PRINT ({1, 2} > {1; 2}). + | ^~~~~~ + +matrix.sps:5.17-5.22: note: MATRIX: The right-hand operand is a 2×1 matrix. + 5 | PRINT ({1, 2} > {1; 2}). + | ^~~~~~ + +({1, 1; 2, 2} < {1, 2; 1, 2}) + 0 1 + 0 0 + +({1, 1; 2, 2} < 2) + 1 1 + 0 0 + +(1 < {1, 2; 1, 2}) + 0 1 + 0 1 + +matrix.sps:10.8-10.22: error: MATRIX: The operands of < must have the same +dimensions or one must be a scalar. + 10 | PRINT ({1, 2} < {1; 2}). + | ^~~~~~~~~~~~~~~ + +matrix.sps:10.8-10.13: note: MATRIX: The left-hand operand is a 1×2 matrix. + 10 | PRINT ({1, 2} < {1; 2}). + | ^~~~~~ + +matrix.sps:10.17-10.22: note: MATRIX: The right-hand operand is a 2×1 matrix. + 10 | PRINT ({1, 2} < {1; 2}). + | ^~~~~~ + +({1, 1; 2, 2} <> {1, 2; 1, 2}) + 0 1 + 1 0 + +({1, 1; 2, 2} <> 2) + 1 1 + 0 0 + +(1 <> {1, 2; 1, 2}) + 0 1 + 0 1 + +matrix.sps:15.8-15.23: error: MATRIX: The operands of <> must have the same +dimensions or one must be a scalar. + 15 | PRINT ({1, 2} <> {1; 2}). + | ^~~~~~~~~~~~~~~~ + +matrix.sps:15.8-15.13: note: MATRIX: The left-hand operand is a 1×2 matrix. + 15 | PRINT ({1, 2} <> {1; 2}). + | ^~~~~~ + +matrix.sps:15.18-15.23: note: MATRIX: The right-hand operand is a 2×1 matrix. + 15 | PRINT ({1, 2} <> {1; 2}). + | ^~~~~~ + +({1, 1; 2, 2} >= {1, 2; 1, 2}) + 1 0 + 1 1 + +({1, 1; 2, 2} >= 2) + 0 0 + 1 1 + +(1 >= {1, 2; 1, 2}) + 1 0 + 1 0 + +matrix.sps:20.8-20.23: error: MATRIX: The operands of >= must have the same +dimensions or one must be a scalar. + 20 | PRINT ({1, 2} >= {1; 2}). + | ^~~~~~~~~~~~~~~~ + +matrix.sps:20.8-20.13: note: MATRIX: The left-hand operand is a 1×2 matrix. + 20 | PRINT ({1, 2} >= {1; 2}). + | ^~~~~~ + +matrix.sps:20.18-20.23: note: MATRIX: The right-hand operand is a 2×1 matrix. + 20 | PRINT ({1, 2} >= {1; 2}). + | ^~~~~~ + +({1, 1; 2, 2} <= {1, 2; 1, 2}) + 1 1 + 0 1 + +({1, 1; 2, 2} <= 2) + 1 1 + 1 1 + +(1 <= {1, 2; 1, 2}) + 1 1 + 1 1 + +matrix.sps:25.8-25.23: error: MATRIX: The operands of <= must have the same +dimensions or one must be a scalar. + 25 | PRINT ({1, 2} <= {1; 2}). + | ^~~~~~~~~~~~~~~~ + +matrix.sps:25.8-25.13: note: MATRIX: The left-hand operand is a 1×2 matrix. + 25 | PRINT ({1, 2} <= {1; 2}). + | ^~~~~~ + +matrix.sps:25.18-25.23: note: MATRIX: The right-hand operand is a 2×1 matrix. + 25 | PRINT ({1, 2} <= {1; 2}). + | ^~~~~~ + +({1, 1; 2, 2} = {1, 2; 1, 2}) + 1 0 + 0 1 + +({1, 1; 2, 2} = 2) + 0 0 + 1 1 + +(1 = {1, 2; 1, 2}) + 1 0 + 1 0 + +matrix.sps:30.8-30.22: error: MATRIX: The operands of = must have the same +dimensions or one must be a scalar. + 30 | PRINT ({1, 2} = {1; 2}). + | ^~~~~~~~~~~~~~~ + +matrix.sps:30.8-30.13: note: MATRIX: The left-hand operand is a 1×2 matrix. + 30 | PRINT ({1, 2} = {1; 2}). + | ^~~~~~ + +matrix.sps:30.17-30.22: note: MATRIX: The right-hand operand is a 2×1 matrix. + 30 | PRINT ({1, 2} = {1; 2}). + | ^~~~~~ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - logical operators]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT (NOT {-1, 0, 1}). + +PRINT ({-1, 0, 1; -1, 0, 1; -1, 0, 1} AND {-1, -1, -1; 0, 0, 0; 1, 1, 1}). +PRINT ({-1, 0, 1} AND -1). +PRINT ({-1, 0, 1} AND 0). +PRINT ({-1, 0, 1} AND 1). +PRINT ({-1, 0} AND {2; 3}). + +PRINT ({-1, 0, 1; -1, 0, 1; -1, 0, 1} OR {-1, -1, -1; 0, 0, 0; 1, 1, 1}). +PRINT ({-1, 0, 1} OR -1). +PRINT ({-1, 0, 1} OR 0). +PRINT ({-1, 0, 1} OR 1). +PRINT ({-1, 0} OR {2; 3}). + +PRINT ({-1, 0, 1; -1, 0, 1; -1, 0, 1} XOR {-1, -1, -1; 0, 0, 0; 1, 1, 1}). +PRINT ({-1, 0, 1} XOR -1). +PRINT ({-1, 0, 1} XOR 0). +PRINT ({-1, 0, 1} XOR 1). +PRINT ({-1, 0} XOR {2; 3}). +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +(NOT {-1, 0, 1}) + 1 1 0 + +({-1, 0, 1; -1, 0, 1; -1, 0, 1} AND {-1, -1, -1; 0, 0, 0; 1, 1, 1}) + 0 0 0 + 0 0 0 + 0 0 1 + +({-1, 0, 1} AND -1) + 0 0 0 + +({-1, 0, 1} AND 0) + 0 0 0 + +({-1, 0, 1} AND 1) + 0 0 1 + +matrix.sps:8.8-8.25: error: MATRIX: The operands of AND must have the same +dimensions or one must be a scalar. + 8 | PRINT ({-1, 0} AND {2; 3}). + | ^~~~~~~~~~~~~~~~~~ + +matrix.sps:8.8-8.14: note: MATRIX: The left-hand operand is a 1×2 matrix. + 8 | PRINT ({-1, 0} AND {2; 3}). + | ^~~~~~~ + +matrix.sps:8.20-8.25: note: MATRIX: The right-hand operand is a 2×1 matrix. + 8 | PRINT ({-1, 0} AND {2; 3}). + | ^~~~~~ + +({-1, 0, 1; -1, 0, 1; -1, 0, 1} OR {-1, -1, -1; 0, 0, 0; 1, 1, 1}) + 0 0 1 + 0 0 1 + 1 1 1 + +({-1, 0, 1} OR -1) + 0 0 1 + +({-1, 0, 1} OR 0) + 0 0 1 + +({-1, 0, 1} OR 1) + 1 1 1 + +matrix.sps:14.8-14.24: error: MATRIX: The operands of OR must have the same +dimensions or one must be a scalar. + 14 | PRINT ({-1, 0} OR {2; 3}). + | ^~~~~~~~~~~~~~~~~ + +matrix.sps:14.8-14.14: note: MATRIX: The left-hand operand is a 1×2 matrix. + 14 | PRINT ({-1, 0} OR {2; 3}). + | ^~~~~~~ + +matrix.sps:14.19-14.24: note: MATRIX: The right-hand operand is a 2×1 matrix. + 14 | PRINT ({-1, 0} OR {2; 3}). + | ^~~~~~ + +({-1, 0, 1; -1, 0, 1; -1, 0, 1} XOR {-1, -1, -1; 0, 0, 0; 1, 1, 1}) + 0 0 1 + 0 0 1 + 1 1 0 + +({-1, 0, 1} XOR -1) + 0 0 1 + +({-1, 0, 1} XOR 0) + 0 0 1 + +({-1, 0, 1} XOR 1) + 1 1 0 + +matrix.sps:20.8-20.25: error: MATRIX: The operands of XOR must have the same +dimensions or one must be a scalar. + 20 | PRINT ({-1, 0} XOR {2; 3}). + | ^~~~~~~~~~~~~~~~~~ + +matrix.sps:20.8-20.14: note: MATRIX: The left-hand operand is a 1×2 matrix. + 20 | PRINT ({-1, 0} XOR {2; 3}). + | ^~~~~~~ + +matrix.sps:20.20-20.25: note: MATRIX: The right-hand operand is a 2×1 matrix. + 20 | PRINT ({-1, 0} XOR {2; 3}). + | ^~~~~~ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - matrix operators]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT ({0, 1; 0, 0} * {0, 0; 1, 0}). +PRINT ({0, 0; 1, 0} * {0, 1; 0, 0}). +PRINT ({1, 2, 3; 4, 5, 6} * {7, 8; 9, 10; 11, 12}). +PRINT ({3, 4, 2} * {13, 9, 7, 15; 8, 7, 4, 6; 6, 4, 0, 3}). +COMPUTE m = {0, 1, 0, 0; 1, 0, 1, 0; 0, 1, 0, 1; 0, 0, 1, 0}. +PRINT m**-2. +PRINT m**-1. +PRINT m**0. +PRINT m**1. +PRINT m**2. +PRINT m**3. +PRINT m**5. +PRINT {3, 3.5; 3.2, 3.6}**-1/FORMAT F6.2. + +PRINT ({1, 2, 3} * {1, 2}). +PRINT {1, 2, 3}**2. +PRINT m**{1, 2}. +PRINT m**1.5. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +({0, 1; 0, 0} * {0, 0; 1, 0}) + 1 0 + 0 0 + +({0, 0; 1, 0} * {0, 1; 0, 0}) + 0 0 + 0 1 + +({1, 2, 3; 4, 5, 6} * {7, 8; 9, 10; 11, 12}) + 58 64 + 139 154 + +({3, 4, 2} * {13, 9, 7, 15; 8, 7, 4, 6; 6, 4, 0, 3}) + 83 63 37 75 + +m**-2 + 2 0 -1 0 + 0 1 0 -1 + -1 0 1 0 + 0 -1 0 2 + +m**-1 + 0 1 0 -1 + 1 0 0 0 + 0 0 0 1 + -1 0 1 0 + +m**0 + 1 0 0 0 + 0 1 0 0 + 0 0 1 0 + 0 0 0 1 + +m**1 + 0 1 0 0 + 1 0 1 0 + 0 1 0 1 + 0 0 1 0 + +m**2 + 1 0 1 0 + 0 2 0 1 + 1 0 2 0 + 0 1 0 1 + +m**3 + 0 2 0 1 + 2 0 3 0 + 0 3 0 2 + 1 0 2 0 + +m**5 + 0 5 0 3 + 5 0 8 0 + 0 8 0 5 + 3 0 5 0 + +{3, 3.5; 3.2, 3.6}**-1 + -9.00 8.75 + 8.00 -7.50 + +matrix.sps:16.8-16.25: error: MATRIX: Matrices not conformable for +multiplication. + 16 | PRINT ({1, 2, 3} * {1, 2}). + | ^~~~~~~~~~~~~~~~~~ + +matrix.sps:16.8-16.16: note: MATRIX: The left-hand operand is a 1×3 matrix. + 16 | PRINT ({1, 2, 3} * {1, 2}). + | ^~~~~~~~~ + +matrix.sps:16.20-16.25: note: MATRIX: The right-hand operand is a 1×2 matrix. + 16 | PRINT ({1, 2, 3} * {1, 2}). + | ^~~~~~ + +matrix.sps:17.7-17.15: error: MATRIX: Matrix exponentation with ** requires a +square matrix on the left-hand size, not one with dimensions 1×3. + 17 | PRINT {1, 2, 3}**2. + | ^~~~~~~~~ + +matrix.sps:18.10-18.15: error: MATRIX: Matrix exponentiation with ** requires a +scalar on the right-hand side, not a matrix with dimensions 1×2. + 18 | PRINT m**{1, 2}. + | ^~~~~~ + +matrix.sps:19.10-19.12: error: MATRIX: Exponent 1.5 in matrix multiplication is +non-integer or outside the valid range. + 19 | PRINT m**1.5. + | ^~~ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - sequences and construction]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT {1:3:-1}. +PRINT {1:3}. +PRINT {1:10:2}. +PRINT {1:11:2}. + +PRINT {-1:-3}. +PRINT {-1:-3:-1}. +PRINT {-1:-10:-2}. +PRINT {-1:-11:-2}. + +PRINT {1:1}. +PRINT {1:1:-1}. + +PRINT {1:3:0}. +PRINT {-1:-3:0}. + +PRINT {1, 2; 3}. +PRINT {{2; 5}, 3}. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +{1:3:-1} + +{1:3} + 1 2 3 + +{1:10:2} + 1 3 5 7 9 + +{1:11:2} + 1 3 5 7 9 11 + +{-1:-3} + +{-1:-3:-1} + -1 -2 -3 + +{-1:-10:-2} + -1 -3 -5 -7 -9 + +{-1:-11:-2} + -1 -3 -5 -7 -9 -11 + +{1:1} + 1 + +{1:1:-1} + 1 + +matrix.sps:15.12: error: MATRIX: The increment operand to : must be nonzero. + 15 | PRINT {1:3:0}. + | ^ + +matrix.sps:16.14: error: MATRIX: The increment operand to : must be nonzero. + 16 | PRINT {-1:-3:0}. + | ^ + +matrix.sps:18.7-18.15: error: MATRIX: This expression tries to vertically join +matrices with differing numbers of columns. + 18 | PRINT {1, 2; 3}. + | ^~~~~~~~~ + +matrix.sps:18.8-18.11: note: MATRIX: This operand is a 1×2 matrix. + 18 | PRINT {1, 2; 3}. + | ^~~~ + +matrix.sps:18.14: note: MATRIX: This operand is a 1×1 matrix. + 18 | PRINT {1, 2; 3}. + | ^ + +matrix.sps:19.7-19.17: error: MATRIX: This expression tries to horizontally +join matrices with differing numbers of rows. + 19 | PRINT {{2; 5}, 3}. + | ^~~~~~~~~~~ + +matrix.sps:19.8-19.13: note: MATRIX: This operand is a 2×1 matrix. + 19 | PRINT {{2; 5}, 3}. + | ^~~~~~ + +matrix.sps:19.16: note: MATRIX: This operand is a 1×1 matrix. + 19 | PRINT {{2; 5}, 3}. + | ^ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - comments]) +AT_DATA([matrix.sps], [dnl +MATRIX. +* Comment one. +PRINT (1+2). +COMMENT Comment two. +PRINT (3+4). +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +(1+2) + 3 + +(3+4) + 7 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - string matrices]) +AT_DATA([matrix.sps], [dnl +MATRIX. +COMPUTE m={'This is', 'a string', 'matrix', 'including', 'some', 'long strings'}. +PRINT m/FORMAT=A8. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +m + This is a string matrix includin some long str +]) +AT_CLEANUP + +AT_SETUP([MATRIX - ABS ALL ANY ARSIN ARTAN]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT ABS({-1, 0, 1}). + +PRINT ALL({0, 0, 0}). +PRINT ALL({-1, 1}). +PRINT ALL({-1, 0, 1}). + +PRINT ANY({0, 0, 0}). +PRINT ANY({-1, 1}). +PRINT ANY({-1, 0, 1}). + +PRINT ARSIN({-1, 0, 1})/FORMAT=F5.2. + +PRINT ARTAN({-5, -1, 0, 1, 5})/FORMAT=F5.2. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +ABS({-1, 0, 1}) + 1 0 1 + +ALL({0, 0, 0}) + 0 + +ALL({-1, 1}) + 1 + +ALL({-1, 0, 1}) + 0 + +ANY({0, 0, 0}) + 0 + +ANY({-1, 1}) + 1 + +ANY({-1, 0, 1}) + 1 + +ARSIN({-1, 0, 1}) + -1.57 .00 1.57 + +ARTAN({-5, -1, 0, 1, 5}) + -1.37 -.79 .00 .79 1.37 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - BLOCK CHOL CMAX CMIN COS]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT BLOCK({1, 2; 3, 4}, 5, {7; 8; 9}, {10, 11}). + +COMPUTE b=CHOL({4, 12, -16; 12, 37, -43; -16, -43, 98}). +PRINT b. +PRINT (T(b)*b). + +PRINT CMAX({9, 3, 4; 5, 8, 6; 7, 4, 11}). + +PRINT CMIN({9, 3, 4; 5, 8, 6; 7, 4, 11}). + +PRINT COS({0.785, 1.57; 3.14, 1.57 + 3.14}) /FORMAT=F5.2. + +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +BLOCK({1, 2; 3, 4}, 5, {7; 8; 9}, {10, 11}) + 1 2 0 0 0 0 + 3 4 0 0 0 0 + 0 0 5 0 0 0 + 0 0 0 7 0 0 + 0 0 0 8 0 0 + 0 0 0 9 0 0 + 0 0 0 0 10 11 + +b + 2 6 -8 + 0 1 5 + 0 0 3 + +(T(b)*b) + 4 12 -16 + 12 37 -43 + -16 -43 98 + +CMAX({9, 3, 4; 5, 8, 6; 7, 4, 11}) + 9 8 11 + +CMIN({9, 3, 4; 5, 8, 6; 7, 4, 11}) + 5 3 4 + +COS({0.785, 1.57; 3.14, 1.57 + 3.14}) + .71 .00 + -1.00 .00 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - CSSQ CSUM DESIGN DET DIAG]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT CSSQ({1, 2, 3; 4, 5, 6; 7, 8, 9}). +PRINT CSUM({1, 2, 3; 4, 5, 6; 7, 8, 9}). +PRINT DESIGN({1, 2, 0; 2, 1, 0; 3, 0, 1}). +PRINT DESIGN({1, 2, 0; 2, 2, 0; 3, 2, 1}). +PRINT DET({1, 2, 3; 4, 5, 6; 7, 8, 9}) /FORMAT F4.1. +PRINT DIAG({1, 2, 3, 4; 4, 5, 6, 7; 7, 8, 9, 10}). +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +CSSQ({1, 2, 3; 4, 5, 6; 7, 8, 9}) + 66 93 126 + +CSUM({1, 2, 3; 4, 5, 6; 7, 8, 9}) + 12 15 18 + +DESIGN({1, 2, 0; 2, 1, 0; 3, 0, 1}) + 1 0 0 0 0 1 1 0 + 0 1 0 0 1 0 1 0 + 0 0 1 1 0 0 0 1 + +warning: Column 2 in DESIGN argument has constant value. + +DESIGN({1, 2, 0; 2, 2, 0; 3, 2, 1}) + 1 0 0 1 0 + 0 1 0 1 0 + 0 0 1 0 1 + +DET({1, 2, 3; 4, 5, 6; 7, 8, 9}) + .0 + +DIAG({1, 2, 3, 4; 4, 5, 6, 7; 7, 8, 9, 10}) + 1 + 5 + 9 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - EVAL EXP GINV GRADE GSCH]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT EVAL({2, 0, 0; 0, 3, 4; 0, 4, 9}). + +PRINT EXP({2, 3; 4, 5})/FORMAT F5.2. + +PRINT GINV({1, 2})/FORMAT F5.2. +COMPUTE a={1, 2, 3; 4, 5, 6; 7, 8, 9}. +COMPUTE g=GINV(a). +PRINT (a*g*a)/FORMAT F5.2. + +PRINT GRADE({1, 0, 3; 3, 1, 2; 3, 0, 5}). +COMPUTE x={26, 690, 323, 208, 671, 818, 732, 711, 585, 792}. +COMPUTE asort=x. +COMPUTE asort(GRADE(asort))=asort. +PRINT asort. +COMPUTE dsort=x. +COMPUTE dsort(GRADE(-dsort))=dsort. +PRINT dsort. + +PRINT (GSCH({3, 2; 1, 2}) * SQRT(10))/FORMAT F5.2. +PRINT (GSCH({0, 3, 6, 2; 0, 1, 2, 2}) * SQRT(10))/FORMAT F5.2. +PRINT GSCH({0; 0}). +PRINT GSCH({0, 0, 0; 0, 0, 0}). +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +EVAL({2, 0, 0; 0, 3, 4; 0, 4, 9}) + 11.0000000000 + 2.0000000000 + 1.0000000000 + +EXP({2, 3; 4, 5}) + 7.39 20.09 + 54.60 148.4 + +GINV({1, 2}) + .20 + .40 + +(a*g*a) + 1.00 2.00 3.00 + 4.00 5.00 6.00 + 7.00 8.00 9.00 + +GRADE({1, 0, 3; 3, 1, 2; 3, 0, 5}) + 3 1 6 + 7 4 5 + 8 2 9 + +asort + 26 208 323 585 671 690 711 732 792 818 + +dsort + 818 792 732 711 690 671 585 323 208 26 + +(GSCH({3, 2; 1, 2}) * SQRT(10)) + 3.00 -1.00 + 1.00 3.00 + +(GSCH({0, 3, 6, 2; 0, 1, 2, 2}) * SQRT(10)) + 3.00 -1.00 + 1.00 3.00 + +matrix.sps:22.12-22.17: error: MATRIX: GSCH requires its argument to have at +least as many columns as rows, but it has dimensions 2×1. + 22 | PRINT GSCH({0; 0}). + | ^~~~~~ + +matrix.sps:23.12-23.29: error: MATRIX: 2×3 argument to GSCH contains only 0 +linearly independent columns. + 23 | PRINT GSCH({0, 0, 0; 0, 0, 0}). + | ^~~~~~~~~~~~~~~~~~ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - IDENT INV KRONEKER LG10 LN]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT IDENT(1). +PRINT IDENT(2). +PRINT IDENT(3,5). +PRINT IDENT(5,3). + +PRINT INV({3, 3.5; 3.2, 3.6})/FORMAT F8.2. +PRINT INV({4, 7; 2, 6})/FORMAT F8.2. +PRINT (INV({4, -2, 1; 5, 0, 3; -1, 2, 6})*52)/FORMAT F8.2. + +PRINT KRONEKER({1, 2; 3, 4}, {0, 5; 6, 7}). + +PRINT LG10({1, 10, 100, 1000}). + +PRINT LN({1, 2; 3, 4})/FORMAT F5.2. +PRINT LN(0). +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +IDENT(1) + 1 + +IDENT(2) + 1 0 + 0 1 + +IDENT(3,5) + 1 0 0 0 0 + 0 1 0 0 0 + 0 0 1 0 0 + +IDENT(5,3) + 1 0 0 + 0 1 0 + 0 0 1 + 0 0 0 + 0 0 0 + +INV({3, 3.5; 3.2, 3.6}) + -9.00 8.75 + 8.00 -7.50 + +INV({4, 7; 2, 6}) + .60 -.70 + -.20 .40 + +(INV({4, -2, 1; 5, 0, 3; -1, 2, 6})*52) + -6.00 14.00 -6.00 + -33.00 25.00 -7.00 + 10.00 -6.00 10.00 + +KRONEKER({1, 2; 3, 4}, {0, 5; 6, 7}) + 0 5 0 10 + 6 7 12 14 + 0 15 0 20 + 18 21 24 28 + +LG10({1, 10, 100, 1000}) + 0 1 2 3 + +LN({1, 2; 3, 4}) + .00 .69 + 1.10 1.39 + +matrix.sps:16.7-16.11: error: MATRIX: Argument 1 to matrix function LN must be +greater than 0. + 16 | PRINT LN(0). + | ^~~~~ + +matrix.sps:16.10: note: MATRIX: Argument 1 is 0. + 16 | PRINT LN(0). + | ^ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MAGIC]) +AT_DATA([matrix.sps], [dnl +MATRIX. + +LOOP n=3 to 10. + COMPUTE m=MAGIC(n). + COMPUTE total=n*(n**2 + 1) / 2. + COMPUTE tb={MSUM(DIAG(T(m))), CSUM(m), MSUM(DIAG(m))} - total. + COMPUTE lr=RSUM(m) - total. + PRINT {tb; lr, m, lr; tb}/FORMAT F4.0. +END LOOP. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +{tb; lr, m, lr; tb} + 0 0 0 0 0 + 0 8 1 6 0 + 0 3 5 7 0 + 0 4 9 2 0 + 0 0 0 0 0 +{tb; lr, m, lr; tb} + 0 0 0 0 0 0 + 0 1 5 12 16 0 + 0 15 11 6 2 0 + 0 14 8 9 3 0 + 0 4 10 7 13 0 + 0 0 0 0 0 0 +{tb; lr, m, lr; tb} + 0 0 0 0 0 0 0 + 0 17 24 1 8 15 0 + 0 23 5 7 14 16 0 + 0 4 6 13 20 22 0 + 0 10 12 19 21 3 0 + 0 11 18 25 2 9 0 + 0 0 0 0 0 0 0 +{tb; lr, m, lr; tb} + 0 0 0 0 0 0 0 0 + 0 1 5 9 28 32 36 0 + 0 35 30 27 10 7 2 0 + 0 24 14 22 18 17 16 0 + 0 13 23 15 19 20 21 0 + 0 34 31 26 11 6 3 0 + 0 4 8 12 25 29 33 0 + 0 0 0 0 0 0 0 0 +{tb; lr, m, lr; tb} + 0 0 0 0 0 0 0 0 0 + 0 30 39 48 1 10 19 28 0 + 0 38 47 7 9 18 27 29 0 + 0 46 6 8 17 26 35 37 0 + 0 5 14 16 25 34 36 45 0 + 0 13 15 24 33 42 44 4 0 + 0 21 23 32 41 43 3 12 0 + 0 22 31 40 49 2 11 20 0 + 0 0 0 0 0 0 0 0 0 +{tb; lr, m, lr; tb} + 0 0 0 0 0 0 0 0 0 0 + 0 1 9 17 25 40 48 56 64 0 + 0 63 55 47 39 26 18 10 2 0 + 0 3 11 19 27 38 46 54 62 0 + 0 61 53 45 37 28 20 12 4 0 + 0 60 52 44 32 33 21 13 5 0 + 0 6 14 22 30 35 43 51 59 0 + 0 58 50 42 34 31 23 15 7 0 + 0 8 16 24 36 29 41 49 57 0 + 0 0 0 0 0 0 0 0 0 0 +{tb; lr, m, lr; tb} + 0 0 0 0 0 0 0 0 0 0 0 + 0 47 58 69 80 1 12 23 34 45 0 + 0 57 68 79 9 11 22 33 44 46 0 + 0 67 78 8 10 21 32 43 54 56 0 + 0 77 7 18 20 31 42 53 55 66 0 + 0 6 17 19 30 41 52 63 65 76 0 + 0 16 27 29 40 51 62 64 75 5 0 + 0 26 28 39 50 61 72 74 4 15 0 + 0 36 38 49 60 71 73 3 14 25 0 + 0 37 48 59 70 81 2 13 24 35 0 + 0 0 0 0 0 0 0 0 0 0 0 +{tb; lr, m, lr; tb} + 0 0 0 0 0 0 0 0 0 0 0 0 + 0 1 9 17 25 33 68 76 84 92 100 0 + 0 99 91 83 75 67 34 26 18 10 2 0 + 0 3 11 19 27 35 66 74 82 90 98 0 + 0 97 89 81 72 65 36 29 20 12 4 0 + 0 60 42 58 44 56 50 49 53 47 46 0 + 0 41 59 43 57 45 51 52 48 54 55 0 + 0 96 88 80 73 64 37 28 21 13 5 0 + 0 6 14 22 30 38 63 71 79 87 95 0 + 0 94 86 78 70 62 39 31 23 15 7 0 + 0 8 16 24 32 40 61 69 77 85 93 0 + 0 0 0 0 0 0 0 0 0 0 0 0 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MAKE MDIAG MMAX MMIN MOD]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT MAKE(1, 2, 3). +PRINT MAKE(2, 1, 4). +PRINT MAKE(2, 3, 5). + +PRINT MDIAG({1, 2, 3, 4}). +PRINT MDIAG({1; 2; 3; 4}). +PRINT MDIAG({1, 2; 3, 4}). + +PRINT MMAX({55, 44; 66, 11}). + +PRINT MMIN({55, 44; 66, 11}). + +PRINT MOD({5, 4, 3, 2, 1, 0}, 3). +PRINT MOD({5, 4, 3, 2, 1, 0}, -3). +PRINT MOD({-5, -4, -3, -2, -1, 0}, 3). +PRINT MOD({-5, -4, -3, -2, -1, 0}, -3). +PRINT MOD({5, 4, 3, 2, 1, 0}, 1.5) /FORMAT F5.1. +PRINT MOD({5, 4, 3, 2, 1, 0}, 0). +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +MAKE(1, 2, 3) + 3 3 + +MAKE(2, 1, 4) + 4 + 4 + +MAKE(2, 3, 5) + 5 5 5 + 5 5 5 + +MDIAG({1, 2, 3, 4}) + 1 0 0 0 + 0 2 0 0 + 0 0 3 0 + 0 0 0 4 + +MDIAG({1; 2; 3; 4}) + 1 0 0 0 + 0 2 0 0 + 0 0 3 0 + 0 0 0 4 + +matrix.sps:8.13-8.24: error: MATRIX: Function MDIAG argument 1 must be a +vector, not a 2×2 matrix. + 8 | PRINT MDIAG({1, 2; 3, 4}). + | ^~~~~~~~~~~~ + +MMAX({55, 44; 66, 11}) + 66 + +MMIN({55, 44; 66, 11}) + 11 + +MOD({5, 4, 3, 2, 1, 0}, 3) + 2 1 0 2 1 0 + +MOD({5, 4, 3, 2, 1, 0}, -3) + 2 1 0 2 1 0 + +MOD({-5, -4, -3, -2, -1, 0}, 3) + -2 -1 0 -2 -1 0 + +MOD({-5, -4, -3, -2, -1, 0}, -3) + -2 -1 0 -2 -1 0 + +MOD({5, 4, 3, 2, 1, 0}, 1.5) + .5 1.0 .0 .5 1.0 .0 + +matrix.sps:19.7-19.32: error: MATRIX: Argument 2 to matrix function MOD must +not be equal to 0. + 19 | PRINT MOD({5, 4, 3, 2, 1, 0}, 0). + | ^~~~~~~~~~~~~~~~~~~~~~~~~~ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MSSQ MSUM NCOL NROW RANK]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT MSSQ({1, 0, 1; -2, -3, 1; 3, 3, 0}). + +PRINT MSUM({1, 0, 1; -2, -3, 1; 3, 3, 0}). + +PRINT NCOL({1, 0; -2, -3; 3, 3}). + +PRINT NROW({1, 0; -2, -3; 3, 3}). + +PRINT RANK({1, 0, 1; -2, -3, 1; 3, 3, 0}). +PRINT RANK({1, 1, 0, 2; -1, -1, 0, -2}). +PRINT RANK({1, -1; 1, -1; 0, 0; 2, -2}). +PRINT RANK({1, 2, 1; -2, -3, 1; 3, 5, 0}). +PRINT RANK({1, 0, 2; 2, 1, 0; 3, 2, 1}). +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +MSSQ({1, 0, 1; -2, -3, 1; 3, 3, 0}) + 34 + +MSUM({1, 0, 1; -2, -3, 1; 3, 3, 0}) + 4 + +NCOL({1, 0; -2, -3; 3, 3}) + 2 + +NROW({1, 0; -2, -3; 3, 3}) + 3 + +RANK({1, 0, 1; -2, -3, 1; 3, 3, 0}) + 2 + +RANK({1, 1, 0, 2; -1, -1, 0, -2}) + 1 + +RANK({1, -1; 1, -1; 0, 0; 2, -2}) + 1 + +RANK({1, 2, 1; -2, -3, 1; 3, 5, 0}) + 2 + +RANK({1, 0, 2; 2, 1, 0; 3, 2, 1}) + 3 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - RESHAPE RMAX RMIN RND RNKORDER]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT RESHAPE(1:12, 1, 12). +PRINT RESHAPE(1:12, 2, 6). +PRINT RESHAPE(1:12, 3, 4). +PRINT RESHAPE(1:12, 4, 3). +PRINT RESHAPE(1:12, 6, 2). +PRINT RESHAPE(1:12, 12, 1). + +PRINT RMAX({1, 0, 1; -2, -3, 1; 3, 3, 0}). + +PRINT RMIN({1, 0, 1; -2, -3, 1; 3, 3, 0}). + +PRINT RND({-1.6, -1.5, -1.4; + -.6, -.5, -.4; + .4, .5, .6; + 1.4, 1.5, 1.6})/FORMAT F5.1. + +PRINT RNKORDER({1, 0, 3; 3, 1, 2; 3, 0, 5}) /FORMAT F5.1. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +RESHAPE(1:12, 1, 12) + 1 2 3 4 5 6 7 8 9 10 11 12 + +RESHAPE(1:12, 2, 6) + 1 2 3 4 5 6 + 7 8 9 10 11 12 + +RESHAPE(1:12, 3, 4) + 1 2 3 4 + 5 6 7 8 + 9 10 11 12 + +RESHAPE(1:12, 4, 3) + 1 2 3 + 4 5 6 + 7 8 9 + 10 11 12 + +RESHAPE(1:12, 6, 2) + 1 2 + 3 4 + 5 6 + 7 8 + 9 10 + 11 12 + +RESHAPE(1:12, 12, 1) + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + 12 + +RMAX({1, 0, 1; -2, -3, 1; 3, 3, 0}) + 1 + 1 + 3 + +RMIN({1, 0, 1; -2, -3, 1; 3, 3, 0}) + 0 + -3 + 0 + +RND({-1.6, -1.5, -1.4; + -.6, -.5, -.4; + .4, .5, .6; + 1.4, 1.5, 1.6}) + -2.0 -2.0 -1.0 + -1.0 .0 .0 + .0 .0 1.0 + 1.0 2.0 2.0 + +RNKORDER({1, 0, 3; 3, 1, 2; 3, 0, 5}) + 3.5 1.5 7.0 + 7.0 3.5 5.0 + 7.0 1.5 9.0 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - RSSQ RSUM SIN SOLVE SQRT]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT RSSQ({1, 2, 3; 4, 5, 6; 7, 8, 9}). +PRINT RSUM({1, 2, 3; 4, 5, 6; 7, 8, 9}). + +PRINT SIN({0, .78, 1.57, 2.35, 3.14}) /FORMAT F5.2. + +PRINT SOLVE({2, 3; 4, 9}, {6, 2; 15, 5}) /FORMAT=F6.2. +PRINT SOLVE({1, 3, -2; 3, 5, 6; 2, 4, 3}, {5; 7; 8}) /FORMAT=F6.2. +PRINT SOLVE({2, 1, -1; -3, -1, 2; -2, 1, 2}, {8; -11; -3}) /FORMAT=F6.2. +PRINT SOLVE({1, 2; 3, 4}, {1, 2}). + +PRINT SQRT({0, 1, 2, 3, 4, 9, 81}) /FORMAT=F5.2. +PRINT SQRT(-1). +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +RSSQ({1, 2, 3; 4, 5, 6; 7, 8, 9}) + 14 + 77 + 194 + +RSUM({1, 2, 3; 4, 5, 6; 7, 8, 9}) + 6 + 15 + 24 + +SIN({0, .78, 1.57, 2.35, 3.14}) + .00 .70 1.00 .71 .00 + +SOLVE({2, 3; 4, 9}, {6, 2; 15, 5}) + 1.50 .50 + 1.00 .33 + +SOLVE({1, 3, -2; 3, 5, 6; 2, 4, 3}, {5; 7; 8}) + -15.00 + 8.00 + 2.00 + +SOLVE({2, 1, -1; -3, -1, 2; -2, 1, 2}, {8; -11; -3}) + 2.00 + 3.00 + -1.00 + +matrix.sps:10.7-10.33: error: MATRIX: SOLVE arguments must have the same number +of rows. + 10 | PRINT SOLVE({1, 2; 3, 4}, {1, 2}). + | ^~~~~~~~~~~~~~~~~~~~~~~~~~~ + +matrix.sps:10.13-10.24: note: MATRIX: Argument 1 has dimensions 2×2. + 10 | PRINT SOLVE({1, 2; 3, 4}, {1, 2}). + | ^~~~~~~~~~~~ + +matrix.sps:10.27-10.32: note: MATRIX: Argument 2 has dimensions 1×2. + 10 | PRINT SOLVE({1, 2; 3, 4}, {1, 2}). + | ^~~~~~ + +SQRT({0, 1, 2, 3, 4, 9, 81}) + .00 1.00 1.41 1.73 2.00 3.00 9.00 + +matrix.sps:13.7-13.14: error: MATRIX: Argument 1 to matrix function SQRT must +be greater than or equal to 0. + 13 | PRINT SQRT(-1). + | ^~~~~~~~ + +matrix.sps:13.12-13.13: note: MATRIX: Argument 1 is -1. + 13 | PRINT SQRT(-1). + | ^~ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - SSCP SVAL SWEEP TRACE TRANSPOS TRUNC]) +AT_DATA([matrix.sps], [dnl +MATRIX. +COMPUTE m={1, 2, 3; 4, 5, 6} +COMPUTE sscp1=SSCP(m). +COMPUTE sscp2=T(m)*m. +PRINT sscp1. +PRINT (sscp1 <> sscp2). + +PRINT SVAL({1, 1; 0, 0})/FORMAT F5.2. +PRINT SVAL({1, 0, 1; 0, 1, 1; 0, 0, 0})/FORMAT F5.2. +PRINT SVAL({1, 0, 0, 0, 2; 0, 0, 3, 0, 0; 0, 0, 0, 0, 0; 0, 2, 0, 0, 0}) + /FORMAT F5.2. +PRINT SVAL({2, 4; 1, 3; 0, 0; 0, 0})/FORMAT F5.2. + +COMPUTE s0 = {6, 12, 0, 12; 12, 28, 0, 25; 0, 0, 6, 2; 12, 25, 2, 28}. +PRINT SWEEP(s0, 1)/FORMAT F5.2. +PRINT SWEEP(SWEEP(s0, 1), 2)/FORMAT F5.2. +PRINT SWEEP(SWEEP(SWEEP(s0, 1), 2), 3)/FORMAT F5.2. + +COMPUTE s1 = {6, 12, 0, 12; 12, 0, 0, 25; 0, 0, 6, 2; 12, 25, 2, 28}. +PRINT SWEEP(s1, 2). + +COMPUTE s2 = {0, 1, 2; 3, 4, 5; 6, 7, 8}. +PRINT SWEEP(s2, 1). +PRINT SWEEP(s2, 2). +PRINT SWEEP(s2, 3). + +PRINT TRACE(s0). + +PRINT T(s0). +PRINT TRANSPOS(s0). +PRINT ALL(T(T(s0)) = s0). + +PRINT TRUNC(SVAL({2, 4; 1, 3; 0, 0; 0, 0})). +PRINT TRUNC(-SVAL({2, 4; 1, 3; 0, 0; 0, 0})). +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +sscp1 + 17 22 27 + 22 29 36 + 27 36 45 + +(sscp1 <> sscp2) + 0 0 0 + 0 0 0 + 0 0 0 + +SVAL({1, 1; 0, 0}) + 1.41 + .00 + +SVAL({1, 0, 1; 0, 1, 1; 0, 0, 0}) + 1.73 + 1.00 + .00 + +SVAL({1, 0, 0, 0, 2; 0, 0, 3, 0, 0; 0, 0, 0, 0, 0; 0, 2, 0, 0, 0}) + 3.00 + 2.24 + 2.00 + .00 + +SVAL({2, 4; 1, 3; 0, 0; 0, 0}) + 5.46 + .37 + +SWEEP(s0, 1) + .17 2.00 .00 2.00 + -2.00 4.00 .00 1.00 + .00 .00 6.00 2.00 + -2.00 1.00 2.00 4.00 + +SWEEP(SWEEP(s0, 1), 2) + 1.17 -.50 .00 1.50 + -.50 .25 .00 .25 + .00 .00 6.00 2.00 + -1.50 -.25 2.00 3.75 + +SWEEP(SWEEP(SWEEP(s0, 1), 2), 3) + 1.17 -.50 .00 1.50 + -.50 .25 .00 .25 + .00 .00 .17 .33 + -1.50 -.25 -.33 3.08 + +SWEEP(s1, 2) + 6 0 0 12 + 0 0 0 0 + 0 0 6 2 + 12 0 2 28 + +SWEEP(s2, 1) + 0 0 0 + 0 4 5 + 0 7 8 + +SWEEP(s2, 2) + -.7500000000 -.2500000000 .7500000000 + .7500000000 .2500000000 1.2500000000 + .7500000000 -1.7500000000 -.7500000000 + +SWEEP(s2, 3) + -1.5000000000 -.7500000000 -.2500000000 + -.7500000000 -.3750000000 -.6250000000 + .7500000000 .8750000000 .1250000000 + +TRACE(s0) + 68 + +T(s0) + 6 12 0 12 + 12 28 0 25 + 0 0 6 2 + 12 25 2 28 + +TRANSPOS(s0) + 6 12 0 12 + 12 28 0 25 + 0 0 6 2 + 12 25 2 28 + +ALL(T(T(s0)) = s0) + 1 + +TRUNC(SVAL({2, 4; 1, 3; 0, 0; 0, 0})) + 5 + 0 + +TRUNC(-SVAL({2, 4; 1, 3; 0, 0; 0, 0})) + -5 + 0 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - UNIFORM]) +AT_DATA([matrix.sps], [dnl +SET SEED=10. +MATRIX. +PRINT (UNIFORM(4, 5)*10)/FORMAT F5.2. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +(UNIFORM(4, 5)*10) + 7.71 2.99 .21 4.95 6.34 + 4.43 7.49 8.32 4.99 5.83 + 2.25 .25 1.98 7.09 7.61 + 2.66 1.69 2.64 .88 1.50 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - invalid function arguments]) +AT_DATA([matrix.sps], [dnl +MATRIX. +COMPUTE x=MOD({1,2,3},{4,5,6}). +COMPUTE x=MDIAG({1, 2; 3, 4}). +COMPUTE x=ARSIN(2). +COMPUTE x=ARSIN({1, 1; -1, 2}). +COMPUTE x=CDF.UNIFORM(2,1,1). +COMPUTE x=CDF.UNIFORM(1,2,1). +COMPUTE x=CDF.UNIFORM({1,2},1,1). +COMPUTE x=MAGIC(2). +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:2.23-2.29: error: MATRIX: Function MOD argument 2 must be a scalar, +not a 1×3 matrix. + 2 | COMPUTE x=MOD({1,2,3},{4,5,6}). + | ^~~~~~~ + +matrix.sps:3.17-3.28: error: MATRIX: Function MDIAG argument 1 must be a +vector, not a 2×2 matrix. + 3 | COMPUTE x=MDIAG({1, 2; 3, 4}). + | ^~~~~~~~~~~~ + +matrix.sps:4.17: error: MATRIX: Argument 1 to matrix function ARSIN is 2, which +is outside the valid range [[-1,1]]. + 4 | COMPUTE x=ARSIN(2). + | ^ + +matrix.sps:5.17-5.29: error: MATRIX: Row 2, column 2 of argument 1 to matrix +function ARSIN is 2, which is outside the valid range [[-1,1]]. + 5 | COMPUTE x=ARSIN({1, 1; -1, 2}). + | ^~~~~~~~~~~~~ + +error: Argument 1 to matrix function CDF.UNIFORM must be less than or equal to +argument 3. + +matrix.sps:6.23: note: MATRIX: Argument 1 is 2. + 6 | COMPUTE x=CDF.UNIFORM(2,1,1). + | ^ + +matrix.sps:6.27: note: MATRIX: Argument 3 is 1. + 6 | COMPUTE x=CDF.UNIFORM(2,1,1). + | ^ + +error: Argument 2 to matrix function CDF.UNIFORM must be less than or equal to +argument 3. + +matrix.sps:7.25: note: MATRIX: Argument 2 is 2. + 7 | COMPUTE x=CDF.UNIFORM(1,2,1). + | ^ + +matrix.sps:7.27: note: MATRIX: Argument 3 is 1. + 7 | COMPUTE x=CDF.UNIFORM(1,2,1). + | ^ + +error: Argument 1 to matrix function CDF.UNIFORM must be less than or equal to +argument 3. + +matrix.sps:8.23-8.27: note: MATRIX: Row 1, column 2 of argument 1 is 2. + 8 | COMPUTE x=CDF.UNIFORM({1,2},1,1). + | ^~~~~ + +matrix.sps:8.31: note: MATRIX: Argument 3 is 1. + 8 | COMPUTE x=CDF.UNIFORM({1,2},1,1). + | ^ + +matrix.sps:9.11-9.18: error: MATRIX: Argument 1 to matrix function MAGIC must +be greater than or equal to 3. + 9 | COMPUTE x=MAGIC(2). + | ^~~~~~~~ + +matrix.sps:9.17: note: MATRIX: Argument 1 is 2. + 9 | COMPUTE x=MAGIC(2). + | ^ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - invalid number function arguments]) +AT_DATA([matrix.sps], [dnl +MATRIX. +COMPUTE x=ABS(). +COMPUTE x=ABS(1,2). +COMPUTE x=KRONEKER(1,2,3). +COMPUTE x=IDENT(). +COMPUTE x=IDENT(1,2,3). +COMPUTE x=BLOCK(). +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:2: error: COMPUTE: Matrix function ABS requires 1 argument. + +matrix.sps:3: error: COMPUTE: Matrix function ABS requires 1 argument. + +matrix.sps:4: error: COMPUTE: Matrix function KRONEKER requires 2 arguments. + +matrix.sps:5: error: COMPUTE: Matrix function IDENT requires 1 or 2 arguments, +but 0 were provided. + +matrix.sps:6: error: COMPUTE: Matrix function IDENT requires 1 or 2 arguments, +but 3 were provided. + +matrix.sps:7: error: COMPUTE: Matrix function BLOCK requires at least one +argument. +]) +AT_CLEANUP + +AT_SETUP([MATRIX - CALL SETDIAG]) +AT_DATA([matrix.sps], [dnl +MATRIX. +COMPUTE x={1, 2, 3; 4, 5, 6; 7, 8, 9}. + +COMPUTE x1=x. +CALL SETDIAG(x1, 10). +PRINT x1. + +COMPUTE x2=x. +CALL SETDIAG(x2, {10, 11}). +PRINT x2. + +COMPUTE x3=x. +CALL SETDIAG(x3, {10, 11, 12}). +PRINT x3. + +COMPUTE x4=x. +CALL SETDIAG(x4, {10, 11, 12, 13}). +PRINT x4. + +COMPUTE x5=x. +CALL SETDIAG(x5, {10, 11; 12, 13}). +PRINT x5. + +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +x1 + 10 2 3 + 4 10 6 + 7 8 10 + +x2 + 10 2 3 + 4 11 6 + 7 8 9 + +x3 + 10 2 3 + 4 11 6 + 7 8 12 + +x4 + 10 2 3 + 4 11 6 + 7 8 12 + +matrix.sps:21.18-21.33: error: MATRIX: SETDIAG argument 2 must be a scalar or a +vector, not a 2×2 matrix. + 21 | CALL SETDIAG(x5, {10, 11; 12, 13}). + | ^~~~~~~~~~~~~~~~ + +x5 + 1 2 3 + 4 5 6 + 7 8 9 +]) +AT_CLEANUP + +dnl I have some doubts about the correctness of the results below. +AT_SETUP([MATRIX - CALL EIGEN]) +AT_DATA([matrix.sps], [dnl +MATRIX. +CALL EIGEN({1, 0; 0, 1}, evec, eval). +PRINT evec. +PRINT eval. + +CALL EIGEN({3, 2, 4; 2, 0, 2; 4, 2, 3}, evec2, eval2). +PRINT evec2. +PRINT eval2. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +evec + 1 0 + 0 1 + +eval + 1 + 1 + +evec2 + -.6666666667 .0000000000 .7453559925 + -.3333333333 -.8944271910 -.2981423970 + -.6666666667 .4472135955 -.5962847940 + +eval2 + 8.0000000000 + -1.0000000000 + -1.0000000000 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - CALL SVD]) +AT_DATA([matrix.sps], [dnl +MATRIX. +CALL SVD({3, 2, 2; 2, 3, -2}, u, s, v). +PRINT (u * s * T(v))/FORMAT F5.1. + +CALL SVD({2, 4; 1, 3; 0, 0; 0, 0}, u, s, v). +PRINT (u*s*T(v))/FORMAT F5.1. + +CALL SVD({-3, 1; 6, -2; 6, -2}, u, s, v). +PRINT (u*s*T(v))/FORMAT F5.1. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +(u * s * T(v)) + 3.0 2.0 2.0 + 2.0 3.0 -2.0 + +(u*s*T(v)) + 2.0 4.0 + 1.0 3.0 + .0 .0 + .0 .0 + +(u*s*T(v)) + -3.0 1.0 + 6.0 -2.0 + 6.0 -2.0 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - PRINT]) +AT_DATA([matrix.sps], [dnl +MATRIX. +PRINT/TITLE="title 1". +PRINT/SPACE=2/TITLE="title 2". + +COMPUTE m={1, 2, 3; 3, 4, 5; 6, 7, 8}. +PRINT m/RLABELS=123, a b c, long name. +PRINT m/RNAMES={'123', 'a b c', 'long name'}. +PRINT m/CLABELS=col1, col2, long column name. +PRINT m/CNAMES={'col1', 'col2', 'long column name'}. +PRINT m/RLABELS=123, a b c, long name + /CLABELS=col1, col2, long column name. +PRINT m/RNAMES={'123', 'a b c', 'long name'} + /CNAMES={'col1', 'col2', 'long column name'}. +PRINT {123e10, 456e10, 500}. +END MATRIX. +]) + +AT_DATA([matrix-tables.sps], [dnl +SET MDISPLAY=TABLES. +INCLUDE 'matrix.sps'. +]) + +AT_CHECK([pspp matrix.sps], [0], [dnl +title 1 + + + +title 2 + +m +123 1 2 3 +a b c 3 4 5 +long nam 6 7 8 + +m +123 1 2 3 +a b c 3 4 5 +long nam 6 7 8 + +m + col1 col2 long col + 1 2 3 + 3 4 5 + 6 7 8 + +m + col1 col2 long col + 1 2 3 + 3 4 5 + 6 7 8 + +m + col1 col2 long col +123 1 2 3 +a b c 3 4 5 +long nam 6 7 8 + +m + col1 col2 long col +123 1 2 3 +a b c 3 4 5 +long nam 6 7 8 + +{123e10, 456e10, 500} + 10 ** 12 X + 1.2300000000 4.5600000000 .0000000005 +]) + +AT_CHECK([pspp matrix-tables.sps], [0], [dnl +title 1 + + + +title 2 + + m ++---------+-----+ +|123 |1 2 3| +|a b c |3 4 5| +|long name|6 7 8| ++---------+-----+ + + m ++--------+-----+ +|123 |1 2 3| +|a b c |3 4 5| +|long nam|6 7 8| ++--------+-----+ + + m ++----+----+----------------+ +|col1|col2|long column name| ++----+----+----------------+ +| 1| 2| 3| +| 3| 4| 5| +| 6| 7| 8| ++----+----+----------------+ + + m ++----+----+--------+ +|col1|col2|long col| ++----+----+--------+ +| 1| 2| 3| +| 3| 4| 5| +| 6| 7| 8| ++----+----+--------+ + + m ++---------+----+----+----------------+ +| |col1|col2|long column name| ++---------+----+----+----------------+ +|123 | 1| 2| 3| +|a b c | 3| 4| 5| +|long name| 6| 7| 8| ++---------+----+----+----------------+ + + m ++--------+----+----+--------+ +| |col1|col2|long col| ++--------+----+----+--------+ +|123 | 1| 2| 3| +|a b c | 3| 4| 5| +|long nam| 6| 7| 8| ++--------+----+----+--------+ + + {123e10, 456e10, 500} ++----------------------------------------------+ +|1.2300000000[[a]] 4.5600000000[[a]] .0000000005[[a]]| ++----------------------------------------------+ +a. × 10**12 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - DO IF]) +AT_DATA([matrix.sps], [dnl +MATRIX. +DO IF 1. +PRINT/TITLE '1'. +END IF. + +DO IF 0. +PRINT/TITLE '2'. +ELSE IF 1. +PRINT/TITLE '3'. +END IF. + +DO IF -1. +PRINT/TITLE '4'. +ELSE IF 0. +PRINT/TITLE '5'. +ELSE. +PRINT/TITLE '6'. +END IF. + +DO IF {1, 2}. +END IF. + +DO IF 0. +ELSE IF {}. +END IF. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +1 + +3 + +6 + +matrix.sps:20.7-20.12: error: MATRIX: Expression for DO IF must evaluate to +scalar, not a 1×2 matrix. + 20 | DO IF {1, 2}. + | ^~~~~~ + +matrix.sps:24.9-24.10: error: MATRIX: Expression for ELSE IF must evaluate to +scalar, not a 0×0 matrix. + 24 | ELSE IF {}. + | ^~ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - unbounded LOOP]) +AT_DATA([matrix.sps], [dnl +MATRIX. +* Truly unbounded loop. +COMPUTE x=0. +COMPUTE y={}. +LOOP. +COMPUTE x=x+1. +COMPUTE y={y, x}. +END LOOP. +PRINT x. +PRINT y. + +* Unbounded loop terminates with BREAK. +COMPUTE x=0. +COMPUTE y={}. +LOOP. +COMPUTE x=x+1. +COMPUTE y={y, x}. +DO IF x >= 20. + BREAK. +END IF. +END LOOP. +PRINT x. +PRINT y. + +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +x + 40 + +y + 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 +20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 +40 + +x + 20 + +y + 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 +20 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - indexed or conditional LOOP]) +AT_DATA([matrix.sps], [dnl +MATRIX. +* Indexed loop terminates based on index. +COMPUTE y={}. +LOOP x=1 TO 20. +COMPUTE y={y, x}. +END LOOP. +PRINT x. +PRINT y. + +* Indexed loop terminates based on MXLOOPS. +COMPUTE y={}. +LOOP x=1 TO 50. +COMPUTE y={y, x}. +END LOOP. +PRINT x. +PRINT y. + +* Indexed loop terminates with BREAK. +COMPUTE y={}. +LOOP x=1 TO 50. +COMPUTE y={y, x}. +DO IF x >= 20. + BREAK. +END IF. +END LOOP. +PRINT x. +PRINT y. + +* Indexed loop terminates with top IF. +COMPUTE y={}. +LOOP x=1 TO 50 IF NCOL(y) < 15. +COMPUTE y={y, x}. +END LOOP. +PRINT x. +PRINT y. + +* Indexed loop terminates with bottom IF. +COMPUTE y={}. +LOOP x=1 TO 50. +COMPUTE y={y, x}. +END LOOP IF NCOL(y) >= 22. +PRINT x. +PRINT y. + +* Index behavior. +COMPUTE indexing={ + 1, 10, 1; + 1, 10, 2; + 1, 10, 3; + 1, 10, -1; + 1, 10, 0; + 10, 1, -1; + 10, 1, -2; + 10, 1, -3; + 10, 1, 1; + 10, 1, 0 +}. +LOOP i=1 TO NROW(indexing). + COMPUTE y={}. + LOOP j=indexing(i, 1) TO indexing(i, 2) BY indexing(i, 3). + COMPUTE y={y, j}. + END LOOP. + PRINT {indexing(i, :), y}. +END LOOP. + +LOOP i={} TO 5. +END LOOP. + +LOOP i=5 TO {}. +END LOOP. + +LOOP i=5 TO 8 BY {}. +END LOOP. + +LOOP IF {}. +END LOOP. + +LOOP. +END LOOP IF {}. + +LOOP i=1e100 to 1e200. +END LOOP. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +x + 20 + +y + 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 +20 + +x + 40 + +y + 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 +20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 +40 + +x + 20 + +y + 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 +20 + +x + 16 + +y + 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 + +x + 22 + +y + 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 +20 21 22 + +{indexing(i, :), y} + 1 10 1 1 2 3 4 5 6 7 8 9 10 +{indexing(i, :), y} + 1 10 2 1 3 5 7 9 +{indexing(i, :), y} + 1 10 3 1 4 7 10 +{indexing(i, :), y} + 1 10 -1 +{indexing(i, :), y} + 1 10 0 +{indexing(i, :), y} + 10 1 -1 10 9 8 7 6 5 4 3 2 1 +{indexing(i, :), y} + 10 1 -2 10 8 6 4 2 +{indexing(i, :), y} + 10 1 -3 10 7 4 1 +{indexing(i, :), y} + 10 1 1 +{indexing(i, :), y} + 10 1 0 + +matrix.sps:66.8-66.9: error: MATRIX: Expression for LOOP must evaluate to +scalar, not a 0×0 matrix. + 66 | LOOP i={} TO 5. + | ^~ + +matrix.sps:69.13-69.14: error: MATRIX: Expression for TO must evaluate to +scalar, not a 0×0 matrix. + 69 | LOOP i=5 TO {}. + | ^~ + +matrix.sps:72.18-72.19: error: MATRIX: Expression for BY must evaluate to +scalar, not a 0×0 matrix. + 72 | LOOP i=5 TO 8 BY {}. + | ^~ + +matrix.sps:75.9-75.10: error: MATRIX: Expression for LOOP IF must evaluate to +scalar, not a 0×0 matrix. + 75 | LOOP IF {}. + | ^~ + +matrix.sps:79.13-79.14: error: MATRIX: Expression for END LOOP IF must evaluate +to scalar, not a 0×0 matrix. + 79 | END LOOP IF {}. + | ^~ + +matrix.sps:81.8-81.12: error: MATRIX: Expression for LOOP is outside the +integer range. + 81 | LOOP i=1e100 to 1e200. + | ^~~~~ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - BREAK outside LOOP]) +AT_DATA([matrix.sps], [dnl +MATRIX. +BREAK. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:2: error: BREAK: BREAK not inside LOOP. +]) +AT_CLEANUP + +AT_SETUP([MATRIX - READ]) +AT_DATA([matrix.txt], [dnl +9 +8 +7 +6 +1 2 3 +4 5 6 +7 8 9 +10 11 12,13 +14, 15 ,16 , 17 +18 +19 +20 21 22 23 + 12 34 +5 6 + 78 89 +10 11 +$1 $2 3 +4 $5 6 +$1 $2 $3 4 + $5$6 $78 +1% 2% 3% 4 + 56% 7%8 +abcdefghijkl +ABCDEFGHIJKL +]) +AT_DATA([matrix2.txt], [dnl +2, 3, 5, 7 +11, 13, 17, 19 +23, 29, 31, 37 +41, 43, 47, 53 +]) +AT_DATA([matrix3.txt], [dnl +1 5 +3 1 2 3 +5 6 -1 2 5 1 +2 8 9 +3 1 3 2 +]) +AT_DATA([matrix.sps], [dnl +MATRIX. +READ x/FILE='matrix.txt'/SIZE=4/FIELD=1 TO 1. +PRINT x. +READ x/FILE='matrix.txt'/SIZE={3,3}/FIELD=1 TO 80. +PRINT x. +READ x/SIZE={2,4}/FIELD=1 TO 80. +PRINT x. +READ x(:,2)/FILE='matrix.txt'/FIELD=1 TO 80. +PRINT x. +READ x(1,:)/SIZE={1,4}/FIELD=1 TO 80. +PRINT x. + +READ x/SIZE={2,6}/FIELD=1 TO 20 BY 5. +PRINT x. +READ x/SIZE={2,3}/FIELD=1 TO 20/FORMAT=DOLLAR. +PRINT x. +READ x/SIZE={2,4}/FIELD=1 TO 20/FORMAT=DOLLAR5.1. +PRINT x. +READ x/SIZE={2,4}/FIELD=1 TO 12/FORMAT='4PCT'. +PRINT x. +READ x/SIZE={2,4}/FIELD=1 TO 12/FORMAT='4A'. +PRINT x/FORMAT=A3. + +COMPUTE y={}. +LOOP IF NOT EOF('matrix2.txt'). +READ x/FILE='matrix2.txt'/SIZE={1,4}/FIELD=1 TO 80. +COMPUTE y={y; x}. +END LOOP. +PRINT y. + +COMPUTE m = MAKE(5, 5, 0). +LOOP i = 1 TO 5. +READ count /FILE='matrix3.txt' /FIELD=1 TO 1 /SIZE=1. +READ m(i, 1:count) /FIELD=3 TO 100 /REREAD. +END LOOP. +PRINT m. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [0], [dnl +x + 9 + 8 + 7 + 6 + +x + 1 2 3 + 4 5 6 + 7 8 9 + +x + 10 11 12 13 + 14 15 16 17 + +x + 10 18 12 13 + 14 19 16 17 + +x + 20 21 22 23 + 14 19 16 17 + +x + 1 2 3 4 5 6 + 7 8 8 9 10 11 + +x + 1 2 3 + 4 5 6 + +x + 1 2 3 4 + 5 6 7 8 + +x + 1 2 3 4 + 5 6 7 8 + +x + abc def ghi jkl + ABC DEF GHI JKL + +y + 2 3 5 7 + 11 13 17 19 + 23 29 31 37 + 41 43 47 53 + +m + 5 0 0 0 0 + 1 2 3 0 0 + 6 -1 2 5 1 + 8 9 0 0 0 + 1 3 2 0 0 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - READ - negative]) +AT_DATA([matrix.sps], [dnl +MATRIX. +READ !. +READ x/FILE=!. +READ x/ENCODING=!. +READ x/FIELD=!. +READ x/FIELD=1 !. +READ x/FIELD=1 TO !. +READ x/FIELD=1 TO 0. +READ x/FIELD=1 TO 10 BY !. +READ x/FIELD=1 TO 10 BY 6. +READ x/SIZE=!. +READ x/MODE=!. +READ x/FORMAT=!. +READ x/FORMAT=F8.2/FORMAT=F8.2. +READ x/FORMAT='5XYZZY'. +READ x/FORMAT=XYZZY. +READ x/!. +READ x. +READ x/FIELD=1 TO 10. +READ x/FIELD=1 TO 10/SIZE={1,2}. +READ x/FIELD=1 TO 10/SIZE={1,2}/FILE='xyzzy.txt'/FORMAT='15F'. +READ x/FIELD=1 TO 10 BY 2/SIZE={1,2}/FILE='xyzzy.txt'/FORMAT=F5. +READ x/FIELD=1 TO 10 BY 2/SIZE={1,2}/FILE='xyzzy.txt'/FORMAT='2F'. +READ x/FIELD=1 TO 10/SIZE={1,2;3,4}/FILE='matrix.txt'. +READ x/FIELD=1 TO 10/SIZE={1,2,3}/FILE='matrix.txt'. +READ x/FIELD=1 TO 10/SIZE={-1}/FILE='matrix.txt'. +COMPUTE x={1,2,3}. +READ x(:,:)/FIELD=1 TO 10/SIZE={2,2}/FILE='matrix.txt'. +READ x/FIELD=1 TO 10/SIZE={1,3}/FILE='matrix.txt'/MODE=SYMMETRIC. +READ x/FIELD=1 TO 10/SIZE=2/FILE='matrix.txt'. +END MATRIX. +]) +AT_DATA([matrix.txt], [dnl +xyzzy +. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:2.6: error: READ: Syntax error at `!': expecting identifier. + +matrix.sps:3.13: error: READ: Syntax error at `!': expecting a file name or +handle name. + +matrix.sps:4.17: error: READ: Syntax error at `!': expecting string. + +matrix.sps:5.14: error: READ: Syntax error at `!': Expected positive integer +for FIELD. + +matrix.sps:6.16: error: READ: Syntax error at `!': expecting `TO'. + +matrix.sps:7.19: error: READ: Syntax error at `!': Expected positive integer +for TO. + +matrix.sps:8.19: error: READ: Syntax error at `0': Expected positive integer +for TO. + +matrix.sps:9.25: error: READ: Syntax error at `!': Expected integer between 1 +and 10 for BY. + +matrix.sps:10: error: READ: BY 6 does not evenly divide record width 10. + +matrix.sps:11.13: error: READ: Syntax error at `!'. + +matrix.sps:12.13: error: READ: Syntax error at `!': expecting RECTANGULAR or +SYMMETRIC. + +matrix.sps:13.15: error: READ: Syntax error at `!': expecting identifier. + +matrix.sps:14: error: READ: Subcommand FORMAT may only be specified once. + +matrix.sps:15.15-15.22: error: READ: Syntax error at `'5XYZZY'': Unknown format +XYZZY. + +matrix.sps:16: error: READ: Unknown format type `XYZZY'. + +matrix.sps:17.8: error: READ: Syntax error at `!': expecting FILE, FIELD, MODE, +REREAD, or FORMAT. + +matrix.sps:18: error: READ: Required subcommand FIELD was not specified. + +matrix.sps:19: error: READ: SIZE is required for reading data into a full +matrix (as opposed to a submatrix). + +matrix.sps:20: error: READ: Required subcommand FILE was not specified. + +matrix.sps:21: error: READ: 15 repetitions cannot fit in record width 10. + +matrix.sps:22: error: READ: FORMAT specifies field width 5 but BY specifies 2. + +matrix.sps:23: error: READ: FORMAT specifies 2 repetitions with record width +10, which implies field width 5, but BY specifies field width 2. + +matrix.sps:24.27-24.35: error: MATRIX: SIZE must evaluate to a scalar or a 2- +element vector, not a 2×2 matrix. + 24 | READ x/FIELD=1 TO 10/SIZE={1,2;3,4}/FILE='matrix.txt'. + | ^~~~~~~~~ + +matrix.sps:25.27-25.33: error: MATRIX: SIZE must evaluate to a scalar or a 2- +element vector, not a 1×3 matrix. + 25 | READ x/FIELD=1 TO 10/SIZE={1,2,3}/FILE='matrix.txt'. + | ^~~~~~~ + +matrix.sps:26.28-26.29: error: MATRIX: Matrix dimensions -1×1 specified on SIZE +are outside valid range. + 26 | READ x/FIELD=1 TO 10/SIZE={-1}/FILE='matrix.txt'. + | ^~ + +matrix.sps:28: error: MATRIX: Dimensions specified on SIZE differ from +dimensions of destination submatrix. + +matrix.sps:28.32-28.36: note: MATRIX: SIZE specifies dimensions 2×2. + 28 | READ x(:,:)/FIELD=1 TO 10/SIZE={2,2}/FILE='matrix.txt'. + | ^~~~~ + +matrix.sps:28.6-28.11: note: MATRIX: Destination submatrix has dimensions 1×3. + 28 | READ x(:,:)/FIELD=1 TO 10/SIZE={2,2}/FILE='matrix.txt'. + | ^~~~~~ + +matrix.sps:29: error: MATRIX: Cannot read non-square 1×3 matrix using READ with +MODE=SYMMETRIC. + +matrix.txt:1.1-1.5: warning: Error reading "xyzzy" as format F for matrix row +1, column 1: Field contents are not numeric. + +matrix.txt:2.1: warning: Error reading "." as format F for matrix row 2, column +1: Matrix data may not contain missing value. +]) +AT_CLEANUP + +AT_SETUP([MATRIX - WRITE]) +AT_DATA([matrix.sps], [dnl +MATRIX. +WRITE {1.5, 2; 3, 4.12345}/OUTFILE='matrix.txt'/FIELD=1 TO 80. +WRITE {1.5, 2; 3, 4.12345}/OUTFILE='matrix.txt'/FIELD=1 TO 5. +WRITE {1, 2; 3, 4}/OUTFILE='matrix.txt'/FIELD=1 TO 80 BY 5. +WRITE {1, 2; 3, 4}/OUTFILE='matrix.txt'/FIELD=1 TO 80/FORMAT=F8.2. +WRITE {1, 2; 3, 4}/OUTFILE='matrix.txt'/FIELD=1 TO 80/FORMAT=E. +WRITE {1, 2; 3, 4}/OUTFILE='matrix.txt'/FIELD=1 TO 10 BY 10/FORMAT=E. +WRITE "abcdefhi"/OUTFILE='matrix.txt'/FIELD=1 TO 80/FORMAT=A8. +WRITE "abcdefhi"/OUTFILE='matrix.txt'/FIELD=1 TO 80/FORMAT=A4. +WRITE "abcdefhi"/OUTFILE='matrix.txt'/FIELD=1 TO 80/FORMAT=AHEX12. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps]) +AT_CHECK([cat matrix.txt], [0], [dnl + 1.5 2 + 3 4.12345 + 1.5 2 + 3 + 4.12345 + 1 2 + 3 4 + 1.00 2.00 + 3.00 4.00 + 1 2 + 3 4 + 1.E+000 + 2.E+000 + 3.E+000 + 4.E+000 + abcdefhi + abcd + 616263646566 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - WRITE - negative]) +AT_DATA([matrix.sps], [dnl +MATRIX. +WRITE !. +WRITE 1/OUTFILE=!. +WRITE 1/ENCODING=!. +WRITE 1/FIELD=!. +WRITE 1/FIELD=1 !. +WRITE 1/FIELD=1 TO 0. +WRITE 1/FIELD=1 TO 10 BY 20. +WRITE 1/FIELD=1 TO 10 BY 6. +WRITE 1/MODE=TRAPEZOIDAL. +WRITE 1/FORMAT=F5/FORMAT=F5. +WRITE 1/FORMAT='5ASDF'. +WRITE 1/FORMAT=ASDF5. +WRITE 1/!. +WRITE 1. +WRITE 1/FIELD=1 TO 10. +WRITE 1/FIELD=1 TO 10/OUTFILE='matrix.txt'/FORMAT='15F'. +WRITE 1/FIELD=1 TO 10 BY 5/OUTFILE='matrix.txt'/FORMAT='5F'. +WRITE 1/FIELD=1 TO 10 BY 5/OUTFILE='matrix.txt'/FORMAT=E. +WRITE 1/FIELD=1 TO 10/OUTFILE='matrix.txt'/FORMAT=A9. +WRITE {1,2}/FIELD=1 TO 10/OUTFILE='matrix.txt'/MODE=TRIANGULAR. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:2.7: error: WRITE: Syntax error at `!'. + +matrix.sps:3.17: error: WRITE: Syntax error at `!': expecting a file name or +handle name. + +matrix.sps:4.18: error: WRITE: Syntax error at `!': expecting string. + +matrix.sps:5.15: error: WRITE: Syntax error at `!': Expected positive integer +for FIELD. + +matrix.sps:6.17: error: WRITE: Syntax error at `!': expecting `TO'. + +matrix.sps:7.20: error: WRITE: Syntax error at `0': Expected positive integer +for TO. + +matrix.sps:8.26-8.27: error: WRITE: Syntax error at `20': Expected integer +between 1 and 10 for BY. + +matrix.sps:9: error: WRITE: BY 6 does not evenly divide record width 10. + +matrix.sps:10.14-10.24: error: WRITE: Syntax error at `TRAPEZOIDAL': expecting +RECTANGULAR or TRIANGULAR. + +matrix.sps:11: error: WRITE: Subcommand FORMAT may only be specified once. + +matrix.sps:12.16-12.22: error: WRITE: Syntax error at `'5ASDF'': Unknown format +ASDF. + +matrix.sps:13: error: WRITE: Unknown format type `ASDF'. + +matrix.sps:14.9: error: WRITE: Syntax error at `!': expecting OUTFILE, FIELD, +MODE, HOLD, or FORMAT. + +matrix.sps:15: error: WRITE: Required subcommand FIELD was not specified. + +matrix.sps:16: error: WRITE: Required subcommand OUTFILE was not specified. + +matrix.sps:17: error: WRITE: 15 repetitions cannot fit in record width 10. + +matrix.sps:18: error: WRITE: FORMAT specifies 5 repetitions with record width +10, which implies field width 2, but BY specifies field width 5. + +matrix.sps:19: error: WRITE: Output format E5.0 specifies width 5, but E +requires a width between 6 and 40. + +matrix.sps:20: error: WRITE: Format A9 is too wide for 8-byte matrix eleemnts. + +matrix.sps:21.7-21.11: error: MATRIX: WRITE with MODE=TRIANGULAR requires a +square matrix but the matrix to be written has dimensions 1×2. + 21 | WRITE {1,2}/FIELD=1 TO 10/OUTFILE='matrix.txt'/MODE=TRIANGULAR. + | ^~~~~ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - GET]) +AT_DATA([matrix.sps], [dnl +DATA LIST LIST NOTABLE /a b c. +MISSING VALUES a(1) b(5). +BEGIN DATA. +0 0 0 +1 2 3 +4 5 6 +7 8 . +END DATA. + +MATRIX. +GET x0 /NAMES=names0. +PRINT x0. +PRINT names0/FORMAT=A8. +END MATRIX. + +MATRIX. +GET x1 /VARIABLES=a b c /NAMES=names1 /MISSING=OMIT. +PRINT x1. +PRINT names1/FORMAT=A8. +END MATRIX. + +MATRIX. +GET x2 /VARIABLES=a b /NAMES=names2 /MISSING=OMIT. +PRINT x2. +PRINT names2/FORMAT=A8. +END MATRIX. + +MATRIX. +GET x3 /FILE=* /VARIABLES=a b c /NAMES=names3 /MISSING=5. +PRINT x3. +PRINT names3/FORMAT=A8. +END MATRIX. + +MATRIX. +GET x4 /FILE=* /VARIABLES=a b /NAMES=names4 /MISSING=5. +PRINT x4. +PRINT names4/FORMAT=A8. +END MATRIX. + +SAVE OUTFILE='matrix.sav'. +NEW FILE. + +MATRIX. +GET x5 /FILE='matrix.sav' /VARIABLES=a b c /NAMES=names5 /MISSING=ACCEPT. +PRINT x5. +PRINT names5/FORMAT=A8. +END MATRIX. + +MATRIX. +GET x6 /FILE='matrix.sav' /VARIABLES=a b c /NAMES=names6 /MISSING=ACCEPT /SYSMIS=9. +PRINT x6. +PRINT names6/FORMAT=A8. +END MATRIX. + +MATRIX. +GET x7 /FILE='matrix.sav' /VARIABLES=a b c /NAMES=names7 /MISSING=ACCEPT /SYSMIS=OMIT. +PRINT x7. +PRINT names7/FORMAT=A8. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:11: error: MATRIX: Variable a in case 2 has user-missing value 1. + +matrix.sps:12.7-12.8: error: MATRIX: Uninitialized variable x0 used in +expression. + 12 | PRINT x0. + | ^~ + +names0 + a + b + c + +matrix.sps:17: error: MATRIX: Variable c in case 4 is system-missing. + +matrix.sps:18.7-18.8: error: MATRIX: Uninitialized variable x1 used in +expression. + 18 | PRINT x1. + | ^~ + +names1 + a + b + c + +x2 + 0 0 + 7 8 + +names2 + a + b + +matrix.sps:29: error: MATRIX: Variable c in case 4 is system-missing. + +matrix.sps:30.7-30.8: error: MATRIX: Uninitialized variable x3 used in +expression. + 30 | PRINT x3. + | ^~ + +names3 + a + b + c + +x4 + 0 0 + 5 2 + 4 5 + 7 8 + +names4 + a + b + +matrix.sps:44: error: MATRIX: Variable c in case 4 is system-missing. + +matrix.sps:45.7-45.8: error: MATRIX: Uninitialized variable x5 used in +expression. + 45 | PRINT x5. + | ^~ + +names5 + a + b + c + +x6 + 0 0 0 + 1 2 3 + 4 5 6 + 7 8 9 + +names6 + a + b + c + +x7 + 0 0 0 + 1 2 3 + 4 5 6 + +names7 + a + b + c +]) +AT_CLEANUP + +AT_SETUP([MATRIX - GET - negative]) +AT_DATA([matrix.sps], [dnl +DATA LIST LIST NOTABLE /a b c * d(a1). +MISSING VALUES a(1) b(5). +BEGIN DATA. +0 0 0 a +1 2 3 b +4 5 6 b +7 8 . d +END DATA. +SAVE OUTFILE='matrix.sav'. + +MATRIX. +GET !. +GET x/VARIABLES=!. +GET x/FILE=!. +GET x/ENCODING=!. +GET x/NAMES=!. +GET x/MISSING=!. +GET x/SYSMIS=!. +GET x/!. +GET x/VARIABLES=!. +GET x/VARIABLES=x TO !. +GET x/VARIABLES=x. +GET x/VARIABLES=c TO a. +GET x/VARIABLES=d. +GET x. +END MATRIX. + +NEW FILE. +MATRIX. +GET x/VARIABLES=a. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:12.5: error: GET: Syntax error at `!': expecting identifier. + +matrix.sps:13.17: error: GET: Syntax error at `!': expecting variable name. + +matrix.sps:14.12: error: GET: Syntax error at `!': expecting a file name or +handle name. + +matrix.sps:15.16: error: GET: Syntax error at `!': expecting string. + +matrix.sps:16.13: error: GET: Syntax error at `!': expecting identifier. + +matrix.sps:17.15: error: GET: Syntax error at `!'. + +matrix.sps:18.14: error: GET: Syntax error at `!'. + +matrix.sps:19.7: error: GET: Syntax error at `!': expecting FILE, VARIABLES, +NAMES, MISSING, or SYSMIS. + +matrix.sps:20.17: error: GET: Syntax error at `!': expecting variable name. + +matrix.sps:21.22: error: GET: Syntax error at `!': expecting variable name. + +matrix.sps:22: error: MATRIX: x is not a variable name. + +matrix.sps:23: error: MATRIX: c TO a is not valid syntax since c precedes a in +the dictionary. + +matrix.sps:24: warning: MATRIX: d is not a numeric variable. + +matrix.sps:25: error: MATRIX: Variable d is not numeric. + +error: The GET command cannot read an empty active file. +]) +AT_CLEANUP + +AT_SETUP([MATRIX - SAVE]) +AT_DATA([matrix.sps], [dnl +MATRIX. +SAVE {1,2,3; 4,5,6}/OUTFILE='matrix.sav'. +SAVE {7,8,9}/VARIABLES=a b c d. + +SAVE {1,2,3}/OUTFILE='matrix2.sav'/VARIABLES=v01 TO v03. +SAVE {4,5,6}/NAMES={'x', 'y', 'z', 'w'}. + +SAVE {1,'abcd',3}/OUTFILE='matrix3.sav'/NAMES={'a', 'b', 'c'}/STRINGS=b. +SAVE {4,'xyzw',6}/STRINGS=a, b. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps]) +AT_CHECK([pspp-convert matrix.sav matrix.csv && cat matrix.csv], [0], [dnl +COL1,COL2,COL3 +1,2,3 +4,5,6 +7,8,9 +]) +AT_CHECK([pspp-convert matrix2.sav matrix2.csv && cat matrix2.csv], [0], [dnl +v01,v02,v03 +1,2,3 +4,5,6 +]) +AT_CHECK([pspp-convert matrix3.sav matrix3.csv && cat matrix3.csv], [0], [dnl +a,b,c +1,abcd,3 +4,xyzw,6 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - SAVE - inline]) +AT_DATA([matrix.sps], [dnl +MATRIX. +SAVE {1,2,3; 4,5,6}/OUTFILE=*. +SAVE {7,8,9}/VARIABLES=a b c d. +END MATRIX. +LIST. + +MATRIX. +SAVE {1,2,3}/OUTFILE=*/VARIABLES=v01 TO v03. +SAVE {4,5,6}/NAMES={'x', 'y', 'z', 'w'}. +END MATRIX. +LIST. + +MATRIX. +SAVE {1,'abcd',3}/OUTFILE=*/NAMES={'a', 'b', 'c'}/STRINGS=b. +SAVE {4,'xyzw',6}/STRINGS=a, b. +END MATRIX. +LIST. +]) +AT_CHECK([pspp matrix.sps -O format=csv], [0], [dnl +Table: Data List +COL1,COL2,COL3 +1.00,2.00,3.00 +4.00,5.00,6.00 +7.00,8.00,9.00 + +Table: Data List +v01,v02,v03 +1.00,2.00,3.00 +4.00,5.00,6.00 + +Table: Data List +a,b,c +1.00,abcd,3.00 +4.00,xyzw,6.00 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - SAVE - negative]) +AT_DATA([matrix.sps], [dnl +MATRIX. +SAVE !. +SAVE 1/OUTFILE=!. +SAVE 1/VARIABLES=!. +SAVE 1/NAMES=!. +SAVE 1/!. +SAVE 1. +SAVE 1/OUTFILE='matrix.sav'/NAMES={'a'}/VARIABLES=a. +SAVE 1/OUTFILE='matrix2.sav'. +SAVE {1,2}/OUTFILE='matrix2.sav'. +SAVE {1,2}/OUTFILE='matrix3.sav'/NAMES={'a', 'a'}. +SAVE {1,2}/OUTFILE='matrix4.sav'/STRINGS=a. +SAVE {1,2}/OUTFILE='matrix5.sav'/STRINGS=a, b. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:2.6: error: SAVE: Syntax error at `!'. + +matrix.sps:3.16: error: SAVE: Syntax error at `!': expecting a file name or +handle name. + +matrix.sps:4.18: error: SAVE: Syntax error at `!': expecting variable name. + +matrix.sps:5.14: error: SAVE: Syntax error at `!'. + +matrix.sps:6.8: error: SAVE: Syntax error at `!': expecting OUTFILE, VARIABLES, +NAMES, or STRINGS. + +matrix.sps:7: error: SAVE: Required subcommand OUTFILE was not specified. + +matrix.sps:8: warning: SAVE: VARIABLES and NAMES both specified; ignoring +NAMES. + +matrix.sps:10: error: MATRIX: Cannot save 1×2 matrix to `matrix2.sav' because +the first SAVE to `matrix2.sav' in this matrix program wrote a 1-column matrix. + +matrix.sps:9: error: MATRIX: This is the location of the first SAVE to +`matrix2.sav'. + +error: Duplicate variable name a in SAVE statement. + +error: The SAVE command STRINGS subcommand specifies an unknown variable a. + +error: The SAVE command STRINGS subcommand specifies 2 unknown variables, +including a. +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MGET]) +AT_DATA([matrix.sps], [dnl +MATRIX DATA + VARIABLES=ROWTYPE_ var01 TO var08. +BEGIN DATA. +MEAN 24.3 5.4 69.7 20.1 13.4 2.7 27.9 3.7 +SD 5.7 1.5 23.5 5.8 2.8 4.5 5.4 1.5 +N 92 92 92 92 92 92 92 92 +CORR 1.00 +CORR .18 1.00 +CORR -.22 -.17 1.00 +CORR .36 .31 -.14 1.00 +CORR .27 .16 -.12 .22 1.00 +CORR .33 .15 -.17 .24 .21 1.00 +CORR .50 .29 -.20 .32 .12 .38 1.00 +CORR .17 .29 -.05 .20 .27 .20 .04 1.00 +END DATA. + +MATRIX. +MGET. +PRINT MN/FORMAT=F5.1. +PRINT SD/FORMAT=F5.1. +PRINT NC/FORMAT=F5.0. +PRINT CR/FORMAT=F5.2. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps -O format=csv], [0], [dnl +Table: Matrix Variables Created by MGET +,Dimensions, +,Rows,Columns +MN,1,8 +SD,1,8 +NC,1,8 +CR,8,8 + +MN +24.3 5.4 69.7 20.1 13.4 2.7 27.9 3.7 + +SD +5.7 1.5 23.5 5.8 2.8 4.5 5.4 1.5 + +NC +92 92 92 92 92 92 92 92 + +CR +1.00 .18 -.22 .36 .27 .33 .50 .17 +.18 1.00 -.17 .31 .16 .15 .29 .29 +-.22 -.17 1.00 -.14 -.12 -.17 -.20 -.05 +.36 .31 -.14 1.00 .22 .24 .32 .20 +.27 .16 -.12 .22 1.00 .21 .12 .27 +.33 .15 -.17 .24 .21 1.00 .38 .20 +.50 .29 -.20 .32 .12 .38 1.00 .04 +.17 .29 -.05 .20 .27 .20 .04 1.00 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MGET with split variables]) +AT_DATA([matrix.sps], [dnl +matrix data + variables = s1 s2 rowtype_ var01 var02 var03 + /split=s1 s2. + +begin data +8 0 mean 21.4 5.0 72.9 +8 0 sd 6.5 1.6 22.8 +8 0 n 106 106 106 +8 0 corr 1 +8 0 corr .41 1 +8 0 corr -.16 -.22 1 +8 1 mean 11.4 1.0 52.9 +8 1 sd 9.5 8.6 12.8 +8 1 n 10 11 12 +8 1 corr 1 +8 1 corr .51 1 +8 1 corr .36 -.41 1 +end data. + +MATRIX. +MGET. +PRINT MNS1/FORMAT=F5.1. +PRINT SDS1/FORMAT=F5.1. +PRINT NCS1/FORMAT=F5.0. +PRINT CRS1/FORMAT=F5.2. +PRINT MNS2/FORMAT=F5.1. +PRINT SDS2/FORMAT=F5.1. +PRINT NCS2/FORMAT=F5.0. +PRINT CRS2/FORMAT=F5.2. +END MATRIX. +]) +AT_CHECK([pspp -O format=csv matrix.sps], [0], [dnl +Table: Matrix Variables Created by MGET +,Split Values,,Dimensions, +,s1,s2,Rows,Columns +MNS1,8,0,1,3 +SDS1,8,0,1,3 +NCS1,8,0,1,3 +CRS1,8,0,3,3 +MNS2,8,1,1,3 +SDS2,8,1,1,3 +NCS2,8,1,1,3 +CRS2,8,1,3,3 + +MNS1 +21.4 5.0 72.9 + +SDS1 +6.5 1.6 22.8 + +NCS1 +106 106 106 + +CRS1 +1.00 .41 -.16 +.41 1.00 -.22 +-.16 -.22 1.00 + +MNS2 +11.4 1.0 52.9 + +SDS2 +9.5 8.6 12.8 + +NCS2 +10 11 12 + +CRS2 +1.00 .51 .36 +.51 1.00 -.41 +.36 -.41 1.00 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MGET with factor variables]) +AT_DATA([matrix.sps], [dnl +MATRIX DATA + VARIABLES=ROWTYPE_ f1 var01 TO var04 + /FACTOR=f1. +BEGIN DATA. +MEAN 0 34 35 36 37 +SD 0 22 11 55 66 +N 0 99 98 99 92 +MEAN 1 44 45 34 39 +SD 1 23 15 51 46 +N 1 98 34 87 23 +CORR . 1 +CORR . .9 1 +CORR . .8 .6 1 +CORR . .7 .5 .4 1 +END DATA. +FORMATS var01 TO var04(F5.1). +SAVE OUTFILE='matrix.sav'. +]) +AT_DATA([matrix2.sps], [dnl +MATRIX. +MGET FILE='matrix.sav'. +PRINT MNF1/FORMAT=F2.0. +PRINT SDF1/FORMAT=F2.0. +PRINT NCF1/FORMAT=F2.0. +PRINT MNF2/FORMAT=F2.0. +PRINT SDF2/FORMAT=F2.0. +PRINT NCF2/FORMAT=F2.0. +PRINT CR/FORMAT=F3.1. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps]) +AT_CHECK([pspp -O format=csv matrix2.sps], [0], [dnl +Table: Matrix Variables Created by MGET +,Factors,Dimensions, +,f1,Rows,Columns +MNF1,0,1,4 +SDF1,0,1,4 +NCF1,0,1,4 +MNF2,1,1,4 +SDF2,1,1,4 +NCF2,1,1,4 +CR,.,4,4 + +MNF1 +34 35 36 37 + +SDF1 +22 11 55 66 + +NCF1 +99 98 99 92 + +MNF2 +44 45 34 39 + +SDF2 +23 15 51 46 + +NCF2 +98 34 87 23 + +CR +1.0 .9 .8 .7 +.9 1.0 .6 .5 +.8 .6 1.0 .4 +.7 .5 .4 1.0 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MGET with factor and split variables]) +AT_DATA([matrix.sps], [dnl +matrix data + variables = s f rowtype_ var01 var02 var03 + /split=s + /factor=f. + +begin data +8 0 mean 21.4 5.0 72.9 +8 0 sd 6.5 1.6 22.8 +8 0 n 106 106 106 +8 . corr 1 +8 . corr .41 1 +8 . corr -.16 -.22 1 +9 1 mean 11.4 1.0 52.9 +9 1 sd 9.5 8.6 12.8 +9 1 n 10 11 12 +9 . corr 1 +9 . corr .51 1 +9 . corr .36 -.41 1 +end data. + +MATRIX. +MGET. +PRINT MNF1S1/FORMAT=F5.1. +PRINT SDF1S1/FORMAT=F5.1. +PRINT NCF1S1/FORMAT=F5.0. +PRINT CRS1/FORMAT=F5.2. +PRINT MNF1S2/FORMAT=F5.1. +PRINT SDF1S2/FORMAT=F5.1. +PRINT NCF1S2/FORMAT=F5.0. +PRINT CRS2/FORMAT=F5.2. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps -O format=csv], [0], [dnl +Table: Matrix Variables Created by MGET +,Split Values,Factors,Dimensions, +,s,f,Rows,Columns +MNF1S1,8,0,1,3 +SDF1S1,8,0,1,3 +NCF1S1,8,0,1,3 +CRS1,8,.,3,3 +MNF1S2,9,1,1,3 +SDF1S2,9,1,1,3 +NCF1S2,9,1,1,3 +CRS2,9,.,3,3 + +MNF1S1 +21.4 5.0 72.9 + +SDF1S1 +6.5 1.6 22.8 + +NCF1S1 +106 106 106 + +CRS1 +1.00 .41 -.16 +.41 1.00 -.22 +-.16 -.22 1.00 + +MNF1S2 +11.4 1.0 52.9 + +SDF1S2 +9.5 8.6 12.8 + +NCF1S2 +10 11 12 + +CRS2 +1.00 .51 .36 +.51 1.00 -.41 +.36 -.41 1.00 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MGET with TYPE]) +AT_DATA([matrix.sps], [dnl +MATRIX DATA + VARIABLES=ROWTYPE_ f1 var01 TO var04 + /FACTOR=f1. +BEGIN DATA. +MEAN 0 34 35 36 37 +SD 0 22 11 55 66 +N 0 99 98 99 92 +MEAN 1 44 45 34 39 +SD 1 23 15 51 46 +N 1 98 34 87 23 +CORR . 1 +CORR . .9 1 +CORR . .8 .6 1 +CORR . .7 .5 .4 1 +END DATA. +FORMATS var01 TO var04(F5.1). +SAVE OUTFILE='matrix.sav'. +]) +AT_DATA([matrix2.sps], [dnl +MATRIX. +MGET/FILE='matrix.sav'/TYPE=CORR. +PRINT CR/FORMAT=F3.1. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps]) +AT_CHECK([pspp -O format=csv matrix2.sps], [0], [dnl +Table: Matrix Variables Created by MGET +,Factors,Dimensions, +,f1,Rows,Columns +CR,.,4,4 + +CR +1.0 .9 .8 .7 +.9 1.0 .6 .5 +.8 .6 1.0 .4 +.7 .5 .4 1.0 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MGET - negative - parsing]) +AT_DATA([matrix.sps], [dnl +MATRIX. +MGET !. +MGET FILE=!. +MGET ENCODING=!. +MGET TYPE=!. +MGET TYPE=CORR !. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:2.6: error: MGET: Syntax error at `!': expecting FILE or TYPE. + +matrix.sps:3.11: error: MGET: Syntax error at `!': expecting a file name or +handle name. + +matrix.sps:4.15: error: MGET: Syntax error at `!': expecting string. + +matrix.sps:5.11: error: MGET: Syntax error at `!': expecting COV, CORR, MEAN, +STDDEV, N, or COUNT. + +matrix.sps:6.16: error: MGET: Syntax error at `!': expecting COV, CORR, MEAN, +STDDEV, N, or COUNT. +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MGET - missing VARNAME_ and ROWTYPE_]) +AT_DATA([matrix.sps], [dnl +DATA LIST LIST NOTABLE /x. +BEGIN DATA. +1 +END DATA. + +MATRIX. +MGET. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:7: error: MATRIX: Matrix data file lacks ROWTYPE_ variable. + +matrix.sps:7: error: MATRIX: Matrix data file lacks VARNAME_ variable. +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MGET - wrong format for VARNAME_ and ROWTYPE_]) +AT_DATA([matrix.sps], [dnl +DATA LIST LIST NOTABLE /VARNAME_ * ROWTYPE_ (A7). +BEGIN DATA. +1 asdf +END DATA. + +MATRIX. +MGET. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:7: error: MATRIX: ROWTYPE_ variable in matrix data file must be 8- +byte string, but it has width 7. + +matrix.sps:7: error: MATRIX: VARNAME_ variable in matrix data file must be 8- +byte string, but it has width 0. +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MGET - wrong order for VARNAME_ and ROWTYPE_]) +AT_DATA([matrix.sps], [dnl +DATA LIST LIST NOTABLE /VARNAME_ ROWTYPE_ (A8). +BEGIN DATA. +asdf jkl; +END DATA. + +MATRIX. +MGET. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:7: error: MATRIX: ROWTYPE_ must precede VARNAME_ in matrix data +file. +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MGET - no continuous variables]) +AT_DATA([matrix.sps], [dnl +DATA LIST LIST NOTABLE /ROWTYPE_ VARNAME_ (A8). +BEGIN DATA. +asdf jkl; +END DATA. + +MATRIX. +MGET. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:7: error: MATRIX: Matrix data file contains no continuous variables. +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MGET - unexpected string variables]) +AT_DATA([matrix.sps], [dnl +DATA LIST LIST NOTABLE /ROWTYPE_ VARNAME_ cvar1 (A8). +BEGIN DATA. +asdf jkl; zxcv +END DATA. + +MATRIX. +MGET. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:7: error: MATRIX: Matrix data file contains unexpected string +variable cvar1. +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MGET - unknown ROWTYPE_]) +AT_DATA([matrix.sps], [dnl +DATA LIST LIST NOTABLE /ROWTYPE_ VARNAME_ (A8) cvar1. +BEGIN DATA. +asdf jkl; 1 +END DATA. + +MATRIX. +MGET. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps -O format=csv], [1], [dnl +"matrix.sps:7: error: MATRIX: Matrix data file contains unknown ROWTYPE_ ""asdf""." +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MGET - duplicate matrix variable name]) +AT_DATA([matrix.sps], [dnl +DATA LIST LIST NOTABLE /ROWTYPE_ VARNAME_ (A8) cvar1. +BEGIN DATA. +corr jkl; 1 +END DATA. + +MATRIX. +MGET. +MGET. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps -O format=csv], [0], [dnl +Table: Matrix Variables Created by MGET +,Dimensions, +,Rows,Columns +CR,1,1 + +matrix.sps:8: warning: MATRIX: Matrix data file contains variable with existing name CR. +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MGET - missing values in input]) +AT_DATA([matrix.sps], [dnl +DATA LIST LIST NOTABLE /s1 * ROWTYPE_ VARNAME_ (A8) cvar1 cvar2. +BEGIN DATA. +1 n "" 1 . +2 n "" . . +END DATA. + +MATRIX. +MGET. +PRINT ncs1/FORMAT=F5. +PRINT ncs2/FORMAT=F5. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps -O format=csv], [1], [dnl +"matrix.sps:8: error: MATRIX: Matrix data file variable NCS1 contains a missing value, which was treated as zero." + +"matrix.sps:8: error: MATRIX: Matrix data file variable NCS2 contains 2 missing values, which were treated as zero." + +Table: Matrix Variables Created by MGET +,Split Values,Dimensions, +,s1,Rows,Columns +NCS1,1.00,1,2 +NCS2,2.00,1,2 + +ncs1 +1 0 + +ncs2 +0 0 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MSAVE]) +AT_DATA([matrix.sps], [dnl +MATRIX. +MSAVE {1, 2; 3, 4}/TYPE=CORR/VARIABLES=X,Y/OUTFILE='matrix.sav'. +MSAVE {5, 6; 7, 8; 9, 10}/TYPE=COV/VARIABLES=X,Y. +MSAVE {11, 12}/TYPE=MEAN. +MSAVE {13, 14}/TYPE=STDDEV. +MSAVE {15, 16}/TYPE=N. +MSAVE {17, 18}/TYPE=COUNT. +END MATRIX. +GET 'matrix.sav'. +LIST. +]) +AT_CHECK([pspp matrix.sps -O format=csv], [0], [dnl +Table: Data List +ROWTYPE_,VARNAME_,X,Y +CORR,X,1.00,2.00 +CORR,Y,3.00,4.00 +COV,X,5.00,6.00 +COV,Y,7.00,8.00 +COV,,9.00,10.00 +MEAN,,11.00,12.00 +STDDEV,,13.00,14.00 +N,,15.00,16.00 +COUNT,,17.00,18.00 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MSAVE with factor variables]) +AT_DATA([matrix.sps], [dnl +MATRIX. +MSAVE {1, 2; 3, 4}/TYPE=CORR/FACTOR={1,1}/FNAMES=X,Y/OUTFILE='matrix.sav'. +MSAVE {5, 6; 7, 8; 9, 10}/TYPE=COV. +MSAVE {11, 12}/TYPE=MEAN. +MSAVE {13, 14}/FACTOR={2,1}/TYPE=STDDEV. +MSAVE {15, 16}/TYPE=N. +MSAVE {17, 18}/FACTOR={1,2}/TYPE=COUNT. +END MATRIX. +GET 'matrix.sav'. +LIST. + +MATRIX. +MSAVE {1, 2; 3, 4}/TYPE=CORR/FACTOR={5,6,7,8}/OUTFILE='matrix2.sav'. +END MATRIX. +GET 'matrix2.sav'. +LIST. +]) +AT_CHECK([pspp matrix.sps -O format=csv], [0], [dnl +Table: Data List +ROWTYPE_,X,Y,VARNAME_,COL1,COL2 +CORR,1.00,1.00,COL1,1.00,2.00 +CORR,1.00,1.00,COL2,3.00,4.00 +COV,1.00,1.00,COL1,5.00,6.00 +COV,1.00,1.00,COL2,7.00,8.00 +COV,1.00,1.00,,9.00,10.00 +MEAN,1.00,1.00,,11.00,12.00 +STDDEV,2.00,1.00,,13.00,14.00 +N,2.00,1.00,,15.00,16.00 +COUNT,1.00,2.00,,17.00,18.00 + +Table: Data List +ROWTYPE_,FAC1,FAC2,FAC3,FAC4,VARNAME_,COL1,COL2 +CORR,5.00,6.00,7.00,8.00,COL1,1.00,2.00 +CORR,5.00,6.00,7.00,8.00,COL2,3.00,4.00 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MSAVE with split variables]) +AT_DATA([matrix.sps], [dnl +MATRIX. +MSAVE {1, 2; 3, 4}/TYPE=CORR/SPLIT={1,1}/SNAMES=X,Y/OUTFILE='matrix.sav'. +MSAVE {5, 6; 7, 8; 9, 10}/TYPE=COV. +MSAVE {11, 12}/TYPE=MEAN. +MSAVE {13, 14}/SPLIT={2,1}/TYPE=STDDEV. +MSAVE {15, 16}/TYPE=N. +MSAVE {17, 18}/SPLIT={1,2}/TYPE=COUNT. +END MATRIX. +GET 'matrix.sav'. +LIST. + +MATRIX. +MSAVE {1, 2; 3, 4}/TYPE=CORR/SPLIT={5,6,7,8}/OUTFILE='matrix2.sav'. +END MATRIX. +GET 'matrix2.sav'. +LIST. +]) +AT_CHECK([pspp matrix.sps -O format=csv], [0], [dnl +Table: Data List +X,Y,ROWTYPE_,VARNAME_,COL1,COL2 +1.00,1.00,CORR,COL1,1.00,2.00 +1.00,1.00,CORR,COL2,3.00,4.00 +1.00,1.00,COV,COL1,5.00,6.00 +1.00,1.00,COV,COL2,7.00,8.00 +1.00,1.00,COV,,9.00,10.00 +1.00,1.00,MEAN,,11.00,12.00 +2.00,1.00,STDDEV,,13.00,14.00 +2.00,1.00,N,,15.00,16.00 +1.00,2.00,COUNT,,17.00,18.00 + +Table: Data List +SPL1,SPL2,SPL3,SPL4,ROWTYPE_,VARNAME_,COL1,COL2 +5.00,6.00,7.00,8.00,CORR,COL1,1.00,2.00 +5.00,6.00,7.00,8.00,CORR,COL2,3.00,4.00 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MSAVE with factor and split variables]) +AT_DATA([matrix.sps], [dnl +MATRIX. +MSAVE {1, 2; 3, 4}/TYPE=CORR/SPLIT=1/FACTOR=1/OUTFILE='matrix.sav'. +MSAVE {5, 6; 7, 8; 9, 10}/TYPE=COV. +MSAVE {11, 12}/FACTOR=2/TYPE=MEAN. +MSAVE {13, 14}/FACTOR=1/SPLIT=2/TYPE=STDDEV. +MSAVE {15, 16}/TYPE=N. +MSAVE {17, 18}/FACTOR=2/TYPE=COUNT. +END MATRIX. +GET 'matrix.sav'. +LIST. +]) +AT_CHECK([pspp matrix.sps -O format=csv], [0], [dnl +Table: Data List +SPL1,ROWTYPE_,FAC1,VARNAME_,COL1,COL2 +1.00,CORR,1.00,COL1,1.00,2.00 +1.00,CORR,1.00,COL2,3.00,4.00 +1.00,COV,1.00,COL1,5.00,6.00 +1.00,COV,1.00,COL2,7.00,8.00 +1.00,COV,1.00,,9.00,10.00 +1.00,MEAN,2.00,,11.00,12.00 +2.00,STDDEV,1.00,,13.00,14.00 +2.00,N,1.00,,15.00,16.00 +2.00,COUNT,2.00,,17.00,18.00 +]) +AT_CLEANUP + +AT_SETUP([MATRIX - MSAVE - negative]) +AT_DATA([matrix.sps], [dnl +MATRIX. +MSAVE !. +MSAVE 1/TYPE=!. +MSAVE 1/OUTFILE=!. +MSAVE 1/VARIABLES=!. +MSAVE 1/FNAMES=!. +MSAVE 1/SNAMES=!. +MSAVE 1/SPLIT=!. +MSAVE 1/FACTOR=!. +MSAVE 1/!. +MSAVE 1. +MSAVE 1/TYPE=COV/FNAMES=x. +MSAVE 1/TYPE=COV/SNAMES=x. +MSAVE 1/TYPE=COV. + +MSAVE 1/TYPE=COV/OUTFILE='matrix.sav' + /FACTOR=1 /FNAMES=y + /SPLIT=2 /SNAMES=z + /VARIABLES=w. +MSAVE 1/TYPE=COV/OUTFILE='matrix2.sav'. +MSAVE 1/TYPE=COV/VARIABLES=x. +MSAVE 1/TYPE=COV/FNAMES=x. +MSAVE 1/TYPE=COV/SNAMES=x. +END MATRIX. + +MATRIX. +MSAVE 1/TYPE=COV/VARIABLES=x/OUTFILE='matrix3.sav'/FACTOR=1/SPLIT=2. +MSAVE {1,2}/TYPE=COV/VARIABLES=x/OUTFILE='matrix3.sav'/FACTOR=1/SPLIT=2. +MSAVE {1,2;3}/TYPE=COV. +MSAVE 0/TYPE=COV/FACTOR={1,2}. +MSAVE 0/TYPE=COV/FACTOR=1/SPLIT={1;2}. +END MATRIX. + +MATRIX. +MSAVE 1/TYPE=COV/OUTFILE='matrix4.sav'/SNAMES=x,x/SPLIT=1. +END MATRIX. + +MATRIX. +MSAVE 1/TYPE=COV/OUTFILE='matrix5.sav'/SNAMES=x/FNAMES=x/SPLIT=1/FACTOR=1. +END MATRIX. + +MATRIX. +MSAVE 1/TYPE=COV/OUTFILE='matrix6.sav'/VARIABLES=x/FNAMES=x/FACTOR=1. +END MATRIX. + +MATRIX. +MSAVE 1/TYPE=COV/OUTFILE='matrix6.sav'/VARIABLES=x/SNAMES=x/SPLIT=1. +END MATRIX. + +MATRIX. +MSAVE 1/TYPE=COV/OUTFILE='matrix7.sav'/SNAMES=VARNAME_. +MSAVE 1/TYPE=COV/OUTFILE='matrix7.sav'/SNAMES=ROWTYPE_. +MSAVE 1/TYPE=COV/OUTFILE='matrix7.sav'/FNAMES=VARNAME_. +MSAVE 1/TYPE=COV/OUTFILE='matrix7.sav'/FNAMES=ROWTYPE_. +MSAVE 1/TYPE=COV/OUTFILE='matrix7.sav'/VARIABLES=VARNAME_. +MSAVE 1/TYPE=COV/OUTFILE='matrix7.sav'/VARIABLES=ROWTYPE_. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:2.7: error: MSAVE: Syntax error at `!'. + +matrix.sps:3.14: error: MSAVE: Syntax error at `!': expecting COV, CORR, MEAN, +STDDEV, N, or COUNT. + +matrix.sps:4.17: error: MSAVE: Syntax error at `!': expecting a file name or +handle name. + +matrix.sps:5.19: error: MSAVE: Syntax error at `!': expecting variable name. + +matrix.sps:6.16: error: MSAVE: Syntax error at `!': expecting variable name. + +matrix.sps:7.16: error: MSAVE: Syntax error at `!': expecting variable name. + +matrix.sps:8.15: error: MSAVE: Syntax error at `!'. + +matrix.sps:9.16: error: MSAVE: Syntax error at `!'. + +matrix.sps:10.9: error: MSAVE: Syntax error at `!': expecting TYPE, OUTFILE, +VARIABLES, FNAMES, SNAMES, SPLIT, or FACTOR. + +matrix.sps:11: error: MSAVE: Required subcommand TYPE was not specified. + +matrix.sps:12: error: MSAVE: FNAMES requires FACTOR. + +matrix.sps:13: error: MSAVE: SNAMES requires SPLIT. + +matrix.sps:14: error: MSAVE: Required subcommand OUTFILE was not specified. + +matrix.sps:20: error: MSAVE: OUTFILE must name the same file on each MSAVE +within a single MATRIX command. + +matrix.sps:21: error: MSAVE: VARIABLES must specify the same variables each +time within a given MATRIX. + +matrix.sps:16-19: note: MSAVE: This is the location of the first MSAVE command. + +matrix.sps:22: error: MSAVE: FNAMES must specify the same variables each time +within a given MATRIX. + +matrix.sps:16-19: note: MSAVE: This is the location of the first MSAVE command. + +matrix.sps:23: error: MSAVE: SNAMES must specify the same variables each time +within a given MATRIX. + +matrix.sps:16-19: note: MSAVE: This is the location of the first MSAVE command. + +matrix.sps:28.7-28.11: error: MATRIX: Matrix on MSAVE has 2 columns but there +are 1 variables. + 28 | MSAVE {1,2}/TYPE=COV/VARIABLES=x/OUTFILE='matrix3.sav'/FACTOR=1/ +SPLIT=2. + | ^~~~~ + +matrix.sps:29.7-29.13: error: MATRIX: This expression tries to vertically join +matrices with differing numbers of columns. + 29 | MSAVE {1,2;3}/TYPE=COV. + | ^~~~~~~ + +matrix.sps:29.8-29.10: note: MATRIX: This operand is a 1×2 matrix. + 29 | MSAVE {1,2;3}/TYPE=COV. + | ^~~ + +matrix.sps:29.12: note: MATRIX: This operand is a 1×1 matrix. + 29 | MSAVE {1,2;3}/TYPE=COV. + | ^ + +matrix.sps:30.25-30.29: error: MATRIX: There are 1 factor variables, but 2 +factor values were supplied. + 30 | MSAVE 0/TYPE=COV/FACTOR={1,2}. + | ^~~~~ + +matrix.sps:31.33-31.37: error: MATRIX: There are 1 split variables, but 2 split +values were supplied. + 31 | MSAVE 0/TYPE=COV/FACTOR=1/SPLIT={1;2}. + | ^~~~~ + +matrix.sps:35: error: MSAVE: Variable x appears twice in variable list. + +matrix.sps:39: error: MATRIX: Duplicate or invalid FACTOR variable name x. + +matrix.sps:43: error: MATRIX: Duplicate or invalid variable name x. + +matrix.sps:47: error: MATRIX: Duplicate or invalid variable name x. + +matrix.sps:51: error: MSAVE: Variable name VARNAME_ is reserved. + +matrix.sps:52: error: MSAVE: Variable name ROWTYPE_ is reserved. + +matrix.sps:53: error: MSAVE: Variable name VARNAME_ is reserved. + +matrix.sps:54: error: MSAVE: Variable name ROWTYPE_ is reserved. + +matrix.sps:55: error: MSAVE: Variable name VARNAME_ is reserved. + +matrix.sps:56: error: MSAVE: Variable name ROWTYPE_ is reserved. +]) +AT_CLEANUP + +AT_SETUP([MATRIX - DISPLAY]) +AT_DATA([matrix-template.sps], [dnl +MATRIX. +COMPUTE a={1,2,3}. +COMPUTE b={1;2;3}. +COMPUTE c={T(b),a}. +COMPUTE d={T(a),b}. +command. +END MATRIX. +]) +for command in 'DISPLAY' 'DISPLAY DICTIONARY' 'DISPLAY STATUS'; do + sed "s/command/$command/" < matrix-template.sps > matrix.sps + AT_CHECK([pspp matrix.sps -O format=csv], [0], [dnl +Table: Matrix Variables +,Dimension,,Size (kB) +,Rows,Columns, +a,1,3,0 +b,3,1,0 +c,1,6,0 +d,3,2,0 +]) +done +AT_CLEANUP + +AT_SETUP([MATRIX - DISPLAY - negative]) +AT_DATA([matrix.sps], [dnl +MATRIX. +DISPLAY !. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:2.9: error: DISPLAY: Syntax error at `!': expecting DICTIONARY or +STATUS. +]) +AT_CLEANUP + +AT_SETUP([MATRIX - RELEASE]) +AT_DATA([matrix.sps], [dnl +MATRIX. +COMPUTE x=1. +PRINT x. +RELEASE X. +PRINT x. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +x + 1 + +matrix.sps:5.7: error: MATRIX: Uninitialized variable x used in expression. + 5 | PRINT x. + | ^ +]) +AT_CLEANUP + +AT_SETUP([MATRIX - RELEASE - negative]) +AT_DATA([matrix.sps], [dnl +MATRIX. +RELEASE !. +RELEASE x. +COMPUTE x=1. +RELEASE x, !. +COMPUTE x=1. +RELEASE x y. +COMPUTE x=1. +RELEASE x. +RELEASE x. +END MATRIX. +]) +AT_CHECK([pspp matrix.sps], [1], [dnl +matrix.sps:2.9: error: RELEASE: Syntax error at `!': expecting end of command. + +matrix.sps:3.9: error: RELEASE: Syntax error at `x': Variable name expected. + +matrix.sps:5.12: error: RELEASE: Syntax error at `!': expecting end of command. + +matrix.sps:7.11: error: RELEASE: Syntax error at `y': expecting end of command. +]) +AT_CLEANUP \ No newline at end of file