Использование решения в Mathematica

Чтобы познакомиться с решающими функциями Mathematica, я попытался разработать решение для Минутная математическая задача:

Есть список из семи номеров. Среднее первых четырех чисел равно 5, а среднее последних четырех чисел равно 8. Если среднее всех семи чисел равно 46/7, то какое число является общим для обоих наборов из четырех чисел?

Конечно, это упражнение можно решить и без компьютера, но как решить его с помощью Mathematica? Мой первый подход

X = Table[Subscript[x, i], {i, 1, 7}];
cond = {
  Mean[Part[X, 1 ;; 4]] == 5,  
  Mean[Part[X, 4 ;; 7]] == 8, 
  Mean[X] == 46/7
};
Solve[cond, Subscript[x, 4]]

не вернул решения. Мой второй подход

X = Table[Subscript[x, i], {i, 1, 7}];
rules = {Mean[Part[X, 1 ;; 4]] -> 5,  
   Mean[Part[X, 4 ;; 7]] -> 8, 
   Mean[X] -> 46/7
};
Solve[
  Mean[X] == Mean[Part[X, 1 ;; 4]] 
    + Mean[Part[X, 4 ;; 7]] 
    - Subscript[x, 4] /. rules, 
  Subscript[x, 4]
]

дает неправильное решение (45/7 вместо 6). Что я сделал не так?


puzzle wolfram-mathematica
person Karsten W.    schedule 06.04.2011    source источник
comment
Хорошо, есть проблема со вторым подходом. Должно быть 7*Среднее[X] == 4*Среднее[Часть[X, 1 ;; 4]] + 4*Среднее[Часть[X, 4 ;; 7]] - Subscript[x, 4], но это сводится к True при применении rules... Почему так?   -  person Karsten W.    schedule 06.04.2011
comment
Ваш второй подход имеет 3 серьезные проблемы. 1st LHS ваших правил довольно сложны, и в менее надуманных случаях (или если вы упростите/расширите свои уравнения перед применением правил) они не будут соответствовать чему-либо. 2-е ваши уравнения на самом деле неверны. Явно разверните и посмотрите на каждую сторону, и вы увидите, что произошло. 3rd При сложении уравнений вместе вы теряете информацию. Вы теряете то, что разница в уравнениях. Таким образом, сведение проблемы к одному уравнению, как вы сделали, никогда не даст полного результата.   -  person Simon    schedule 09.04.2011

Ответы (2)


arrow_upward
6
arrow_downward

Первый фрагмент кода, который вы даете, в порядке. Единственная проблема в том, что для x_4 нет решения. Если вы замените последнюю строку на Solve[cond], тогда Mathmatica автоматически выберет свободные переменные, и вы получите решение.

Я думаю, что простой/тривиальный пример прояснит проблему этого типа:

In[1]:= Solve[x==1&&y==2,x]
        Solve[x==1&&y==2,{x,y}]
Out[1]= {}
Out[2]= {{x->1,y->2}}

Окончательный вывод также можно получить с помощью Solve[x==1&&y==2], где Mma угадывает свободные переменные. Это поведение отличается от поведения Mathematica 7. В Mathematica 8 появилась новая опция для Solve (и связанных функций), называемая MaxExtraCondtions. Это позволяет Solve предоставлять решения, использующие новое ConditionalExpression и предназначенные для поведение решения более последовательное и предсказуемое. Вот как это работает в этом простом примере:

In[3]:= Solve[x==1&&y==2, x, MaxExtraConditions->1]
Out[3]= {{x -> ConditionalExpression[1, y==2]}}

См. приведенную выше ссылку на документы для получения дополнительных примеров, показывающих, почему этот Option полезен. (Хотя, возможно, по умолчанию Automatic вместо 0 было бы более прагматичным выбором дизайна для новой опции...)

Наконец, вот ваше первое решение, немного переписанное:

In[1]:= X=Array[Symbol["x"<>ToString[#]]&,{7}]
Out[1]= {x1,x2,x3,x4,x5,x6,x7}

In[2]:= cond=Mean[X[[1;;4]]]==5&&Mean[X[[4;;7]]]==8&&Mean[X]==46/7;

In[3]:= Solve[cond]
         x4/.%
Out[3]= {{x1->14-x2-x3,x4->6,x5->26-x6-x7}}
Out[4]= {6}
person Simon    schedule 06.04.2011
comment
Саймон, в Mma 7 Solve[x == 1 && y == 2, x] дает {{x -> 1}}; это изменилось в v8? - person Mr.Wizard; 07.04.2011
comment
@Mr.Wizard: Да, похоже, что да. Я подумал, что немного странно, что Solve[x == 1 && y == 2, x] не работает в Mma8. Поведение кажется немного нелогичным. Может быть, это непреднамеренно, и мы должны указать на это WRI. - person Simon; 07.04.2011
comment
@Karsten: @Mr.Wizard: Получил ответ от WRI. Это было преднамеренным изменением в Mma8, которое должно привести к более предсказуемому поведению для более сложных примеров. Существует новый Option для Solve с именем MaxExtraConditions, который управляет этим поведением и по умолчанию имеет значение 0. Смотрите редактирование. - person Simon; 09.04.2011

arrow_upward
4
arrow_downward

Возможно более компактный:

Reduce[Mean@Array[f, 4] == 5 && 
       Mean@Array[f, 4, 4] == 8 && 
       Mean@Array[f, 7] == 46/7]
(*
-> f[5] == 26 - f[6] - f[7] && 
   f[4] == 6 && 
   f[1] == 14 - f[2] - f[3]
*)

Хотя для ясности я, наверное, предпочитаю:

Reduce[Sum[f@i, {i, 4}] == 20 && 
       Sum[f@i, {i, 4, 7}] == 32 && 
       Sum[f@i, {i, 7}] == 46]

Изменить

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

  • Вам не нужно инициализировать список (Table[Subscript ... в вашем примере`)
  • Результирующие выражения обычно менее загромождены (без Part[ ;; ] и т. д.).
person Dr. belisarius    schedule 06.04.2011
comment
Вы, ребята, быстро! Как часто вы проверяете наличие новых вопросов? - person Mr.Wizard; 06.04.2011
comment
@Mr.W: Ваш комментарий отстает всего на пару минут! - person Simon; 06.04.2011
comment
@ Саймон Я думал, о, новый вопрос, давайте посмотрим, смогу ли я сначала ответить на него, но нет, два человека до меня. Ребята, вы больше ничем не занимаетесь? - person Mr.Wizard; 06.04.2011
comment
@Мистер. Ну, я также люблю вопросы обработки изображений - person Dr. belisarius; 06.04.2011
comment
@belisarius Можно ли узнать, как Reduce Мма работал в случае вашего решения? Это похоже на магию. - person DavidC; 06.04.2011
comment
@David Единственное отличие от обычного использования Reduce[] заключается в том, что я не указал vars. Я обнаружил, что Reduce попытается угадать каждый неопределенный символ, если вы введете только уравнения, но я не знаю, правильно ли это задокументировано. Или, может быть, я упускаю какую-то другую странность в своем решении? - person Dr. belisarius; 06.04.2011
comment
@David: Solve будет делать то же самое, если не указаны переменные для решения. - person Simon; 07.04.2011