View previous topic :: View next topic |
Author |
Message |
ghasedak404 مهمون يكي دو روزه
Joined: 24 Oct 2005 Posts: 26
|
Posted: Wed Oct 26, 2005 8:49 am Post subject: برنامه مربع جادويي به زبان پاسكال |
|
|
كي مي تونه اين برنامه رو برام بنويسه ؟ ممنون مي شم . |
|
Back to top |
|
 |
vahid بي تو هرگز
Joined: 26 Nov 2004 Posts: 3067 Location: Tehran
|
Posted: Wed Oct 26, 2005 5:28 pm Post subject: |
|
|
اين مربع جادويي چي هست ؟
بايد چي كار كنه ؟
با جارو پرواز كنه ؟
انقدري ميدونم كه مثلا سطرها با ستونها جمعشون يكي باشه ؟ بيشتر توضيح بده . |
|
Back to top |
|
 |
arash مدير بخش سي

Joined: 27 Nov 2004 Posts: 1232 Location: www.parsx.com
|
Posted: Wed Oct 26, 2005 9:25 pm Post subject: |
|
|
بگو چیه ؟
چقدر ؟
 |
|
Back to top |
|
 |
ghasedak404 مهمون يكي دو روزه
Joined: 24 Oct 2005 Posts: 26
|
Posted: Wed Nov 02, 2005 9:50 am Post subject: برنامه مربع جادويي |
|
|
مربع جادويي يك ماتريس n*n است كه اعضاي آن اعداد 3,2,1, ... , n به توان 2 هستند كه هر كدام يك بار تكرار شده اند و مجموع سطرها ، ستون ها و قطرهاي آن يكسان است .
مثلا مربع جادويي 5*5 كه مجموع عناصر سطرها ، ستون ها و قطرهاي آن 65 است :
15 8 1 24 17
16 14 7 5 23
22 20 13 6 4
3 21 19 12 10
9 2 25 18 11 |
|
Back to top |
|
 |
vahid بي تو هرگز
Joined: 26 Nov 2004 Posts: 3067 Location: Tehran
|
Posted: Wed Nov 02, 2005 9:45 pm Post subject: |
|
|
اگه خواستي هزينه كني بابتش ميتوني در بخش پروژه بنويسي .
دو روزه يكي پيدا ميشه برات مينويسه  |
|
Back to top |
|
 |
ghasedak404 مهمون يكي دو روزه
Joined: 24 Oct 2005 Posts: 26
|
Posted: Thu Nov 03, 2005 10:02 am Post subject: |
|
|
سلام
آخه مي دوني چيه ؟
من فكر مي كردم ما اينجا جمع شديم كه به همديگه كمك كنيم و از همديگه چيز ياد بگيريم نه اينكه ....
به هر حال اميدوارم يكي پيدا بشه و مشكل ما رو حل كنه . |
|
Back to top |
|
 |
vahid بي تو هرگز
Joined: 26 Nov 2004 Posts: 3067 Location: Tehran
|
Posted: Thu Nov 03, 2005 12:53 pm Post subject: |
|
|
دقيقا همين چيزيه كه ميخواي .
اما كمك كردن روش داره !
شما شروع كن به نوشتن . هر جا سوال داشتي بپرس . من بشخصه در خدمت هستم .
اما اينكه من بشينم 4 ساعت روي برنامه شما فكر كنم و بنويسم كه نميشه كمك كه ! ميشه ؟ |
|
Back to top |
|
 |
vahid بي تو هرگز
Joined: 26 Nov 2004 Posts: 3067 Location: Tehran
|
Posted: Thu Nov 03, 2005 1:38 pm Post subject: |
|
|
| program MSMFPC;
const GRAU = 5; { DIMENSION }
const CGRAU2= ((GRAU)*(GRAU-1)) div 2;
const GRAU2 = GRAU*GRAU;
const NTROCA= (GRAU2*(GRAU2-1)) div 2;
const TOTLIN = (((1+GRAU2)*GRAU2) div 2) div GRAU;
const QueroArq = false;
type TAQUAD = array[1..GRAU2] of word;
type TTROCA = record
A:word;
B:word;
end;
type TATROCA = array[1..NTROCA] of TTROCA;
type TALTROCA = array[1..CGRAU2] of TTROCA;
type TQUAD = object { Magic Square Class }
FOUND:boolean;
QUAD:TAQUAD; {square}
TROCA:TATROCA;
LTROCA:TALTROCA;
CICLOS:longint; {cicles }
NFOUND:longint;
WantQuit:boolean;
constructor Init;
destructor Done;
procedure Mostra; { show }
procedure Gera(var Q:TAQUAD); {generate a square }
procedure PTroca(var Q:TAQUAD;N:longint); {exchange cells}
procedure Run;
procedure Try03;
end;
{ implementation }
function EvalQuad(Q:TAQUAD):longint;
var COUNT,COUNT2:word;
POS,POS2:word;
SOMLIN,SOMCOL: array[1..GRAU] of longint;
COLPRIN,COLSEC:longint;
DIFTOTAL:longint;
begin
DIFTOTAL:=0;
for COUNT:=1 to GRAU do
begin
SOMLIN[COUNT]:=0;
SOMCOL[COUNT]:=0;
end;
COLPRIN:=0;
COLSEC:=0;
for COUNT:=1 to GRAU do { soma linhas e colunas }
for COUNT2:=1 to GRAU do
begin
SOMLIN[COUNT2]:=SOMLIN[COUNT2]+Q[GRAU*pred(COUNT )+COUNT2];
SOMCOL[COUNT2]:=SOMCOL[COUNT2]+Q[GRAU*pred(COUNT2)+COUNT ];
end;
POS:=1;
POS2:=GRAU;
for COUNT:=1 to GRAU do {soma diagonais}
begin
COLPRIN:=COLPRIN+Q[POS];
COLSEC:=COLSEC+Q[POS2];
POS:=POS+succ(GRAU);
POS2:=POS2+pred(GRAU);
end;
DIFTOTAL:=abs(COLPRIN-TOTLIN)+abs(COLSEC-TOTLIN);
for COUNT:=1 to GRAU do
DIFTOTAL:=DIFTOTAL+abs(TOTLIN-SOMLIN[COUNT])+
abs(TOTLIN-SOMCOL[COUNT]);
EvalQuad:=DIFTOTAL;
end; { of procedure }
constructor TQUAD.Init;
var COUNT,COUNT2:longint;
POS:longint;
begin
WantQuit:=false;
Writeln('Output:');
Writeln('Dimension(Grau):',GRAU);
Writeln('Cells:(Celulas):',GRAU2);
Writeln('Level 1(Nivel 1):',NTROCA);
Writeln('Sum(Total por linha):',TOTLIN);
CICLOS:=0;
NFOUND:=0;
Randomize;
POS:=0;
for COUNT:=1 to GRAU2 do {gera tabela de trocas}
for COUNT2:=succ(COUNT) to GRAU2 do
begin
inc(POS);
TROCA[POS].A:=COUNT;
TROCA[POS].B:=COUNT2;
end;
Gera(QUAD);
Writeln('--------------------------------------');
POS:=0;
for COUNT:=1 to GRAU do
for COUNT2:=succ(COUNT) to GRAU do
begin { combinations }
inc(POS);
LTROCA[POS].A:=COUNT;
LTROCA[POS].B:=COUNT2;
end;
end;
destructor TQUAD.Done;
begin
end;
procedure TQUAD.Gera(var Q:TAQUAD);
var COUNT:longint;
begin;
for COUNT:=1 to GRAU2 do
Q[COUNT]:=COUNT;
for COUNT:=1 to NTROCA do
PTROCA(Q,succ(round(random(NTROCA))));
end;
procedure TQUAD.Mostra;
var COUNT,COUNT2:longint;
POS:longint;
begin;
POS:=0;
for COUNT:=1 to GRAU do
begin
for COUNT2:=1 to GRAU do
begin
inc(POS);
Write(QUAD[POS]:4);
end;
Writeln;
end;
{Application.ProcessMessages;}
end;
procedure TQUAD.PTroca(var Q:TAQUAD;N:longint);
var AUX:word;
begin;
AUX:=Q[TROCA[N].A];
Q[TROCA[N].A]:=Q[TROCA[N].B];
Q[TROCA[N].B]:=AUX;
end;
procedure TQUAD.Try03;
var USE:TAQUAD;
OLDEVAL,EVAL:longint;
COUNT,COUNT3:longint;
BESTPOS1,BESTEVAL:longint;
ATUAL1:longint;
MAX:longint;
LA:boolean; {local achei}
begin
BESTPOS1:=1;
BESTEVAL:=NTROCA{EvalQuad(QUAD)};
OLDEVAL:=EvalQuad(QUAD);{BESTEVAL;}
EVAL:=OLDEVAL;
USE:=QUAD;
COUNT:=0;
LA:=false;
MAX:=round(NTROCA/1.5);
while (COUNT<MAX) and not(LA) do
begin
inc(COUNT);
USE:=QUAD;
ATUAL1:=succ(round(random(NTROCA)));
PTROCA(USE,ATUAL1); {troca}
EVAL:=EvalQuad(USE);
if EVAL<=BESTEVAL then
begin
BESTEVAL:=EVAL;
BESTPOS1:=ATUAL1;
end; { of if}
if EVAL<=OLDEVAL then
LA:=true;
end;{ of FOR }
PTROCA(QUAD,BESTPOS1);
if Random(100)>8 then
begin
{Application.ProcessMessages;}
{writeln(BESTEVAL);}
end;
if BESTEVAL=0 then
begin
inc(NFOUND);
writeln;
writeln('This is another magic square 4u ghasedak40:',NFOUND);
MOSTRA;
Gera(Quad);
end;
end;
procedure TQUAD.Run;
var Count:longint;
begin
Count:=0;
while not(WantQuit) do
begin
Try03;
end;
end;
var MS:TQUAD; { Magic Square Object }
begin
MS.Init;
MS.Run;
MS.Done;
end. |
|
|
Back to top |
|
 |
ghasedak404 مهمون يكي دو روزه
Joined: 24 Oct 2005 Posts: 26
|
Posted: Fri Nov 04, 2005 1:24 am Post subject: |
|
|
سلام وحيد
قبل از هر چيز به خاطر نوشتن برنامه ازت تشكر مي كنم
. هر چند هنوز تستش نكردم ولي همين كه زحمت كشيدي ازت ممنونم .
سعي مي كنم ازش سر در بيارم . ولي هر جا كه مشكل داشتم سوال مي كنم .
جوابم رو ميدي ؟؟؟؟
باز هم ممنونم . |
|
Back to top |
|
 |
vahid بي تو هرگز
Joined: 26 Nov 2004 Posts: 3067 Location: Tehran
|
Posted: Fri Nov 04, 2005 11:54 am Post subject: |
|
|
هر جا مشكلي داشتي اگه بلد بودم در خدمت هستم .
اين برنامه رو از يكي از تالارهاي orkut گرفتم . |
|
Back to top |
|
 |
ghasedak404 مهمون يكي دو روزه
Joined: 24 Oct 2005 Posts: 26
|
Posted: Sat Nov 05, 2005 1:55 am Post subject: |
|
|
سلام
خيلي باهاش ور رفتم . ولي چيز زيادي دستگيرم نشد
به نظرم يه خورده پيچيده هست !!!
راستي تو منطق برنامه رو به دست آوردي ؟ اينكه اعداد چه جوري چيده مي شن ؟ |
|
Back to top |
|
 |
vahid بي تو هرگز
Joined: 26 Nov 2004 Posts: 3067 Location: Tehran
|
Posted: Sat Nov 05, 2005 9:24 pm Post subject: |
|
|
من فكر كنم خودشم نفهميده چي نوشته  |
|
Back to top |
|
 |
ghasedak404 مهمون يكي دو روزه
Joined: 24 Oct 2005 Posts: 26
|
Posted: Sun Nov 06, 2005 1:18 am Post subject: |
|
|
دارم به همين نتيجه مي رسم . |
|
Back to top |
|
 |
ghasedak404 مهمون يكي دو روزه
Joined: 24 Oct 2005 Posts: 26
|
Posted: Tue Nov 08, 2005 9:59 am Post subject: |
|
|
سلام
وحيد جان ، برنامه اي كه شما گذاشتيد رو سايت درست كار نمي كنه .
البته بابت زحمتي كه كشيدي ازت ممنونم .
ولي بالاخره خودم تونستم برنامه رو بنويسم . درست درست هم كار مي كنه
مي ذارمش روي سايت تا همه ازش استفاده كنن .
|
program msquare;
const
MAX_SIZE=15;
var
square:array[1..MAX_SIZE,1..MAX_SIZE] of integer;
i,j,row,column,sum:integer;
count:integer;
size:integer;
BEGIN
sum:=0;
writeln;
write('Enter the size of the square:');
readln(size);
if ((size<1) or (size>MAX_SIZE)) then
begin
writeln('Error! size is out of range.');
readln;
exit;
end;
if not ((size mod 2<>0)) then
begin
writeln('Error! size is even.');
readln;
exit;
end;
for i:=1 to size do
for j:=1 to size do
square[i,j]:=0 ;
square[1,trunc((size+1)/2)]:=1;
i:=1;
j:=trunc((size+1)/2);
for count:=2 to size*size do
begin
if (i-1=0) then
row:=size
else
row:=i-1;
if (j-1=0) then
column:=size
else
column:=j-1;
if (square[row,column]<>0) then
i:=i+1
else
begin
i:=row;
if (j-1=0) then
j:=size
else
j:=j-1;
end;
square[i,j]:=count;
end;
writeln('Magic square of size ',size,': ');
writeln;
for i:=1 to size do
begin
for j:=1 to size do
write(square[i,j]:4);
writeln;
writeln;
end;
writeln;
for i:=1 to size do
sum:=sum+square[i,1];
writeln('The sum of any ( row,column and diameter ) is : ',sum);
writeln;
write('Press Enter to Exit ...');
readln;
end. |
|
|
Back to top |
|
 |
Etrok مهمون يكي دو روزه
Joined: 05 Jul 2005 Posts: 1
|
Posted: Wed Nov 09, 2005 11:08 pm Post subject: |
|
|
اين برنامه هه كه گذاشتم كار ميكردا ؟
اما خوب ماله شما خيلي واضحتر و بهتر بنظر ميرسه ... |
|
Back to top |
|
 |
|