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.
--- /dev/null
+/* 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 <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#include <gsl/gsl_blas.h>
+#include <gsl/gsl_cdf.h>
+#include <gsl/gsl_eigen.h>
+#include <gsl/gsl_linalg.h>
+#include <gsl/gsl_matrix.h>
+#include <gsl/gsl_permutation.h>
+#include <gsl/gsl_randist.h>
+#include <gsl/gsl_vector.h>
+#include <limits.h>
+#include <math.h>
+#include <uniwidth.h>
+
+#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;
+}
+\f
+/* 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".
+
+ - "a<b", "a>b", "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
+\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;
+}
+\f
+/* 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 <charl@itfromb.it>
+ 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;
+}
+\f
+/* 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);
+}
+\f
+/* 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 *);
+\f
+/* 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));
+}
+\f
+/* 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);
+ }
+}
+\f
+/* 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;
+}
+\f
+/* 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;
+ }
+ }
+}
+\f
+/* 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;
+}
+\f
+/* 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);
+}
+\f
+/* 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;
+ }
+}
+\f
+/* 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);
+}
+\f
+/* 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);
+}
+\f
+/* 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);
+}
+\f
+/* 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);
+ }
+}
+\f
+/* 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);
+}
+\f
+/* 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);
+ }
+}
+\f
+/* 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;
+}
+\f
+/* 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);
+}
+\f
+/* 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);
+ }
+}
+\f
+/* 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;
+}
--- /dev/null
+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
projects / pspp / commitdiff