/*
* ------------------------------------------------------------------------
*
* "rcqpCmd_attribute_size(SEXP inAttribute)" --
*
*
*
* ------------------------------------------------------------------------
*/
SEXP rcqpCmd_attribute_size(SEXP inAttribute)
{
SEXP result = R_NilValue;
char * a;
Attribute * attribute;
int size;
int found = 0;
if (!isString(inAttribute) || length(inAttribute) != 1) error("argument 'attribute' must be a string");
PROTECT(inAttribute);
a = (char*)CHAR(STRING_ELT(inAttribute,0));
/* Need to try all possible attribute types */
attribute = cqi_lookup_attribute(a, ATT_POS);
if (attribute != NULL) {
size = cl_max_cpos(attribute);
if (size < 0) {
UNPROTECT(1);
rcqp_send_error();
} else {
found = 1;
}
} else {
attribute = cqi_lookup_attribute(a, ATT_STRUC);
if (attribute != NULL) {
size = cl_max_struc(attribute);
if (size < 0) {
size = 0;
} else {
found = 1;
}
} else {
attribute = cqi_lookup_attribute(a, ATT_ALIGN);
if (attribute != NULL) {
size = cl_max_alg(attribute);
if (size < 0) {
UNPROTECT(1);
rcqp_send_error();
} else {
found = 1;
}
} else {
UNPROTECT(1);
rcqp_error_code(cqi_errno);
}
}
}
if (found) {
result = PROTECT(allocVector(INTSXP, 1));
INTEGER(result)[0] = size;
}
UNPROTECT(2);
return result;
}
void
do_cqi_cl_attribute_size(void)
{
char *a;
Attribute *attribute;
int size;
a = cqi_read_string(); /* need to try all possible attribute types */
if (server_debug)
Rprintf( "CQi: CQI_CL_ATTRIBUTE_SIZE('%s')\n", a);
attribute = cqi_lookup_attribute(a, ATT_POS);
if (attribute != NULL) {
size = cl_max_cpos(attribute);
if (size < 0) {
send_cl_error();
}
else {
cqi_data_int(size);
}
}
else {
attribute = cqi_lookup_attribute(a, ATT_STRUC);
if (attribute != NULL) {
size = cl_max_struc(attribute);
if (size < 0) {
/* send_cl_error(); */
/* current version of CL considers 0 regions a data access error condition, but we want to allow that */
cqi_data_int(0);
}
else {
cqi_data_int(size);
}
}
else {
attribute = cqi_lookup_attribute(a, ATT_ALIGN);
if (attribute != NULL) {
size = cl_max_alg(attribute);
if (size < 0) {
send_cl_error();
}
else {
cqi_data_int(size);
}
}
else {
cqi_command(cqi_errno); /* return errno from the last lookup */
}
}
}
free(a);
}
void
do_cqi_cl_cpos2str(void)
{
int *cposlist;
int len, i;
char *a, *str;
Attribute *attribute;
a = cqi_read_string();
len = cqi_read_int_list(&cposlist);
if (server_debug) {
fprintf(stderr, "CQi: CQI_CL_CPOS2STR('%s', [", a);
for (i=0; i<len; i++)
fprintf(stderr, "%d ", cposlist[i]);
fprintf(stderr, "])\n");
}
attribute = cqi_lookup_attribute(a, ATT_POS);
if (attribute == NULL) {
cqi_command(cqi_errno);
}
else {
/* we assemble the CQI_DATA_STRING_LIST() return command by hand,
so we don't have to allocate a temporary list */
cqi_send_word(CQI_DATA_STRING_LIST);
cqi_send_int(len); /* list size */
for (i=0; i<len; i++) {
str = cl_cpos2str(attribute, cposlist[i]);
cqi_send_string(str); /* sends "" if str == NULL (cpos out of range) */
}
}
cqi_flush();
if (cposlist != NULL)
free(cposlist); /* don't forget to free allocated memory */
free(a);
}
void
do_cqi_cl_struc2str(void)
{
int *struclist;
int len, i;
char *a, *str;
Attribute *attribute;
a = cqi_read_string();
len = cqi_read_int_list(&struclist);
if (server_debug) {
Rprintf( "CQi: CQI_CL_STRUC2STR('%s', [", a);
for (i=0; i<len; i++)
Rprintf( "%d ", struclist[i]);
Rprintf( "])\n");
}
attribute = cqi_lookup_attribute(a, ATT_STRUC);
if (attribute == NULL) {
cqi_command(cqi_errno);
}
else {
/* we assemble the CQI_DATA_STRING_LIST() return command by hand,
so we don't have to allocate a temporary list */
cqi_send_word(CQI_DATA_STRING_LIST);
cqi_send_int(len); /* list size */
for (i=0; i<len; i++) {
str = cl_struc2str(attribute, struclist[i]);
cqi_send_string(str); /* sends "" if str == NULL (wrong alignment number) */
}
}
cqi_flush();
if (struclist != NULL)
free(struclist); /* don't forget to free allocated memory */
free(a);
}
/*
* ------------------------------------------------------------------------
*
* "rcqpCmd_struc2cpos(SEXP inAttribute, SEXP inStruc)" --
*
*
*
* ------------------------------------------------------------------------
*/
SEXP rcqpCmd_struc2cpos(SEXP inAttribute, SEXP inStruc)
{
SEXP result = R_NilValue;
int struc, start, end;
char * a;
Attribute * attribute;
if (!isString(inAttribute) || length(inAttribute) != 1) error("argument 'attribute' must be a string");
PROTECT(inAttribute);
if (!isVector(inStruc) || length(inStruc) != 1) error("argument 'struc' must be an integer");
PROTECT(inStruc);
a = (char*)CHAR(STRING_ELT(inAttribute,0));
struc = INTEGER(inStruc)[0];
attribute = cqi_lookup_attribute(a, ATT_STRUC);
if (attribute == NULL) {
UNPROTECT(2);
rcqp_error_code(cqi_errno);
} else {
if (cl_struc2cpos(attribute, struc, &start, &end)) {
result = PROTECT(allocVector(INTSXP, 2));
INTEGER(result)[0] = start;
INTEGER(result)[1] = end;
} else {
UNPROTECT(2);
rcqp_send_error(cqi_errno);
}
}
UNPROTECT(3);
return result;
}
void
do_cqi_cl_id2cpos(void)
{
int *cposlist;
int len, id;
char *a;
Attribute *attribute;
a = cqi_read_string();
id = cqi_read_int();
if (server_debug)
Rprintf( "CQi: CQI_CL_ID2CPOS('%s', %d)\n", a, id);
attribute = cqi_lookup_attribute(a, ATT_POS);
if (attribute == NULL) {
cqi_command(cqi_errno);
}
else {
cposlist = cl_id2cpos(attribute, id, &len);
if (cposlist == NULL)
send_cl_error();
else {
cqi_data_int_list(cposlist, len);
free(cposlist);
}
}
free(a); /* don't forget to free allocated space */
}
void
do_cqi_cl_idlist2cpos(void)
{
int *idlist, *cposlist;
int i, len, cposlen;
char *a;
Attribute *attribute;
a = cqi_read_string();
len = cqi_read_int_list(&idlist);
if (server_debug) {
Rprintf( "CQi: CQI_CL_IDLIST2CPOS('%s', [", a);
for (i=0; i<len; i++)
Rprintf( "%d ", idlist[i]);
Rprintf( "])\n");
}
attribute = cqi_lookup_attribute(a, ATT_POS);
if (attribute == NULL) {
cqi_command(cqi_errno);
}
else {
cposlist = cl_idlist2cpos(attribute, idlist, len, 1, &cposlen);
if (cposlist == NULL)
send_cl_error();
else {
cqi_data_int_list(cposlist, cposlen);
free(cposlist);
}
}
cqi_flush();
if (idlist != NULL)
free(idlist); /* don't forget to free allocated memory */
free(a);
}
void
do_cqi_cl_regex2id(void)
{
int *idlist;
int len;
char *a, *regex;
Attribute *attribute;
a = cqi_read_string();
regex = cqi_read_string();
if (server_debug)
Rprintf( "CQi: CQI_CL_REGEX2ID('%s', '%s')\n", a, regex);
attribute = cqi_lookup_attribute(a, ATT_POS);
if (attribute == NULL) {
cqi_command(cqi_errno);
}
else {
idlist = cl_regex2id(attribute, regex, 0, &len);
if (idlist == NULL) {
if (cderrno != CDA_OK)
send_cl_error();
else
cqi_data_int_list(NULL, 0); /* no matches -> zero size list */
}
else {
cqi_data_int_list(idlist, len);
free(idlist);
}
}
free(regex);
free(a); /* don't forget to free allocated space */
}
/*
* ------------------------------------------------------------------------
*
* "rcqpCmd_lexicon_size(SEXP inAttribute)" --
*
*
*
* ------------------------------------------------------------------------
*/
SEXP rcqpCmd_lexicon_size(SEXP inAttribute)
{
SEXP result = R_NilValue;
char * a;
Attribute * attribute;
int size;
if (!isString(inAttribute) || length(inAttribute) != 1) error("argument 'attribute' must be a string");
PROTECT(inAttribute);
a = (char*)CHAR(STRING_ELT(inAttribute,0));
attribute = cqi_lookup_attribute(a, ATT_POS);
if (attribute != NULL) {
size = cl_max_id(attribute);
if (size < 0) {
UNPROTECT(1);
Rprintf("negative size");
rcqp_send_error();
} else {
result = PROTECT(allocVector(INTSXP, 1));
INTEGER(result)[0] = size;
}
} else {
UNPROTECT(1);
return R_NilValue;
}
UNPROTECT(2);
return result;
}
/*
* ------------------------------------------------------------------------
*
* "rcqpCmd_structural_attribute_has_values(SEXP inAttribute)" --
*
*
*
* ------------------------------------------------------------------------
*/
SEXP rcqpCmd_structural_attribute_has_values(SEXP inAttribute)
{
SEXP result = R_NilValue;
char * a;
Attribute * attribute;
/* rcqp_initialize(); */
if (!isString(inAttribute) || length(inAttribute) != 1) error("argument 'attribute' must be a string");
PROTECT(inAttribute);
a = (char*)CHAR(STRING_ELT(inAttribute,0));
attribute = cqi_lookup_attribute(a, ATT_STRUC);
if (attribute != NULL) {
result = PROTECT(allocVector(LGLSXP, 1));
LOGICAL(result)[0] = (cl_struc_values(attribute) != 0);
} else {
rcqp_error_code(cqi_errno);
}
UNPROTECT(2);
return result;
}
void
do_cqi_cl_lexicon_size(void)
{
char *a;
Attribute *attribute;
int size;
a = cqi_read_string();
if (server_debug)
Rprintf( "CQi: CQI_CL_LEXICON_SIZE('%s')\n", a);
attribute = cqi_lookup_attribute(a, ATT_POS);
if (attribute != NULL) {
size = cl_max_id(attribute);
if (size < 0) {
send_cl_error();
}
else {
cqi_data_int(size);
}
}
else {
cqi_command(cqi_errno); /* cqi_errno set by lookup() */
}
free(a);
}
void
do_cqi_corpus_structural_attribute_has_values(void) {
char *a;
Attribute *attribute;
a = cqi_read_string(); /* need to try all possible attribute types */
if (server_debug)
Rprintf( "CQi: CQI_CORPUS_STRUCTURAL_ATTRIBUTE_HAS_VALUES('%s')\n", a);
attribute = cqi_lookup_attribute(a, ATT_STRUC);
if (attribute != NULL) {
cqi_data_bool(cl_struc_values(attribute));
}
else {
cqi_command(cqi_errno);
}
free(a);
}
/*
* ------------------------------------------------------------------------
*
* "rcqpCmd_cpos2rbound(SEXP inAttribute, SEXP inCpos)" --
*
*
*
* ------------------------------------------------------------------------
*/
SEXP rcqpCmd_cpos2rbound(SEXP inAttribute, SEXP inCpos)
{
SEXP result = R_NilValue;
int cpos;
int len, i, struc, lb, rb;
char * a;
Attribute * attribute;
if (!isString(inAttribute) || length(inAttribute) != 1) error("argument 'attribute' must be a string");
PROTECT(inAttribute);
if (!isVector(inCpos)) error("argument 'cpos' must be a vector of integers");
PROTECT(inCpos);
a = (char*)CHAR(STRING_ELT(inAttribute,0));
len = length(inCpos);
attribute = cqi_lookup_attribute(a, ATT_STRUC);
if (attribute == NULL) {
UNPROTECT(2);
rcqp_error_code(cqi_errno);
} else {
result = PROTECT(allocVector(INTSXP, len));
for (i=0; i<len; i++) {
cpos = INTEGER(inCpos)[i];
struc = cl_cpos2struc(attribute, cpos);
/* Return -1 if cpos is out of range */
if (struc < 0) {
struc = -1;
} else {
if (cl_struc2cpos(attribute, struc, &lb, &rb)) {
struc = rb;
} else {
struc = -1;
}
}
INTEGER(result)[i] = struc;
}
}
UNPROTECT(3);
return result;
}
/*
* ------------------------------------------------------------------------
*
* "rcqpCmd_regex2id(SEXP inAttribute, SEXP inRegex)" --
*
*
*
* ------------------------------------------------------------------------
*/
SEXP rcqpCmd_regex2id(SEXP inAttribute, SEXP inRegex)
{
SEXP result = R_NilValue;
int * idlist;
int len, i;
char *a, *r;
Attribute * attribute;
if (!isString(inAttribute) || length(inAttribute) != 1) error("argument 'attribute' must be a string");
PROTECT(inAttribute);
if (!isString(inRegex) || length(inRegex) != 1) error("argument 'regexp' must be a string");
PROTECT(inRegex);
a = (char*)CHAR(STRING_ELT(inAttribute,0));
r = (char*)CHAR(STRING_ELT(inRegex,0));
attribute = cqi_lookup_attribute(a, ATT_POS);
if (attribute == NULL) {
UNPROTECT(2);
rcqp_error_code(cqi_errno);
} else {
idlist = cl_regex2id(attribute, r, 0, &len);
if (idlist == NULL) {
if (cderrno != CDA_OK) {
UNPROTECT(2);
rcqp_send_error();
} else {
result = PROTECT(allocVector(INTSXP, 0));
}
} else {
result = PROTECT(allocVector(INTSXP, len));
for (i=0; i<len; i++) {
INTEGER(result)[i] = idlist[i];
}
free(idlist);
}
}
UNPROTECT(3);
return result;
}
void
do_cqi_cl_cpos2rbound(void)
{
int *cposlist;
int len, i, struc, lb, rb;
char *a;
Attribute *attribute;
a = cqi_read_string();
len = cqi_read_int_list(&cposlist);
if (server_debug) {
Rprintf( "CQi: CQI_CL_CPOS2RBOUND('%s', [", a);
for (i=0; i<len; i++)
Rprintf( "%d ", cposlist[i]);
Rprintf( "])\n");
}
attribute = cqi_lookup_attribute(a, ATT_STRUC);
if (attribute == NULL) {
cqi_command(cqi_errno);
}
else {
/* we assemble the CQI_DATA_INT_LIST() return command by hand,
so we don't have to allocate a temporary list */
cqi_send_word(CQI_DATA_INT_LIST);
cqi_send_int(len); /* list size */
for (i=0; i<len; i++) {
struc = cl_cpos2struc(attribute, cposlist[i]);
if (struc < 0) {
cqi_send_int(-1); /* return -1 if cpos is not in region */
}
else {
if (cl_struc2cpos(attribute, struc, &lb, &rb))
cqi_send_int(rb);
else
cqi_send_int(-1); /* cannot return error within list, so send -1 */
}
}
}
cqi_flush();
cl_free(cposlist); /* don't forget to free allocated memory */
free(a);
}
/*
* ------------------------------------------------------------------------
*
* "rcqpCmd_alg2cpos(SEXP inAttribute, SEXP inAlg)" --
*
*
*
* ------------------------------------------------------------------------
*/
SEXP rcqpCmd_alg2cpos(SEXP inAttribute, SEXP inAlg)
{
SEXP result = R_NilValue;
int alg, s1, s2, t1, t2;
char * a;
Attribute * attribute;
if (!isString(inAttribute) || length(inAttribute) != 1) error("argument 'attribute' must be a string");
if (!isVector(inAlg) || length(inAlg) != 1) error("argument 'alg' must be an integer");
PROTECT(inAttribute);
PROTECT(inAlg);
a = (char*)CHAR(STRING_ELT(inAttribute,0));
alg = asInteger(inAlg);
if (alg == NA_INTEGER) {
UNPROTECT(2);
error("invalid 'alg' value (too large or NA)");
}
attribute = cqi_lookup_attribute(a, ATT_ALIGN);
if (attribute == NULL) {
UNPROTECT(2);
rcqp_error_code(cqi_errno);
} else {
if (cl_alg2cpos(attribute, alg, &s1, &s2, &t1, &t2)) {
result = PROTECT(allocVector(INTSXP, 4));
INTEGER(result)[0] = s1;
INTEGER(result)[1] = s2;
INTEGER(result)[2] = t1;
INTEGER(result)[3] = t2;
} else {
rcqp_send_error();
}
}
UNPROTECT(3);
return result;
}
/*
* ------------------------------------------------------------------------
*
* "rcqpCmd_id2cpos(SEXP inAttribute, SEXP inId)" --
*
*
*
* ------------------------------------------------------------------------
*/
SEXP rcqpCmd_id2cpos(SEXP inAttribute, SEXP inId)
{
SEXP result = R_NilValue;
int idx;
int len, i;
int * cposlist;
char *a;
Attribute * attribute;
if (!isString(inAttribute) || length(inAttribute) != 1) error("argument 'attribute' must be a string");
PROTECT(inAttribute);
if (!isVector(inId) || length(inId) != 1) error("argument 'id' must be an integer");
PROTECT(inId);
a = (char*)CHAR(STRING_ELT(inAttribute,0));
idx = INTEGER(inId)[0];
attribute = cqi_lookup_attribute(a, ATT_POS);
if (attribute == NULL) {
UNPROTECT(2);
rcqp_error_code(cqi_errno);
} else {
cposlist = cl_id2cpos(attribute, idx, &len);
result = PROTECT(allocVector(INTSXP, len));
if (cposlist == NULL) {
UNPROTECT(2);
rcqp_error_code(cqi_errno);
} else {
for (i=0; i<len; i++) {
INTEGER(result)[i] = cposlist[i];
}
free(cposlist);
}
}
UNPROTECT(3);
return result;
}
void
do_cqi_cl_alg2cpos(void)
{
int alg, s1, s2, t1, t2;
char *a;
Attribute *attribute;
a = cqi_read_string();
alg = cqi_read_int();
if (server_debug)
Rprintf( "CQi: CQI_CL_ALG2CPOS('%s', %d)\n", a, alg);
attribute = cqi_lookup_attribute(a, ATT_ALIGN);
if (attribute == NULL) {
cqi_command(cqi_errno);
}
else {
if (cl_alg2cpos(attribute, alg, &s1, &s2, &t1, &t2))
cqi_data_int_int_int_int(s1, s2, t1, t2);
else
send_cl_error();
}
free(a); /* don't forget to free allocated space */
}
void
do_cqi_cl_struc2cpos(void)
{
int struc, start, end;
char *a;
Attribute *attribute;
a = cqi_read_string();
struc = cqi_read_int();
if (server_debug)
Rprintf( "CQi: CQI_CL_STRUC2CPOS('%s', %d)\n", a, struc);
attribute = cqi_lookup_attribute(a, ATT_STRUC);
if (attribute == NULL) {
cqi_command(cqi_errno);
}
else {
if (cl_struc2cpos(attribute, struc, &start, &end))
cqi_data_int_int(start, end);
else
send_cl_error();
}
free(a); /* don't forget to free allocated space */
}
/*
* ------------------------------------------------------------------------
*
* "rcqpCmd_struc2str(SEXP inAttribute, SEXP inIds)" --
*
* Function gets value of struc_num'th instance of the specified s-attribute.
*
* ------------------------------------------------------------------------
*/
SEXP rcqpCmd_struc2str(SEXP inAttribute, SEXP inIds)
{
SEXP result = R_NilValue;
int idx;
int len, i;
char *a, *str;
Attribute * attribute;
if (!isString(inAttribute) || length(inAttribute) != 1) error("argument 'attribute' must be a string");
PROTECT(inAttribute);
if (!isVector(inIds)) error("argument 'ids' must be a vector of integers");
PROTECT(inIds);
a = (char*)CHAR(STRING_ELT(inAttribute,0));
len = length(inIds);
attribute = cqi_lookup_attribute(a, ATT_STRUC);
if (attribute == NULL) {
UNPROTECT(2);
rcqp_error_code(cqi_errno);
} else {
result = PROTECT(allocVector(STRSXP, len));
for (i=0; i<len; i++) {
idx = INTEGER(inIds)[i];
str = cl_struc2str(attribute, idx);
/* Sends "" if str == NULL (cpos out of range) */
if (str != NULL) {
SET_STRING_ELT(result, i, mkChar(str));
}
}
}
UNPROTECT(3);
return result;
}
/*
* ------------------------------------------------------------------------
*
* "rcqpCmd_str2id(SEXP inAttribute, SEXP inStrs)" --
*
*
*
* ------------------------------------------------------------------------
*/
SEXP rcqpCmd_str2id(SEXP inAttribute, SEXP inStrs)
{
SEXP result = R_NilValue;
int idx;
int len, i;
char *a, *str;
Attribute * attribute;
if (!isString(inAttribute) || length(inAttribute) != 1) error("argument 'attribute' must be a string");
PROTECT(inAttribute);
if (!isString(inStrs)) error("argument 'strs' must be a vector of strings");
PROTECT(inStrs);
a = (char*)CHAR(STRING_ELT(inAttribute,0));
len = length(inStrs);
attribute = cqi_lookup_attribute(a, ATT_POS);
if (attribute == NULL) {
UNPROTECT(2);
rcqp_error_code(cqi_errno);
} else {
result = PROTECT(allocVector(INTSXP, len));
for (i=0; i<len; i++) {
str = (char*)CHAR(STRING_ELT(inStrs,i));
idx = cl_str2id(attribute, str);
if (idx < 0) {
idx = -1;
}
INTEGER(result)[i] = idx;
}
}
UNPROTECT(3);
return result;
}
void
do_cqi_cl_cpos2alg(void)
{
int *cposlist;
int len, i, alg;
char *a;
Attribute *attribute;
a = cqi_read_string();
len = cqi_read_int_list(&cposlist);
if (server_debug) {
Rprintf( "CQi: CQI_CL_CPOS2ALG('%s', [", a);
for (i=0; i<len; i++)
Rprintf( "%d ", cposlist[i]);
Rprintf( "])\n");
}
attribute = cqi_lookup_attribute(a, ATT_ALIGN);
if (attribute == NULL) {
cqi_command(cqi_errno);
}
else {
/* we assemble the CQI_DATA_INT_LIST() return command by hand,
so we don't have to allocate a temporary list */
cqi_send_word(CQI_DATA_INT_LIST);
cqi_send_int(len); /* list size */
for (i=0; i<len; i++) {
alg = cl_cpos2alg(attribute, cposlist[i]);
if (alg < 0)
alg = -1; /* return -1 if cpos is out of range */
cqi_send_int(alg);
}
}
cqi_flush();
if (cposlist != NULL)
free(cposlist); /* don't forget to free allocated memory */
free(a);
}
/* one might wish to add extensive error checking to all the CL functions,
but that will need a LOT of code! */
void
do_cqi_cl_str2id(void)
{
char **strlist;
int len, i, id;
char *a;
Attribute *attribute;
a = cqi_read_string();
len = cqi_read_string_list(&strlist);
if (server_debug) {
Rprintf( "CQi: CQI_CL_STR2ID('%s', [", a);
for (i=0; i<len; i++)
Rprintf( "'%s' ", strlist[i]);
Rprintf( "])\n");
}
attribute = cqi_lookup_attribute(a, ATT_POS);
if (attribute == NULL) {
cqi_command(cqi_errno);
}
else {
/* we assemble the CQI_DATA_INT_LIST() return command by hand,
so we don't have to allocate a temporary list */
cqi_send_word(CQI_DATA_INT_LIST);
cqi_send_int(len); /* list size */
for (i=0; i<len; i++) {
id = cl_str2id(attribute, strlist[i]);
if (id < 0)
id = -1; /* -1 => string not found in lexicon */
cqi_send_int(id);
}
}
cqi_flush();
if (strlist != NULL)
free(strlist); /* don't forget to free allocated memory */
free(a);
}
void
do_cqi_cl_id2freq(void)
{
int *idlist;
int len, i, f;
char *a;
Attribute *attribute;
a = cqi_read_string();
len = cqi_read_int_list(&idlist);
if (server_debug) {
Rprintf( "CQi: CQI_CL_ID2FREQ('%s', [", a);
for (i=0; i<len; i++)
Rprintf( "%d ", idlist[i]);
Rprintf( "])\n");
}
attribute = cqi_lookup_attribute(a, ATT_POS);
if (attribute == NULL) {
cqi_command(cqi_errno);
}
else {
/* we assemble the CQI_DATA_INT_LIST() return command by hand,
so we don't have to allocate a temporary list */
cqi_send_word(CQI_DATA_INT_LIST);
cqi_send_int(len); /* list size */
for (i=0; i<len; i++) {
f = cl_id2freq(attribute, idlist[i]);
if (f < 0)
f = 0; /* return 0 if ID is out of range */
cqi_send_int(f);
}
}
cqi_flush();
if (idlist != NULL)
free(idlist); /* don't forget to free allocated memory */
free(a);
}
void
do_cqi_cl_cpos2struc(void)
{
int *cposlist;
int len, i, struc;
char *a;
Attribute *attribute;
a = cqi_read_string();
len = cqi_read_int_list(&cposlist);
if (server_debug) {
fprintf(stderr, "CQi: CQI_CL_CPOS2STRUC('%s', [", a);
for (i=0; i<len; i++)
fprintf(stderr, "%d ", cposlist[i]);
fprintf(stderr, "])\n");
}
attribute = cqi_lookup_attribute(a, ATT_STRUC);
if (attribute == NULL) {
cqi_command(cqi_errno);
}
else {
/* we assemble the CQI_DATA_INT_LIST() return command by hand,
so we don't have to allocate a temporary list */
cqi_send_word(CQI_DATA_INT_LIST);
cqi_send_int(len); /* list size */
for (i=0; i<len; i++) {
struc = cl_cpos2struc(attribute, cposlist[i]);
if (struc < 0)
struc = -1; /* return -1 if cpos is out of range */
cqi_send_int(struc);
}
}
cqi_flush();
cl_free(cposlist); /* don't forget to free allocated memory */
free(a);
}
/*
* ------------------------------------------------------------------------
*
* "rcqpCmd_id2freq(SEXP inAttribute, SEXP inIds)" --
*
*
*
* ------------------------------------------------------------------------
*/
SEXP rcqpCmd_id2freq(SEXP inAttribute, SEXP inIds)
{
SEXP result = R_NilValue;
int idx;
int len, i, f;
char *a;
Attribute * attribute;
if (!isString(inAttribute) || length(inAttribute) != 1) error("argument 'attribute' must be a string");
PROTECT(inAttribute);
if (!isVector(inIds)) error("argument 'ids' must be a vector of integers");
PROTECT(inIds);
a = (char*)CHAR(STRING_ELT(inAttribute,0));
len = length(inIds);
attribute = cqi_lookup_attribute(a, ATT_POS);
if (attribute == NULL) {
UNPROTECT(2);
rcqp_error_code(cqi_errno);
} else {
result = PROTECT(allocVector(INTSXP, len));
for (i=0; i<len; i++) {
idx = INTEGER(inIds)[i];
f = cl_id2freq(attribute, idx);
/* Return 0 if ID is out of range */
if (f < 0) f = 0;
INTEGER(result)[i] = f;
}
}
UNPROTECT(3);
return result;
}
/*
* ------------------------------------------------------------------------
*
* "rcqpCmd_cpos2alg(SEXP inAttribute, SEXP inCpos)" --
*
*
*
* ------------------------------------------------------------------------
*/
SEXP rcqpCmd_cpos2alg(SEXP inAttribute, SEXP inCpos)
{
SEXP result = R_NilValue;
int cpos;
int len, i, alg;
char * a;
Attribute * attribute;
if (!isString(inAttribute) || length(inAttribute) != 1) error("argument 'attribute' must be a string");
PROTECT(inAttribute);
if (!isVector(inCpos)) error("argument 'cpos' must be a vector of integers");
PROTECT(inCpos);
a = (char*)CHAR(STRING_ELT(inAttribute,0));
len = length(inCpos);
attribute = cqi_lookup_attribute(a, ATT_ALIGN);
if (attribute == NULL) {
UNPROTECT(2);
rcqp_error_code(cqi_errno);
} else {
result = PROTECT(allocVector(INTSXP, len));
for (i=0; i<len; i++) {
cpos = INTEGER(inCpos)[i];
alg = cl_cpos2alg(attribute, cpos);
/* Return -1 if cpos is out of range */
if (alg < 0) alg = -1;
INTEGER(result)[i] = alg;
}
}
UNPROTECT(3);
return result;
}