void wn_skdel(wn_skhandle handle, wn_sklist sklist)
{
wn_skhandle prev_handle;
/* wn_skhandle new_handle, new_head_handle; ** unused - bchapman 041111 */
/* int new_ptr_count; ** unused - bchapman 041111 */
int i, j;
prev_handle = sklist->handle;
for (j = sklist->ptr_count - 1; j >= 0; --j)
{
prev_handle = lo_del_find_prev(prev_handle, sklist, handle, j);
wn_assert(prev_handle);
if (WN_SKIP_NEXTS(prev_handle)[j] == handle)
{
break;
}
}
for (i = j; i >= 0; --i)
{
prev_handle = lo_del_find_prev(prev_handle, sklist, handle, i);
wn_assert(prev_handle);
WN_SKIP_NEXTS(prev_handle)[i] = WN_SKIP_NEXTS(handle)[i];
}
wn_free(handle);
} /* wn_skdel */
void mat_test_small_simplex_2()
{
static double ss_row0[] = { 1, -2, 1, 0, 0, 0, 0 };
static double ss_row1[] = { 2, -1, 0, 1, 0, 0, 0 };
static double ss_row2[] = { 4, 1, 0, 0, 1, 0, 0 };
static double ss_row3[] = { -2, 3, 0, 0, 0, 1, 0 };
static double ss_row4[] = { -3, 2, 0, 0, 0, 0, 1 };
static double *ss_mat[] = { ss_row0, ss_row1, ss_row2, ss_row3, ss_row4 };
static double ss_rhs[] = { 2, 7, 29, 17, 8 };
static double ss_objective_vect[] = { 1, 2, 0, 0, 0, 0, 0 };
double solution[7];
double objective;
int code;
wn_simplex_method(&code, &objective, NULL, solution, ss_objective_vect,
/**/ ss_mat, ss_rhs, 5, 7);
/* at this point, the simplex has told us the problem is infeasible,
** when the solution { 5, 9 } given in the textbook clearly satisfies
** all the inequalities, as does { 0, 0 } */
/*
printf("small simplex 2 return code: %d\n", code);
*/
wn_assert(WN_SUCCESS == code);
wn_assert(LO_ALMOST_EQUAL(5, solution[0]));
wn_assert(LO_ALMOST_EQUAL(9, solution[1]));
} /* mat_test_small_simplex_2 */
void wn_verify_string_list_is_sorted(wn_sll orig_list, wn_sll sorted_list)
{
wn_sll slli, sllj;
int orig_dup_count, sorted_dup_count;
for (slli = sorted_list ; slli && slli->next; slli = slli->next)
{
wn_assert(strcmp((char *) slli->contents,
/**/ (char *) slli->next->contents) <= 0);
}
/* count duplicates */
for (slli = orig_list ; slli; slli = slli->next)
{
orig_dup_count = 0;
for (sllj = orig_list; sllj; sllj = sllj->next)
{
if (!strcmp((char *) slli->contents, (char *) sllj->contents))
{
++orig_dup_count;
}
}
sorted_dup_count = 0;
for (sllj = sorted_list; sllj; sllj = sllj->next)
{
if (!strcmp((char *) slli->contents, (char *) sllj->contents))
{
++sorted_dup_count;
}
}
wn_assert(orig_dup_count == sorted_dup_count);
}
} /* wn_verify_string_list_is_sorted */
EXTERN void wn_mksklist
(
wn_sklist *psklist,
double threshold,
int (*pcompare_keys_func)(ptr key1,ptr key2),
void (*palloc_copy_key_func)(ptr *pkey,ptr key),
void (*pfree_key_func)(ptr key)
)
{
*psklist = (wn_sklist) wn_alloc(sizeof(struct wn_sklist_struct));
wn_assert(1.0 > threshold);
wn_assert(0.0 < threshold);
(*psklist)->threshold = (int) (threshold * (1<<LO_SKIP_RAND_BITS));
(*psklist)->threshold = wn_max((*psklist)->threshold, 0);
(*psklist)->threshold = wn_min((*psklist)->threshold, (1<<LO_SKIP_RAND_BITS)-2);
(*psklist)->max_levels = 1000; /* for now */
(*psklist)->pcompare_keys_func = pcompare_keys_func;
(*psklist)->palloc_copy_key_func = palloc_copy_key_func;
(*psklist)->pfree_key_func = pfree_key_func;
(*psklist)->handle = (wn_skhandle) wn_alloc(WN_SKHANDLE_SIZE(1));
(*psklist)->ptr_count = 1;
(*psklist)->handle->key = NULL;
WN_SKIP_NEXTS((*psklist)->handle)[0] = NULL;
(*psklist)->group = wn_curgp();
} /* wn_mksklist */
local void simplex_solve
(
int *pcode,
wn_sparse_matrix cost_mat
)
{
int code;
wn_sparse_matrix feasibility_cost_mat;
double objective,delta;
compute_feasibility_cost_mat(&feasibility_cost_mat,cost_mat);
wn_trans_problem_simplex_improve(&code,&objective,&delta,
&first_result,first_result,
feasibility_cost_mat,
WN_IHUGE);
wn_assert(code == WN_SUCCESS);
if(objective == 0.0)
{
*pcode = WN_SUBOPTIMAL;
}
else
{
wn_assert(objective > 0.0);
*pcode = WN_INFEASIBLE;
}
}
local void lo_insert_free_block_into_big_free_list(wn_free_block free_block,
/**/ wn_memgp group)
{
free_list_type free_list = (free_list_type) group->free_list;
wn_mbtree tree = free_list->big_blocks_tree;
wn_mbhandle handle, hdr_handle;
/* int mbhandle_chunk_size; ** unused - bchapman 041111 */
/* int total_size; ** unused - bchapman 041111 */
/* wn_free_block free_block_2; ** unused - bchapman 041111 */
wn_assert(free_block->free_block_size >= SMALL_SIZE);
wn_assert((((long unsigned int) free_block) & 7) == 4);
handle = WN_FREE_BLOCK_TO_MBHANDLE(free_block);
wn_mbget(&hdr_handle, tree, (ptr) free_block->free_block_size, WN_MB_EQ);
if (hdr_handle)
{
handle->next_free_block = hdr_handle->free_block_list;
hdr_handle->free_block_list = free_block;
}
else
{
wn_mbins(handle, tree, (ptr) free_block->free_block_size);
handle->next_free_block =
handle->free_block_list = NULL;
wn_assert(handle->key == (ptr) free_block->free_block_size);
}
} /* lo_insert_free_block_into_big_free_list */
/****************************************************************
** small simplex. I never studied the simplex method in any
** detail. This example is copied out of a textbook. This
** example intends to pose the following problem:
maximize s[0] + 9*s[1] + s[2]
such that
s[0] + 2*s[1] + 3*s[2] <= 9
3*s[0] + 2*s[1] + 2*s[2] <= 15
and s[0], s[1], s[2] are all non-negative. s[] is described below
as solution[]. -- Bill Chapman. The wnsplx routines require
that constraints be equalities. We change the constraints to
equalities by adding slack variables, leading to the following
formulation:
maximize s[0] + 9*s[1] + s[2]
such that
s[0] + 2*s[1] + 3*s[2] + s[3] == 9
3*s[0] + 2*s[1] + 2*s[2] + s[4] == 15
*/
void mat_test_small_simplex()
{
static double ss_row0[] = { 1, 2, 3, 1, 0 };
static double ss_row1[] = { 3, 2, 2, 0, 1 };
static double *ss_mat[] = { ss_row0, ss_row1 };
int code;
static double ss_rhs[] = { 9, 15 };
static double ss_objective_vect[] = { 1, 9, 1, 0, 0 };
double solution[5];
double objective;
wn_simplex_method(&code, &objective, NULL, solution, ss_objective_vect,
/**/ ss_mat, ss_rhs, 2, 5);
wn_assert(WN_SUCCESS == code);
/* at this point, it returns the feasible but suboptimal solution
** { 3, 3, 0 }. Textbook said { 0, 4.5, 0 }, which yields a higher
** objective. Don't know what I'm doing wrong. */
/*
printf("small simplex solution: %f %f %f\n", solution[0], solution[1],
solution[2]);
*/
wn_assert(LO_ALMOST_EQUAL(0, solution[0]));
wn_assert(LO_ALMOST_EQUAL(4.5, solution[1]));
wn_assert(LO_ALMOST_EQUAL(0, solution[2]));
} /* mat_test_small_simplex */
void wn_bverify(wn_btree tree)
{
wn_assert(tree->pcompare_keys_func != NULL);
wn_assert(tree->palloc_copy_key_func != NULL);
wn_assert(tree->pfree_key_func != NULL);
wn_assert(tree->group != NULL);
verify_handle_tree(tree->handle_tree,(wn_bhandle)NULL,
tree->pcompare_keys_func);
}
void wn_skins(wn_skhandle *phandle, wn_sklist sklist, ptr key)
{
wn_skhandle prev_handle;
/* wn_skhandle new_handle, new_head_handle; ** unused - bchapman 041111 */
int new_ptr_count;
int i;
for (new_ptr_count = 1; new_ptr_count < sklist->max_levels; ++new_ptr_count)
{
if (wn_random_n_bits(LO_SKIP_RAND_BITS) > sklist->threshold)
{
break;
}
}
wn_gppush(sklist->group);
*phandle = (wn_skhandle) wn_alloc(WN_SKHANDLE_SIZE(new_ptr_count));
(*(sklist->palloc_copy_key_func))(&(*phandle)->key, key);
if (new_ptr_count > sklist->ptr_count)
{
/* we need a new headnode */
wn_realloc((ptr *) &sklist->handle, WN_SKHANDLE_SIZE(sklist->ptr_count),
/**/ WN_SKHANDLE_SIZE( new_ptr_count));
for (i = sklist->ptr_count; i < new_ptr_count; ++i)
{
WN_SKIP_NEXTS(sklist->handle)[i] = NULL;
}
sklist->ptr_count = new_ptr_count;
}
prev_handle = sklist->handle;
for (i = sklist->ptr_count - 1; i >= new_ptr_count; --i)
{
prev_handle = lo_find_prev(prev_handle, sklist, key, i);
wn_assert(prev_handle);
}
for ( ; i >= 0; --i)
{
prev_handle = lo_find_prev(prev_handle, sklist, key, i);
wn_assert(prev_handle);
WN_SKIP_NEXTS( *phandle)[i] = WN_SKIP_NEXTS(prev_handle)[i];
WN_SKIP_NEXTS(prev_handle)[i] = *phandle;
}
/* this is useful for some debugging, but may be overridden by user */
(*phandle)->contents = (ptr) new_ptr_count;
wn_gppop();
} /* wn_skins */
void wn_ptrarraydelindex(ptr **pptrarray,int *pusedsize,int *pmemsize,int index)
{
wn_assert(index < *pusedsize);
wn_assert(index >= 0);
--(*pusedsize);
if(index < (*pusedsize))
{
(*pptrarray)[index] = (*pptrarray)[*pusedsize];
}
(*pptrarray)[*pusedsize] = NULL;
}
void wn_cdn_set_coord_x0
(
wn_cdn_context_type c,
int coord,
double x0
)
{
wn_assert(coord >= 0);
wn_assert(coord < c->num_vars);
(c->coord_search_direction_array)[coord]->x0 = x0;
}
void wn_cdn_set_coord_max_x_width
(
wn_cdn_context_type c,
int coord,
double max_x_width
)
{
wn_assert(coord >= 0);
wn_assert(coord < c->num_vars);
(c->coord_search_direction_array)[coord]->max_x_width = max_x_width;
}
void wn_verify_punsigned_list_is_sorted(wn_sll orig_list, wn_sll sorted_list)
{
wn_sll slli, sllj;
int orig_dup_count, sorted_dup_count;
int i; /* count iterations for debugging */
if (dump_list_to_file)
{
FILE *fp;
fp = fopen(dump_list_to_file, "w");
for (slli = sorted_list; slli; slli = slli->next)
{
fprintf(fp, "%d\n", * (int *) slli->contents);
}
fclose(fp);
}
for (slli = sorted_list, i = 0; slli && slli->next; slli = slli->next, ++i)
{
wn_assert(* (unsigned *) slli->contents <=
/**/ * (unsigned *) slli->next->contents);
}
/* count duplicates */
for (slli = orig_list ; slli; slli = slli->next)
{
orig_dup_count = 0;
for (sllj = orig_list; sllj; sllj = sllj->next)
{
if (* (unsigned *) slli->contents == * (unsigned *) sllj->contents)
{
++orig_dup_count;
}
}
sorted_dup_count = 0;
for (sllj = sorted_list; sllj; sllj = sllj->next)
{
if (* (unsigned *) slli->contents == * (unsigned *) sllj->contents)
{
++sorted_dup_count;
}
}
wn_assert(orig_dup_count == sorted_dup_count);
}
} /* wn_verify_punsigned_list_is_sorted */
local bool x0_too_far_in(double x0,double x2,double threshold)
{
wn_assert(threshold < 1.0);
if(x2 > 0.0)
{
return(x0 < x2*threshold);
}
else
{
wn_assert(x2 < 0.0); /* x0 == 0 not allowed */
return(x0_too_far_in(-x0,-x2,threshold));
}
}
void solve_conductance_network
(
int *pcode,
double voltage_vect[],
wn_sparse_matrix passed_conductance_graph, /* assumed to be symmetric */
double passed_stimulus_vect[],
stimulus_type passed_stimulus_type_vect[]
)
{
double val_min;
int i;
conductance_graph = passed_conductance_graph;
stimulus_vect = passed_stimulus_vect;
stimulus_type_vect = passed_stimulus_type_vect;
wn_assert(conductance_graph->len_i == conductance_graph->len_j);
len = conductance_graph->len_i;
count = 0;
wn_conj_gradient_method(pcode,&val_min,
voltage_vect,len,&function,&gradient,2*len);
for(i=0;i<len;++i)
{
if(stimulus_type_vect[i] == voltage)
{
voltage_vect[i] = stimulus_vect[i];
}
}
}
local void find_handle_pointer
(
wn_bhandle **pphandle,
wn_btree tree,
wn_bhandle handle
)
{
wn_bhandle parent;
parent = handle->parent;
if(parent != NULL)
{
if(parent->left_child == handle)
{
*pphandle = &(parent->left_child);
}
else /* parent->right_child == handle */
{
*pphandle = &(parent->right_child);
}
}
else /* parent == NULL */
{
*pphandle = &(tree->handle_tree);
}
wn_assert(**pphandle == handle); /* cannot find handle in tree */
}
EXTERN void wn_numerical_gradient
(
double grad[],
double vect[],
double delta_vect[],
int len,
double (*pfunction)(double vect[])
)
{
double f,base_f,delta_f;
double save_vect_el,delta_vect_el;
int i;
base_f = (*pfunction)(vect);
for(i=0;i<len;++i)
{
save_vect_el = vect[i];
delta_vect_el = delta_vect[i];
wn_assert(delta_vect_el != 0.0);
vect[i] += delta_vect_el;
f = (*pfunction)(vect);
delta_f = f-base_f;
grad[i] = delta_f/delta_vect_el;
vect[i] = save_vect_el;
}
}
void wn_grow_2array
(
ptr *parray1,ptr *parray2,
int *pmemsize,
int blocksize1,int blocksize2
)
{
ptr new_array;
int new_memsize;
if((*pmemsize) <= 0)
{
wn_assert((*pmemsize) == 0);
*pmemsize = 1;
*parray1 = (ptr)wn_alloc(blocksize1);
*parray2 = (ptr)wn_alloc(blocksize2);
}
else
{
new_memsize = 2*(*pmemsize);
new_array = (ptr)wn_alloc(new_memsize*blocksize1);
wn_memcpy(new_array,*parray1,(*pmemsize)*blocksize1);
wn_free(*parray1);
*parray1 = new_array;
new_array = (ptr)wn_alloc(new_memsize*blocksize2);
wn_memcpy(new_array,*parray2,(*pmemsize)*blocksize2);
wn_free(*parray2);
*parray2 = new_array;
*pmemsize = new_memsize;
}
}
local void compute_fract_too_small_ratio_df1_noise
(
wn_cdn_context_type c,
double *pfract_too_small,
double target
)
{
int i;
int total_count,too_small_count;
double sum;
too_small_count = 0;
total_count = 0;
for(i=0;i<c->num_search_directions;++i)
{
if((c->search_direction_array)[i]->ratio_df1_noise < target)
{
++too_small_count;
}
++total_count;
}
for(i=0;i<c->num_vars;++i)
{
if((c->coord_search_direction_array)[i]->ratio_df1_noise < target)
{
++too_small_count;
}
++total_count;
}
wn_assert(total_count > 0);
*pfract_too_small = ((double)too_small_count)/total_count;
}
void wn_mbverify(wn_mbtree tree)
{
wn_assert(tree->pcompare_keys_func != (int (*)(ptr,ptr))NULL);
lo_verify_handle_tree(tree->handle_tree,(wn_mbhandle)NULL,
/**/ tree->pcompare_keys_func);
}
local void compute_average_ratio_df1_noise
(
wn_cdn_context_type c,
double *paverage_ratio_df1_noise
)
{
int i;
int count;
double sum;
count = 0;
sum = 0.0;
for(i=0;i<c->num_search_directions;++i)
{
sum += (c->search_direction_array)[i]->ratio_df1_noise;
++count;
}
for(i=0;i<c->num_vars;++i)
{
sum += (c->coord_search_direction_array)[i]->ratio_df1_noise;
++count;
}
wn_assert(count > 0);
*paverage_ratio_df1_noise = sum/count;
}
local double lo_node_x_gradient(int node_number, double *coords) {
double *x_coords = coords;
/* double *y_coords = coords + lo_dim_square; */
double ret = 0;
wn_assert((unsigned) node_number < (unsigned) lo_dim_square);
/* we will just add hook's law spring energy from the nodes to the
** left and the right, except if the node is next to the right or bottom
** walls, in which case we also add the distance to those walls */
/* distance to the neighbor to our left */
if (!(node_number % lo_dim)) {
/* we are connected to the left wall */
ret += 2 * (x_coords[node_number] - lo_left_wall_x);
} else {
ret += 2 * (x_coords[node_number] - x_coords[node_number-1]);
}
/* distance to the neighbor to our right */
if (!((node_number+1) % lo_dim)) {
ret += -2 * (lo_right_wall_x - x_coords[node_number]);
} else {
ret += -2 * (x_coords[node_number+1] - x_coords[node_number]);
}
return ret;
} /* lo_node_x_gradient */
local void verify_group(wn_memgp group)
{
if (group->current_block)
{
wn_assert(group->block_mem_left >= 0);
wn_assert(group->block_mem_left == (char *) group->block_end_ptr -
/**/ (char *) group->block_ptr);
}
wn_assert(*group->plast == group);
wn_assert(group->mem_used >= 0);
if(wn_gp_pad_flag)
{
verify_pad_list((pad_type)(group->pad_list));
}
}
void wn_skverify(wn_sklist sklist)
{
wn_skhandle handle, handle1, handle2;
int i, j;
for (i = sklist->ptr_count-1; i >= 0; --i)
{
for (handle = sklist->handle; handle; handle = WN_SKIP_NEXTS(handle)[i])
{
for (j = i; j >= 0 && !WN_SKIP_NEXTS(handle)[j]; --j)
{
;
}
for ( ; j >= 0; --j)
{
wn_assert(WN_SKIP_NEXTS(handle)[j]);
}
wn_assert(-1 == j);
if (handle != sklist->handle)
{
for (j = i; j >= 0; --j)
{
handle2 = WN_SKIP_NEXTS(handle)[j];
if (handle2)
{
wn_assert((*sklist->pcompare_keys_func)(handle->key,
/**/ handle2->key) <= 0);
if (j > 0)
{
handle1 = WN_SKIP_NEXTS(handle)[j-1];
wn_assert(handle1);
wn_assert((*sklist->pcompare_keys_func)(handle1->key,
/**/ handle2->key) <= 0);
}
}
}
}
}
}
} /* wn_skverify */
local void mat_test_invert(void)
{
double **mat,**mat2,**mat3;
int code;
int i, j;
wn_gpmake("general_free");
wn_make_mat(&mat, LEN,LEN);
wn_make_mat(&mat2,LEN,LEN);
wn_make_mat(&mat3,LEN,LEN);
wn_random_mat(mat,LEN,LEN);
wn_copy_mat(mat2,mat,LEN,LEN);
wn_invert_mat(&code,mat2,LEN);
wn_assert(code == WN_SUCCESS);
wn_mult_mats(mat3,mat,mat2,LEN,LEN,LEN);
/* mat3 should now be the identity matrix */
for (i = 0; i < LEN; ++i)
{
for (j = 0; j < LEN; ++j)
{
wn_assert(LO_ALMOST_EQUAL(mat3[i][j], i == j ? 1.0 : 0.0));
} }
wn_mult_mats(mat3,mat2,mat,LEN,LEN,LEN);
/* mat3 should now be the identity matrix */
for (i = 0; i < LEN; ++i)
{
for (j = 0; j < LEN; ++j)
{
wn_assert(LO_ALMOST_EQUAL(mat3[i][j], i == j ? 1.0 : 0.0));
} }
wn_free_mat(mat, LEN,LEN);
wn_free_mat(mat2,LEN,LEN);
wn_free_mat(mat3,LEN,LEN);
wn_gpfree();
} /* mat_test_invert */
static clock_t lo_time(void)
{
struct tms time_buf;
int sts;
sts = times(&time_buf);
wn_assert(-1 != sts);
return time_buf.tms_utime + time_buf.tms_stime;
}
local clock_t lo_get_time(void)
{
struct tms time_buf;
int sts;
sts = times(&time_buf);
wn_assert(-1 != sts);
return time_buf.tms_utime;
} /* lo_get_time */
void wn_insert_sparse_matrix_entry
(
wn_sparse_matrix mat,
wn_sparse_matrix_entry entry
)
{
wn_gppush(mat->group);
wn_assert(entry->i >= 0);
wn_assert(entry->i < mat->len_i);
wn_assert(entry->j >= 0);
wn_assert(entry->j < mat->len_j);
wn_sllins(&((mat->i_lists)[entry->i]),entry);
wn_sllins(&((mat->j_lists)[entry->j]),entry);
wn_gppop();
}
local ptr alloc_piece(int size,wn_memgp group)
{
int old_size;
ptr ret;
old_size = size;
if(wn_gp_pad_flag)
{
size += sizeof(union pad_type_8aligned_union);
}
if(size >= group->block_mem_left)
{
get_more_memory(size,group);
}
if (size & 0x7) /* 4-aligned -- get from end */
{
group->block_end_ptr = (ptr) ((char *)group->block_end_ptr - size);
ret = group->block_end_ptr;
}
else /* 8-aligned -- get from start */
{
ret = group->block_ptr;
group->block_ptr = (ptr) ((char *)group->block_ptr + size);
}
group->block_mem_left -= size;
group->mem_used += old_size;
if(wn_gp_pad_flag)
{
fill_pad((pad_type)((char *)ret + old_size), group);
}
if(wn_gp_trap_address_flag)
{
if(ret == wn_gp_trap_address_address)
{
fprintf(stderr,"address found.\n");
wn_assert_notreached();
}
}
wn_assert(!(((long unsigned) ret) & 3));
wn_assert( (((long unsigned) size) & 7) || !(((long unsigned) ret) & 7));
return(ret);
} /* alloc_piece */
local void mat_test_2sies()
{
static double t_row0[2], t_row1[2];
static double *t_mat[] = { t_row0, t_row1 };
double t_vec[2];
double **a_inv_mat;
int code;
int i, j;
wn_gpmake("no_free");
wn_mult_mats(t_mat, a_mat, b_mat, 2, 2, 2);
/* t should now EXACTLY equal c */
for (i = 0; i < 2; ++i)
{
for (j = 0; j < 2; ++j)
{
wn_assert(t_mat[i][j] == c_mat[i][j]);
} }
wn_mult_mat_by_vect(t_vec, a_mat, a_vec, 2, 2);
for (i = 0; i < 2; ++i)
{
wn_assert(t_vec[i] == c_vec[i]);
}
wn_make_mat(&a_inv_mat, 2, 2);
wn_copy_mat(a_inv_mat, a_mat, 2, 2);
wn_invert_mat(&code,a_inv_mat, 2);
wn_assert(WN_SUCCESS == code);
t_vec[0] = t_vec[1] = -1;
wn_solve_system(&code, t_vec, c_vec, a_inv_mat, a_mat, 2, 5);
/* t_vec should now == a_vec, don't know if it's exact tho */
for (i = 0; i < 2; ++i)
{
wn_assert(LO_ALMOST_EQUAL(t_vec[i], a_vec[i]));
}
wn_gpfree();
} /* mat_test_2sies */
