delphi4arab منتديات دلفي للعرب - كيف أوظف الإحتمالات كلها؟

الصفحات : 1 2

السلام عليكم ورحمة الله تعالى وبركاته:
كيف أوظف الإحتمالات كلها؟
مثال لو أنه أعطيت لي هذه المجموعة (2-7-8-1) وطلب مني تحديد جميع الأعداد الرباعية الممكن تكوينها من خلال المجموعة:
أنا أعلم أن عدد الإحتمالات هو 24 عددا مثل:
1872-1827-1728-1782-1278-1287-2871...وهكذا
لكن بالدلفي كيف يمكنني استخراجها كلها؟
وبارك الله فيكم.

السلام عليكم

لم تحدد الشروط اكثر لكن جرب هذا ربما ينفعك

PHP كود :
type
  TNumber = '0'..'9'; 

لا تنسونا من صالح دعائكم

PHP كود :
procedure TForm1.Button1Click(Sender: TObject);
var
  Numbers: array[0..3] of TNumber;
  a, b, c, d: Integer;
begin
  Numbers[0] := '1';
    Numbers[1] := '8';
      Numbers[2] := '7';
        Numbers[3] := '2';
  for a := low(Numbers) to High(Numbers) do
    for b := low(Numbers) to High(Numbers) do
      for c := low(Numbers) to High(Numbers) do
        for d := low(Numbers) to High(Numbers) do
        Memo1.Lines.Add(Numbers[a] + Numbers[b] + Numbers[c]  + Numbers[d]);
end; 

سلامي

السلام عليكم ورحمة الله تعالى وبركاته
بارك الله فيك أخي s.fateh
هو كود رائع، لكنه قد ذكر الإحتمالات كلها، وأعني أنه استعمل حتى تكرار الأعداد مثلا المجموعة التالية: (1-5-9)
تكون كما يلي: (951-915-519-591-195-159) بعدم التكرار
وليس هكذا: (111-119-191-199-115-151-155-195-159-555-.....إلخ)

السلام عليكم
هدا أحد الحلول
من دون حلقات ودوران

كود :
function Rev(N: string): string;
var
  SL: TStringList;
begin
  if Length(N) = 4 then
  begin
    Result := '';
    SL := TStringList.Create;
    try
      {1}
      SL.Add(N[1] + N[2] + N[3] + N[4]);
      SL.Add(N[1] + N[2] + N[4] + N[3]);
      SL.Add(N[1] + N[3] + N[2] + N[4]);
      SL.Add(N[1] + N[3] + N[4] + N[2]);
      SL.Add(N[1] + N[4] + N[3] + N[2]);
      SL.Add(N[1] + N[4] + N[2] + N[3]);
      {2}
      SL.Add(N[2] + N[1] + N[3] + N[4]);
      SL.Add(N[2] + N[1] + N[4] + N[3]);
      SL.Add(N[2] + N[3] + N[4] + N[1]);
      SL.Add(N[2] + N[3] + N[1] + N[4]);
      SL.Add(N[2] + N[4] + N[3] + N[1]);
      SL.Add(N[2] + N[4] + N[1] + N[3]);
      {3}
      SL.Add(N[3] + N[1] + N[4] + N[2]);
      SL.Add(N[3] + N[1] + N[2] + N[4]);
      SL.Add(N[3] + N[2] + N[1] + N[4]);
      SL.Add(N[3] + N[2] + N[4] + N[1]);
      SL.Add(N[3] + N[4] + N[2] + N[1]);
      SL.Add(N[3] + N[4] + N[1] + N[2]);
      {4}
      SL.Add(N[4] + N[1] + N[3] + N[2]);
      SL.Add(N[4] + N[1] + N[2] + N[3]);
      SL.Add(N[4] + N[2] + N[1] + N[3]);
      SL.Add(N[4] + N[2] + N[3] + N[1]);
      SL.Add(N[4] + N[3] + N[2] + N[1]);
      SL.Add(N[4] + N[3] + N[1] + N[2]);
      Result := SL.Text;
    finally
      SL.Free;
    end;
  end;
end;

باستعمال loop

كود :
function Rev(N: string): string;
var
  SL: TStringList;
  i, b, c, d: Integer;
begin
  if Length(N) = 4 then
  begin
    Result := '';
    b := 2; c := 3; d := 4;
    SL := TStringList.Create;
    try
      for i := 1 to Length(N) do
      begin
        if i = 2 then b := 1 else if i = 3 then c := 2 else if i = 4 then d := 3;
        SL.Add(N[i] + N[b] + N[c] + N[d]);
        SL.Add(N[i] + N[b] + N[d] + N[c]);
        SL.Add(N[i] + N[c] + N[b] + N[d]);
        SL.Add(N[i] + N[c] + N[d] + N[b]);
        SL.Add(N[i] + N[d] + N[c] + N[b]);
        SL.Add(N[i] + N[d] + N[b] + N[c]);
      end;
      Result := SL.Text;
    finally
      SL.Free;
    end;
  end;
end;

belnono كتب :لكنه قد ذكر الإحتمالات كلها، وأعني أنه استعمل حتى تكرار الأعداد مثلا المجموعة التالية: (1-5-9)

السلام عليكم
لاشك توجد طريقة لتحديد الاحتمالات بهذا الشكل لكن يمكن اضافة كود فلتر لتمرير فقط القيم التي لا تحتوي على تكرارات

PHP كود :
unit Unit1;

// Codded By S.FATEH | Delphi4Arab.Com                                                                                 //

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TNumber = '0'..'9';

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    function Occurrences(const Substring, Text: string): Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses StrUtils;

procedure TForm1.Button1Click(Sender: TObject);
var
  Numbers: array[0..3] of TNumber;
  a, b, c, d: Integer;
  s: string;
begin
  Numbers[0] := '1';
  Numbers[1] := '8';
  Numbers[2] := '7';
  Numbers[3] := '2';
  for a := low(Numbers) to High(Numbers) do
    for b := low(Numbers) to High(Numbers) do
      for c := low(Numbers) to High(Numbers) do
        for d := low(Numbers) to High(Numbers) do
        begin
          s := Numbers[a] + Numbers[b] + Numbers[c]  + Numbers[d];
          if
            (Occurrences('1', s) > 1 ) or
            (Occurrences('8', s) > 1 ) or
            (Occurrences('7', s) > 1 ) or
            (Occurrences('2', s) > 1 )
          then
            Continue
          else
            Memo1.Lines.Add(s);
  end;
end;

function TForm1.Occurrences(const Substring, Text: string): Integer;
var
  Offset: Integer;
begin
  Result := 0;
  Offset := PosEx(Substring, Text, 1);
  while Offset <> 0 do
  begin
    Inc(Result);
    Offset := PosEx(Substring, Text, offset + length(Substring));
  end;
end;



end. 

بالتوفيق

السلام عليكم ورحمة الله تعالى وبركاته:
أخي الكريم (ghost-dz)، أشكرك جزيل الشكر على هذا المجهود
و لكن إذا كانت المجموعة تتكون من N رقم أو عدد
أي أننا نريد طريقة أو كود يعمل مع كل قيم المجموعة، سواء من 4 ارقام أو 20 رقم ...وهكذا
ولذلك يجب استعمال الحلقات، أما أن فقد وضعت 4 أرقام على سبيل المثال فقط.
بارك الله فيك، فإن كان عندك طريقة أخي الكريم، فأنا في الإنتظار.

أخي الكريم: s.fateh
الكود الثاني نسخته وعند التنفيذ يتم تحديد الكلمات (occurrences) على أنه خطأ
فلم أستطع إيجاد المكان التالي لأنسخ فيه الشطر الثاني من الكود:
أي هنا (function TForm1.Occurrences(const Substring, Text: string): Integer Wink

فلم أجد هذا المسار، واعذرني لأنني مبتدئ فينقصني الكثير والكثير.
و إن لم أتعبك أخي، لو ترفق البرنامج حتى أحمله وأطلع على كل صغيرة وكبيرة فيه.
بارك الله فيك وفي دنياك.

مجرد نسخ و لصق على كل حال تفضل المشروع...

s.fateh
بارك الله فيك أخي الكريم
هذا ما كنت أبحث عنه بالضبط
جزاك الله عنا كل الخير

قمة بطرح سآل و قد كانت الاجابة طريقة أخرى جيدة لبعض الحالات ...

PHP كود :
program Permuatations;

{$APPTYPE CONSOLE}

type
  TElements = '1'..'3';

procedure EnumerateCombinations(const Stem: string; Len: Integer);
var
  i: Integer;
  el: TElements;
  Used: set of TElements;
begin
  if Len=0 then
    exit;
  Used := [];
  for i := 1 to Length(Stem) do
    Include(Used, Stem[i]);
  for el := low(el) to high(el) do
  begin
    if el in Used then
      continue;
    if Len=1 then
      Writeln(Stem+el)
    else
      EnumerateCombinations(Stem+el, Len-1)
  end;
end;

procedure Main;
begin
  EnumerateCombinations('', 1+ord(high(TElements))-ord(low(TElements)));
end;

begin
  Main;
  Readln;
end. 

كود :
http://stackoverflow.com/questions/12132099/create-an-unknown-number-of-loops

شكرا أخي

.fateh
على الكود الأخير، لكنني لم أفهم منه شيئا
ولا حتى امكانية نسخه لتطبيقه، فلا أعلم مواضعها
لأنني أقر مرتين على button1 ثم أنسخ الكود
لكن في هذه الحالات لم أجد هذا المسار مثل:
procedure EnumerateCombinations(const Stem: string; Len: Integer);
المهم لقد أعجبني الكود الذي سبقه، فهو سهل وبسيط
بارك الله فيك

الصفحات : 1 2