# This function generates random matrices with given characteristics.
surprise = function (rows; cols; type; density; symmetry; other)
{
local (rt; n; nt; ns; no; nc; i; combos; spec; A; d);
rt = "run time error: ";
# Set defaults.
if (rows == NULL) { rows = 0; }
if (cols == NULL) { cols = 0; }
if (type == NULL) { type = "real"; }
if (density == NULL) { density = 1; }
if (symmetry == NULL) { symmetry = "general"; }
if (other == NULL) { other = "none"; }
# All are vectors.
rows = vector (integer (rows));
cols = vector (integer (cols));
type = vector (type);
density = vector (density);
symmetry = vector (symmetry);
other = vector (other);
# Check legality.
if (rows < 0)
{
message (rt + "Row dimension is negative.")
exception ();
}
if (cols < 0)
{
message (rt + "Column dimension is negative.")
exception ();
}
if (complement ("integer", "real", "complex"; type))
{
message (rt + "Invalid type.");
exception ();
}
if (density.type == "character")
{
message (rt + "Density argument must be numeric.");
exception ();
}
if (density < 0 || density > 1)
{
message (rt + "Invalid density.");
exception ();
}
if (complement ("general", "symmetric", "hermitian"; symmetry))
{
message (rt + "Invalid symmetry.");
exception ();
}
if (complement ("none", "diagonal", "positive_definite"; other))
{
message (rt + "Invalid \"other\" matrix characteristic.");
exception ();
}
# Square precluded?
if ((symmetry == "symmetric" || symmetry == "hermitian") &&
!intersection (rows; cols).ne)
{
symmetry = symmetry [lose ("symmetric","hermitian"; symmetry)];
other = other [lose ("diagonal","positive_definite"; other)];
}
# Generate matrix combinations.
nt = type.ne;
ns = symmetry.ne;
no = other.ne;
n = nt * ns * no;
type = fill (n; fill (ns*no,nt; type) ');
symmetry = fill (n; btrans (fill (nt*no,ns; symmetry); nt; 1) ');
other = fill (n; other);
combos = type + "," + symmetry + "," + other;
combos = combos [lose (self.disallowed; combos)];
# No legal combinations?
if (!combos.ne)
{
message (rt + "No allowable matrix characteristics given.");
exception ();
}
# Now just pick one.
spec = split (select (combos); ",");
type = spec [1];
symmetry = spec [2];
other = spec [3];
# Pick dimensions.
if (symmetry == ("symmetric", "hermitian"))
{
rows = cols = select (intersection (rows; cols));
else
rows = select (rows);
cols = select (cols);
}
# Pick density.
density = select (density);
# Finally, assemble the matrix.
if (symmetry == "general")
{
A = surprise.fill (rows; cols; type; density);
elseif (symmetry == "symmetric")
if (other == "diagonal")
{
A = diag (vector (surprise.fill (1; cols; type; density)));
else
A = symmetric (surprise.fill (rows; cols; type; density/2));
if (A.density == "sparse") { A = sparse (A); }
if (other == "positive_definite")
{
d = diag (A);
A += diag (1 + sum (abs (A)) - abs (d));
}
if (type == "integer") { A = integer (A); }
}
else # symmetry == "hermitian"
if (other == "diagonal")
{
A = hermitian (diag (vector (surprise.fill (1;cols;type;density))));
else
A = hermitian (surprise.fill (rows; cols; type; density/2));
if (A.density == "sparse") { A = sparse (A); }
if (other == "positive_definite")
{
d = diag (A);
A += diag (1 + sum (abs (A)) - abs (d));
}
}
}
return A;
};
surprise.disallowed = (
"integer,general,diagonal",
"integer,general,positive_definite",
"integer,hermitian,none",
"integer,hermitian,diagonal",
"integer,hermitian,positive_definite",
"real,general,diagonal",
"real,general,positive_definite",
"real,hermitian,none",
"real,hermitian,diagonal",
"real,hermitian,positive_definite",
"complex,general,diagonal",
"complex,general,positive_definite",
"complex,symmetric,positive_definite");
surprise.fill = function (nr; nc; type; density)
{
local (c; x; n; nn; N);
if (density == 1.0) { return surprise.rand (nr,nc; type); }
N = real(nr) * nc;
n = integer (N*density);
if (density < 0.5)
{
c = fill (0; 0);
while (1)
{
c = set (c, integer (floor (rand ((n-c.ne)*1.2) * N)) + 1);
if (c.ne >= n) { break; }
}
c = c [seq (n)];
else
nn = N - n;
c = fill (0; 0);
while (1)
{
c = set (c, integer (floor (rand ((nn-c.ne)*1.2) * N)) + 1);
if (c.ne >= nn) { break; }
}
c = c [seq (nn)];
c = lose (c; seq (N));
}
x = mksparse ({shape = 1,N;
rows = fill (n; 1);
cols = c;
values = surprise.rand (n; type)});
return cram (nr,nc; x);
};
surprise.rand = function (shape; type)
{
if (type == "integer")
{
return integer (floor ((rand (shape) * 2.0 - 1.0) * product (shape)));
elseif (type == "real")
return rand (shape) * 2.0 - 1.0;
else
return rand (shape) * 2 - 1 + sqrt(-1) * (rand (shape) * 2 - 1);
}
};
syntax highlighted by Code2HTML, v. 0.9.1