الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

برنامج تباديل كلمة

مغلق
بدأه ibr_exn في 1 أغسطس 2005 · 8 رد · 1,367 مشاهدة · في لغة Delphi
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

الكود التالي لعمل تباديل حروف كلمة

مثال اذا ادخلت له abc

يعطيك

abc

acb

bac

bca

cab

cba

وهكذا

الرجاء ممن لديه معرفة بلغة C++ تحويل هذا الكود الى باسكال

واذا وجد كود افضل ارجو وضعه هنا

<code>

#include <stdio.h> ;

#include <string.h> ;

void swap(char* s, int a, int B)

{

char temp=s[a];

s[a]=s;

s=temp;

}

int permute(char* str, int len)

{

int key=len-1;

int newkey=len-1;

/*The key value is the first value from the

end which is smaller than the value to

its immediate right*/

while( (key>0)&&(str[key] <= str[key-1]))

{key--;}

key--;

/*If key<0 the data is in reverse sorted order,

which is the last permutation. */

if(key <0)

return 0;

/*str[key+1] is greater than str[key] because

of how key was found. If no other is greater,

str[key+1] is used*/

newkey=len-1;

while((newkey > key) && (str[newkey] <= str[key]))

{

newkey--;

}

swap(str, key,newkey);

/*variables len and key are used to walk through

the tail, exchanging pairs from both ends of

the tail. len and key are reused to save

memory*/

len--;

key++;

/*The tail must end in sorted order to produce the

next permutation.*/

while(len>key)

{

swap(str,len,key);

key++;

len--;

}

return 1;

}

void main()

{

/*test data*/

char test_string[]="aabcd";

/*A short test loop to print each permutation, which

are created in sorted order.*/

do {

printf("%s\n",test_string);

}while(permute(test_string,strlen(test_string)));

}

</code>

مع خالص تحياتي

إبراهيم

الحمد لله الذي هدانا لهذا وماكنا لنهتدي لولا ان هدانا الله

#2

هذا الكود للعمل مع باسكال يمكن تعديله للعمل مع دلفي

program Recursion;
type Pere=array [byte] of byte;
 var N,i,j:byte;
     X:Pere;

procedure Generate(k:byte);
      var i,j:byte;
    procedure Swap(var a,b:byte);
       var c:byte;
      begin 
            c:=a;
            a:=b;
            b:=c
      end;{swap}
 begin
     if k=N then
       begin
         for i:=1 to N do
           write(X:3);
         writeln
        end
      else
          for j:=k+1 to N do
          begin
           Swap(X[k+1],X[j]);
           Generate(k+1);
           Swap(X[k+1],X[j])
        end
 end;

{========================================  }

  begin
  write('N=');
  readln(N);
 for i:=1 to N do X:=i;
  Generate(0)
 end.

أضاعوني وأي فتى أضاعـوا * * * ليـوم كــريهـة وســـداد ثغــــر

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

كأني لم أكــــــن فيهـم وسيطـا * * * ولم تك نســبتي في آل عمــرو

أجرر في الجـــوامع كـل يـوم * * * ألا لله مظــــلمتـي وهـصـــري

عسى الملك المجيب لمن دعاه * * * سينجيني فيعلم كيــف شكـري

فأجـــزي بالكرامـة أهـل ودي * * * وأجزي بالضـغينة أهل ضري

منتديات الرياضيات العربية

#3

إستخدم دالة ReverseString الموجودة في داخل وحدة StrUtils

لا تحزن:

إن كنت فقيرا فغيرك محبوس في دين، وإن كنت لا تملك وسيلة نقل فسواك مبتور القدمين، وان كنت تشكوا من آلام فغيرك يرقدون على الاسرة البيضاء و من سنوات، وان فقدت ولدا فغيرك فقد عددا من الأولاد و في حادث واحد.

لا تحزن:

فأنت تشرب الماء الزلال، و تستنشق الهواء الطلق، و تمشي على قدميك معافى، و تنام ليلك آمنا.

#4

الشكر للجميع

وارجو وضع كود خاص بتوافيق كلمة أو أية كتب ومراجع تتحدث عن هذا الموضوع

مع خالص التحيات

ابراهيم

الحمد لله الذي هدانا لهذا وماكنا لنهتدي لولا ان هدانا الله

#5

الكود امامك في المشاركة السابقة

ايحث عن ال combinatorial problems و لايد ان تجد الحل

تم تعديل هذه المشاركة بواسطة romanof في 8 أغسطس 2005 في 19:59

أضاعوني وأي فتى أضاعـوا * * * ليـوم كــريهـة وســـداد ثغــــر

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

كأني لم أكــــــن فيهـم وسيطـا * * * ولم تك نســبتي في آل عمــرو

أجرر في الجـــوامع كـل يـوم * * * ألا لله مظــــلمتـي وهـصـــري

عسى الملك المجيب لمن دعاه * * * سينجيني فيعلم كيــف شكـري

فأجـــزي بالكرامـة أهـل ودي * * * وأجزي بالضـغينة أهل ضري

منتديات الرياضيات العربية

#6

الاخ رومانوف مشكور على الرد

المشاركة السابقة تتحدث عن التباديل وانا طلبت التوافيق

مثال ادخل

abc

يعطي

aaa

aab

aac

aba

.

.

.

ccc

في الحقيقة انا احاول جمع اكبر قدر ممكن من الاكواد والامثلة على الخوارزميات (خصوصاً الاستدعاء الذاتي) بلغة باسكال ومن ثم شرحها ووضعها في كتاب اليكتروني ليستفيد منها الجميع

ومن هذه المسائل :

- مسألة تنقل الحصان في الشطرنج على الرقعة دون تكرار

- خوارزمية بروت فورس

- حساب التعبير الرياضي

- لعبة ترتيب مربع الارقام الثمانية

وما شابه

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

تحياتي للجميع

الحمد لله الذي هدانا لهذا وماكنا لنهتدي لولا ان هدانا الله

#7

اسم الكتاب THe Tomes of Delphi

Algorithms and Data Structures

المؤلف Julian Backnal

الحجم 5.279

عدد الصفحات 545

ملا حظات بطئ قليلا في التحميل

http://podgoretsky.com/ftp/Docs/Delphi/DX/AlgStruct.pdf

ستجد كتابا مليءا بالخوارزميات

أضاعوني وأي فتى أضاعـوا * * * ليـوم كــريهـة وســـداد ثغــــر

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

كأني لم أكــــــن فيهـم وسيطـا * * * ولم تك نســبتي في آل عمــرو

أجرر في الجـــوامع كـل يـوم * * * ألا لله مظــــلمتـي وهـصـــري

عسى الملك المجيب لمن دعاه * * * سينجيني فيعلم كيــف شكـري

فأجـــزي بالكرامـة أهـل ودي * * * وأجزي بالضـغينة أهل ضري

منتديات الرياضيات العربية

#8

اليك الكود بالباسكال يا سيدي

program s;
Uses Crt;
Const N=2;{Number of places}
      M=2;{Number of chars}
  var A:array[1..N] of char;
      B:array[1..N] of integer;
    {***********************************}

{هذه الدالة ترفع العدد الصحيح الى اس معين }
function Power(M1,N1:integer):integer;
  var Val,i:integer;
  begin
    val:=1;
    for i:=1 to N1 do
     Val:=Val*M1;
    Power:=Val;
  end;
  {***************************************}
هذه الدالة لاخراج الرمز الموجود في العنوان رقم  B
          
 procedure MyOutPut;
  var i:integer;
  begin
   for i:=N downto 1 do
    write(A[B],'   ' );
  end;
  {***********************************}
procedure MyRecursion(i:integer);
  begin
   B:=B+1;
    if(B>N) then
     begin
       if(i<N) then
          begin
           B:=1;
           MyRecursion(i+1);
          end;
      end;
  end;
  {***************************************}
  var i,amount:integer;
begin
 Clrscr;
 for i:=1 to N  do
  begin
   A:=char(96+i);
   B:=1;
  end;
  {***********************************}
  writeln;
   amount:=Power(N,N);
   for i:=1 to amount  do
    begin
    MyOutPut;
    MyRecursion(1);
    writeln;
    end;


 readkey;
end.

واضح من الكود ان الدلة الاساسية هي الدالة MyRecursion

الفكرة تشيه تماما بل هي نفسها فكرة النظام العشري لاحظ اننا في النظام العشري دائما نزيد خانة الاحاد بمقدار واحد

B:=B+1;

فاذا زاد الخانة عن تسعة تعود خانة الاحاد الى الصفر

 B:=1;

ونضيف واحد الى خانة العشرات (اي اننا تصرف مع خانة العشرات او الخانة التالية بلغة المصفوفات كما تصرفنا مع الخانة الاولى )

           MyRecursion(i+1);

مع فارق بسيط اننا في النظام العشري نملك عددا لا نهائيا من الخانات بينما هنا نملك N من الخانات

وبالتالي نحتاج الى مراعاة رقم الخانة لكي لا نخرج من حدود المصفوفة في المرة التالية

طيعا انت تعلم لو كنت تملك 4 خانات و 3 احرف فانت تملك 3 اس 4

من الحالات المختلفة

ويشكل عام عدد الحالات المختلفة =

(عدد الاحرف) مرفوعا الى الاس (عدد الخانات التي ستكتب داخلها هذه الاحرف )

لاحظ انك تملك حالة واحدة اذا كان عدد الاحرف =1 مهما كان عدد الخانات aaaaaaaaaaa

اتمنى ان تكون قد فهمت

اقتباس
الغرض في الدرجة الاولى تعليمي

وفي الدرجة الثانية ؟؟؟

عموما الله يفتح عليك

تم تعديل هذه المشاركة بواسطة romanof في 9 أغسطس 2005 في 17:13

أضاعوني وأي فتى أضاعـوا * * * ليـوم كــريهـة وســـداد ثغــــر

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

كأني لم أكــــــن فيهـم وسيطـا * * * ولم تك نســبتي في آل عمــرو

أجرر في الجـــوامع كـل يـوم * * * ألا لله مظــــلمتـي وهـصـــري

عسى الملك المجيب لمن دعاه * * * سينجيني فيعلم كيــف شكـري

فأجـــزي بالكرامـة أهـل ودي * * * وأجزي بالضـغينة أهل ضري

منتديات الرياضيات العربية

#9

مشكور أخ رومانوف

كان يجب ان اكتب "الموضوع تعليمي بحت"

لانه لايوجد درجة ثانية او غيره :lol:

الكتاب موجود معي فعلاً لكنه فقير بالنسبة لموضوع الاستدعاء الذاتي و نظرية الالعاب

حصلت على هذا الكود ويقوم بالمطلوب

uses crt;

var A:array[1..64] of byte;

n,k:byte;

procedure print(m:integer);

var i:integer;

begin

for i:=m downto 1 do

write(A:1);

writeln;

end;

procedure comb(m:integer);

var j:integer;

begin

if m=0 then

print(n)

else

for j:=0 to k-1 do

begin

A[m]:=j;

comb(m-1);

end;

end;

begin (************** Main **************)

clrscr;

writeln('*********************************');

writeln('* Calculate comb(n,k) *');

writeln('*********************************');

writeln(' try 3,3 ');

n:=0; k:=0;

write('Input n : '); readln(n);

write('Input k : '); readln(k);

writeln;

If (n<1) or (n>64) or (k<2) then

begin

writeln('Invalid Input Value');

writeln('n>=1 & n<=64 & k>=2')

end;

comb(n);

readkey

end.

الحمد لله الذي هدانا لهذا وماكنا لنهتدي لولا ان هدانا الله

هذا الموضوع مغلق.

مواضيع مشابهة