Я предполагаю, что вы ищете какой-то элегантный метод, но сейчас вот как его переборщить:
Clear[findx];findx[d_,g_,b_]:=x/.First@FindRoot[x\[Equal]((b x+1)/(x+g))^d,{x,0,1},PrecisionGoal\[Rule]3]
ClearAll[plotQ];
plotQ[d_,g_,b_,eps_]:=Module[
{x=findx[d,g,b]},
Abs[(1-b g) x d/((b x+1) (x+g))-1.]<eps]
tbl=Table[{d,g,plotQ[d,g,.1,.001]},{d,4,20,.05},{g,1,1.12,.001}];
(это должно занять порядка 10 секунд). Затем нарисуйте точки следующим образом:
Reap[
Scan[
If[#[[3]] == True,
Sow@Point[{#[[1]], #[[2]]}]] &,
Flatten[tbl, 1]]] // Last // Last //
Graphics[#, PlotRange -> {{1, 20}, {1, 1.1}}, Axes -> True,
AspectRatio -> 1, AxesLabel -> {"d", "g"}] &
![введите здесь описание изображения](https://i.stack.imgur.com/W6UbJ.png)
Уж больно уродливый способ сделать это, но он есть.
Обратите внимание, что я просто быстро написал это, поэтому я не гарантирую, что это правильно!
РЕДАКТИРОВАТЬ: Вот как это сделать, указав только b
и размер шага для d
:
Clear[findx];
findx[d_, g_, b_] :=
x /. First@
FindRoot[x \[Equal] ((b x + 1)/(x + g))^d, {x, 0, 1},
PrecisionGoal \[Rule] 3]
ClearAll[plotQ];
plotQ[d_, g_, b_, eps_] :=
Module[{x = findx[d, g, b]},
Abs[(1 - b g) x d/((b x + 1) (x + g)) - 1.] < eps]
tbl = Table[{d, g, plotQ[d, g, .1, .001]}, {d, 4, 20, .05}, {g, 1,
1.12, .001}];
ClearAll[tmpfn];
tmpfn[d_?NumericQ, g_?NumericQ, b_?NumericQ] :=
With[{x = findx[d, g, b]},
(1 - b g) x d/((b x + 1) (x + g)) - 1.
]
тогда
stepsize=.1
(tbl3=Table[
{d,g/.FindRoot[tmpfn[d,g,.1]\[Equal]0.,
{g,1,2.},PrecisionGoal\[Rule]2]},
{d,1.1,20.,stepsize}]);//Quiet//Timing
ListPlot[tbl3,AxesLabel\[Rule]{"d","g"}]
давать
![введите здесь описание изображения](https://i.stack.imgur.com/b2F2n.png)
person
acl
schedule
01.08.2011
lefthandside(x,y) = righthandside(x,y)
, то вас интересует трехмерный графикZ = lefthandside(x,y)-righthandside(x,y)
, который определенно не просто 0 или 1. Однако вас интересует фрагмент графика, где Z = 0. Я уверен, что вы можете взять его отсюда; Я давно не пользовался математикой - person Brian Gordon   schedule 02.08.2011