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 count_words), потом находим нужные слова(procedure find_words). Если их двое, то выбираем одно из них. Создаем новый файл, в который записываем слова, букв которых нет в выбранном слове.
program big_help; uses crt; procedure create_file(s:string); var t:text; temp:string; begin temp:='ab bc c bd km b '; assign(t,s); rewrite(t); writeln(t,temp); close(t); end;
function count_words(s:string):integer; var f:text; n:integer; temp:string; ch:char; begin assign(f,s); reset(f); n:=0; while not eof(f) do begin read(f,ch); if (ch=' ') or (ch=#13) then inc(n); end; count_words:=n; close(f); end;
function choose_word(r1,r2:string):string; var ch:char; begin writeln('Press 1 if you want to choose first word : ',r1, ' and 2 if second : ',r2); ch:=readkey; if ch='1' then choose_word:=r1; if ch='2' then choose_word:=r2; end;
procedure find_words(n:integer; s:string; var res1,res2:string); var f:text; i,buf1,buf2:integer; ch:char; begin i:=0; res1:=''; res2:=''; if (n mod 2)=0 then begin buf1:=n div 2; buf2:=n div 2 + 1; end else begin buf1:=n div 2 + 1; buf2:=-1; end; assign(f,s); reset(f); while not eof(f) do begin read(f,ch); if (ch=' ') or (ch=#13) then inc(i); if (i=buf1-1) and (ch<>' ') then res1:=res1+ch; if (i=buf2-1) and (ch<>' ') then res2:=res2+ch; end; close(f); end;
procedure result_file(path1,path2,res:string); var f1,f2:text; ch:char; buf:string; i:integer; b:boolean; begin assign(f1,path1); assign(f2,path2); reset(f1); rewrite(f2); buf:=''; b:=true; while not eof(f1) do begin read(f1,ch); if ch=' ' then begin for i:=1 to length(buf) do if pos(buf[i],res)<>0 then b:=false; if b=true then write(f2,buf+' '); b:=true; buf:=''; end else buf:=buf+ch; end; close(f1); close(f2); end; var num:integer; res1,res2,res:string; begin clrscr; create_file('d:\temp.dat'); num:=count_words('d:\temp.dat'); find_words(num,'d:\temp.dat',res1,res2); if res2<>'' then res:=choose_word(res1,res2) else res:=res1; result_file('d:\temp.dat','d:\res.dat',res); readln; end.
Сообщение отредактировано: volvo -
--------------------
Лао-Цзы : Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.