Решить неравенство с параметром

Sep 08 2020

Я хочу решить неравенство

$m<700000log((m-1)a)+3 $

где $a$ - положительное целое число, я знаю команду, когда в неравенстве нет параметра, но я не знаю, в случае параметра. (a - параметр)

Мне нужна команда для вышеуказанного неравенства.

Ответы

1 BobHanlon Sep 08 2020 at 19:29
Reduce[{m < 700000 Log[(m - 1) a] + 3, Element[a, PositiveIntegers]}, m]

(* Reduce::nsmet: This system cannot be solved with the methods available to Reduce.

Reduce[{m < 3 + 700000 Log[a (-1 + m)], a ∈ Integers && a > 0}, m] *)

Чтобы найти приблизительное решение

data = Table[{a, 
   m /. FindRoot[700000 Log[(m - 1) a] + 3 - m == 0, {m, 1 + 1/a}]}, {a, 20}]

(* {{1, 2.}, {2, 1.5}, {3, 1.33333}, {4, 1.25}, {5, 1.2}, {6, 1.16667}, {7, 
  1.14286}, {8, 1.125}, {9, 1.11111}, {10, 1.1}, {11, 1.09091}, {12, 
  1.08333}, {13, 1.07692}, {14, 1.07143}, {15, 1.06667}, {16, 1.0625}, {17, 
  1.05882}, {18, 1.05556}, {19, 1.05263}, {20, 1.05}} *)

(nlm = NonlinearModelFit[data, 1 + 1/a + ϵ, {ϵ}, a]) // Normal

(* 1. + 1/a *)

nlm["BestFitParameters"]

(* {ϵ -> -3.99951*10^-7} *)

Приблизительное решение: m > 1 + 1/a

Plot[Evaluate@
  Table[700000 Log[(m - 1) a] + 3 - m, {a, 5, 1, -1}],
 {m, 1, 5}, PlotLegends -> Range[5, 1, -1]]

1 CarlWoll Sep 08 2020 at 20:04

Используя вариант подстановки @BobHanlon, мы можем найти аналитический результат для интервала. Границы интервала вычисляются из следующего уравнения:

eq = m == 700000Log[(m-1)a] + 3

m == 3 + 700000 Log [a (-1 + m)]

Подставляя:

eq2 = eq /. m -> 1 + x/a

1 + x / a == 3 + 700000 Log [x]

Оказывается, Solveможно справиться с этим уравнением:

xsol = x /. First @ Solve[eq2, x, InverseFunctions->True]

-700000 a ProductLog [- (1 / (700000 a E ^ (1/350000)))]

и поэтому mдается:

msol = 1 + xsol/a

1 - 700000 ProductLog [- (1 / (700000 a E ^ (1/350000)))]

Теперь ProductLogмногозначно, и разные ветви определяются с помощью версии с двумя аргументами. Итак, актуальные решения:

min = msol /. ProductLog[z_] -> ProductLog[0, z];
max = msol /. ProductLog[z_] -> ProductLog[-1, z];

и поэтому неравенство:

ineq = min < m < max

1 - 700000 ProductLog [- (1 / (700000 a E ^ (1/350000)))] <m <1 - 700000 ProductLog [-1, - (1 / (700000 a E ^ (1/350000)))]

Проверим a=10.:

Block[{a = 10.}, ineq]

1,1 <м <1,30826 * 10 ^ 7

Сравним с решением исходного неравенства a=10.:

Block[{a = 10.},
    Reduce[m < 3 + 700000 Log[(m-1)a] + 3, m, Reals]
]

Reduce :: ratnz: Reduce не смог решить систему с неточными коэффициентами. Ответ был получен путем решения соответствующей точной системы и числового представления результата.

1,1 <м <1,30826 * 10 ^ 7