Математические финты

[Yuri_So]

Нужно сложыть такую программу, но у меня только одна идея, и не очень рациональная, может кто-то что-то подскажет.
Есть введеное число А, и три введеных числа Б,В,Г.Надо перебрать все возможные математические комбинации(с действиями + - * \) с этими числами Б,В,Г, чтоб получить число А, притом минимум может быть задействовано 3, а максимум 6 заданых чисел Б,В,Г тоесть Б+В/Г(тут 3 числа) и Б+В+Г/Б-В/Г(а тут 6 чисел).НЕ перебирать же все возможные варианты вручную????Или по другому никак?У кого какие идеи?

[Urvin]

Я думаю, тебе сюда:
http://www.cking.narod.ru/solver/index.htm
http://www.mukrebus.narod.ru/
http://www.mukrebus.narod.ru/calc.htm

Если еще надо что-то объяснить, объясню.

[Yuri_So]

Спасибо, гляну.

[Sanya Z]

Это, я так понял, модель KeyGen'a

[Urvin]

У меня - калькулятор ребусов, в него вводиши "а + бб + а = ссс", он выведет ответ, притом одной букве - уникальная цифра. Букв разных может быть от одной до десяти, значит надо переменное количество циклов, что и реализуется в проге. Потом для кажной дой ситуации (а=0 б=0; а=0 б=1) идет проверка на соответствие математике...

[Yuri_So]

Ну вобщем да, что-то похожее......

[Urvin]

У меня код только Паскальный, но, думаю, в нем не сложно разобраться:

Код: Выделить всё

procedure TfrmMain.btnSolveClick(Sender: TObject);
Var
  I: array[0 .. 9] of extended;
  K: integer;
  JJJ: integer;// int64;
  jj: integer;
  ii: integer;
  kk: integer;
  ji: extended;
  jjjj: integer;
  nn: integer;
  mm: integer;
  m: string;
  n: string;
  p: string;
  z: string;
  var Time0: TDateTime;
  var Time1: TDateTime;
label 107;
Label 108;
Label 109;
Label 110;
begin
  txtRebus.Enabled := False;
  btnSolve.Enabled := False;
  chbLeadNil.Enabled:=False;

  m:=DelChar(txtRebus.Text,#32);
  m:=LowerCase(m);

  Time0:=Time;

  lblStatus.Caption := 'Статус: Проверка';
  lblAddr2.Caption := 'Найденные решения:';
  repaint;
  if pos('=',m) <= 0 then begin
    with Application do
      begin
      NormalizeTopMosts;
      MessageBox('Вы неправильно ввели ребус!', 'Ошибка!', MB_OK);
      RestoreTopMosts;
      end;
      lblStatus.Caption := 'Статус: Проверьте ввод ребуса!';
    goto 109;
  end
  else begin
    n:=Copy(m,pos('=',m)+1,length(m));
    if pos('=',n)>0 then begin
      with Application do
      begin
      NormalizeTopMosts;
      MessageBox('Вы неправильно ввели ребус!', 'Ошибка!', MB_OK);
      RestoreTopMosts;
      end;
      lblStatus.Caption := 'Статус: Проверьте ввод ребуса!';
    goto 109;
    end;
  end;


  if DeDig(DelChar(m,'=')) = '' then begin
    with Application do
      begin
      NormalizeTopMosts;
      MessageBox('Неправильно введен ребус!', 'Ошибка!', MB_OK);
      RestoreTopMosts;
      end;
      lblStatus.Caption := 'Статус: Проверьте ввод ребуса!';
    goto 109;
  end
  else begin

  end;

  n:=OutChar(DelChar(DeDig(m),'='));
  k:=Length(n);

  if k > 10 then begin
    with Application do
      begin
      NormalizeTopMosts;
      MessageBox('Не более 10 различных букв!', 'Ошибка!', MB_OK);
      RestoreTopMosts;
      end;
      lblStatus.Caption := 'Статус: Проверьте ввод ребуса!';
    goto 109;
  end;

  lstAnswer.Items.Clear;

  nn:=0;

  lblStatus.Caption := 'Статус: Подбор решений';
  repaint;

  jjjj:=round(Power(10,k))-1;

  prgProgress.Max := jjjj;

  jjj:= 0;
  while jjj <= jjjj do begin

    for jj:= 0 to k-1 do begin
      I[jj] := int((jjj - Int(jjj/(Power(10,jj+1)))*Power(10,jj+1))/Power(10,jj));
    end;
    kk:=0;

    mm:=0;
    for jj:= k-1 downto 1 do begin
      for ii:= jj-1 downto 0 do begin
        if I[ii] = I[jj] then begin
          mm:=ii;
          kk:=1;
          goto 107;
        end;
      end;
    end;
107:

    if kk=0 then begin
      p:=m;
      for ii := 0 to k-1 do begin
        z:=FloatToStr(I[ii]);
        p:=ChChar(p,n[ii+1],z[1]);
      end;
      if MEval(p)=True then begin
        If chbLeadNil.Checked = True then begin
            if LeadNil(p)=True then begin
            lstAnswer.Items.Add(p);
            nn:=nn+1;
          end;
      end else begin
          lstAnswer.Items.add(p);
          nn:=nn+1;
        end;
      end;
      jjj:=jjj+1;
    end else begin
      ji := (Int(jjj/(Power(10,mm))) + 1) * (Power(10,mm));
      jjj:=StrToInt(FloatToStr(ji));
    end;
108:
    if jjj mod 1000 = 0 then begin
      prgProgress.Position := jjj;
    end;
  //end jjj
  end;

  Time1:=time;
  frmMain.Caption:='Калькулятор ребусов: ' + TimeToStr(Time1-Time0) ;
  lblAddr2.Caption := 'Найдено ' + IntToStr(nn) + ' решений';
  lblStatus.Caption := 'Статус: Готово';
109:
  txtRebus.Enabled := True;
  btnSolve.Enabled := True;
  chbLeadNil.Enabled:=True;
  prgProgress.Position:=0;
  txtRebus.SetFocus;
end;

[RayShade]

Единственное что явствует из этого когда, так это то что:

1. Код на дельфи;

2. Код неполный.

[Urvin]

Главное - Алгоритм!
А алгоритм здесь есть.