1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Ещё одна задача Пусть матрица A целых чисел размером 10 на 10 записана по строкам в файле. Найдите все совпадающие между собой строки и столбцы и выведите их номера.
uses crt; var a: array[1..10,1..10] of Integer; {Матрица} x,y: Integer;
procedure Iskat; var Flag: Boolean; begin for x:=1 to 10 do begin Flag:=True; for y:=1 to 10 do if a[x,y]<>a[y,x] then Flag:=False; if Flag then WriteLn(x); end; end;
begin Clrscr; TextAttr:=7; Randomize; for x:=1 to 10 do for y:=1 to 10 do a[x,y]:=Random(2); {Заполняем массив} Iskat; for x:=1 to 10 do begin for y:=1 to 10 do Write(a[x,y]:5,' '); {Столбец(y) - строка(x)} WriteLn; end; end.
Она показывает матрицу, но не выводит результат совпадающие между собой строки и столбцы, как енто сделать?
function check(s: string): boolean; var to_do: boolean; i: integer; begin to_do := true; i := 1; while to_do and (i <= length(s)) do begin to_do := (pos(s[i], center_word) = 0); inc(i); end; check := to_do; end;
function ProcessWords(to_check: boolean; var f, g: text; var st: Tst): integer; const chars = [#10, #13, #26, ' ']; var ch, foo: char; i, _word_count, first, second: integer; _word: string; begin second := maxInt;
for i := 1 to 2 - byte(to_check) do begin _word_count := 0; reset(f); read(f, ch);
while not seekeof(f) do begin
while ch in chars do read(f, ch);
if ch <> #26 then _word := ch;
while not (ch in chars) do begin
read(f, ch); if not (ch in chars) then _word := _word + ch else break;
end; if _word <> '' then begin
inc(_word_count); if to_check then begin
if check(_word) then writeln(g, _word);
end;
if _word_count = first then st[1] := _word; if _word_count = second then begin st[2] := _word; break; end;
end;
end; first := (_word_count div 2) + (_word_count mod 2); second := first + (1 - (_word_count mod 2)); end;
ProcessWords := 1 + (second - first); end;
var st: Tst; f, g: text; i, n: integer; begin clrscr; assign(f, '01.txt'); reset(f); assign(g, '02.txt'); rewrite(g); n := ProcessWords(false, f, g, st); if n = 2 then begin write('select the word: '); for i := 1 to n do write('"' + st[i] + '" '); write('[1, 2] -> '); readln(i); center_word := st[i]; end else center_word := st[1];
writeln('working with word: ', center_word); ProcessWords(true, f, g, st);