Помощь - Поиск - Пользователи - Календарь
Полная версия: Создание магического квадрата
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
gooddron123
1) Написать алгоритм создания магического квадрата любой размерности. (Магический квадрат: суммы элементов в каждом столбце равны сумме элементов в каждой строке равны сумме элементов на 2 больших диагоналях)
2) Дано 300 точек. Построить прямую (уравнение прямой), содержащую максимальное кол-во точек из этих 300.
(Примечание: в задаче необходимо использовать записи)
3)Дано 300 точек. Найти такую прямую (уравнение прямой) , чтобы разницы между суммой точек сверху и суммой точек снизу была минимальна.
Altair
Цитата
2) Дано 300 точек. Построить прямую (уравнение прямой), содержащую максимальное кол-во точек из этих 300.
(Примечание: в задаче необходимо использовать записи)

Алгоритм такой:

создаешь тип:
Код

type
<индефикатор типа> = record x,y:<тип_координат> end;
var
<индефикатор_переменной>:array[1..300] of <индефикатор типа>

То есть массив записей - каждая запись содержит 2 поля - абсциссу и ординату точки. (если 3D то еще апликата)

ну а потом передираем пары точек:
Код
for i:=1 to n do for j:=1 to n do {...}

смыслв том, что припереборе пары точкек, проверем все отсальные на принадлежность к прямой... и таким образом находим пару точек, задающую прямую, через которую проход макс. чилсо точек.
алгоритм понятен?
volvo
gooddron123
Цитата
Написать алгоритм создания магического квадрата любой размерности


Размерность до 16х16.
Const
 mn = 16;

Var
 p: Boolean;

Procedure Swap(Var a, b: Integer);
 Var T: Integer;
 Begin
   T := a; a := b; b := T
 End;

Procedure CreateMagic(n: Integer);
 Var
   i, j, k, s, b, r, m: Integer;
   a: Array[1 .. mn, 1 .. mn] Of Integer;
 Begin
   p := True;

   If Odd(n) Then
     Begin
       i := 1; j := Succ(n div 2);
       For k := 1 To Sqr(n) do
         Begin
           a[i,j] := k;
           If k mod n = 0 Then Inc(i)
           Else
             Begin
               Dec(i); Inc(j);
               If i = 0 Then i := n;
               If j > n Then j := 1
             End
         End;
     End

   Else
     If n mod 4 = 0 Then
       Begin
         k := 1;
         For i := 1 To n Do
           For j := 1 To n Do
             Begin
               a[i, j] := k; Inc(k)
             End;
         j := 2; m := n div 2;
         For i := 1 To m Do
           For k := 1 To m Div 2 Do
             Begin
               If j = Succ(m) Then j := 2
               Else
                 If j = (m + 2) Then j := 1;
                 s := Succ(n - i); b := Succ(n - j);
                 Swap(a[i, j], a[s, b]);
                 Swap(a[i, b], a[s, j]);
                 Inc(j, 2)
             End
       End

     Else
       If n <> 2 Then
         Begin
           k := 1;
           For i := 1 To n Do
             For j := 1 To n Do
               Begin
                 a[i, j] := k; Inc(k)
               End;
           r := Pred(n div 2) div 2; m := n div 2;

           For i := 1 To m Do
             Begin
               j := i;
               For k := 1 To r Do
                 Begin
                   If j > m Then j := 1;
                   s := Succ(n - i); b := Succ(n - j);
                   Swap(a[i, j], a[s, b]);
                   Swap(a[i, b], a[s, j]);
                   Inc(j)
                 End
             End;

           i := 1; j := Succ®;
           For k := 1 To m Do
             Begin
               If j > m Then j := 1;
               s := Succ(n - i);
               Swap(a[i, j], a[s, j]);
               Inc(i); Inc(j)
             End;

           i := 1; j := r + 2;
           For k := 1 To m Do
             Begin
               If j > m Then j := 1;
               b := Succ(n - j);
               Swap(a[i, j], a[i, b]);
               Inc(i); Inc(j)
             End
         End

       Else p := False;

   If p Then
     Begin
       For i := 1 To n Do
         Begin
           For j := 1 To n Do
             Write(a[i, j]: 4);
           WriteLn
         End
     End
   Else
     WriteLn( 'do not exists' )
 End;

Var
 n: Integer;

begin
 WriteLn('n = '); ReadLn(n);
 CreateMagic(n);
 ReadLn
end.
gooddron123
Oleg_Z
Понял, ничего сложного вроде нет. Спасибо огромное.

volvo

Спасибо большое.

P.S. Не ожидал такого оперативного реагирования. Приятно удивлен. smile.gif
Altair
Цитата
P.S. Не ожидал такого оперативного реагирования. Приятно удивлен. 

Ну дык ты на форум -то посмотри! smile.gif
это же лучший в сети.


да, насчет 3 программы- там аналогично вобщем... (только при переборе точек условие другое провереятся).

если что не получиться - обращайся.
только сначала сампопробуй решить - только так сможешь хорошо освоить решение задач... smile.gif

заходи еще!
Armen
Цитата(volvo @ 27.12.2004 21:17) *

gooddron123
Цитата
Написать алгоритм создания магического квадрата любой размерности


Размерность до 16х16.
Const
 mn = 16;

Var
 p: Boolean;

Procedure Swap(Var a, b: Integer);
 Var T: Integer;
 Begin
   T := a; a := b; b := T
 End;

Procedure CreateMagic(n: Integer);
 Var
   i, j, k, s, b, r, m: Integer;
   a: Array[1 .. mn, 1 .. mn] Of Integer;
 Begin
   p := True;

   If Odd(n) Then
     Begin
       i := 1; j := Succ(n div 2);
       For k := 1 To Sqr(n) do
         Begin
           a[i,j] := k;
           If k mod n = 0 Then Inc(i)
           Else
             Begin
               Dec(i); Inc(j);
               If i = 0 Then i := n;
               If j > n Then j := 1
             End
         End;
     End

   Else
     If n mod 4 = 0 Then
       Begin
         k := 1;
         For i := 1 To n Do
           For j := 1 To n Do
             Begin
               a[i, j] := k; Inc(k)
             End;
         j := 2; m := n div 2;
         For i := 1 To m Do
           For k := 1 To m Div 2 Do
             Begin
               If j = Succ(m) Then j := 2
               Else
                 If j = (m + 2) Then j := 1;
                 s := Succ(n - i); b := Succ(n - j);
                 Swap(a[i, j], a[s, b]);
                 Swap(a[i, b], a[s, j]);
                 Inc(j, 2)
             End
       End

     Else
       If n <> 2 Then
         Begin
           k := 1;
           For i := 1 To n Do
             For j := 1 To n Do
               Begin
                 a[i, j] := k; Inc(k)
               End;
           r := Pred(n div 2) div 2; m := n div 2;

           For i := 1 To m Do
             Begin
               j := i;
               For k := 1 To r Do
                 Begin
                   If j > m Then j := 1;
                   s := Succ(n - i); b := Succ(n - j);
                   Swap(a[i, j], a[s, b]);
                   Swap(a[i, b], a[s, j]);
                   Inc(j)
                 End
             End;

           i := 1; j := Succ®;
           For k := 1 To m Do
             Begin
               If j > m Then j := 1;
               s := Succ(n - i);
               Swap(a[i, j], a[s, j]);
               Inc(i); Inc(j)
             End;

           i := 1; j := r + 2;
           For k := 1 To m Do
             Begin
               If j > m Then j := 1;
               b := Succ(n - j);
               Swap(a[i, j], a[i, b]);
               Inc(i); Inc(j)
             End
         End

       Else p := False;

   If p Then
     Begin
       For i := 1 To n Do
         Begin
           For j := 1 To n Do
             Write(a[i, j]: 4);
           WriteLn
         End
     End
   Else
     WriteLn( 'do not exists' )
 End;

Var
 n: Integer;

begin
 WriteLn('n = '); ReadLn(n);
 CreateMagic(n);
 ReadLn
end.






a kak iz etogo sozdat obichnuyu programmu chtobi zapuskat na
kompyutere
viagra cialis prescription onlin
Viagra Kaufen Ohne Rezept De
furosemide pharmacy pitampura in
Levitra Annonce
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.