Помощь - Поиск - Пользователи - Календарь
Полная версия: Создание магического квадрата
Форум «Всё о Паскале» > 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(r);
            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(r);
            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
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.