SEXP L2L1Vit(SEXP obsSeq, SEXP obsWts, SEXP lambda2, SEXP lambda1, SEXP retPath, SEXP maxSegs, SEXP nSegs, SEXP backPtrs, SEXP primBds) { int max_segs = GetInt(maxSegs, 0, 0); double * o = REAL(obsSeq); double * wts = REAL(obsWts); double lam2 = GetNumeric(lambda2, 0, 0); double lam1 = GetNumeric(lambda1, 0, 0); int n_obs = LENGTH(obsSeq); int n_protect = 0; double * back_ptrs = REAL(backPtrs); int msg_buf_len = FL_SEGSZ*2*30; double * msg_buf = malloc( msg_buf_len*sizeof(double) ); int * n_segs = INTEGER(nSegs); double obs_min = R_PosInf, obs_max = R_NegInf; for(int i = 0; i < n_obs; i++){ if(R_FINITE(o[i])){ if(o[i] < obs_min) obs_min = o[i]; else if(o[i] > obs_max) obs_max = o[i]; } } SEXP ret_sxp; PROTECT(ret_sxp = NEW_INTEGER(1)); n_protect++; double * rp = REAL(retPath); int r1 = L2L1VitFwd(lam2, o, wts, &msg_buf, &msg_buf_len, max_segs, back_ptrs, n_segs, n_obs, max_segs, obs_min, obs_max, (rp + (n_obs-1)) ); if(r1 != 1){ INTEGER(ret_sxp)[0] = r1; UNPROTECT(n_protect); return ret_sxp; } double * bd1 = NULL, *bd2 = NULL; if(primBds != R_NilValue){ bd1 = REAL(primBds); bd2 = bd1 + 1; } L2L1BackTrace(rp[n_obs-1], lam1, rp, n_obs, back_ptrs, bd1, bd2); free(msg_buf); INTEGER(ret_sxp)[0] = 1; if(n_protect > 0) UNPROTECT(n_protect); return ret_sxp; }
DVT_STATUS VALUE_TM_CLASS::IsTime (string time, int, LOG_MESSAGE_CLASS * messages) // DESCRIPTION : Check if time format is valid. // PRECONDITIONS : // POSTCONDITIONS : // EXCEPTIONS : // NOTES : //<<=========================================================================== { int length = time.length(); int hour; int minute; int second; char message[256]; if (length > 6) { sprintf (message, "HHMMSS may not exceed 6 characters. Length %d found.", length); messages->AddMessage (VAL_RULE_D_TM_9, message); return (MSG_ERROR); } hour = 0; minute = 0; second = 0; switch (length) { case 6: second = GetNumeric (&time[4],2); // Fall through. case 4: minute = GetNumeric (&time[2], 2); // Fall through case 2: hour = GetNumeric (time, 2); break; case 0: break; default: sprintf (message, "invalid time format - expected [HH[MM[SS[.FRAC]]]]"); messages->AddMessage (VAL_RULE_D_TM_2, message); return (MSG_ERROR); } if (IsTimeValid (hour, minute, second) == false) { sprintf (message, "invalid time"); messages->AddMessage (VAL_RULE_D_TM_5, message); return (MSG_ERROR); } return (MSG_OK); }
void SpectDisplay::ReadDialogValues() //{================================== { spectseq->amplitude = formantdlg->t_amplitude->GetValue(); spectseq->duration = GetNumeric(voicedlg->vd_duration); voicedlg->ReadParams(); }
uint32 SOMFRecordPointer::UnpackLIDATABlock(int8 * destination, uint32 MaxSize) { // Unpack Data block in LIDATA record recursively and store data at destination uint32 RepeatCount = GetNumeric(); // Outer repeat count uint32 BlockCount = GetWord(); // Inner repeat count uint32 Size = 0; // Size of data expanded so far uint32 RSize; // Size of recursively expanded data uint32 SaveIndex; // Save Index for repetition uint32 i, j; // Loop counters if (BlockCount == 0) { // Contains one repeated block Size = GetByte(); // Size of repeated block if (RepeatCount * Size > MaxSize) { // Data outside allowed area err.submit(2310); // Error message Index += Size; // Point to after block return 0; // No data stored } // Loop RepeatCount times for (i = 0; i < RepeatCount; i++) { // copy data block into destination memcpy(destination, buffer + FileOffset + Index, Size); destination += Size; } Index += Size; // Point to after block return RepeatCount * Size; // Size of expanded data } // Nested repeat blocks SaveIndex = Index; // Loop RepeatCount times for (i = 0; i < RepeatCount; i++) { // Go back and repeat unpacking Index = SaveIndex; // Loop BlockCount times for (j = 0; j < BlockCount; j++) { // Recursion RSize = UnpackLIDATABlock(destination, MaxSize); destination += RSize; MaxSize -= RSize; Size += RSize; } } return Size; }
uint32 SOMFRecordPointer::InterpretLIDATABlock() { // Interpret Data block in LIDATA record recursively // Prints repeat count and returns total size uint32 RepeatCount = GetNumeric(); uint32 BlockCount = GetWord(); uint32 Size = 0; printf("%i * ", RepeatCount); if (BlockCount == 0) { Size = GetByte(); Index += Size; printf("%i", Size); return RepeatCount * Size; } // Nested repeat blocks printf("("); for (uint32 i = 0; i < BlockCount; i++) { // Recursion Size += InterpretLIDATABlock(); if (i+1 < BlockCount) printf(" + "); } printf(")"); return RepeatCount * Size; }
SEXP L2L1ExpandFit(SEXP betaPath, SEXP betaSegs, SEXP lam1, SEXP lam2Inds, SEXP retFit) { double lm1 = GetNumeric(lam1, 0, 0); double * ret_fit = REAL(retFit); int n_lam2i = LENGTH(lam2Inds); int * lam2i = INTEGER(lam2Inds); for(int i = 0; i < n_lam2i; i++){ SEXP bp_sxp = VECTOR_ELT(betaPath, lam2i[i]); SEXP bsg_sxp = VECTOR_ELT(betaSegs, lam2i[i]); int n_seg = LENGTH(bp_sxp); double * bv = REAL(bp_sxp); int * sgv = INTEGER(bsg_sxp); double cur_b = soft_thresh(bv[0], lm1); int n_fill = 1 + sgv[1] - sgv[0]; for(int j = 0; j < n_fill; j++, ret_fit++){ *ret_fit = cur_b; } for(int k = 1, k2 = 2; k < n_seg; k++, k2 += 2){ cur_b = soft_thresh(bv[k], lm1); n_fill = 1 + sgv[k2 + 1] - sgv[k2]; for(int j = 0; j < n_fill; j++, ret_fit++){ *ret_fit = cur_b; } } } return R_NilValue; }
DVT_STATUS VALUE_DT_CLASS::Check (UINT32 flags, BASE_VALUE_CLASS **, LOG_MESSAGE_CLASS *messages, SPECIFIC_CHARACTER_SET_CLASS *) // DESCRIPTION : Check DT format. // PRECONDITIONS : // POSTCONDITIONS : // EXCEPTIONS : // NOTES : //<<=========================================================================== { DVT_STATUS result = MSG_OK; int length = valueM.length(); int maxLength; int index; int frac_index = 0; unsigned int offset_index = 0; string syntax = ""; int second; int minute; int hour; int day; int month; int year; char message[256]; if (length == 0) return (MSG_OK); if (flags & ATTR_FLAG_RANGES_ALLOWED) { maxLength = DT_QR_LENGTH; } else { maxLength = DT_LENGTH; } if (length > maxLength) { sprintf (message, "value length %i exceeds maximum length %i - truncated for value(%s)", length, maxLength, valueM.c_str()); messages->AddMessage (VAL_RULE_D_DT_1, message); length = maxLength; result= MSG_ERROR; } if (length > 0) { for (index=0 ; index<length ; index++) { if ((valueM[index] >= '0') && (valueM[index] <= '9')) { syntax += 'n'; } else { switch (valueM[index]) { case '.': if (!(flags & ATTR_FLAG_RANGES_ALLOWED)) { if (frac_index != 0) // twice { sprintf (message, "more then one '.' Character found at offset %d", index); messages->AddMessage (VAL_RULE_D_DT_2, message); return MSG_ERROR; } } syntax += '.'; frac_index = index + 1; break; case '+': // Fall through case '-': if (!(flags & ATTR_FLAG_RANGES_ALLOWED)) { if (offset_index != 0) // twice { sprintf (message, "more then one '+' or '-' Character found at offset %d", index); messages->AddMessage (VAL_RULE_D_DT_2, message); return MSG_ERROR; } } syntax += 'S'; offset_index = index + 1; break; case ' ': if ( ((index + 1) % 2 != 0) || ((valueM[index+1] != NULLCHAR) && ((index + 1) < maxLength) ) ) { sprintf (message, "unexpected SPACE character at offset %d", index+1); messages->AddMessage (VAL_RULE_D_DT_2, message); return MSG_ERROR; } break; case 0x00: sprintf (message, "unexpected character [NUL]=0x00 at offset %d", index+1); messages->AddMessage (VAL_RULE_D_DT_2, message); return MSG_ERROR; case 0x0a: // Fall through case 0x0d: sprintf (message, "unexpected character 0x%02X at offset %d", (int)(valueM[index]), index+1); messages->AddMessage (VAL_RULE_D_DT_2, message); return MSG_ERROR; default: sprintf (message, "unexpected character %c=0x%02X at offset %d", valueM[index], valueM[index], index+1); messages->AddMessage (VAL_RULE_D_DT_2, message); return MSG_ERROR; } } } // Deal with offset first. Note that an offset can not be at the // beginning of a string. if (offset_index != 0) { if (syntax.find("nnnn", offset_index) != offset_index) { sprintf (message, "invalid optional offset suffix"); messages->AddMessage (VAL_RULE_D_DT_2, message); return MSG_ERROR; } hour = GetNumeric (&valueM[offset_index], 2); minute = GetNumeric (&valueM[offset_index + 2], 2); if (!(IsTimeValid (hour, minute, 0))) { sprintf (message, "invalid time value specified in offset suffix"); messages->AddMessage (VAL_RULE_D_DT_2, message); return MSG_ERROR; } // chop offset off syntax string index = offset_index - 1; syntax[index] = NULLCHAR; hour = 0; minute = 0; } // Compensate the index counter used in the for-loop. index--; // Deal with frac. if (!(flags & ATTR_FLAG_RANGES_ALLOWED)) { if ((syntax.find ("nnnnnnnnnnnnnn.n") == 0) && (index <= 21)) { if (! IsNumeric (&valueM[frac_index], index-frac_index)) { sprintf (message, "invalid fractional part specified"); messages->AddMessage (VAL_RULE_D_DT_2, message); return MSG_ERROR; } } else { if (frac_index > 0) { sprintf (message, "fraction '.' Character not expected at offset %d", frac_index); messages->AddMessage (VAL_RULE_D_DT_2, message); return MSG_ERROR; } } } // Deal with main date/time stem - various formats index = 0; while (syntax[index] == 'n') { index++; } second = 0; minute = 0; hour = 0; day = 1; month = 1; year = 1900; switch (index) { case 14: second = GetNumeric(&valueM[12], 2); // Fall through case 12: minute = GetNumeric(&valueM[10], 2); // Fall through case 10: hour = GetNumeric(&valueM[8], 2); // Fall through case 8: day = GetNumeric(&valueM[6], 2); // Fall through case 6: month = GetNumeric(&valueM[4], 2); // Fall through case 4: year = GetNumeric(valueM, 4); break; default: sprintf (message, "unexpected components - expected YYYY[MM[DD[HH[MM[SS[.FRAC]]]]]][OFFSET]"); messages->AddMessage (VAL_RULE_D_DT_2, message); return MSG_ERROR; } if (IsDateValid(year, month, day) == false) { sprintf (message, "invalid date"); messages->AddMessage (VAL_RULE_D_DT_3, message); return MSG_ERROR; } if (IsTimeValid(hour, minute, second) == false) { sprintf (message, "invalid time"); messages->AddMessage (VAL_RULE_D_DT_3, message); return MSG_ERROR; } } return (result); }
Token Scanner::Get(Need need) { int type = Token::EOT; old_index = index; old_line = line; eos = str + length; p = str + index; if (p >= eos) { if (need == Demand && reader) { Load(reader->more()); if (length > 0) return Get(need); } return Token("", type, 0, line, 0); } while (isspace(*p) && p < eos) { // skip initial white space if (*p == '\n') { line++; lineStart = p - str; } p++; } if (p >= eos) { if (need == Demand && reader) { Load(reader->more()); if (length > 0) return Get(need); } return Token("", type, 0, line, 0); } Token result; size_t start = p - str; if (*p == '"' || *p == '\'') { // special case for quoted tokens if (*p == '"') type = Token::StringLiteral; else type = Token::CharLiteral; char match = *p; while (++p < eos) { if (*p == match) { // find matching quote if (*(p-1) != '\\') { // if not escaped p++; // token includes matching quote break; } } } } // generic delimited comments else if (*p == Token::comBeg(0) && (!Token::comBeg(1) || *(p+1) == Token::comBeg(1))) { type = Token::Comment; while (++p < eos) { if (*p == Token::comEnd(0) && (!Token::comEnd(1) || *(p+1) == Token::comEnd(1))) { p++; if (Token::comEnd(1)) p++; break; } } } // alternate form delimited comments else if (*p == Token::altBeg(0) && (!Token::altBeg(1) || *(p+1) == Token::altBeg(1))) { type = Token::Comment; while (++p < eos) { if (*p == Token::altEnd(0) && (!Token::altEnd(1) || *(p+1) == Token::altEnd(1))) { p++; if (Token::altEnd(1)) p++; break; } } } else if (*p == '.') type = Token::Dot; else if (*p == ',') type = Token::Comma; else if (*p == ';') type = Token::Semicolon; else if (*p == '(') type = Token::LParen; else if (*p == ')') type = Token::RParen; else if (*p == '[') type = Token::LBracket; else if (*p == ']') type = Token::RBracket; else if (*p == '{') type = Token::LBrace; else if (*p == '}') type = Token::RBrace; // use lexical sub-parser for ints and floats else if (isdigit(*p)) type = GetNumeric(); else if (IsSymbolic(*p)) { type = Token::SymbolicIdent; while (IsSymbolic(*p)) p++; } else { type = Token::AlphaIdent; while (IsAlpha(*p)) p++; } size_t extent = (p - str) - start; if (extent < 1) extent = 1; // always get at least one character index = start + extent; // advance the cursor int col = start - lineStart; if (line == 0) col++; char* buf = new(__FILE__, __LINE__) char [extent + 1]; strncpy(buf, str + start, extent); buf[extent] = '\0'; if (type == Token::Comment && Token::hidecom) { delete [] buf; if (Token::comEnd(0) == '\n') { line++; lineStart = p - str; } return Get(need); } if (type == Token::AlphaIdent || // check for keyword type == Token::SymbolicIdent) { int val; if (Token::findKey(Text(buf), val)) result = Token(buf, Token::Keyword, val, line+1, col); } if (result.mType != Token::Keyword) result = Token(buf, type, 0, line+1, col); if (line+1 > (size_t) best.mLine || (line+1 == (size_t) best.mLine && col > best.mColumn)) best = result; delete [] buf; return result; }
SEXP L2L1VitPath(SEXP obsSeq, SEXP lambda2, SEXP lambda1, SEXP retPath, SEXP maxSegs, SEXP segmentVec, SEXP primBds) { int segmented_ret = (segmentVec != R_NilValue) ? 1 : 0; int max_segs = GetInt(maxSegs, 0, 0); double * all_obs = REAL(obsSeq); int n_obs = LENGTH(obsSeq); int n_protect = 0; double * back_ptrs = AllocProtectReal(2*n_obs); n_protect++; int * fused_segs1 = NULL; int * fused_segs2 = NULL; double *o2 = NULL, *wts2 = NULL, *o3 = NULL, *wts3 = NULL; int msg_buf_len = FL_SEGSZ*2*30; double * msg_buf = malloc( msg_buf_len*sizeof(double) ); SEXP ret_sxp; PROTECT(ret_sxp = NEW_INTEGER(1)); n_protect++; double obs_min = R_PosInf, obs_max = R_NegInf; for(int i = 0; i < n_obs; i++){ if(R_FINITE(all_obs[i])){ if(all_obs[i] < obs_min) obs_min = all_obs[i]; if(all_obs[i] > obs_max) obs_max = all_obs[i]; } } double lam1 = GetNumeric(lambda1, 0, 0); int n_lam2 = LENGTH(lambda2); int n_o = n_obs; double * o = all_obs; double * wts = NULL; double * prim_bds = (primBds == R_NilValue) ? NULL : REAL(primBds); for(int lam2i = 0; lam2i < n_lam2; lam2i++){ double lam2 = REAL(lambda2)[lam2i]; double beta_hat = 0.0; int r1 = L2L1VitFwd(lam2, o, wts, &msg_buf, &msg_buf_len, max_segs, back_ptrs, NULL, n_o, max_segs, obs_min, obs_max, &beta_hat); if(r1 != 1){ INTEGER(ret_sxp)[0] = r1; UNPROTECT(n_protect); return ret_sxp; } int * fs = fused_segs1; int nfsd2 = 0; if(o2 == NULL || segmented_ret){ //We haven't allocated the buffers for the //fused observations yet nfsd2 = L2L1GetNFused(beta_hat, n_o, back_ptrs); o2 = AllocProtectReal(nfsd2); n_protect++; wts2 = AllocProtectReal(nfsd2); n_protect++; fused_segs1 = AllocProtectInt(2*(nfsd2+1)); n_protect++; fused_segs2 = AllocProtectInt(2*(nfsd2+1)); n_protect++; } double * fit_v = NULL; if(segmented_ret){ SEXP tmp_sxp; PROTECT(tmp_sxp = NEW_NUMERIC(nfsd2)); SET_VECTOR_ELT(retPath, lam2i, tmp_sxp); UNPROTECT(1); fit_v = REAL(VECTOR_ELT(retPath, lam2i)); }else{ fit_v = REAL(retPath) + n_obs * lam2i; } int seg_R = (fs) ? fs[0] : (n_obs-1); int seg_L = (fs) ? fs[1] : (n_obs-1); int n_fused2 = 0; fused_segs2[0] = seg_R; if(fs) fs += 2; double bd1 = 0.0, bd2 = 0.0; double beta_hat_shr = beta_hat; if(segmented_ret){ fit_v[(nfsd2-1) - n_fused2] = beta_hat_shr; bd1 += fabs(beta_hat_shr); }else{ for(int k = seg_L; k <= seg_R; k++){ fit_v[k] = beta_hat_shr; } bd1 += fabs(beta_hat_shr) * (double)(1+seg_R - seg_L); } if( !R_FINITE(o[n_o-1]) ){ o2[n_fused2] = wts2[n_fused2] = 0; }else if(wts){ o2[n_fused2] = o[n_o-1]*wts[n_o-1]; wts2[n_fused2] = wts[n_o-1]; }else{ o2[n_fused2] = o[n_o-1]; wts2[n_fused2] = 1.0; } if(n_o == 1){ n_fused2 = 1; fused_segs2[0] = n_obs - 1; fused_segs2[1] = 0; o2[0] = o[0] * wts[0]; wts2[0] = wts[0]; } for(int i = n_o-2; i >= 0; i--){ seg_R = (fs) ? fs[0] : i; seg_L = (fs) ? fs[1] : i; double * bp = back_ptrs + (2*(i+1)); if(beta_hat > bp[1]){ bd2 += fabs(beta_hat - bp[1]); beta_hat = bp[1]; beta_hat_shr = beta_hat; fused_segs2[2*n_fused2 + 1] = seg_R+1; n_fused2++; o2[n_fused2] = wts2[n_fused2] = 0.0; fused_segs2[2*n_fused2] = seg_R; }else if(beta_hat < bp[0]){ bd2 += fabs(beta_hat - bp[0]); beta_hat = bp[0]; beta_hat_shr = beta_hat; fused_segs2[2*n_fused2 + 1] = seg_R+1; n_fused2++; o2[n_fused2] = wts2[n_fused2] = 0.0; fused_segs2[2*n_fused2] = seg_R; } if(R_FINITE(o[i])){ if(wts){ o2[n_fused2] += o[i]*wts[i]; wts2[n_fused2] += wts[i]; }else{ o2[n_fused2] += o[i]; wts2[n_fused2] += 1.0; } } if(segmented_ret){ fit_v[(nfsd2-1) - n_fused2] = beta_hat_shr; }else{ for(int k = seg_L; k <= seg_R; k++){ fit_v[k] = beta_hat_shr; } } bd1 += fabs(beta_hat_shr) * (double)(1+seg_R - seg_L); if(i == 0){ fused_segs2[2*n_fused2 + 1] = seg_L; n_fused2++; } if(fs) fs += 2; } if(prim_bds){ double * bdv = prim_bds + 2*lam2i; bdv[0] = bd1; bdv[1] = bd2; } // We have stored the fitted parameters. Now we collapse // observations and fit on the new sequence at the next // iteration obs_min = R_PosInf; obs_max = R_NegInf; if(o3 == NULL){ o3 = AllocProtectReal(n_fused2); n_protect++; wts3 = AllocProtectReal(n_fused2); n_protect++; } for(int i = 0; i < n_fused2; i++){ if( wts2[n_fused2-1-i] > 0.0 ){ double z = o2[n_fused2-1-i] / wts2[n_fused2-1-i]; if(z < obs_min) obs_min = z; if(z > obs_max) obs_max = z; o3[i] = z; }else{ o3[i] = NA_REAL; } wts3[i] = wts2[n_fused2-1-i]; } if(n_o == 1){ obs_max = obs_min + FL_ENDPT_KNOT_FUDGE; obs_min -= FL_ENDPT_KNOT_FUDGE; } if(segmented_ret){ SEXP tmp_sxp, seg_dim; PROTECT(tmp_sxp = NEW_INTEGER(2*nfsd2)); PROTECT(seg_dim=NEW_INTEGER(2)); INTEGER(seg_dim)[0] = 2; INTEGER(seg_dim)[1] = nfsd2; SET_DIM(tmp_sxp,seg_dim); SET_VECTOR_ELT(segmentVec, lam2i, tmp_sxp); UNPROTECT(2); int * seg_v = INTEGER(VECTOR_ELT(segmentVec, lam2i)); for(int k = 0; k < nfsd2; k++){ seg_v[1+2*k] = fused_segs2[(nfsd2-1-k)*2]+1; seg_v[2*k] = fused_segs2[1+(nfsd2-1-k)*2]+1; } } o = o3; wts = wts3; fs = fused_segs2; fused_segs2 = fused_segs1; fused_segs1 = fs; n_o = n_fused2; } free(msg_buf); if(segmented_ret){ for(int lam2i = 0; lam2i < n_lam2; lam2i++){ double * bv = REAL(VECTOR_ELT(retPath, lam2i)); int m = LENGTH(VECTOR_ELT(retPath, lam2i)); for(int i = 0; i < m; i++){ bv[i] = soft_thresh(bv[i], lam1); } } }else{ double * bv = REAL(retPath); int m = LENGTH(retPath); for(int i = 0; i < m; i++){ bv[i] = soft_thresh(bv[i], lam1); } } INTEGER(ret_sxp)[0] = 1; UNPROTECT(n_protect); return ret_sxp; }