SEXP seqlib_gen_tile(SEXP Rsequence,SEXP Rlen,SEXP Rstep,SEXP Rcircular)
{
sequence_tp *ms,*oligo;
int cnt,pos,len,olen=60,step=1,circular=0,i=0;
SEXP res;
char *seqstring;
if(!isString(Rsequence) || length(Rsequence) != 1)
error("gen_tile: sequence is not a single string");
if (!isInteger(Rlen) || length(Rlen) != 1)
error("gen_tile: len value must be single int");
if (!isInteger(Rstep) || length(Rstep) != 1)
error("gen_tile: step value must be single int");
if (!isInteger(Rcircular) || length(Rcircular) != 1)
error("gen_tile: circular value must be single int");
olen = INTEGER(Rlen)[0];
step = INTEGER(Rstep)[0];
circular = INTEGER(Rcircular)[0];
if (olen < 1)
error("gen_tile: length value must be 1 or higher");
if (step < 1)
error("gen_tile: step value must be 1 or higher");
ms = sequence_from_string(CHAR(STRING_ELT(Rsequence,i)));
len = sequence_length(ms);
if (len < olen)
{
sequence_free(ms);
error("gen_tile: tile len must be smaller than sequence length");
}
if (circular)
cnt = 1+ (len-1)/step;
else
cnt = 1+(len-olen)/step;
pos = 1;
seqstring= (char*)malloc(sizeof(char)*olen);
PROTECT(res = allocVector(STRSXP,cnt));
while (pos+olen-1 <= len)
{
oligo = sequence_select_part(ms,pos,pos+olen-1);
SET_STRING_ELT(res,i,mkChar(sequence_chars(oligo,seqstring)));
sequence_free(oligo);
pos = pos+step;
i++;
}
if (circular)
{
while (pos <= len)
{
oligo = sequence_select_part(ms,pos,len);
sequence_append(oligo,sequence_select_part(ms,1,olen-(len-pos)-1));
SET_STRING_ELT(res,i,mkChar(sequence_chars(oligo,seqstring)));
sequence_free(oligo);
pos = pos+step;
i++;
}
}
free(seqstring);
UNPROTECT(1);
return res;
}
int scrambling_stop(scrambling_hl* hl) {
int i;
for (i=0;i<NSUBFRAMES_X_FRAME;i++) {
sequence_free(&hl->obj.seq[i]);
}
return 0;
}
double mm_logprob (mm_model *mm, char *format, dataset *d)
{
// printf ("Calculating MM probability on test files (%s): ", dataset_filename);
double logprob = 0;
int outputsymbols = 0;
for (int entry = 0; entry < d->entries; entry++)
{
// printf ("%d ", test_filename_number);
sequence_data *s = sequence_read (mm->model_name, format, d->filenames[entry]);
/* calculate cross-entropy over file */
int *state = NULL;
if (mm->model_column == 0)
{
state = s->hidden;
}
else if (mm->model_column == 1)
{
state = s->visible;
}
if (mm->model_column >= 0)
{
double logp_initial = gsl_vector_get (mm->logp_initial, state[0]);
logprob += logp_initial;
}
else
{
logprob += gsl_matrix_get (mm->logp_transition, s->hidden[0], s->visible[0]);
}
for (int t = 1; t < s->sequencelength; t++)
{
double logp_transition;
if (mm->model_column >= 0)
{
logp_transition = gsl_matrix_get (mm->logp_transition, state[t], state[t-1]);
}
else
{
logp_transition = gsl_matrix_get (mm->logp_transition, s->hidden[0], s->visible[0]);
}
logprob += logp_transition;
}
outputsymbols += s->sequencelength;
sequence_free (s);
}
// printf ("%f %d\n", logprob, outputsymbols);
return logprob / outputsymbols;
}
mm_model *mm_orderzero_train (char *model_name, dataset *d, int model_column)
{
mm_model *mm = mm_new (model_name, model_column);
/* initialise GSL probability matrices of these sizes */
mm->p_initial = gsl_vector_calloc (mm->inputstates);
mm->logp_initial = gsl_vector_calloc (mm->inputstates);
mm->p_transition = 0;
mm->logp_transition = 0;
/* loop through files in dataset */
// printf ("Training MM from input files: ");
for (int entry = 0; entry < d->entries; entry++)
{
// printf ("%d ", training_filename_number);
sequence_data *s = sequence_read (model_name, DATAFILE_FORMAT, d->filenames[entry]);
int *state;
if (model_column == 0)
{
state = s->hidden;
}
else
{
state = s->visible;
}
/* train probability matrices */
for (int t = 0; t < s->sequencelength; t++)
{
double n = gsl_vector_get (mm->p_initial, state[t]) + 1.;
gsl_vector_set (mm->p_initial, state[t], n);
}
sequence_free (s);
}
// printf ("\n\n");
/* smooth (add-k), normalise, precalculate logs */
vector_smooth_normalise_log (mm->p_initial, mm->logp_initial);
mm->normalised_flag = 1;
return mm;
}
/* Delete an alignment object */
void align_free(align_t *ali) {
sequence_t **p;
if (ali == NULL) { return; }
p = ali->seq;
while (p && *p) {
sequence_free(*p);
p++; }
free(ali->seq);
free(ali->_tmp);
free(ali);
return; }
SEXP seqlib_read_fasta(SEXP filename)
{
FILE *df;
int i,cnt,sl,maxlen=0;
sequence_tp *ds;
SEXP res,names;
char comment[SEQUENCE_MAX_COMMENT_LEN], *seqstring;
if(!isString(filename) || length(filename) != 1)
error("filename is not a single string");
df = fopen(CHAR(STRING_ELT(filename, 0)),"r");
if (!df)
{
error("can not open file");
}
cnt =0;
sequence_catch_warning(warning_stub);
while ((ds=sequence_read_fasta(df,comment,SEQ_TYPE_4BIT)))
{
sl = sequence_length(ds);
if (sl > maxlen)
maxlen = sl;
sequence_free(ds);
cnt++;
}
if (cnt)
{
rewind(df);
seqstring= (char*)malloc(sizeof(char)*(maxlen+1));
PROTECT(res = allocVector(STRSXP,cnt));
PROTECT(names = allocVector(VECSXP, cnt));
for (i=0; i< cnt; i++)
{
ds=sequence_read_fasta(df,comment,SEQ_TYPE_4BIT);
SET_STRING_ELT(res,i,mkChar(sequence_chars(ds,seqstring)));
SET_VECTOR_ELT(names,i,mkChar(comment));
}
free(seqstring);
setAttrib(res, R_NamesSymbol, names);
UNPROTECT(2);
}
else
{
error("can not open file");
}
fclose(df);
return res;
}
int single_state_coin_toss()
{
state single_state;
model my_model;
double symbols_single_state[2]={0.5,0.5};
double trans_prob_single_state[1]={1.0};
double trans_prob_single_state_rev[1]={1.0};
int trans_id_single_state[1]={0};
sequence_t* my_output;
int silent_array[2] = {0};
my_model.model_type = 0;
/* initialise this state */
single_state.pi = 1.0;
single_state.b=symbols_single_state;
single_state.out_states=1;
single_state.out_a=trans_prob_single_state;
single_state.out_id=trans_id_single_state;
single_state.in_states=1;
single_state.in_id=trans_id_single_state;
single_state.in_a=trans_prob_single_state_rev;
single_state.fix=1;
/* initialise model */
my_model.N=1;
my_model.M=2;
my_model.s=&single_state;
my_model.prior=-1;
my_model.silent = silent_array;
fprintf(stdout,"transition matrix:\n");
model_A_print(stdout,&my_model,""," ","\n");
fprintf(stdout,"observation symbol matrix:\n");
model_B_print(stdout,&my_model,""," ","\n");
my_output=model_generate_sequences(&my_model,0,10,10,100);
sequence_print(stdout,my_output);
sequence_free(&my_output);
return 0;
}
double mm_orderzero_logprob (mm_model *mm, char *format, dataset *d)
{
// printf ("Calculating zero-order MM probability on test files (%s): ", dataset_filename);
double logprob = 0;
int outputsymbols = 0;
for (int entry = 0; entry < d->entries; entry++)
{
// printf ("%d ", test_filename_number);
sequence_data *s = sequence_read (mm->model_name, DATAFILE_FORMAT, d->filenames[entry]);
int *state;
if (mm->model_column == 0)
{
state = s->hidden;
}
else
{
state = s->visible;
}
/* calculate cross-entropy over file */
for (int t = 0; t < s->sequencelength; t++)
{
double logp = gsl_vector_get (mm->logp_initial, state[t]);
outputsymbols++;
logprob += logp;
}
sequence_free (s);
}
// printf ("%f %d\n", logprob, outputsymbols);
return logprob / outputsymbols;
}
void pbch_free(pbch_t *q) {
if (q->pbch_d) {
free(q->pbch_d);
}
int i;
for (i = 0; i < q->cell.nof_ports; i++) {
if (q->ce[i]) {
free(q->ce[i]);
}
if (q->pbch_x[i]) {
free(q->pbch_x[i]);
}
if (q->pbch_symbols[i]) {
free(q->pbch_symbols[i]);
}
}
if (q->pbch_llr) {
free(q->pbch_llr);
}
if (q->temp) {
free(q->temp);
}
if (q->pbch_rm_f) {
free(q->pbch_rm_f);
}
if (q->pbch_rm_b) {
free(q->pbch_rm_b);
}
if (q->data_enc) {
free(q->data_enc);
}
if (q->data) {
free(q->data);
}
sequence_free(&q->seq_pbch);
modem_table_free(&q->mod);
viterbi_free(&q->decoder);
}
int main(int argc, char **argv) {
int i;
sequence_t seq;
char *input_b, *scrambled_b;
float *input_f, *scrambled_f;
parse_args(argc, argv);
if (init_sequence(&seq, sequence_name) == -1) {
fprintf(stderr, "Error initiating sequence %s\n", sequence_name);
exit(-1);
}
if (!do_floats) {
input_b = malloc(sizeof(char) * seq.len);
if (!input_b) {
perror("malloc");
exit(-1);
}
scrambled_b = malloc(sizeof(char) * seq.len);
if (!scrambled_b) {
perror("malloc");
exit(-1);
}
for (i=0;i<seq.len;i++) {
input_b[i] = rand()%2;
scrambled_b[i] = input_b[i];
}
scrambling_b(&seq, scrambled_b);
scrambling_b(&seq, scrambled_b);
for (i=0;i<seq.len;i++) {
if (scrambled_b[i] != input_b[i]) {
printf("Error in %d\n", i);
exit(-1);
}
}
free(input_b);
free(scrambled_b);
} else {
input_f = malloc(sizeof(float) * seq.len);
if (!input_f) {
perror("malloc");
exit(-1);
}
scrambled_f = malloc(sizeof(float) * seq.len);
if (!scrambled_f) {
perror("malloc");
exit(-1);
}
for (i=0;i<seq.len;i++) {
input_f[i] = 100*(rand()/RAND_MAX);
scrambled_f[i] = input_f[i];
}
scrambling_f(&seq, scrambled_f);
scrambling_f(&seq, scrambled_f);
for (i=0;i<seq.len;i++) {
if (scrambled_f[i] != input_f[i]) {
printf("Error in %d\n", i);
exit(-1);
}
}
free(input_f);
free(scrambled_f);
}
printf("Ok\n");
sequence_free(&seq);
exit(0);
}
int main(int argc, char **argv){
FILE *IN, *OUT;
seqlist_t IDs;
sequence_t *seq;
int i, keep, excl;
char *prog, *list, *f, *out, *id;
/* todo convert to uint_64 */
uint64_t n, total;
/* default values */
prog = basename(*argv);
list = NULL;
out = NULL;
OUT = stdout;
excl = keep = 0;
/* Check command line */
while ((i = getopt(argc, argv, "hl:o:x")) != -1) {
switch (i) {
case 'h':
usage(prog, EXIT_SUCCESS); break;
case 'l':
list = optarg; break;
case 'o':
out = optarg; break;
case 'x':
excl = 1; break;
default:
usage(prog, EXIT_FAILURE);
}
}
/* some files to deal with ? */
if (argc - optind < 1) { usage(prog, EXIT_FAILURE); }
/* get ids from list */
if (list != NULL) {
if ((IN = fopen(list, "r")) == NULL)
err(EXIT_FAILURE, "%s", list);
seqlist_init(&IDs);
i = seqlist_populate(&IDs, IN);
if (i == 0) errx(EXIT_FAILURE, "file: %s no identifier found", list);
if (fclose(IN) == EOF) err(EXIT_FAILURE, "%s: close failed", list);
seqlist_sort(&IDs);
}
/* open output file */
if ((out != NULL) && ((OUT = fopen(out, "w")) == NULL))
err(EXIT_FAILURE, "%s", out);
total = n = 0;
/* start filtering all argument file*/
for (i = optind; i < argc; i++) {
f = *(argv+i);
if ((IN = fopen(f, "r")) == NULL) err(EXIT_FAILURE, "%s", f);
while ((seq = sequence_parse(IN, SEQFMT_FASTA)) != NULL) {
total++;
id = seq->nam;
keep = 1;
if (list != NULL) { keep = 1 - seqlist_chk(&IDs, id); }
if (excl == 1) { keep = 1 - keep; }
if (keep == 1) { n++; sequence_print(OUT, seq, SEQFMT_FASTA); }
sequence_free(seq);
}//end while
/* check for parsing error vs EOF */
if ((feof(IN) == 0) || (total == 0)){
errx(1, "%s: unable to read sequence %d", f, total+1);
}
if (fclose(IN) == EOF) err(EXIT_FAILURE, "%s: close failed", f);
}//end for files
if ((out != NULL) && (fclose(OUT) == EOF)) err(EXIT_FAILURE, "%s", out);
if (list != NULL) seqlist_fini(&IDs);
/*display resume on stderr */
fprintf(stderr, "file %s: Extracted %"PRI_U64" from %"PRI_U64" sequences (%.2f %%)\n" ,
basename(f), n , total, (float)(n)/total*100.0);
return EXIT_SUCCESS;
}
void testBaumwelch(){
int i, error, tl,z,z1,z2;
double log_p,first_prob1,first_prob2, first_prob;
double *proba;
int *path;
int* real_path;
int *path1;
int* real_path1;
int *path2;
int* real_path2;
model *mo = NULL;
sequence_t *my_output, *your_output;
int seqlen = 1000;
tl = 150;
mo = malloc(sizeof(model));
if (mo==NULL) {fprintf(stderr,"Null Pointer in malloc(model).\n");}
real_path = malloc(seqlen*sizeof(double));
if(!real_path){ printf("real_path hat kein platz gekriegt\n");}
real_path1 = malloc(seqlen*sizeof(double));
if(!real_path1){ printf("real_path hat kein platz gekriegt\n");}
real_path2 = malloc(seqlen*sizeof(double));
if(!real_path2){ printf("real_path hat kein platz gekriegt\n");}
/* generate a model with variable number of states*/
generateModel(mo, 5);
/*generate a random sequence*/
my_output = model_label_generate_sequences(mo, 0, seqlen, 10, seqlen);
for (i=0; i<seqlen; i++){
printf("%d", my_output->state_labels[0][i]);
}
printf("\n");
/*viterbi*/
path = viterbi(mo, my_output->seq[0], my_output->seq_len[0], &first_prob);
path1 = viterbi(mo, my_output->seq[1], my_output->seq_len[1], &first_prob1);
path2 = viterbi(mo, my_output->seq[2], my_output->seq_len[2], &first_prob2);
printf("\n viterbi-path\n");
z=0;
z1=0;
z2=0;
for (i=0; i<my_output->seq_len[0]; i++){
if (path1[i] != -1) {
real_path1[z1]=path1[i];
z1++;
printf("%d", path1[i]);
}
else printf("hallo");
if (path2[i] != -1) {
real_path2[z2]=path2[i];
z2++;
printf("%d", path2[i]);
}
else printf("hallo");
if (path[i] != -1) {
real_path[z]=path[i];
z++;
printf("%d", path[i]);
}
}
printf("\n");
printf("log-prob: %g\n",first_prob);
my_output->state_labels[0]=real_path;
my_output->state_labels[1]=real_path1;
my_output->state_labels[2]=real_path2;
for (i=0;i<seqlen;i++)
printf("realpath[%i]=%i",i,real_path[i]);
proba = malloc(sizeof(double)*tl);
printf("No of Sequences = %d", my_output->seq_number);
your_output = model_label_generate_sequences(mo, 0, seqlen, 1, seqlen);
error = gradient_descent(&mo, your_output, .02, i);
path = viterbi(mo, my_output->seq[0], my_output->seq_len[0], &log_p);
free(path);
/*reestimate_baum_welch_label(mo, my_output);*/
/*reestimate_baum_welch(mo, my_output);*/
/*reruns viterbi to check the training*/
printf("run viterbi second\n");
path = viterbi(mo, my_output->seq[0], my_output->seq_len[0], &log_p);
for (i=0; i<(my_output->seq_len[0]*mo->N); i++){
if (path[i] != -1) {printf("%d", path[i]);}
}
printf("\n");
printf("log-prob: %g\n",log_p);
/* freeing memory */
model_free(&mo);
free(path);
/*printf("sequence_free success: %d\n", */sequence_free(&my_output)/*)*/;
free(my_output);
}
int two_states_coin_toss()
{
model my_model;
state model_states[2];
double symbols_head_state[2]={1.0,0.0};
double trans_prob_head_state[2]={0.5,0.5};
double trans_prob_head_state_rev[2]={0.5,0.5};
int trans_id_head_state[2]={0,1};
double symbols_tail_state[2]={0.0,1.0};
double trans_prob_tail_state[2]={0.5,0.5};
double trans_prob_tail_state_rev[2]={0.5,0.5};
int trans_id_tail_state[2]={0,1};
sequence_t *my_output;
double log_p_viterbi, log_p_forward;
double **forward_alpha;
double forward_scale[10];
int *viterbi_path;
int i;
/* flags indicating whether a state is silent */
int silent_array[2] = {0,0};
my_model.model_type = 0;
/* initialise head state */
model_states[0].pi = 0.5;
model_states[0].b=symbols_head_state;
model_states[0].out_states=2;
model_states[0].out_a=trans_prob_head_state;
model_states[0].out_id=trans_id_head_state;
model_states[0].in_states=2;
model_states[0].in_id=trans_id_head_state;
model_states[0].in_a=trans_prob_head_state_rev;
model_states[0].fix=1;
/* initialise tail state */
model_states[1].pi = 0.5;
model_states[1].b=symbols_tail_state;
model_states[1].out_states=2;
model_states[1].out_id=trans_id_tail_state;
model_states[1].out_a=trans_prob_tail_state;
model_states[1].in_states=2;
model_states[1].in_id=trans_id_tail_state;
model_states[1].in_a=trans_prob_tail_state_rev;
model_states[1].fix=1;
/* initialise model */
my_model.N=2;
my_model.M=2;
my_model.s=model_states;
my_model.prior=-1;
my_model.silent = silent_array;
fprintf(stdout,"transition matrix:\n");
model_A_print(stdout,&my_model,""," ","\n");
fprintf(stdout,"observation symbol matrix:\n");
model_B_print(stdout,&my_model,""," ","\n");
my_output=model_generate_sequences(&my_model,0,10,10,100);
sequence_print(stdout,my_output);
/* try viterbi algorithm in a clear situation */
viterbi_path=viterbi(&my_model,
my_output->seq[0],
my_output->seq_len[0],
&log_p_viterbi);
if (viterbi_path==NULL)
{fprintf(stderr,"viterbi failed!"); return 1;}
fprintf(stdout,"viterbi:\n");
for(i=0;i<my_output->seq_len[0];i++){
printf(" %d, ", viterbi_path[i]);
}
printf("\n");
fprintf(stdout,
"log-p of this sequence (viterbi algorithm): %f\n",
log_p_viterbi);
/* allocate matrix for forward algorithm */
fprintf(stdout,"applying forward algorithm to the sequence...");
forward_alpha=stat_matrix_d_alloc(10,2);
if (forward_alpha==NULL)
{
fprintf(stderr,"\n could not alloc forward_alpha matrix\n");
return 1;
}
/* run foba_forward */
if (foba_forward(&my_model,
my_output->seq[0],
my_output->seq_len[0],
forward_alpha,
forward_scale,
&log_p_forward))
{
fprintf(stderr,"foba_logp failed!");
stat_matrix_d_free(&forward_alpha);
return 1;
}
/* alpha matrix */
fprintf(stdout,"Done.\nalpha matrix from forward algorithm:\n");
matrix_d_print(stdout,forward_alpha,10,2,""," ","\n");
fprintf(stdout,"log-p of this sequence (forward algorithm): %f\n",log_p_forward);
/* clean up */
sequence_free(&my_output);
free(viterbi_path);
stat_matrix_d_free(&forward_alpha);
return 0;
}
int main (int argc, char **argv) {
toptions *opt;
tsequence *seq;
treadseq *rs = NULL;
ttokenizer *tokenizer = NULL;
char *command;
opt = (toptions *) calloc(1,sizeof(toptions));
init_defaults(opt);
process_args(opt, 0, argc, argv);
if (!opt->terminate) {
if (optind < argc) rs = readseq_open(READSEQ_STRING, argv[optind]);
else if (opt->inputfile) rs = readseq_open(READSEQ_FILE, opt->inputfile);
else if (!isatty(fileno(stdin))) rs = readseq_open(READSEQ_STDIN, NULL);
else {
printf("Interactive mode. Try `./RNAfold -h` for more information.\n", argv[0]);
rl_init();
opt->interactive = 1;
opt->colored_output = 1 - opt->colored_output;
tokenizer = tokenizer_new();
rs = readseq_open(READSEQ_STRING, "");
}
while (1) {
if (opt->interactive) {
if (opt->colored_output)
printf("%s\nInput sequence (upper or lower case); :q to quit, -h for help.\n....,....1....,....2....,....3....,....4....,....5....,....6....,....7....,....8\n%s",COLOR_RED,COLOR_DEFAULT);
else
printf("\nInput sequence (upper or lower case); :q to quit, -h for help.\n....,....1....,....2....,....3....,....4....,....5....,....6....,....7....,....8\n");
command = rl_gets();
if (!command || (command[0] == '@') || ((command[0] == ':') && (command[1] == 'q'))) {
pcolor(opt->colored_output,COLOR_BLUE);
printf("Leaving RNAfold.");
pcolor(opt->colored_output,COLOR_DEFAULT);
printf("\n");
exit(0);
}
else if (command[0] == ':') {
pcolor(opt->colored_output,COLOR_BLUE);
if (command[1] == 's') print_settings(opt);
if (command[1] == 'd') {
init_defaults(opt);
opt->colored_output = 1;
opt->interactive = 1;
printf("Activated default configuration.\n");
pcolor(opt->colored_output,COLOR_DEFAULT);
}
if (command[1] == 'e') {
system(command + 2);
}
if (command[1] == 'r') {
system("make update");
system("./RNAfold");
exit(0);
}
}
else if (command[0] == '-') {
tokenizer_exec(tokenizer, argv[0], command);
process_args(opt, 1, tokenizer->count, tokenizer->token);
if (opt->inputfile) {
rs = readseq_free(rs);
rs = readseq_open(READSEQ_FILE, opt->inputfile);
}
free(opt->inputfile);
opt->inputfile = NULL;
}
else {
rs = readseq_free(rs);
rs = readseq_open(READSEQ_STRING, command);
}
}
while (1) {
seq = readseq_next_fasta(rs);
if (!(seq->success)) break;
if (1) {
main_rnafold_mfe(opt, seq);
}
sequence_free(seq);
}
if (!opt->interactive) break;
}
}
exit(0);
}
SEXP sequence_clean(SEXP seqs,SEXP seqno,SEXP qstart,SEXP qstop,SEXP min_len)
{
sequence_tp **results,*ms;
int i,nb_cuts,nb_seqs,cidx,nb_res,qs,qe,cp,ml,maxlen = 0,seq_name_len,pcnt,*sorttab;
char *seqstring,**rnames;
const char *seq_name;
SEXP res,names;
#if DEBUG
fprintf(stderr,"Cleaning\n");
#endif
if(!isString(seqs))
error("sequence must have character type");
if (!isInteger(seqno))
error("seqno value must be integer");
if (!isInteger(qstart))
error("start-values must be integer");
if (!isInteger(qstop))
error("start-values must be integer");
if (!isInteger(min_len) || (length(min_len) != 1))
error("start-values must be a single integer");
nb_cuts = length(seqno);
if ((length(qstop) != nb_cuts) || (length(qstart) != nb_cuts))
error("non-equal number of sequence references and start/stop-positions.");
nb_seqs = length(seqs);
results = (sequence_tp**)malloc(sizeof(sequence_tp*)*nb_seqs*3);
rnames = (char**)malloc(sizeof(char*)*nb_seqs*3);
nb_res = 0;
cidx = 0;
ml = INTEGER(min_len)[0];
for (i=0; i<nb_cuts; i++)
INTEGER(seqno)[i]--;
#if DEBUG
fprintf(stderr,"Sorting \n");
#endif
sorttab = (int*)malloc(sizeof(int)*nb_cuts);
for (i=0; i<nb_cuts; i++) sorttab[i] = i;
sort_cut_list(seqno,qstart,qstop,sorttab);
#if DEBUG
fprintf(stderr,"Done sorting \n");
#endif
for (i=0; i<nb_seqs; i++)
{
pcnt=1;
seq_name = CHAR(STRING_ELT(getAttrib(seqs,R_NamesSymbol), i));
seq_name_len = strlen(seq_name);
ms = sequence_from_string(CHAR(STRING_ELT(seqs,i)));
#if DEBUG
fprintf(stderr,"Doing sequence %d/%d: (1-%d)\n",i,nb_seqs,sequence_length(ms));
#endif
if ((cidx < nb_cuts) && (INTEGER(seqno)[cidx] == i))
{
cp = 1;
while ((INTEGER(seqno)[cidx] == i) && (cidx < nb_cuts))
{
qs = INTEGER(qstart)[sorttab[cidx]];
qe = INTEGER(qstop)[sorttab[cidx]];
if ((qs -cp) > ml)
{
results[nb_res] = sequence_select_part(ms,cp,qs-1);
rnames[nb_res] = (char*)malloc(sizeof(char)*(seq_name_len+5));
sprintf(rnames[nb_res],"%s_p%d",seq_name,pcnt++);
#if DEBUG
fprintf(stderr,"Add result %d : %d (%d-%d)\n",nb_res,i,cp,qs-1);
#endif
nb_res++;
}
if ((qe+1) > cp) cp = qe+1;
cidx++;
}
if ((sequence_length(ms)-cp) >= ml)
{
results[nb_res] = sequence_select_part(ms,cp,sequence_length(ms));
rnames[nb_res] = (char*)malloc(sizeof(char)*(seq_name_len+5));
sprintf(rnames[nb_res],"%s_p%d",seq_name,pcnt);
#if DEBUG
fprintf(stderr,"Add tail %d : %d (%d-%d)\n",nb_res,i,cp,sequence_length(ms));
#endif
nb_res++;
}
sequence_free(ms);
}
else
{
results[nb_res] = ms;
#if DEBUG
fprintf(stderr,"Not cutting sequence %d\n",i);
#endif
rnames[nb_res] = (char*)malloc(sizeof(char)*(seq_name_len+5));
sprintf(rnames[nb_res],"%s",seq_name);
nb_res++;
}
}
for (i=0; i<nb_res; i++)
if (sequence_length(results[i]) > maxlen) { maxlen = sequence_length(results[i]);}
maxlen+=10;
PROTECT(res = allocVector(STRSXP,nb_res));
PROTECT(names = allocVector(VECSXP, nb_res));
seqstring= (char*)malloc(sizeof(char)*(maxlen));
for (i=0; i< nb_res; i++)
{
#if DEBUG
fprintf(stderr,"setting sequence %d \n",i);
#endif
SET_STRING_ELT(res,i,mkChar(sequence_chars(results[i],seqstring)));
SET_VECTOR_ELT(names,i,mkChar(rnames[i]));
}
free(seqstring);
free(sorttab);
for (i=0; i<nb_res; i++)
{
free(rnames[i]);
sequence_free(results[i]);
}
free(results);
free(rnames);
setAttrib(res, R_NamesSymbol, names);
UNPROTECT(2);
#if DEBUG
fprintf(stderr,"Done cleaning\n");
#endif
return res;
}
