From fe4dd44276a50261ff51bfa898721c6089c3dc7f Mon Sep 17 00:00:00 2001
From: Yannick Ulrich <yannick.ulrich@psi.ch>
Date: Tue, 18 Feb 2020 08:25:38 +0100
Subject: [PATCH] Fixing #12 in Mathematica
---
vegas.mm | 20 +++++++++++---------
1 file changed, 11 insertions(+), 9 deletions(-)
diff --git a/vegas.mm b/vegas.mm
index e5d24e6..0d8efcb 100644
--- a/vegas.mm
+++ b/vegas.mm
@@ -304,16 +304,18 @@ MergePlots[list_, chi_:False] := Quiet[Module[{out, chilist},
]]
-CombinePlots[A_, B_, OptionsPattern[]] := Block[{opE, x1, x2},
+
+CombinePlots[A_, B_, OptionsPattern[]] := Block[{opE, x1, x2, newx, newy, newe, maskA, maskB},
opE[e1_, y1_, e2_, y2_] := Sqrt[D[OptionValue[op][x1, x2], x1]^2 e1^2 + D[OptionValue[op][x1, x2], x2]^2 e2^2] /. {x1 -> y1, x2 -> y2};
- Select[
- Table[Table[
- If[A[[i]][[1]] == B[[j]][[1]], {A[[i]][[1]],
- OptionValue[op][A[[i]][[2]], B[[j]][[2]]],
- opE[A[[i]][[3]], A[[i]][[2]], B[[j]][[3]],
- B[[j]][[2]]]}, ## &[]], {j, Length[B]}], {i,
- Length[A]}] /. {x_} -> x, UnsameQ[#, {}] &]
-];
+ newx = Intersection[A[[;; , 1]], B[[;; , 1]]];
+ maskA = First@First[Position[A[[;; , 1]], #]] & /@ newx;
+ maskB = First@First[Position[A[[;; , 1]], #]] & /@ newx;
+ newy = MapThread[OptionValue[op], {A[[maskA, 2]], B[[maskB, 2]]}];
+ newe = MapThread[opE, {
+ A[[maskA, 3]], A[[maskA, 2]], B[[maskB, 3]], B[[maskB, 2]]
+ }];
+ Thread[{newx, newy, newe}]
+]
ApplyPlot[A_, fY_] := Block[{x, dummy, opE},
--
GitLab