Пример #1
0
void
invert_number(void)
{
	unsigned int *a, *b;

	save();

	p1 = pop();

	if (iszero(p1))
		stop("divide by zero");

	if (isdouble(p1)) {
		push_double(1 / p1->u.d);
		restore();
		return;
	}

	a = mcopy(p1->u.q.a);
	b = mcopy(p1->u.q.b);

	MSIGN(b) = MSIGN(a);
	MSIGN(a) = 1;

	p1 = alloc();

	p1->k = NUM;

	p1->u.q.a = b;
	p1->u.q.b = a;

	push(p1);

	restore();
}
Пример #2
0
//***********************************************************************
// set $EXTRACT
//
short DSetextract(u_char *tmp, cstring *cptr, mvar *var,
		  int i1, int i2)		// Set $EXTRACT()
{ cstring *vptr;				// where the variable goes
  short s;					// for the functions
  int i;					// a handy int

  if (i1 < 1) i1 = 1;				// ensure i1 positive
  if (i1 > i2) return 0;			// ignore that, it's junk
  if (i2 > MAX_STR_LEN) return -ERRM75;		// complain if too long
  vptr = (cstring *) tmp;			// where it goes
  s = Dget1(vptr->buf, var);			// get current value
  if (s < 0) return s;				// die on error
  vptr->len = s;				// save the size
  for (i = s; i < i1; vptr->buf[i++] = ' ');	// ensure enough spaces
  if (s <= i2)					// if no trailing left
  { s = mcopy(cptr->buf, &vptr->buf[i1 - 1], cptr->len); // copy it in
    if (s < 0) return s;			// check for overflow
    vptr->len = i1 - 1 + cptr->len;		// the new length
    if (var->uci == UCI_IS_LOCALVAR)
      return ST_Set(var, vptr);			// set it back and return
    return DB_Set(var, vptr);			// set it back and return
  }
  if ((i2 - i1 + 1) != cptr->len)		// not an exact fit?
  { s = mcopy(&vptr->buf[i2],			// move tail from here
	      &vptr->buf[i1 - 1 + cptr->len],	// to here
	      vptr->len - i2 + 2);		// this many bytes
    if (s < 0) return s;			// check overflow
  }
  bcopy(cptr->buf, &vptr->buf[i1 - 1], cptr->len); // can't use mcopy() here
  vptr->len = vptr->len - (i2 - i1 + 1) + cptr->len;
  if (var->uci == UCI_IS_LOCALVAR)
    return ST_Set(var, vptr);			// set it back and return
  return DB_Set(var, vptr);			// set it back and return
}
Пример #3
0
void
negate_number(void)
{
	save();
	p1 = pop();
	if (iszero(p1)) {
		push(p1);
		restore();
		return;
	}
	switch (p1->k) {
	case NUM:
		p2 = alloc();
		p2->k = NUM;
		p2->u.q.a = mcopy(p1->u.q.a);
		p2->u.q.b = mcopy(p1->u.q.b);
		MSIGN(p2->u.q.a) *= -1;
		push(p2);
		break;
	case DOUBLE:
		push_double(-p1->u.d);
		break;
	default:
		stop("bug caught in mp_negate_number");
		break;
	}
	restore();
}
Пример #4
0
Файл: Mgcd.c Проект: 8l/csolve
FN minvert(MINT *a, MINT *b, MINT *c)
{	MINT x, y, z, w, Anew, Aold;
	int i = 0;
	static MINT one;
	static int oneinit = 1;

	if (oneinit) {
		oneinit = 0;
		MSET(1,&one);
	}
	MINIT(&x);
	MINIT(&y);
	MINIT(&z);
	MINIT(&w);
	MINIT(&Aold);
	MSET (1,&Anew);

	mcopy(b, &x);
	mcopy(a, &y);
	/*
	 * Loop invariant:
	 *
	 * y = -1^i * Anew * a  mod b
	 */
	while(mtest(&y) != 0)
	{	mdiv(&x, &y, &w, &z);
		mcopy(&Anew, &x);
		mmult(&w, &Anew, &Anew);
		madd(&Anew, &Aold, &Anew);
		mmove(&x, &Aold);
		mmove(&y, &x);
		mmove(&z, &y);
		i++;
	}
	if (mcmp(&one,&x)) {
		mcopy(&one,c);
	} else {
		mmove(&Aold, c);
		if( (i&01) == 0) msub(b, c, c);
	}

	MFREE(&x);
	MFREE(&y);
	MFREE(&z);
	MFREE(&w);
	MFREE(&Aold);
	MFREE(&Anew);
}
Пример #5
0
short DB_GetLen( mvar *var, int lock, u_char *buf)	// length of node
{ short s;						// for returns
  int sav;						// save curr_lock

  if ((lock == -1) && (buf == NULL))			// just unlock?
  { if (curr_lock)					// if locked
    { SemOp( SEM_GLOBAL, -curr_lock);			// unlock it
    }
    return 0;						// exit
  }
  sav = curr_lock;					// save this
  s = Copy2local(var);					// get local copy
  curr_lock = sav;					// restore current lock
  if (s < 0)						// check for error
  { if (curr_lock)					// if locked
    { SemOp( SEM_GLOBAL, -curr_lock);			// release global lock
    }
    return s;						// and return
  }
  s = Get_data(0);					// attempt to get it

  if (s < 0)						// check for error
  { if (curr_lock)					// if locked
    { SemOp( SEM_GLOBAL, -curr_lock);			// release global lock
    }
    return s;						// and return
  }
  if (buf != NULL)					// want data?
  { s = mcopy(record->buf, buf, record->len);		// copy the data
  }
  if ((lock != 1) && (curr_lock))			// preserve lock?
  { SemOp( SEM_GLOBAL, -curr_lock);			// no - release it
  }
  return s;						// and exit
}
Пример #6
0
unsigned int *
mpow(unsigned int *a, unsigned int n)
{
	unsigned int *aa, *t;

	a = mcopy(a);

	aa = mint(1);

	for (;;) {

		if (n & 1) {
			t = mmul(aa, a);
			mfree(aa);
			aa = t;
		}

		n >>= 1;

		if (n == 0)
			break;

		t = mmul(a, a);
		mfree(a);
		a = t;
	}

	mfree(a);

	return aa;
}
Пример #7
0
int
readp(		/* get human-readable primitive */
	PRIMITIVE  *p,
	FILE  *fp
)
{
 char  inbuf[MAXARGS];
 register int  c, nargs;
 int  tmp;

 if (fp == NULL) fp = stdin;

 restart:
 
 if ((c = getc(fp)) == EOF) {		/* used to be fatal */
    mcopy((char *)p, (char *)&peof, sizeof(PRIMITIVE));
    return(0);
 }

 if (c == CDELIM) {			/* skip user comment */
    fgets(inbuf, MAXARGS, fp);
    goto restart;
 } else if (c == '\n')			/* skip empty line */
    goto restart;
    
 if (!iscom(c))
    error(USER, "bad command in readp");

 p->com = c;

 fscanf(fp, "%o", &tmp);
 p->arg0 = tmp & 0377;

 if (isglob(c))
    p->xy[XMN] = p->xy[YMN] = p->xy[XMX] = p->xy[YMX] = -1;
 else if (fscanf(fp, "%d %d %d %d", &p->xy[XMN], &p->xy[YMN],
				&p->xy[XMX], &p->xy[YMX]) != 4)
    error(USER, "missing extent in readp");

 while ((c = getc(fp)) != EOF && c != '\n' && c != ADELIM);

 nargs = 0;

 if (c == ADELIM)
    while ((c = getc(fp)) != EOF && c != '\n' && nargs < MAXARGS-1)
	inbuf[nargs++] = c;

 if (nargs >= MAXARGS)
     error(USER, "too many arguments in readp");

 if (nargs)  {
    inbuf[nargs] = '\0';
    p->args = savestr(inbuf);
    }
 else
    p->args = NULL;

 return(p->com != PEOF);
 }
Пример #8
0
char *
mstr(unsigned int *a)
{
	int k, n, r, sign;
	char c;

	if (str == NULL) {
		str = (char *) malloc(1000);
		len = 1000;
	}

	// estimate string size

	n = 10 * MLENGTH(a) + 2;

	if (n > len) {
		free(str);
		str = (char *) malloc(n);
		len = n;
	}

	sign = MSIGN(a);

	a = mcopy(a);

	k = len - 1;

	str[k] = 0;

	for (;;) {
		k -= 9;
		r = divby1billion(a);
		c = str[k + 9];
		sprintf(str + k, "%09d", r);
		str[k + 9] = c;
		if (MZERO(a))
			break;
	}

	// remove leading zeroes

	while (str[k] == '0')
		k++;

	if (str[k] == 0)
		k--;

	// sign

	if (sign == -1) {
		k--;
		str[k] = '-';
	}

	mfree(a);

	return str + k;
}
Пример #9
0
int main(){
   char s[100],t[100];
   int m;
   gets(s);
   scanf("%d",&m);
   mcopy(s, t, m);
   system("pause");
   
}
int exhaustive_scrabble_test(const char* filename)
{
	long result = errors_counter();
	// note that dictsize*keys*3 tests are performed
	size_t DICTSIZE = 10000, KEYS = 10;
	typedef std::vector<std::string> Dictionary;
	extern size_t fill_dictionary(const char*, Dictionary&, size_t, size_t = 0);
	Dictionary dictionary;
	size_t longest_in_file = fill_dictionary(filename, dictionary, DICTSIZE);
	std::random_shuffle(dictionary.begin(), dictionary.end());

	ScrabbleTst names;

	Dictionary::iterator dit;
	for (dit = dictionary.begin(); dit != dictionary.end(); dit += 4) {
		const std::string& name(*dit);
		names[name] = name.c_str();
	}

	int skip = dictionary.size() / KEYS;
	for(dit = dictionary.begin() + skip; dit != dictionary.end(); dit += skip)
	{
		std::string name(*dit);
		std::sort(name.begin(), name.end());
		for (int jokercount = 0; jokercount < 3; ++jokercount) {
			ScrabbleTst::search_results_list matchresults = names.create_search_results();
			names.combinatorial_search(name, std::back_inserter(matchresults), jokercount);
			//if (matchresults.size() == 0)
			//	std::cout << "couldn't find " << name << '\n';
			BOOST_CHECK(matchresults.size() != 0);
			ScrabbleTst matches;
			ScrabbleTst matchcount;
			size_t prevsize = 0;
			for (size_t i = 0; i != matchresults.size(); ++i) {
				std::string mcopy(matchresults[i].key());
				matchcount[mcopy] = mcopy.c_str();
				if (matchcount.size() > prevsize) {
					BOOST_CHECK(check_scrabble_found(name, mcopy, jokercount));
					++prevsize;
				}
				else {
					std::cout << "scrabble found duplicate " << mcopy << "\n";
				}
				std::sort(mcopy.begin(), mcopy.end());
				matches[mcopy] = mcopy.c_str();
			}
			// check for duplicates
			scrabble_findcount += matchresults.size();
			scrabble_duplicates += matchresults.size() - matchcount.size();
			BOOST_CHECK(matchcount.size() == matchresults.size());
			BOOST_CHECK(check_scrabble_missed(names, matches, jokercount));
		}
	}
	//std::cout << "scrabble duplicate matches " << scrabble_duplicates << " of " << scrabble_findcount << "\n";

	return errors_counter() - result;
}
Пример #11
0
void
mcopy(
  std::pair<T*, T*> const& d,
  std::pair<T*, T*> const& s,
  stride_type              d_stride_0,
  stride_type              d_stride_1,
  stride_type              s_stride_0,
  stride_type              s_stride_1,
  length_type              size_0,
  length_type              size_1)
{
  mcopy(d.first, s.first,
	    d_stride_0, d_stride_1,
	    s_stride_0, s_stride_1,
	    size_0, size_1);
  mcopy(d.second, s.second,
	    d_stride_0, d_stride_1,
	    s_stride_0, s_stride_1,
	    size_0, size_1);
}
Пример #12
0
  static void exec(DstBlock& dst, SrcBlock const& src, col2_type, col2_type)
  {
    vsip::impl::Ext_data<DstBlock> d_ext(dst, vsip::impl::SYNC_OUT);
    vsip::impl::Ext_data<SrcBlock> s_ext(src, vsip::impl::SYNC_IN);

    mcopy(
      d_ext.data(), s_ext.data(),
      d_ext.stride(1), d_ext.stride(0),
      s_ext.stride(1), s_ext.stride(0),
      d_ext.size(1), d_ext.size(0));
  }
Пример #13
0
short DB_QueryD(mvar *var, u_char *buf) 		// get next key
{ short s;						// for returns
//  int i;						// a handy int

  s = Copy2local(var);					// get local copy
  if (s < 0)
  { return s;						// exit on error
  }
  s = Get_data(0);					// try to find that
  if ((s < 0) && (s != -ERRM7))				// check for errors
  { if (curr_lock)					// if locked
    { SemOp( SEM_GLOBAL, -curr_lock);			// release global lock
    }
    return s;						// and return the error
  }
  if ((level == 0) && (s == -ERRM7))			// if no such global
  { buf[0] = '\0';					// null terminate ret
    if (curr_lock)					// if locked
    { SemOp( SEM_GLOBAL, -curr_lock);			// release global lock
    }
    return -(ERRMLAST+ERRZ55);				// and return
  }

  if ((s < 0) && (db_var.slen))				// If we had a "real"
  { Index--;						// <UNDEF> last time
  }							// back up Index

  s = Locate_next();					// point at next
  if (s < 0)						// not found or error
  { if (curr_lock)					// if locked
    { SemOp( SEM_GLOBAL, -curr_lock);			// release global lock
    }
    if (s == -ERRM7)					// if no more
    { s = -(ERRMLAST+ERRZ55);				// say 'at end'
    }
    return s;						// done
  }

//  for (i = 10; i <= Index; i++)			// scan to current
//  { chunk = (cstring *) &iidx[idx[i]];             	// point at the chunk
//    bcopy(&chunk->buf[2], &keybuf[chunk->buf[0]+1],
//	  chunk->buf[1]);				// update the key
//    keybuf[0] = chunk->buf[0] + chunk->buf[1];	// and the size
//  }
  bcopy(&keybuf[1], var->key, (int) keybuf[0]);		// copy in the key
  var->slen = keybuf[0];				// update the length
  s = mcopy(record->buf, buf, record->len);		// copy the data
  if (curr_lock)					// if locked
  { SemOp( SEM_GLOBAL, -curr_lock);			// release global lock
  }
  return s;						// return the count
}
Пример #14
0
bool Anchor::ray(float o[4],float d[4],float m[4][4]) {
	
	bool test=false;
	
	unsigned int f=0;
		
	float mori[4][4];
	
		for(f=0;f<this->countChildren;f++) {
		mcopy(m,mori);
		(this->children[f]->ray(o,d,mori)?test=true:test=test); // nada inteligente
	}

	this->cast=test;
	
	return(test);

}
Пример #15
0
int
mprime(unsigned int *n)
{
	int i, k;
	unsigned int *q;

	// 1?

	if (MLENGTH(n) == 1 && n[0] == 1)
		return 0;

	// 2?

	if (MLENGTH(n) == 1 && n[0] == 2)
		return 1;

	// even?

	if ((n[0] & 1) == 0)
		return 0;

	// n = 1 + (2 ^ k) q

	q = mcopy(n);

	k = 0;
	do {
		mshiftright(q);
		k++;
	} while ((q[0] & 1) == 0);

	// try 25 times

	for (i = 0; i < 25; i++)
		if (mprimef(n, q, k) == 0)
			break;

	mfree(q);

	if (i < 25)
		return 0;
	else
		return 1;
}
Пример #16
0
bool Inline::ray(float o[4],float d[4],float m[4][4]) {
	
	bool test=false;
	
	float mori[4][4];
	
	mcopy(m,mori);
	
	#ifdef DEBUG1
	cout << "m " << m[0][0] << "  " << m[0][1] << "  " << m[0][2] << "  " << m[0][3] << endl;
	cout << "  " << m[1][0] << "  " << m[1][1] << "  " << m[1][2] << "  " << m[1][3] << endl;
	cout << "  " << m[2][0] << "  " << m[2][1] << "  " << m[2][2] << "  " << m[2][3] << endl;
	cout << "  " << m[3][0] << "  " << m[3][1] << "  " << m[3][2] << "  " << m[3][3] << endl << endl;
	#endif
	
	(this->ixb->ray(o,d,mori)?test=true:test=test); // nada inteligente
	
	return(test);

}
Пример #17
0
short DB_Get(mvar *var, u_char *buf)           		// get global data
{ short s;						// for returns

  s = Copy2local(var);					// get local copy
  if (s < 0)
  { return s;						// exit on error
  }
  systab->vol[volnum-1]->stats.dbget++;                 // update stats
  s = Get_data(0);					// attempt to get it
  if (s >= 0)						// if worked
  { if (bcmp("$GLOBAL\0", &db_var.name.var_cu[0], 8) == 0) // if ^$G
    { s = itocstring(buf, *(u_int *) record);		// block number
    }
    else
    { s = mcopy(record->buf, buf, record->len);		// copy the data
    }
  }
  if (curr_lock)					// if locked
  { SemOp( SEM_GLOBAL, -curr_lock);			// release global lock
  }
  return s;						// return the count
}
Пример #18
0
int main(int argc, char const *argv[])
{
  int len;
  int max;

  char line[MAXLINE];
  char longest[MAXLINE];

  max = 0;

  while((len = mgetline(line, MAXLINE)) > 0){
    if(len > max){
      max = len;
      mcopy(longest, line);
    }

  }

  if(max > 0)
    printf("%s", longest);

  return 0;
}
Пример #19
0
//***********************************************************************
// $VIEW(channel#,location[,size[,value]])
//
short Dview(u_char *ret_buffer, int chan, int loc,
            int size, cstring *value)
{ int i;					// a handy int
  u_char *vb;					// view buffer address

  if (chan > -1) return -(ERRMLAST+ERRZ63);	// must be negative for now
  chan = (-chan) - 1;				// negate it and 0 base
  if (partab.jobtab->view[chan] == NULL)	// got a block
    return -(ERRMLAST+ERRZ63);			// no - die
  vb = (u_char *) partab.jobtab->view[chan]->mem; // get block mem address
  if ((loc < 0) || 
      (size < 1) ||
      ((loc + size) > systab->vol[chan]->vollab->block_size))
    return -(ERRMLAST+ERRZ63);			// out of range - die
  vb = vb + loc;				// offset to locn
  if (value == NULL)				// a read?
  { if (size == 1)
      return itocstring(ret_buffer, *vb);	// one byte
    if (size == 2)
      return itocstring(ret_buffer, *((u_short *) vb)); // two bytes
    if (size == 4)
      return itocstring(ret_buffer, *((u_int *) vb)); // four bytes
    return mcopy(vb, ret_buffer, size);		// return the string
  }
  ret_buffer[0] = '\0';				// null terminate
  if ((size == 1) || (size == 2) || (size == 4)) // int type?
  { i = cstringtoi(value);			// make int of it
    if (size == 1) *vb = (u_char) i;
    else if (size == 2) *((u_short *) vb) = (u_short) i;
    else *((u_int *) vb) = i;			// set some int type
  }
  else
  { if (size != value->len) return -(ERRMLAST+ERRZ63); // junk
    bcopy(value->buf, vb, size);		// copy whatever
  }
  return 0;					// return OK
}
Пример #20
0
Файл: Msqrt.c Проект: 8l/csolve
msqrt(MINT *a, MINT *b, MINT *r)
{	MINT x,y,z;
	register alen,j;

	MINIT(&x); MINIT(&y); MINIT(&z);
	alen = a->len;

	if (alen<0) mpfatal("msqrt: neg arg");
	if (alen==0) {
		mset(0,b);
		mset(0,r);
		return(0);
	}

	if(alen & 01) x.len = (1+alen)/2;
	else x.len = 1 + alen/2;
	valloc(x.val,x.len);
	for (j=x.len; (--j)>=0;) x.val[j]=0;
	if (alen & 01) x.val[x.len-1]=0400;
	else x.val[x.len-1]=1;

	for (;;) {
		mdiv(a,&x,&y,&z);
		madd(&x,&y,&y);
		mshiftr(&y,1);
		if (mcmp(&x,&y) <= 0) break;
		mmove(&y,&x);
	}
	mcopy(&x,&y);
	mmult(&x,&x,&x);
	msub(a,&x,r);
	MFREE(&x);
	MMOVEFREE(&y,b);
	MFREE(&z);
	return(r->len);
}
Пример #21
0
void
mp_denominator(void)
{
	save();

	p1 = pop();

	if (p1->k != NUM) {
		push(one);
		restore();
		return;
	}

	p2 = alloc();

	p2->k = NUM;

	p2->u.q.a = mcopy(p1->u.q.b);
	p2->u.q.b = mint(1);

	push(p2);

	restore();
}
Пример #22
0
short Dstack1x(u_char *ret_buffer, int level, int job)
{ int i;					// a usefull int
  ret_buffer[0] = '\0';				// null terminate
  if (level < -1) return 0;			// junk
  i = systab->jobtab[job].cur_do;		// default
  if (systab->jobtab[job].error_frame > systab->jobtab[job].cur_do)
    i = systab->jobtab[job].error_frame;	// ensure we have the error bit
  if (level > i) return 0;			// nothing there
  if (level == -1)
    return itocstring(ret_buffer, i);		// return the number
  if (level == 0)
  { if (systab->jobtab[job].dostk[0].type == TYPE_JOB)
      return mcopy((u_char *) "JOB", ret_buffer, 3);	// for a JOB command
    return mcopy((u_char *) "RUN", ret_buffer, 3);		// normal run
  }
  if (level == systab->jobtab[job].error_frame) level = STM1_FRAME; // err frame
  i = systab->jobtab[job].dostk[level].type & 127; // get the type
  if (i == TYPE_RUN) return mcopy((u_char *) "BREAK", ret_buffer, 5);
  if (i == TYPE_DO) return mcopy((u_char *) "DO", ret_buffer, 2);
  if (i == TYPE_EXTRINSIC) return mcopy((u_char *) "$$", ret_buffer, 2);
  if (i == TYPE_XECUTE) return mcopy((u_char *) "XECUTE", ret_buffer, 6);
  ret_buffer[0] = '\0';
  return 0;					// else nothing
}
Пример #23
0
/*******************************************************************
 Subroutine to compute the inverse matrix and determinant
   matrix *cov:        the pointer to the covariance matrix
   matrix *inv_cov:    the pointer to the inverse covariance matrix
   matrix *cov_mat:    the pointer to the approximate covariance matrix
                       when singular. If unsingular, it equals to cov
   double *det_cov:    the pointer to determinant

 return value: '1' - successfully exit
               '0' - exit with waring/error
*******************************************************************/
int veCov(matrix *cov, matrix *inv_cov, matrix *cov_mat, 
		  double *det_cov)
{
	int i, j;
	matrix eigvec_re;
	matrix eigvec_im;
	vector eigval_re;
	vector eigval_im;
    int *eig_order;
	int eig_info;
	int num_v;  // the number of eigenvalue
	int rank_c; 
	double sum_v;
	double factor = 0.02;
	double ass_value;
	double min_real;

    mnew(&eigvec_re, cov->m, cov->n);
    mnew(&eigvec_im, cov->m, cov->n);
	vnew(&eigval_re, cov->n);
	vnew(&eigval_im, cov->n);
    eig_order = new int[cov->n];
    

    // the eigenvector and eigenvalue of covariance matrix
    eig_info = eig(cov, &eigvec_re, &eigvec_im, &eigval_re, &eigval_im);
	//vprint(&eigval_re);
	//vprint(&eigval_im);

	if (!eig_info) {
		printf(" The eigenvalue computation failed! \n");
		return 0;
		//....
	}
	
	// the rank of covariance matrix
	num_v = cov->n;
	
	/*rank_c = num_v;
	for (i=0; i<num_v; i++) {
		if ((fabs(*(eigval_re.pr+i)) < ZEROTHRESH) && (fabs(*(eigval_im.pr+i)) < ZEROTHRESH)) {
			rank_c--;
		}
	}
	printf("rank = %d", rank_c);*/

	rank_c = rank(cov, TOLERANCE);

	// compute the inverse and determinate
    if (rank_c == num_v) {  // nonsingular
		inv(cov, inv_cov);
		mcopy(cov, cov_mat);
		*det_cov = det(cov);
	
	} else {  // singular
		min_real = pow(10, (((double)-250) / ((double) cov->m)));

		/*for (i=0; i<num_v; i++) {
			if ((*(eigval_re.pr+i) < ZEROTHRESH) || (*(eigval_im.pr+i) != 0)) {
				*(eigval_re.pr+i) = 0;  // ???? keep the real part of complex or not
				*(eigval_im.pr+i) = 0;
			}
		}
		sort(&eigval_re, eig_order, 'd'); */

		for (i=0; i<num_v; i++) {
			// when negtive real eigenvalue, change to absolute value
			//   to ensure all the real eigenvalues are positive
			if ((eigval_re.pr[i] < 0) && (eigval_im.pr[i] == 0)) {
				eigval_re.pr[i] *= -1;
				// the i-th column of eigenvector should also be changed the sign
				for (j=0; j<(eigvec_re.m); j++) {
					eigvec_re.pr[j*(eigvec_re.n)+i] *= -1;
				}
			}
		}

		//vprint(&eigval_re);
		//vprint(&eigval_im);

		// sort real eigenvalues descendingly, put complex ones at the end
		sorteig(&eigval_re, &eigval_im, eig_order);

		for (i=rank_c; i<num_v; i++) {
				*(eigval_re.pr+i) = 0;
				*(eigval_im.pr+i) = 0;
		}

		//vprint(&eigval_re);
		//vprint(&eigval_im);

		sum_v = vsum(&eigval_re);

		ass_value = factor * sum_v / (num_v - rank_c);

		if (ass_value < (0.5 * (*(eigval_re.pr+rank_c)) * (1 - factor))) {
			if (ass_value > min_real) {
				for (i=rank_c; i<num_v; i++) {
					*(eigval_re.pr+i) = ass_value;
				}
				for (i=0; i<rank_c; i++) {
					*(eigval_re.pr+i) *= 1 - factor;
				}
			} else {
				for (i=rank_c; i<num_v; i++) {
					*(eigval_re.pr+i) = min_real;
				}
			}
		} else {
			ass_value = 0.5 * (*(eigval_re.pr+rank_c)) * (1 - factor);
			if (ass_value > min_real) {
				for (i=rank_c; i<num_v; i++) {
					*(eigval_re.pr+i) = ass_value;
				}
				for (i=0; i<rank_c; i++) {
					*(eigval_re.pr+i) = *(eigval_re.pr+i) - ass_value * (num_v - rank_c) * (*(eigval_re.pr+i)) / sum_v;
				}
			} else {
				for (i=rank_c; i<num_v; i++) {
					*(eigval_re.pr+i) = min_real;
				}
			}
		}
        
		//vprint(&eigval_re);
		//vprint(&eigval_im);

		matrix eigvec_re_sorted;
		matrix eigvec_re_sorted_t;
		mnew(&eigvec_re_sorted, num_v, num_v);
		mnew(&eigvec_re_sorted_t, num_v, num_v);

		sortcols(eig_order, &eigvec_re, &eigvec_re_sorted);
		transpose(&eigvec_re_sorted, &eigvec_re_sorted_t); 

		matrix inv_eig_vl_s;
		mnew(&inv_eig_vl_s, num_v, num_v);
		for (i=1; i<num_v; i++) {
			*(inv_eig_vl_s.pr + i*num_v + i) = 1 / (*(eigval_re.pr+i));    
		}
		
		matrix tmp;
		mnew(&tmp, num_v, num_v);

		mmMul(&eigvec_re_sorted, &inv_eig_vl_s, &tmp);
		mmMul(&tmp, &eigvec_re_sorted_t, inv_cov);

		matrix diag_eigval;
		mnew(&diag_eigval, num_v, num_v);
		for (i=0; i<num_v; i++) {
			*(diag_eigval.pr + i*num_v + i) = *(eigval_re.pr+i);    
		}
		mmMul(&eigvec_re_sorted, &diag_eigval, &tmp);
		mmMul(&tmp, &eigvec_re_sorted_t, cov_mat);

		*det_cov = 1;
		for (i=0; i<num_v; i++) {
			*det_cov = (*det_cov) * (*(eigval_re.pr+i)); 
		}

		mdelete(&inv_eig_vl_s);
		mdelete(&eigvec_re_sorted);
		mdelete(&eigvec_re_sorted_t);
		mdelete(&tmp);
		mdelete(&diag_eigval);

	}

	#ifdef _DEBUG
	printf("rank = %d \n", rank_c);
	printf("\n det_cov = %e \n", *det_cov);
	printf("inv_cov = \n");
	mprint(inv_cov);
	printf("cov_mat = \n");
	mprint(cov_mat);
	#endif

    mdelete(&eigvec_re);
	mdelete(&eigvec_im);
	vdelete(&eigval_re);
	vdelete(&eigval_im);
    delete []eig_order;

    return 1;
}
Пример #24
0
void tex::handle_right_brace ()
	{
	scal	d;
	int	f;
	ptr	p;
	ptr	q;
	
	switch (cur_group)
	{
	case SIMPLE_GROUP:
		unsave();
		break;
	
	case BOTTOM_LEVEL:
		print_err("Too many }'s");
		help_close_group();
		error();
		break;
	
	case SEMI_SIMPLE_GROUP:
	case MATH_SHIFT_GROUP:
	case MATH_LEFT_GROUP:
		extra_right_brace();
		break;

	case HBOX_GROUP:
		package(0);
		break;
	
	case ADJUSTED_HBOX_GROUP:
		tex::adjust_tail = tex::adjust_head;
		package(0);
		break;
	
	case VBOX_GROUP:
		end_graf();
		package(0);
		break;
	
	case VTOP_GROUP:
		end_graf();
		package(VTOP_CODE);
		break;

	case INSERT_GROUP:
		end_graf();
		q = split_top_skip;
		add_glue_ref(q);
		d = split_max_depth;
		f = floating_penalty;
		unsave();
		decr(save_ptr);
		p = vpack(link(head), 0, ADDITIONAL);
		pop_nest();
		if (saved(0) < 255) {
			tail_append(new_node(INS_NODE_SIZE));
			type(tail) = INS_NODE;
			subtype(tail) = saved(0);
			ins_height(tail) = box_height(p) + box_depth(p);
			ins_ptr(tail) = list_ptr(p);
			split_top_ptr(tail) = q;
			ins_depth(tail) = d;
			float_cost(tail) = f;
		} else {
			tail_append(new_node(SMALL_NODE_SIZE));
			type(tail) = ADJUST_NODE;
			subtype(tail) = 0;
			adjust_ptr(tail) = list_ptr(p);
			delete_glue_ref(q);
		}
		free_node(p, BOX_NODE_SIZE);
		if (nest_ptr == nest) 
			build_page();
		break;
	
	case OUTPUT_GROUP:
		if (loc != null
		|| (token_type != OUTPUT_TEXT && token_type != BACKED_UP)) {
			print_err("Unbalanced output routine");
			help_output_balance();
			error();
			do get_token();
			while (loc != null);
		}
		end_token_list();
		end_graf();
		unsave();
		output_active = FALSE;
		insert_penalties = 0;
		if (box(255) != null) {
			print_err("Output routine didn't use all of ");
			print_esc("box255");
			help_output();
			box_error(255);
		}
		if (tail != head) {
			link(page_tail) = link(head);
			page_tail = tail;
		}
		if (link(page_head) != null) {
			if (link(contrib_head) == null)
				contrib_tail = page_tail;
			link(page_tail) = link(contrib_head);
			link(contrib_head) = link(page_head);
			link(page_head) = null;
			page_tail = page_head;
		}
		pop_nest();
		build_page();
		break;
	
	case DISC_GROUP:
		build_discretionary();
		break;
	
	case ALIGN_GROUP:
		back_input();
		cur_tok = sym2tok(FROZEN_CR);
		print_err("Missing ");
		print_esc("cr");
		print(" inserted");
		help_align_cr();
		ins_error(); 
		break;

	case NO_ALIGN_GROUP:
		end_graf();
		unsave();
		align_peek();
		break;
	
	case VCENTER_GROUP:
		end_graf();
		unsave();
		save_ptr -= 2;
		p = vpackage(link(head), saved(1), saved(0), MAX_DIMEN);
		pop_nest();
		tail_append(new_noad());
		type(tail) = VCENTER_NOAD;
		math_type(nucleus(tail)) = SUB_BOX;
		info(nucleus(tail)) = p;
		break;
	
	case MATH_CHOICE_GROUP:
		build_choices();
		break;

	case MATH_GROUP:
		unsave();
		decr(save_ptr);
		math_type(saved(0)) = SUB_MLIST;
		p = fin_mlist(null);
		math_link(saved(0)) = p;
		if (p != null) {
			if (link(p) == null) {
				if (type(p) == ORD_NOAD) {
					if (math_type(subscr(p)) == EMPTY
					&& math_type(supscr(p)) == EMPTY) {
						mcopy(saved(0), nucleus(p));
						free_node(p, NOAD_SIZE);
					}
				} else if (type(p) == ACCENT_NOAD
					&& saved(0) == nucleus(tail)
					&& type(tail) == ORD_NOAD) {
					q = head;
					while (link(q) != tail)
						q = link(q);
					link(q) = p;
					free_node(tail, NOAD_SIZE);
					tail = p;
				}
			}
		}
		break;
	
	default:
		confusion("rightbrace");
		break;
	}
}
Пример #25
0
//***********************************************************************
// set $PIECE
//
short DSetpiece(u_char *tmp, cstring *cptr, mvar *var,
		cstring *dptr, int i1, int i2)	// Set $PIECE()
{ cstring *vptr;				// where the variable goes
  short s;					// for the functions
  int beg = 0;                                  // start copy from
  int end;                                      // copy to
  int pce = 1;                                  // current piece
  int f;                                        // found flag
  int j;                                        // for delim scan
  int np;					// number of pieces

  if (i1 < 1) i1 = 1;				// ensure i1 positive
  if (i1 > i2) return 0;			// ignore that, it's junk
  vptr = (cstring *) tmp;			// where it goes
  s = Dget1(vptr->buf, var);			// get current value
  if (s < 0) return s;				// die on error
  vptr->len = s;				// save the size
  if (dptr->len == 0)				// null delimiter ?
  { s = mcopy(cptr->buf, &vptr->buf[vptr->len], cptr->len); // copy at end
    if (s < 0) return s;			// die on error
    vptr->len = vptr->len + cptr->len;		// the new length
    if (var->uci == UCI_IS_LOCALVAR)
      return ST_Set(var, vptr);			// set it back and return
    return DB_Set(var, vptr);			// set it back and return
  }
  np = Dlength2x(vptr, dptr);			// get number of pieces
  if (np < i1)					// current < = start
  { f = i1 - np;				// delimiters required
    for (j = 0; j < f; j++)			// for each required delimiter
    { s = mcopy(dptr->buf, &vptr->buf[vptr->len], dptr->len); // copy 1 delim
      if (s < 0) return s;			// check for overflow
      if ((vptr->len+s)>MAX_STR_LEN) return -ERRM75;
      vptr->len += s;				// add to length
    }
    s = mcopy(cptr->buf, &vptr->buf[vptr->len], cptr->len); // copy in source
    vptr->len += s;				// add to length
    if (var->uci == UCI_IS_LOCALVAR)
      return ST_Set(var, vptr);			// set it back and return
    return DB_Set(var, vptr);			// set it back and return
  }
  for (end = 0; end < vptr->len; end++)         // scan expr
  { if (vptr->buf[end] == dptr->buf[0])         // if first char matches
    { f = 1;                                    // set found flag
      for (j = 1; j < dptr->len; j++)           // scan rest of delimiter
      { if (vptr->buf[end+j] != dptr->buf[j])   // if we have a mismatch
        { f = 0;                                // clear found flag
          break;                                // and quit
        }
      }                                         // end delim scan
      if (f == 1)                               // just quit the if on fail
      { if (pce == i2)                          // if this is last piece
        { end--;                                // point at last reqd char
          break;                                // and quit for loop
        }                                       // end last piece processing
        pce++;                                  // increment current piece
        end = end + dptr->len - 1;              // point at last char of delim
        if (pce == i1) beg = end + 1;		// if this is the first pce
      }                                         // end found code
    }                                           // end of got match
  }                                             // end of expr scan
  if (np == i1)					// replace last piece
  { s = mcopy(cptr->buf, &vptr->buf[beg], cptr->len); // copy it
    vptr->len = beg + cptr->len;		// fixup length
    if (var->uci == UCI_IS_LOCALVAR)
      return ST_Set(var, vptr);			// set it back and return
    return DB_Set(var, vptr);			// set it back and return
  }
  if (end >= vptr->len) end = vptr->len - 1;	// don't point past end
  i1 = beg;					// start of cut
  i2 = end;					// end of cut
  if ((i2 - i1 + 1) != cptr->len)		// not an exact fit?
  { s = mcopy(&vptr->buf[i2 + 1],		// move tail from here
	      &vptr->buf[i1 + cptr->len],	// to here
	      vptr->len - i2 + 2);		// this many bytes
    if (s < 0) return s;			// check overflow
  }
  if (cptr->len)
    bcopy(cptr->buf, &vptr->buf[i1], cptr->len); // can't use mcopy() here
  vptr->len = vptr->len - (i2 - i1 + 1) + cptr->len;
  if (var->uci == UCI_IS_LOCALVAR)
    return ST_Set(var, vptr);			// set it back and return
  return DB_Set(var, vptr);			// set it back and return
}
Пример #26
0
//***********************************************************************
// $TEXT(entryref)
//
// the entire string "entryref" is passed in one variable, eval it here
//
short Dtext(u_char *ret_buffer, cstring *str)	// $TEXT()
{ int i = 0;					// a handy int
  int j = 0;					// and another
  u_char slen;					// saved length
  short s;					// for functions
  int off = 1;					// line offset
  u_char rou[4+MAX_NAME_BYTES];			// routine name
  u_char tag[4+MAX_NAME_BYTES];			// the tag
  cstring *cr;					// the rou
  cstring *ct;					// and the tag

  ret_buffer[0] = '\0';				// JIC
  ct = (cstring *) &tag[0];			// use it this way
  cr = (cstring *) &rou[0];			// ditto  
  ct->len = 0;					// assume no tag
  cr->len = 0;					// no routine for now

  if (bcmp("+0\0", str->buf, 3) == 0)		// $T(+0) ?
  { for (i = 0; i < MAX_NAME_BYTES; i++)		// copy rou name
    { if (!partab.jobtab->dostk[partab.jobtab->cur_do].rounam.var_cu[i])
        break;					// quit when done
      ret_buffer[i] = 
        partab.jobtab->dostk[partab.jobtab->cur_do].rounam.var_cu[i]; // copy
    }
    ret_buffer[i] = '\0';			// null terminate
    return (short) i;				// and exit
  }
  if ((str->buf[i] != '+') && (str->buf[i] != '^')) // is there a tag
  { while (j < MAX_NAME_BYTES)
    { if ((i == 0) && (str->buf[i] == '%'))	// leading %
      { ct->buf[j++] = str->buf[i++];		// copy it
        continue;				// and go for more
      }
      if (isalnum(str->buf[i]) == 0) break;	// done
      ct->buf[j++] = str->buf[i++];		// copy it
    }
    ct->buf[j] = '\0';				// null terminate tag
    ct->len = j;				// save the length
    off = 0;					// change offset to zero
    while ((str->buf[i] != '+') &&
	   (str->buf[i] != '^') &&
	   (str->buf[i] != '\0')) i++;		// skip to + ^ or null
  }						// end tag processing
  if (str->buf[i] == '+')			// if we have a plus
  { off = 0;					// clear offset
    i++;					// skip the +
    while (isdigit(str->buf[i]) != 0)		// for all digits
      off = (off * 10) + (str->buf[i++] - '0');	// extract the offset
  }						// end offset stuf
  if ((str->buf[i] != '^') && (str->buf[i] != '\0'))
    return -(ERRMLAST + ERRZ12);		// complain
  j = 0;					// clear rou ptr
  if (str->buf[i] == '^')			// routine name
  { i++;					// skip the ^
    while (j < MAX_NAME_BYTES)
    { if ((j == 0) && (str->buf[i] == '%'))	// leading %
      { cr->buf[j++] = str->buf[i++];		// copy it
        continue;				// and go for more
      }
      if (isalnum(str->buf[i]) == 0) break;	// done
      cr->buf[j++] = str->buf[i++];		// copy it
    }
    cr->buf[j] = '\0';				// null terminate rou
    cr->len = j;				// save the length
  }
  else						// we need the current routine
  { for (j = 0; j < MAX_NAME_BYTES; j++)
      if ((cr->buf[j] = 
            partab.jobtab->dostk[partab.jobtab->cur_do].rounam.var_cu[j])
		== '\0') break;			// copy till done
    cr->buf[j] = '\0';				// null terminate rou
    cr->len = j;				// save the length
  }
  if (cr->len == 0) return 0;			// no routine supplied -> null
  if ((ct->len == 0) && (!off))			// just the name reqd?
    return mcopy(cr->buf, ret_buffer, cr->len);	// return the name
  X_set("$ROUTINE", &partab.src_var.name.var_cu[0], 8); // setup for DB_Get
  partab.src_var.volset = partab.jobtab->rvol;	// vol
  partab.src_var.uci = partab.jobtab->ruci;	// uci
  if (cr->buf[0] == '%')			// manager routine?
    partab.src_var.uci = 1;			// point there
  partab.src_var.slen = 0;			// init key size
  s = UTIL_Key_Build(cr, &partab.src_var.key[0]); // first key
  if (s < 0) return s;				// die on error
  slen = s;					// save key size
  if (ct->len == 0)				// no tag?
  { ct->len = itocstring(ct->buf, off);		// cstring off
    s = UTIL_Key_Build(ct,
		       &partab.src_var.key[slen]); // next key
    if (s < 0) return s;			// die on error
    partab.src_var.slen = s + slen;		// save key size
    s = DB_Get(&partab.src_var, ret_buffer);	// get it
    if (s < 0)
    { ret_buffer[0] = '\0';			// nothing
      s = 0;					// zero length
    }
    return s;					// and return it
  }
  for (j = 1; ; j++)				// need to read all lines
  { cr->len = itocstring(cr->buf, j);		// cstring j
    s = UTIL_Key_Build(cr,
		       &partab.src_var.key[slen]); // next key
    if (s < 0) return s;			// die on error
    partab.src_var.slen = s + slen;		// save key size
    s = DB_Get(&partab.src_var, ret_buffer);	// get it
    if (s < 0)
    { ret_buffer[0] = '\0';			// nothing
      return 0;					// zero length
    }
    for (i = 0; i < ct->len; i++)		// check the tag
      if (ret_buffer[i] != ct->buf[i]) break;	// quit if different
    if (i < ct->len) continue;			// go for next if no match
    if ((ret_buffer[i] != ' ') &&		// must be space
        (ret_buffer[i] != '(') &&		//	or (
	(ret_buffer[i] != '\0')) continue;	//	or null
    if (off == 0) return s;			// no offset - all done
    j = j + off;				// add the offset
    cr->len = itocstring(cr->buf, j);		// cstring j
    s = UTIL_Key_Build(cr,
		       &partab.src_var.key[slen]); // next key
    if (s < 0) return s;			// die on error
    partab.src_var.slen = s + slen;		// save key size
    s = DB_Get(&partab.src_var, ret_buffer);	// get it
    if (s < 0)
    { ret_buffer[0] = '\0';			// nothing
      s = 0;					// zero length
    }
    return s;					// done
  }
}
Пример #27
0
static int
mprimef(unsigned int *n, unsigned int *q, int k)
{
	int i, j;
	unsigned int *t, *x, *y;

	// generate x

	t = mcopy(n);

	while (1) {
		for (i = 0; i < MLENGTH(t); i++)
			t[i] = rand();
		x = mmod(t, n);
		if (!MZERO(x) && !MEQUAL(x, 1))
			break;
		mfree(x);
	}

	mfree(t);

	// exponentiate

	y = mmodpow(x, q, n);

	// done?

	if (MEQUAL(y, 1)) {
		mfree(x);
		mfree(y);
		return 1;
	}

	j = 0;

	while (1) {

		// y = n - 1?

		t = msub(n, y);

		if (MEQUAL(t, 1)) {
			mfree(t);
			mfree(x);
			mfree(y);
			return 1;
		}

		mfree(t);

		if (++j == k) {
			mfree(x);
			mfree(y);
			return 0;
		}

		// y = (y ^ 2) mod n

		t = mmul(y, y);
		mfree(y);
		y = mmod(t, n);
		mfree(t);

		// y = 1?

		if (MEQUAL(y, 1)) {
			mfree(x);
			mfree(y);
			return 0;
		}
	}
}
Пример #28
0
/*******************************************************************
 Subroutine to do the EM algorithm
   matrix *D:       the pointer to the matrix data
   matrix *mean0_x: the pointer to a matrix containing the initial Means of clusters
   vector *w0:		the pointer to a vector containing the initial mixing proportion of clusters
   double vv:       the value for initializing the Covariance matrix of clusters
   double error:    the error threshold
   vector *Zjk_up:  the pointer to a vector containing Posterior probabilities of the up-level 
                         cluster samples
   matrix *mean1_x: the pointer to a matrix containing the Means of clusters in t-space
   vector *w0_t:	the pointer to a vector containing the mixing proportions of the identified 
                         clusters in t-space
   matrix *cov_mat: the pointer to a group of matrixs containing the Covariance
                         matrix of clusters in t-space
   matrix *Zjk:     the pointer to a matrix containing Posterior probabilities of all samples 
                         belonging to all the sub-level clusters, each column is for one cluster.
   
 return value: '1' - successfully exit
               '0' - exit with waring/error
*******************************************************************/
int veSubEM(matrix *D, matrix *mean0_x, vector *w0, double vv, double error, vector *Zjk_up, //input
			matrix *mean1_x, vector *w0_t, matrix *cov_mat, matrix *Zjk)  //output
{
	int k0, kc, n, p;
	int i, j, k, u, s;
	matrix *Var0;
	matrix Gxn;
	vector Fx;
	matrix MUK;
	matrix MU1;
	int zeroFx_num = 1;
	//double error = 0.01;
	double err = error + (double)1;
	vector Zjk_temp;

	n = D->m;
	p = D->n;
	k0 = mean0_x->m;
	kc = mean0_x->n;
	
	Var0 = new matrix[k0];
	for(i=0; i<k0; i++) {
		mnew(Var0+i, p, p);
	}
	mnew(&Gxn, n, k0);
	vnew(&Fx, n);
	vnew(&Zjk_temp, n);
	mnew(&MUK, k0, p);
	mcopy(mean0_x, &MUK);
	mnew(&MU1, k0, p);

	vector D_j;
	vector Zjk_k;
	double sum_tmp = 0;
	matrix Ck;
	vector D_i;
	vector MUK_k;
	vector cen_D_i;
	matrix mtmp;
	vector vtmp;

	vnew(&D_j, n);
	vnew(&Zjk_k, n);
	mnew(&Ck, p, p);
	vnew(&D_i, p);
	vnew(&MUK_k, p);
	vnew(&cen_D_i, p);
	mnew(&mtmp, p, p);
	vnew(&vtmp, n);

	//Initializing the parameters of mixture of Gaussians
	//Initinalize the covariance matrix
	//Use EM algorithm to perform the local training.
	
	//Test intialization of covarinace matrix 
	//printf("Testing covariance matrix initialization... \n");

	while (zeroFx_num != 0) {
		for(i=0; i<k0; i++) {
			meye(Var0+i);
			for (j=0; j<p; j++) {
				*((Var0+i)->pr+j*p+j) = vv;
			}
		}
	
		veModel(D, mean0_x, Var0, w0, &Gxn, &Fx);
		//printf("\n Gxn = :\n");
		//mprint(&Gxn);
		//printf("\n Fx = :\n");
		//vprint(&Fx);

		zeroFx_num = 0;
		for (i=0; i<n; i++) {
			if (*(Fx.pr+i) == 0) {
				zeroFx_num++;
			}
		}

		vv *= 2;
	
	}

	vones(&Zjk_temp);

	//printf("\n EM in t-space starts ... \n");
	//printf("\n Data = \n");
	//mprint(D);

	int l = 0;
	while (err > error) {
		
		#ifdef _DEBUG
		printf(" \n...... in EM loop %d ......\n", ++l);

		printf("\n L%d: w0 = \n", l);
		vprint(w0);
		printf("\n L%d: MUK = \n", l);
		mprint(&MUK);
		printf("\n L%d: Var0 = \n", l);
		for(i=0; i<k0; i++) {
			mprint(Var0+i);
			printf("\n");
		}
		printf("\n L%d: Zjk = \n", l);
		mprint(Zjk);
		#endif

		veModel(D, &MUK, Var0, w0, &Gxn, &Fx);
		
		#ifdef _DEBUG
		printf("\n L%d: Gxn = \n", l);
		mprint(&Gxn);
		printf("\n L%d: Fx = \n", l);
		vprint(&Fx);
		#endif

		for (k=0; k<k0; k++) {
			u = k*p;

			double zz = 0;
			double zz_up = 0;
			for (i=0; i<n; i++) {
				*(Zjk->pr+i*k0+k) = (*(w0->pr+k)) * Zjk_up->pr[i] * (*(Gxn.pr+i*k0+k)) / (*(Fx.pr+i));
				zz += *(Zjk->pr+i*k0+k);
				zz_up += Zjk_up->pr[i];
			}
			*(w0->pr+k) = zz/zz_up;

			for (j=0; j<p; j++) {
				getcolvec(D, j, &D_j);
				getcolvec(Zjk, k, &Zjk_k);
				sum_tmp = 0;
				for (i=0; i<n; i++) {
					sum_tmp += (*(Zjk_k.pr+i)) * (*(D_j.pr+i));
				}
				*(MU1.pr+u+j) = sum_tmp / zz;
			}

			mzero(&Ck);
			for (i=0; i<n; i++) {
				getrowvec(D, i, &D_i);
				getrowvec(&MUK, k, &MUK_k);
				for (j=0; j<p; j++) {
					*(cen_D_i.pr+j) = *(D_i.pr+j) - *(MUK_k.pr+j);
				}

				vvMul(&cen_D_i, &cen_D_i, &mtmp);
				
				for (j=0; j<p; j++) {
					for (s=0; s<p; s++) {
						*(Ck.pr+j*p+s) += (*(Zjk->pr+i*k0+k)) * (*(mtmp.pr+j*p+s));
					}
				}
			}
			for (j=0; j<p; j++) {
				for (s=0; s<p; s++) {
					*(Var0[k].pr+j*p+s) = (*(Ck.pr+j*p+s)) / zz;
				}
			}
		}   // for (k...

		mcopy(&MU1, &MUK);

		for (i=0; i<n; i++) {
			*(vtmp.pr+i) = fabs(*(Zjk_k.pr+i) - *(Zjk_temp.pr+i));
		}
		err = vmean(&vtmp);
		vcopy(&Zjk_k, &Zjk_temp);
		
		
    }  // while

	vcopy(w0, w0_t);
	mcopy(&MUK, mean1_x);
	for(i=0; i<k0; i++) {
		mcopy(Var0+i, cov_mat+i);
	}

	for(i=0; i<k0; i++) {
		mdelete(Var0+i);
	} 
	mdelete(&Gxn);
	vdelete(&Fx);
	vdelete(&Zjk_temp);
	mdelete(&MUK);
	mdelete(&MU1);
    vdelete(&D_j);
	vdelete(&Zjk_k);
	mdelete(&Ck);
	vdelete(&D_i);
	vdelete(&MUK_k);
	vdelete(&cen_D_i);
	mdelete(&mtmp);
	vdelete(&vtmp);

    return 1;
}
Пример #29
0
unsigned int *
mgcd(unsigned int *u, unsigned int *v)
{
	int i, k, n;
	unsigned int *t;

	if (MZERO(u)) {
		t = mcopy(v);
		MSIGN(t) = 1;
		return t;
	}

	if (MZERO(v)) {
		t = mcopy(u);
		MSIGN(t) = 1;
		return t;
	}

	u = mcopy(u);
	v = mcopy(v);

	MSIGN(u) = 1;
	MSIGN(v) = 1;

	k = 0;

	while ((u[0] & 1) == 0 && (v[0] & 1) == 0) {
		mshiftright(u);
		mshiftright(v);
		k++;
	}

	if (u[0] & 1) {
		t = mcopy(v);
		MSIGN(t) *= -1;
	} else
		t = mcopy(u);

	while (1) {

		while ((t[0] & 1) == 0)
			mshiftright(t);

		if (MSIGN(t) == 1) {
			mfree(u);
			u = mcopy(t);
		} else {
			mfree(v);
			v = mcopy(t);
			MSIGN(v) *= -1;
		}

		mfree(t);

		t = msub(u, v);

		if (MZERO(t)) {
			mfree(t);
			mfree(v);
			n = (k / 32) + 1;
			v = mnew(n);
			MSIGN(v) = 1;
			MLENGTH(v) = n;
			for (i = 0; i < n; i++)
				v[i] = 0;
			mp_set_bit(v, k);
			t = mmul(u, v);
			mfree(u);
			mfree(v);
			return t;
		}
	}
}
Пример #30
0
short Dstack2x(u_char *ret_buffer, int level, cstring *code, int job)
{ int arg2 = 0;					// arg 2 1 = ECODE
						//       2 = MCODE
						//	 3 = PLACE
  var_u *rounam;				// routine name
  int line;					// line number
  int i;					// a handy int
  u_char *p;					// a handy pointer
  mvar *var;					// for ^$R()
  u_char temp[3*MAX_NAME_BYTES];		// ditto
  cstring *cptr;				// ditto
  short s;					// ditto

  ret_buffer[0] = '\0';				// null terminate
  if (level < 0) return 0;			// junk
  i = systab->jobtab[job].cur_do;		// default
  if (systab->jobtab[job].error_frame > systab->jobtab[job].cur_do)
    i = systab->jobtab[job].error_frame;	// ensure we have the error bit
  if (level > i) return 0;			// nothing there
  if (strncasecmp((const char *) code->buf, "ecode\0", 6) == 0) arg2 = 1;
  else if (strncasecmp((const char *) code->buf, "mcode\0", 6) == 0) arg2 = 2;
  else if (strncasecmp((const char *) code->buf, "place\0", 6) == 0) arg2 = 3;
  else return (-(ERRZ50+ERRMLAST));		// junk
  if (arg2 == 1)				// "ECODE"
  { ret_buffer[0] = '\0';			// assume nothing
    if (job != (partab.jobtab - systab->jobtab)) return (0); // can't find
    var = (mvar *) ret_buffer;			// use same space for mvar
    X_set("$ECODE\0\0", &var->name.var_cu[0], 8);// copy in $ECODE
    var->volset = 0;
    var->uci = UCI_IS_LOCALVAR;
    cptr = (cstring *) temp;			// some spare space
    cptr->len = itocstring(cptr->buf, level);	// setup for subscript
    var->slen = UTIL_Key_Build(cptr, &var->key[0]);
    s = ST_Get(var, ret_buffer);		// get and return
    if (s == -ERRM6) s = 0;			// allow for not there
    return s;
  }
  if ((level == systab->jobtab[job].error_frame) &&
      (level)) level = STM1_FRAME; 		// err frame adjust
  if ((((systab->jobtab[job].dostk[level].type & 127) == TYPE_XECUTE) ||
       ((systab->jobtab[job].dostk[level].type & 127) == TYPE_RUN) ||
       ((systab->jobtab[job].dostk[level].type & 127) == TYPE_JOB)) &&
       //(systab->jobtab[job].dostk[level].rounam.var_qu == 0))
       (X_Empty(systab->jobtab[job].dostk[level].rounam.var_xu)))
  { if (arg2 == 2)				// "MCODE"
    { ret_buffer[0] = '\0';			// JIC
      if (systab->jobtab[job].cur_do < level) return 0; // no can do
      if (job != (partab.jobtab - systab->jobtab)) return (0); // can't find
      p = (u_char *)systab->jobtab[job].dostk[level].routine;
      if (p == NULL) return 0;			// nothing there
      for (i = 0; ((ret_buffer[i] = p[i])); i++); // copy it
      return i;					// return the count
    }
    return mcopy((u_char *) "XECUTE", ret_buffer, 6);	// "PLACE"
  }
  rounam = &(systab->jobtab[job].dostk[level].rounam); // point at routine name
  line = systab->jobtab[job].dostk[level].line_num; // get line number
  if (arg2 == 2)				// "MCODE"
  { var = (mvar *) ret_buffer;			// use same space for mvar
    X_set("$ROUTINE", &var->name.var_cu[0], 8); // copy in $ROUTINE
    var->volset = systab->jobtab[job].rvol;	// vol number
    var->uci = systab->jobtab[job].ruci;	// uci number
    if (rounam->var_cu[0] == '%') var->uci = 1;	// check for a percent rou
    cptr = (cstring *) temp;			// some spare space
    for (i = 0; i < MAX_NAME_BYTES; i++)	// copy name
    { if (rounam->var_cu[i] == 0) break;	// quit when done
      cptr->buf[i] = rounam->var_cu[i];		// copy
    }
    cptr->buf[i] = '\0';			// null terminate
    cptr->len = i;				// save the length
    s = UTIL_Key_Build(cptr, &var->key[0]);	// make a key from it
    if (s < 0) return s;			// die on error
    var->slen = (u_char) s;			// save the length
    cptr->len = itocstring(cptr->buf, line);	// make a string from int
    s = UTIL_Key_Build(cptr, &var->key[var->slen]); // make a key from it
    if (s < 0) return s;			// die on error
    var->slen = (u_char) s + var->slen;		// save the length
    s = Dget1(ret_buffer, var);			// get data
    if (s < 0) s = 0;				// ignore errors
    ret_buffer[s] = '\0';			// null terminate
    return s;					// and return
  }
  i = 0;					// the start
  ret_buffer[i++] = '+';			// add plus
  i = i + itocstring(&ret_buffer[i], line);	// add the line number
  ret_buffer[i++] = '^';			// the name indicator
  for (arg2 = 0; arg2 < MAX_NAME_BYTES; arg2++)	// copy name
    if ((ret_buffer[i++] = rounam->var_cu[arg2]) == 0) break;
  if (ret_buffer[i-1] == '\0') i--;		// back up over null
  ret_buffer[i] = '\0';				// null terminate
  return i;  					// return length
}