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) 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
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) 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
28.08.2021 13:57
Viagra Kaufen Ohne Rezept De
furosemide pharmacy pitampura in
17.09.2021 3:31
Levitra Annonce
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.