1) Написать алгоритм создания магического квадрата любой размерности. (Магический квадрат: суммы элементов в каждом столбце равны сумме элементов в каждой строке равны сумме элементов на 2 больших диагоналях) 2) Дано 300 точек. Построить прямую (уравнение прямой), содержащую максимальное кол-во точек из этих 300. (Примечание: в задаче необходимо использовать записи) 3)Дано 300 точек. Найти такую прямую (уравнение прямой) , чтобы разницы между суммой точек сверху и суммой точек снизу была минимальна.
Altair
27.12.2004 21:16
Цитата
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
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) ThenBegin
i := 1; j := Succ(n div2);
For k := 1To Sqr(n) doBegin
a[i,j] := k;
If k mod n = 0Then Inc(i)
ElseBegin
Dec(i); Inc(j);
If i = 0Then i := n;
If j > n Then j := 1EndEnd;
EndElseIf n mod4 = 0ThenBegin
k := 1;
For i := 1To n DoFor j := 1To n DoBegin
a[i, j] := k; Inc(k)
End;
j := 2; m := n div2;
For i := 1To m DoFor k := 1To m Div2DoBeginIf j = Succ(m) Then j := 2ElseIf 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)
EndEndElseIf n <> 2ThenBegin
k := 1;
For i := 1To n DoFor j := 1To n DoBegin
a[i, j] := k; Inc(k)
End;
r := Pred(n div2) div2; m := n div2;
For i := 1To m DoBegin
j := i;
For k := 1To r DoBeginIf 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)
EndEnd;
i := 1; j := Succ(r);
For k := 1To m DoBeginIf 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 := 1To m DoBeginIf j > m Then j := 1;
b := Succ(n - j);
Swap(a[i, j], a[i, b]);
Inc(i); Inc(j)
EndEndElse p := False;
If p ThenBeginFor i := 1To n DoBeginFor j := 1To n Do
Write(a[i, j]: 4);
WriteLn
EndEndElse
WriteLn( 'do not exists' )
End;
Var
n: Integer;
begin
WriteLn('n = '); ReadLn(n);
CreateMagic(n);
ReadLn
end.
gooddron123
27.12.2004 21:22
Oleg_Z Понял, ничего сложного вроде нет. Спасибо огромное.
volvo
Спасибо большое.
P.S. Не ожидал такого оперативного реагирования. Приятно удивлен.
Altair
27.12.2004 21:30
Цитата
P.S. Не ожидал такого оперативного реагирования. Приятно удивлен.
Ну дык ты на форум -то посмотри! это же лучший в сети.
да, насчет 3 программы- там аналогично вобщем... (только при переборе точек условие другое провереятся).
если что не получиться - обращайся. только сначала сампопробуй решить - только так сможешь хорошо освоить решение задач...
заходи еще!
Armen
19.12.2017 17:26
Цитата(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) ThenBegin
i := 1; j := Succ(n div2);
For k := 1To Sqr(n) doBegin
a[i,j] := k;
If k mod n = 0Then Inc(i)
ElseBegin
Dec(i); Inc(j);
If i = 0Then i := n;
If j > n Then j := 1EndEnd;
EndElseIf n mod4 = 0ThenBegin
k := 1;
For i := 1To n DoFor j := 1To n DoBegin
a[i, j] := k; Inc(k)
End;
j := 2; m := n div2;
For i := 1To m DoFor k := 1To m Div2DoBeginIf j = Succ(m) Then j := 2ElseIf 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)
EndEndElseIf n <> 2ThenBegin
k := 1;
For i := 1To n DoFor j := 1To n DoBegin
a[i, j] := k; Inc(k)
End;
r := Pred(n div2) div2; m := n div2;
For i := 1To m DoBegin
j := i;
For k := 1To r DoBeginIf 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)
EndEnd;
i := 1; j := Succ(r);
For k := 1To m DoBeginIf 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 := 1To m DoBeginIf j > m Then j := 1;
b := Succ(n - j);
Swap(a[i, j], a[i, b]);
Inc(i); Inc(j)
EndEndElse p := False;
If p ThenBeginFor i := 1To n DoBeginFor j := 1To n Do
Write(a[i, j]: 4);
WriteLn
EndEndElse
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
28.08.2021 13:57
Viagra Kaufen Ohne Rezept De
furosemide pharmacy pitampura in
17.09.2021 3:31
Levitra Annonce
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.