Advertisement
Guest User

Untitled

a guest
Jul 24th, 2019
96
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.74 KB | None | 0 0
  1. constraints = {{0, 0, 0}, {1, 0.00311936, 0.00416369}, {2, 0.0847077, 0.109064},
  2. {3, 0.272142, 0.354692}, {4, 0.53198, 0.646113}, {5, 0.623413, 0.743102},
  3. {6, 0.744714, 0.905966}}
  4.  
  5. mids = ({#1, Mean[{#2,#3}]}&) @@@ constraints
  6. f = Interpolation[mids, InterpolationOrder->0]
  7.  
  8. (* Distance from x to the nearest member of list l. *)
  9. listdist[x_, l_List] := Min[Abs[x - #] & /@ l]
  10.  
  11. (* Return a value x for the variable var such that expr/.var->x is at least (or
  12. at most, if dir is -1) t. *)
  13. invertish[expr_, var_, t_, dir_:1] := Module[{x = dir},
  14. While[dir*(expr /. var -> x) < dir*t, x *= 2];
  15. x]
  16.  
  17. (* Return a non-decreasing interpolating function that maps from the
  18. reals to [0,1] and that is as close as possible to expr[var] without
  19. violating the given constraints (a list of {x,ymin,ymax} triples).
  20. The model, expr, will have free parameters, params, so first do a
  21. model fit to choose the parameters to satisfy the constraints as well
  22. as possible. *)
  23. cfit[constraints_, expr_, params_, var_] :=
  24. Block[{xlist,bots,tops,loparams,hiparams,lofit,hifit,xmin,xmax,gap,aug,bests},
  25. xlist = First /@ constraints;
  26. bots = Most /@ constraints; (* bottom points of the constraints *)
  27. tops = constraints /. {x_, _, ymax_} -> {x, ymax};
  28. (* fit a model to the lower bounds of the constraints, and
  29. to the upper bounds *)
  30. loparams = FindFit[bots, expr, params, var];
  31. hiparams = FindFit[tops, expr, params, var];
  32. lofit[z_] = (expr /. loparams /. var -> z);
  33. hifit[z_] = (expr /. hiparams /. var -> z);
  34. (* find x-values where the fitted function is very close to 0 and to 1 *)
  35. {xmin, xmax} = {
  36. Min@Append[xlist, invertish[expr /. hiparams, var, 10^-6, -1]],
  37. Max@Append[xlist, invertish[expr /. loparams, var, 1-10^-6]]};
  38. (* the smallest gap between x-values in constraints *)
  39. gap = Min[(#2 - #1 &) @@@ Partition[Sort[xlist], 2, 1]];
  40. (* augment the constraints to fill in any gaps and extrapolate so there are
  41. constraints everywhere from where the function is almost 0 to where it's
  42. almost 1 *)
  43. aug = SortBy[Join[constraints, Select[Table[{x, lofit[x], hifit[x]},
  44. {x, xmin,xmax, gap}],
  45. listdist[#[[1]],xlist]>gap&]], First];
  46. (* pick a y-value from each constraint that is as close as possible to
  47. the mean of lofit and hifit *)
  48. bests = ({#1, Clip[(lofit[#1] + hifit[#1])/2, {#2, #3}]} &) @@@ aug;
  49. Interpolation[bests, InterpolationOrder -> 3]]
  50.  
  51. g1 = cfit[constraints, CDF[LogNormalDistribution[mu,sigma], z], {mu,sigma}, z]
  52. g2 = cfit[constraints, CDF[NormalDistribution[mu,sigma], z], {mu,sigma}, z]
  53. g3 = cfit[constraints, 1/(1 + c*Exp[-k*z]), {c,k}, z]
  54.  
  55. Plot[{g1'[x], g2'[x], g3'[x]}, {x, 0, 10}]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement