int luaC_lunum_zeros(lua_State *L)
{
if (lua_isnumber(L, 1)) {
const int N = luaL_checkinteger(L, 1);
const enum ArrayType T = (enum ArrayType) luaL_optinteger(L, 2, ARRAY_TYPE_DOUBLE);
struct Array A = array_new_zeros(N, T);
lunum_pusharray1(L, &A);
return 1;
}
else if (lua_istable(L, 1) || lunum_hasmetatable(L, 1, "array")) {
int Nd;
int *N = (int*) lunum_checkarray2(L, 1, ARRAY_TYPE_INT, &Nd);
const enum ArrayType T = (enum ArrayType) luaL_optinteger(L, 2, ARRAY_TYPE_DOUBLE);
int ntot = 1;
for (int d=0; d<Nd; ++d) ntot *= N[d];
struct Array A = array_new_zeros(ntot, T);
array_resize(&A, N, Nd);
lunum_pusharray1(L, &A);
return 1;
}
else {
luaL_error(L, "argument must be either number, table, or array");
return 0;
}
}
static int luaC_lunum_zeros(lua_State *L)
{
if (lua_isnumber(L, 1)) {
const lua_Integer N = luaL_checkinteger(L, 1);
if (N <= 0) { return luaL_error(L, "Invalid size %d", N); }
const ArrayType T = (ArrayType) luaL_optinteger(L, 2, ARRAY_TYPE_DOUBLE);
Array A = array_new_zeros(N, T);
lunum_pusharray1(L, &A);
return 1;
}
else if (lua_istable(L, 1) || lunum_hasmetatable(L, 1, "array")) {
size_t Nd_t;
size_t *N = (size_t*) lunum_checkarray2(L, 1, ARRAY_TYPE_SIZE_T, &Nd_t);
int Nd = (int)Nd_t;
const ArrayType T = (ArrayType) luaL_optinteger(L, 2, ARRAY_TYPE_DOUBLE);
size_t ntot = 1;
for (int d=0; d<Nd; ++d) ntot *= N[d];
Array A = array_new_zeros(ntot, T);
array_resize_t(&A, N, Nd);
lunum_pusharray1(L, &A);
return 1;
}
else {
return luaL_error(L, "argument must be either number, table, or array");
}
}
static int _array_array_binary_op(lua_State *L, ArrayBinaryOperation op)
{
const Array *A = lunum_checkarray1(L, 1);
const Array *B = lunum_checkarray1(L, 2);
/* check size and dimensions */
if (A->ndims != B->ndims) {
return luaL_error(L, "arrays have different dimensions");
}
for (int d=0; d<A->ndims; ++d) {
if (A->shape[d] != B->shape[d]) {
return luaL_error(L, "arrays shapes do not agree");
}
}
const ArrayType T = (A->dtype >= B->dtype) ? A->dtype : B->dtype;
Array C = array_new_zeros(A->size, T);
array_resize_t(&C, A->shape, A->ndims);
lunum_pusharray1(L, &C);
array_array_binary_op(L, A, B, &C, op);
return 1;
}
struct Array array_new_from_mask(const struct Array *B1, struct Array *M)
// -----------------------------------------------------------------------------
// Extracts the indices of B1 for which M is true, and returns a 1d-array
// -----------------------------------------------------------------------------
// @M : Array of bool's, must have the same size as B1
// -----------------------------------------------------------------------------
{
int sizeof_T = array_sizeof(B1->dtype);
char *b0 = (char*) malloc(sizeof_T);
char *b1 = (char*) B1->data;
int m = 0;
for (int n=0; n<B1->size; ++n) {
if (((Bool*)M->data)[n]) {
b0 = (char*) realloc(b0, (++m)*sizeof(double));
memcpy(b0 + (m-1)*sizeof_T, b1 + n*sizeof_T, sizeof_T);
}
}
struct Array B0 = array_new_zeros(m, B1->dtype);
memcpy(B0.data, b0, m*sizeof_T);
free(b0);
return B0;
}
static int luaC_lunum_fromfile(lua_State *L)
// -----------------------------------------------------------------------------
// Opens the binary file 'fname' for reading, and returns a 1d array from the
// data. The file size must be a multiple of the data type 'T'.
// -----------------------------------------------------------------------------
{
const char *fname = luaL_checkstring(L, 1);
const ArrayType T = luaL_optinteger(L, 2, ARRAY_TYPE_DOUBLE);
const int sizeof_T = array_sizeof(T);
FILE *input = fopen(fname, "rb");
if (input == NULL) {
return luaL_error(L, "no such file %s", fname);
}
fseek(input, 0L, SEEK_END); const size_t sz = ftell(input);
fseek(input, 0L, SEEK_SET);
if (sz % sizeof_T != 0) {
return luaL_error(L, "file size must be a multiple of the data type size");
}
const size_t N = sz / sizeof_T;
Array A = array_new_zeros(N, T);
if (fread(A.data, N, sizeof_T, input) != sizeof_T) {
fclose(input);
return luaL_error(L, "Error while reading file %s", fname);
}
fclose(input);
lunum_pusharray1(L, &A);
return 1;
}
struct Array array_new_copy(const struct Array *B, enum ArrayType T)
{
struct Array A = array_new_zeros(B->size, T);
array_resize(&A, B->shape, B->ndims);
array_assign_from_array(&A, B);
return A;
}
int luaC_lunum_range(lua_State *L)
{
const int N = luaL_checkinteger(L, 1);
struct Array A = array_new_zeros(N, ARRAY_TYPE_INT);
lunum_pusharray1(L, &A);
for (int i=0; i<N; ++i) {
((int*)A.data)[i] = i;
}
return 1;
}
static int luaC_lunum_range(lua_State *L)
{
const lua_Integer N = luaL_checkinteger(L, 1);
if (N <= 0) { return luaL_error(L, "Invalid size %d", N); }
if (N <= INT_MAX) {
Array A = array_new_zeros(N, ARRAY_TYPE_INT);
lunum_pusharray1(L, &A);
for (size_t i=0; i<N; ++i) {
((int*)A.data)[i] = i;
}
} else {
Array A = array_new_zeros(N, ARRAY_TYPE_LONG);
lunum_pusharray1(L, &A);
for (size_t i=0; i<N; ++i) {
((long*)A.data)[i] = i;
}
}
return 1;
}
int test_astable(lua_State *L)
{
size_t N = 100;
Array A = array_new_zeros(N, ARRAY_TYPE_DOUBLE);
lunum_pusharray1(L, &A);
lunum_astable(L, -1);
lua_replace(L, -2);
return 1;
}
static int luaC_lunum_transpose(lua_State *L)
{
const Array *A = lunum_checkarray1(L, 1); // the array to transpose
/* copy transposed shape and size to B */
Array B = array_new_zeros(A->size, A->dtype);
array_resize_t(&B, A->shape, A->ndims);
array_transpose(A, &B);
lunum_pusharray1(L, &B);
return 1;
}
static int _array_unary_op(lua_State *L, ArrayUnaryOperation op)
{
Array *A = lunum_checkarray1(L, 1);
const size_t N = A->size;
ArrayType T = A->dtype;
Array B = array_new_zeros(N, T);
array_resize_t(&B, A->shape, A->ndims);
lunum_pusharray1(L, &B);
array_unary_op(L, A, &B, op);
return 1;
}
static int luaC_lunum_linear(lua_State *L)
{
const lua_Number e1 = luaL_checknumber(L, 1);
const lua_Number e2 = luaL_checknumber(L, 2);
const lua_Integer N = luaL_checkinteger(L, 3);
if (N <= 1) { return luaL_error(L, "Invalid size %d", N); }
const ArrayType T = (ArrayType) luaL_optinteger(L, 4, ARRAY_TYPE_DOUBLE);
Array A = array_new_zeros(N, T);
void *a = A.data;
ARRAY_ASSIGN_OP(T, EXPR_ASSIGN_LINEAR);
lunum_pusharray1(L, &A);
return 1;
}
int _array_binary_op2(lua_State *L, enum ArrayOperation op)
{
struct Array *A = lunum_checkarray1(L, 1);
struct Array *B = lunum_checkarray1(L, 2);
if (A->ndims != B->ndims) {
luaL_error(L, "arrays have different dimensions");
}
for (int d=0; d<A->ndims; ++d) {
if (A->shape[d] != B->shape[d]) {
luaL_error(L, "arrays shapes do not agree");
}
}
const int N = A->size;
enum ArrayType T = (A->dtype >= B->dtype) ? A->dtype : B->dtype;
struct Array A_ = (A->dtype == T) ? *A : array_new_copy(A, T);
struct Array B_ = (B->dtype == T) ? *B : array_new_copy(B, T);
struct Array C = array_new_zeros(N, T);
array_resize(&C, A->shape, A->ndims);
lunum_pusharray1(L, &C);
array_binary_op(&A_, &B_, &C, op);
luaL_getmetatable(L, "array");
lua_setmetatable(L, -2);
if (A->dtype != T) array_del(&A_);
if (B->dtype != T) array_del(&B_);
return 1;
}
struct Array array_new_from_slice(const struct Array *B1,
int *start, int *stop, int *skip, int Nd)
// -----------------------------------------------------------------------------
// Extracts a slice from B1, and returns it as the contiguous array 'B0'
// -----------------------------------------------------------------------------
// @start : starting indices into B1
// @stop : upper bound on selection (non-inclusive)
// @skip : distance between entries of B1 along each axis
// @Nd : the number of axes in each array
// -----------------------------------------------------------------------------
{
int *J = (int*) malloc(Nd*sizeof(int)); // current indices into B1
int *N = (int*) malloc(Nd*sizeof(int)); // number of elements to select
int *S = (int*) malloc(Nd*sizeof(int)); // strides (in memory) along each axis
int ntot = 1;
for (int d=0; d<Nd; ++d) {
J[d] = 0;
N[d] = 1 + (stop[d] - start[d] - 1) / skip[d];
ntot *= N[d];
}
S[Nd-1] = 1;
for (int d=Nd-2; d>=0; --d) S[d] = S[d+1] * B1->shape[d+1];
struct Array B0 = array_new_zeros(ntot, B1->dtype);
array_resize(&B0, N, Nd);
int sizeof_T = array_sizeof(B0.dtype);
int m = 0; // indexes into B0, advanced uniformly
char *b0 = (char*) B0 .data;
char *b1 = (char*) B1->data;
while (J[0] < N[0]) {
int M = 0;
for (int d=0; d<Nd; ++d) M += (J[d] * skip[d] + start[d]) * S[d];
// ----- use the indices m,M -----
memcpy(b0 + (m++)*sizeof_T, b1 + M*sizeof_T, sizeof_T);
// ----- -----
++J[Nd-1];
for (int d=Nd-1; d!=0; --d) {
if (J[d] == N[d]) {
J[d] = 0;
++J[d-1];
}
}
}
free(J);
free(N);
free(S);
return B0;
}
int lunum_upcast(lua_State *L, int pos, enum ArrayType T, int N)
// -----------------------------------------------------------------------------
// If the object at position 'pos' is already an array of dtype 'T', then push
// nothing and return 0. If the dtype is not 'T', then return 1 and push a copy
// of that array with dtype 'T' onto the stack. If it is a table, then push an
// array of dtype 'T' having the length of the table. If it is a number or
// complex, then push an array of dtype float or complex respectively having
// length 'N'.
// -----------------------------------------------------------------------------
{
if (array_typename(T) == NULL) {
luaL_error(L, "invalid array type");
}
// Deal with lunum.array
// ---------------------------------------------------------------------------
if (lunum_hasmetatable(L, pos, "array")) {
struct Array *A = lunum_checkarray1(L, pos);
if (A->dtype == T) {
return 0;
}
else {
struct Array A_ = array_new_copy(A, T);
lunum_pusharray1(L, &A_);
return 1;
}
}
// Deal with Lua table
// ---------------------------------------------------------------------------
else if (lua_istable(L, pos)) {
struct Array A = array_new_zeros(lua_rawlen(L, pos), T);
for (int i=0; i<A.size; ++i) {
lua_pushnumber(L, i+1);
lua_gettable(L, pos);
void *val = lunum_tovalue(L, T);
memcpy((char*)A.data + array_sizeof(T)*i, val, array_sizeof(T));
free(val);
lua_pop(L, 1);
}
lunum_pusharray1(L, &A);
return 1;
}
// Deal with Lua bool
// ---------------------------------------------------------------------------
else if (lua_isboolean(L, pos)) {
const Bool x = lua_toboolean(L, pos);
struct Array A = array_new_zeros(N, ARRAY_TYPE_BOOL);
array_assign_from_scalar(&A, &x);
lunum_pusharray1(L, &A);
return 1;
}
// Deal with Lua numbers
// ---------------------------------------------------------------------------
else if (lua_isnumber(L, pos)) {
const double x = lua_tonumber(L, pos);
struct Array A = array_new_zeros(N, ARRAY_TYPE_DOUBLE);
array_assign_from_scalar(&A, &x);
struct Array B = array_new_copy(&A, T);
array_del(&A);
lunum_pusharray1(L, &B);
return 1;
}
// Deal with lunum.complex
// ---------------------------------------------------------------------------
else if (lunum_hasmetatable(L, pos, "complex")) {
const Complex z = *((Complex*) lua_touserdata(L, pos));
struct Array A = array_new_zeros(N, ARRAY_TYPE_COMPLEX);
array_assign_from_scalar(&A, &z);
lunum_pusharray1(L, &A);
return 1;
}
// Throw an error
// ---------------------------------------------------------------------------
else {
luaL_error(L, "cannot cast to array from object of dtype %s\n",
lua_typename(L, lua_type(L, pos)));
return 0;
}
}
void lunum_pusharray2(lua_State *L, void *data, enum ArrayType T, int N)
{
struct Array A = array_new_zeros(N, T);
memcpy(A.data, data, N*array_sizeof(T));
lunum_pusharray1(L, &A);
}
static int _array_number_binary_op(lua_State *L, ArrayBinaryOperation op, Bool array_first)
{
const Array *A = array_first ? lunum_checkarray1(L, 1) : lunum_checkarray1(L, 2);
ArrayType T = A->dtype;
int num_pos = array_first ? 2 : 1;
union {
Bool b;
char c;
short s;
int i;
long l;
size_t t;
float f;
double d;
Complex z;
lua_Integer li;
lua_Number ln;
} num;
/* to force integer conversion if possible */
int isnum;
if (lua_isboolean(L, num_pos)) {
num.i = lua_toboolean(L, num_pos);
/* number can't have a higher type, upgrade to type T */
switch (T) {
case ARRAY_TYPE_BOOL : num.b = (Bool)num.i; break;
case ARRAY_TYPE_CHAR : num.c = (char)num.i; break;
case ARRAY_TYPE_SHORT : num.s = (short)num.i; break;
case ARRAY_TYPE_INT : num.i = (int)num.i; break;
case ARRAY_TYPE_LONG : num.l = (long)num.i; break;
case ARRAY_TYPE_SIZE_T : num.t = (size_t)num.i; break;
case ARRAY_TYPE_FLOAT : num.f = (float)num.i; break;
case ARRAY_TYPE_DOUBLE : num.d = (double)num.i; break;
case ARRAY_TYPE_COMPLEX : num.z = (Complex)num.i; break;
}
}
else if (num.li = lua_tointegerx(L, num_pos, &isnum), isnum) {
/* already assigned above */
if (T >= ARRAY_TYPE_LONG) {
/* A has higher type */
} else {
/* number has higher type */
T = ARRAY_TYPE_LONG;
}
/* upgrade to type T */
switch (T) {
case ARRAY_TYPE_BOOL : num.b = (Bool)num.li; break;
case ARRAY_TYPE_CHAR : num.c = (char)num.li; break;
case ARRAY_TYPE_SHORT : num.s = (short)num.li; break;
case ARRAY_TYPE_INT : num.i = (int)num.li; break;
case ARRAY_TYPE_LONG : num.l = (long)num.li; break;
case ARRAY_TYPE_SIZE_T : num.t = (size_t)num.li; break;
case ARRAY_TYPE_FLOAT : num.f = (float)num.li; break;
case ARRAY_TYPE_DOUBLE : num.d = (double)num.li; break;
case ARRAY_TYPE_COMPLEX : num.z = (Complex)num.li; break;
}
}
else if (num.ln = lua_tonumberx(L, num_pos, &isnum), isnum) {
/* already assigned above */
if (T >= ARRAY_TYPE_DOUBLE) {
/* A has higher type */
} else {
/* number has higher type */
T = ARRAY_TYPE_DOUBLE;
}
/* upgrade to type T */
switch (T) {
case ARRAY_TYPE_BOOL : num.b = (Bool)num.ln; break;
case ARRAY_TYPE_CHAR : num.c = (char)num.ln; break;
case ARRAY_TYPE_SHORT : num.s = (short)num.ln; break;
case ARRAY_TYPE_INT : num.i = (int)num.ln; break;
case ARRAY_TYPE_LONG : num.l = (long)num.ln; break;
case ARRAY_TYPE_SIZE_T : num.t = (size_t)num.ln; break;
case ARRAY_TYPE_FLOAT : num.f = (float)num.ln; break;
case ARRAY_TYPE_DOUBLE : num.d = (double)num.ln; break;
case ARRAY_TYPE_COMPLEX : num.z = (Complex)num.ln; break;
}
}
else if (lunum_hasmetatable(L, num_pos, "complex")) {
/* number complex */
num.z = *((Complex*) lua_touserdata(L, num_pos));
T = ARRAY_TYPE_COMPLEX;
} else {
return luaL_error(L, "Invalid argument in Array binary op");
}
Array C = array_new_zeros(A->size, T);
array_resize_t(&C, A->shape, A->ndims);
lunum_pusharray1(L, &C);
array_number_binary_op(L, A, (void *)&num, &C, op, array_first);
return 1;
}