genius r655 - in trunk: . src

[jirka svn gnome org]

Author: jirka
Date: Thu May 22 06:12:03 2008
New Revision: 655
URL: http://svn.gnome.org/viewvc/genius?rev=655&view=rev

Log:

Thu May 22 01:10:40 2008  Jiri (George) Lebl <jirka 5z com>

	* src/funclib.c: fix identity matrix caching, setup type caches for
	  identity, zeros and ones

	* src/matop.c: move rref caching to gauss to speed up inverting
	  matrices in rref form etc...



Modified:
   trunk/ChangeLog
   trunk/src/funclib.c
   trunk/src/matop.c

Modified: trunk/src/funclib.c
==============================================================================
--- trunk/src/funclib.c	(original)
+++ trunk/src/funclib.c	Thu May 22 06:12:03 2008
@@ -2683,19 +2683,32 @@
 	if (cached_size == size) {
 		n->mat.matrix = gel_matrixw_copy (cached_m);
 	} else {
+		GelMatrixW *m;
+
 		if (cached_m != NULL)
 			gel_matrixw_free (cached_m);
-		n->mat.matrix = gel_matrixw_new();
-		gel_matrixw_set_size(n->mat.matrix,size,size);
+		n->mat.matrix = m = gel_matrixw_new();
+		gel_matrixw_set_size (m, size, size);
 
 		for (i = 0; i < size; i++)
-			gel_matrixw_set_index (n->mat.matrix, i, i) =
+			gel_matrixw_set_index (m, i, i) =
 				gel_makenum_ui(1);
 		/* This is in row reduced form, duh! */
-		n->mat.matrix->rref = 1;
+		m->rref = 1;
+
+		m->cached_value_only = 1;
+		m->value_only = 1;
+		m->cached_value_only_real = 1;
+		m->value_only_real = 1;
+		m->cached_value_only_rational = 1;
+		m->value_only_rational = 1;
+		m->cached_value_only_integer = 1;
+		m->value_only_integer = 1;
+		m->cached_value_or_bool_only = 1;
+		m->value_or_bool_only = 1;
 
-		cached_m = gel_matrixw_copy (n->mat.matrix);
-		cached_size = -1;
+		cached_m = gel_matrixw_copy (m);
+		cached_size = size;
 	}
 
 	return n;
@@ -2705,6 +2718,7 @@
 zeros_op (GelCtx *ctx, GelETree * * a, gboolean *exception)
 {
 	GelETree *n;
+	GelMatrixW *m;
 	long rows, cols;
 
 	if G_UNLIKELY ( ! check_argument_integer (a, 0, "zeros") ||
@@ -2733,9 +2747,23 @@
 	/*make us a new empty node*/
 	GET_NEW_NODE(n);
 	n->type = MATRIX_NODE;
-	n->mat.matrix = gel_matrixw_new();
+	n->mat.matrix = m = gel_matrixw_new();
 	n->mat.quoted = FALSE;
-	gel_matrixw_set_size(n->mat.matrix,cols,rows);
+	gel_matrixw_set_size (m, cols, rows);
+
+	/* trivially rref */
+	m->rref = 1;
+
+	m->cached_value_only = 1;
+	m->value_only = 1;
+	m->cached_value_only_real = 1;
+	m->value_only_real = 1;
+	m->cached_value_only_rational = 1;
+	m->value_only_rational = 1;
+	m->cached_value_only_integer = 1;
+	m->value_only_integer = 1;
+	m->cached_value_or_bool_only = 1;
+	m->value_or_bool_only = 1;
 	
 	return n;
 }
@@ -2744,6 +2772,7 @@
 ones_op (GelCtx *ctx, GelETree * * a, gboolean *exception)
 {
 	GelETree *n;
+	GelMatrixW *m;
 	long rows, cols;
 	int i, j;
 
@@ -2773,14 +2802,25 @@
 	/*make us a new empty node*/
 	GET_NEW_NODE(n);
 	n->type = MATRIX_NODE;
-	n->mat.matrix = gel_matrixw_new();
+	n->mat.matrix = m = gel_matrixw_new();
 	n->mat.quoted = FALSE;
-	gel_matrixw_set_size(n->mat.matrix,cols,rows);
+	gel_matrixw_set_size (m, cols, rows);
+
+	m->cached_value_only = 1;
+	m->value_only = 1;
+	m->cached_value_only_real = 1;
+	m->value_only_real = 1;
+	m->cached_value_only_rational = 1;
+	m->value_only_rational = 1;
+	m->cached_value_only_integer = 1;
+	m->value_only_integer = 1;
+	m->cached_value_or_bool_only = 1;
+	m->value_or_bool_only = 1;
 	
 	for(j=0;j<rows;j++)
 		for(i=0;i<cols;i++)
-			gel_matrixw_set_index(n->mat.matrix,i,j) =
-				gel_makenum_ui(1);
+			gel_matrixw_set_index (m, i, j) =
+				gel_makenum_ui (1);
 
 	return n;
 }
@@ -3305,7 +3345,6 @@
 	n->mat.matrix = gel_matrixw_copy(a[0]->mat.matrix);
 	if ( ! n->mat.matrix->rref) {
 		gel_value_matrix_gauss (ctx, n->mat.matrix, TRUE, FALSE, FALSE, NULL, NULL);
-		n->mat.matrix->rref = 1;
 	}
 	n->mat.quoted = FALSE;
 	return n;

Modified: trunk/src/matop.c
==============================================================================
--- trunk/src/matop.c	(original)
+++ trunk/src/matop.c	Thu May 22 06:12:03 2008
@@ -393,19 +393,33 @@
 	gboolean matrix_rational = FALSE;
 	int *pivots = NULL;
 	int pivots_max = -1;
-	
+
+	w = gel_matrixw_width (m);
+        h = gel_matrixw_height (m);
+
 	if(detop)
 		mpw_set_ui(detop,1);
 
+	if (m->rref) {
+		/* test for singularity */
+		if (h > w) {
+			ret = FALSE;
+		} else {
+			GelETree *t = gel_matrixw_get_index(m,h-1,h-1);
+			if (t == NULL ||
+			    mpw_zero_p (t->val.value))
+				ret = FALSE;
+		}
+		return ret;
+	}
+	
 	matrix_rational = gel_is_matrix_value_only_rational (m);
 
 	mpw_init(tmp);
 	d = 0;
-	w = gel_matrixw_width (m);
-        h = gel_matrixw_height (m);
 
 	if (reduce) {
-		pivots = g_new0 (int, h);
+		pivots = g_alloca (sizeof(int) * h);
 	}
 
 	for (i = 0; i < w && d < h; i++) {
@@ -447,7 +461,6 @@
 			ret = FALSE;
 			if(stopsing) {
 				mpw_clear(tmp);
-				g_free (pivots);
 				return FALSE;
 			}
 			continue;
@@ -496,7 +509,6 @@
 					if ( ! mul_sub_row (ctx, simul, d, tmp, j) &&
 					     stopsing) {
 						mpw_clear(tmp);
-						g_free (pivots);
 						return FALSE;
 					}
 				}
@@ -528,7 +540,6 @@
 					    t != NULL &&
 					    t->type != VALUE_NODE) {
 						mpw_clear(tmp);
-						g_free (pivots);
 						return FALSE;
 					}
 				}
@@ -540,7 +551,6 @@
 			if ( ! div_row (ctx, simul, d, piv->val.value) &&
 			    stopsing) {
 				mpw_clear(tmp);
-				g_free (pivots);
 				return FALSE;
 			}
 		}
@@ -561,14 +571,12 @@
 					if ( ! mul_sub_row (ctx, m, d, tmp, j) &&
 					     stopsing) {
 						mpw_clear(tmp);
-						g_free (pivots);
 						return FALSE;
 					}
 					if(simul) {
 						if ( ! mul_sub_row (ctx, simul, d, tmp, j) &&
 						     stopsing) {
 							mpw_clear(tmp);
-							g_free (pivots);
 							return FALSE;
 						}
 					}
@@ -581,9 +589,11 @@
 		/* FIXME: this may fail!!! */
 		gel_mod_integer_rational (detop, ctx->modulo);
 	}
+
+	if (reduce && ! uppertriang)
+		m->rref = 1;
 	
 	mpw_clear(tmp);
-	g_free (pivots);
 	return ret;
 }