VoxelMatrix <float> findNucleoli(const VoxelMatrix<float>& originalVoxelMatrix, VoxelMatrix<float>& nucleusMask, const string& filename, const string& intermediateProcessesDir ) { EVAL("1"); VoxelMatrix<float> nucleusMaskCopy = nucleusMask; VoxelMatrix<float> gradientMatrix = originalVoxelMatrix; EVAL("1"); //labelling GaussianGradient<float> gaussianGradient; gaussianGradient.MaskVoxelMatrixProcessing<float>::setMask( nucleusMaskCopy ); gaussianGradient.setSigma( 2 ); gaussianGradient.apply( gradientMatrix ); // gradientMatrix.save( intermediateProcessesDir + filename + "-gradient.vm", true ); VoxelMatrix <float> regionMatrix = gradientMatrix; WatershedTransform<float> watershedTransform; watershedTransform.MaskVoxelMatrixProcessing<float>::setMask( nucleusMaskCopy ); watershedTransform.apply( regionMatrix ); regionMatrix.save( intermediateProcessesDir + filename + "-watershed.vm", true ); VoxelMatrix<float> rangeMask, copyVoxelMatrix = originalVoxelMatrix; VoxelMatrix<float> nucleoliMask; /* RegionAnalysis3D<float> regionAnalysis; regionAnalysis.setLabelMatrix( regionMatrix ); regionAnalysis.setValueMatrix( copyVoxelMatrix ); regionAnalysis.setOutputMatrix( rangeMask ); regionAnalysis.run(); regionAnalysis.outputFillRegions( REGION_FEATURE_CONTRACTNESS ); rangeMask.save( intermediateProcessesDir + filename + "-contrast.vm", true ); VoxelMatrix<float> nucleoliMask = rangeMask; OtsuThresholding<float> otsuThresholding; Vector <float> featureValues = regionAnalysis.computeRegionFeature( REGION_FEATURE_CONTRACTNESS ); Vector <unsigned int> histogram = featureValues.histogram( featureValues.min(), 1, floor(featureValues.max())+1 ); Thresholding<float> thresholding; thresholding.setBackground( 0.0 ); thresholding.setForeground( 1.0 ); EVAL("1"); thresholding.setThreshold( otsuThresholding.computeThreshold(histogram) ); //thresholding.applyAlternative( nucleoliMask ); thresholding.apply( nucleoliMask ); //to obtain a better filling, it's applied to each 2D slice instead of the complete 3D stack HolesFillingf holesFilling; int sizeZ = nucleoliMask.getSize3(); for (int k = 0; k < sizeZ; ++k) holesFilling.apply( nucleoliMask[k] ); // VoxelMatrix<float> ccsFillMask = nucleoliMask; // nucleoliMask.fillIt(ccsFillMask); VoxelMatrix<float> structElement; structElement.setSize(1,1,1); structElement.setOnes(); VoxelMatrixDilatation<float> voxelDilatation; voxelDilatation.setStructElt( structElement ); voxelDilatation.apply( nucleoliMask ); VoxelMatrixErosion<float> voxelErosion; voxelErosion.setStructElt( structElement ); voxelErosion.apply( nucleoliMask ); // VoxelMatrix<float> ccsFillMask = nucleoliMask; // nucleoliMask.fillIt(ccsFillMask); holesFilling.apply( nucleoliMask ); for (int k = 0; k < sizeZ; ++k) holesFilling.apply( nucleoliMask[k] ); //labeling the image ComponentLabelling<float> componentLabelling; componentLabelling.apply( nucleoliMask ); nucleoliMask.setVoxelCalibration( originalVoxelMatrix.getVoxelCalibration() ); //nucleoliMask.save( chromocentersDir + filename + ".vm", true ); */ return nucleoliMask; }
/* Evaluate method invocation */ static any evMethod(any o, any expr, any x) { any y = car(expr); any cls = TheCls, key = TheKey; struct { // bindFrame struct bindFrame *link; int i, cnt; struct {any sym; any val;} bnd[length(y)+3]; } f; f.link = Env.bind, Env.bind = (bindFrame*)&f; f.i = sizeof(f.bnd) / (2*sizeof(any)) - 2; f.cnt = 1, f.bnd[0].sym = At, f.bnd[0].val = val(At); while (isCell(y)) { f.bnd[f.cnt].sym = car(y); f.bnd[f.cnt].val = EVAL(car(x)); ++f.cnt, x = cdr(x), y = cdr(y); } if (isNil(y)) { while (--f.i > 0) { x = val(f.bnd[f.i].sym); val(f.bnd[f.i].sym) = f.bnd[f.i].val; f.bnd[f.i].val = x; } f.bnd[f.cnt].sym = This, f.bnd[f.cnt++].val = val(This), val(This) = o; y = cls, cls = Env.cls; Env.cls = y; y = key, key = Env.key; Env.key = y; x = prog(cdr(expr)); } else if (y != At) { f.bnd[f.cnt].sym = y, f.bnd[f.cnt++].val = val(y), val(y) = x; while (--f.i > 0) { x = val(f.bnd[f.i].sym); val(f.bnd[f.i].sym) = f.bnd[f.i].val; f.bnd[f.i].val = x; } f.bnd[f.cnt].sym = This, f.bnd[f.cnt++].val = val(This), val(This) = o; y = cls, cls = Env.cls; Env.cls = y; y = key, key = Env.key; Env.key = y; x = prog(cdr(expr)); } else { int n, cnt; cell *arg; cell c[n = cnt = length(x)]; while (--n >= 0) Push(c[n], EVAL(car(x))), x = cdr(x); while (--f.i > 0) { x = val(f.bnd[f.i].sym); val(f.bnd[f.i].sym) = f.bnd[f.i].val; f.bnd[f.i].val = x; } n = Env.next, Env.next = cnt; arg = Env.arg, Env.arg = c; f.bnd[f.cnt].sym = This, f.bnd[f.cnt++].val = val(This), val(This) = o; y = cls, cls = Env.cls; Env.cls = y; y = key, key = Env.key; Env.key = y; x = prog(cdr(expr)); if (cnt) drop(c[cnt-1]); Env.arg = arg, Env.next = n; } while (--f.cnt >= 0) val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val; Env.bind = f.link; Env.cls = cls, Env.key = key; return x; }
VoxelMatrix <float> findCCs(const VoxelMatrix<float>& originalVoxelMatrix, VoxelMatrix<float>& nucleusMask, const string& filename, const string& intermediateProcessesDir ) { VoxelMatrix<float> regionMatrix; regionMatrix = applyLabelling( originalVoxelMatrix, nucleusMask, filename, intermediateProcessesDir ); // VoxelMatrix<float> regionMatrix( intermediateProcessesDir + filename + "-gradient.vm" ); // EVAL(regionMatrix.getSize()); VoxelMatrix<float> rangeMask, copyVoxelMatrix = originalVoxelMatrix; RegionAnalysis3D<float> regionAnalysis; regionAnalysis.setLabelMatrix( regionMatrix ); regionAnalysis.setValueMatrix( copyVoxelMatrix ); regionAnalysis.run(); rangeMask.setSize( copyVoxelMatrix.getSize() ); rangeMask.setZeros(); regionAnalysis.setOutputMatrix( rangeMask ); regionAnalysis.outputFillRegions( REGION_FEATURE_CONTRAST ); //regionAnalysis.outputFillRegions( REGION_FEATURE_CONTRACTNESS ); rangeMask.save( intermediateProcessesDir + filename + "-contrast.vm", true ); //rangeMask.save( intermediateProcessesDir + filename + "-contractness.vm", true ); OtsuThresholding<float> otsuThresholding; Vector <float> featureValues = regionAnalysis.computeRegionFeature( REGION_FEATURE_CONTRAST ); //Vector <float> featureValues = regionAnalysis.computeRegionFeature( REGION_FEATURE_CONTRACTNESS ); featureValues.sort(); Vector <unsigned int> histogram = featureValues.histogram( featureValues.min(), 1, floor(featureValues.max())+1 ); float threshold = otsuThresholding.computeThreshold( histogram ); //float threshold = otsuThresholding.computeThreshold( histogram * 0.8 ); EVAL(featureValues); EVAL(histogram); EVAL(threshold); regionAnalysis.thresholdRegions( featureValues, threshold ); regionAnalysis.run(); int num = regionAnalysis.condenseRegionLabels(); regionAnalysis.run(); EVAL(num); VoxelMatrix<float> ccsMask = regionAnalysis.getLabelMatrix(); //to obtain a better filling, it's applied to each 2D slice instead of the complete 3D stack HolesFillingf holesFilling; int sizeZ = ccsMask.getSize3(); for (int k = 0; k < sizeZ; ++k) holesFilling.apply( ccsMask[k] ); // VoxelMatrix<float> ccsFillMask = ccsMask; // ccsMask.fillIt(ccsFillMask); // VoxelMatrix<float> structElement; // structElement.setSize(3,3,3); // structElement.setOnes(); // VoxelMatrixDilatation<float> voxelDilatation; // voxelDilatation.setStructElt( structElement ); // voxelDilatation.apply( ccsMask ); // // VoxelMatrix<float> structElement2; // // structElement2.setSize(1,1,1); // // structElement2.setOnes(); // VoxelMatrixErosion<float> voxelErosion; // voxelErosion.setStructElt( structElement ); // voxelErosion.apply( ccsMask ); // for (int k = 0; k < sizeZ; ++k) holesFilling.apply( ccsMask[k] ); ccsMask.setVoxelCalibration( originalVoxelMatrix.getVoxelCalibration() ); //ccsMask.save( chromocentersDir + filename + ".vm", true ); return ccsMask; }
malValuePtr EVAL(malValuePtr ast, malEnvPtr env) { if (!env) { env = replEnv; } while (1) { const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } ast = macroExpand(ast, env); list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } // From here on down we are evaluating a non-empty list. // First handle the special forms. if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { String special = symbol->value(); int argCount = list->count() - 1; if (special == "def!") { checkArgsIs("def!", 2, argCount); const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); return env->set(id->value(), EVAL(list->item(2), env)); } if (special == "defmacro!") { checkArgsIs("defmacro!", 2, argCount); const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); malValuePtr body = EVAL(list->item(2), env); const malLambda* lambda = VALUE_CAST(malLambda, body); return env->set(id->value(), mal::macro(*lambda)); } if (special == "do") { checkArgsAtLeast("do", 1, argCount); for (int i = 1; i < argCount; i++) { EVAL(list->item(i), env); } ast = list->item(argCount); continue; // TCO } if (special == "fn*") { checkArgsIs("fn*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); StringVec params; for (int i = 0; i < bindings->count(); i++) { const malSymbol* sym = VALUE_CAST(malSymbol, bindings->item(i)); params.push_back(sym->value()); } return mal::lambda(params, list->item(2), env); } if (special == "if") { checkArgsBetween("if", 2, 3, argCount); bool isTrue = EVAL(list->item(1), env)->isTrue(); if (!isTrue && (argCount == 2)) { return mal::nilValue(); } ast = list->item(isTrue ? 2 : 3); continue; // TCO } if (special == "let*") { checkArgsIs("let*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); int count = checkArgsEven("let*", bindings->count()); malEnvPtr inner(new malEnv(env)); for (int i = 0; i < count; i += 2) { const malSymbol* var = VALUE_CAST(malSymbol, bindings->item(i)); inner->set(var->value(), EVAL(bindings->item(i+1), inner)); } ast = list->item(2); env = inner; continue; // TCO } if (special == "macroexpand") { checkArgsIs("macroexpand", 1, argCount); return macroExpand(list->item(1), env); } if (special == "quasiquote") { checkArgsIs("quasiquote", 1, argCount); ast = quasiquote(list->item(1)); continue; // TCO } if (special == "quote") { checkArgsIs("quote", 1, argCount); return list->item(1); } if (special == "try*") { checkArgsIs("try*", 2, argCount); malValuePtr tryBody = list->item(1); const malList* catchBlock = VALUE_CAST(malList, list->item(2)); checkArgsIs("catch*", 2, catchBlock->count() - 1); MAL_CHECK(VALUE_CAST(malSymbol, catchBlock->item(0))->value() == "catch*", "catch block must begin with catch*"); // We don't need excSym at this scope, but we want to check // that the catch block is valid always, not just in case of // an exception. const malSymbol* excSym = VALUE_CAST(malSymbol, catchBlock->item(1)); malValuePtr excVal; try { ast = EVAL(tryBody, env); } catch(String& s) { excVal = mal::string(s); } catch (malEmptyInputException&) { // Not an error, continue as if we got nil ast = mal::nilValue(); } catch(malValuePtr& o) { excVal = o; }; if (excVal) { // we got some exception env = malEnvPtr(new malEnv(env)); env->set(excSym->value(), excVal); ast = catchBlock->item(2); } continue; // TCO } } // Now we're left with the case of a regular list to be evaluated. std::unique_ptr<malValueVec> items(list->evalItems(env)); malValuePtr op = items->at(0); if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { ast = lambda->getBody(); env = lambda->makeEnv(items->begin()+1, items->end()); continue; // TCO } else { return APPLY(op, items->begin()+1, items->end()); } } }
// (xor 'any 'any) -> flg any doXor(any x) { bool f; x = cdr(x), f = isNil(EVAL(car(x))), x = cdr(x); return f ^ isNil(EVAL(car(x)))? T : Nil; }
// draw the image warped by the current homography static void draw_warped_image(struct FTR *f) { struct viewer_state *e = f->userdata; int w = e->iw; int h = e->ih; double H[3][3]; obtain_current_homography(H, e); /* H[0][0]=0.107933; H[0][1]=0.000899; H[0][2]=-3.784855; H[1][0]=-0.747116; H[1][1]=0.778536; H[1][2]=19.920756; H[2][0]=-0.000941; H[2][1]=-0.000131; H[2][2]=1.;*/ extrapolator_t OUT = obtain_extrapolator(e); interpolator_t EVAL = obtain_interpolator(e); if(e->interpolation_order == 0){ for (int j = 0; j < f->h; j++){ for (int i = 0; i < f->w; i++){ double p[2] = {i, j}; apply_homography(p, H, p); p[0] = (p[0] - 0.5) * w / (w - 1.0); p[1] = (p[1] - 0.5) * h / (h - 1.0); for (int l = 0; l < 3; l++){ int idx = l + 3 * (f->w * j + i); float v = EVAL(e->img, w, h, e->pd, p[0], p[1], l, OUT); f->rgb[idx] = v; } } } } if(e->interpolation_order==1){ float *img_f = malloc(3*(f->w)*(f->h)*sizeof(float)); for(int i=0;i<(f->w)*(f->h)*3;i++){img_f[i]=0;} clock_t debutcpu,fincpu; debutcpu = clock(); if(e->pd==3){ apply_homo_ground_truth(e->img,img_f,w,h,f->w,f->h,H); }else{//suppose pd=1 float *img3 = malloc(3*w*h*sizeof(float)); for(int i=0;i<w*h;i++){ for(int l = 0;l<3;l++){ img3[3*i+l]=e->img[i]; } } apply_homo_ground_truth(img3,img_f,w,h,f->w,f->h,H); } for(int i=0;i<3*(f->w)*(f->h);i++){(f->rgb)[i]=float_to_byte(img_f[i]);} fincpu = clock(); printf("cputime :%fs\n",(double)(fincpu-debutcpu)/CLOCKS_PER_SEC); } }
LispObj * Lisp_PQgetvalue(LispBuiltin *builtin) /* pq-getvalue result tuple field &optional type-specifier */ { char *string; double real = 0.0; PGresult *res; int tuple, field, isint = 0, isreal = 0, integer; LispObj *result, *otupple, *field_number, *type; type = ARGUMENT(3); field_number = ARGUMENT(2); otupple = ARGUMENT(1); result = ARGUMENT(0); if (!CHECKO(result, PGresult_t)) LispDestroy("%s: cannot convert %s to PGresult*", STRFUN(builtin), STROBJ(result)); res = (PGresult*)(result->data.opaque.data); CHECK_INDEX(otupple); tuple = FIXNUM_VALUE(otupple); CHECK_INDEX(field_number); field = FIXNUM_VALUE(field_number); string = PQgetvalue(res, tuple, field); if (type != UNSPEC) { char *typestring; CHECK_SYMBOL(type); typestring = ATOMID(type); if (strcmp(typestring, "INT16") == 0) { integer = *(short*)string; isint = 1; goto simple_type; } else if (strcmp(typestring, "INT32") == 0) { integer = *(int*)string; isint = 1; goto simple_type; } else if (strcmp(typestring, "FLOAT") == 0) { real = *(float*)string; isreal = 1; goto simple_type; } else if (strcmp(typestring, "REAL") == 0) { real = *(double*)string; isreal = 1; goto simple_type; } else if (strcmp(typestring, "PG-POLYGON") == 0) goto polygon_type; else if (strcmp(typestring, "STRING") != 0) LispDestroy("%s: unknown type %s", STRFUN(builtin), typestring); } simple_type: return (isint ? INTEGER(integer) : isreal ? DFLOAT(real) : (string ? STRING(string) : NIL)); polygon_type: { LispObj *poly, *box, *p = NIL, *cdr, *obj; POLYGON *polygon; int i, size; size = PQgetlength(res, tuple, field); polygon = (POLYGON*)(string - sizeof(int)); GCDisable(); /* get polygon->boundbox */ cdr = EVAL(CONS(ATOM("MAKE-PG-POINT"), CONS(KEYWORD("X"), CONS(REAL(polygon->boundbox.high.x), CONS(KEYWORD("Y"), CONS(REAL(polygon->boundbox.high.y), NIL)))))); obj = EVAL(CONS(ATOM("MAKE-PG-POINT"), CONS(KEYWORD("X"), CONS(REAL(polygon->boundbox.low.x), CONS(KEYWORD("Y"), CONS(REAL(polygon->boundbox.low.y), NIL)))))); box = EVAL(CONS(ATOM("MAKE-PG-BOX"), CONS(KEYWORD("HIGH"), CONS(cdr, CONS(KEYWORD("LOW"), CONS(obj, NIL)))))); /* get polygon->p values */ for (i = 0; i < polygon->npts; i++) { obj = EVAL(CONS(ATOM("MAKE-PG-POINT"), CONS(KEYWORD("X"), CONS(REAL(polygon->p[i].x), CONS(KEYWORD("Y"), CONS(REAL(polygon->p[i].y), NIL)))))); if (i == 0) p = cdr = CONS(obj, NIL); else { RPLACD(cdr, CONS(obj, NIL)); cdr = CDR(cdr); } } /* make result */ poly = EVAL(CONS(ATOM("MAKE-PG-POLYGON"), CONS(KEYWORD("SIZE"), CONS(REAL(size), CONS(KEYWORD("NUM-POINTS"), CONS(REAL(polygon->npts), CONS(KEYWORD("BOUNDBOX"), CONS(box, CONS(KEYWORD("POINTS"), CONS(QUOTE(p), NIL)))))))))); GCEnable(); return (poly); } }
// (lit 'any) -> any any doLit(any x) { x = cadr(x); if (isNum(x = EVAL(x)) || isNil(x) || x == T || isCell(x) && isNum(car(x))) return x; return cons(Quote, x); }
/////////////////////////////// // FIXME - make it loop over // - eval_ast // - apply // ast EVAL (ast tree, environment::ptr a_env) { for (;;) { if (!tree) return tree; if (tree->type () != node_type_enum::LIST) return eval_ast (tree, a_env); // not as_or_throw - we know the type auto root_list = tree->as<ast_node_list> (); if (root_list->empty ()) return tree; // auto fn_handle_def = [root_list, &a_env]() { if (root_list->size () != 3) raise<mal_exception_eval_invalid_arg> (root_list->to_string ()); const auto& key = (*root_list)[1]->as_or_throw<ast_node_symbol, mal_exception_eval_invalid_arg> ()->symbol (); ast_node::ptr value = EVAL ((*root_list)[2], a_env); a_env->set (key, value); return value; }; // tco auto fn_handle_let_tco = [root_list, &a_env]() -> tco { if (root_list->size () != 3) raise<mal_exception_eval_invalid_arg> (root_list->to_string ()); const ast_node_container_base* let_bindings = nullptr; const auto root_list_arg_1 = (*root_list)[1]; switch (root_list_arg_1->type ()) { case node_type_enum::LIST: case node_type_enum::VECTOR: let_bindings = root_list_arg_1->as<ast_node_container_base> (); break; default: raise<mal_exception_eval_invalid_arg> (root_list_arg_1->to_string ()); }; // auto let_env = environment::make (a_env); if (let_bindings->size () % 2 != 0) raise<mal_exception_eval_invalid_arg> (let_bindings->to_string ()); for (size_t i = 0, e = let_bindings->size(); i < e; i += 2) { const auto& key = (*let_bindings)[i]->as_or_throw<ast_node_symbol, mal_exception_eval_invalid_arg> ()->symbol (); ast_node::ptr value = EVAL ((*let_bindings)[i + 1], let_env); let_env->set (key, value); } return {(*root_list)[2], let_env}; }; // tco auto fn_handle_apply_tco= [&tree, &a_env]() -> tco { ast_node::ptr new_node = eval_ast (tree, a_env); auto callable_list = new_node->as_or_throw<ast_node_list, mal_exception_eval_not_list> (); const size_t list_size = callable_list->size (); if (list_size == 0) raise<mal_exception_eval_not_callable> (callable_list->to_string ()); auto && callable_node = (*callable_list)[0]->as_or_throw<ast_node_callable, mal_exception_eval_not_callable> (); return callable_node->call_tco (call_arguments (callable_list, 1, list_size - 1)); }; // tco auto fn_handle_do_tco = [root_list, &a_env]() -> tco { const size_t list_size = root_list->size (); if (list_size < 2) raise<mal_exception_eval_invalid_arg> (root_list->to_string ()); for (size_t i = 1, e = list_size - 1; i < e; ++i) { /*retVal = */EVAL ((*root_list)[i], a_env); } return {(*root_list)[list_size - 1], a_env}; }; // tco auto fn_handle_if_tco = [root_list, &a_env] () -> tco { const size_t list_size = root_list->size (); if (list_size < 3 || list_size > 4) raise<mal_exception_eval_invalid_arg> (root_list->to_string ()); ast_node::ptr condNode = EVAL ((*root_list)[1], a_env); const bool cond = !(condNode == ast_node::nil_node) && !(condNode == ast_node::false_node); if (cond) return {(*root_list)[2], a_env}; else if (list_size == 4) return {(*root_list)[3], a_env}; return tco {nullptr, nullptr, ast_node::nil_node}; }; auto fn_handle_fn = [root_list, &a_env] () -> ast { const size_t list_size = root_list->size (); if (list_size != 3) raise<mal_exception_eval_invalid_arg> (root_list->to_string ()); auto&& bindsNode = (*root_list)[1]; auto&& astNode = (*root_list)[2]; ast_node::ptr retVal = std::make_shared<ast_node_callable_lambda> (bindsNode, astNode, a_env); return retVal; }; auto first = (*root_list)[0]; if (first->type () == node_type_enum::SYMBOL) { // apply special symbols // not as_or_throw - we know the type const auto first_symbol = first->as<ast_node_symbol> (); const auto& symbol = first_symbol->symbol (); if (symbol == "def!") { return fn_handle_def (); } else if (symbol == "let*") { std::tie (tree, a_env, std::ignore) = fn_handle_let_tco (); continue; } else if (symbol == "do") { std::tie (tree, a_env, std::ignore) = fn_handle_do_tco (); continue; } else if (symbol == "if") { ast retVal; std::tie (tree, a_env, retVal) = fn_handle_if_tco (); if (retVal) return retVal; continue; } else if (symbol == "fn*") { return fn_handle_fn (); } } // apply { ast retVal; std::tie (tree, a_env, retVal) = fn_handle_apply_tco (); if (retVal) return retVal; continue; } } }
malValuePtr EVAL(malValuePtr ast, malEnvPtr env) { const malList* list = DYNAMIC_CAST(malList, ast); if (!list || (list->count() == 0)) { return ast->eval(env); } // From here on down we are evaluating a non-empty list. // First handle the special forms. if (const malSymbol* symbol = DYNAMIC_CAST(malSymbol, list->item(0))) { String special = symbol->value(); int argCount = list->count() - 1; if (special == "def!") { checkArgsIs("def!", 2, argCount); const malSymbol* id = VALUE_CAST(malSymbol, list->item(1)); return env->set(id->value(), EVAL(list->item(2), env)); } if (special == "do") { checkArgsAtLeast("do", 1, argCount); for (int i = 1; i < argCount; i++) { EVAL(list->item(i), env); } return EVAL(list->item(argCount), env); } if (special == "fn*") { checkArgsIs("fn*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); StringVec params; for (int i = 0; i < bindings->count(); i++) { const malSymbol* sym = VALUE_CAST(malSymbol, bindings->item(i)); params.push_back(sym->value()); } return mal::lambda(params, list->item(2), env); } if (special == "if") { checkArgsBetween("if", 2, 3, argCount); bool isTrue = EVAL(list->item(1), env)->isTrue(); if (!isTrue && (argCount == 2)) { return mal::nilValue(); } return EVAL(list->item(isTrue ? 2 : 3), env); } if (special == "let*") { checkArgsIs("let*", 2, argCount); const malSequence* bindings = VALUE_CAST(malSequence, list->item(1)); int count = checkArgsEven("let*", bindings->count()); malEnvPtr inner(new malEnv(env)); for (int i = 0; i < count; i += 2) { const malSymbol* var = VALUE_CAST(malSymbol, bindings->item(i)); inner->set(var->value(), EVAL(bindings->item(i+1), inner)); } return EVAL(list->item(2), inner); } } // Now we're left with the case of a regular list to be evaluated. std::unique_ptr<malValueVec> items(list->evalItems(env)); malValuePtr op = items->at(0); if (const malLambda* lambda = DYNAMIC_CAST(malLambda, op)) { return EVAL(lambda->getBody(), lambda->makeEnv(items->begin()+1, items->end())); } else { return APPLY(op, items->begin()+1, items->end(), env); } }
std::string rep (const std::string& line, environment::ptr env) { return PRINT (EVAL ( READ (line), env)); }
// (gc ['num]) -> num | NIL any doGc(any x) { x = cdr(x); gc(isNum(x = EVAL(car(x)))? CELLS*unBox(x) : CELLS); return x; }
void rep () { PRINT (EVAL ( READ())); }
// (box 'any) -> sym any doBox(any x) { x = cdr(x); return consSym(EVAL(car(x)), Nil); }
void segfault_KGML(int signal, siginfo_t *si, void *arg){ EVAL(lang2(install("registerMemoryErr"), mkString("KGML2igraph"))); error("Critical memory error in KGML2igraph. Please save your work and restart R."); }
// (as 'any1 . any2) -> any2 | NIL any doAs(any x) { x = cdr(x); if (isNil(EVAL(car(x)))) return Nil; return cdr(x); }
/* ****************************************************************** ****************************************************************** */ void inip (int* n,double** x,double** l, double** u,int* m, double** lambda,int** equatn,int** linear,int* coded, int* checkder) { int i; SEXP n_r,m_r,x_r,l_r,u_r,lambda_r,rho_r,equatn_r,linear_r,coded_r, checkder_r; *n = 0; *m = 0; defineVar(install("x") ,createRRealVector(*n,NULL) ,environment_r); defineVar(install("l") ,createRRealVector(*n,NULL) ,environment_r); defineVar(install("u") ,createRRealVector(*n,NULL) ,environment_r); defineVar(install("lambda") ,createRRealVector(*m,NULL) ,environment_r); defineVar(install("equatn") ,createRIntVector(*m,NULL) ,environment_r); defineVar(install("linear") ,createRIntVector(*m,NULL) ,environment_r); defineVar(install("coded") ,createRIntVector(11,NULL) ,environment_r); defineVar(install("checkder"),createRIntScalar(*checkder),environment_r); EVAL(inip_r); n_r = findVar(install("n") ,environment_r); x_r = findVar(install("x") ,environment_r); l_r = findVar(install("l") ,environment_r); u_r = findVar(install("u") ,environment_r); m_r = findVar(install("m") ,environment_r); lambda_r = findVar(install("lambda") ,environment_r); equatn_r = findVar(install("equatn") ,environment_r); linear_r = findVar(install("linear") ,environment_r); coded_r = findVar(install("coded") ,environment_r); checkder_r = findVar(install("checkder"),environment_r); *n = (INTEGER(AS_INTEGER(EVAL(n_r))))[0]; *m = (INTEGER(AS_INTEGER(EVAL(m_r))))[0]; *checkder = (INTEGER(AS_INTEGER(EVAL(checkder_r))))[0]; *x = (double *) malloc(*n * sizeof(double)); *l = (double *) malloc(*n * sizeof(double)); *u = (double *) malloc(*n * sizeof(double)); *lambda = (double *) malloc(*m * sizeof(double)); *equatn = (int *) malloc(*m * sizeof(int )); *linear = (int *) malloc(*m * sizeof(int )); for(i = 0; i < *n; i++) { (*x)[i] = (REAL(EVAL(x_r)))[i]; (*l)[i] = (REAL(EVAL(l_r)))[i]; (*u)[i] = (REAL(EVAL(u_r)))[i]; } for(i = 0; i < *m; i++) { (*lambda)[i] = (REAL(EVAL(lambda_r)))[i]; (*equatn)[i] = (INTEGER(AS_INTEGER(EVAL(equatn_r))))[i]; (*linear)[i] = (INTEGER(AS_INTEGER(EVAL(linear_r))))[i]; } for(i = 0; i < 11; i++) { coded[i] = (INTEGER(AS_INTEGER(EVAL(coded_r))))[i]; } }
// (eval 'any ['cnt ['lst]]) -> any any doEval(any x) { any y; cell c1; bindFrame *p; x = cdr(x), Push(c1, EVAL(car(x))), x = cdr(x); if (!isNum(y = EVAL(car(x))) || !(p = Env.bind)) data(c1) = EVAL(data(c1)); else { int cnt, n, i, j; struct { // bindFrame struct bindFrame *link; int i, cnt; struct {any sym; any val;} bnd[length(x)]; } f; x = cdr(x), x = EVAL(car(x)); j = cnt = (int)unBox(y); n = f.i = f.cnt = 0; do { ++n; if ((i = p->i) <= 0 && (p->i -= cnt, i == 0)) { for (i = 0; i < p->cnt; ++i) { y = val(p->bnd[i].sym); val(p->bnd[i].sym) = p->bnd[i].val; p->bnd[i].val = y; } if (p->cnt && p->bnd[0].sym == At && !--j) break; } } while (p = p->link); while (isCell(x)) { for (p = Env.bind, j = n; ; p = p->link) { if (p->i < 0) for (i = 0; i < p->cnt; ++i) { if (p->bnd[i].sym == car(x)) { f.bnd[f.cnt].val = val(f.bnd[f.cnt].sym = car(x)); val(car(x)) = p->bnd[i].val; ++f.cnt; goto next; } } if (!--j) break; } next: x = cdr(x); } f.link = Env.bind, Env.bind = (bindFrame*)&f; data(c1) = EVAL(data(c1)); while (--f.cnt >= 0) val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val; Env.bind = f.link; do { for (p = Env.bind, i = n; --i; p = p->link); if (p->i < 0 && (p->i += cnt) == 0) for (i = p->cnt; --i >= 0;) { y = val(p->bnd[i].sym); val(p->bnd[i].sym) = p->bnd[i].val; p->bnd[i].val = y; } } while (--n); } return Pop(c1); }
void evalgjacp(int n,double *x,double *g,int m,double *p,double *q, char work,int *gotj,int *flag) { int i; SEXP g_r,p_r,q_r,gotj_r,flag_r; defineVar(install("n") ,createRIntScalar(n) ,environment_r); defineVar(install("x") ,createRRealVector(n,x) ,environment_r); defineVar(install("m") ,createRIntScalar(m) ,environment_r); defineVar(install("work"),createRCharScalar(work),environment_r); defineVar(install("gotj") ,createRIntScalar(*gotj) ,environment_r); if ( work == 'J' || work == 'T' ) { // Compute g defineVar(install("g"),createRRealVector(n,x),environment_r); } if ( work == 'j' || work == 'J' ) { // Compute p = Jac q defineVar(install("q"),createRRealVector(n,q) ,environment_r); defineVar(install("p"),createRRealVector(1,NULL) ,environment_r); } else // if ( work == 't' || work == 'T' ) { // Compute q = Jac^t p defineVar(install("p"),createRRealVector(m,p) ,environment_r); defineVar(install("q"),createRRealVector(1,NULL) ,environment_r); } EVAL(evalgjacp_r); if ( work == 'J' || work == 'T' ) { // Compute g g_r = findVar(install("g") ,environment_r); for (i = 0; i < n; i++) g[i] = (REAL(EVAL(g_r)))[i]; } if ( work == 'j' || work == 'J' ) { // Compute p = Jac q p_r = findVar(install("p"),environment_r); for (i = 0; i < n; i++) p[i] = (REAL(EVAL(p_r)))[i]; } else // if ( work == 't' || work == 'T' ) { // Compute q = Jac^t p q_r = findVar(install("q"),environment_r); for (i = 0; i < n; i++) q[i] = (REAL(EVAL(q_r)))[i]; } gotj_r = findVar(install("gotj") ,environment_r); flag_r = findVar(install("flag") ,environment_r); *gotj = (INTEGER(AS_INTEGER(EVAL(gotj_r))))[0]; *flag = (INTEGER(AS_INTEGER(EVAL(flag_r))))[0]; }
// (bool 'any) -> flg any doBool(any x) {return isNil(EVAL(cadr(x)))? Nil : T;}
// (for sym 'num ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any // (for sym|(sym2 . sym) 'lst ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any // (for (sym|(sym2 . sym) 'any1 'any2 [. prg]) ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any any doFor(any x) { any y, body, cond, a; cell c1; struct { // bindFrame struct bindFrame *link; int i, cnt; struct {any sym; any val;} bnd[2]; } f; f.link = Env.bind, Env.bind = (bindFrame*)&f; f.i = 0; if (!isCell(y = car(x = cdr(x))) || !isCell(cdr(y))) { if (!isCell(y)) { f.cnt = 1; f.bnd[0].sym = y; f.bnd[0].val = val(y); } else { f.cnt = 2; f.bnd[0].sym = cdr(y); f.bnd[0].val = val(cdr(y)); f.bnd[1].sym = car(y); f.bnd[1].val = val(car(y)); val(f.bnd[1].sym) = Zero; } y = Nil; x = cdr(x), Push(c1, EVAL(car(x))); if (isNum(data(c1))) val(f.bnd[0].sym) = Zero; body = x = cdr(x); for (;;) { if (isNum(data(c1))) { val(f.bnd[0].sym) = bigCopy(val(f.bnd[0].sym)); digAdd(val(f.bnd[0].sym), 2); if (bigCompare(val(f.bnd[0].sym), data(c1)) > 0) break; } else { if (!isCell(data(c1))) break; val(f.bnd[0].sym) = car(data(c1)); if (!isCell(data(c1) = cdr(data(c1)))) data(c1) = Nil; } if (f.cnt == 2) { val(f.bnd[1].sym) = bigCopy(val(f.bnd[1].sym)); digAdd(val(f.bnd[1].sym), 2); } do { if (!isNum(y = car(x))) { if (isSym(y)) y = val(y); else if (isNil(car(y))) { y = cdr(y); if (isNil(a = EVAL(car(y)))) { y = prog(cdr(y)); goto for1; } val(At) = a; y = Nil; } else if (car(y) == T) { y = cdr(y); if (!isNil(a = EVAL(car(y)))) { val(At) = a; y = prog(cdr(y)); goto for1; } y = Nil; } else y = evList(y); } } while (isCell(x = cdr(x))); x = body; } for1: drop(c1); if (f.cnt == 2) val(f.bnd[1].sym) = f.bnd[1].val; val(f.bnd[0].sym) = f.bnd[0].val; Env.bind = f.link; return y; } if (!isCell(car(y))) { f.cnt = 1; f.bnd[0].sym = car(y); f.bnd[0].val = val(car(y)); } else { f.cnt = 2; f.bnd[0].sym = cdar(y); f.bnd[0].val = val(cdar(y)); f.bnd[1].sym = caar(y); f.bnd[1].val = val(caar(y)); val(f.bnd[1].sym) = Zero; } y = cdr(y); val(f.bnd[0].sym) = EVAL(car(y)); y = cdr(y), cond = car(y), y = cdr(y); Push(c1,Nil); body = x = cdr(x); while (!isNil(a = EVAL(cond))) { val(At) = a; if (f.cnt == 2) { val(f.bnd[1].sym) = bigCopy(val(f.bnd[1].sym)); digAdd(val(f.bnd[1].sym), 2); } do { if (!isNum(data(c1) = car(x))) { if (isSym(data(c1))) data(c1) = val(data(c1)); else if (isNil(car(data(c1)))) { data(c1) = cdr(data(c1)); if (isNil(a = EVAL(car(data(c1))))) { data(c1) = prog(cdr(data(c1))); goto for2; } val(At) = a; data(c1) = Nil; } else if (car(data(c1)) == T) { data(c1) = cdr(data(c1)); if (!isNil(a = EVAL(car(data(c1))))) { val(At) = a; data(c1) = prog(cdr(data(c1))); goto for2; } data(c1) = Nil; } else data(c1) = evList(data(c1)); } } while (isCell(x = cdr(x))); if (isCell(y)) val(f.bnd[0].sym) = prog(y); x = body; } for2: if (f.cnt == 2) val(f.bnd[1].sym) = f.bnd[1].val; val(f.bnd[0].sym) = f.bnd[0].val; Env.bind = f.link; return Pop(c1); }
/** solve an equation of the form $f[ ae^{nt} + be^{mt} + c = 0 $f] @returns the solution in $f[ t $f], or etp::NaN if none found **/ double e2solve(double a,/**< the parameter \p a */ double n, /**< the parameter \p n (should be negative) */ double b, /**< the parameter \p b */ double m, /**< the parameter \p m (should be negative) */ double c, /**< the constant \p c */ double p, /**< the precision (1e-8 if omitted) */ double *e) /**< pointer to error estimate (null if none desired) */ { double t=0; double f = EVAL(t,a,n,b,m,c); // check for degenerate cases (1 exponential term is dominant) // solve for t in dominant exponential, but only when a solution exists // (c must be opposite sign of scalar and have less magnitude than scalar) if (fabs(a/b)<p) // a is dominant return c*b<0 && fabs(c)<fabs(b) ? log(-c/b)/m : NaN; else if (fabs(b/a)<p) // b is dominant return c*a<0 && fabs(c)<fabs(a) ? log(-c/a)/n : NaN; // is there an extremum/inflexion to consider if (a*b<0) { // compute the time t and value fi at which it occurs double an_bm = -a*n/(b*m); double tm = log(an_bm)/(m-n); double fm = EVAL(tm,a,n,b,m,c); double ti = log(an_bm*n/m)/(m-n); double fi = EVAL(ti,a,n,b,m,c); if (tm>0) // extremum in domain { if (f*fm<0) // first solution is in range t = 0; else if (c*fm<0) // second solution is in range t = ti; else // no solution is in range return NaN; } else if (tm<0 && ti>0) // no extremum but inflexion in domain { if (fm*c<0) // solution in range t = ti; else // no solution in range return NaN; } else if (ti<0) // no extremum or inflexion in domain { if (fi*c<0) // solution in range t = ti; else // no solution in range return NaN; } else // no solution possible (includes tm==0 and ti==0) return NaN; } else if (f*c>0) // solution is not reachable from t=0 (same sign) { return NaN; } // solve using Newton's method int iter = 100; if (t!=0) // initial t changed to inflexion point double f = EVAL(t,a,n,b,m,c); double dfdt = EVAL(t,a*n,n,b*m,m,0); while ( fabs(f)>p && isfinite(t) && iter-->0) { t -= f/dfdt; f = EVAL(t,a,n,b,m,c); dfdt = EVAL(t,a*n,n,b*m,m,0); } if (iter==0) { gl_error("etp::solve(a=%.4f,n=%.4f,b=%.4f,m=%.4f,c=%.4f,prec=%.g) failed to converge",a,n,b,m,c,p); return NaN; // failed to catch limit condition above } if (e!=NULL) *e = p/dfdt; return t>0?t:NaN; }
// (! . exe) -> any any doBreak(any x) { x = cdr(x); if (!isNil(val(Dbg))) x = brkLoad(x); return EVAL(x); }
String rep(const String& input, malEnvPtr env) { return PRINT(EVAL(READ(input), env)); }
// (bye 'cnt|NIL) any doBye(any ex) { any x = EVAL(cadr(ex)); bye(isNil(x)? 0 : xCnt(ex,x)); }
Vector<T> CDFTools<T>::areasDifference( const Vector<T>& y1, const Vector<T>& x1, const Vector<T>& y2, const Vector<T>& x2) const { if ( y1.isIncreasing() == false || y2.isIncreasing() == false ) { UsageError usageError; usageError.setWhere( "void CDFTools<T>::areasDifference(...) const" ); usageError.setWhat( "The cdf passed is not an increasing number sequence" ); throw usageError; } if ( x1.getSize() != y1.getSize() || x2.getSize() != y2.getSize() ) { UsageError usageError; usageError.setWhere( "void CDFTools<T>::areasDifference(...) const" ); usageError.setWhat( "The sizes of at least one cdf passed and its repartition function do not match to each other" ); usageError.setWhat( "Use Vector<T> CDFTools<T>::cdf(const Vector<T>&) if needed..." ); throw usageError; } Vector<T> areasDifference; // | __| // | | -->y[0] -- y axis // | _| // |_|____ -->x[0] -- x axis // // EVAL(y1); // EVAL(x1); // EVAL(y2); // EVAL(x2); T area1, area2; area1 = 0; area2 = 0; for ( int i = 1; i < y1.getSize(); ++i ) area1 += ( x1[i]-x1[i-1] ) * y1[i-1]; EVAL(area1); for ( int i = 1; i < y2.getSize(); ++i ) area2 += ( x2[i]-x2[i-1] ) * y2[i-1]; EVAL(area2); // output with 4 indexes areasDifference.setSize( 6 ); areasDifference[0] = area1; areasDifference[1] = area2; // 1) Difference of areas areasDifference[2] = abs( area1 - area2 ); // 2) Difference of areas ^ 2 areasDifference[3] = abs( pow( area1, 2.) - pow( area2, 2.) ); // 3) Coefficient between areas if ( area1 < area2 ) areasDifference[2] = area1 / area2; else areasDifference[4] = area2 / area1; // 4) Coefficient between areas ^ 2 if ( area1 < area2 ) areasDifference[3] = pow( area1, 2.) / pow( area2, 2.); else areasDifference[5] = pow( area2, 2.) / pow( area1, 2.); return areasDifference; }
/* Conforms to the specification and the behavior of Gauche 0.8.8. * http://gauche.sourceforge.jp/doc/gauche-refe_82.html */ SCM_EXPORT ScmObj scm_s_let_optionalsstar(ScmObj args, ScmObj bindings, ScmObj body, ScmEvalState *eval_state) { ScmObj env, var, val, exp, binding; DECLARE_FUNCTION("let-optionals*", syntax_variadic_tailrec_2); env = eval_state->env; args = EVAL(args, env); ENSURE_LIST(args); /*======================================================================= (let-optionals* <restargs> (<binding spec>*) <body>) (let-optionals* <restargs> (<binding spec>+ . <restvar>) <body>) (let-optionals* <restargs> <restvar> <body>) ;; Gauche 0.8.8 <binding spec> --> (<variable> <expression>) | <variable> <restvar> --> <variable> <body> --> <definition>* <sequence> <definition> --> (define <variable> <expression>) | (define (<variable> <def formals>) <body>) | (begin <definition>*) <sequence> --> <command>* <expression> <command> --> <expression> =======================================================================*/ FOR_EACH (binding, bindings) { if (LIST_2_P(binding)) { var = CAR(binding); exp = CADR(binding); } else { var = binding; exp = SCM_UNDEF; } if (!IDENTIFIERP(var)) ERR_OBJ(ERRMSG_INVALID_BINDING, binding); if (NULLP(args)) { /* the second element is only evaluated when there are not enough * arguments */ val = EVAL(exp, env); CHECK_VALID_EVALED_VALUE(val); } else { val = POP(args); } /* extend env for each variable */ env = scm_extend_environment(LIST_1(var), LIST_1(val), env); } if (IDENTIFIERP(bindings)) { var = bindings; env = scm_extend_environment(LIST_1(var), LIST_1(args), env); } else if (!NULLP(bindings)) { ERR_OBJ(ERRMSG_INVALID_BINDINGS, bindings); } eval_state->env = env; return scm_s_body(body, eval_state); }