Esempio n. 1
0
double objective(gsl_matrix *A, gsl_vector *b, double lambda, gsl_vector *z) {
	double obj = 0;
	gsl_vector *Azb = gsl_vector_calloc(A->size1);
	gsl_blas_dgemv(CblasNoTrans, 1, A, z, 0, Azb);
	gsl_vector_sub(Azb, b);
	double Azb_nrm2;
	gsl_blas_ddot(Azb, Azb, &Azb_nrm2);
	obj = 0.5 * Azb_nrm2 + lambda * gsl_blas_dasum(z);
	gsl_vector_free(Azb);
	return obj;
}
Esempio n. 2
0
/* ----------- evaluate the objective function --------------*/
double objective(gsl_vector *x, double lambda, gsl_vector *z, int N) {
  double obj = 0;
  double temp =0.0;
  temp = gsl_blas_dnrm2(z);
  temp = temp*temp/(double)(2.0*N);
  double foo;
  foo = gsl_blas_dasum(x);
  //  double recv;
  //  MPI_Allreduce(&foo, &recv, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
  obj = lambda*foo + temp;
  return obj;
}
Esempio n. 3
0
int
gsl_linalg_balance_columns (gsl_matrix * A, gsl_vector * D)
{
  const size_t N = A->size2;
  size_t j;

  if (D->size != A->size2)
    {
      GSL_ERROR("length of D must match second dimension of A", GSL_EINVAL);
    }
  
  gsl_vector_set_all (D, 1.0);

  for (j = 0; j < N; j++)
    {
      gsl_vector_view A_j = gsl_matrix_column (A, j);
      
      double s = gsl_blas_dasum(&A_j.vector);
      
      double f = 1.0;
      
      if (s == 0.0 || !gsl_finite(s))
        {
          gsl_vector_set (D, j, f);
          continue;
        }

      /* FIXME: we could use frexp() here */

      while (s > 1.0)
        {
          s /= 2.0;
          f *= 2.0;
        }
      
      while (s < 0.5)
        {
          s *= 2.0;
          f /= 2.0;
        }
      
      gsl_vector_set (D, j, f);

      if (f != 1.0)
        {
          gsl_blas_dscal(1.0/f, &A_j.vector);
        }
    }

  return GSL_SUCCESS;
}
Esempio n. 4
0
double normal_null_maximum(gsl_vector *means,gsl_vector *s) {
  assert(means->size == s->size);
  
  // Baskara coefs.
  double a,b,c;

  gsl_vector *s2=gsl_vector_alloc(means->size);
  gsl_blas_dcopy(s,s2);
  gsl_vector_mul(s2,s2);

  gsl_vector *B=gsl_vector_alloc(means->size);
  gsl_blas_dcopy(means,B);
  gsl_blas_dscal(-2.0,B);
  //printf("B=%lg %lg\n",ELTd(B,0),ELTd(B,1));

  gsl_vector *C=gsl_vector_alloc(means->size);
  gsl_blas_dcopy(means,C);
  gsl_vector_mul(C,C);

  gsl_vector *prods=gsl_vector_alloc(means->size);
  mutual_prod(s2,prods);

  a=gsl_blas_dasum(prods);
  gsl_blas_ddot(B,prods,&b);
  gsl_blas_ddot(C,prods,&c);

  printf("null max: a=%lf b=%lf c=%lf\n",a,b,c);

  double delta=b*b-4*a*c;
  double x0=-b/(2.0*a);
  printf("null max: delta=%lg\n",delta);
  
  if (fabs(delta) < 1e-5) {
    return x0; 
  } else {
    if (delta > 0) {
      double x1=(-b-sqrt(delta))/(2.0*a);
      double x2=(-b-sqrt(delta))/(2.0*a);
      
      printf("null max: x1=%lg x2=%lg\n",x1,x2);
      return x1;
    } else {
      printf("WARNING: Null max not found!\n");
      return x0;
    }
  }
}
Esempio n. 5
0
 /**
  * C++ version of gsl_blas_dasum().
  * @param X A vector
  * @return The absolute sum of the elements
  */
 double dasum( vector const& X ){ return gsl_blas_dasum( X.get() ); }
Esempio n. 6
0
static int BasicTest(
  size_t n,
  const int bound_on_0,
  const int bound_on_1,
  const int bound_on_2,
  const int bound_on_3,
  const char *lattice_name,
  const UINT8 total_ref_0,
  const UINT8 total_ref_1,
  const UINT8 total_ref_2,
  const UINT8 total_ref_3
  )
{

  const int bound_on[4] = {bound_on_0, bound_on_1, bound_on_2, bound_on_3};
  const UINT8 total_ref[4] = {total_ref_0, total_ref_1, total_ref_2, total_ref_3};

  // Create lattice tiling
  LatticeTiling *tiling = XLALCreateLatticeTiling(n);
  XLAL_CHECK(tiling != NULL, XLAL_EFUNC);

  // Add bounds
  for (size_t i = 0; i < n; ++i) {
    XLAL_CHECK(bound_on[i] == 0 || bound_on[i] == 1, XLAL_EFAILED);
    XLAL_CHECK(XLALSetLatticeTilingConstantBound(tiling, i, 0.0, bound_on[i] * pow(100.0, 1.0/n)) == XLAL_SUCCESS, XLAL_EFUNC);
  }

  // Set metric to the Lehmer matrix
  const double max_mismatch = 0.3;
  {
    gsl_matrix *GAMAT(metric, n, n);
    for (size_t i = 0; i < n; ++i) {
      for (size_t j = 0; j < n; ++j) {
        const double ii = i+1, jj = j+1;
        gsl_matrix_set(metric, i, j, jj >= ii ? ii/jj : jj/ii);
      }
    }
    XLAL_CHECK(XLALSetTilingLatticeAndMetric(tiling, lattice_name, metric, max_mismatch) == XLAL_SUCCESS, XLAL_EFUNC);
    GFMAT(metric);
    printf("Number of (tiled) dimensions: %zu (%zu)\n", XLALTotalLatticeTilingDimensions(tiling), XLALTiledLatticeTilingDimensions(tiling));
    printf("  Bounds: %i %i %i %i\n", bound_on_0, bound_on_1, bound_on_2, bound_on_3);
    printf("  Lattice type: %s\n", lattice_name);
  }

  // Create lattice tiling locator
  LatticeTilingLocator *loc = XLALCreateLatticeTilingLocator(tiling);
  XLAL_CHECK(loc != NULL, XLAL_EFUNC);
  if (lalDebugLevel & LALINFOBIT) {
    printf("  Index trie:\n");
    XLAL_CHECK(XLALPrintLatticeTilingIndexTrie(loc, stdout) == XLAL_SUCCESS, XLAL_EFUNC);
  }

  for (size_t i = 0; i < n; ++i) {

    // Create lattice tiling iterator and locator over 'i+1' dimensions
    LatticeTilingIterator *itr = XLALCreateLatticeTilingIterator(tiling, i+1);
    XLAL_CHECK(itr != NULL, XLAL_EFUNC);

    // Count number of points
    const UINT8 total = XLALTotalLatticeTilingPoints(itr);
    printf("Number of lattice points in %zu dimensions: %" LAL_UINT8_FORMAT "\n", i+1, total);
    XLAL_CHECK(imaxabs(total - total_ref[i]) <= 1, XLAL_EFUNC,
               "ERROR: |total - total_ref[%zu]| = |%" LAL_UINT8_FORMAT " - %" LAL_UINT8_FORMAT "| > 1", i, total, total_ref[i]);
    for (UINT8 k = 0; XLALNextLatticeTilingPoint(itr, NULL) > 0; ++k) {
      const UINT8 itr_index = XLALCurrentLatticeTilingIndex(itr);
      XLAL_CHECK(k == itr_index, XLAL_EFUNC,
                 "ERROR: k = %" LAL_UINT8_FORMAT " != %" LAL_UINT8_FORMAT " = itr_index", k, itr_index);
    }
    XLAL_CHECK(XLALResetLatticeTilingIterator(itr) == XLAL_SUCCESS, XLAL_EFUNC);

    // Check tiling statistics
    printf("  Check tiling statistics ...");
    for (size_t j = 0; j < n; ++j) {
      const LatticeTilingStats *stats = XLALLatticeTilingStatistics(tiling, j);
      XLAL_CHECK(stats != NULL, XLAL_EFUNC);
      XLAL_CHECK(imaxabs(stats->total_points - total_ref[j]) <= 1, XLAL_EFAILED, "\n  "
                 "ERROR: |total - total_ref[%zu]| = |%" LAL_UINT8_FORMAT " - %" LAL_UINT8_FORMAT "| > 1", j, stats->total_points, total_ref[j]);
      XLAL_CHECK(stats->min_points <= stats->avg_points, XLAL_EFAILED, "\n  "
                 "ERROR: min_points = %" LAL_INT4_FORMAT " > %g = avg_points", stats->min_points, stats->avg_points);
      XLAL_CHECK(stats->max_points >= stats->avg_points, XLAL_EFAILED, "\n  "
                 "ERROR: max_points = %" LAL_INT4_FORMAT " < %g = avg_points", stats->max_points, stats->avg_points);
    }
    printf(" done\n");

    // Get all points
    gsl_matrix *GAMAT(points, n, total);
    XLAL_CHECK(XLALNextLatticeTilingPoints(itr, &points) == (int)total, XLAL_EFUNC);
    XLAL_CHECK(XLALNextLatticeTilingPoint(itr, NULL) == 0, XLAL_EFUNC);

    // Get nearest points to each template, check for consistency
    printf("  Testing XLALNearestLatticeTiling{Point|Block}() ...");
    gsl_vector *GAVEC(nearest, n);
    UINT8Vector *nearest_indexes = XLALCreateUINT8Vector(n);
    XLAL_CHECK(nearest_indexes != NULL, XLAL_ENOMEM);
    for (UINT8 k = 0; k < total; ++k) {
      gsl_vector_const_view point_view = gsl_matrix_const_column(points, k);
      const gsl_vector *point = &point_view.vector;
      XLAL_CHECK(XLALNearestLatticeTilingPoint(loc, point, nearest, nearest_indexes) == XLAL_SUCCESS, XLAL_EFUNC);
      gsl_vector_sub(nearest, point);
      double err = gsl_blas_dasum(nearest) / n;
      XLAL_CHECK(err < 1e-6, XLAL_EFAILED, "\n  "
                 "ERROR: err = %e < 1e-6", err);
      XLAL_CHECK(nearest_indexes->data[i] == k, XLAL_EFAILED, "\n  "
                 "ERROR: nearest_indexes[%zu] = %" LAL_UINT8_FORMAT " != %" LAL_UINT8_FORMAT "\n", i, nearest_indexes->data[i], k);
      if (0 < i) {
        const LatticeTilingStats *stats = XLALLatticeTilingStatistics(tiling, i);
        UINT8 nearest_index = 0;
        UINT4 nearest_left = 0, nearest_right = 0;
        XLAL_CHECK(XLALNearestLatticeTilingBlock(loc, point, i, nearest, &nearest_index, &nearest_left, &nearest_right) == XLAL_SUCCESS, XLAL_EFUNC);
        XLAL_CHECK(nearest_index == nearest_indexes->data[i-1], XLAL_EFAILED, "\n  "
                   "ERROR: nearest_index = %" LAL_UINT8_FORMAT " != %" LAL_UINT8_FORMAT "\n", nearest_index, nearest_indexes->data[i-1]);
        UINT4 nearest_len = 1 + nearest_left + nearest_right;
        XLAL_CHECK(nearest_len <= stats->max_points, XLAL_EFAILED, "\n  "
                   "ERROR: nearest_len = %i > %i = stats[%zu]->max_points\n", nearest_len, stats->max_points, i);
      }
      if (i+1 < n) {
        const LatticeTilingStats *stats = XLALLatticeTilingStatistics(tiling, i+1);
        UINT8 nearest_index = 0;
        UINT4 nearest_left = 0, nearest_right = 0;
        XLAL_CHECK(XLALNearestLatticeTilingBlock(loc, point, i+1, nearest, &nearest_index, &nearest_left, &nearest_right) == XLAL_SUCCESS, XLAL_EFUNC);
        XLAL_CHECK(nearest_index == nearest_indexes->data[i], XLAL_EFAILED, "\n  "
                   "ERROR: nearest_index = %" LAL_UINT8_FORMAT " != %" LAL_UINT8_FORMAT "\n", nearest_index, nearest_indexes->data[i]);
        UINT4 nearest_len = 1 + nearest_left + nearest_right;
        XLAL_CHECK(nearest_len <= stats->max_points, XLAL_EFAILED, "\n  "
                   "ERROR: nearest_len = %i > %i = stats[%zu]->max_points\n", nearest_len, stats->max_points, i+1);
      }
    }
    printf(" done\n");

    // Cleanup
    XLALDestroyLatticeTilingIterator(itr);
    GFMAT(points);
    GFVEC(nearest);
    XLALDestroyUINT8Vector(nearest_indexes);

  }

  for (size_t i = 0; i < n; ++i) {

    // Create alternating lattice tiling iterator over 'i+1' dimensions
    LatticeTilingIterator *itr_alt = XLALCreateLatticeTilingIterator(tiling, i+1);
    XLAL_CHECK(itr_alt != NULL, XLAL_EFUNC);
    XLAL_CHECK(XLALSetLatticeTilingAlternatingIterator(itr_alt, true) == XLAL_SUCCESS, XLAL_EFUNC);

    // Count number of points, check for consistency with non-alternating count
    UINT8 total = 0;
    while (XLALNextLatticeTilingPoint(itr_alt, NULL) > 0) ++total;
    XLAL_CHECK(imaxabs(total - total_ref[i]) <= 1, XLAL_EFUNC, "ERROR: alternating |total - total_ref[%zu]| = |%" LAL_UINT8_FORMAT " - %" LAL_UINT8_FORMAT "| > 1", i, total, total_ref[i]);

    // Cleanup
    XLALDestroyLatticeTilingIterator(itr_alt);

  }

  // Cleanup
  XLALDestroyLatticeTiling(tiling);
  XLALDestroyLatticeTilingLocator(loc);
  LALCheckMemoryLeaks();
  printf("\n");
  fflush(stdout);

  return XLAL_SUCCESS;

}
Esempio n. 7
0
static VALUE rb_gsl_blas_dasum(int argc, VALUE *argv, VALUE obj)
{
  gsl_vector *x = NULL;
  get_vector1(argc, argv, obj, &x);
  return rb_float_new(gsl_blas_dasum(x));
}
Esempio n. 8
0
void checkSLE(const gsl_matrix* A, const gsl_vector* x, 
              const gsl_vector* b, const int N) {
//	TODO - make complete logging to the file
//	print("Checking the solution of the SLE ... ");

	// Checking on condition number of matrix A
	int signum;
	gsl_permutation *perm = gsl_permutation_alloc(N);
	gsl_matrix *LU = gsl_matrix_alloc(N, N);
	gsl_matrix *invA = gsl_matrix_alloc(N, N);
	gsl_matrix_memcpy(LU, A);
	gsl_linalg_LU_decomp(LU, perm, &signum);
	gsl_linalg_LU_invert(LU, perm, invA);
	gsl_matrix_free(LU);
	gsl_permutation_free(perm);
	gsl_vector *row = gsl_vector_alloc(N);
	double normA = 0;
	double normInvA = 0;
	for(int i = 0; i < N; i++) {
		gsl_matrix_get_row(row, A, i);
		double dasum = gsl_blas_dasum(row);
		if (dasum > normA) normA = dasum;
		gsl_matrix_get_row(row, invA, i);
		dasum = gsl_blas_dasum(row);
		if (dasum > normInvA) normInvA = dasum;
	}
	double conditionNumber = normA * normInvA;
	if (conditionNumber > 1000)
		//print("Condition number of matrix of SLE is ", conditionNumber);
	gsl_vector_free(row);
	
	// Checking on Ax == b
	gsl_vector *tmp = gsl_vector_alloc(N);
	gsl_vector_memcpy(tmp, b);
	// tmp = A*x - b, i.e. error
	gsl_blas_dgemv(CblasNoTrans, 1, A, x, -1, tmp);
	for(int i = 0; i < N; i++) {
		if (fabs(gsl_vector_get(tmp, i) / gsl_vector_get(b, i)) > 1e-8) {
			if (gsl_vector_get(b, i) == 0) {
				if (fabs(gsl_vector_get(tmp, i)) > 1e-8)
					print("Ax =", gsl_vector_get(tmp, i), "at string", i,
					      ". But b = 0 here.");
			} else {
				print("( Ax - b ) / b =", 
				      gsl_vector_get(tmp, i) / gsl_vector_get(b, i),
				      "at string", i);
			}
		}
	}
	
	// Checking on inv(A)b == x
	gsl_vector_memcpy(tmp, x);
	// tmp = inv(A)*b - x, i.e. error
	gsl_blas_dgemv(CblasNoTrans, 1, invA, b, -1, tmp);
	for(int i = 0; i < N; i++) {
		if (fabs(gsl_vector_get(tmp, i) / gsl_vector_get(x, i)) > 1e-8)
			print("( inv(A)b - x ) / x =",
			      gsl_vector_get(tmp, i) / gsl_vector_get(x, i),
			      "at string ", i);
	}
	
	gsl_vector_free(tmp);
	gsl_matrix_free(invA);
	
//	TODO - make complete logging to the file	
//	print("Checking is done.");
}
int Holling2(double t, const double y[], double ydot[], void *params){

	double alpha	= 0.3;						// respiration
	double lambda	= 0.65;						// ecologic efficiency
	double hand	= 0.35;						// handling time
	double beta	= 0.5;						// intraspecific competition
	double aij	= 6.0;						// attack rate
	//double migratingPop = 0.01;
	
	int i, j,l	= 0;						// Hilfsvariablen
	double rowsum	= 0;	
	//double colsum	= 0;		  

// 	int test = 0;
// 	
// 	if(test<5)
// 	{
// 	  printf("Richtiges Holling");
// 	}
// 	test++;
//-- Struktur zerlegen-------------------------------------------------------------------------------------------------------------------------------

  	struct foodweb *nicheweb = (struct foodweb *)params;			// pointer cast from (void*) to (struct foodweb*)
	//printf("t in Holling 2=%f\n", t);
	gsl_vector *network = (nicheweb->network);						// Inhalt: A+linksA+Y+linksY+Massen+Trophische_Level = (Rnum+S)²+1+Y²+1+(Rnum+S)+S

	int S 	 	= nicheweb->S;
	int Y 	 	= nicheweb->Y;
	int Rnum	= nicheweb->Rnum;
	//double d  	= nicheweb->d;
	int Z 		= nicheweb->Z;
	//double dij 	= pow(10, d);
	double Bmigr = gsl_vector_get(network, (Rnum+S)*(S+Rnum)+1+Y*Y+1+(Rnum+S)+S);
	//printf("Bmigr ist %f\n", Bmigr);
	
	double nu,mu, tau;
	
	int SpeciesNumber;
	
	tau =  gsl_vector_get(nicheweb->migrPara,0);
	
	mu = gsl_vector_get(nicheweb->migrPara,1);
// 	if((int)nu!=0)
// 	{
// 	  printf("nu ist nicht null sondern %f\n",nu);
// 	}
	
	nu = gsl_vector_get(nicheweb->migrPara,2);
	
	SpeciesNumber = gsl_vector_get(nicheweb->migrPara,3);
	double tlast = gsl_vector_get(nicheweb->migrPara,4);
	
//  	if(SpeciesNumber!= 0)
// 	{
// 	  //printf("SpeciesNumber %i\n", SpeciesNumber);
// 	}
	  //printf("t oben %f\n",t);
		//int len	 = (Rnum+S)*(Rnum+S)+2+Y*Y+(Rnum+S)+S;
	
	gsl_vector_view A_view = gsl_vector_subvector(network, 0, (Rnum+S)*(Rnum+S));						// Fressmatrix A als Vektor
	gsl_matrix_view EA_mat = gsl_matrix_view_vector(&A_view.vector, (Rnum+S), (Rnum+S));				// A als Matrix_view
	gsl_matrix *EAmat	   = &EA_mat.matrix;															// A als Matrix

	gsl_vector_view D_view = gsl_vector_subvector(network, (Rnum+S)*(Rnum+S)+1, Y*Y);					// Migrationsmatrix D als Vektor
	gsl_matrix_view ED_mat = gsl_matrix_view_vector(&D_view.vector, Y, Y);								// D als Matrixview
	gsl_matrix *EDmat	   = &ED_mat.matrix;		// D als Matrix
	
	
	gsl_vector_view M_vec  = gsl_vector_subvector(network, ((Rnum+S)*(Rnum+S))+1+(Y*Y)+1, (Rnum+S));	// Massenvektor
	gsl_vector *Mvec	   = &M_vec.vector;
	
	
 //-- verändere zu dem gewünschten Zeitpunkt Migrationsmatrix	
	
	if( (t > tau) && (tlast < tau))
	{	
	    //printf("mu ist %f\n", gsl_vector_get(nicheweb->migrPara,1));
	    //printf("nu ist %f\n", nu);
	    gsl_vector_set(nicheweb->migrPara,4,t);

	    //printf("Setze Link für gewünschte Migration\n");
// 	    printf("t oben %f\n",t);
// 	    printf("tlast oben %f\n",tlast);
	    gsl_matrix_set(EDmat, nu, mu, 1.);
	    //int m;
// 	    for(l = 0; l< Y;l++)
// 	    {
// 		for(m=0;m<Y;m++)
// 		{
// 		  printf("%f\t",gsl_matrix_get(EDmat,l,m));
// 		}
// 	     printf("\n");
// 	    }
	}
	else
	{
	  gsl_matrix_set_zero(EDmat);
	}
	

	


			
// 			printf("\ncheckpoint Holling2 I\n");
// 			printf("\nS = %i\n", S);
// 			printf("\nS + Rnum = %i\n", S+Rnum);
// 
// 			printf("\nSize A_view = %i\n", (int)A_view.vector.size);
// 			printf("\nSize D_view = %i\n", (int)D_view.vector.size);
// 			printf("\nSize M_vec  = %i\n", (int)M_vec.vector.size);


// 			for(i=0; i<(Rnum+S)*Y; i++){
// 				printf("\ny = %f\n", y[i]);
// 				}

// 			for(i=0; i<(Rnum+S)*Y; i++){
// 			printf("\nydot = %f\n", ydot[i]);
// 			}
		

//--zusätzliche Variablen anlegen-------------------------------------------------------------------------------------------------------------

  double ytemp[(Rnum+S)*Y];		 
	for(i=0; i<(Rnum+S)*Y; i++) ytemp[i] = y[i];							// temp array mit Kopie der Startwerte
 	
  for(i=0; i<(Rnum+S)*Y; i++) ydot[i] = 0;									// Ergebnis, in das evolve_apply schreibt
 						
  gsl_vector_view yfddot_vec	= gsl_vector_view_array(ydot, (Rnum+S)*Y);		//Notiz: vector_view_array etc. arbeiten auf den original Daten der ihnen zugeordneten Arrays/Vektoren!
  gsl_vector *yfddotvec		= &yfddot_vec.vector;							// zum einfacheren Rechnen ydot über vector_view_array ansprechen
  
  gsl_vector_view yfd_vec	= gsl_vector_view_array(ytemp, (Rnum+S)*Y);
  gsl_vector *yfdvec		= &yfd_vec.vector;								// Startwerte der Populationen

//-- neue Objekte zum Rechnen anlegen--------------------------------------------------------------------------------------------------------

  gsl_matrix *AFgsl	= gsl_matrix_calloc(Rnum+S, Rnum+S);	// matrix of foraging efforts
//   gsl_matrix *ADgsl	= gsl_matrix_calloc(Y,Y); 				// matrix of migration efforts
  
  gsl_matrix *Emat	= gsl_matrix_calloc(Rnum+S, Rnum+S);	// gsl objects for calculations of populations 
  gsl_vector *tvec	= gsl_vector_calloc(Rnum+S);
  gsl_vector *rvec	= gsl_vector_calloc(Rnum+S);
  gsl_vector *svec	= gsl_vector_calloc(Rnum+S);
  
//   gsl_matrix *Dmat	= gsl_matrix_calloc(Y,Y);				// gsl objects for calculations of migration
//   gsl_vector *d1vec	= gsl_vector_calloc(Y);
  gsl_vector *d2vec	= gsl_vector_calloc(Y);
  gsl_vector *d3vec	= gsl_vector_calloc(Y);
  
//	printf("\ncheckpoint Holling2 III\n");

//-- Einzelne Patches lösen------------------------------------------------------------------------------------------------------------    
  for(l=0; l<Y; l++)								// start of patch solving
  {
    gsl_matrix_set_zero(AFgsl);						// Objekte zum Rechnen vor jedem Patch nullen 
    gsl_matrix_set_zero(Emat);
    gsl_vector_set_zero(tvec);
    gsl_vector_set_zero(rvec);
    gsl_vector_set_zero(svec);
    
    gsl_vector_view ydot_vec = gsl_vector_subvector(yfddotvec, (Rnum+S)*l, (Rnum+S));	// enthält ydot von Patch l
    gsl_vector *ydotvec 	 = &ydot_vec.vector;

    gsl_vector_view y_vec	 = gsl_vector_subvector(yfdvec, (Rnum+S)*l, (Rnum+S));		// enthält Startwerte der Population in l
    gsl_vector *yvec 		 = &y_vec.vector;
    
    gsl_matrix_memcpy(AFgsl, EAmat);
    
    for(i=0; i<Rnum+S; i++)
    {
      gsl_vector_view rowA   = gsl_matrix_row(AFgsl,i);
      				  rowsum = gsl_blas_dasum(&rowA.vector);
      if(rowsum !=0 )
      {
		for(j=0; j<Rnum+S; j++)
	    gsl_matrix_set(AFgsl, i, j, (gsl_matrix_get(AFgsl,i,j)/rowsum));				// normiere Beute Afgsl = A(Beutelinks auf 1 normiert) = f(i,j)
      }
    }
    
    gsl_matrix_memcpy(Emat, EAmat);									//  Emat = A
    gsl_matrix_scale(Emat, aij);									//  Emat(i,j) = a(i,j)
    gsl_matrix_mul_elements(Emat, AFgsl);							//  Emat(i,j) = a(i,j)*f(i,j)

    gsl_vector_memcpy(svec, yvec);									// s(i) = y(i)
    gsl_vector_scale(svec, hand);									// s(i) = y(i)*h
    gsl_blas_dgemv(CblasNoTrans, 1, Emat, svec, 0, rvec);			// r(i) = Sum_k h*a(i,k)*f(i,k)*y(k)
    gsl_vector_add_constant(rvec, 1);								// r(i) = 1+Sum_k h*a(i,k)*f(i,k)*y(k)
    	
    gsl_vector_memcpy(tvec, Mvec);									// t(i) = masse(i)^(-0.25)
    gsl_vector_div(tvec, rvec);										// t(i) = masse(i)^(-0.25)/(1+Sum_k h*a(i,k)*f(i,k)*y(k))
    gsl_vector_mul(tvec, yvec);										// t(i) = masse(i)^(-0.25)*y(i)/(1+Sum_k h*a(i,k)*f(i,k)*y(k))

    gsl_blas_dgemv(CblasTrans, 1, Emat, tvec, 0, rvec);				// r(i) = Sum_j a(j,i)*f(j,i)*t(j)
    gsl_vector_mul(rvec, yvec);										// r(i) = Sum_j a(j,i)*f(j,i)*t(j)*y(i) [rvec: Praedation]

    gsl_blas_dgemv(CblasNoTrans, lambda, Emat, yvec, 0, ydotvec);	// ydot(i) = Sum_j lambda*a(i,j)*f(i,j)*y(j)
    gsl_vector_mul(ydotvec, tvec);									// ydot(i) = Sum_j lambda*a(i,j)*f(i,j)*y(j)*t(i)
    
    gsl_vector_memcpy(svec, Mvec);
    gsl_vector_scale(svec, alpha);								// s(i) = alpha*masse^(-0.25) [svec=Respiration bzw. Mortalitaet]

    gsl_vector_memcpy(tvec, Mvec);
    gsl_vector_scale(tvec, beta);								// t(i) = beta*masse^(-0.25)
    gsl_vector_mul(tvec, yvec);									// t(i) = beta*y(i)
    gsl_vector_add(svec, tvec);									// s(i) = alpha*masse^(-0.25)+beta*y(i)
    	
    gsl_vector_mul(svec, yvec);									// s(i) = alpha*masse^(-0.25)*y(i)+beta*y(i)*y(i)
    gsl_vector_add(svec, rvec);									// [svec: Respiration, competition und Praedation]
    
    gsl_vector_sub(ydotvec, svec);								// ydot(i) = Fressen-Respiration-Competition-Praedation
    
    for(i=0; i<Rnum; i++)
      gsl_vector_set(ydotvec, i, 0.0);							// konstante Ressourcen
      
  }// Ende Einzelpatch, Ergebnis steht in ydotvec 

//	printf("\ncheckpoint Holling2 IV\n");
  
//-- Migration lösen---------------------------------------------------------------------------------------------------------    
  gsl_vector *ydottest	= gsl_vector_calloc(Y);
  double ydotmigr = gsl_vector_get(nicheweb->migrPara, 5);

//   int count=0,m;
//   for(l = 0; l< Y;l++)
//   {
// 	for(m=0;m<Y;m++)
// 	{
// 	  count += gsl_matrix_get(EDmat,l,m);
// 	} 
//   }
//   if(count!=0)
//   {
//     //printf("count %i\n",count);
//     //printf("t unten %f\n",t);
//     //printf("tau %f\n",tau);
//     for(l = 0; l< Y;l++)
//     {
// 	for(m=0;m<Y;m++)
// 	{
// 	  printf("%f\t",gsl_matrix_get(EDmat,l,m));
// 	}
//      printf("\n");
//      }
//   }
  double max = gsl_matrix_max(EDmat); 
  for(l = Rnum; l< Rnum+S; l++)								// start of migration solving
  {
    if(l == SpeciesNumber+Rnum && max !=0 )
    {
      //printf("max ist %f\n",max);
      //printf("l ist %i\n",l);
//       gsl_matrix_set_zero(ADgsl);								// reset gsl objects for every patch
//       gsl_matrix_set_zero(Dmat);    
//       gsl_vector_set_zero(d1vec);
      gsl_vector_set_zero(d2vec);
      gsl_vector_set_zero(d3vec);
      gsl_vector_set_zero(ydottest);

	// Untervektor von yfddot (enthält ydot[]) mit offset l (Rnum...Rnum+S) und Abstand zwischen den Elementen (stride) von Rnum+S.
	// Dies ergibt gerade die Größe einer Spezies in jedem Patch in einem Vektor
      gsl_vector_view dydot_vec = gsl_vector_subvector_with_stride(yfddotvec, l, (Rnum+S), Y);	// ydot[]		
      gsl_vector *dydotvec	  = &dydot_vec.vector;
/*
      gsl_vector_view dy_vec	  = gsl_vector_subvector_with_stride(yfdvec, l, (Rnum+S), Y);			// Startgrößen der Spezies pro Patch
      gsl_vector *dyvec		  = &dy_vec.vector;
   */       
//       gsl_matrix_memcpy(ADgsl, EDmat);		// ADgsl = D
//     
//       if(nicheweb->M == 1)				// umschalten w: patchwise (Abwanderung aus jedem Patch gleich), sonst linkwise (Abwanderung pro link gleich) 
// 	   {
// 		  for(i=0; i<Y; i++)
// 		   {
// 				gsl_vector_view colD = gsl_matrix_column(ADgsl, i);					// Spalte i aus Migrationsmatrix
// 							  colsum = gsl_blas_dasum(&colD.vector);
// 				if(colsum!=0)
// 					{
// 					  for(j=0;j<Y;j++)
// 					  gsl_matrix_set(ADgsl,j,i,(gsl_matrix_get(ADgsl,j,i)/colsum));		// ADgsl: D mit normierten Links
// 					}
// 		    }
// 	   }
// 
//       gsl_matrix_memcpy(Dmat, EDmat);					// Dmat = D
//       gsl_matrix_scale(Dmat, dij);					// Dmat(i,j) = d(i,j) (Migrationsstärke)
//       gsl_matrix_mul_elements(Dmat, ADgsl);				// Dmat(i,j) = d(i,j)*xi(i,j)   (skalierte und normierte Migrationsmatrix)
//      
//       gsl_vector_set_all(d1vec, 1/gsl_vector_get(Mvec, l));		// d1(i)= m(l)^0.25
//       gsl_vector_mul(d1vec, dyvec);					// d1(i)= m(l)^0.25*y(i)
//       gsl_blas_dgemv(CblasNoTrans, 1, Dmat, d1vec, 0, d2vec);		// d2(i)= Sum_j d(i,j)*xi(i,j)*m(l)^0.25*y(j)
//     
//       gsl_vector_set_all(d1vec, 1);					// d1(i)= 1
//       gsl_blas_dgemv(CblasTrans, 1, Dmat, d1vec, 0, d3vec);		// d3(i)= Sum_j d(i,j)*xi(i,j)
//       gsl_vector_scale(d3vec, 1/gsl_vector_get(Mvec,l));			// d3(i)= Sum_j d(i,j)*xi(i,j)*m(l)^0.25
//       gsl_vector_mul(d3vec, dyvec);					// d3(i)= Sum_j d(i,j)*xi(i,j)*m(l)^0.25*y(i)
//     
    
    
      gsl_vector_set(d2vec,nu,Bmigr);
      gsl_vector_set(d3vec,mu,Bmigr);
      
      
      gsl_vector_add(ydottest,d2vec);
      gsl_vector_sub(ydottest,d3vec);
      //printf("d2vec ist %f\n",gsl_vector_get(d2vec,0));
      //printf("d3vec ist %f\n",gsl_vector_get(d3vec,0));
      //if(gsl_vector_get(ydottest,mu)!=0)
      //{
      ydotmigr += gsl_vector_get(ydottest,nu);
//       printf("ydotmigr ist %f\n",ydotmigr);
      
      gsl_vector_set(nicheweb->migrPara,5,ydotmigr);
//     if(ydotmigr !=0)
//     {
//       printf("ydottest aufaddiert ist %f\n",ydotmigr);
//       printf("ydottest aufaddiert ist %f\n",gsl_vector_get(nicheweb->migrPara,5));
//     }
    
      gsl_vector_add(dydotvec, d2vec);				// 
      gsl_vector_sub(dydotvec, d3vec);				// Ergebnis in dydotvec (also ydot[]) = Sum_j d(i,j)*xi(i,j)*m(l)^0.25*y(j) - Sum_j d(i,j)*xi(i,j)*m(l)^0.25*y(i) 
      }
  }// Patch i gewinnt das was aus allen j Patches zuwandert und verliert was von i auswandert
  //printf("ydot ist %f\n",gsl_vector_get(ydottest,0));

	//printf("\ncheckpoint Holling2 V\n");

	/*
	for(i=0; i<(Rnum+S)*Y; i++){
		printf("\ny = %f\tydot=%f\n", y[i], ydot[i]);
		}
    */
//--check for fixed point attractor-----------------------------------------------------------------------------------
	
	if(t>7800){

		gsl_vector_set(nicheweb->fixpunkte, 0, 0);	
		gsl_vector_set(nicheweb->fixpunkte, 1, 0);
		gsl_vector_set(nicheweb->fixpunkte, 2, 0);		 

		int fix0 = (int)gsl_vector_get(nicheweb->fixpunkte, 0);
		int fix1 = (int)gsl_vector_get(nicheweb->fixpunkte, 1);
		int fix2 = (int)gsl_vector_get(nicheweb->fixpunkte, 2);


	//printf("t unten = %f\n", t);
	
		for(i=0; i<(Rnum+S)*Y; i++)
		  {
			  if(y[i] <= 0)
			  {
				fix0++;
				fix1++;
				fix2++;
			  }
			  else 
			  {
				if((ydot[i]/y[i]<0.0001) || (ydot[i]<0.0001)) fix0++;
				if(ydot[i]/y[i]<0.0001) fix1++;
				if(ydot[i]<0.0001) fix2++;
			  }
		  }

    if(fix0==(Rnum+S)*Y) gsl_vector_set(nicheweb->fixpunkte, 3, 1);
    if(fix1==(Rnum+S)*Y) gsl_vector_set(nicheweb->fixpunkte, 4, 1);
    if(fix2==(Rnum+S)*Y) gsl_vector_set(nicheweb->fixpunkte, 5, 1);
  }

//--Speicher leeren----------------------------------------------------------------------------------------------------- 

  gsl_matrix_free(Emat);  
//   gsl_matrix_free(Dmat);  
  gsl_matrix_free(AFgsl);  
//   gsl_matrix_free(ADgsl);
  
  gsl_vector_free(tvec);
  gsl_vector_free(rvec);
  gsl_vector_free(svec);
//   gsl_vector_free(d1vec);
  gsl_vector_free(d2vec);
  gsl_vector_free(d3vec);
  gsl_vector_free(ydottest);
  
//	printf("\nCheckpoint Holling2 VI\n");

  return GSL_SUCCESS;

}
Esempio n. 10
0
File: BEF.c Progetto: tatilitudu/BEF
double* metabolicLoss(struct foodweb nicheweb, const double y[], double* metLoss)
{

  int S 	 	= nicheweb.S;
  int Y 	     	= nicheweb.Y;
  int Rnum 		= nicheweb.Rnum;
  double alpha		= nicheweb.alpha;
  gsl_vector *network 	= nicheweb.network;						// Inhalt: A+linksA+Y+linksY+Massen+Trophische_Level = (Rnum+S)²+1+Y²+1+(Rnum+S)+S
  
  
  int i,l;


  /* Massen rausholen */
  gsl_vector_view M_vec  = gsl_vector_subvector(network, ((Rnum+S)*(Rnum+S))+1+(Y*Y)+1, (Rnum+S));	// Massenvektor
  gsl_vector *Mvec	   = &M_vec.vector;
  
  double ytemp[(Rnum+S)*Y];		// tempvector for populations and efforts
  for(i=0;i<(Rnum+S)*Y;i++)
    ytemp[i]=y[i];

  /* Alles view_array */
  
 
  /* Auslesen von ytemp = y[]; sind Population */
  gsl_vector_view yfd_vec=gsl_vector_view_array(ytemp,(Rnum+S)*Y);
  gsl_vector *yfdvec=&yfd_vec.vector;				// populations and efforts for later use
  
  
  
  /* Initialisierungen */
  gsl_vector *svec=gsl_vector_calloc(Rnum+S);
  

    
  for(l=0;l<Y;l++)						// start of patch solving
  {
    /* Initialisierungen */
    gsl_vector_set_zero(svec);
    

    /* yfdvec enthält die Population */
    gsl_vector_view y_vec=gsl_vector_subvector(yfdvec,(Rnum+S)*l,(Rnum+S));
    gsl_vector *yvecmet=&y_vec.vector;
    
 

    gsl_vector_memcpy(svec,Mvec);
    //printf("svec vorher: %f\n",gsl_vector_get(svec,3));
    gsl_vector_scale(svec,alpha);				// s(i)=alpha*masse^(-0.25) [svec=Respiration bzw. Mortalitaet]
    //printf("svec nachher: %f\n",gsl_vector_get(svec,3));
    gsl_vector_set(yvecmet,0,0);					// es wird nur der Fluss zur Ressource benötigt
    gsl_vector_mul(svec,yvecmet);					// s(i) = alpha*masse^(-0.25)*y(i)
   
  
   
    metLoss[l] = gsl_blas_dasum(svec);
    //printf("metloss %f\n",metLoss[0]);
  }
  /* Speicher befreien */
  gsl_vector_free(svec);
  
  return 0;
}
Esempio n. 11
0
File: BEF.c Progetto: tatilitudu/BEF
double* intraguildPred(struct foodweb nicheweb, const double y[], double* intraPred)
{
  int i,j,l;

  int S 	 	= nicheweb.S;
  int Y 	     	= nicheweb.Y;
  int Rnum 		= nicheweb.Rnum;
  gsl_vector *network 	= nicheweb.network;						// Inhalt: A+linksA+Y+linksY+Massen+Trophische_Level = (Rnum+S)²+1+Y²+1+(Rnum+S)+S
  
  double lambda		= nicheweb.lambda;
  double aij		= nicheweb.aij;
  double hand		= nicheweb.hand;

  /* Massen rausholen */
  gsl_vector_view A_view = gsl_vector_subvector(network, 0, (Rnum+S)*(Rnum+S));						// Fressmatrix A als Vektor
  gsl_matrix_view EA_mat = gsl_matrix_view_vector(&A_view.vector, (Rnum+S), (Rnum+S));				// A als Matrix_view
  gsl_matrix *EAmat	   = &EA_mat.matrix;		// A als Matrix

  gsl_vector_view M_vec  = gsl_vector_subvector(network, ((Rnum+S)*(Rnum+S))+1+(Y*Y)+1, (Rnum+S));	// Massenvektor
  gsl_vector *Mvec	   = &M_vec.vector;				// massvector: M(i)=m^(-0.25)
  
  double ytemp[(Rnum+S)*Y];		// tempvector for populations and efforts
  for(i=0;i<(Rnum+S)*Y;i++)
    ytemp[i]=y[i];

  /* Alles view_array */
  
  /* Auslesen von ytemp = y[]; sind Population */
  gsl_vector_view yfd_vec=gsl_vector_view_array(ytemp,(Rnum+S)*Y);
  gsl_vector *yfdvec=&yfd_vec.vector;				// populations and efforts for later use
  
 
  
  
  /* Initialisierungen */
  gsl_matrix *AFgsl=gsl_matrix_calloc(Rnum+S, Rnum+S);		// matrix of foraging efforts
  
  gsl_matrix *Emat=gsl_matrix_calloc(Rnum+S, Rnum+S);		// gsl objects for calculations of populations 
  gsl_vector *tvec=gsl_vector_calloc(Rnum+S);
  gsl_vector *rvec=gsl_vector_calloc(Rnum+S);
  gsl_vector *svec=gsl_vector_calloc(Rnum+S);
  gsl_vector *intraPredTemp=gsl_vector_calloc(Rnum+S);
  
  
  for(l=0;l<Y;l++)						// start of patch solving
  {
    /* Initialisierungen */
    gsl_matrix_set_zero(AFgsl);					// reset gsl objects for every patch
    gsl_matrix_set_zero(Emat);
    gsl_vector_set_zero(tvec);
    gsl_vector_set_zero(rvec);
    gsl_vector_set_zero(svec);
   
    
    /* Je Vektoren von (Res+S) Elementen */


    /* yfdvec enthält die Population */
    gsl_vector_view y_vec=gsl_vector_subvector(yfdvec,(Rnum+S)*l,(Rnum+S));
    gsl_vector *yvecint=&y_vec.vector;
    
    /* Kopie von EAmat erstellen */
    gsl_matrix_memcpy(AFgsl,EAmat);

    for(i=0;i<Rnum+S;i++)
    {
      /* Nehme i-te Zeile aus A */
      gsl_vector_view tempp=gsl_matrix_row(AFgsl,i);
      
      /* Summiere Absolutwerte der Zeile */
      double temp1;	
      temp1=gsl_blas_dasum(&tempp.vector);
      if(temp1!=0)
      {
	/* Teile die Einträge, die nicht- Null sind durch Anzahl an nicht-Nullen in dieser Zeile*/ 
	/* und setzte diesen Wert dann an den entsprechenden Platz */
	/* Man erhält also eine prozentuale Verbindung */
	for(j=0;j<Rnum+S;j++)
	  gsl_matrix_set(AFgsl,i,j,(gsl_matrix_get(AFgsl,i,j)/temp1));
      }
    }
  
  /* aij ist Attackrate; AFgsl ist jetzt normiert- also fij  */
    gsl_matrix_memcpy(Emat,EAmat);
    gsl_matrix_scale(Emat,aij);					//  Emat(i,j) = a(i,j)
    gsl_matrix_mul_elements(Emat,AFgsl);			//  Emat(i,j) = a(i,j)*f(i,j)

    
    /*  hand =  handling time */
    /* Berechnung wie aus Paper */
    gsl_vector_set(yvecint,0,0);
    printf("y: %f\n",gsl_vector_get(yvecint,0));
    gsl_vector_memcpy(svec,yvecint);				// s(i)=y(i)
    gsl_vector_scale(svec, hand);				// s(i)=y(i)*h
    gsl_blas_dgemv(CblasNoTrans,1,Emat,svec,0,rvec);		// r(i)=Sum_k h*a(i,k)*f(i,k)*y(k)
    gsl_vector_add_constant(rvec,1);				// r(i)=1+Sum_k h*a(i,k)*f(i,k)*y(k)
    
    gsl_vector_memcpy(tvec,Mvec);				// t(i)=masse(i)^(-0.25)
    gsl_vector_div(tvec,rvec);					// t(i)=masse(i)^(-0.25)/(1+Sum_k h*a(i,k)*f(i,k)*y(k))
    gsl_vector_mul(tvec,yvecint);					// t(i)=masse(i)^(-0.25)*y(i)/(1+Sum_k h*a(i,k)*f(i,k)*y(k))

    gsl_blas_dgemv(CblasNoTrans,lambda,Emat,yvecint,0,intraPredTemp);	// ydot(i)=Sum_j lambda*a(i,j)*f(i,j)*y(j)
    gsl_vector_mul(intraPredTemp,tvec);
    
    intraPred[l] = gsl_blas_dasum(intraPredTemp);
  }
  /* Speicher befreien */
  gsl_matrix_free(Emat); 
  gsl_matrix_free(AFgsl);  
  
  gsl_vector_free(tvec);
  gsl_vector_free(rvec);
  gsl_vector_free(svec);
  gsl_vector_free(intraPredTemp);
  
  return 0;
}