/************************************************************************* * * * YAP Prolog * * * * Yap Prolog was developed at NCCUP - Universidade do Porto * * * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * * ************************************************************************** * * * File: matrix.c * * Last rev: * * mods: * * comments: numerical arrays * * * *************************************************************************/ #include "config.h" #include "YapInterface.h" #include #if defined(__MINGW32__) || _MSC_VER #include #endif #if HAVE_STRING_H #include #endif /* A matrix is something of the form TYPE = {int,double} BASE = integer #DIMS = an int DIM1 ... DIMn DATA in C format. floating point matrixes may need to be aligned, so we always have an extra element at the end. */ /* maximal number of dimensions, 1024 should be enough */ #define MAX_DIMS 1024 typedef enum { INT_MATRIX, FLOAT_MATRIX } mat_data_type; typedef enum { MAT_TYPE=0, MAT_BASE=1, MAT_NDIMS=2, MAT_SIZE=3, MAT_ALIGN=4, MAT_DIMS=5, } mat_type; typedef enum { MAT_PLUS=0, MAT_SUB=1, MAT_TIMES=2, MAT_DIV=3, MAT_IDIV=4, MAT_ZDIV=5, MAT_LOG=6, MAT_EXP=7 } op_type; YAP_Functor FunctorM; YAP_Atom AtomC; static long int * matrix_long_data(int *mat, int ndims) { return (long int *)(mat+(MAT_DIMS+ndims)); } static double * matrix_double_data(int *mat, int ndims) { return (double *)(mat+(MAT_DIMS+ndims)); } static unsigned int matrix_get_offset(int *mat, int* indx) { unsigned int i, pos = mat[MAT_SIZE], off = 0; /* find where we are */ for (i = 0; i < mat[MAT_NDIMS]; i++) { int v; pos /= mat[MAT_DIMS+i]; v = indx[i]-mat[MAT_BASE]; if (v >= mat[MAT_DIMS+i]) { return off; } off += pos*v; } return off; } static void matrix_get_index(int *mat, unsigned int offset, int* indx) { unsigned int i, pos = mat[MAT_SIZE]; /* find where we are */ for (i = 0; i < mat[MAT_NDIMS]; i++) { pos /= mat[MAT_DIMS+i]; indx[i] = offset / pos; offset = offset % pos; } } static void matrix_next_index(int *dims, int ndims, int* indx) { unsigned int i; /* find where we are */ for (i = ndims; i >0; ) { i--; indx[i]++; if (indx[i]!=dims[i]) return; indx[i] = 0; } } static YAP_Term new_int_matrix(int ndims, int dims[], long int data[]) { unsigned int sz; unsigned int i, nelems=1; YAP_Term blob; int *mat; long int *bdata; int idims[MAX_DIMS]; /* in case we don't have enough room and need to shift the stack, we can't really afford to keep a pointer to the global */ for (i=0;i< ndims;i++) { idims[i] = dims[i]; nelems *= dims[i]; } sz = ((MAT_DIMS+1)*sizeof(int)+ndims*sizeof(int)+nelems*sizeof(long int))/sizeof(YAP_CELL); blob = YAP_MkBlobTerm(sz); if (blob == YAP_TermNil()) { return blob; } mat = (int *)YAP_BlobOfTerm(blob); mat[MAT_TYPE] = INT_MATRIX; mat[MAT_BASE] = 0; mat[MAT_NDIMS] = ndims; mat[MAT_SIZE] = nelems; for (i=0;i< ndims;i++) { mat[MAT_DIMS+i] = idims[i]; } bdata = matrix_long_data(mat,ndims); if (data) memcpy((void *)bdata,(void *)data,sizeof(double)*nelems); return blob; } static YAP_Term new_float_matrix(int ndims, int dims[], double data[]) { unsigned int sz; unsigned int i, nelems=1; YAP_Term blob; int *mat; double *bdata; int idims[MAX_DIMS]; /* in case we don't have enough room and need to shift the stack, we can't really afford to keep a pointer to the global */ for (i=0;i< ndims;i++) { idims[i] = dims[i]; nelems *= dims[i]; } sz = ((MAT_DIMS+1)*sizeof(int)+ndims*sizeof(int)+(nelems+1)*sizeof(double)+(sizeof(YAP_CELL)-1))/sizeof(YAP_CELL); blob = YAP_MkBlobTerm(sz); if (blob == YAP_TermNil()) return blob; mat = YAP_BlobOfTerm(blob); mat[MAT_TYPE] = FLOAT_MATRIX; mat[MAT_BASE] = 0; mat[MAT_NDIMS] = ndims; mat[MAT_SIZE] = nelems; for (i=0;i< ndims;i++) { mat[MAT_DIMS+i] = idims[i]; } bdata = matrix_double_data(mat,ndims); if (data) memcpy((void *)bdata,(void *)data,sizeof(double)*nelems); return blob; } static YAP_Bool scan_dims(int ndims, YAP_Term tl, int dims[MAX_DIMS]) { int i; for (i = 0; i < ndims; i++) { YAP_Term th; int d; if (!YAP_IsPairTerm(tl)) { return FALSE; } th = YAP_HeadOfTerm(tl); if (!YAP_IsIntTerm(th)) { /* ERROR */ return FALSE; } d = YAP_IntOfTerm(th); if (d < 0) { /* ERROR */ return FALSE; } dims[i] = d; tl = YAP_TailOfTerm(tl); } if (tl != YAP_TermNil()) { /* ERROR */ return FALSE; } return TRUE; } static YAP_Bool scan_dims_args(int ndims, YAP_Term tl, int dims[MAX_DIMS]) { int i; for (i = 0; i < ndims; i++) { YAP_Term th; int d; th = YAP_ArgOfTerm(2+i, tl); if (!YAP_IsIntTerm(th)) { /* ERROR */ return FALSE; } d = YAP_IntOfTerm(th); if (d < 0) { /* ERROR */ return FALSE; } dims[i] = d; } return TRUE; } static YAP_Bool cp_int_matrix(YAP_Term tl,YAP_Term matrix) { int *mat = (int *)YAP_BlobOfTerm(matrix); int i, nelems = mat[MAT_SIZE]; long int *j = matrix_long_data(mat, mat[MAT_NDIMS]); for (i = 0; i < nelems; i++) { YAP_Term th; int d; if (!YAP_IsPairTerm(tl)) { return FALSE; } th = YAP_HeadOfTerm(tl); if (!YAP_IsIntTerm(th)) { /* ERROR */ return FALSE; } d = YAP_IntOfTerm(th); j[i] = d; tl = YAP_TailOfTerm(tl); } if (tl != YAP_TermNil()) { /* ERROR */ return FALSE; } return TRUE; } static YAP_Bool cp_float_matrix(YAP_Term tl,YAP_Term matrix) { int *mat = (int *)YAP_BlobOfTerm(matrix); int i, nelems = mat[MAT_SIZE]; double *j = matrix_double_data(mat, mat[MAT_NDIMS]); for (i = 0; i < nelems; i++) { YAP_Term th; double d; if (!YAP_IsPairTerm(tl)) { return FALSE; } th = YAP_HeadOfTerm(tl); if (YAP_IsIntTerm(th)) { d = YAP_IntOfTerm(th); } else if (!YAP_IsFloatTerm(th)) { /* ERROR */ return FALSE; } else { d = YAP_FloatOfTerm(th); } j[i] = d; tl = YAP_TailOfTerm(tl); } if (tl != YAP_TermNil()) { /* ERROR */ return FALSE; } return TRUE; } static YAP_Bool set_int_matrix(YAP_Term matrix,long int set) { int *mat = (int *)YAP_BlobOfTerm(matrix); int i, nelems = mat[MAT_SIZE]; long int *j = matrix_long_data(mat, mat[MAT_NDIMS]); for (i = 0; i < nelems; i++) { j[i] = set; } return TRUE; } static YAP_Bool set_float_matrix(YAP_Term matrix,double set) { int *mat = (int *)YAP_BlobOfTerm(matrix); int i, nelems = mat[MAT_SIZE]; double *j = matrix_double_data(mat, mat[MAT_NDIMS]); for (i = 0; i < nelems; i++) { j[i] = set; } return TRUE; } static YAP_Bool new_ints_matrix(void) { int ndims = YAP_IntOfTerm(YAP_ARG1); YAP_Term tl = YAP_ARG2, out; int dims[MAX_DIMS]; if (!scan_dims(ndims, tl, dims)) return FALSE; out = new_int_matrix(ndims, dims, NULL); if (out == YAP_TermNil()) return FALSE; if (!cp_int_matrix(YAP_ARG3,out)) return FALSE; return YAP_Unify(YAP_ARG4, out); } static YAP_Bool new_ints_matrix_set(void) { int ndims = YAP_IntOfTerm(YAP_ARG1); YAP_Term tl = YAP_ARG2, out, tset = YAP_ARG3; int dims[MAX_DIMS]; long int set; if (!YAP_IsIntTerm(tset)) { return FALSE; } set = YAP_IntOfTerm(tset); if (!scan_dims(ndims, tl, dims)) return FALSE; out = new_int_matrix(ndims, dims, NULL); if (!set_int_matrix(out,set)) return FALSE; return YAP_Unify(YAP_ARG4, out); } static YAP_Bool new_floats_matrix(void) { int ndims = YAP_IntOfTerm(YAP_ARG1); YAP_Term tl = YAP_ARG2, out; int dims[MAX_DIMS]; if (!scan_dims(ndims, tl, dims)) return FALSE; out = new_float_matrix(ndims, dims, NULL); if (out == YAP_TermNil()) return FALSE; if (!cp_float_matrix(YAP_ARG3,out)) return FALSE; return YAP_Unify(YAP_ARG4, out); } static YAP_Bool new_floats_matrix_set(void) { int ndims = YAP_IntOfTerm(YAP_ARG1); YAP_Term tl = YAP_ARG2, out, tset = YAP_ARG3; int dims[MAX_DIMS]; double set; if (!YAP_IsFloatTerm(tset)) { return FALSE; } set = YAP_FloatOfTerm(tset); if (!scan_dims(ndims, tl, dims)) return FALSE; out = new_float_matrix(ndims, dims, NULL); if (!set_float_matrix(out,set)) return FALSE; return YAP_Unify(YAP_ARG4, out); } static YAP_Term float_matrix_to_list(int *mat) { double *data = matrix_double_data(mat, mat[MAT_NDIMS]); /* prepare for worst case with double taking two cells */ if (YAP_RequiresExtraStack(6*mat[MAT_SIZE])) { mat = (int *)YAP_BlobOfTerm(YAP_ARG1); data = matrix_double_data(mat, mat[MAT_NDIMS]); } return YAP_FloatsToList(data, mat[MAT_SIZE]); } static YAP_Term mk_int_list(int nelems, int *data) { YAP_Term tn = YAP_TermNil(); YAP_Term tf = tn; int i = 0; for (i = nelems-1; i>= 0; i--) { tf = YAP_MkPairTerm(YAP_MkIntTerm(data[i]),tf); if (tf == tn) { /* error */ return tn; } } return tf; } static YAP_Term mk_int_list2(int nelems, int base, int *data) { YAP_Term tn = YAP_TermNil(); YAP_Term tf = tn; int i = 0; for (i = nelems-1; i>= 0; i--) { tf = YAP_MkPairTerm(YAP_MkIntTerm(data[i]+base),tf); if (tf == tn) { /* error */ return tn; } } return tf; } static YAP_Term mk_rep_int_list(int nelems, int data) { YAP_Term tn = YAP_TermNil(); YAP_Term tf = tn; int i = 0; for (i = nelems-1; i>= 0; i--) { tf = YAP_MkPairTerm(YAP_MkIntTerm(data),tf); if (tf == tn) { /* error */ return tn; } } return tf; } static YAP_Term mk_long_list(int nelems, long int *data) { YAP_Term tn = YAP_TermNil(); YAP_Term tf = tn; int i = 0; for (i = nelems-1; i>= 0; i--) { tf = YAP_MkPairTerm(YAP_MkIntTerm(data[i]),tf); if (tf == tn) { /* error */ return tn; } } return tf; } static YAP_Term long_matrix_to_list(int *mat) { long int *data = matrix_long_data(mat, mat[MAT_NDIMS]); /* prepare for worst case with longs evrywhere (3cells + 1) */ if (YAP_RequiresExtraStack(5*mat[MAT_SIZE])) { mat = (int *)YAP_BlobOfTerm(YAP_ARG1); data = matrix_long_data(mat, mat[MAT_NDIMS]); } return mk_long_list(mat[MAT_SIZE], data); } static YAP_Term matrix_access(int *mat, int *indx) { unsigned int off = matrix_get_offset(mat, indx); if (mat[MAT_TYPE]==FLOAT_MATRIX) return YAP_MkFloatTerm((matrix_double_data(mat,mat[MAT_NDIMS]))[off]); else return YAP_MkIntTerm((matrix_long_data(mat,mat[MAT_NDIMS]))[off]); } static void matrix_float_set(int *mat, int *indx, double nval) { unsigned int off = 0; off = matrix_get_offset(mat, indx); (matrix_double_data(mat,mat[MAT_NDIMS]))[off] = nval; } static void matrix_long_set(int *mat, int *indx, long int nval) { unsigned int off = matrix_get_offset(mat, indx); (matrix_long_data(mat,mat[MAT_NDIMS]))[off] = nval; } static void matrix_float_set_all(int *mat, double nval) { int i; double *data = matrix_double_data(mat,mat[MAT_NDIMS]); for (i = 0; i< mat[MAT_SIZE]; i++) data[i] = nval; } static void matrix_long_set_all(int *mat, long int nval) { int i; long int *data = matrix_long_data(mat,mat[MAT_NDIMS]); if (nval == 0) { memset((void *)data,0,sizeof(long int)*mat[MAT_SIZE]); } else { for (i = 0; i< mat[MAT_SIZE]; i++) data[i] = nval; } } static void matrix_float_add(int *mat, int *indx, double nval) { unsigned int off; double *dat = matrix_double_data(mat,mat[MAT_NDIMS]); off = matrix_get_offset(mat, indx); dat[off] += nval; } static void matrix_long_add(int *mat, int *indx, long int nval) { long int *dat = matrix_long_data(mat,mat[MAT_NDIMS]); unsigned int off = matrix_get_offset(mat, indx); dat[off] += nval; } static void matrix_inc(int *mat, int *indx) { unsigned int off = matrix_get_offset(mat, indx); if (mat[MAT_TYPE]==FLOAT_MATRIX) (matrix_double_data(mat,mat[MAT_NDIMS])[off])++; else ((matrix_long_data(mat,mat[MAT_NDIMS]))[off])++; } static void matrix_dec(int *mat, int *indx) { unsigned int off = matrix_get_offset(mat, indx); if (mat[MAT_TYPE]==FLOAT_MATRIX) (matrix_double_data(mat,mat[MAT_NDIMS])[off])--; else ((matrix_long_data(mat,mat[MAT_NDIMS]))[off])--; } static YAP_Term matrix_inc2(int *mat, int *indx) { unsigned int off = matrix_get_offset(mat, indx); if (mat[MAT_TYPE]==FLOAT_MATRIX) { double *data = matrix_double_data(mat,mat[MAT_NDIMS]); double d = data[off]; d++; data[off] = d; return YAP_MkFloatTerm(d); } else { long int *data = matrix_long_data(mat,mat[MAT_NDIMS]); long int d = data[off]; d++; data[off] = d; return YAP_MkIntTerm(d); } } static YAP_Term matrix_dec2(int *mat, int *indx) { unsigned int off = matrix_get_offset(mat, indx); if (mat[MAT_TYPE]==FLOAT_MATRIX) { double *data = matrix_double_data(mat,mat[MAT_NDIMS]); double d = data[off]; d--; data[off] = d; return YAP_MkFloatTerm(d); } else { long int *data = matrix_long_data(mat,mat[MAT_NDIMS]); long int d = data[off]; d--; data[off] = d; return YAP_MkIntTerm(d); } } static YAP_Bool matrix_set(void) { int dims[MAX_DIMS], *mat; YAP_Term tf; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } if (!scan_dims(mat[MAT_NDIMS], YAP_ARG2, dims)) { /* Error */ return FALSE; } tf = YAP_ARG3; if (mat[MAT_TYPE] == INT_MATRIX) { if (YAP_IsIntTerm(tf)) { matrix_long_set(mat, dims, YAP_IntOfTerm(tf)); } else if (YAP_IsFloatTerm(tf)) { matrix_long_set(mat, dims, YAP_FloatOfTerm(tf)); } else { /* Error */ return FALSE; } } else { if (YAP_IsIntTerm(tf)) { matrix_float_set(mat, dims, YAP_IntOfTerm(tf)); } else if (YAP_IsFloatTerm(tf)) { matrix_float_set(mat, dims, YAP_FloatOfTerm(tf)); } else { /* Error */ return FALSE; } } return TRUE; } static YAP_Bool matrix_set2(void) { int dims[MAX_DIMS], *mat; YAP_Term tf, t = YAP_ARG1; mat = (int *)YAP_BlobOfTerm(YAP_ArgOfTerm(1,t)); if (!mat) { /* Error */ return FALSE; } if (!scan_dims_args(mat[MAT_NDIMS], t, dims)) { /* Error */ return FALSE; } tf = YAP_ARG2; if (mat[MAT_TYPE] == INT_MATRIX) { if (YAP_IsIntTerm(tf)) { matrix_long_set(mat, dims, YAP_IntOfTerm(tf)); } else if (YAP_IsFloatTerm(tf)) { matrix_long_set(mat, dims, YAP_FloatOfTerm(tf)); } else { /* Error */ return FALSE; } } else { if (YAP_IsIntTerm(tf)) { matrix_float_set(mat, dims, YAP_IntOfTerm(tf)); } else if (YAP_IsFloatTerm(tf)) { matrix_float_set(mat, dims, YAP_FloatOfTerm(tf)); } else { /* Error */ return FALSE; } } return TRUE; } static YAP_Bool matrix_set_all(void) { int *mat; YAP_Term tf; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } tf = YAP_ARG2; if (mat[MAT_TYPE] == INT_MATRIX) { if (YAP_IsIntTerm(tf)) { matrix_long_set_all(mat, YAP_IntOfTerm(tf)); } else if (YAP_IsFloatTerm(tf)) { matrix_long_set_all(mat, YAP_FloatOfTerm(tf)); } else { /* Error */ return FALSE; } } else { if (YAP_IsIntTerm(tf)) { matrix_float_set_all(mat, YAP_IntOfTerm(tf)); } else if (YAP_IsFloatTerm(tf)) { matrix_float_set_all(mat, YAP_FloatOfTerm(tf)); } else { /* Error */ return FALSE; } } return TRUE; } static YAP_Bool matrix_add(void) { int dims[MAX_DIMS], *mat; YAP_Term tf; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } if (!scan_dims(mat[MAT_NDIMS], YAP_ARG2, dims)) { /* Error */ return FALSE; } tf = YAP_ARG3; if (mat[MAT_TYPE] == INT_MATRIX) { if (YAP_IsIntTerm(tf)) { matrix_long_add(mat, dims, YAP_IntOfTerm(tf)); } else if (YAP_IsFloatTerm(tf)) { matrix_long_add(mat, dims, YAP_FloatOfTerm(tf)); } else { /* Error */ return FALSE; } } else { if (YAP_IsIntTerm(tf)) { matrix_float_add(mat, dims, YAP_IntOfTerm(tf)); } else if (YAP_IsFloatTerm(tf)) { matrix_float_add(mat, dims, YAP_FloatOfTerm(tf)); } else { /* Error */ return FALSE; } } return TRUE; } static YAP_Bool do_matrix_access(void) { int dims[MAX_DIMS], *mat; YAP_Term tf; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } if (!scan_dims(mat[MAT_NDIMS], YAP_ARG2, dims)) { /* Error */ return FALSE; } tf = matrix_access(mat, dims); return YAP_Unify(tf, YAP_ARG3); } static YAP_Bool do_matrix_access2(void) { int dims[MAX_DIMS], *mat; YAP_Term tf, t = YAP_ARG1; mat = (int *)YAP_BlobOfTerm(YAP_ArgOfTerm(1, t)); if (!mat) { /* Error */ return FALSE; } if (!scan_dims_args(mat[MAT_NDIMS], t, dims)) { /* Error */ return FALSE; } tf = matrix_access(mat, dims); return YAP_Unify(tf, YAP_ARG2); } static YAP_Bool do_matrix_inc(void) { int dims[MAX_DIMS], *mat; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } if (!scan_dims(mat[MAT_NDIMS], YAP_ARG2, dims)) { /* Error */ return FALSE; } matrix_inc(mat, dims); return TRUE; } static YAP_Bool do_matrix_dec(void) { int dims[MAX_DIMS], *mat; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } if (!scan_dims(mat[MAT_NDIMS], YAP_ARG2, dims)) { /* Error */ return FALSE; } matrix_dec(mat, dims); return TRUE; } static YAP_Bool do_matrix_inc2(void) { int dims[MAX_DIMS], *mat; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } if (!scan_dims(mat[MAT_NDIMS], YAP_ARG2, dims)) { /* Error */ return FALSE; } return YAP_Unify(matrix_inc2(mat, dims), YAP_ARG3); } static YAP_Bool do_matrix_dec2(void) { int dims[MAX_DIMS], *mat; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } if (!scan_dims(mat[MAT_NDIMS], YAP_ARG2, dims)) { /* Error */ return FALSE; } return YAP_Unify(matrix_dec2(mat, dims), YAP_ARG3); } static YAP_Bool matrix_to_list(void) { int *mat; YAP_Term tf; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } if (mat[MAT_TYPE] == INT_MATRIX) tf = long_matrix_to_list(mat); else tf = float_matrix_to_list(mat); return YAP_Unify(YAP_ARG2, tf); } static YAP_Bool matrix_set_base(void) { int *mat; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } mat[MAT_BASE] = YAP_IntOfTerm(YAP_ARG2); return TRUE; } static YAP_Bool matrix_dims(void) { int *mat; YAP_Term tf; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } tf = mk_int_list(mat[MAT_NDIMS],mat+MAT_DIMS); return YAP_Unify(YAP_ARG2, tf); } static YAP_Bool matrix_dims3(void) { int *mat; YAP_Term tf, tof; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } tf = mk_int_list(mat[MAT_NDIMS],mat+MAT_DIMS); tof = mk_rep_int_list(mat[MAT_NDIMS],mat[MAT_BASE]); return YAP_Unify(YAP_ARG2, tf) && YAP_Unify(YAP_ARG3, tof); } static YAP_Bool matrix_size(void) { int *mat; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } return YAP_Unify(YAP_ARG2, YAP_MkIntTerm(mat[MAT_SIZE])); } static YAP_Bool matrix_ndims(void) { int *mat; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } return YAP_Unify(YAP_ARG2, YAP_MkIntTerm(mat[MAT_NDIMS])); } static YAP_Bool matrix_type(void) { int *mat; YAP_Term tf; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* not an error, it may be called on a term matrix */ return FALSE; } if (mat[MAT_TYPE] == INT_MATRIX) { tf = YAP_MkIntTerm(0); } else { tf = YAP_MkIntTerm(1); } return YAP_Unify(YAP_ARG2, tf); } static YAP_Bool matrix_arg_to_offset(void) { int indx[MAX_DIMS], *mat; unsigned int off; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } if (!scan_dims(mat[MAT_NDIMS], YAP_ARG2, indx)) { /* Error */ return FALSE; } off = matrix_get_offset(mat, indx); return YAP_Unify(YAP_ARG3, YAP_MkIntTerm(off)); } static YAP_Bool matrix_offset_to_arg(void) { int indx[MAX_DIMS], *mat; unsigned int off; YAP_Term ti, tf; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } if (!YAP_IsIntTerm(ti = YAP_ARG2)) { /* Error */ return FALSE; } off = YAP_IntOfTerm(ti); matrix_get_index(mat, off, indx); tf = mk_int_list2(mat[MAT_NDIMS], mat[MAT_BASE], indx); return YAP_Unify(YAP_ARG3, tf); } static unsigned int scan_max_long(int sz, long int *data) { int i, off=0; long int max= data[0]; for (i=1; imax) { off=i; max = data[i]; } } return off; } static unsigned int scan_max_float(int sz, double *data) { int i, off=0; double max= data[0]; for (i=1; imax) { max = data[i]; off=i; } } return off; } static unsigned int scan_min_long(int sz, long int *data) { int i, off=0; long int max= data[0]; for (i=1; i max) max = data[i]; } for (i=0; i< mat[MAT_SIZE]; i++) { data[i] = exp(data[i]-max); } } return TRUE; } static YAP_Bool matrix_exp_all2(void) { int *mat; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } if (mat[MAT_TYPE] == INT_MATRIX) { YAP_Term out; long int *data = matrix_long_data(mat, mat[MAT_NDIMS]); double *ndata; int i; int *nmat; if (!YAP_IsVarTerm(YAP_ARG2)) { out = YAP_ARG2; } else { out = new_float_matrix(mat[MAT_NDIMS], mat+MAT_DIMS, NULL); if (out == YAP_TermNil()) return FALSE; } nmat = (int *)YAP_BlobOfTerm(out); ndata = matrix_double_data(nmat, mat[MAT_NDIMS]); for (i=0; i< mat[MAT_SIZE]; i++) { ndata[i] = exp((double)data[i]); } if (YAP_IsVarTerm(YAP_ARG2)) { return YAP_Unify(YAP_ARG2, out); } } else { YAP_Term out; double *data = matrix_double_data(mat, mat[MAT_NDIMS]), *ndata; int i; int *nmat; if (!YAP_IsVarTerm(YAP_ARG2)) { out = YAP_ARG2; } else { out = new_float_matrix(mat[MAT_NDIMS], mat+MAT_DIMS, NULL); if (out == YAP_TermNil()) return FALSE; } nmat = (int *)YAP_BlobOfTerm(out); ndata = matrix_double_data(nmat, mat[MAT_NDIMS]); for (i=0; i< mat[MAT_SIZE]; i++) { ndata[i] = exp(data[i]); } if (YAP_IsVarTerm(YAP_ARG2)) { return YAP_Unify(YAP_ARG2, out); } } return TRUE; } static YAP_Bool matrix_minarg(void) { int indx[MAX_DIMS], *mat; unsigned int off; YAP_Term tf; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } if (mat[MAT_TYPE] == INT_MATRIX) { long int *data = matrix_long_data(mat, mat[MAT_NDIMS]); off = scan_min_long(mat[MAT_SIZE], data); } else { double *data = matrix_double_data(mat, mat[MAT_NDIMS]); off = scan_min_float(mat[MAT_SIZE], data); } matrix_get_index(mat, off, indx); tf = mk_int_list(mat[MAT_NDIMS], indx); return YAP_Unify(YAP_ARG2, tf); } static YAP_Bool matrix_sum(void) { int *mat; YAP_Term tf; mat = (int *)YAP_BlobOfTerm(YAP_ARG1); if (!mat) { /* Error */ return FALSE; } if (mat[MAT_TYPE] == INT_MATRIX) { long int *data = matrix_long_data(mat, mat[MAT_NDIMS]); int i; long int sum = 0; for (i = 0; i < mat[MAT_SIZE]; i++) { sum += data[i]; } tf = YAP_MkIntTerm(sum); } else { double *data = matrix_double_data(mat, mat[MAT_NDIMS]); int i; double sum = 0.0; for (i = 0; i < mat[MAT_SIZE]; i++) { sum += data[i]; } tf = YAP_MkFloatTerm(sum); } return YAP_Unify(YAP_ARG2, tf); } static void add_int_lines(int total,int nlines,long int *mat0,long int *matf) { int ncols = total/nlines, i; for (i=0;i prdim) { d = d*dims[j]; j--; } dd = d*dims[prdim]; memset(ndata, 0, sizeof(double)*nmat[MAT_SIZE]); for (i=0; i< mat[MAT_SIZE]; i++) { YAP_Int k = i % d + (i/dd)*d; ndata[k] += exp(data[i]); } for (i=0; i< nmat[MAT_SIZE]; i++) { ndata[i] = log(ndata[i]); } } return YAP_Unify(YAP_ARG3, tf); } /* given a matrix M and a set of dims, sum out one of the dimensions */ static YAP_Bool matrix_sum_out_logs_several(void) { int ndims, i, *dims, newdims; int indx[MAX_DIMS], nindx[MAX_DIMS], conv[MAX_DIMS]; YAP_Term tf, tconv; int *mat = (int *)YAP_BlobOfTerm(YAP_ARG1), *nmat; if (!mat) { /* Error */ return FALSE; } ndims = mat[MAT_NDIMS]; dims = mat+MAT_DIMS; /* we now have our target matrix, let us grab our conversion arguments */ tconv = YAP_ARG2; for (i=0, newdims=0; i < ndims; i++) { YAP_Term th; if (!YAP_IsPairTerm(tconv)) return FALSE; th = YAP_HeadOfTerm(tconv); if (!YAP_IsIntTerm(th)) return FALSE; conv[i] = YAP_IntOfTerm(th); if (!conv[i]) { nindx[newdims++] = dims[i]; } tconv = YAP_TailOfTerm(tconv); } if (mat[MAT_TYPE] == INT_MATRIX) { long int *data, *ndata; /* create a new matrix with the same size */ tf = new_int_matrix(newdims,nindx,NULL); if (tf == YAP_TermNil()) return FALSE; /* in case the matrix moved */ mat = (int *)YAP_BlobOfTerm(YAP_ARG1); nmat = (int *)YAP_BlobOfTerm(tf); data = matrix_long_data(mat,ndims); ndata = matrix_long_data(nmat,newdims); /* create a new matrix with smaller size */ for (i=0;i