void read_trr2structure(char * filename,char * out_file, int ion_position,vector<int> quartet_1_serial,vector<int> quartet_2_serial,struct atom * atom_head,int step_frame )
{
int natoms,step;
float time_temp;
float lambda;
matrix box;
rvec *x,*v,*f;
XDRFILE *xtc;
xtc=xdrfile_open(filename,"r");
int read_return=read_trr_natoms(filename,&natoms);
int num_step=0;
ofstream out(out_file);
out<<"#calculate the distence of ion to the center of the two quartets in z-axis/"<<endl;
out<<"#Time\t"<<"dist2ions"<<"\t"<<"dist2quartets"<<endl;
double * ion_coor;
ion_coor=dvector(0,2);
struct chain * chain_head;
chain_head=read_pdb_to_chain(atom_head);
struct chain * ch_q_1_G_1;
struct chain * ch_q_1_G_2;
struct chain * ch_q_1_G_3;
struct chain * ch_q_1_G_4;
struct chain * ch_q_2_G_1;
struct chain * ch_q_2_G_2;
struct chain * ch_q_2_G_3;
struct chain * ch_q_2_G_4;
ch_q_1_G_1=get_base_chain(chain_head,quartet_1_serial.at(0));
ch_q_1_G_2=get_base_chain(chain_head,quartet_1_serial.at(1));
ch_q_1_G_3=get_base_chain(chain_head,quartet_1_serial.at(2));
ch_q_1_G_4=get_base_chain(chain_head,quartet_1_serial.at(3));
ch_q_2_G_1=get_base_chain(chain_head,quartet_2_serial.at(0));
ch_q_2_G_2=get_base_chain(chain_head,quartet_2_serial.at(1));
ch_q_2_G_3=get_base_chain(chain_head,quartet_2_serial.at(2));
ch_q_2_G_4=get_base_chain(chain_head,quartet_2_serial.at(3));
struct base_purine_serial * bs_q_1_G_1;
struct base_purine_serial * bs_q_1_G_2;
struct base_purine_serial * bs_q_1_G_3;
struct base_purine_serial * bs_q_1_G_4;
struct base_purine_serial * bs_q_2_G_1;
struct base_purine_serial * bs_q_2_G_2;
struct base_purine_serial * bs_q_2_G_3;
struct base_purine_serial * bs_q_2_G_4;
//得到G碱基的原子的序号。
bs_q_1_G_1=read_pdb2purine_base(atom_head,*ch_q_1_G_1);
bs_q_1_G_2=read_pdb2purine_base(atom_head,*ch_q_1_G_2);
bs_q_1_G_3=read_pdb2purine_base(atom_head,*ch_q_1_G_3);
bs_q_1_G_4=read_pdb2purine_base(atom_head,*ch_q_1_G_4);
bs_q_2_G_1=read_pdb2purine_base(atom_head,*ch_q_2_G_1);
bs_q_2_G_2=read_pdb2purine_base(atom_head,*ch_q_2_G_2);
bs_q_2_G_3=read_pdb2purine_base(atom_head,*ch_q_2_G_3);
bs_q_2_G_4=read_pdb2purine_base(atom_head,*ch_q_2_G_4);
x=( rvec * )calloc(natoms,sizeof(x[0]));
while(1)
{
read_return=read_trr(xtc,natoms,&step,&time_temp,&lambda,box,x,v,f);
num_step++;
if(step%10000==0)
{
cout<<"Reading frame : "<<step<<"\t time :"<<time_temp<<endl;
}
if(read_return!=0)
{
break;
}
if(num_step%step_frame==0)
{
double ** q_1_G_1_matrix;
double ** q_1_G_2_matrix;
double ** q_1_G_3_matrix;
double ** q_1_G_4_matrix;
double ** q_2_G_1_matrix;
double ** q_2_G_2_matrix;
double ** q_2_G_3_matrix;
double ** q_2_G_4_matrix;
q_1_G_1_matrix=dmatrix(0,8,0,2);
q_1_G_2_matrix=dmatrix(0,8,0,2);
q_1_G_3_matrix=dmatrix(0,8,0,2);
q_1_G_4_matrix=dmatrix(0,8,0,2);
q_2_G_1_matrix=dmatrix(0,8,0,2);
q_2_G_2_matrix=dmatrix(0,8,0,2);
q_2_G_3_matrix=dmatrix(0,8,0,2);
q_2_G_4_matrix=dmatrix(0,8,0,2);
for(int i=0;i<natoms;i++)
{
// cout<<step<<"\t"<<time_temp<<"\t"<<natom<<"\t"<<x[natom][0]<<"\t"<<x[natom][1]<<"\t"<<x[natom][2]<<endl;
if((i+1)==ion_position)
{
ion_coor[0]=10*x[i][0];
ion_coor[1]=10*x[i][1];
ion_coor[2]=10*x[i][2];
// cout<<"get ions coordination"<<endl;
}
//q_1_G_1
if((i+1)==bs_q_1_G_1->C2_serial)
{
q_1_G_1_matrix[6][0]=10*x[i][0];
q_1_G_1_matrix[6][1]=10*x[i][1];
q_1_G_1_matrix[6][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_1->C4_serial)
{
q_1_G_1_matrix[8][0]=10*x[i][0];
q_1_G_1_matrix[8][1]=10*x[i][1];
q_1_G_1_matrix[8][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_1->C5_serial)
{
q_1_G_1_matrix[3][0]=10*x[i][0];
q_1_G_1_matrix[3][1]=10*x[i][1];
q_1_G_1_matrix[3][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_1->C6_serial)
{
q_1_G_1_matrix[4][0]=10*x[i][0];
q_1_G_1_matrix[4][1]=10*x[i][1];
q_1_G_1_matrix[4][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_1->C8_serial)
{
q_1_G_1_matrix[1][0]=10*x[i][0];
q_1_G_1_matrix[1][1]=10*x[i][1];
q_1_G_1_matrix[1][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_1->N1_serial)
{
q_1_G_1_matrix[5][0]=10*x[i][0];
q_1_G_1_matrix[5][1]=10*x[i][1];
q_1_G_1_matrix[5][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_1->N3_serial)
{
q_1_G_1_matrix[7][0]=10*x[i][0];
q_1_G_1_matrix[7][1]=10*x[i][1];
q_1_G_1_matrix[7][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_1->N7_serial)
{
q_1_G_1_matrix[2][0]=10*x[i][0];
q_1_G_1_matrix[2][1]=10*x[i][1];
q_1_G_1_matrix[2][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_1->N9_serial)
{
q_1_G_1_matrix[0][0]=10*x[i][0];
q_1_G_1_matrix[0][1]=10*x[i][1];
q_1_G_1_matrix[0][2]=10*x[i][2];
}
// q_1_G_2
if((i+1)==bs_q_1_G_2->C2_serial)
{
q_1_G_2_matrix[6][0]=10*x[i][0];
q_1_G_2_matrix[6][1]=10*x[i][1];
q_1_G_2_matrix[6][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_2->C4_serial)
{
q_1_G_2_matrix[8][0]=10*x[i][0];
q_1_G_2_matrix[8][1]=10*x[i][1];
q_1_G_2_matrix[8][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_2->C5_serial)
{
q_1_G_2_matrix[3][0]=10*x[i][0];
q_1_G_2_matrix[3][1]=10*x[i][1];
q_1_G_2_matrix[3][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_2->C6_serial)
{
q_1_G_2_matrix[4][0]=10*x[i][0];
q_1_G_2_matrix[4][1]=10*x[i][1];
q_1_G_2_matrix[4][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_2->C8_serial)
{
q_1_G_2_matrix[1][0]=10*x[i][0];
q_1_G_2_matrix[1][1]=10*x[i][1];
q_1_G_2_matrix[1][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_2->N1_serial)
{
q_1_G_2_matrix[5][0]=10*x[i][0];
q_1_G_2_matrix[5][1]=10*x[i][1];
q_1_G_2_matrix[5][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_2->N3_serial)
{
q_1_G_2_matrix[7][0]=10*x[i][0];
q_1_G_2_matrix[7][1]=10*x[i][1];
q_1_G_2_matrix[7][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_2->N7_serial)
{
q_1_G_2_matrix[2][0]=10*x[i][0];
q_1_G_2_matrix[2][1]=10*x[i][1];
q_1_G_2_matrix[2][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_2->N9_serial)
{
q_1_G_2_matrix[0][0]=10*x[i][0];
q_1_G_2_matrix[0][1]=10*x[i][1];
q_1_G_2_matrix[0][2]=10*x[i][2];
}
//q_1_G_3
if((i+1)==bs_q_1_G_3->C2_serial)
{
q_1_G_3_matrix[6][0]=10*x[i][0];
q_1_G_3_matrix[6][1]=10*x[i][1];
q_1_G_3_matrix[6][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_3->C4_serial)
{
q_1_G_3_matrix[8][0]=10*x[i][0];
q_1_G_3_matrix[8][1]=10*x[i][1];
q_1_G_3_matrix[8][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_3->C5_serial)
{
q_1_G_3_matrix[3][0]=10*x[i][0];
q_1_G_3_matrix[3][1]=10*x[i][1];
q_1_G_3_matrix[3][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_3->C6_serial)
{
q_1_G_3_matrix[4][0]=10*x[i][0];
q_1_G_3_matrix[4][1]=10*x[i][1];
q_1_G_3_matrix[4][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_3->C8_serial)
{
q_1_G_3_matrix[1][0]=10*x[i][0];
q_1_G_3_matrix[1][1]=10*x[i][1];
q_1_G_3_matrix[1][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_3->N1_serial)
{
q_1_G_3_matrix[5][0]=10*x[i][0];
q_1_G_3_matrix[5][1]=10*x[i][1];
q_1_G_3_matrix[5][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_3->N3_serial)
{
q_1_G_3_matrix[7][0]=10*x[i][0];
q_1_G_3_matrix[7][1]=10*x[i][1];
q_1_G_3_matrix[7][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_3->N7_serial)
{
q_1_G_3_matrix[2][0]=10*x[i][0];
q_1_G_3_matrix[2][1]=10*x[i][1];
q_1_G_3_matrix[2][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_3->N9_serial)
{
q_1_G_3_matrix[0][0]=10*x[i][0];
q_1_G_3_matrix[0][1]=10*x[i][1];
q_1_G_3_matrix[0][2]=10*x[i][2];
}
//q_1_G_4
if((i+1)==bs_q_1_G_4->C2_serial)
{
q_1_G_4_matrix[6][0]=10*x[i][0];
q_1_G_4_matrix[6][1]=10*x[i][1];
q_1_G_4_matrix[6][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_4->C4_serial)
{
q_1_G_4_matrix[8][0]=10*x[i][0];
q_1_G_4_matrix[8][1]=10*x[i][1];
q_1_G_4_matrix[8][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_4->C5_serial)
{
q_1_G_4_matrix[3][0]=10*x[i][0];
q_1_G_4_matrix[3][1]=10*x[i][1];
q_1_G_4_matrix[3][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_4->C6_serial)
{
q_1_G_4_matrix[4][0]=10*x[i][0];
q_1_G_4_matrix[4][1]=10*x[i][1];
q_1_G_4_matrix[4][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_4->C8_serial)
{
q_1_G_4_matrix[1][0]=10*x[i][0];
q_1_G_4_matrix[1][1]=10*x[i][1];
q_1_G_4_matrix[1][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_4->N1_serial)
{
q_1_G_4_matrix[5][0]=10*x[i][0];
q_1_G_4_matrix[5][1]=10*x[i][1];
q_1_G_4_matrix[5][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_4->N3_serial)
{
q_1_G_4_matrix[7][0]=10*x[i][0];
q_1_G_4_matrix[7][1]=10*x[i][1];
q_1_G_4_matrix[7][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_4->N7_serial)
{
q_1_G_4_matrix[2][0]=10*x[i][0];
q_1_G_4_matrix[2][1]=10*x[i][1];
q_1_G_4_matrix[2][2]=10*x[i][2];
}
if((i+1)==bs_q_1_G_4->N9_serial)
{
q_1_G_4_matrix[0][0]=10*x[i][0];
q_1_G_4_matrix[0][1]=10*x[i][1];
q_1_G_4_matrix[0][2]=10*x[i][2];
}
//q_2_G_1
if((i+1)==bs_q_2_G_1->C2_serial)
{
q_2_G_1_matrix[6][0]=10*x[i][0];
q_2_G_1_matrix[6][1]=10*x[i][1];
q_2_G_1_matrix[6][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_1->C4_serial)
{
q_2_G_1_matrix[8][0]=10*x[i][0];
q_2_G_1_matrix[8][1]=10*x[i][1];
q_2_G_1_matrix[8][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_1->C5_serial)
{
q_2_G_1_matrix[3][0]=10*x[i][0];
q_2_G_1_matrix[3][1]=10*x[i][1];
q_2_G_1_matrix[3][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_1->C6_serial)
{
q_2_G_1_matrix[4][0]=10*x[i][0];
q_2_G_1_matrix[4][1]=10*x[i][1];
q_2_G_1_matrix[4][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_1->C8_serial)
{
q_2_G_1_matrix[1][0]=10*x[i][0];
q_2_G_1_matrix[1][1]=10*x[i][1];
q_2_G_1_matrix[1][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_1->N1_serial)
{
q_2_G_1_matrix[5][0]=10*x[i][0];
q_2_G_1_matrix[5][1]=10*x[i][1];
q_2_G_1_matrix[5][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_1->N3_serial)
{
q_2_G_1_matrix[7][0]=10*x[i][0];
q_2_G_1_matrix[7][1]=10*x[i][1];
q_2_G_1_matrix[7][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_1->N7_serial)
{
q_2_G_1_matrix[2][0]=10*x[i][0];
q_2_G_1_matrix[2][1]=10*x[i][1];
q_2_G_1_matrix[2][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_1->N9_serial)
{
q_2_G_1_matrix[0][0]=10*x[i][0];
q_2_G_1_matrix[0][1]=10*x[i][1];
q_2_G_1_matrix[0][2]=10*x[i][2];
}
//q_2_G_2
if((i+1)==bs_q_2_G_2->C2_serial)
{
q_2_G_2_matrix[6][0]=10*x[i][0];
q_2_G_2_matrix[6][1]=10*x[i][1];
q_2_G_2_matrix[6][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_2->C4_serial)
{
q_2_G_2_matrix[8][0]=10*x[i][0];
q_2_G_2_matrix[8][1]=10*x[i][1];
q_2_G_2_matrix[8][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_2->C5_serial)
{
q_2_G_2_matrix[3][0]=10*x[i][0];
q_2_G_2_matrix[3][1]=10*x[i][1];
q_2_G_2_matrix[3][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_2->C6_serial)
{
q_2_G_2_matrix[4][0]=10*x[i][0];
q_2_G_2_matrix[4][1]=10*x[i][1];
q_2_G_2_matrix[4][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_2->C8_serial)
{
q_2_G_2_matrix[1][0]=10*x[i][0];
q_2_G_2_matrix[1][1]=10*x[i][1];
q_2_G_2_matrix[1][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_2->N1_serial)
{
q_2_G_2_matrix[5][0]=10*x[i][0];
q_2_G_2_matrix[5][1]=10*x[i][1];
q_2_G_2_matrix[5][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_2->N3_serial)
{
q_2_G_2_matrix[7][0]=10*x[i][0];
q_2_G_2_matrix[7][1]=10*x[i][1];
q_2_G_2_matrix[7][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_2->N7_serial)
{
q_2_G_2_matrix[2][0]=10*x[i][0];
q_2_G_2_matrix[2][1]=10*x[i][1];
q_2_G_2_matrix[2][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_2->N9_serial)
{
q_2_G_2_matrix[0][0]=10*x[i][0];
q_2_G_2_matrix[0][1]=10*x[i][1];
q_2_G_2_matrix[0][2]=10*x[i][2];
}
//q_2_G_3
if((i+1)==bs_q_2_G_3->C2_serial)
{
q_2_G_3_matrix[6][0]=10*x[i][0];
q_2_G_3_matrix[6][1]=10*x[i][1];
q_2_G_3_matrix[6][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_3->C4_serial)
{
q_2_G_3_matrix[8][0]=10*x[i][0];
q_2_G_3_matrix[8][1]=10*x[i][1];
q_2_G_3_matrix[8][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_3->C5_serial)
{
q_2_G_3_matrix[3][0]=10*x[i][0];
q_2_G_3_matrix[3][1]=10*x[i][1];
q_2_G_3_matrix[3][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_3->C6_serial)
{
q_2_G_3_matrix[4][0]=10*x[i][0];
q_2_G_3_matrix[4][1]=10*x[i][1];
q_2_G_3_matrix[4][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_3->C8_serial)
{
q_2_G_3_matrix[1][0]=10*x[i][0];
q_2_G_3_matrix[1][1]=10*x[i][1];
q_2_G_3_matrix[1][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_3->N1_serial)
{
q_2_G_3_matrix[5][0]=10*x[i][0];
q_2_G_3_matrix[5][1]=10*x[i][1];
q_2_G_3_matrix[5][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_3->N3_serial)
{
q_2_G_3_matrix[7][0]=10*x[i][0];
q_2_G_3_matrix[7][1]=10*x[i][1];
q_2_G_3_matrix[7][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_3->N7_serial)
{
q_2_G_3_matrix[2][0]=10*x[i][0];
q_2_G_3_matrix[2][1]=10*x[i][1];
q_2_G_3_matrix[2][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_3->N9_serial)
{
q_2_G_3_matrix[0][0]=10*x[i][0];
q_2_G_3_matrix[0][1]=10*x[i][1];
q_2_G_3_matrix[0][2]=10*x[i][2];
}
//q_2_G_4
if((i+1)==bs_q_2_G_4->C2_serial)
{
q_2_G_4_matrix[6][0]=10*x[i][0];
q_2_G_4_matrix[6][1]=10*x[i][1];
q_2_G_4_matrix[6][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_4->C4_serial)
{
q_2_G_4_matrix[8][0]=10*x[i][0];
q_2_G_4_matrix[8][1]=10*x[i][1];
q_2_G_4_matrix[8][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_4->C5_serial)
{
q_2_G_4_matrix[3][0]=10*x[i][0];
q_2_G_4_matrix[3][1]=10*x[i][1];
q_2_G_4_matrix[3][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_4->C6_serial)
{
q_2_G_4_matrix[4][0]=10*x[i][0];
q_2_G_4_matrix[4][1]=10*x[i][1];
q_2_G_4_matrix[4][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_4->C8_serial)
{
q_2_G_4_matrix[1][0]=10*x[i][0];
q_2_G_4_matrix[1][1]=10*x[i][1];
q_2_G_4_matrix[1][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_4->N1_serial)
{
q_2_G_4_matrix[5][0]=10*x[i][0];
q_2_G_4_matrix[5][1]=10*x[i][1];
q_2_G_4_matrix[5][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_4->N3_serial)
{
q_2_G_4_matrix[7][0]=10*x[i][0];
q_2_G_4_matrix[7][1]=10*x[i][1];
q_2_G_4_matrix[7][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_4->N7_serial)
{
q_2_G_4_matrix[2][0]=10*x[i][0];
q_2_G_4_matrix[2][1]=10*x[i][1];
q_2_G_4_matrix[2][2]=10*x[i][2];
}
if((i+1)==bs_q_2_G_4->N9_serial)
{
q_2_G_4_matrix[0][0]=10*x[i][0];
q_2_G_4_matrix[0][1]=10*x[i][1];
q_2_G_4_matrix[0][2]=10*x[i][2];
}
}
double ** q_1_G_1_rotation_matrix;
double ** q_1_G_2_rotation_matrix;
double ** q_1_G_3_rotation_matrix;
double ** q_1_G_4_rotation_matrix;
double ** q_2_G_1_rotation_matrix;
double ** q_2_G_2_rotation_matrix;
double ** q_2_G_3_rotation_matrix;
double ** q_2_G_4_rotation_matrix;
q_1_G_1_rotation_matrix=dmatrix(0,2,0,2);
q_1_G_2_rotation_matrix=dmatrix(0,2,0,2);
q_1_G_3_rotation_matrix=dmatrix(0,2,0,2);
q_1_G_4_rotation_matrix=dmatrix(0,2,0,2);
q_2_G_1_rotation_matrix=dmatrix(0,2,0,2);
q_2_G_2_rotation_matrix=dmatrix(0,2,0,2);
q_2_G_3_rotation_matrix=dmatrix(0,2,0,2);
q_2_G_4_rotation_matrix=dmatrix(0,2,0,2);
Rotation_matrix(q_1_G_1_matrix,'G',q_1_G_1_rotation_matrix);
Rotation_matrix(q_1_G_2_matrix,'G',q_1_G_2_rotation_matrix);
Rotation_matrix(q_1_G_3_matrix,'G',q_1_G_3_rotation_matrix);
Rotation_matrix(q_1_G_4_matrix,'G',q_1_G_4_rotation_matrix);
Rotation_matrix(q_2_G_1_matrix,'G',q_2_G_1_rotation_matrix);
Rotation_matrix(q_2_G_2_matrix,'G',q_2_G_2_rotation_matrix);
Rotation_matrix(q_2_G_3_matrix,'G',q_2_G_3_rotation_matrix);
Rotation_matrix(q_2_G_4_matrix,'G',q_2_G_4_rotation_matrix);
//以q_1_G_1为基准，校正z-axis的方向。
double * vector_q_1_G_1;
double * vector_q_1_G_2;
double * vector_q_1_G_3;
double * vector_q_1_G_4;
double * vector_q_2_G_1;
double * vector_q_2_G_2;
double * vector_q_2_G_3;
double * vector_q_2_G_4;
vector_q_1_G_1=dvector(0,2);
vector_q_1_G_2=dvector(0,2);
vector_q_1_G_3=dvector(0,2);
vector_q_1_G_4=dvector(0,2);
vector_q_2_G_1=dvector(0,2);
vector_q_2_G_2=dvector(0,2);
vector_q_2_G_3=dvector(0,2);
vector_q_2_G_4=dvector(0,2);
for(int i=0;i<3;i++)
{
vector_q_1_G_1[i]=q_1_G_1_rotation_matrix[i][2];
vector_q_1_G_2[i]=q_1_G_2_rotation_matrix[i][2];
vector_q_1_G_3[i]=q_1_G_3_rotation_matrix[i][2];
vector_q_1_G_4[i]=q_1_G_4_rotation_matrix[i][2];
vector_q_2_G_1[i]=q_2_G_1_rotation_matrix[i][2];
vector_q_2_G_2[i]=q_2_G_2_rotation_matrix[i][2];
vector_q_2_G_3[i]=q_2_G_3_rotation_matrix[i][2];
vector_q_2_G_4[i]=q_2_G_4_rotation_matrix[i][2];
}
if(dot_product_vector(vector_q_1_G_1,vector_q_1_G_2,3)<0)
{
for(int i=1;i<3;i++)
{
for(int j=0;j<3;j++)
{
q_1_G_2_rotation_matrix[j][i]= - q_1_G_2_rotation_matrix[j][i];
}
}
}
if(dot_product_vector(vector_q_1_G_1,vector_q_1_G_3,3)<0)
{
for(int i=1;i<3;i++)
{
for(int j=0;j<3;j++)
{
q_1_G_3_rotation_matrix[j][i]= - q_1_G_3_rotation_matrix[j][i];
}
}
}
if(dot_product_vector(vector_q_1_G_1,vector_q_1_G_4,3)<0)
{
for(int i=1;i<3;i++)
{
for(int j=0;j<3;j++)
{
q_1_G_4_rotation_matrix[j][i]= - q_1_G_4_rotation_matrix[j][i];
}
}
}
if(dot_product_vector(vector_q_1_G_1,vector_q_2_G_1,3)<0)
{
for(int i=1;i<3;i++)
{
for(int j=0;j<3;j++)
{
q_2_G_1_rotation_matrix[j][i]= - q_2_G_1_rotation_matrix[j][i];
}
}
}
if(dot_product_vector(vector_q_1_G_1,vector_q_2_G_2,3)<0)
{
for(int i=1;i<3;i++)
{
for(int j=0;j<3;j++)
{
q_2_G_2_rotation_matrix[j][i]= - q_2_G_2_rotation_matrix[j][i];
}
}
}
if(dot_product_vector(vector_q_1_G_1,vector_q_2_G_3,3)<0)
{
for(int i=1;i<3;i++)
{
for(int j=0;j<3;j++)
{
q_2_G_3_rotation_matrix[j][i]= - q_2_G_3_rotation_matrix[j][i];
}
}
}
if(dot_product_vector(vector_q_1_G_1,vector_q_2_G_4,3)<0)
{
for(int i=1;i<3;i++)
{
for(int j=0;j<3;j++)
{
q_2_G_4_rotation_matrix[j][i]= - q_2_G_4_rotation_matrix[j][i];
}
}
}
free_dvector(vector_q_1_G_1,0,2);
free_dvector(vector_q_1_G_2,0,2);
free_dvector(vector_q_1_G_3,0,2);
free_dvector(vector_q_1_G_4,0,2);
free_dvector(vector_q_2_G_1,0,2);
free_dvector(vector_q_2_G_2,0,2);
free_dvector(vector_q_2_G_3,0,2);
free_dvector(vector_q_2_G_4,0,2);
//get the origin position of 8 guanine.
double * origin_vector_q_1_G_1;
double * origin_vector_q_1_G_2;
double * origin_vector_q_1_G_3;
double * origin_vector_q_1_G_4;
double * origin_vector_q_2_G_1;
double * origin_vector_q_2_G_2;
double * origin_vector_q_2_G_3;
double * origin_vector_q_2_G_4;
origin_vector_q_1_G_1=dvector(0,2);
origin_vector_q_1_G_2=dvector(0,2);
origin_vector_q_1_G_3=dvector(0,2);
origin_vector_q_1_G_4=dvector(0,2);
origin_vector_q_2_G_1=dvector(0,2);
origin_vector_q_2_G_2=dvector(0,2);
origin_vector_q_2_G_3=dvector(0,2);
origin_vector_q_2_G_4=dvector(0,2);
origin_vector(q_1_G_1_matrix,q_1_G_1_rotation_matrix,'G',origin_vector_q_1_G_1);
origin_vector(q_1_G_2_matrix,q_1_G_2_rotation_matrix,'G',origin_vector_q_1_G_2);
origin_vector(q_1_G_3_matrix,q_1_G_3_rotation_matrix,'G',origin_vector_q_1_G_3);
origin_vector(q_1_G_4_matrix,q_1_G_4_rotation_matrix,'G',origin_vector_q_1_G_4);
origin_vector(q_2_G_1_matrix,q_2_G_1_rotation_matrix,'G',origin_vector_q_2_G_1);
origin_vector(q_2_G_2_matrix,q_2_G_2_rotation_matrix,'G',origin_vector_q_2_G_2);
origin_vector(q_2_G_3_matrix,q_2_G_3_rotation_matrix,'G',origin_vector_q_2_G_3);
origin_vector(q_2_G_4_matrix,q_2_G_4_rotation_matrix,'G',origin_vector_q_2_G_4);
//get the z-axis
vector_q_1_G_1=dvector(0,2);
vector_q_1_G_2=dvector(0,2);
vector_q_1_G_3=dvector(0,2);
vector_q_1_G_4=dvector(0,2);
vector_q_2_G_1=dvector(0,2);
vector_q_2_G_2=dvector(0,2);
vector_q_2_G_3=dvector(0,2);
vector_q_2_G_4=dvector(0,2);
for(int i=0;i<3;i++)
{
vector_q_1_G_1[i]=q_1_G_1_rotation_matrix[i][2];
vector_q_1_G_2[i]=q_1_G_2_rotation_matrix[i][2];
vector_q_1_G_3[i]=q_1_G_3_rotation_matrix[i][2];
vector_q_1_G_4[i]=q_1_G_4_rotation_matrix[i][2];
vector_q_2_G_1[i]=q_2_G_1_rotation_matrix[i][2];
vector_q_2_G_2[i]=q_2_G_2_rotation_matrix[i][2];
vector_q_2_G_3[i]=q_2_G_3_rotation_matrix[i][2];
vector_q_2_G_4[i]=q_2_G_4_rotation_matrix[i][2];
// cout<<vector_q_1_G_1[i]<<endl; //for test
// cout<<vector_q_1_G_2[i]<<endl; //for test
// cout<<vector_q_1_G_3[i]<<endl; //for test
// cout<<vector_q_1_G_4[i]<<endl; //for test
// cout<<vector_q_2_G_1[i]<<endl; //for test
// cout<<vector_q_2_G_2[i]<<endl; //for test
// cout<<vector_q_2_G_3[i]<<endl; //for test
// cout<<vector_q_2_G_4[i]<<endl; //for test
}
double * vector_q_1_G_1_2;
double * vector_q_1_G_3_4;
double * vector_q_1_G_1_2_3_4;
double * vector_q_2_G_1_2;
double * vector_q_2_G_3_4;
double * vector_q_2_G_1_2_3_4;
double * vector_orientation;
vector_q_1_G_1_2=dvector(0,2);
vector_q_1_G_3_4=dvector(0,2);
vector_q_1_G_1_2_3_4=dvector(0,2);
vector_q_2_G_1_2=dvector(0,2);
vector_q_2_G_3_4=dvector(0,2);
vector_q_2_G_1_2_3_4=dvector(0,2);
vector_orientation=dvector(0,2);
rotate_2_vector(vector_q_1_G_1,vector_q_1_G_2, vector_q_1_G_1_2);
// for test
// for(int i=0;i<3;i++)
// {
// cout<<vector_q_1_G_1_2[i]<<endl;
// }
//
rotate_2_vector(vector_q_1_G_3,vector_q_1_G_4,vector_q_1_G_3_4);
rotate_2_vector(vector_q_2_G_1,vector_q_2_G_2,vector_q_2_G_1_2);
rotate_2_vector(vector_q_2_G_3,vector_q_2_G_4,vector_q_2_G_3_4);
rotate_2_vector(vector_q_1_G_1_2,vector_q_1_G_3_4,vector_q_1_G_1_2_3_4);
rotate_2_vector(vector_q_2_G_1_2,vector_q_2_G_3_4,vector_q_2_G_1_2_3_4);
rotate_2_vector(vector_q_1_G_1_2_3_4,vector_q_2_G_1_2_3_4,vector_orientation);
//for test
/*
for(int i=0;i<3;i++)
{
cout<<vector_orientation[i]<<endl;
}
*/
//
//get the center position.
double * center_position_vector;
double * center_1;
double * center_2;
double * vector_2_ion;
double * vector_1_2;
center_position_vector=dvector(0,2);
vector_2_ion=dvector(0,2);
center_1=dvector(0,2);
center_2=dvector(0,2);
vector_1_2=dvector(0,2);
for(int i=0;i<3;i++)
{
center_position_vector[i]=(origin_vector_q_1_G_1[i]+origin_vector_q_1_G_2[i]+origin_vector_q_1_G_3[i]+origin_vector_q_1_G_4[i]+origin_vector_q_2_G_1[i]+origin_vector_q_2_G_2[i]+origin_vector_q_2_G_3[i]+origin_vector_q_2_G_4[i])/8;
center_1[i]=(origin_vector_q_1_G_1[i]+origin_vector_q_1_G_2[i]+origin_vector_q_1_G_3[i]+origin_vector_q_1_G_4[i])/4;
center_2[i]=(origin_vector_q_2_G_1[i]+origin_vector_q_2_G_2[i]+origin_vector_q_2_G_3[i]+origin_vector_q_2_G_4[i])/4;
vector_2_ion[i]=ion_coor[i]-center_position_vector[i];
vector_1_2[i]=center_1[i]-center_2[i];
}
double length=0;
double dist_z=0;
double dist=0;
length=dot_product_vector(vector_orientation,vector_2_ion,3);
dist_z=dot_product_vector(vector_orientation,vector_1_2,3);
dist=sqrt(dot_product_vector(vector_1_2,vector_1_2,3));
//
out<<fixed<<showpoint;
out<<time_temp<<"\t"<<setprecision(4)<<fabs(length)<<"\t"<<setprecision(4)<<dist<<"\t"<<setprecision(4)<<fabs(dist_z)<<endl;
free_dmatrix(q_1_G_1_matrix,0,2,0,8);
free_dmatrix(q_1_G_2_matrix,0,2,0,8);
free_dmatrix(q_1_G_3_matrix,0,2,0,8);
free_dmatrix(q_1_G_4_matrix,0,2,0,8);
free_dmatrix(q_2_G_1_matrix,0,2,0,8);
free_dmatrix(q_2_G_2_matrix,0,2,0,8);
free_dmatrix(q_2_G_3_matrix,0,2,0,8);
free_dmatrix(q_2_G_4_matrix,0,2,0,8);
free_dmatrix(q_1_G_1_rotation_matrix,0,2,0,2);
free_dmatrix(q_1_G_2_rotation_matrix,0,2,0,2);
free_dmatrix(q_1_G_3_rotation_matrix,0,2,0,2);
free_dmatrix(q_1_G_4_rotation_matrix,0,2,0,2);
free_dmatrix(q_2_G_1_rotation_matrix,0,2,0,2);
free_dmatrix(q_2_G_2_rotation_matrix,0,2,0,2);
free_dmatrix(q_2_G_3_rotation_matrix,0,2,0,2);
free_dmatrix(q_2_G_4_rotation_matrix,0,2,0,2);
free_dvector(vector_q_1_G_1,0,2);
free_dvector(vector_q_1_G_2,0,2);
free_dvector(vector_q_1_G_3,0,2);
free_dvector(vector_q_1_G_4,0,2);
free_dvector(vector_q_2_G_1,0,2);
free_dvector(vector_q_2_G_2,0,2);
free_dvector(vector_q_2_G_3,0,2);
free_dvector(vector_q_2_G_4,0,2);
free_dvector(origin_vector_q_1_G_1,0,2);
free_dvector(origin_vector_q_1_G_2,0,2);
free_dvector(origin_vector_q_1_G_3,0,2);
free_dvector(origin_vector_q_1_G_4,0,2);
free_dvector(origin_vector_q_2_G_1,0,2);
free_dvector(origin_vector_q_2_G_2,0,2);
free_dvector(origin_vector_q_2_G_3,0,2);
free_dvector(origin_vector_q_2_G_4,0,2);
free_dvector(vector_q_1_G_1_2,0,2);
free_dvector(vector_q_1_G_3_4,0,2);
free_dvector(vector_q_1_G_1_2_3_4,0,2);
free_dvector(vector_q_2_G_1_2,0,2);
free_dvector(vector_q_2_G_3_4,0,2);
free_dvector( vector_q_2_G_1_2_3_4,0,2);
free_dvector( vector_orientation,0,2);
}
}
xdrfile_close(xtc);
out.close();
}
int complement_match (Representation* X_rep, Representation* Y_rep,
Map * map, int map_max,
int * map_ctr, int * map_best, int best_max, int parent_map){
Penalty_parametrization penalty_params; /* for SW */
double **x = X_rep->full;
int * x_type = X_rep->full_type;
int NX = X_rep->N_full;
double **y = Y_rep->full;
int * y_type = Y_rep->full_type;
int NY = Y_rep->N_full;
double F_effective = 0.0;
double F_current;
double q[4] = {0.0}, q_init[4] = {0.0};
double **x_rotated = NULL;
double **tr_x_rotated = NULL;
double **R;
double z_scr = 0.0, *z_best;
double avg, avg_sq, stdev;
double alpha = options.alpha;
double rmsd, best_rmsd[TOP_RMSD];
double **best_quat;
double cutoff_rmsd = 3.0; /* <<<<<<<<<<<<<<<<< hardcoded */
int *x_type_fudg, *y_type_fudg;
int *anchor_x, *anchor_y, no_anchors;
int no_top_rmsd = TOP_RMSD, chunk;
int x_ctr, y_ctr, top_ctr;
int **best_triple_x;
int **best_triple_y;
int x_triple[3], y_triple[3];
int retval, done = 0;
int best_ctr;
int i, j;
int t;
int smaller;
int my_map_ctr;
int stored_new;
int * x2y, map_unstable;
//time_t time_now, time_start;
int cull_by_dna (Representation * X_rep, int *set_of_directions_x,
Representation * Y_rep, int *set_of_directions_y,
int set_size, Map *map, double cutoff_rmsd);
int distance_of_nearest_approach (Representation * X_rep, int *set_of_directions_x,
Representation * Y_rep, int *set_of_directions_y,
int set_size, double * rmsd_ptr);
int same_hand_triple (Representation * X_rep, int *set_of_directions_x,
Representation * Y_rep, int *set_of_directions_y, int set_size);
int find_map (Penalty_parametrization * params, Representation *X_rep, Representation *Y_rep,
double ** R, double alpha, double * F_effective, Map *map,
int *anchor_x, int * anchor_y, int anchor_size );
int find_next_triple (double **X, double **Y,
int *x_type, int *y_type, int NX, int NY,
int *x_triple, int *y_triple);
int gradient_descent (int first_call, double alpha,
double **x, int * x_type, int NX,
double **y, int * y_type, int NY,
double *q_best, double *F_best_ptr) ;
int map_quality_metrics (Representation *X_rep, Representation *Y_rep,
double ** tr_x_rotated, Map * map, int *reasonable_angle_ct);
int monte_carlo (double alpha,
double **x, int * x_type, int NX,
double **y, int * y_type, int NY,
double *q_best, double *F_best_ptr);
int opt_quat (double ** x, int NX, int *set_of_directions_x,
double ** y, int NY, int *set_of_directions_y,
int set_size, double * q, double * rmsd);
int qmap (double *x0, double *x1, double *y0, double *y1, double * quat);
int store_sorted (Map * map, int NX, int NY, int *map_best, int map_max,
double * z_best, int best_ctr,
double z_scr, int my_map_ctr, int *stored);
map_best[0] = -1; /* it is the end-of-array flag */
if ( *map_ctr >= map_max ) {
fprintf (stderr, "Map array undersized.\n");
exit (1);
}
smaller = (NX <= NY) ? NX : NY;
/***********************/
/* memory allocation */
/***********************/
if ( ! (R=dmatrix(3,3) ) ) return 1; /* compiler is bugging me otherwise */
if ( ! (x_rotated = dmatrix (NX,3)) ) return 1;
if ( ! (tr_x_rotated = dmatrix (NX,3)) ) return 1;
if ( ! (best_quat = dmatrix (no_top_rmsd,4)) ) return 1;
if ( ! (best_triple_x = intmatrix (no_top_rmsd,3)) ) return 1;
if ( ! (best_triple_y = intmatrix (no_top_rmsd,3)) ) return 1;
if ( ! (z_best = emalloc(NX*NY*sizeof(double) )) ) return 1;
if ( ! (x_type_fudg = emalloc(NX*sizeof(int) )) ) return 1;
if ( ! (y_type_fudg = emalloc(NY*sizeof(int) )) ) return 1;
if ( ! (anchor_x = emalloc(NX*sizeof(int) )) ) return 1;
if ( ! (anchor_y = emalloc(NY*sizeof(int) )) ) return 1;
penalty_params.custom_gap_penalty_x = NULL;
penalty_params.custom_gap_penalty_y = NULL;
//if ( ! (penalty_params.custom_gap_penalty_x = emalloc(NX*sizeof(double) )) ) return 1;
//if ( ! (penalty_params.custom_gap_penalty_y = emalloc(NY*sizeof(double) )) ) return 1;
/***********************/
/***********************/
/* expected quantities */
/***********************/
avg = avg_sq = stdev = 0.0;
//if (options.postprocess) {
if (0) {
if (F_moments (x, x_type, NX, y, y_type, NY, alpha, &avg, &avg_sq, &stdev)) return 1;
}
/***********************/
/***********************/
/* initialization */
/***********************/
best_ctr = 0;
penalty_params.gap_opening = options.gap_open;
penalty_params.gap_extension = options.gap_extend;
penalty_params.endgap = options.endgap;
penalty_params.endgap_special_treatment = options.use_endgap;
/***********************/
/***************************************/
/* find reasonble triples of SSEs */
/* that correspond in type */
/* and can be mapped onto each other */
/***************************************/
for (top_ctr=0; top_ctr<no_top_rmsd; top_ctr++) {
best_rmsd[top_ctr] = BAD_RMSD+1;
best_triple_x[top_ctr][0] = -1;
}
for (x_ctr=0; x_ctr < NX-2 && !done; x_ctr++) {
for (y_ctr=0; y_ctr < NY-2 && !done; y_ctr++) {
if ( y_type[y_ctr] != x_type[x_ctr] ) continue;
x_triple[0] = x_ctr;
y_triple[0] = y_ctr;
if (find_next_triple (x, y, x_type, y_type,
NX, NY, x_triple, y_triple) ){
continue;
}
if ( x_triple[1] < 0 || x_triple[2] < 0 ) continue;
if ( y_triple[1] < 0 || y_triple[2] < 0 ) continue;
/* do these three have kind-of similar layout in space?*/
/* is handedness the same? */
if ( ! same_hand_triple ( X_rep, x_triple, Y_rep, y_triple, 3)) continue;
/* are distances comparab;e? */
if (distance_of_nearest_approach ( X_rep, x_triple,
Y_rep, y_triple, 3, &rmsd)) continue;
if ( rmsd > cutoff_rmsd) continue;
/* find q_init that maps the two triples as well as possible*/
if ( opt_quat ( x, NX, x_triple, y, NY, y_triple, 3, q_init, &rmsd)) continue;
for (top_ctr=0; top_ctr<no_top_rmsd; top_ctr++) {
if ( rmsd <= best_rmsd[top_ctr] ) {
chunk = no_top_rmsd - top_ctr -1;
if (chunk) {
memmove (best_rmsd+top_ctr+1, best_rmsd+top_ctr, chunk*sizeof(double));
memmove (best_quat[top_ctr+1],
best_quat[top_ctr], chunk*4*sizeof(double));
memmove (best_triple_x[top_ctr+1],
best_triple_x[top_ctr], chunk*3*sizeof(int));
memmove (best_triple_y[top_ctr+1],
best_triple_y[top_ctr], chunk*3*sizeof(int));
}
best_rmsd[top_ctr] = rmsd;
memcpy (best_quat[top_ctr], q_init, 4*sizeof(double));
memcpy (best_triple_x[top_ctr], x_triple, 3*sizeof(int));
memcpy (best_triple_y[top_ctr], y_triple, 3*sizeof(int));
break;
}
}
}
}
# if 0
for (top_ctr=0; top_ctr<no_top_rmsd; top_ctr++) {
if ( best_rmsd[top_ctr] > BAD_RMSD ) break;
printf (" %3d %8.3lf ", top_ctr, best_rmsd[top_ctr]);
vec_out ( best_quat[top_ctr], 4, "quat: ");
for (t=0; t<3; t++ ) {
printf ("\t %3d %3d \n", best_triple_x[top_ctr][t]+1, best_triple_y[top_ctr][t]+1 );
}
}
exit (1);
# endif
/*********************************************/
/* main loop */
/*********************************************/
for (top_ctr=0; top_ctr<no_top_rmsd; top_ctr++) {
if ( best_rmsd[top_ctr] > BAD_RMSD ) break;
quat_to_R (best_quat[top_ctr], R);
rotate (x_rotated, NX, R, x);
F_current = F( y, y_type, NY, x_rotated, x_type, NX, alpha);
# if 0
printf ("\n***********************************\n");
printf (" %3d %8.3lf %8.3lf ", top_ctr, best_rmsd[top_ctr], F_current);
vec_out ( best_quat[top_ctr], 4, "quat: ");
for (t=0; t<3; t++ ) {
printf ("\t %3d %3d \n", best_triple_x[top_ctr][t]+1, best_triple_y[top_ctr][t]+1 );
}
# endif
/* find map which uses the 2 triples as anchors */
no_anchors = 3;
find_map (&penalty_params, X_rep, Y_rep, R, alpha, &F_effective, map + (*map_ctr),
best_triple_x[top_ctr], best_triple_y[top_ctr], no_anchors);
x2y = ( map + (*map_ctr) ) ->x2y;
map_unstable = 0;
for (t=0; t<3; t++ ) {
if ( x2y[best_triple_x[top_ctr][t]] != best_triple_y[top_ctr][t] ) {
map_unstable = 1;
}
}
if ( map_unstable) continue;
/* dna here is not DNA but "distance of nearest approach" */
cull_by_dna ( X_rep, best_triple_x[top_ctr],
Y_rep, best_triple_y[top_ctr], 3, map + (*map_ctr), cutoff_rmsd );
//printf ("map after culling by dna:\n");
//print_map (stdout, map+ (*map_ctr), NULL, NULL, NULL, NULL, 1);
/* monte that optimizes the aligned vectors only */
for (i=0; i<NX; i++) {
x_type_fudg[i] = JACKFRUIT;
}
for (j=0; j<NY; j++) {
y_type_fudg[j] = JACKFRUIT*2;
}
no_anchors = 0;
for (i=0; i<NX; i++) {
j = (map+(*map_ctr))->x2y[i];
if (j < 0 ) continue;
x_type_fudg[i] = x_type[i];
y_type_fudg[j] = y_type[j];
anchor_x[no_anchors] = i;
anchor_y[no_anchors] = j;
no_anchors ++;
}
if ( opt_quat ( x, NX, anchor_x, y, NY, anchor_y, no_anchors, q, &rmsd)) continue;
retval = monte_carlo ( alpha, x, x_type_fudg, NX,
y, y_type_fudg, NY, q, &F_current);
if (retval) return retval;
if (options.postprocess) {
z_scr = stdev ? (F_current - avg)/stdev : 0.0;
} else {
z_scr = 0.0;
}
quat_to_R (q, R);
/* store_image() is waste of time, but perhaps not critical */
store_image (X_rep, Y_rep, R, alpha, map + (*map_ctr));
map_assigned_score ( X_rep, map + (*map_ctr));
//printf ("map %2d assigned score: %8.3lf z_score: %8.3lf \n\n",
// *map_ctr+1, (map + (*map_ctr)) -> assigned_score, z_scr);
/* store the map that passed all the filters down to here*/
my_map_ctr = *map_ctr;
map[my_map_ctr].F = F_current;
map[my_map_ctr].avg = avg;
map[my_map_ctr].avg_sq = avg_sq;
map[my_map_ctr].z_score = z_scr;
memcpy ( map[my_map_ctr].q, q, 4*sizeof(double) );
/* recalculate the assigned score*/
//if (top_ctr==24) exit (1);
/************************/
/* store sorted */
/************************/
/* find the place for the new z-score */
store_sorted (map, NX, NY, map_best, map_max,
z_best, best_ctr, -map[my_map_ctr].assigned_score, my_map_ctr, &stored_new);
if ( stored_new ) { /* we want to keep this map */
(*map_ctr) ++;
best_ctr++;
} /* otherwise this map space is reusable */
/* is this pretty much as good as it can get ? */
if ( fabs (map[my_map_ctr].assigned_score - smaller)
< options.tol ) done = 1;
}
map_best[best_ctr] = -1;
/******************************************************/
/* look for the sub-map of a couple of best hits */
/******************************************************/
/* initialization:*/
map_consistence ( NX, NY, NULL, NULL, NULL, NULL, NULL);
best_ctr = 0;
while ( map_best[best_ctr] > -1 ) {
best_ctr ++;
}
//exit (1);
if (best_ctr) {
int nr_maps = (best_ctr<options.number_maps_cpl)?
best_ctr : options.number_maps_cpl;
int best_i;
int consistent;
double z;
double total_assigned_score, score, best_score = -100;
double gap_score;
for (i=0; i<nr_maps; i++) { /* look for the complement */
best_i = map_best[i];
/*intialize the (list of) submatch map(s) */
if ( !map[best_i].submatch_best) {
/* for now look for a single map only */
/* TODO - would it be worth any to look at more maps?*/
int map_max = 1;
map[best_i].submatch_best = emalloc (map_max*sizeof(int) );
if (! map[best_i].submatch_best) return 1;
}
map[best_i].submatch_best[0] = -1;
map[best_i].score_with_children = 0;
map[best_i].compl_z_score = 0;
for (j=0; j<best_ctr; j++) {
if (i==j) continue;
map_complementarity ( map+best_i, map + map_best[j], &z);
map_consistence ( NX, NY, map+best_i, map + map_best[j],
&total_assigned_score, &gap_score, NULL);
consistent = ( (map+best_i)->assigned_score < total_assigned_score
&& (map + map_best[j])->assigned_score
< total_assigned_score);
if ( consistent ) {
score = total_assigned_score;
if ( score > best_score ) {
best_score = score;
map[best_i].submatch_best[0] = map_best[j];
map[best_i].score_with_children = total_assigned_score;
map[best_i].compl_z_score = z;
}
}
}
}
}
/**********************/
/* garbage collection */
gradient_descent (1, 0.0, NULL, NULL, 0,
NULL, NULL, 0, NULL, NULL);
free_dmatrix (R);
free_dmatrix (x_rotated);
free_dmatrix (tr_x_rotated);
free_dmatrix (best_quat);
free_imatrix (best_triple_x);
free_imatrix (best_triple_y);
free (z_best);
free (x_type_fudg);
free (y_type_fudg);
free (anchor_x);
free (anchor_y);
if (penalty_params.custom_gap_penalty_x) free (penalty_params.custom_gap_penalty_x);
if (penalty_params.custom_gap_penalty_y) free (penalty_params.custom_gap_penalty_y);
/*********************/
return 0;
}
SEXP coxexact(SEXP maxiter2, SEXP y2,
SEXP covar2, SEXP offset2, SEXP strata2,
SEXP ibeta, SEXP eps2, SEXP toler2) {
int i,j,k;
int iter;
double **covar, **imat; /*ragged arrays */
double *time, *status; /* input data */
double *offset;
int *strata;
int sstart; /* starting obs of current strata */
double *score;
double *oldbeta;
double zbeta;
double newlk=0;
double temp;
int halving; /*are we doing step halving at the moment? */
int nrisk; /* number of subjects in the current risk set */
int dsize, /* memory needed for one coxc0, coxc1, or coxd2 array */
dmemtot, /* amount needed for all arrays */
maxdeath, /* max tied deaths within a strata */
ndeath; /* number of deaths at the current time point */
double dtime; /* time value under current examiniation */
double *dmem0, **dmem1, *dmem2; /* pointers to memory */
double *dtemp; /* used for zeroing the memory */
double *d1; /* current first derivatives from coxd1 */
double d0; /* global sum from coxc0 */
/* copies of scalar input arguments */
int nused, nvar, maxiter;
double eps, toler;
/* returned objects */
SEXP imat2, beta2, u2, loglik2;
double *beta, *u, *loglik;
SEXP rlist, rlistnames;
int nprotect; /* number of protect calls I have issued */
nused = LENGTH(offset2);
nvar = ncols(covar2);
maxiter = asInteger(maxiter2);
eps = asReal(eps2); /* convergence criteria */
toler = asReal(toler2); /* tolerance for cholesky */
/*
** Set up the ragged array pointer to the X matrix,
** and pointers to time and status
*/
covar= dmatrix(REAL(covar2), nused, nvar);
time = REAL(y2);
status = time +nused;
strata = INTEGER(PROTECT(duplicate(strata2)));
offset = REAL(offset2);
/* temporary vectors */
score = (double *) R_alloc(nused+nvar, sizeof(double));
oldbeta = score + nused;
/*
** create output variables
*/
PROTECT(beta2 = duplicate(ibeta));
beta = REAL(beta2);
PROTECT(u2 = allocVector(REALSXP, nvar));
u = REAL(u2);
PROTECT(imat2 = allocVector(REALSXP, nvar*nvar));
imat = dmatrix(REAL(imat2), nvar, nvar);
PROTECT(loglik2 = allocVector(REALSXP, 5)); /* loglik, sctest, flag,maxiter*/
loglik = REAL(loglik2);
nprotect = 5;
strata[0] =1; /* in case the parent forgot */
dsize = 0;
maxdeath =0;
j=0; /* start of the strata */
for (i=0; i<nused;) {
if (strata[i]==1) { /* first obs of a new strata */
if (i>0) {
/* If maxdeath <2 leave the strata alone at it's current value of 1 */
if (maxdeath >1) strata[j] = maxdeath;
j = i;
if (maxdeath*nrisk >dsize) dsize = maxdeath*nrisk;
}
maxdeath =0; /* max tied deaths at any time in this strata */
nrisk=0;
ndeath =0;
}
dtime = time[i];
ndeath =0; /*number tied here */
while (time[i] ==dtime) {
nrisk++;
ndeath += status[i];
i++;
if (i>=nused || strata[i] >0) break; /*tied deaths don't cross strata */
}
if (ndeath > maxdeath) maxdeath=ndeath;
}
if (maxdeath*nrisk >dsize) dsize = maxdeath*nrisk;
if (maxdeath >1) strata[j] = maxdeath;
/* Now allocate memory for the scratch arrays
Each per-variable slice is of size dsize
*/
dmemtot = dsize * ((nvar*(nvar+1))/2 + nvar + 1);
dmem0 = (double *) R_alloc(dmemtot, sizeof(double)); /*pointer to memory */
dmem1 = (double **) R_alloc(nvar, sizeof(double*));
dmem1[0] = dmem0 + dsize; /*points to the first derivative memory */
for (i=1; i<nvar; i++) dmem1[i] = dmem1[i-1] + dsize;
d1 = (double *) R_alloc(nvar, sizeof(double)); /*first deriv results */
/*
** do the initial iteration step
*/
newlk =0;
for (i=0; i<nvar; i++) {
u[i] =0;
for (j=0; j<nvar; j++)
imat[i][j] =0 ;
}
for (i=0; i<nused; ) {
if (strata[i] >0) { /* first obs of a new strata */
maxdeath= strata[i];
dtemp = dmem0;
for (j=0; j<dmemtot; j++) *dtemp++ =0.0;
sstart =i;
nrisk =0;
}
dtime = time[i]; /*current unique time */
ndeath =0;
while (time[i] == dtime) {
zbeta= offset[i];
for (j=0; j<nvar; j++) zbeta += covar[j][i] * beta[j];
score[i] = exp(zbeta);
if (status[i]==1) {
newlk += zbeta;
for (j=0; j<nvar; j++) u[j] += covar[j][i];
ndeath++;
}
nrisk++;
i++;
if (i>=nused || strata[i] >0) break;
}
/* We have added up over the death time, now process it */
if (ndeath >0) { /* Add to the loglik */
d0 = coxd0(ndeath, nrisk, score+sstart, dmem0, maxdeath);
R_CheckUserInterrupt();
newlk -= log(d0);
dmem2 = dmem0 + (nvar+1)*dsize; /*start for the second deriv memory */
for (j=0; j<nvar; j++) { /* for each covariate */
d1[j] = coxd1(ndeath, nrisk, score+sstart, dmem0, dmem1[j],
covar[j]+sstart, maxdeath) / d0;
if (ndeath > 3) R_CheckUserInterrupt();
u[j] -= d1[j];
for (k=0; k<= j; k++) { /* second derivative*/
temp = coxd2(ndeath, nrisk, score+sstart, dmem0, dmem1[j],
dmem1[k], dmem2, covar[j] + sstart,
covar[k] + sstart, maxdeath);
if (ndeath > 5) R_CheckUserInterrupt();
imat[k][j] += temp/d0 - d1[j]*d1[k];
dmem2 += dsize;
}
}
}
}
loglik[0] = newlk; /* save the loglik for iteration zero */
loglik[1] = newlk; /* and it is our current best guess */
/*
** update the betas and compute the score test
*/
for (i=0; i<nvar; i++) /*use 'd1' as a temp to save u0, for the score test*/
d1[i] = u[i];
loglik[3] = cholesky2(imat, nvar, toler);
chsolve2(imat,nvar, u); /* u replaced by u *inverse(imat) */
loglik[2] =0; /* score test stored here */
for (i=0; i<nvar; i++)
loglik[2] += u[i]*d1[i];
if (maxiter==0) {
iter =0; /*number of iterations */
loglik[4] = iter;
chinv2(imat, nvar);
for (i=1; i<nvar; i++)
for (j=0; j<i; j++) imat[i][j] = imat[j][i];
/* assemble the return objects as a list */
PROTECT(rlist= allocVector(VECSXP, 4));
SET_VECTOR_ELT(rlist, 0, beta2);
SET_VECTOR_ELT(rlist, 1, u2);
SET_VECTOR_ELT(rlist, 2, imat2);
SET_VECTOR_ELT(rlist, 3, loglik2);
/* add names to the list elements */
PROTECT(rlistnames = allocVector(STRSXP, 4));
SET_STRING_ELT(rlistnames, 0, mkChar("coef"));
SET_STRING_ELT(rlistnames, 1, mkChar("u"));
SET_STRING_ELT(rlistnames, 2, mkChar("imat"));
SET_STRING_ELT(rlistnames, 3, mkChar("loglik"));
setAttrib(rlist, R_NamesSymbol, rlistnames);
unprotect(nprotect+2);
return(rlist);
}
/*
** Never, never complain about convergence on the first step. That way,
** if someone has to they can force one iter at a time.
*/
for (i=0; i<nvar; i++) {
oldbeta[i] = beta[i];
beta[i] = beta[i] + u[i];
}
halving =0 ; /* =1 when in the midst of "step halving" */
for (iter=1; iter<=maxiter; iter++) {
newlk =0;
for (i=0; i<nvar; i++) {
u[i] =0;
for (j=0; j<nvar; j++)
imat[i][j] =0;
}
for (i=0; i<nused; ) {
if (strata[i] >0) { /* first obs of a new strata */
maxdeath= strata[i];
dtemp = dmem0;
for (j=0; j<dmemtot; j++) *dtemp++ =0.0;
sstart =i;
nrisk =0;
}
dtime = time[i]; /*current unique time */
ndeath =0;
while (time[i] == dtime) {
zbeta= offset[i];
for (j=0; j<nvar; j++) zbeta += covar[j][i] * beta[j];
score[i] = exp(zbeta);
if (status[i]==1) {
newlk += zbeta;
for (j=0; j<nvar; j++) u[j] += covar[j][i];
ndeath++;
}
nrisk++;
i++;
if (i>=nused || strata[i] >0) break;
}
/* We have added up over the death time, now process it */
if (ndeath >0) { /* Add to the loglik */
d0 = coxd0(ndeath, nrisk, score+sstart, dmem0, maxdeath);
R_CheckUserInterrupt();
newlk -= log(d0);
dmem2 = dmem0 + (nvar+1)*dsize; /*start for the second deriv memory */
for (j=0; j<nvar; j++) { /* for each covariate */
d1[j] = coxd1(ndeath, nrisk, score+sstart, dmem0, dmem1[j],
covar[j]+sstart, maxdeath) / d0;
if (ndeath > 3) R_CheckUserInterrupt();
u[j] -= d1[j];
for (k=0; k<= j; k++) { /* second derivative*/
temp = coxd2(ndeath, nrisk, score+sstart, dmem0, dmem1[j],
dmem1[k], dmem2, covar[j] + sstart,
covar[k] + sstart, maxdeath);
if (ndeath > 5) R_CheckUserInterrupt();
imat[k][j] += temp/d0 - d1[j]*d1[k];
dmem2 += dsize;
}
}
}
}
/* am I done?
** update the betas and test for convergence
*/
loglik[3] = cholesky2(imat, nvar, toler);
if (fabs(1-(loglik[1]/newlk))<= eps && halving==0) { /* all done */
loglik[1] = newlk;
loglik[4] = iter;
chinv2(imat, nvar);
for (i=1; i<nvar; i++)
for (j=0; j<i; j++) imat[i][j] = imat[j][i];
/* assemble the return objects as a list */
PROTECT(rlist= allocVector(VECSXP, 4));
SET_VECTOR_ELT(rlist, 0, beta2);
SET_VECTOR_ELT(rlist, 1, u2);
SET_VECTOR_ELT(rlist, 2, imat2);
SET_VECTOR_ELT(rlist, 3, loglik2);
/* add names to the list elements */
PROTECT(rlistnames = allocVector(STRSXP, 4));
SET_STRING_ELT(rlistnames, 0, mkChar("coef"));
SET_STRING_ELT(rlistnames, 1, mkChar("u"));
SET_STRING_ELT(rlistnames, 2, mkChar("imat"));
SET_STRING_ELT(rlistnames, 3, mkChar("loglik"));
setAttrib(rlist, R_NamesSymbol, rlistnames);
unprotect(nprotect+2);
return(rlist);
}
if (iter==maxiter) break; /*skip the step halving and etc */
if (newlk < loglik[1]) { /*it is not converging ! */
halving =1;
for (i=0; i<nvar; i++)
beta[i] = (oldbeta[i] + beta[i]) /2; /*half of old increment */
}
else {
halving=0;
loglik[1] = newlk;
chsolve2(imat,nvar,u);
for (i=0; i<nvar; i++) {
oldbeta[i] = beta[i];
beta[i] = beta[i] + u[i];
}
}
} /* return for another iteration */
/*
** Ran out of iterations
*/
loglik[1] = newlk;
loglik[3] = 1000; /* signal no convergence */
loglik[4] = iter;
chinv2(imat, nvar);
for (i=1; i<nvar; i++)
for (j=0; j<i; j++) imat[i][j] = imat[j][i];
/* assemble the return objects as a list */
PROTECT(rlist= allocVector(VECSXP, 4));
SET_VECTOR_ELT(rlist, 0, beta2);
SET_VECTOR_ELT(rlist, 1, u2);
SET_VECTOR_ELT(rlist, 2, imat2);
SET_VECTOR_ELT(rlist, 3, loglik2);
/* add names to the list elements */
PROTECT(rlistnames = allocVector(STRSXP, 4));
SET_STRING_ELT(rlistnames, 0, mkChar("coef"));
SET_STRING_ELT(rlistnames, 1, mkChar("u"));
SET_STRING_ELT(rlistnames, 2, mkChar("imat"));
SET_STRING_ELT(rlistnames, 3, mkChar("loglik"));
setAttrib(rlist, R_NamesSymbol, rlistnames);
unprotect(nprotect+2);
return(rlist);
}
int reduced_charset(struct zint_symbol *symbol, uint8_t *source, int length)
{
/* These are the "norm" standards which only support Latin-1 at most */
int error_number = 0;
uint8_t preprocessed[length + 1];
if(symbol->symbology == BARCODE_CODE16K) {
symbol->whitespace_width = 16;
symbol->border_width = 2;
symbol->output_options = BARCODE_BIND;
}
if(symbol->symbology == BARCODE_ITF14) {
symbol->whitespace_width = 20;
symbol->border_width = 8;
symbol->output_options = BARCODE_BOX;
}
switch(symbol->input_mode) {
case DATA_MODE:
case GS1_MODE:
memcpy(preprocessed, source, length);
preprocessed[length] = '\0';
break;
case UNICODE_MODE:
error_number = latin1_process(symbol, source, preprocessed, &length);
if(error_number != 0) { return error_number; }
break;
}
switch(symbol->symbology) {
case BARCODE_C25MATRIX: error_number = matrix_two_of_five(symbol, preprocessed, length); break;
case BARCODE_C25IND: error_number = industrial_two_of_five(symbol, preprocessed, length); break;
case BARCODE_C25INTER: error_number = interleaved_two_of_five(symbol, preprocessed, length); break;
case BARCODE_C25IATA: error_number = iata_two_of_five(symbol, preprocessed, length); break;
case BARCODE_C25LOGIC: error_number = logic_two_of_five(symbol, preprocessed, length); break;
case BARCODE_DPLEIT: error_number = dpleit(symbol, preprocessed, length); break;
case BARCODE_DPIDENT: error_number = dpident(symbol, preprocessed, length); break;
case BARCODE_UPCA: error_number = eanx(symbol, preprocessed, length); break;
case BARCODE_UPCE: error_number = eanx(symbol, preprocessed, length); break;
case BARCODE_EANX: error_number = eanx(symbol, preprocessed, length); break;
case BARCODE_EAN128: error_number = ean_128(symbol, preprocessed, length); break;
case BARCODE_CODE39: error_number = c39(symbol, preprocessed, length); break;
case BARCODE_PZN: error_number = pharmazentral(symbol, preprocessed, length); break;
case BARCODE_EXCODE39: error_number = ec39(symbol, preprocessed, length); break;
case BARCODE_CODABAR: error_number = codabar(symbol, preprocessed, length); break;
case BARCODE_CODE93: error_number = c93(symbol, preprocessed, length); break;
case BARCODE_LOGMARS: error_number = c39(symbol, preprocessed, length); break;
case BARCODE_CODE128: error_number = code_128(symbol, preprocessed, length); break;
case BARCODE_CODE128B: error_number = code_128(symbol, preprocessed, length); break;
case BARCODE_NVE18: error_number = nve_18(symbol, preprocessed, length); break;
case BARCODE_CODE11: error_number = code_11(symbol, preprocessed, length); break;
case BARCODE_MSI_PLESSEY: error_number = msi_handle(symbol, preprocessed, length); break;
case BARCODE_TELEPEN: error_number = telepen(symbol, preprocessed, length); break;
case BARCODE_TELEPEN_NUM: error_number = telepen_num(symbol, preprocessed, length); break;
case BARCODE_PHARMA: error_number = pharma_one(symbol, preprocessed, length); break;
case BARCODE_PLESSEY: error_number = plessey(symbol, preprocessed, length); break;
case BARCODE_ITF14: error_number = itf14(symbol, preprocessed, length); break;
case BARCODE_FLAT: error_number = flattermarken(symbol, preprocessed, length); break;
case BARCODE_FIM: error_number = fim(symbol, preprocessed, length); break;
case BARCODE_POSTNET: error_number = post_plot(symbol, preprocessed, length); break;
case BARCODE_PLANET: error_number = planet_plot(symbol, preprocessed, length); break;
case BARCODE_RM4SCC: error_number = royal_plot(symbol, preprocessed, length); break;
case BARCODE_AUSPOST: error_number = australia_post(symbol, preprocessed, length); break;
case BARCODE_AUSREPLY: error_number = australia_post(symbol, preprocessed, length); break;
case BARCODE_AUSROUTE: error_number = australia_post(symbol, preprocessed, length); break;
case BARCODE_AUSREDIRECT: error_number = australia_post(symbol, preprocessed, length); break;
case BARCODE_CODE16K: error_number = code16k(symbol, preprocessed, length); break;
case BARCODE_PHARMA_TWO: error_number = pharma_two(symbol, preprocessed, length); break;
case BARCODE_ONECODE: error_number = imail(symbol, preprocessed, length); break;
case BARCODE_ISBNX: error_number = eanx(symbol, preprocessed, length); break;
case BARCODE_RSS14: error_number = rss14(symbol, preprocessed, length); break;
case BARCODE_RSS14STACK: error_number = rss14(symbol, preprocessed, length); break;
case BARCODE_RSS14STACK_OMNI: error_number = rss14(symbol, preprocessed, length); break;
case BARCODE_RSS_LTD: error_number = rsslimited(symbol, preprocessed, length); break;
case BARCODE_RSS_EXP: error_number = rssexpanded(symbol, preprocessed, length); break;
case BARCODE_RSS_EXPSTACK: error_number = rssexpanded(symbol, preprocessed, length); break;
case BARCODE_EANX_CC: error_number = composite(symbol, preprocessed, length); break;
case BARCODE_EAN128_CC: error_number = composite(symbol, preprocessed, length); break;
case BARCODE_RSS14_CC: error_number = composite(symbol, preprocessed, length); break;
case BARCODE_RSS_LTD_CC: error_number = composite(symbol, preprocessed, length); break;
case BARCODE_RSS_EXP_CC: error_number = composite(symbol, preprocessed, length); break;
case BARCODE_UPCA_CC: error_number = composite(symbol, preprocessed, length); break;
case BARCODE_UPCE_CC: error_number = composite(symbol, preprocessed, length); break;
case BARCODE_RSS14STACK_CC: error_number = composite(symbol, preprocessed, length); break;
case BARCODE_RSS14_OMNI_CC: error_number = composite(symbol, preprocessed, length); break;
case BARCODE_RSS_EXPSTACK_CC: error_number = composite(symbol, preprocessed, length); break;
case BARCODE_KIX: error_number = kix_code(symbol, preprocessed, length); break;
case BARCODE_CODE32: error_number = code32(symbol, preprocessed, length); break;
case BARCODE_DAFT: error_number = daft_code(symbol, preprocessed, length); break;
case BARCODE_EAN14: error_number = ean_14(symbol, preprocessed, length); break;
case BARCODE_AZRUNE: error_number = aztec_runes(symbol, preprocessed, length); break;
case BARCODE_KOREAPOST: error_number = korea_post(symbol, preprocessed, length); break;
case BARCODE_HIBC_128: error_number = hibc(symbol, preprocessed, length); break;
case BARCODE_HIBC_39: error_number = hibc(symbol, preprocessed, length); break;
case BARCODE_HIBC_DM: error_number = hibc(symbol, preprocessed, length); break;
case BARCODE_HIBC_QR: error_number = hibc(symbol, preprocessed, length); break;
case BARCODE_HIBC_PDF: error_number = hibc(symbol, preprocessed, length); break;
case BARCODE_HIBC_MICPDF: error_number = hibc(symbol, preprocessed, length); break;
case BARCODE_HIBC_AZTEC: error_number = hibc(symbol, preprocessed, length); break;
case BARCODE_JAPANPOST: error_number = japan_post(symbol, preprocessed, length); break;
case BARCODE_CODE49: error_number = code_49(symbol, preprocessed, length); break;
case BARCODE_CHANNEL: error_number = channel_code(symbol, preprocessed, length); break;
case BARCODE_CODEONE: error_number = code_one(symbol, preprocessed, length); break;
case BARCODE_DATAMATRIX: error_number = dmatrix(symbol, preprocessed, length); break;
case BARCODE_PDF417: error_number = pdf417enc(symbol, preprocessed, length); break;
case BARCODE_PDF417TRUNC: error_number = pdf417enc(symbol, preprocessed, length); break;
case BARCODE_MICROPDF417: error_number = micro_pdf417(symbol, preprocessed, length); break;
case BARCODE_MAXICODE: error_number = maxicode(symbol, preprocessed, length); break;
case BARCODE_AZTEC: error_number = aztec(symbol, preprocessed, length); break;
}
return error_number;
}
int qmap (double *x0, double *x1, double *y0, double *y1, double * quat){
double q1[4], q2[4];
double v[3], v2[3], cosine = 0, theta =0, sine;
double x_prime[3];
int i,j;
int normalized_cross (double *x, double *y, double * v, double *norm_ptr);
int unnorm_dot (double *x, double *y, double * dot);
/* 1) find any quat for x0 --> y0 */
/* check that it is not the same vector already: */
unnorm_dot (x0, y0, &cosine);
if ( 1-cosine > 0.001 ) {
double ** R;
if ( normalized_cross (x0, y0, v, NULL) )return 1;
theta = acos (cosine);
q1[0] = cos (theta/2);
sine = sin(theta/2);
for (i=0; i<3; i++ ) {
q1[i+1] = sine*v[i];
}
if ( ! (R=dmatrix(3,3) ) ) return 1; /* compiler is bugging me otherwise */
quat_to_R (q1, R);
for (i=0; i<3; i++ ) {
x_prime[i] = 0;
for (j=0; j<3; j++ ) {
x_prime[i] += R[i][j]*x1[j];
}
}
free_dmatrix (R);
} else {
memcpy (x_prime, x1, 3*sizeof(double) );
memset (q1, 0, 4*sizeof(double) );
q1[0] = 1.0;
}
/* 2) find quat thru y0 which maps
x' to the plane <y0,y1> */
unnorm_dot (x_prime, y1, &cosine);
/* determining theta: angle btw planes = angle btw the normals */
if ( 1-cosine > 0.001 ) {
if ( normalized_cross (x_prime, y0,v, NULL)) return 1;
if ( normalized_cross (y1, y0, v2, NULL)) return 1;
unnorm_dot (v, v2, &cosine);
theta = acos (cosine);
/*still need to determine the sign
of rotation */
if (normalized_cross (x_prime, y1,v, NULL)) return 1;
unnorm_dot (v, y0, &cosine);
if ( cosine > 0.0 ) {
sine = sin(theta/2);
} else {
sine = -sin(theta/2);
}
for (i=0; i<3; i++ ) {
v[i] = y0[i];
}
q2[0] = cos (theta/2);
for (i=0; i<3; i++ ) {
q2[i+1] = sine*v[i];
}
} else {
memset (q2, 0, 4*sizeof(double) );
q2[0] = 1.0;
}
/* multiply the two quats */
multiply (q2, q1, 0, quat);
return 0;
}
/* ---------- ------ */
/* Subroutine */ int
/* The last two arguments of this function affect how the null vectors of the Jacobian are computed.
If "useDefaultRHS" is 1 then the normals right hand side is used (i.e. 1.0 is each of the appropriate positions).
If "useDefaultRHS" is 0 then the right hand side in RHSVector is used.
The idea is that we add additional pseudo-arclength constraints for the manifold calculations,
and this allows us to compute a basis of the tangent space.
*/
solvbv(integer ifst, iap_type *iap, rap_type *rap, doublereal *par, integer *icp, FUNI_TYPE((*funi)), BCNI_TYPE((*bcni)), ICNI_TYPE((*icni)), doublereal *rds, integer nllv, doublereal *rlcur, doublereal *rlold, doublereal *rldot, integer ndxloc, doublereal **ups, doublereal **dups, doublereal **uoldps, doublereal **udotps, doublereal **upoldp, doublereal *dtm, doublereal **fa, doublereal *fc, doublereal **p0, doublereal **p1, doublereal *thl, doublereal *thu
#ifdef MANIFOLD
,integer useDefaultRHS,doublereal *RHSVector
#endif
)
{
integer ndim;
logical ipar;
integer ncol, nclm, nfpr, nint, nrow, ntst, ntst0;
integer nalc;
integer nbc, iid, iam;
doublereal det;
integer ips, nrc;
integer kwt;
static main_auto_storage_type main_auto_storage={NULL,NULL,NULL,NULL,
NULL,NULL,NULL,NULL,
NULL,NULL,NULL,NULL,
NULL,NULL,NULL,NULL,
NULL,NULL,NULL};
/* N AX is the local N TSTX, which is smaller than the global N TSTX. */
/* NODES is the total number of nodes. */
/* Sets up and solves the linear equations for one Newton/Chord iteration
*/
/* Most of the required memory is allocated below */
/* This is an interesting section of code. The main point
is that setubv and conpar only get called when ifst
is 1. This is a optimization since you can solve
the system using the previously factored jacobian.
One thing to watch out for is that two seperate calls
of solvbv_ talk to each other through these arrays,
so it is only safe to get rid of them when ifst is
1 (since their entries will then be recreated in conpar
and setubv).
*/
if (ifst==1){
/* The formulas used for the allocation are somewhat complex, but they
are based on following macros (the space after the first letter is
for the scripts which detect these things automatically, the original
name does not have the space:
M 1AAR = (((iap->ndim * iap->ncol ) + iap->ndim ) )
M 2AA = ((iap->ndim * iap->ncol ) )
N AX = (iap->ntst /NODES+1)
M 1BB = (iap->nfpr)
M 2BB = ((iap->ndim * iap->ncol ) )
M 1CC = ((((iap->ndim * iap->ncol ) + iap->ndim ) ) )
M 2CC = (((iap->ndim +3) +NINTX+1) )
M 1DD = (((iap->ndim +3) +NINTX+1) )
M 2DD = (iap->nfpr)
N RCX = ((iap->ndim +3) +NINTX+1)
N CLMX = ((iap->ndim * iap->ncol ) + iap->ndim )
N ROWX = (iap->ndim * iap->ncol )
*/
/* Free floating point arrays */
free_dmatrix_3d(main_auto_storage.a);
free_dmatrix_3d(main_auto_storage.b);
free_dmatrix_3d(main_auto_storage.c);
free_dmatrix(main_auto_storage.d);
free_dmatrix_3d(main_auto_storage.a1);
free_dmatrix_3d(main_auto_storage.a2);
free_dmatrix_3d(main_auto_storage.s1);
free_dmatrix_3d(main_auto_storage.s2);
free_dmatrix_3d(main_auto_storage.bb);
free_dmatrix_3d(main_auto_storage.cc);
free_dmatrix_3d(main_auto_storage.ccbc);
free_dmatrix(main_auto_storage.faa);
free_dmatrix_3d(main_auto_storage.ca1);
/* Free integer arrays */
free(main_auto_storage.icf);
free(main_auto_storage.irf);
free(main_auto_storage.ipr);
free(main_auto_storage.icf11);
free(main_auto_storage.icf1);
free(main_auto_storage.icf2);
free(main_auto_storage.np);
/*(M 1AAR*M 2AA*N AX) */
main_auto_storage.a=dmatrix_3d(iap->ntst + 1,
iap->ncol * iap->ndim,
(iap->ncol + 1) * iap->ndim);
/*(M 1BB*M 2BB*N AX)*/
main_auto_storage.b=dmatrix_3d(iap->ntst + 1, iap->ndim * iap->ncol, iap->nfpr);
/*(M 1CC*M 2CC*N AX)*/
#ifdef MANIFOLD
main_auto_storage.c=dmatrix_3d(iap->ntst + 1, iap->nint + iap->nalc,
#else
main_auto_storage.c=dmatrix_3d(iap->ntst + 1, iap->nint + 1,
#endif
(iap->ncol + 1) * iap->ndim);
/*(M 1DD*M 2DD)*/
#ifdef MANIFOLD
main_auto_storage.d=dmatrix(iap->nbc + iap->nint + iap->nalc, iap->nfpr);
#else
main_auto_storage.d=dmatrix(iap->nbc + iap->nint + 1, iap->nfpr);
#endif
/*(iap->ndim * iap->ndim *N AX)*/
main_auto_storage.a1=dmatrix_3d(iap->ntst + 1, iap->ndim, iap->ndim);
/*(iap->ndim * iap->ndim *N AX)*/
main_auto_storage.a2=dmatrix_3d(iap->ntst + 1, iap->ndim, iap->ndim);
/*(iap->ndim * iap->ndim *N AX)*/
main_auto_storage.s1=dmatrix_3d(iap->ntst + 1, iap->ndim, iap->ndim);
/*(iap->ndim * iap->ndim *N AX)*/
main_auto_storage.s2=dmatrix_3d(iap->ntst + 1, iap->ndim, iap->ndim);
/*(iap->ndim *N PARX*N AX)*/
main_auto_storage.bb=dmatrix_3d(iap->ntst + 1, iap->ndim, iap->nfpr);
/*(N RCX* iap->ndim *N AX+1)*/
#ifdef MANIFOLD
main_auto_storage.cc=dmatrix_3d(iap->ntst + 1, iap->nint + iap->nalc, iap->ndim);
#else
main_auto_storage.cc=dmatrix_3d(iap->ntst + 1, iap->nint + 1, iap->ndim);
#endif
main_auto_storage.ccbc=dmatrix_3d(2, iap->nbc, iap->ndim);
/*(iap->ndim *N AX)*/
main_auto_storage.faa=dmatrix(iap->ntst + 1, iap->ndim);
/*(iap->ndim * iap->ndim *K REDO)*/
main_auto_storage.ca1=dmatrix_3d(KREDO, iap->ndim, iap->ndim);
/*(N CLMX*N AX)*/
main_auto_storage.icf=(integer *)malloc(sizeof(integer)*(((iap->ndim * iap->ncol ) + iap->ndim ) * (iap->ntst +1) ) );
/*(N ROWX*N AX)*/
main_auto_storage.irf=(integer *)malloc(sizeof(integer)*((iap->ndim * iap->ncol ) * (iap->ntst +1) ) );
/*(iap->ndim *N AX)*/
main_auto_storage.ipr=(integer *)malloc(sizeof(integer)*(iap->ndim * (iap->ntst +1) ) );
/*(iap->ndim *K REDO)*/
main_auto_storage.icf11=(integer *)malloc(sizeof(integer)*(iap->ndim *KREDO) );
/*(iap->ndim *N AX)*/
main_auto_storage.icf1=(integer *)malloc(sizeof(integer)*(iap->ndim * (iap->ntst +1) ));
/*(iap->ndim *N AX)*/
main_auto_storage.icf2=(integer *)malloc(sizeof(integer)*(iap->ndim * (iap->ntst +1) ));
/*(2)*/
main_auto_storage.np=(integer *)malloc(sizeof(integer)*(2) );
}
int
conpar_mpi_wrapper(integer nov, integer na, integer nra,
integer nca, doublereal ***a, integer ncb,
doublereal ***b, integer nrc,
doublereal ***c, doublereal **d, integer *irf, integer *icf)
{
integer loop_start,loop_end;
integer loop_end_tmp;
int i,j,comm_size;
int *a_counts,*a_displacements;
int *b_counts,*b_displacements;
int *c_counts,*c_displacements;
int *irf_counts,*irf_displacements;
int *icf_counts,*icf_displacements;
MPI_Comm_size(MPI_COMM_WORLD,&comm_size);
a_counts=(int *)malloc(sizeof(int)*comm_size);
a_displacements=(int *)malloc(sizeof(int)*comm_size);
b_counts=(int *)malloc(sizeof(int)*comm_size);
b_displacements=(int *)malloc(sizeof(int)*comm_size);
c_counts=(int *)malloc(sizeof(int)*comm_size);
c_displacements=(int *)malloc(sizeof(int)*comm_size);
irf_counts=(int *)malloc(sizeof(int)*comm_size);
irf_displacements=(int *)malloc(sizeof(int)*comm_size);
icf_counts=(int *)malloc(sizeof(int)*comm_size);
icf_displacements=(int *)malloc(sizeof(int)*comm_size);
a_counts[0] = 0;
a_displacements[0] = 0;
b_counts[0] = 0;
b_displacements[0] = 0;
c_counts[0] = 0;
c_displacements[0] = 0;
irf_counts[0] = 0;
irf_displacements[0] = 0;
icf_counts[0] = 0;
icf_displacements[0] = 0;
for(i=1;i<comm_size;i++){
/*Send message to get worker into conpar mode*/
{
int message=AUTO_MPI_CONPAR_MESSAGE;
MPI_Send(&message,1,MPI_INT,i,0,MPI_COMM_WORLD);
}
loop_start = ((i-1)*na)/(comm_size - 1);
loop_end = ((i)*na)/(comm_size - 1);
a_counts[i] = nca*nra*(loop_end-loop_start);
a_displacements[i] = nca*nra*loop_start;
b_counts[i] = ncb*nra*(loop_end-loop_start);
b_displacements[i] = ncb*nra*loop_start;
c_counts[i] = nca*nrc*(loop_end-loop_start);
c_displacements[i] = nca*nrc*loop_start;
irf_counts[i] = nra*(loop_end-loop_start);
irf_displacements[i] = nra*loop_start;
icf_counts[i] = nca*(loop_end-loop_start);
icf_displacements[i] = nca*loop_start;
loop_end_tmp = loop_end-loop_start;
MPI_Send(&loop_end_tmp ,1,MPI_LONG,i,0,MPI_COMM_WORLD);
}
{
integer params[5];
params[0]=nov;
params[1]=nra;
params[2]=nca;
params[3]=ncb;
params[4]=nrc;
MPI_Bcast(params ,5,MPI_LONG,0,MPI_COMM_WORLD);
}
/* Worker is running now */
{
/*I create a temporary send buffer for the MPI_Reduce
command. This is because there isn't an
asymmetric version (like MPI_Scatterv).*/
double **dtemp;
dtemp = dmatrix(nrc,ncb);
for(i=0;i<nrc;i++)
for(j=0;j<ncb;j++)
dtemp[i][j]=d[i][j];
MPI_Reduce(dtemp[0],d[0],ncb*nrc,MPI_DOUBLE,MPI_SUM,0,MPI_COMM_WORLD);
free_dmatrix(dtemp);
}
MPI_Gatherv(NULL,0,MPI_DOUBLE,
a[0][0],a_counts,a_displacements,MPI_DOUBLE,
0,MPI_COMM_WORLD);
MPI_Gatherv(NULL,0,MPI_DOUBLE,
b[0][0],b_counts,b_displacements,MPI_DOUBLE,
0,MPI_COMM_WORLD);
MPI_Gatherv(NULL,0,MPI_DOUBLE,
c[0][0],c_counts,c_displacements,MPI_DOUBLE,
0,MPI_COMM_WORLD);
MPI_Gatherv(NULL,0,MPI_LONG,
irf,irf_counts,irf_displacements,MPI_LONG,
0,MPI_COMM_WORLD);
MPI_Gatherv(NULL,0,MPI_LONG,
icf,icf_counts,icf_displacements,MPI_LONG,
0,MPI_COMM_WORLD);
return 0;
}
SEXP coxfit6(SEXP maxiter2, SEXP time2, SEXP status2,
SEXP covar2, SEXP offset2, SEXP weights2,
SEXP strata2, SEXP method2, SEXP eps2,
SEXP toler2, SEXP ibeta, SEXP doscale2) {
int i,j,k, person;
double **covar, **cmat, **imat; /*ragged arrays */
double **imatCopy; /* Naras add */
double wtave;
double *a, *newbeta;
double *a2, **cmat2;
double *scale;
double denom=0, zbeta, risk;
double temp, temp2;
int ndead; /* number of death obs at a time point */
double tdeath=0; /* ndead= total at a given time point, tdeath= all */
double newlk=0;
double dtime, d2;
double deadwt; /*sum of case weights for the deaths*/
double efronwt; /* sum of weighted risk scores for the deaths*/
int halving; /*are we doing step halving at the moment? */
int nrisk; /* number of subjects in the current risk set */
double *maxbeta;
/* copies of scalar input arguments */
int nused, nvar, maxiter;
int method;
double eps, toler;
int doscale;
/* vector inputs */
double *time, *weights, *offset;
int *status, *strata;
/* returned objects */
SEXP imat2, means2, beta2, u2, loglik2;
SEXP imatCopy2; /* Naras add */
double *beta, *u, *loglik, *means;
SEXP sctest2, flag2, iter2;
double *sctest;
int *flag, *iter;
SEXP rlist, rlistnames;
int nprotect; /* number of protect calls I have issued */
/* get local copies of some input args */
nused = LENGTH(offset2);
nvar = ncols(covar2);
method = asInteger(method2);
maxiter = asInteger(maxiter2);
eps = asReal(eps2); /* convergence criteria */
toler = asReal(toler2); /* tolerance for cholesky */
doscale = asInteger(doscale2);
time = REAL(time2);
weights = REAL(weights2);
offset= REAL(offset2);
status = INTEGER(status2);
strata = INTEGER(strata2);
/*
** Set up the ragged arrays and scratch space
** Normally covar2 does not need to be duplicated, even though
** we are going to modify it, due to the way this routine was
** was called. In this case NAMED(covar2) will =0
*/
nprotect =0;
if (NAMED(covar2)>0) {
PROTECT(covar2 = duplicate(covar2));
nprotect++;
}
covar= dmatrix(REAL(covar2), nused, nvar);
PROTECT(imat2 = allocVector(REALSXP, nvar*nvar));
nprotect++;
imat = dmatrix(REAL(imat2), nvar, nvar);
/* Naras add */
PROTECT(imatCopy2 = allocVector(REALSXP, nvar*nvar));
nprotect++;
imatCopy = dmatrix(REAL(imatCopy2), nvar, nvar);
/* Naras add end */
a = (double *) R_alloc(2*nvar*nvar + 5*nvar, sizeof(double));
newbeta = a + nvar;
a2 = newbeta + nvar;
maxbeta = a2 + nvar;
scale = maxbeta + nvar;
cmat = dmatrix(scale + nvar, nvar, nvar);
cmat2= dmatrix(scale + nvar +nvar*nvar, nvar, nvar);
/*
** create output variables
*/
PROTECT(beta2 = duplicate(ibeta));
beta = REAL(beta2);
PROTECT(means2 = allocVector(REALSXP, nvar));
means = REAL(means2);
PROTECT(u2 = allocVector(REALSXP, nvar));
u = REAL(u2);
PROTECT(loglik2 = allocVector(REALSXP, 2));
loglik = REAL(loglik2);
PROTECT(sctest2 = allocVector(REALSXP, 1));
sctest = REAL(sctest2);
PROTECT(flag2 = allocVector(INTSXP, 1));
flag = INTEGER(flag2);
PROTECT(iter2 = allocVector(INTSXP, 1));
iter = INTEGER(iter2);
nprotect += 7;
/*
** Subtract the mean from each covar, as this makes the regression
** much more stable.
*/
tdeath=0; temp2=0;
for (i=0; i<nused; i++) {
temp2 += weights[i];
tdeath += weights[i] * status[i];
}
for (i=0; i<nvar; i++) {
temp=0;
for (person=0; person<nused; person++)
temp += weights[person] * covar[i][person];
temp /= temp2;
means[i] = temp;
for (person=0; person<nused; person++) covar[i][person] -=temp;
if (doscale==1) { /* and also scale it */
temp =0;
for (person=0; person<nused; person++) {
temp += weights[person] * fabs(covar[i][person]);
}
if (temp > 0) temp = temp2/temp; /* scaling */
else temp=1.0; /* rare case of a constant covariate */
scale[i] = temp;
for (person=0; person<nused; person++) covar[i][person] *= temp;
}
}
if (doscale==1) {
for (i=0; i<nvar; i++) beta[i] /= scale[i]; /*rescale initial betas */
}
else {
for (i=0; i<nvar; i++) scale[i] = 1.0;
}
/*
** do the initial iteration step
*/
strata[nused-1] =1;
loglik[1] =0;
for (i=0; i<nvar; i++) {
u[i] =0;
a2[i] =0;
for (j=0; j<nvar; j++) {
imat[i][j] =0 ;
cmat2[i][j] =0;
}
}
for (person=nused-1; person>=0; ) {
if (strata[person] == 1) {
nrisk =0 ;
denom = 0;
for (i=0; i<nvar; i++) {
a[i] = 0;
for (j=0; j<nvar; j++) cmat[i][j] = 0;
}
}
dtime = time[person];
ndead =0; /*number of deaths at this time point */
deadwt =0; /* sum of weights for the deaths */
efronwt=0; /* sum of weighted risks for the deaths */
while(person >=0 &&time[person]==dtime) {
/* walk through the this set of tied times */
nrisk++;
zbeta = offset[person]; /* form the term beta*z (vector mult) */
for (i=0; i<nvar; i++)
zbeta += beta[i]*covar[i][person];
risk = exp(zbeta) * weights[person];
denom += risk;
/* a is the vector of weighted sums of x, cmat sums of squares */
for (i=0; i<nvar; i++) {
a[i] += risk*covar[i][person];
for (j=0; j<=i; j++)
cmat[i][j] += risk*covar[i][person]*covar[j][person];
}
if (status[person]==1) {
ndead++;
deadwt += weights[person];
efronwt += risk;
loglik[1] += weights[person]*zbeta;
for (i=0; i<nvar; i++)
u[i] += weights[person]*covar[i][person];
if (method==1) { /* Efron */
for (i=0; i<nvar; i++) {
a2[i] += risk*covar[i][person];
for (j=0; j<=i; j++)
cmat2[i][j] += risk*covar[i][person]*covar[j][person];
}
}
}
person--;
if (strata[person]==1) break; /*ties don't cross strata */
}
if (ndead >0) { /* we need to add to the main terms */
if (method==0) { /* Breslow */
loglik[1] -= deadwt* log(denom);
for (i=0; i<nvar; i++) {
temp2= a[i]/ denom; /* mean */
u[i] -= deadwt* temp2;
for (j=0; j<=i; j++)
imat[j][i] += deadwt*(cmat[i][j] - temp2*a[j])/denom;
}
}
else { /* Efron */
/*
** If there are 3 deaths we have 3 terms: in the first the
** three deaths are all in, in the second they are 2/3
** in the sums, and in the last 1/3 in the sum. Let k go
** from 0 to (ndead -1), then we will sequentially use
** denom - (k/ndead)*efronwt as the denominator
** a - (k/ndead)*a2 as the "a" term
** cmat - (k/ndead)*cmat2 as the "cmat" term
** and reprise the equations just above.
*/
for (k=0; k<ndead; k++) {
temp = (double)k/ ndead;
wtave = deadwt/ndead;
d2 = denom - temp*efronwt;
loglik[1] -= wtave* log(d2);
for (i=0; i<nvar; i++) {
temp2 = (a[i] - temp*a2[i])/ d2;
u[i] -= wtave *temp2;
for (j=0; j<=i; j++)
imat[j][i] += (wtave/d2) *
((cmat[i][j] - temp*cmat2[i][j]) -
temp2*(a[j]-temp*a2[j]));
}
}
for (i=0; i<nvar; i++) {
a2[i]=0;
for (j=0; j<nvar; j++) cmat2[i][j]=0;
}
}
}
} /* end of accumulation loop */
loglik[0] = loglik[1]; /* save the loglik for iter 0 */
/*
** Use the initial variance matrix to set a maximum coefficient
** (The matrix contains the variance of X * weighted number of deaths)
*/
for (i=0; i<nvar; i++)
maxbeta[i] = 20* sqrt(imat[i][i]/tdeath);
/* am I done?
** update the betas and test for convergence
*/
for (i=0; i<nvar; i++) /*use 'a' as a temp to save u0, for the score test*/
a[i] = u[i];
*flag= cholesky2(imat, nvar, toler);
chsolve2(imat,nvar,a); /* a replaced by a *inverse(i) */
temp=0;
for (i=0; i<nvar; i++)
temp += u[i]*a[i];
*sctest = temp; /* score test */
/*
** Never, never complain about convergence on the first step. That way,
** if someone HAS to they can force one iter at a time.
*/
for (i=0; i<nvar; i++) {
newbeta[i] = beta[i] + a[i];
}
if (maxiter==0) {
/* Naras add */
for (i = 0; i < nvar; i++) {
for (j = 0; j < nvar; j++) {
imatCopy[i][j] = imat[i][j];
}
}
/* Naras add end */
chinv2(imat,nvar);
for (i=0; i<nvar; i++) {
beta[i] *= scale[i]; /*return to original scale */
u[i] /= scale[i];
imat[i][i] *= scale[i]*scale[i];
imatCopy[i][i] /= (scale[i]*scale[i]);
for (j=0; j<i; j++) {
imat[j][i] *= scale[i]*scale[j];
imat[i][j] = imat[j][i];
imatCopy[j][i] /= (scale[i]*scale[j]);
imatCopy[i][j] = imatCopy[j][i];
}
}
goto finish;
}
/*
** here is the main loop
*/
halving =0 ; /* =1 when in the midst of "step halving" */
for (*iter=1; *iter<= maxiter; (*iter)++) {
newlk =0;
for (i=0; i<nvar; i++) {
u[i] =0;
for (j=0; j<nvar; j++)
imat[i][j] =0;
}
/*
** The data is sorted from smallest time to largest
** Start at the largest time, accumulating the risk set 1 by 1
*/
for (person=nused-1; person>=0; ) {
if (strata[person] == 1) { /* rezero temps for each strata */
denom = 0;
nrisk =0;
for (i=0; i<nvar; i++) {
a[i] = 0;
for (j=0; j<nvar; j++) cmat[i][j] = 0;
}
}
dtime = time[person];
deadwt =0;
ndead =0;
efronwt =0;
while(person>=0 && time[person]==dtime) {
nrisk++;
zbeta = offset[person];
for (i=0; i<nvar; i++)
zbeta += newbeta[i]*covar[i][person];
risk = exp(zbeta) * weights[person];
denom += risk;
for (i=0; i<nvar; i++) {
a[i] += risk*covar[i][person];
for (j=0; j<=i; j++)
cmat[i][j] += risk*covar[i][person]*covar[j][person];
}
if (status[person]==1) {
ndead++;
deadwt += weights[person];
newlk += weights[person] *zbeta;
for (i=0; i<nvar; i++)
u[i] += weights[person] *covar[i][person];
if (method==1) { /* Efron */
efronwt += risk;
for (i=0; i<nvar; i++) {
a2[i] += risk*covar[i][person];
for (j=0; j<=i; j++)
cmat2[i][j] += risk*covar[i][person]*covar[j][person];
}
}
}
person--;
if (strata[person]==1) break; /*tied times don't cross strata*/
}
if (ndead >0) { /* add up terms*/
if (method==0) { /* Breslow */
newlk -= deadwt* log(denom);
for (i=0; i<nvar; i++) {
temp2= a[i]/ denom; /* mean */
u[i] -= deadwt* temp2;
for (j=0; j<=i; j++)
imat[j][i] += (deadwt/denom)*
(cmat[i][j] - temp2*a[j]);
}
}
else { /* Efron */
for (k=0; k<ndead; k++) {
temp = (double)k / ndead;
wtave= deadwt/ ndead;
d2= denom - temp* efronwt;
newlk -= wtave* log(d2);
for (i=0; i<nvar; i++) {
temp2 = (a[i] - temp*a2[i])/ d2;
u[i] -= wtave*temp2;
for (j=0; j<=i; j++)
imat[j][i] += (wtave/d2)*
((cmat[i][j] - temp*cmat2[i][j]) -
temp2*(a[j]-temp*a2[j]));
}
}
for (i=0; i<nvar; i++) { /*in anticipation */
a2[i] =0;
for (j=0; j<nvar; j++) cmat2[i][j] =0;
}
}
}
} /* end of accumulation loop */
/* am I done?
** update the betas and test for convergence
*/
*flag = cholesky2(imat, nvar, toler);
if (fabs(1-(loglik[1]/newlk))<= eps && halving==0) { /* all done */
loglik[1] = newlk;
chinv2(imat, nvar); /* invert the information matrix */
for (i=0; i<nvar; i++) {
beta[i] = newbeta[i]*scale[i];
u[i] /= scale[i];
imat[i][i] *= scale[i]*scale[i];
for (j=0; j<i; j++) {
imat[j][i] *= scale[i]*scale[j];
imat[i][j] = imat[j][i];
}
}
goto finish;
}
if (*iter== maxiter) break; /*skip the step halving calc*/
if (newlk < loglik[1]) { /*it is not converging ! */
halving =1;
for (i=0; i<nvar; i++)
newbeta[i] = (newbeta[i] + beta[i]) /2; /*half of old increment */
}
else {
halving=0;
loglik[1] = newlk;
chsolve2(imat,nvar,u);
j=0;
for (i=0; i<nvar; i++) {
beta[i] = newbeta[i];
newbeta[i] = newbeta[i] + u[i];
if (newbeta[i] > maxbeta[i]) newbeta[i] = maxbeta[i];
else if (newbeta[i] < -maxbeta[i]) newbeta[i] = -maxbeta[i];
}
}
} /* return for another iteration */
/*
** We end up here only if we ran out of iterations
*/
loglik[1] = newlk;
/* Naras add */
for (i = 0; i < nvar; i++) {
for (j = 0; j < nvar; j++) {
imatCopy[i][j] = imat[i][j];
}
}
/* Naras add end */
chinv2(imat, nvar);
for (i=0; i<nvar; i++) {
beta[i] = newbeta[i]*scale[i];
u[i] /= scale[i];
imat[i][i] *= scale[i]*scale[i];
imatCopy[i][i] /= (scale[i]*scale[i]);
for (j=0; j<i; j++) {
imat[j][i] *= scale[i]*scale[j];
imat[i][j] = imat[j][i];
imatCopy[j][i] /= (scale[i]*scale[j]);
imatCopy[i][j] = imatCopy[j][i];
}
}
*flag = 1000;
finish:
/*
** create the output list
*/
PROTECT(rlist= allocVector(VECSXP, 9));
SET_VECTOR_ELT(rlist, 0, beta2);
SET_VECTOR_ELT(rlist, 1, means2);
SET_VECTOR_ELT(rlist, 2, u2);
SET_VECTOR_ELT(rlist, 3, imat2);
SET_VECTOR_ELT(rlist, 4, loglik2);
SET_VECTOR_ELT(rlist, 5, sctest2);
SET_VECTOR_ELT(rlist, 6, iter2);
SET_VECTOR_ELT(rlist, 7, flag2);
SET_VECTOR_ELT(rlist, 8, imatCopy2);
/* add names to the objects */
PROTECT(rlistnames = allocVector(STRSXP, 9));
SET_STRING_ELT(rlistnames, 0, mkChar("coef"));
SET_STRING_ELT(rlistnames, 1, mkChar("means"));
SET_STRING_ELT(rlistnames, 2, mkChar("u"));
SET_STRING_ELT(rlistnames, 3, mkChar("imat"));
SET_STRING_ELT(rlistnames, 4, mkChar("loglik"));
SET_STRING_ELT(rlistnames, 5, mkChar("sctest"));
SET_STRING_ELT(rlistnames, 6, mkChar("iter"));
SET_STRING_ELT(rlistnames, 7, mkChar("flag"));
SET_STRING_ELT(rlistnames, 8, mkChar("imatCopy"));
setAttrib(rlist, R_NamesSymbol, rlistnames);
unprotect(nprotect+2);
return(rlist);
}
double *abg_to_aei(char *abg_file)
{
PBASIS p;
XVBASIS xv;
ORBIT orbit;
static double result[15];
double d, dd;
double **covar_abg, **covar_xyz, **derivs, **covar_aei;
int i,j;
covar_abg = dmatrix(1,6,1,6);
covar_xyz = dmatrix(1,6,1,6);
covar_aei = dmatrix(1,6,1,6);
derivs = dmatrix(1,6,1,6);
if (read_abg(abg_file,&p,covar_abg)) {
fprintf(stderr, "Error in input alpha/beta/gamma file\n");
exit(1);
}
/* Transform the orbit basis and get the deriv. matrix */
pbasis_to_bary(&p, &xv, derivs);
/* Map the covariance matrix to new basis */
covar_map(covar_abg, derivs, covar_xyz,6,6);
/* Get partial derivative matrix from xyz to aei */
aei_derivs(&xv, derivs);
/* Map the covariance matrix to new basis */
covar_map(covar_xyz, derivs, covar_aei,6,6);
/* Transform xyz basis to orbital parameters */
orbitElements(&xv, &orbit);
d = sqrt(xBary*xBary + yBary*yBary + pow(zBary-1/p.g,2.));
dd = d*d*sqrt(covar_abg[5][5]);
/* Print out the results, with comments */
/*
printf(aei_file,"# Barycentric osculating elements in ICRS at epoch %.1f:\n",jd0);
printf("# a e i Node Arg of Peri Time of Peri\n");
printf("%12.6f %9.6f %8.3f %8.3f %8.3f %11.3f\n",
orbit.a, orbit.e, orbit.i, orbit.lan, orbit.aop, orbit.T);
fprintf("+-%10.6f %9.6f %8.3f %8.3f %8.3f %11.3f\n",
sqrt(covar_aei[1][1]),
sqrt(covar_aei[2][2]),
sqrt(covar_aei[3][3])/DTOR,
sqrt(covar_aei[4][4])/DTOR,
sqrt(covar_aei[5][5])/DTOR,
sqrt(covar_aei[6][6])/DAY);
fprintf("# covariance matrix:\n");
fprint_matrix(stdout,covar_aei,6,6);
*/
result[0] = orbit.a;
result[1] = orbit.e;
result[2] = orbit.i;
result[3] = orbit.lan;
result[4] = orbit.aop;
result[5] = orbit.T;
result[6] = sqrt(covar_aei[1][1]);
result[7] = sqrt(covar_aei[2][2]);
result[8] = sqrt(covar_aei[3][3])/DTOR;
result[9] = sqrt(covar_aei[4][4])/DTOR;
result[10] = sqrt(covar_aei[5][5])/DTOR;
result[11] = sqrt(covar_aei[6][6])/DAY;
result[12] = jd0;
result[13] = d;
result[14] = dd;
free_dmatrix(covar_abg,1,6,1,6);
free_dmatrix(covar_xyz,1,6,1,6);
free_dmatrix(covar_aei,1,6,1,6);
free_dmatrix(derivs,1,6,1,6);
return result;
}
/* Subroutine which executes the mrqmin optimization */
void
mrqfit(OBSERVATION *obsarray,
int nobs,
PBASIS *p,
int *ia,
double **covar,
double *chisq,
double energy_wt)
{
double *a, alambda,oldchi,**alpha;
int ma=6,niter;
a = dvector(1,6);
alpha = dmatrix(1,6,1,6);
a[1]=p->a;
a[2]=p->adot;
a[3]=p->b;
a[4]=p->bdot;
a[5]=p->g;
a[6]=p->gdot;
alambda=-1.;
*chisq = 1.e14;
niter = 0;
do {
/*do an iteration of the nr marquandt search*/
oldchi = *chisq;
niter++;
mrqmin_orbit(obsarray, nobs, a, ia,
ma, covar, alpha, chisq, &alambda, energy_wt);
#ifdef DEBUG
fprintf(stderr,
"# Iteration %d: chisq %f, alamda now %f\n",
niter,*chisq,alambda);
fprintf(stderr,"# Params %g %g %g %g %g %g\n",
a[1],a[2],a[3],a[4],a[5],a[6]);
#endif
if (alambda>1e8) {
/*
fprintf(stderr,
"MRQMIN being stopped after %d iterations, alambda=%f\n",
niter,alambda);
*/
break;
}
} while (niter<MAXIT && (*chisq<oldchi-CHITOL || *chisq>=oldchi));
/*first get the uncertainties back from mrqmin*/
alambda=0.;
mrqmin_orbit(obsarray, nobs, a, ia,
ma, covar, alpha, chisq, &alambda, energy_wt);
p->a = a[1];
p->adot = a[2];
p->b = a[3];
p->bdot = a[4];
p->g = a[5];
p->gdot = a[6];
return;
}
void mglin(double **u, int n, int ncycle)
{
void addint(double **uf, double **uc, double **res, int nf);
void copy(double **aout, double **ain, int n);
void fill0(double **u, int n);
void interp(double **uf, double **uc, int nf);
void relax(double **u, double **rhs, int n);
void resid(double **res, double **u, double **rhs, int n);
void rstrct(double **uc, double **uf, int nc);
void slvsml(double **u, double **rhs);
unsigned int j,jcycle,jj,jpost,jpre,nf,ng=0,ngrid,nn;
double **ires[NGMAX+1],**irho[NGMAX+1],**irhs[NGMAX+1],**iu[NGMAX+1];
nn=n;
while (nn >>= 1) ng++;
if (n != 1+(1L << ng)) nrerror("n-1 must be a power of 2 in mglin.");
if (ng > NGMAX) nrerror("increase NGMAX in mglin.");
nn=n/2+1;
ngrid=ng-1;
irho[ngrid]=dmatrix(1,nn,1,nn);
rstrct(irho[ngrid],u,nn);
while (nn > 3) {
nn=nn/2+1;
irho[--ngrid]=dmatrix(1,nn,1,nn);
rstrct(irho[ngrid],irho[ngrid+1],nn);
}
nn=3;
iu[1]=dmatrix(1,nn,1,nn);
irhs[1]=dmatrix(1,nn,1,nn);
slvsml(iu[1],irho[1]);
free_dmatrix(irho[1],1,nn,1,nn);
ngrid=ng;
for (j=2;j<=ngrid;j++) {
nn=2*nn-1;
iu[j]=dmatrix(1,nn,1,nn);
irhs[j]=dmatrix(1,nn,1,nn);
ires[j]=dmatrix(1,nn,1,nn);
interp(iu[j],iu[j-1],nn);
copy(irhs[j],(j != ngrid ? irho[j] : u),nn);
for (jcycle=1;jcycle<=ncycle;jcycle++) {
nf=nn;
for (jj=j;jj>=2;jj--) {
for (jpre=1;jpre<=NPRE;jpre++)
relax(iu[jj],irhs[jj],nf);
resid(ires[jj],iu[jj],irhs[jj],nf);
nf=nf/2+1;
rstrct(irhs[jj-1],ires[jj],nf);
fill0(iu[jj-1],nf);
}
slvsml(iu[1],irhs[1]);
nf=3;
for (jj=2;jj<=j;jj++) {
nf=2*nf-1;
addint(iu[jj],iu[jj-1],ires[jj],nf);
for (jpost=1;jpost<=NPOST;jpost++)
relax(iu[jj],irhs[jj],nf);
}
}
}
copy(u,iu[ngrid],n);
for (nn=n,j=ng;j>=2;j--,nn=nn/2+1) {
free_dmatrix(ires[j],1,nn,1,nn);
free_dmatrix(irhs[j],1,nn,1,nn);
free_dmatrix(iu[j],1,nn,1,nn);
if (j != ng) free_dmatrix(irho[j],1,nn,1,nn);
}
free_dmatrix(irhs[1],1,3,1,3);
free_dmatrix(iu[1],1,3,1,3);
}
/* Initializes the MCMC sampler and allocates memory. */
void MBC_MCMC_init(unsigned int sample_size,
unsigned int interval,
unsigned int n,
unsigned int d,
unsigned int G,
double *lpZ_mcmc,
double *lpLV_mcmc,
double **Z,
double *Z_pK,
double **Z_mean_start,
double *Z_var,
unsigned int *Z_K,
double Z_var_prior,
double Z_mean_prior_var,
double Z_K_prior,
double Z_var_df,
int *K_mcmc,
double *Z_pK_mcmc,
double *Z_mean_mcmc,
double *Z_var_mcmc) {
unsigned int i;
// Packing constants into structs.
ERGMM_MCMC_Model model = {0,
NULL, // iY
NULL, // dY
NULL, // X
NULL,
NULL,
NULL,
0,
NULL,
NULL,
n, // verts
d, // latent
0, // coef
G // clusters
};
ERGMM_MCMC_MCMCSettings setting = {0,0,NULL,NULL,NULL,0,0,0, // deltas
sample_size,interval,
FALSE // accept_all
};
ERGMM_MCMC_Priors prior = {Z_mean_prior_var, // Z_mean_var
Z_var_prior, // Z_var
Z_var_df, // a.k.a. Z_var_df (I hope)
NULL,
NULL,
Z_K_prior,
0,0,0,0
};
ERGMM_MCMC_Par state = {Z, // Z
NULL, // coef
Z_mean_start, // Z_mean
Z_var, // Z_var
Z_pK, // Z_pK
NULL,
0,
NULL,
0,
0, // dispersion
Z_K, // Z_K
0, // llk
NULL, // lpedge
0, // lpZ
0, // lpLV
0, // lpcoef
0, // lpRE
0, // lpREV
0 // lpdispersion
};
ERGMM_MCMC_MCMCState start = {&state,
NULL,
model.clusters ? dmatrix(model.clusters,model.latent) : NULL, // Z_bar
NULL, // tr_by
model.clusters ? dvector(model.clusters): NULL, // pK
model.clusters ? (unsigned int *) ivector(model.clusters) : NULL, // n
PROP_NONE, // prop_Z
PROP_NONE, // prop_RE
PROP_NONE, // prop_coef
PROP_NONE, // prop_LV
PROP_NONE, // prop_REV
PROP_NONE, // prop_dispersion
FALSE, // after_Gibbs
NULL // update_order
};
ERGMM_MCMC_ROutput outlists = {NULL, // llk
lpZ_mcmc,
NULL, // lpcoef
NULL, // lpRE
lpLV_mcmc,
NULL, //lpREV,
NULL, //lpdispersion
NULL, // Z
NULL, // Z_rate_move
NULL, // coef
NULL, // coef_rate
Z_mean_mcmc,Z_var_mcmc,Z_pK_mcmc,
NULL,NULL,
NULL,NULL,
NULL, // dispersion_mcmc
K_mcmc
};
if(model.clusters>0)
for(i=0; i<model.verts; i++)
start.n[state.Z_K[i] - 1]++;
// Initialize the log-probabilities.
ERGMM_MCMC_logp_Z(&model, &state);
MBC_MCMC_store_iteration(0,&model,&state,&setting,&outlists);
MBC_MCMC_store_iteration(1,&model,&state,&setting,&outlists);
MBC_MCMC_loop(&model, &prior, &start, &setting, &outlists);
}
SEXP DeltaBs1R(SEXP x, SEXP nph, SEXP timecat, SEXP fixobs, SEXP paramt, SEXP matk, SEXP totk, SEXP varcov, SEXP grad)
{
SEXP varlhaz, varlcum, gradlhaz, gradlcum, rlist, rlistnames;
int lx = length(x);
int lnph = length(nph);
int lfix = length(fixobs);
int ltotk = length(totk);
int npar = length(paramt);
PROTECT(x = coerceVector(x,REALSXP));
PROTECT(nph = coerceVector(nph,REALSXP));
PROTECT(timecat = coerceVector(timecat,INTSXP));
PROTECT(fixobs = coerceVector(fixobs,REALSXP));
PROTECT(paramt = coerceVector(paramt,REALSXP));
PROTECT(matk = coerceVector(matk,REALSXP));
PROTECT(totk = coerceVector(totk,REALSXP));
PROTECT(varcov = coerceVector(varcov,REALSXP));
PROTECT(grad = coerceVector(grad,INTSXP));
PROTECT(varlhaz = allocVector(REALSXP,lx));
PROTECT(varlcum = allocVector(REALSXP,lx));
int isGrad = INTEGER(grad)[0];
int A1 = 1;
int A2 = 1;
if (isGrad){
A1 = lx;
A2 = npar;
}
PROTECT(gradlhaz = allocVector(REALSXP,A1*A2));
PROTECT(gradlcum = allocVector(REALSXP,A1*A2));
int nprotect = 13;
double *X = REAL(x);
double *Nph = REAL(nph);
int *TimeCat = INTEGER(timecat);
double *FixObs = REAL(fixobs);
double *ParamT = REAL(paramt);
double *MatK = REAL(matk);
double *TotK = REAL(totk);
double *Varcov = REAL(varcov);
double *VarLHaz = REAL(varlhaz);
double *VarLCum = REAL(varlcum);
int nnph = lnph/lx;
int nfix = lfix/lx;
int nbase = ltotk-1;
int i, j, k, z, t2, t3, tcz;
double Temp, Beta1, Beta2;
double Cst1 = 0;
double Cst2 = 0;
double templ, tempL, InvtempL;
double *MyGradLH = (double *)R_alloc(npar,sizeof(double));
double *MyGradLC = (double *)R_alloc(npar,sizeof(double));
double *MyParam = (double *)R_alloc((nbase+1),sizeof(double));
double *Res = (double *)R_alloc((nbase+1),sizeof(double));
double *tempLvec = (double *)R_alloc((nbase+1),sizeof(double));
double **GradLHaz = dmatrix(REAL(gradlhaz), A1, A2);
double **GradLCum = dmatrix(REAL(gradlcum), A1, A2);
Res[0] = 0;
MyParam[0] = 0;
for (z=0; z<lx; z++){
t3 = nfix*z;
for (i=0; i<nfix; i++){
MyGradLH[i] = FixObs[i+t3];
MyGradLC[i] = FixObs[i+t3];
}
tcz = TimeCat[z];
VarLHaz[z] = 0;
VarLCum[z] = 0;
tempLvec[0] = 0;
t2 = z*nnph;
for (i=0; i<nbase; i++){
MyParam[i+1] = ParamT[i+nfix];
Res[i+1] = 0;
tempLvec[i+1] = 0;
for (j=1; j<nnph; j++){
MyParam[i+1] += ParamT[j*nbase+i+nfix]*Nph[j+t2];
}
}
// Calculation of lambda, Lambda and necessary integrals //
Beta1 = MyParam[tcz];
Beta2 = MyParam[tcz+1];
Res[tcz] = (TotK[tcz+1]-X[z])/MatK[tcz];
Res[tcz+1] = (X[z]-TotK[tcz])/MatK[tcz];
Temp = Beta2-Beta1;
if (Temp!=0){
Cst1 = MatK[tcz]/Temp;
Cst2 = 1/Temp;
templ = Beta1*Res[tcz]+Beta2*Res[tcz+1];
tempL = Cst1*(exp(templ)-exp(Beta1));
tempLvec[tcz] = Cst1*((Res[tcz]+Cst2)*exp(templ)-(1+Cst2)*exp(Beta1));
tempLvec[tcz+1] = Cst1*((Res[tcz+1]-Cst2)*exp(templ)+Cst2*exp(Beta1));
}
else {
templ = Beta1;
Cst1 = 0.5*exp(templ)*Res[tcz+1]*MatK[tcz];
tempL = (X[z]-TotK[tcz])*exp(templ);
tempLvec[tcz] = Cst1*(1+Res[tcz]);
tempLvec[tcz+1] = Cst1*Res[tcz+1];
}
for (k=tcz; k>0; k--){
Beta1 = MyParam[k-1];
Beta2 = MyParam[k];
Temp = Beta2-Beta1;
if (Temp!=0) {
Cst1 = MatK[k-1]/Temp;
Cst2 = 1/Temp;
tempL += Cst1*(exp(Beta2)-exp(Beta1));
tempLvec[k] += Cst1*((1-Cst2)*exp(Beta2)+Cst2*exp(Beta1));
tempLvec[k-1] += Cst1*(Cst2*exp(Beta2)-(1+Cst2)*exp(Beta1));
}
else {
Cst1 = MatK[k-1]*exp(Beta1);
tempL += Cst1;
tempLvec[k] += 0.5*Cst1;
tempLvec[k-1] += 0.5*Cst1;
}
}
InvtempL = 1/tempL;
for (i=0; i<nnph; i++){
for (j=0; j<nbase; j++){
MyGradLH[nfix + i*nbase+j] = Res[j+1]*Nph[i+t2];
MyGradLC[nfix + i*nbase+j] = tempLvec[j+1]*Nph[i+t2]*InvtempL;
}
}
for (i=0; i<npar; i++){
for (j=0; j<npar; j++){
VarLHaz[z] += MyGradLH[i]*Varcov[j+npar*i]*MyGradLH[j];
VarLCum[z] += MyGradLC[i]*Varcov[j+npar*i]*MyGradLC[j];
}
if (isGrad){
GradLHaz[i][z] = MyGradLH[i];
GradLCum[i][z] = MyGradLC[i];
}
}
}
if (isGrad){
/* assemble the return objects as a list */
PROTECT(rlist= allocVector(VECSXP, 4));
SET_VECTOR_ELT(rlist, 0, varlhaz);
SET_VECTOR_ELT(rlist, 1, varlcum);
SET_VECTOR_ELT(rlist, 2, gradlhaz);
SET_VECTOR_ELT(rlist, 3, gradlcum);
/* add names to the list elements */
PROTECT(rlistnames = allocVector(STRSXP, 4));
SET_STRING_ELT(rlistnames, 0, mkChar("VarLogHaz"));
SET_STRING_ELT(rlistnames, 1, mkChar("VarLogCum"));
SET_STRING_ELT(rlistnames, 2, mkChar("GradLogHaz"));
SET_STRING_ELT(rlistnames, 3, mkChar("GradLogCum"));
}
else {
/* assemble the return objects as a list */
PROTECT(rlist= allocVector(VECSXP, 2));
SET_VECTOR_ELT(rlist, 0, varlhaz);
SET_VECTOR_ELT(rlist, 1, varlcum);
/* add names to the list elements */
PROTECT(rlistnames = allocVector(STRSXP, 2));
SET_STRING_ELT(rlistnames, 0, mkChar("VarLogHaz"));
SET_STRING_ELT(rlistnames, 1, mkChar("VarLogCum"));
}
setAttrib(rlist, R_NamesSymbol, rlistnames);
UNPROTECT(nprotect+2);
return rlist;
}
main()
{
/* Change of variables info */
double *r,*dr;
int N;
/* Physics variables */
double *V,*Rho,Z;
int lmax,*nmax,nmaxmax;
double **E,***Psi,**F;
/* Working variables */
int n,l,k;
double x;
/* Value of pi */
const double pi=4.*atan(1.);
/* Specifications for carbon */
Z=6.;
lmax=1;
nmax=ivector(0,lmax);
nmax[0]=1;
nmax[1]=0;
nmaxmax=0; /* Find max of all nmax's */
for (l=0; l<=lmax; l++)
if (nmax[l]>nmaxmax) nmaxmax=nmax[l];
F=dmatrix(0,lmax,0,nmaxmax);
F[0][0]=2.; /* 2 electrons in 1s */
F[0][1]=2.; /* 2 electrons in 2s */
F[1][0]=2.; /* 2 electrons in 2p */
/* The rest is now general for ANY case */
E=dmatrix(0,lmax,0,nmaxmax); /* Make space for E's and Psi's */
Psi=d3tensor(0,lmax,0,nmaxmax,0,Nmx);
Rho=dvector(0,Nmx);
/* Grid vectors */
r=dvector(0,Nmx);
dr=dvector(0,Nmx);
V=dvector(0,Nmx);
/* Set up grid */
N=400;
for (k=0; k<=N; k++) {
x=((double) k)/((double) N);
r[k]=1./(1.-x)-1.-x-x*x;
dr[k]=1./(1.-x)/(1.-x)-1.-2*x;
V[k]=-Z/r[k];
}
V[0]=0.; dr[N]=0.;
/* Test section */
getallEs(E,lmax,nmax,Z,V,r,dr,N);
getallPsis(Psi,E,lmax,nmax,V,r,dr,N);
getRho(Rho,Psi,F,lmax,nmax,N);
printf("Total charge is: %20.15f\n",simpint(Rho,r,dr,N));
/* Be a good citizen and clean up... */
free_dvector(r,0,Nmx);
free_dvector(dr,0,Nmx);
free_dvector(V,0,Nmx);
free_dmatrix(E,0,lmax,0,nmaxmax);
free_dmatrix(F,0,lmax,0,nmaxmax);
free_d3tensor(Psi,0,lmax,0,nmaxmax,0,Nmx);
free_dvector(Rho,0,Nmx);
}
double calLikelihood(double **n_dw, double **p_z_d, double **p_w_z) // log likelihood
{
int z,d,w,i;
double sum;
double *p_z = (double*)calloc(K, sizeof(double)); // p(z)
double *p_z_dw = (double*)calloc(K, sizeof(double)); // p(z|d,w)
printf("aaa\n");
// p(z)
for (int zz = 0; zz < K; zz++)
{
p_z[zz] = 0;
for (i = 0; i < N_Bill_Term; i++)
{
d = (int)(n_dw[i][0]);
w = (int)(n_dw[i][1]);
for (z = 0; z < K; z++)
p_z_dw[z] = p_w_z[w][z] * p_z_d[z][d];
sum = 0;
for (z = 0; z < K; z++)
sum += p_z_dw[z];
if (sum != 0)
p_z_dw[zz] /= sum;
else
printf("sum = 0 in likelihood\n");
p_z[zz] += n_dw[d][w] * p_z_dw[zz];
}
}
printf("bbb\n");
sum = 0;
for (i = 0; i < N_Bill_Term; i++)
sum += n_dw[i][2];
if (sum != 0)
for (z = 0; z < K; z++)
p_z[z] /= sum;
else printf("Error 0\n");
printf("ccc\n");
// p(d|z) - denoted by sum_w[z][d]
double **sum_w = dmatrix(K, D);
double **temp_p_w_z = dmatrix(V, K);
int startCount = 0;
int endCount = 0;
int w_count;
for (d = 0; d < D; d++)
{
if (startCount >= N_Bill_Term)
break;
while ((int)(n_dw[endCount][0]) == d)
{
endCount += 1;
if (endCount >= N_Bill_Term)
break;
}
w_count = endCount - startCount;
int *w_for_d = (int *)calloc(w_count, sizeof(int));
double *wfreq_for_d = (double *)calloc(w_count, sizeof(double));
for (i = 0; i < w_count; i++)
{
w_for_d[i] = (int)(n_dw[startCount+i][1]);
wfreq_for_d[i] = n_dw[startCount+i][2];
}
for (i = 0; i < w_count; i++)
{
w = w_for_d[i];
for (z = 0; z < K; z++)
// actually temp_p_w_z is p(z|d,w), but we omit d in order to save space
temp_p_w_z[w][z] = p_w_z[w][z] * p_z_d[z][d];
sum = 0;
for (z = 0; z < K; z++)
sum += temp_p_w_z[w][z];
if (sum != 0)
for (z = 0; z < K; z++)
temp_p_w_z[w][z] /= sum;
else
printf("%s\n", "sum = 0 in E-step(2)!");
}
for (z = 0; z < K; z++)
{
sum_w[z][d] = 0;
for (i = 0; i < w_count; i++)
{
w = w_for_d[i];
sum_w[z][d] += temp_p_w_z[w][z] * wfreq_for_d[i]; // sum_{w}{p(z|d,w)*n(d,w)}
}
}
startCount = endCount;
free(w_for_d);
free(wfreq_for_d);
}
printf("ddd\n");
for (z = 0; z < K; z++)
{
sum = 0;
for (d = 0; d < D; d++)
sum += sum_w[z][d];
if (sum != 0)
for (d = 0; d < D; d++)
sum_w[z][d] /= sum; // p(d|z)
else
printf("0 error in likelihood\n");
}
printf("eee\n");
// likelihood
double likelihood = 0;
for (i = 0; i < N_Bill_Term; i++)
{
d = n_dw[i][0];
w = n_dw[i][1];
sum = 0; // p(d,w)
for (z = 0; z < K; z++)
sum += p_z[z] * p_w_z[w][z] * sum_w[z][d];
likelihood += n_dw[i][2] * log(sum);
}
free(p_z);
free(p_z_dw);
return likelihood;
}
double *fitradec(char *mpc_filename, char *abg_filename)
{
FILE *abg_file ;
FILE *res_file ;
OBSERVATION obsarray[MAXOBS];
int nobs;
ORBIT orbit;
PBASIS p;
XVBASIS xv;
double d, dd;
static double result[2];
double **covar;
double chisq;
int i;
int dof;
covar = dmatrix(1,6,1,6);
if (read_radec(obsarray, mpc_filename, &nobs)) {
fprintf(stderr, "Error reading input observations\n");
return result ;
}
/* Call subroutine to do the actual fitting: */
fit_observations(obsarray, nobs, &p, covar, &chisq, &dof, NULL);
abg_file = fopen(abg_filename,"w");
/* fprintf(stderr, "# Chi-squared of fit: %.2f DOF: %d\n",chisq,dof); */
fprintf(abg_file, "# Exact a, adot, b, bdot, g, gdot:\n");
fprintf(abg_file, "%11.8f %11.8f %11.8f %11.8f %11.8f %11.8f\n",p.a,p.adot,p.b,
p.bdot, p.g, p.gdot);
pbasis_to_bary(&p, &xv, NULL);
orbitElements(&xv, &orbit);
/* fprintf(stderr, "# a=%f AU,e=%f,i=%f deg\n",orbit.a, orbit.e, orbit.i); */
d = sqrt(xBary*xBary + yBary*yBary + pow(zBary-1/p.g,2.));
dd = d*d*sqrt(covar[5][5]);
/* fprintf(stderr, "# Barycentric distance %.3f+-%.3f\n",d,dd); */
/* Print the covariance matrix to the agb_file */
/* write the covariance to the agbfile */
fprintf(abg_file, "# Covariance matrix: \n");
print_matrix(abg_file, covar, 6, 6);
/* Print out information on the coordinate system */
fprintf(abg_file, "# lat0 lon0 xBary yBary zBary JD0\n");
fprintf(abg_file, "%12.7f %12.7f %10.7f %10.7f %10.7f %.6f\n",
lat0/DTOR,lon0/DTOR,xBary,yBary,zBary,jd0);
fclose(abg_file);
/* Dump residuals to res_file */
/*
res_file = stderr;
fprintf(res_file,"Best fit orbit gives:\n");
fprintf(res_file,"obs time x x_resid y y_resid\n");
for (i=0; i<nobs; i++) {
double x,y;
kbo2d(&p, &obsarray[i], &x, NULL, &y, NULL);
fprintf(res_file,"%3d %9.4f %10.3f %7.3f %10.3f %7.3f\n",
i, obsarray[i].obstime,
obsarray[i].thetax/ARCSEC, (obsarray[i].thetax-x)/ARCSEC,
obsarray[i].thetay/ARCSEC, (obsarray[i].thetay-y)/ARCSEC);
}
*/
free_dmatrix(covar,1,6,1,6);
result[0] = d;
result[1] = dd;
return result;
}
void mgfas(double **u, int n, int maxcyc)
{
double anorm2(double **a, int n);
void copy(double **aout, double **ain, int n);
void interp(double **uf, double **uc, int nf);
void lop(double **out, double **u, int n);
void matadd(double **a, double **b, double **c, int n);
void matsub(double **a, double **b, double **c, int n);
void relax2(double **u, double **rhs, int n);
void rstrct(double **uc, double **uf, int nc);
void slvsm2(double **u, double **rhs);
unsigned int j,jcycle,jj,jm1,jpost,jpre,nf,ng=0,ngrid,nn;
double **irho[NGMAX+1],**irhs[NGMAX+1],**itau[NGMAX+1],
**itemp[NGMAX+1],**iu[NGMAX+1];
double res,trerr;
nn=n;
while (nn >>= 1) ng++;
if (n != 1+(1L << ng)) nrerror("n-1 must be a power of 2 in mgfas.");
if (ng > NGMAX) nrerror("increase NGMAX in mglin.");
nn=n/2+1;
ngrid=ng-1;
irho[ngrid]=dmatrix(1,nn,1,nn);
rstrct(irho[ngrid],u,nn);
while (nn > 3) {
nn=nn/2+1;
irho[--ngrid]=dmatrix(1,nn,1,nn);
rstrct(irho[ngrid],irho[ngrid+1],nn);
}
nn=3;
iu[1]=dmatrix(1,nn,1,nn);
irhs[1]=dmatrix(1,nn,1,nn);
itau[1]=dmatrix(1,nn,1,nn);
itemp[1]=dmatrix(1,nn,1,nn);
slvsm2(iu[1],irho[1]);
free_dmatrix(irho[1],1,nn,1,nn);
ngrid=ng;
for (j=2;j<=ngrid;j++) {
nn=2*nn-1;
iu[j]=dmatrix(1,nn,1,nn);
irhs[j]=dmatrix(1,nn,1,nn);
itau[j]=dmatrix(1,nn,1,nn);
itemp[j]=dmatrix(1,nn,1,nn);
interp(iu[j],iu[j-1],nn);
copy(irhs[j],(j != ngrid ? irho[j] : u),nn);
for (jcycle=1;jcycle<=maxcyc;jcycle++) {
nf=nn;
for (jj=j;jj>=2;jj--) {
for (jpre=1;jpre<=NPRE;jpre++)
relax2(iu[jj],irhs[jj],nf);
lop(itemp[jj],iu[jj],nf);
nf=nf/2+1;
jm1=jj-1;
rstrct(itemp[jm1],itemp[jj],nf);
rstrct(iu[jm1],iu[jj],nf);
lop(itau[jm1],iu[jm1],nf);
matsub(itau[jm1],itemp[jm1],itau[jm1],nf);
if (jj == j)
trerr=ALPHA*anorm2(itau[jm1],nf);
rstrct(irhs[jm1],irhs[jj],nf);
matadd(irhs[jm1],itau[jm1],irhs[jm1],nf);
}
slvsm2(iu[1],irhs[1]);
nf=3;
for (jj=2;jj<=j;jj++) {
jm1=jj-1;
rstrct(itemp[jm1],iu[jj],nf);
matsub(iu[jm1],itemp[jm1],itemp[jm1],nf);
nf=2*nf-1;
interp(itau[jj],itemp[jm1],nf);
matadd(iu[jj],itau[jj],iu[jj],nf);
for (jpost=1;jpost<=NPOST;jpost++)
relax2(iu[jj],irhs[jj],nf);
}
lop(itemp[j],iu[j],nf);
matsub(itemp[j],irhs[j],itemp[j],nf);
res=anorm2(itemp[j],nf);
if (res < trerr) break;
}
}
copy(u,iu[ngrid],n);
for (nn=n,j=ng;j>=1;j--,nn=nn/2+1) {
free_dmatrix(itemp[j],1,nn,1,nn);
free_dmatrix(itau[j],1,nn,1,nn);
free_dmatrix(irhs[j],1,nn,1,nn);
free_dmatrix(iu[j],1,nn,1,nn);
if (j != ng && j != 1) free_dmatrix(irho[j],1,nn,1,nn);
}
}
double *predict(char *abg_file, double jdate, int obscode)
{
PBASIS p;
OBSERVATION futobs;
struct date_time dt;
char inbuff[256], rastring[20], decstring[20];
char outbuff[256];
char *f_string;
double **covar,**sigxy,a,b,PA,**derivs;
double lat,lon,**covecl;
double ra,dec, **coveq;
double yr,mo,day,hr,mn,ss;
double xx,yy,xy,bovasqrd,det;
double distance;
static double result[6];
int i,nfields;
int iarg=1;
sigxy = dmatrix(1,2,1,2);
derivs = dmatrix(1,2,1,2);
covar = dmatrix(1,6,1,6);
covecl = dmatrix(1,2,1,2);
coveq = dmatrix(1,2,1,2);
result[0] = -1.0;
result[1] = -1.0;
result[2] = -1.0;
result[3] = -1.0;
result[4] = -1.0;
result[5] = -1.0;
if (read_abg(abg_file,&p,covar) ) {
fprintf(stderr, "Error input alpha/beta/gamma file %s\n",abg_file);
return result;
}
/* get observatory code */
futobs.obscode=obscode;
futobs.obstime=(jdate-jd0)*DAY;
futobs.xe = -999.; /* Force evaluation of earth3d */
distance = predict_posn(&p,covar,&futobs,sigxy);
/* Now transform to RA/DEC, via ecliptic*/
proj_to_ec(futobs.thetax,futobs.thetay,
&lat, &lon,
lat0, lon0, derivs);
/* map the covariance */
covar_map(sigxy, derivs, covecl, 2, 2);
/* Now to ICRS: */
ec_to_eq(lat, lon, &ra, &dec, derivs);
/* map the covariance */
covar_map(covecl, derivs, coveq, 2, 2);
/* Compute a, b, theta of error ellipse for output */
xx = coveq[1][1]*cos(dec)*cos(dec);
xy = coveq[1][2]*cos(dec);
yy = coveq[2][2];
PA = 0.5 * atan2(2.*xy,(xx-yy)) * 180./PI; /*go right to degrees*/
/* Put PA N through E */
PA = 90.-PA;
bovasqrd = (xx+yy-sqrt(pow(xx-yy,2.)+pow(2.*xy,2.)))
/ (xx+yy+sqrt(pow(xx-yy,2.)+pow(2.*xy,2.))) ;
det = xx*yy-xy*xy;
b = pow(det*bovasqrd,0.25);
a = pow(det/bovasqrd,0.25);
ra /= DTOR;
if (ra<0.) ra+= 360.;
dec /= DTOR;
result[0] = ra;
result[1] = dec;
result[2] = a/ARCSEC;
result[3] = b/ARCSEC;
result[4] = PA;
result[5] = distance;
return result;
}
int
main(int argc, char *argv[])
{
PBASIS p;
OBSERVATION futobs, obs;
struct date_time dt;
char inbuff[256],rastring[20],decstring[20];
double **covar,**sigxy,a,b,PA,**derivs;
double lat,lon,**covecl;
double ra,dec, **coveq;
double dx, dy, chisq, elat, elon;
double xx,yy,xy,bovasqrd,det;
int i,nfields;
int iarg=1;
if (argc>1 && *argv[1]=='^') print_help();
if (read_options(&iarg, argc, argv)) print_help();
if (argc-iarg!=1) print_help();
/* echo the command line to output */
printf("#");
for (i=0; i<argc; i++) printf(" %s",argv[i]);
{
#include <time.h>
time_t timettt;
time(&timettt);
/* note that ctime returns string with newline at end */
printf("\n#---%s",ctime(&timettt));
}
sigxy = dmatrix(1,2,1,2);
derivs = dmatrix(1,2,1,2);
covar = dmatrix(1,6,1,6);
covecl = dmatrix(1,2,1,2);
coveq = dmatrix(1,2,1,2);
if (read_abg(argv[iarg],&p,covar)) {
fprintf(stderr, "Error input alpha/beta/gamma file %s\n",argv[iarg]);
exit(1);
}
while (fgets_nocomment(inbuff, 255, stdin, stdout)!=NULL) {
if (scan_observation(inbuff, &obs)) exit(1);
/* Set time to years after jd0, rotate to tangent plane coords */
obs.obstime = (obs.obstime-jd0)*DAY;
eq_to_ec(obs.thetax,obs.thetay,&elat,&elon,NULL);
ec_to_proj(elat,elon,&(obs.thetax),&(obs.thetay),
lat0,lon0,NULL);
/* Calculate the position of Earth at this time to avoid doing
* it many times later: */
earth3d(obs.obstime, obs.obscode,
&(obs.xe),&(obs.ye),&(obs.ze));
futobs.obstime = obs.obstime;
futobs.obscode = obs.obscode;
futobs.xe = -999.;
predict_posn(&p,covar,&futobs,sigxy);
/* Errors: */
dx = obs.thetax - futobs.thetax;
dy = obs.thetay - futobs.thetay;
/* Add observational errors into the uncertainty */
sigxy[1][1] += pow(obs.dthetax,2.);
sigxy[2][2] += pow(obs.dthetay,2.);
chisq = dx*dx*sigxy[2][2] -2.*dx*dy*sigxy[1][2] + dy*dy*sigxy[1][1];
chisq /= sigxy[1][1]*sigxy[2][2] - sigxy[1][2]*sigxy[2][1];
/* Compute a, b, theta of error ellipse for output */
xx = sigxy[1][1];
yy = sigxy[2][2];
xy = sigxy[1][2];
PA = 0.5 * atan2(2.*xy,(xx-yy)) * 180./PI; /*go right to degrees*/
/* Adjust for PA to be N through E, */
PA = PA-90;
if (PA<-90.) PA += 180.;
bovasqrd = (xx+yy-sqrt(pow(xx-yy,2.)+pow(2.*xy,2.)))
/ (xx+yy+sqrt(pow(xx-yy,2.)+pow(2.*xy,2.))) ;
det = xx*yy-xy*xy;
b = pow(det*bovasqrd,0.25);
a = pow(det/bovasqrd,0.25);
printf("%7.4f %9.2f %9.2f %8.3f %8.3f %8.2f %8.2f %7.2f %.2f\n",
futobs.obstime, futobs.thetax/ARCSEC, futobs.thetay/ARCSEC,
dx/ARCSEC, dy/ARCSEC,
a/ARCSEC,b/ARCSEC,PA, chisq
);
}
exit(0);
}
void pLSA(double **n_dw1, double **n_dw2, double **p_w_z, double **p_z_d, int iter)
{
int i,j,d,z,w,zz;
int step, index, startCount, endCount;
int d_count, w_count;
double sum, sumz;
double likelihood;
double freq;
double beta = 1; // parameters in Tempered EM
double eta = 0.95; // parameters in Tempered EM
double **temp_p_w_z;
double **temp_p_z_d;
temp_p_w_z = dmatrix(V, K); // has different meanings
temp_p_z_d = dmatrix(K, D);
double **sum_w; // sum_{w}{p(z|d,w)*n(d,w)}
double **sum_d; // sum_{d}{p(z|d,w)*n(d,w)}
sum_w = dmatrix(K, D);
sum_d = dmatrix(K, V);
for (step = 0; step < iter; step++)
{
//if (step%10 == 9)
printf("%d%s%d\n", step+1, "/", iter);
// E-step:
printf("%s\n", "E-step(1) begins...");
startCount = 0;
endCount = 0;
for (w = 0; w < V; w++)
{
// if (w%100 == 0) printf("%s%d\n", "w=", w);
if (startCount >= N_Bill_Term)
break;
while ((int)(n_dw2[endCount][0]) == w)
{
endCount += 1;
if (endCount >= N_Bill_Term)
break;
}
if (endCount == startCount)
printf("%s%d%s\n", "Word ", w, " doesn't appear in any bill");
if (endCount > N_Bill_Term)
printf("%s\n", "Index error.");
d_count = endCount - startCount;
// if (w%100 == 0) printf("%s%d\n", "d_count ", d_count);
int *d_for_w = (int *)calloc(d_count, sizeof(int));
double *dfreq_for_w = (double *)calloc(d_count, sizeof(double));
for (i = 0; i < d_count; i++)
{
d_for_w[i] = (int)(n_dw2[startCount+i][1]);
dfreq_for_w[i] = n_dw2[startCount+i][2];
}
for (i = 0; i < d_count; i++)
{
d = d_for_w[i];
for (z = 0; z < K; z++)
// actually temp_p_z_d is p(z|d,w), but we omit w in order to save space
temp_p_z_d[z][d] = p_w_z[w][z] * p_z_d[z][d];
sum = 0;
for (z = 0; z < K; z++)
sum += temp_p_z_d[z][d];
if (sum != 0)
for (z = 0; z < K; z++)
temp_p_z_d[z][d] /= sum;
else
printf("%s\n", "sum = 0 in E-step(1)!");
}
for (z = 0; z < K; z++)
{
sum_d[z][w] = 0;
for (i = 0; i < d_count; i++)
{
d = d_for_w[i];
freq = dfreq_for_w[i];
sum_d[z][w] += temp_p_z_d[z][d] * freq; // sum_{d}{p(z|d,w)*n(d,w)}
}
}
startCount = endCount;
free(d_for_w);
free(dfreq_for_w);
}
printf("%s\n", "E-step(2) begins...");
startCount = 0;
endCount = 0;
for (d = 0; d < D; d++)
{
// if (d%100 == 0) printf("%s%d\n", "d=", d);
if (startCount >= N_Bill_Term)
break;
while ((int)(n_dw1[endCount][0]) == d)
{
endCount += 1;
if (endCount >= N_Bill_Term)
break;
}
w_count = endCount - startCount;
// if (d%100 == 0) printf("%s%d\n", "w_count ", w_count);
int *w_for_d = (int *)calloc(w_count, sizeof(int));
double *wfreq_for_d = (double *)calloc(w_count, sizeof(double));
for (i = 0; i < w_count; i++)
{
w_for_d[i] = (int)(n_dw1[startCount+i][1]);
wfreq_for_d[i] = n_dw1[startCount+i][2];
}
for (i = 0; i < w_count; i++)
{
w = w_for_d[i];
for (z = 0; z < K; z++)
// actually temp_p_w_z is p(z|d,w), but we omit d in order to save space
temp_p_w_z[w][z] = p_w_z[w][z] * p_z_d[z][d];
sum = 0;
for (z = 0; z < K; z++)
sum += temp_p_w_z[w][z];
if (sum != 0)
for (z = 0; z < K; z++)
temp_p_w_z[w][z] /= sum;
else
printf("%s\n", "sum = 0 in E-step(2)!");
}
for (z = 0; z < K; z++)
{
sum_w[z][d] = 0;
for (i = 0; i < w_count; i++)
{
w = w_for_d[i];
freq = wfreq_for_d[i];
sum_w[z][d] += temp_p_w_z[w][z] * freq; // sum_{w}{p(z|d,w)*n(d,w)}
}
}
startCount = endCount;
free(w_for_d);
free(wfreq_for_d);
}
// (Tempered) E-step: calculate n(d,w)*p(z|d,w)
// M-step(1): update p(z|d)
printf("%s\n", "M-step(1) begins...");
for (d = 0; d < D; d++)
{
// if (d%100 == 0) printf("%s%d\n", "d=", d);
for (z = 0; z < K; z++)
temp_p_z_d[z][d] = sum_w[z][d];
// Normalize
sum = 0; // denominator
for (z = 0; z < K; z++)
sum += temp_p_z_d[z][d];
if (sum != 0)
for (z = 0; z < K; z++)
temp_p_z_d[z][d] /= sum;
else
printf("%s\n", "sum = 0 in M-step(1)!");
}
// M-step(2): update p(w|z)
// can add seeds here
printf("%s\n", "M-step(2) begins...");
for (z = 0; z < K; z++)
{
// printf("%s%d\n", "z=", z);
for (w = 0; w < V; w++)
temp_p_w_z[w][z] = sum_d[z][w];
// Normalize
sum = 0; // denominator
for (w = 0; w < V; w++)
sum += temp_p_w_z[w][z];
if (sum != 0)
for (w = 0; w < V; w++)
temp_p_w_z[w][z] /= sum;
else
printf("%s\n", "sum = 0 in M-step(2)!");
}
// update p(z|d) and p(w|z)
for (z = 0; z < K; z++)
{
for (d = 0; d < D; d++)
p_z_d[z][d] = temp_p_z_d[z][d];
for (w = 0; w < V; w++)
p_w_z[w][z] = temp_p_w_z[w][z];
}
// examine whether sum(p(z|d), z) = 1 and sum(p(w|z), w) = 1
for (d = 0; d < D; d++)
{
sum = 0;
for (z = 0; z < K; z++)
sum += p_z_d[z][d];
if (abs(sum-1) > 0.0001)
{
printf("%s\n", "p(d|z) abs(sum-1)>0.0001!");
//printf("%s%d\n", "sum != 1 in step ", step+1);
//printf("%s%f\n", "sum = ", sum);
}
}
for (z = 0; z < K; z++)
{
sum = 0;
for (w = 0; w < V; w++)
sum += p_w_z[w][z];
if (abs(sum-1) > 0.0001)
{
printf("%s\n", "p(z|w) abs(sum-1)>0.0001!");
}
}
}
free_dmatrix(temp_p_w_z, V);
free_dmatrix(temp_p_z_d, K);
free_dmatrix(sum_w, K);
free_dmatrix(sum_d, K);
return;
}
void lensing_data_input(void)
{
double x1;
int i,j,n,k,i1, istart, ii, nlim = 20;
FILE *fp;
char fname[1000], aa[1000], color[100];
double **covar, **tmp, **tmp2;
wpx.zlo = wpx.zhi = -1;
if(REDSHIFT>=0.2 || REDSHIFT<0.5)
{
wpx.iz = 1;
wpx.zlo = 0.22;
wpx.zhi = 0.48;
wpx.nsamples = 7;
}
if(REDSHIFT>=0.5 && REDSHIFT <0.75)
{
wpx.iz = 2;
wpx.zlo = 0.48;
wpx.zhi = 0.74;
wpx.nsamples = 7;
}
if(REDSHIFT>=0.75 && REDSHIFT <1.00)
{
wpx.iz = 3;
wpx.zlo = 0.74;
wpx.zhi = 1.00;
wpx.nsamples = 6;
}
istart = 1;
if(wpx.zlo<0)
endrun("ERROR: no proper redshift specified.\n");
wpx.mstar_threshold = dvector(1,wpx.nsamples);
wpx.ndata = ivector(1,wpx.nsamples);
wpx.ndatar = ivector(1,wpx.nsamples);
wpx.ndatab = ivector(1,wpx.nsamples);
wpx.ngal = dvector(1,wpx.nsamples);
set_lensing_mass_bins();
// loop over BLUE and RED
for(ii=1;ii<=2;++ii)
{
if(ii==1)sprintf(color,"blue");
if(ii==2)sprintf(color,"red");
// read in the wp data
for(i=istart;i<=wpx.nsamples;++i)
{
// Tinker's laptop
sprintf(fname,"/Users/tinker/cosmo/COSMOS/QUENCHED_LENSING/z%d_%s_sm%d.fits.txt",
wpx.iz,color,i-1);
if(JPL_FLAG)
sprintf(fname,"./DATA/z%d_%s_sm%d.fits.txt",wpx.iz,color,i-1);
fp = openfile(fname);
n = filesize(fp);
wpx.ndata[i] = n;
if(ii==1)
{
wpx.rdata[i] = dvector(1,nlim);
wpx.xdata[i] = dvector(1,nlim);
wpx.edata[i] = dvector(1,nlim);
wpx.covar[i] = dmatrix(1,nlim,1,nlim);
wpx.model[i] = dvector(1,nlim);
}
for(j=1;j<=n;++j)
{
fscanf(fp,"%lf %lf %lf %lf %lf %lf %lf %lf %lf",
&x1,&x1,&x1,&x1,&wpx.rdata[i][j],&x1,&wpx.xdata[i][j],&x1,&wpx.edata[i][j]);
fgets(aa,1000,fp);
}
fprintf(stderr,"Read %d lines from [%s]\n",n,fname);
fclose(fp);
/* let's take these data and put them in comoving h-inverse Mpc
* r_ph = r_co*a = r_co/(1+z)
*/
for(j=1;j<=n;++j)
{
wpx.rdata[i][j] = wpx.rdata[i][j]/1000.0*HUBBLE*(1+REDSHIFT);
//printf("%d %d %e %e %e\n",i,j,wpx.rdata[i][j],wpx.xdata[i][j],wpx.edata[i][j]);
}
if(LENSING_COVAR)
{
// Now read in the covariance matrix
// Tinker's laptop
sprintf(fname,"/Users/tinker/cosmo/COSMOS/QUENCHED_LENSING/Covar_%s/z%d_%s_sm%d.covar",
color,wpx.iz,color,i-1);
if(JPL_FLAG)
sprintf(fname,"./DATA/z%d_%s_sm%d.covar",wpx.iz,color,i-1);
fp = openfile(fname);
if(filesize(fp)!=n*n)
{
fprintf(stderr,"FILESIZE mismatch: cij and data not match in SMF: %d %d\n",n*n,filesize(fp));
exit(0);
}
covar = dmatrix(1,nlim,1,nlim);
for(j=1;j<=n;++j)
for(k=1;k<=n;++k)
fscanf(fp,"%d %d %lf",&i1,&i1,&covar[j][k]);
fclose(fp);
fprintf(stderr,"Read [%d] lines from [%s]\n",n*n,fname);
//add the statistical uncertainties to the diagonals
for(j=1;j<=n;++j)
covar[j][j] += (wpx.edata[i][j]*wpx.edata[i][j]);
printf("INVERTING COVARIANCE MATRIX\n");
tmp=dmatrix(1,n,1,1);
tmp2=dmatrix(1,n,1,n);
for(j=1;j<=n;++j)
for(k=1;k<=n;++k)
tmp2[j][k]=covar[j][k];
gaussj(tmp2,n,tmp,1);
for(j=1;j<=n;++j)
for(k=1;k<=n;++k)
wpx.covar[i][j][k]=tmp2[j][k];
free_dmatrix(tmp,1,n,1,1);
free_dmatrix(tmp2,1,n,1,n);
free_dmatrix(covar,1,n,1,n);
}
// put this in the right place
if(ii==1)
{
wpx.ndatab[i] = n;
wpx.rdatab[i] = dvector(1,nlim);
wpx.xdatab[i] = dvector(1,nlim);
wpx.edatab[i] = dvector(1,nlim);
wpx.covarb[i] = dmatrix(1,nlim,1,nlim);
wpx.two_halo_blue[i] = dvector(1,nlim);
for(j=1;j<=n;++j)
{
wpx.rdatab[i][j] = wpx.rdata[i][j];
wpx.xdatab[i][j] = wpx.xdata[i][j];
wpx.edatab[i][j] = wpx.edata[i][j];
for(k=1;k<=n;++k)
wpx.covarb[i][j][k] = wpx.covar[i][j][k];
}
}
if(ii==2)
{
wpx.ndatar[i] = n;
wpx.rdatar[i] = dvector(1,nlim);
wpx.xdatar[i] = dvector(1,nlim);
wpx.edatar[i] = dvector(1,nlim);
wpx.covarr[i] = dmatrix(1,nlim,1,nlim);
wpx.two_halo_red[i] = dvector(1,nlim);
for(j=1;j<=n;++j)
{
wpx.rdatar[i][j] = wpx.rdata[i][j];
wpx.xdatar[i][j] = wpx.xdata[i][j];
wpx.edatar[i][j] = wpx.edata[i][j];
for(k=1;k<=n;++k)
wpx.covarr[i][j][k] = wpx.covar[i][j][k];
}
}
}
}
}
int main()
{
int i,z,d,w;
int billID, wordID, freq;
double sum;
FILE *fp1 = fopen("../data/Bill_Term", "r");
FILE *fp2 = fopen("../data/Term_Bill", "r");
FILE *fpwrite = fopen("../Result/result6479/45topic_NoSeeds_zw", "w");
FILE *fpwrite2 = fopen("../Result/result6479/45topic_NoSeeds_zd", "w");
// initialize
// double **n_dw;
double **p_z_d, **p_w_z;
double **n_dw1, **n_dw2;
// n_dw = dmatrix(D, V);
n_dw1 = dmatrix(N_Bill_Term, 3);
n_dw2 = dmatrix(N_Bill_Term, 3);
p_z_d = dmatrix(K, D);
p_w_z = dmatrix(V, K);
// initialize n(d,w), p(z|d), p(w|z)
i = 0;
while (!feof(fp1))
{
fscanf(fp1, "%d\t%d\t%d\n", &billID, &wordID, &freq);
// n_dw[billID-1][wordID-1] = freq;
n_dw1[i][0] = billID;
n_dw1[i][1] = wordID;
n_dw1[i][2] = freq;
i++;
}
printf("%s%d\n%s%d\n", "i = ", i, "N_Bill_Term = ", N_Bill_Term);
i = 0;
while (!feof(fp2))
{
fscanf(fp2, "%d\t%d\t%d\n", &billID, &wordID, &freq);
n_dw2[i][0] = wordID;
n_dw2[i][1] = billID;
n_dw2[i][2] = freq;
i++;
}
printf("%s%d\n%s%d\n", "i = ", i, "N_Bill_Term = ", N_Bill_Term);
for (d = 0; d < 10; d++)
for (z = 0; z < 3; z++)
printf("%d\t", (int)(n_dw2[d][z]));
for (d = 0; d < D; d++)
{
for (z = 0; z < K; z++)
p_z_d[z][d] = rand() / (double)RAND_MAX; // p(z|d)
// Normalization
sum = 0;
for (z = 0; z < K; z++)
sum += p_z_d[z][d];
if (sum != 0)
for (z = 0; z < K; z++)
p_z_d[z][d] /= sum;
else
printf("%s\n", "Need initialize again.");
sum = 0;
for (z = 0; z < K; z++)
sum += p_z_d[z][d];
if (abs(sum-1)>0.0001) printf("%s\n", "abs(sum-1)>0.0001, Need initialize again.");
}
for (z = 0; z < K; z++)
{
for (w = 0; w < V; w++)
p_w_z[w][z] = rand() / (double)RAND_MAX; // p(w|z)
//Normalization
sum = 0;
for (w = 0; w < V; w++)
sum += p_w_z[w][z];
if (sum != 0)
for (w = 0; w < V; w++)
p_w_z[w][z] /= sum;
else
printf("%s\n", "Need initialize again.");
sum = 0;
for (w = 0; w < V; w++)
sum += p_w_z[w][z];
if (abs(sum-1)>0.0001) printf("%s\n", "abs(sum-1)>0.0001, Need initialize again.");
}
matPrint(p_w_z, 10, 5);
// run plsa
pLSA(n_dw1, n_dw2, p_w_z, p_z_d, iteration);
// output
matPrint(p_z_d, 1, 150);
printf("%s\n", "Write to file...");
//matPrint(p_w_z, 50, 5);
//matPrint(p_z_d, 5, 20);
// d: person, z: topic, w: bill
// topic-word
printf("%s\n", "p(w|z)");
for (z = 0; z < K; z++)
{
sum = 0;
for (w = 0; w < V; w++)
{
sum += p_w_z[w][z];
fprintf(fpwrite, "%.12f", p_w_z[w][z]);
if (w != V-1)
fprintf(fpwrite, "%s", "\t");
}
printf("%lf\n", sum);
fprintf(fpwrite, "%s", "\n");
}
// topic-bill
printf("%s\n", "p(z|d)");
for (z = 0; z < K; z++)
{
for (d = 0; d < D; d++)
{
fprintf(fpwrite2, "%.12f", p_z_d[z][d]);
if (d != D-1)
fprintf(fpwrite2, "%s", "\t");
}
fprintf(fpwrite2, "%s", "\n");
}
// clear
fclose(fp1);
fclose(fp2);
fclose(fpwrite);
fclose(fpwrite2);
// free_dmatrix(n_dw, D);
free_dmatrix(n_dw1, N_Bill_Term);
free_dmatrix(n_dw2, N_Bill_Term);
free_dmatrix(p_z_d, K);
free_dmatrix(p_w_z, V);
return 0;
}
int qmap_bisec (double *x0, double *x1, double *y0, double *y1, double * quat){
double q1[4], q2[4];
double v[3], cosine = 0, theta =0, sine;
double bisec_x[3], bisec_y[3];
double norm_x[3], norm_y[3];
double bisec_x_prime[3];
double norm;
int i,j;
int normalized_cross (double *x, double *y, double * v, double *norm_ptr);
int unnorm_dot (double *x, double *y, double * dot);
/* 0) find normals and bisectors */
if ( normalized_cross (x0, x1, norm_x, NULL) )return 1;
if ( normalized_cross (y0, y1, norm_y, NULL) )return 1;
norm = 0;
for (i=0; i<3; i++ ) {
bisec_x[i] = (x0[i] + x1[i])/2;
norm += bisec_x[i]*bisec_x[i];
}
norm += sqrt(norm);
if (norm) for (i=0; i<3; i++ ) bisec_x[i] /= norm;
norm = 0;
for (i=0; i<3; i++ ) {
bisec_y[i] = (y0[i] + y1[i])/2;
norm += bisec_y[i]*bisec_y[i];
}
norm += sqrt(norm);
if (norm) for (i=0; i<3; i++ ) bisec_y[i] /= norm;
/* 1) find any quat that will match the normals */
/* check that it is not the same vector already: */
unnorm_dot (norm_x, norm_y, &cosine);
if ( 1-cosine > 0.001 ) {
double ** R;
if ( normalized_cross (norm_x, norm_y, v, NULL) )return 1;
theta = acos (cosine);
q1[0] = cos (theta/2);
sine = sin(theta/2);
for (i=0; i<3; i++ ) {
q1[i+1] = sine*v[i];
}
if ( ! (R=dmatrix(3,3) ) ) return 1; /* compiler is bugging me otherwise */
quat_to_R (q1, R);
for (i=0; i<3; i++ ) {
bisec_x_prime[i] = 0;
for (j=0; j<3; j++ ) {
bisec_x_prime[i] += R[i][j]*bisec_x[j];
}
}
free_dmatrix (R);
} else {
memcpy (bisec_x_prime, bisec_x, 3*sizeof(double));
memset (q1, 0, 4*sizeof(double) );
q1[0] = 1.0;
}
/* 2) find quat thru norm_y which maps bisectors one onto another */
unnorm_dot (bisec_x_prime, bisec_y, &cosine);
/* determining theta: angle btw planes = angle btw the normals */
if ( 1-cosine > 0.001 ) {
theta = acos (cosine);
/*still need to determine the sign of rotation */
if (normalized_cross (bisec_x_prime, bisec_y, v, NULL)) return 1;
unnorm_dot (v, norm_y, &cosine);
if ( cosine > 0.0 ) {
sine = sin(theta/2);
} else {
sine = -sin(theta/2);
}
for (i=0; i<3; i++ ) {
v[i] = norm_y[i];
}
q2[0] = cos (theta/2);
for (i=0; i<3; i++ ) {
q2[i+1] = sine*v[i];
}
} else {
memset (q2, 0, 4*sizeof(double) );
q2[0] = 1.0;
}
/* multiply the two quats */
multiply (q2, q1, 0, quat);
return 0;
}
int main(int argc,char *argv[])
{
char *listfile,*inputfile;
char choose= ' ';
string operate=" ";
double temperature=300;
string output=" ";
string segment="all";
int segment_b=0;
int segment_e=0;
// 读取当前的时间
time_t t = time( 0 );
char TIME[64];
strftime( TIME, sizeof(TIME), "%Y/%m/%d %X ",localtime(&t) );
//
switch(argc)
{
case 1:
cout<<"Usage:CurAnalysis -f listfile.txt -i inputfile.txt"<<endl;
exit(0);
case 2:
if(string(argv[1])=="-a")
{
Printversion();
exit(0);
}
if(string(argv[1])=="-h")
{
Printhelp();
exit(0);
}
case 5:
if(string(argv[1])=="-f"&&string(argv[3])=="-i")
{
listfile=argv[2];
inputfile=argv[4];
}
break;
default:
cout<<"Usage:CurAnalysis -f listfile.txt -i inputfile.txt"<<endl;
exit(0);
}
ReadInput(inputfile,operate,choose,output,temperature,segment,segment_b,segment_e);
/*
average部分已经完成，经测试可以使用，主要的问题是读文件的异常
比如说文件残缺，文件丢失等的情况的处理的过程没有完成。
*/
if(operate=="average")
{
if(choose=='E'||choose=='F'||choose=='G'||choose=='H')
{
double ***totaldata;
struct Filelist *fl;
struct Paramater *spt;
int N=0;
ofstream outfile(output.c_str(),ios::app);
fl=Readlist(listfile);
switch(choose)
{
case 'E':
spt=E_part(fl->file);
break;
case 'F':
spt=F_part(fl->file);
break;
case 'G':
spt=G_part(fl->file);
break;
case 'H':
spt=H_part(fl->file);
break;
}
int filesize=Getfilelen(fl);
int size=GetParamaterlen(spt);
if(segment!="all")
{
size=segment_e - segment_b+1;
}
if(segment=="all")
{
segment_b=1;
segment_e=size;
}
totaldata=f3tensor(0,5,0,size-1,0,filesize-1);
outfile<<"******************************************************************"<<endl;
//output the input file!
ifstream infile(inputfile);
string s;
getline(infile,s);
while(!infile.fail())
{
outfile<<"#"<<s<<endl;
getline(infile,s);
}
outfile<<TIME<<endl; //输出当前时间
infile.close();
//
while(fl!=NULL)
{
struct Paramater *sp;
switch(choose)
{
case 'E':
sp=E_part(fl->file);
break;
case 'F':
sp=F_part(fl->file);
break;
case 'G':
sp=G_part(fl->file);
break;
case 'H':
sp=H_part(fl->file);
break;
}
// int size=GetParamaterlen(sp);
double **data;
data=dmatrix(0,5,0,size-1);
struct Namelist *name;
name=(struct Namelist *)malloc(sizeof(struct Namelist));
Paramater2double(sp,data,name,segment_b,segment_e);
for(int i=0;i<6;i++)
{
for(int j=0;j<size;j++)
{
totaldata[i][j][N]=data[i][j];
}
}
free_dmatrix(data,0,5,0,size-1);
cout<<"Read file "<<fl->file<<" finished!"<<endl;//输出提示
fl=fl->next;
N++;
}
double **aveg;
aveg=dmatrix(0,5,0,size-1);
for(int i=0;i<6;i++)
{
for(int j=0;j<size;j++)
{
aveg[i][j]=0;
}
}
outfile<<endl;
outfile<<"******************************************************************"<<endl;
outfile<<"\t"<<"rise"<<"\t"<<"roll"<<"\t"<<"shift"<<"\t"<<"slide"<<"\t"<<"tilt"<<"\t"<<"twist"<<endl;
outfile<<endl;
for(int i=0;i<size;i++)
{
outfile<<i+segment_b<<"\t";
for(int j=0;j<6;j++)
{
for(int k=0;k<filesize;k++)
{
aveg[j][i]+=totaldata[j][i][k];
}
aveg[j][i]=aveg[j][i]/filesize;
outfile<<fixed<<showpoint;
outfile<<setprecision(2)<<aveg[j][i]<<"\t";
}
outfile<<endl;
}
outfile<<endl;
outfile<<"******************************************************************"<<endl;
cout<<"finished the calculation of average !"<<endl;
cout<<"the output write in the file "<<output<<" !"<<endl;
outfile.close();
free_f3tensor(totaldata,0,5,0,size-1,0,filesize-1);
}
//average for J
if(choose=='J')
{
double ***totaldata;
struct Filelist *fl;
struct Backbone *spt;
int N=0;
fl=Readlist(listfile);
spt=J_part(fl->file);
int filesize=Getfilelen(fl);
int size=GetBackbonelen(spt);
if(segment!="all")
{
size=segment_e - segment_b+1;
}
if(segment=="all")
{
segment_b=1;
segment_e=size;
}
totaldata=f3tensor(0,13,0,size-1,0,filesize-1);
ofstream outfile(output.c_str(),ios::app);
outfile<<"******************************************************************"<<endl;
//output the input file!
ifstream infile(inputfile);
string s;
getline(infile,s);
while(!infile.fail())
{
outfile<<"#"<<s<<endl;
getline(infile,s);
}
outfile<<TIME<<endl; //输出当前时间
infile.close();
//
while(fl!=NULL)
{
struct Backbone *sp;
sp=J_part(fl->file);
// int size=GetBackbonelen(sp);
double **data;
data=dmatrix(0,13,0,size-1);
struct Namelist *name;
name=(struct Namelist *)malloc(sizeof(struct Namelist));
Backbone2double(sp,data,name,segment_b,segment_e);
for(int i=0;i<14;i++)
{
for(int j=0;j<size;j++)
{
totaldata[i][j][N]=data[i][j];
}
}
free_dmatrix(data,0,13,0,size-1);
cout<<"Read file "<<fl->file<<" finished!"<<endl;//输出提示
fl=fl->next;
N++;
}
double **aveg;
aveg=dmatrix(0,13,0,size-1);
for(int i=0;i<14;i++)
{
for(int j=0;j<size;j++)
{
aveg[i][j]=0;
}
}
outfile<<endl;
outfile<<"******************************************************************"<<endl;
outfile<<"\t"<<"alpha"<<"\t"<<"ampli"<<"\t"<<"beta"<<"\t"<<"c1"<<"\t"<<"c1c2"<<"\t"<<"c2"<<"\t"<<"c2c3"<<"\t"<<"c3"<<"\t"<<"chi"<<"\t"<<"delta"<<"\t"<<"epsil"<<"\t"<<"gamma"<<"\t"<<"phase"<<"\t"<<"zeta"<<endl;
outfile<<endl;
for(int i=0;i<size;i++)
{
outfile<<i+segment_b<<"\t";
for(int j=0;j<14;j++)
{
for(int k=0;k<filesize;k++)
{
aveg[j][i]+=totaldata[j][i][k];
}
aveg[j][i]=aveg[j][i]/filesize;
outfile<<fixed<<showpoint;
outfile<<setprecision(2)<<aveg[j][i]<<"\t";
}
outfile<<endl;
}
outfile<<endl;
outfile<<"******************************************************************"<<endl;
cout<<"finished the calculation of average !"<<endl;
cout<<"the output write in the file "<<output<<" !"<<endl;
outfile.close();
free_f3tensor(totaldata,0,13,0,size-1,0,filesize-1);
}
}
//计算某一数据的分布
if(operate=="distribution")
{
//part 1: get the data
if(choose=='E'||choose=='F'||choose=='G'||choose=='H')
{
double ***totaldata;
struct Filelist *fl;
struct Paramater *spt;
int N=0;
ofstream outfile(output.c_str(),ios::app);
fl=Readlist(listfile);
switch(choose)
{
case 'E':
spt=E_part(fl->file);
break;
case 'F':
spt=F_part(fl->file);
break;
case 'G':
spt=G_part(fl->file);
break;
case 'H':
spt=H_part(fl->file);
break;
}
int filesize=Getfilelen(fl);
int size=GetParamaterlen(spt);
if(segment!="all")
{
size=segment_e - segment_b+1;
}
if(segment=="all")
{
segment_b=1;
segment_e=size;
}
totaldata=f3tensor(0,5,0,size-1,0,filesize-1);
outfile<<"******************************************************************"<<endl;
//output the input file!
ifstream infile(inputfile);
string s;
getline(infile,s);
while(!infile.fail())
{
outfile<<"#"<<s<<endl;
getline(infile,s);
}
outfile<<TIME<<endl; //输出当前时间
infile.close();
//
while(fl!=NULL)
{
struct Paramater *sp;
switch(choose)
{
case 'E':
sp=E_part(fl->file);
break;
case 'F':
sp=F_part(fl->file);
break;
case 'G':
sp=G_part(fl->file);
break;
case 'H':
sp=H_part(fl->file);
break;
}
// int size=GetParamaterlen(sp);
double **data;
data=dmatrix(0,5,0,size-1);
struct Namelist *name;
name=(struct Namelist *)malloc(sizeof(struct Namelist));
Paramater2double(sp,data,name,segment_b,segment_e);
for(int i=0;i<6;i++)
{
for(int j=0;j<size;j++)
{
totaldata[i][j][N]=data[i][j];
}
}
free_dmatrix(data,0,5,0,size-1);
cout<<"Read file "<<fl->file<<" finished!"<<endl;//输出提示
fl=fl->next;
N++;
}
// finished the input data
//calculate the distribution!
double *vect;
vect=dvector(0, size*filesize-1) ;
for(int i=0;i<6;i++)
{
outfile<<"******************************************************************"<<endl;
switch(i)
{
case 0:
outfile<<"the distribution of RISE"<<endl;
break;
case 1:
outfile<<"the distribution of ROLL"<<endl;
break;
case 2:
outfile<<"the distribution of SHIFT"<<endl;
break;
case 3:
outfile<<"the distribution of SLIDE"<<endl;
break;
case 4:
outfile<<"the distribution of TILT"<<endl;
break;
case 5:
outfile<<"the distribution of TWIST"<<endl;
break;
}
outfile<<"******************************************************************"<<endl;
//
for(int m=0;m<size;m++)
{
for(int n=0;n<filesize;n++)
{
vect[m*filesize+n]=totaldata[i][m][n];
}
}
//把二维的数据转化为一维的数据！
Distribution(vect,size*filesize,output);
outfile<<"******************************************************************"<<endl;
}
cout<<"finished the calculation of distribution !"<<endl;
cout<<"the output write in the file "<<output<<" !"<<endl;
outfile.close();
free_f3tensor(totaldata,0,5,0,size-1,0,filesize-1);
// finished the calculation !
}
if(choose=='J')
{
double ***totaldata;
struct Filelist *fl;
struct Backbone *spt;
int N=0;
fl=Readlist(listfile);
spt=J_part(fl->file);
int filesize=Getfilelen(fl);
int size=GetBackbonelen(spt);
if(segment!="all")
{
size=segment_e - segment_b+1;
}
if(segment=="all")
{
segment_b=1;
segment_e=size;
}
totaldata=f3tensor(0,13,0,size-1,0,filesize-1);
ofstream outfile(output.c_str(),ios::app);
outfile<<"******************************************************************"<<endl;
//output the input file!
ifstream infile(inputfile);
string s;
getline(infile,s);
while(!infile.fail())
{
outfile<<"#"<<s<<endl;
getline(infile,s);
}
outfile<<TIME<<endl; //输出当前时间
infile.close();
//
while(fl!=NULL)
{
struct Backbone *sp;
sp=J_part(fl->file);
// int size=GetBackbonelen(sp);
double **data;
data=dmatrix(0,13,0,size-1);
struct Namelist *name;
name=(struct Namelist *)malloc(sizeof(struct Namelist));
Backbone2double(sp,data,name,segment_b,segment_e);
for(int i=0;i<14;i++)
{
for(int j=0;j<size;j++)
{
totaldata[i][j][N]=data[i][j];
}
}
free_dmatrix(data,0,13,0,size-1);
cout<<"Read file "<<fl->file<<" finished!"<<endl;//输出提示
fl=fl->next;
N++;
}
double *vect;
vect=dvector(0, size*filesize-1) ;
for(int i=0;i<14;i++)
{
outfile<<"******************************************************************"<<endl;
switch(i)
{
case 0:
outfile<<"the distribution of ALPHA"<<endl;
break;
case 1:
outfile<<"the distribution of AMPLI"<<endl;
break;
case 2:
outfile<<"the distribution of BETA"<<endl;
break;
case 3:
outfile<<"the distribution of C1'"<<endl;
break;
case 4:
outfile<<"the distribution of C1'-C2'"<<endl;
break;
case 5:
outfile<<"the distribution of C2'"<<endl;
break;
case 6:
outfile<<"the distribution of C2'-C3'"<<endl;
break;
case 7:
outfile<<"the distribution of C3'"<<endl;
break;
case 8:
outfile<<"the distribution of CHI"<<endl;
break;
case 9:
outfile<<"the distribution of DELTA"<<endl;
break;
case 10:
outfile<<"the distribution of ESPIL"<<endl;
break;
case 11:
outfile<<"the distribution of GAMMA"<<endl;
break;
case 12:
outfile<<"the distribution of PHASE"<<endl;
break;
case 13:
outfile<<"the distribution of ZETA"<<endl;
break;
}
outfile<<"******************************************************************"<<endl;
//
for(int m=0;m<size;m++)
{
for(int n=0;n<filesize;n++)
{
vect[m*filesize+n]=totaldata[i][m][n];
}
}
//把二维的数据转化为一维的数据！
Distribution(vect,size*filesize,output);
outfile<<"******************************************************************"<<endl;
}
cout<<"finished the calculation of distribution !"<<endl;
cout<<"the output write in the file "<<output<<" !"<<endl;
outfile.close();
free_f3tensor(totaldata,0,13,0,size-1,0,filesize-1);
// finished the calculation !
}
}
/*计算刚性*/
if(operate=="stiffness")
{
/*get the data*/
if(choose=='E'||choose=='F'||choose=='G'||choose=='H')
{
double ***totaldata;
struct Filelist *fl;
struct Paramater *spt;
int N=0;
ofstream outfile(output.c_str(),ios::app);
fl=Readlist(listfile);
switch(choose)
{
case 'E':
spt=E_part(fl->file);
break;
case 'F':
spt=F_part(fl->file);
break;
case 'G':
spt=G_part(fl->file);
break;
case 'H':
spt=H_part(fl->file);
break;
}
int filesize=Getfilelen(fl);
int size=GetParamaterlen(spt);
if(segment!="all")
{
size=segment_e - segment_b+1;
}
if(segment=="all")
{
segment_b=1;
segment_e=size;
}
totaldata=f3tensor(0,5,0,size-1,0,filesize-1);
outfile<<"******************************************************************"<<endl;
//output the input file!
ifstream infile(inputfile);
string s;
getline(infile,s);
while(!infile.fail())
{
outfile<<"#"<<s<<endl;
getline(infile,s);
}
outfile<<TIME<<endl; //输出当前时间
infile.close();
//
while(fl!=NULL)
{
struct Paramater *sp;
switch(choose)
{
case 'E':
sp=E_part(fl->file);
break;
case 'F':
sp=F_part(fl->file);
break;
case 'G':
sp=G_part(fl->file);
break;
case 'H':
sp=H_part(fl->file);
break;
}
// int size=GetParamaterlen(sp);
double **data;
data=dmatrix(0,5,0,size-1);
struct Namelist *name;
name=(struct Namelist *)malloc(sizeof(struct Namelist));
Paramater2double(sp,data,name,segment_b,segment_e);
for(int i=0;i<6;i++)
{
for(int j=0;j<size;j++)
{
totaldata[i][j][N]=data[i][j];
}
}
free_dmatrix(data,0,5,0,size-1);
cout<<"Read file "<<fl->file<<" finished!"<<endl;//输出提示
fl=fl->next;
N++;
}
// finished the input data
/*calculate the stiffness! */
double **stiff;
double **matrix;
double **inve_matrix;
/*output the title */
outfile<<"******************************************************************"<<endl;
outfile<<"calculate the stiffness of part "<<choose<<endl;
outfile<<"******************************************************************"<<endl;
for(int x=segment_b-1;x<segment_e;x++) /* the loop for segment */
{
stiff=dmatrix(0,5,0, filesize-1) ; /* hold the space!*/
matrix=dmatrix(0,5,0,5);
inve_matrix=dmatrix(0,5,0,5);
for(int i=0;i<6;i++)
{
for(int n=0;n<filesize;n++)
{
stiff[i][n]=totaldata[i][x][n];
}
}
Getmatrix(stiff,matrix,filesize); /*cteate the helical matrix!*/
free_dmatrix(stiff,0,5,0,filesize-1);
inverse_matrix(matrix, inve_matrix,6);
free_dmatrix(matrix,0,5,0,5);
outfile<<"the stiffness of segment "<<x+1<<endl;
outfile<<"******************************************************************"<<endl;
outfile<<"\t"<<"rise"<<"\t"<<"roll"<<"\t"<<"shift"<<"\t"<<"slide"<<"\t"<<"tilt"<<"\t"<<"twist"<<endl;
outfile<<fixed<<showpoint;
for(int i=0;i<6;i++)
{
switch(i)
{
case 0:
outfile<<"rise"<<"\t";
break;
case 1:
outfile<<"roll"<<"\t";
break;
case 2:
outfile<<"shift"<<"\t";
break;
case 3:
outfile<<"slide"<<"\t";
break;
case 4:
outfile<<"tilt"<<"\t";
break;
case 5:
outfile<<"twist"<<"\t";
break;
}
for(int j=0;j<6;j++)
{
outfile<<setprecision(2)<<R*temperature*inve_matrix[i][j]<<"\t";
}
outfile<<endl;
}
outfile<<"******************************************************************"<<endl;
}
cout<<"finished the calculation of stiffness !"<<endl;
cout<<"the output write in the file "<<"\""<<output<<"\" !"<<endl;
outfile.close();
free_f3tensor(totaldata,0,5,0,size-1,0,filesize-1);
// finished the calculation !
}
else
{
cout<<"wrong input, please check!"<<endl;
exit(0);
}
}
if(operate!="stiffness"&&operate!="average"&&operate!="distribution")
{
cout<<"Input a wrong operate. the correct oprtate is 'average/distribution/stiffness'"<<endl;
exit(0);
}
return 0;
}
int
main (int argc, char *argv[])
{
document *data;
double *alpha;
double **beta;
FILE *ap, *bp; // for alpha, beta
char c;
int nlex, dlenmax;
int nclass = CLASS_DEFAULT; // default in lda.h
int emmax = EMMAX_DEFAULT; // default in lda.h
int demmax = DEMMAX_DEFAULT; // default in lda.h
double epsilon = EPSILON_DEFAULT; // default in lda.h
while ((c = getopt(argc, argv, "N:I:D:E:h")) != -1)
{
switch (c) {
case 'N': nclass = atoi(optarg); break;
case 'I': emmax = atoi(optarg); break;
case 'D': demmax = atoi(optarg); break;
case 'E': epsilon = atof(optarg); break;
case 'h': usage (); break;
default : usage (); break;
}
}
if (!(argc - optind == 2))
usage ();
/* open data */
if ((data = feature_matrix(argv[optind], &nlex, &dlenmax)) == NULL) {
fprintf(stderr, "lda:: cannot open training data.\n");
exit(1);
}
/* allocate parameters */
if ((alpha = (double *)calloc(nclass, sizeof(double))) == NULL) {
fprintf(stderr, "lda:: cannot allocate alpha.\n");
exit(1);
}
if ((beta = dmatrix(nlex, nclass)) == NULL) {
fprintf(stderr, "lda:: cannot allocate beta.\n");
exit(1);
}
/* open model outputs */
if (((ap = fopen(strconcat(argv[optind + 1], ".alpha"), "w")) == NULL)
|| ((bp = fopen(strconcat(argv[optind + 1], ".beta"), "w")) == NULL))
{
fprintf(stderr, "lda:: cannot open model outputs.\n");
exit(1);
}
lda_learn (data, alpha, beta, nclass, nlex, dlenmax,
emmax, demmax, epsilon);
lda_write (ap, bp, alpha, beta, nclass, nlex);
free_feature_matrix(data);
free_dmatrix(beta, nlex);
free(alpha);
fclose(ap);
fclose(bp);
exit(0);
}
void pLSA(double **n_dw1, double **n_dw2, double **p_w_z, double **p_z_d, int iter)
{
int i,j,d,z,w,zz;
int step, index, startCount, endCount;
int d_count, w_count;
double sum, sumz;
double freq;
double beta = 1; // parameters in Tempered EM
double eta = 0.95; // parameters in Tempered EM
double **temp_p_w_z; // has different meanings
double **temp_p_z_d; // has differnet meanings
temp_p_w_z = dmatrix(V, K);
temp_p_z_d = dmatrix(K, D);
double **sum_w; // sum_{w}{p(z|d,w)*n(d,w)}
double **sum_d; // sum_{d}{p(z|d,w)*n(d,w)}
sum_w = dmatrix(K, D);
sum_d = dmatrix(K, V);
double likelihood[2] = {-1,-1}; // old, new: for early stopping
for (step = 0; step < iter; step++)
{
// if (step%10 == 9)
printf("%d%s%d\n", step+1, "/", iter);
// E-step:
//printf("%s\n", "E-step(1) begins..."); // sum_{d}{p(z|d,w)*n(d,w)}
startCount = 0;
endCount = 0;
for (w = 0; w < V; w++)
{
// if (w%100 == 0) printf("%d\n", w);
if (startCount >= N_Bill_Term)
break;
while ((int)(n_dw2[endCount][0]) == w)
{
endCount += 1;
if (endCount >= N_Bill_Term)
break;
}
if (endCount == startCount)
printf("%s%d%s\n", "Word ", w, " doesn't appear in any bill");
if (endCount > N_Bill_Term)
printf("%s\n", "Index error.");
d_count = endCount - startCount;
// if (w%100 == 0) printf("%s%d\n", "d_count ", d_count);
int *d_for_w = (int *)calloc(d_count, sizeof(int));
double *dfreq_for_w = (double *)calloc(d_count, sizeof(double));
for (i = 0; i < d_count; i++)
{
d_for_w[i] = (int)(n_dw2[startCount+i][1]);
dfreq_for_w[i] = n_dw2[startCount+i][2];
}
for (i = 0; i < d_count; i++)
{
d = d_for_w[i];
for (z = 0; z < K; z++)
// actually temp_p_z_d is p(z|d,w), but we omit w in order to save space
temp_p_z_d[z][d] = p_w_z[w][z] * p_z_d[z][d];
sum = 0;
for (z = 0; z < K; z++)
sum += temp_p_z_d[z][d];
if (sum != 0)
for (z = 0; z < K; z++)
temp_p_z_d[z][d] /= sum;
else
printf("%s\n", "sum = 0 in E-step(1)!");
}
for (z = 0; z < K; z++)
{
sum_d[z][w] = 0;
for (i = 0; i < d_count; i++)
{
d = d_for_w[i];
freq = dfreq_for_w[i];
sum_d[z][w] += temp_p_z_d[z][d] * freq; // sum_{d}{p(z|d,w)*n(d,w)}
}
}
startCount = endCount;
free(d_for_w);
free(dfreq_for_w);
}
//printf("%s\n", "E-step(2) begins..."); // sum_{w}{p(z|d,w)*n(d,w)}
startCount = 0;
endCount = 0;
for (d = 0; d < D; d++)
{
// if (d%100 == 0) printf("%d\n", d);
if (startCount >= N_Bill_Term)
break;
while ((int)(n_dw1[endCount][0]) == d)
{
endCount += 1;
if (endCount >= N_Bill_Term)
break;
}
w_count = endCount - startCount;
int *w_for_d = (int *)calloc(w_count, sizeof(int));
double *wfreq_for_d = (double *)calloc(w_count, sizeof(double));
for (i = 0; i < w_count; i++)
{
w_for_d[i] = (int)(n_dw1[startCount+i][1]);
wfreq_for_d[i] = n_dw1[startCount+i][2];
}
for (i = 0; i < w_count; i++)
{
w = w_for_d[i];
for (z = 0; z < K; z++)
// actually temp_p_w_z is p(z|d,w), but we omit d in order to save space
temp_p_w_z[w][z] = p_w_z[w][z] * p_z_d[z][d];
sum = 0;
for (z = 0; z < K; z++)
sum += temp_p_w_z[w][z];
if (sum != 0)
for (z = 0; z < K; z++)
temp_p_w_z[w][z] /= sum;
else
printf("%s\n", "sum = 0 in E-step(2)!");
}
for (z = 0; z < K; z++)
{
sum_w[z][d] = 0;
for (i = 0; i < w_count; i++)
{
w = w_for_d[i];
freq = wfreq_for_d[i];
sum_w[z][d] += temp_p_w_z[w][z] * freq; // sum_{w}{p(z|d,w)*n(d,w)}
}
}
startCount = endCount;
free(w_for_d);
free(wfreq_for_d);
}
// M-step(1): update p(z|d)
//printf("%s\n", "M-step(1) begins...");
for (d = 0; d < D; d++)
{
// if (d%100 == 0) printf("%d\n",d);
for (z = 0; z < K; z++)
temp_p_z_d[z][d] = sum_w[z][d];
// Normalize
sum = 0; // denominator
for (z = 0; z < K; z++)
sum += temp_p_z_d[z][d];
if (sum != 0)
for (z = 0; z < K; z++)
temp_p_z_d[z][d] /= sum;
else
printf("%s\n", "sum = 0 in M-step(1)!");
}
// M-step(2): update p(w|z)
// can add seeds here
//printf("%s\n", "M-step(2) begins...");
for (z = 0; z < K; z++)
{
// printf("%d\n", z);
for (w = 0; w < V; w++)
temp_p_w_z[w][z] = sum_d[z][w];
// Normalize
sum = 0; // denominator
for (w = 0; w < V; w++)
sum += temp_p_w_z[w][z];
if (sum != 0)
for (w = 0; w < V; w++)
temp_p_w_z[w][z] /= sum;
else
printf("%s\n", "sum = 0 in M-step(2)!");
}
// update p(z|d) and p(w|z)
for (z = 0; z < K; z++)
{
for (d = 0; d < D; d++)
p_z_d[z][d] = temp_p_z_d[z][d];
for (w = 0; w < V; w++)
p_w_z[w][z] = temp_p_w_z[w][z];
}
// examine whether sum(p(z|d), z) = 1 and sum(p(w|z), w) = 1
for (d = 0; d < D; d++)
{
sum = 0;
for (z = 0; z < K; z++)
sum += p_z_d[z][d];
if (fabs(sum-1) > 0.0001)
{
printf("%s\n", "p(d|z) abs(sum-1)>0.0001!");
//printf("%s%d\n", "sum != 1 in step ", step+1);
//printf("%s%f\n", "sum = ", sum);
}
}
for (z = 0; z < K; z++)
{
sum = 0;
for (w = 0; w < V; w++)
sum += p_w_z[w][z];
if (fabs(sum-1) > 0.0001)
{
printf("%s\n", "p(z|w) abs(sum-1)>0.0001!");
}
}
// early stopping
if (step%10 == 0)
{
likelihood[1] = calLikelihood(n_dw1, p_z_d, p_w_z);
printf("%s%f\n%f\n", "likelihoods: (old/new)\n", likelihood[0], likelihood[1]);
double rate = fabs((likelihood[1]-likelihood[0])/likelihood[0]);
printf("%s%f\n", "rate = ", rate);
if (rate < pow(10.0, -5.0) && step > 1)
{
printf("%s\n", "early stop");
return;
}
likelihood[0] = likelihood[1];
FILE *fp = fopen("../Result/result6479/likelihood_NoSeeds", "a");
fprintf(fp, "%lf\t%lf\n", likelihood[1], rate);
fclose(fp);
}
}
free_dmatrix(temp_p_w_z, V);
free_dmatrix(temp_p_z_d, K);
free_dmatrix(sum_w, K);
free_dmatrix(sum_d, K);
return;
}
int opt_quat ( double ** x, int NX, int *set_of_directions_x,
double ** y, int NY, int *set_of_directions_y,
int set_size, double * q, double * rmsd) {
double * x_sub[set_size], * y_sub[set_size];
int ctr;
int i, j;
double ATA [4][4] = {{0.0}};
double prev_ATA[4][4] = {{0.0}};
double ATA_sum [4][4] = {{0.0}};
double a[3] = {0.0}, b[3] = {0.0};
int add_matrices (double matrix1[4][4],double matrix2[4][4],
double result[4][4]);
int construct_ATA (double ATA[4][4], double a[3], double b[3]);
/* note how we pass the matrix: pointer to the first element in the block */
void dsyev_ (char * jobz, char *uplo, int *n,
double *A, int * lda, double * w, double * work, int * lwork, int *info);
if (!set_size) {
*rmsd = -1;
return 1;
}
memset ( &(q[0]), 0, 4*sizeof(double) );
/* find the subset */
ctr = 0;
for ( ctr =0; ctr < set_size; ctr++ ) {
x_sub[ctr] = x[set_of_directions_x[ctr]];
y_sub[ctr] = y[set_of_directions_y[ctr]];
}
/* check: */
if (0) {
printf (" Number of vectors to match: %d. \n", set_size);
for ( ctr =0; ctr < set_size; ctr++ ) {
printf ("\t x%1d %10.4lf %10.4lf %10.4lf ",
ctr, x_sub[ctr][0], x_sub[ctr][1], x_sub[ctr][2]);
printf ("\t y%1d %10.4lf %10.4lf %10.4lf \n",
ctr, y_sub[ctr][0], y_sub[ctr][1], y_sub[ctr][2]);
}
exit (1);
}
/* B = ATA_sum matrix to diagonalize in order to get the quaternion */
for ( ctr =0; ctr < set_size; ctr++ ) {
for (i=0; i<3; i++ ) {
a[i] = y_sub[ctr][i] + x_sub[ctr][i];
b[i] = y_sub[ctr][i] - x_sub[ctr][i];
}
construct_ATA (ATA, a, b);
add_matrices (prev_ATA, ATA, ATA_sum);
memcpy (prev_ATA[0], ATA_sum[0], 4*4*sizeof(double));
}
for (i=0; i<4; i++ ) {
for (j=0; j<4; j++ ) {
ATA_sum[i][j] /= set_size;
}
}
/* diagonalize ATA_sum - the eigenvector corresponsing to the
smallest lambda is the quaternion we are looking for; the
eigenvalue is the rmsd*/
/* use the nomenclature from dsyev*/
char jobz= 'V'; /*Compute eigenvalues and eigenvectors.*/
char uplo= 'U'; /* Upper triangle of A (the matrix we are diagonalizing) is stored; */
int n = 4; /* order and the leading dimension of A */
int lda = 4;
double ** A;
int info;
int lwork = 200;
double w [4];
double work[200];
if ( !( A=dmatrix(4,4) ) ) exit (1);
memcpy (A[0], ATA_sum[0], 4*4*sizeof(double));
/* note how we pass the matrix: */
dsyev_ ( &jobz, &uplo, &n, A[0], &lda, w, work, &lwork, &info);
if ( ! info) {
*rmsd = sqrt (w[0]);
for (i=0; i<4; i++ ) q[i] = A[0][i];
if (0) {
/* w contains the eigenvalues */
printf ("\n");
for (i=0; i<4; i++ ) printf ("%8.3lf ", w[i]);
printf ("\nrmsd: %8.3lf \n", *rmsd);
printf ("quat:\n");
for (i=0; i<4; i++ ) printf ("%8.3lf ", q[i]);
printf ("\n");
/* printf (" opt lwork: %d\n", (int) work[0]); */
}
} else {
fprintf (stderr, "Error in dsyev().\n");
exit (1);
}
free_dmatrix(A);
return 0;
}
int main()
{
int i,z,d,w;
int billID, wordID, freq;
double sum;
double likelihood[10];
FILE *fp1 = fopen("../data/Bill_Term", "r");
FILE *fp2 = fopen("../data/Term_Bill", "r");
FILE *fpwrite = fopen("../Result/result6479/10topic_NoSeeds_zw", "w");
FILE *fpwrite2 = fopen("../Result/result6479/10topic_NoSeeds_zd", "w");
// initialize
double **n_dw1 = dmatrix(N_Bill_Term, 3);
double **n_dw2 = dmatrix(N_Bill_Term, 3);
double ***p_z_d = d3matrix(10, K, D);
double ***p_w_z = d3matrix(10, V, K);
// initialize n(d,w), p(z|d), p(w|z)
i = 0;
while (!feof(fp1))
{
fscanf(fp1, "%d\t%d\t%d\n", &billID, &wordID, &freq);
// n_dw[billID-1][wordID-1] = freq;
n_dw1[i][0] = billID;
n_dw1[i][1] = wordID;
n_dw1[i][2] = freq;
i++;
}
printf("%s%d\n%s%d\n", "i = ", i, "N_Bill_Term = ", N_Bill_Term);
i = 0;
while (!feof(fp2))
{
fscanf(fp2, "%d\t%d\t%d\n", &billID, &wordID, &freq);
n_dw2[i][0] = wordID;
n_dw2[i][1] = billID;
n_dw2[i][2] = freq;
i++;
}
printf("%s%d\n%s%d\n", "i = ", i, "N_Bill_Term = ", N_Bill_Term);
srand((unsigned)time(NULL));
for (i = 0; i < 10; i++)
{
for (d = 0; d < D; d++)
{
for (z = 0; z < K; z++)
p_z_d[i][z][d] = rand() / (double)RAND_MAX; // p(z|d)
// Normalization
sum = 0;
for (z = 0; z < K; z++)
sum += p_z_d[i][z][d];
if (sum != 0)
for (z = 0; z < K; z++)
p_z_d[i][z][d] /= sum;
else
printf("%s\n", "Need initialize again.");
sum = 0;
for (z = 0; z < K; z++)
sum += p_z_d[i][z][d];
if (fabs(sum-1)>0.0001) printf("%s\n", "abs(sum-1)>0.0001, Need initialize again.");
}
}
for (i = 0; i < 10; i++)
{
for (z = 0; z < K; z++)
{
for (w = 0; w < V; w++)
p_w_z[i][w][z] = rand() / (double)RAND_MAX; // p(w|z)
//Normalization
sum = 0;
for (w = 0; w < V; w++)
sum += p_w_z[i][w][z];
if (sum != 0)
for (w = 0; w < V; w++)
p_w_z[i][w][z] /= sum;
else
printf("%s\n", "Need initialize again.");
sum = 0;
for (w = 0; w < V; w++)
sum += p_w_z[i][w][z];
if (fabs(sum-1)>0.0001) printf("%s\n", "abs(sum-1)>0.0001, Need initialize again.");
}
}
// select the best one, after 50 iterations
for (i = 0; i < 10; i++)
{
printf("%s%d\n", "Initialization ", i);
pLSA(n_dw1, n_dw2, p_w_z[i], p_z_d[i], 50);
likelihood[i] = calLikelihood(n_dw1, p_z_d[i], p_w_z[i]);
printf("%s%d%s%f\n", "Likelihood", i, " is ", likelihood[i]);
}
int ml = 0;
for (i = 1; i < 10; i++)
if (likelihood[i] > likelihood[ml])
ml = i;
printf("%s%d\n", "ml = ", ml);
pLSA(n_dw1, n_dw2, p_w_z[ml], p_z_d[ml], 450);
// output
printf("%s\n", "Writing to file...");
// d: person, z: topic, w: bill
// topic-word
printf("%s\n", "p(w|z)");
for (z = 0; z < K; z++)
{
sum = 0;
for (w = 0; w < V; w++)
{
sum += p_w_z[ml][w][z];
fprintf(fpwrite, "%.12lf", p_w_z[ml][w][z]);
if (w != V-1)
fprintf(fpwrite, "%s", "\t");
}
printf("%lf\n", sum);
fprintf(fpwrite, "%s", "\n");
}
// topic-bill
printf("%s\n", "p(z|d)");
for (z = 0; z < K; z++)
{
for (d = 0; d < D; d++)
{
fprintf(fpwrite2, "%.12lf", p_z_d[ml][z][d]);
if (d != D-1)
fprintf(fpwrite2, "%s", "\t");
}
fprintf(fpwrite2, "%s", "\n");
}
// clear
fclose(fp1);
fclose(fp2);
fclose(fpwrite);
fclose(fpwrite2);
free_dmatrix(n_dw1, N_Bill_Term);
free_dmatrix(n_dw2, N_Bill_Term);
free_d3matrix(p_z_d, 10, K);
free_d3matrix(p_w_z, 10, V);
return 0;
}
int hibc(struct zint_symbol *symbol, unsigned char source[], int length)
{
int counter, error_number, i;
char to_process[40], temp[2], check_digit;
if(length > 36) {
strcpy(symbol->errtxt, "Data too long for HIBC LIC");
return ZINT_ERROR_TOO_LONG;
}
to_upper(source);
error_number = is_sane(TECHNETIUM , source, length);
if(error_number == ZINT_ERROR_INVALID_DATA) {
strcpy(symbol->errtxt, "Invalid characters in data");
return error_number;
}
strcpy(to_process, "+");
counter = 41;
for(i = 0; i < length; i++) {
counter += posn(TECHNETIUM, source[i]);
}
counter = counter % 43;
if(counter < 10) {
check_digit = itoc(counter);
} else {
if(counter < 36) {
check_digit = (counter - 10) + 'A';
} else {
switch(counter) {
case 36: check_digit = '-'; break;
case 37: check_digit = '.'; break;
case 38: check_digit = ' '; break;
case 39: check_digit = '$'; break;
case 40: check_digit = '/'; break;
case 41: check_digit = '+'; break;
case 42: check_digit = '%'; break;
default: check_digit = ' '; break; /* Keep compiler happy */
}
}
}
temp[0] = check_digit;
temp[1] = '\0';
concat(to_process, (char *)source);
concat(to_process, temp);
length = strlen(to_process);
switch(symbol->symbology) {
case BARCODE_HIBC_128:
error_number = code_128(symbol, (unsigned char *)to_process, length);
ustrcpy(symbol->text, (unsigned char*)"*");
uconcat(symbol->text, (unsigned char*)to_process);
uconcat(symbol->text, (unsigned char*)"*");
break;
case BARCODE_HIBC_39:
symbol->option_2 = 0;
error_number = c39(symbol, (unsigned char *)to_process, length);
ustrcpy(symbol->text, (unsigned char*)"*");
uconcat(symbol->text, (unsigned char*)to_process);
uconcat(symbol->text, (unsigned char*)"*");
break;
case BARCODE_HIBC_DM:
error_number = dmatrix(symbol, (unsigned char *)to_process, length);
break;
case BARCODE_HIBC_QR:
error_number = qr_code(symbol, (unsigned char *)to_process, length);
break;
case BARCODE_HIBC_PDF:
error_number = pdf417enc(symbol, (unsigned char *)to_process, length);
break;
case BARCODE_HIBC_MICPDF:
error_number = micro_pdf417(symbol, (unsigned char *)to_process, length);
break;
case BARCODE_HIBC_AZTEC:
error_number = aztec(symbol, (unsigned char *)to_process, length);
break;
}
return error_number;
}
/* ---------------------------------------------------------------------- */
int gencf (doublereal *par)
{
integer i, j, k;
doublereal s;
integer ic[5];
extern int ge(integer n, integer m1a, doublereal *a, integer nrhs, integer ndxloc, doublereal *u, integer m1f, doublereal *f, doublereal *det);
extern double **dmatrix(integer, integer);
integer ir[5];
doublereal det;
/* ---------- ----- */
/* ---------------------------------------------------------------------- */
/* ---------------------------------------------------------------------- */
/* ---------------------------------------------------------------------- */
/* ---------------------------------------------------------------------- */
/* brf : A parabolic PDE (the Brusselator) */
/* ---------------------------------------------------------------------- */
/* ---------------------------------------------------------------------- */
/* (Discretized in space by fourth order finite differences) */
/* ---------------------------------------------------------------------- */
/* ---------------------------------------------------------------------- */
/* NOTE: The values of the constants NE and NX are defined above. */
/* If they are changed then the equations-file brf.f must */
/* be rewritten with an editor or with the GUI Write button. */
/* NE : the dimension of the PDE system */
/* NX : the number of space intervals for the discretization */
/* The AUTO-constant NDIM must be set equal to the value of NE*(NX-1) */
/* ---------------------------------------------------------------------- */
/* ---------------------------------------------------------------------- */
/* Function Body */
blppde_1.d0 = dmatrix(5, 5);
blppde_1.d2 = dmatrix(5, 5);
blppde_1.di = dmatrix(5, 5);
blppde_1.dd = dmatrix(5, 5);
blppde_1.ri = dmatrix(5, 5);
for (i = 0; i < 5; ++i) {
for (j = 0; j < 5; ++j) {
blppde_1.d0[i][j] = 0.;
blppde_1.d2[i][j] = 0.;
blppde_1.di[i][j] = 0.;
blppde_1.dd[i][j] = 0.;
blppde_1.ri[i][j] = 0.;
/* L1: */
}
blppde_1.d0[i][i] = .83333333333333337;
blppde_1.d2[i][i] = -72.;
blppde_1.ri[i][i] = 1.;
/* L2: */
}
for (i = 0; i < 4; ++i) {
blppde_1.d0[i + 1][i] = .083333333333333329;
blppde_1.d0[i][i + 1] = .083333333333333329;
blppde_1.d2[i + 1][i] = 36.;
blppde_1.d2[i][i + 1] = 36.;
/* L3: */
}
ge(5, 5, *blppde_1.d0, 5, 5, *blppde_1.di, 5, *blppde_1.ri, &det);
for (i = 0; i < 5; ++i) {
for (j = 0; j < 5; ++j) {
s = 0.;
for (k = 0; k < 5; ++k) {
s += blppde_1.di[i][k] * blppde_1.d2[j][k];
/* L4: */
}
blppde_1.dd[i][j] = s;
/* L5: */
}
/* L6: */
}
return 0;
}
