IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Типизированные файлы, матрица
leahov
сообщение 3.06.2006 12:17
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 39
Пол: Мужской
Реальное имя: leahov

Репутация: -  0  +


Ещё одна задача
Пусть матрица 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.


Она показывает матрицу, но не выводит результат совпадающие между собой строки и столбцы, как енто сделать?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
volvo
сообщение 6.06.2006 7:53
Сообщение #2


Гость






Нужен еще вариант?
uses crt;
type
Tst=Array[1..2] of string;

var
center_word: string;

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);

close(f); close(g);
end.
 К началу страницы 
+ Ответить 
Malice
сообщение 6.06.2006 9:43
Сообщение #3


Профи
****

Группа: Пользователи
Сообщений: 705
Пол: Мужской

Репутация: -  20  +


Ну раз пошла такая пьянка, вот тебе вариант для комикадзе wacko.gif
uses crt;
const sl:set of char =['a'..'z','A'..'Z'];
var t:file of char;
y:text;
c:char;
b:boolean;
s1,s2:string;
i,kll,kol:integer;
begin
assign(t,'c:\readme.txt'); reset(t);
assign(y,'c:\readme.out'); rewrite(y);
b:=true;
kol:=0; clrscr;
for i:=0 to 1 do begin
repeat
read(t,c);
if (c in sl) and b then if i=0 then inc (kol) else inc (kll);
b:=not(c in sl);
until ((eof(t) and (i=0))) or ((kll=(kol div 2)) and (i=1));
if i=0 then begin reset (t); b:=true; kll:=0; end;
end;
b:=false;
repeat
if c in sl then
if kll=kol div 2 then s1:=s1+c else s2:=s2+c;
read(t,c);
if (c in sl) and b then inc (kll);
b:=not(c in sl);
until kll=(1+kol div 2+byte(odd(kol+1)));
if odd(kol+1) then begin
writeln ('Колво слов в тексте четно (',kol,'), какое нужно ?');
writeln ('1-',s1); writeln ('2-',s2);
repeat c:=readkey; until c in ['1','2'];
if c='2' then s1:=s2;
end;
reset(t);
s2:=''; b:=false;
repeat
if (c in sl) and b then s2:=s2+c else begin s2:=''; end;
read(t,c); b:=(c in sl);
if not(b) then begin
b:=true;
for i:=1 to length(s2) do b:=(pos(s2[i],s1)=0) and b;
if b and (length(s2)>0) then writeln (y,s2); b:=false;
end;
until eof(t);
close(t); close(y);
end.

smile.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
leahov   Типизированные файлы   3.06.2006 12:17
leahov   похоже что всё таки это не из этой оперы   3.06.2006 12:30
RaV   А где у тебя файл? И ещё совподать должны строки ...   3.06.2006 12:33
volvo   leahov, а ты внимательно смотрел на свою процедуру...   3.06.2006 12:35
leahov   оп, звиняйте, я не весь код влил это вообща код и...   3.06.2006 12:45
RaV   Я думаю, что должна быть записана в файле.   3.06.2006 12:49
leahov   Ребят, в общем если можете помочь решить два задан...   3.06.2006 13:01
RaV   Ты их реши,а если не будет что-то получаться задаш...   3.06.2006 13:17
leahov   у меня просто срок сдачи в понедельник, дома интер...   3.06.2006 13:25
Bokul   Вот. Вроде все работает. Считывания сможешь сам о...   3.06.2006 19:53
leahov   Bokul спасибо. вроде довел до рабочего состояния   5.06.2006 9:23
leahov   Уважаемые знатоки Паскаля Так и не смог написать ч...   5.06.2006 11:17
Bokul   Вот вроде сделал... :) Алгоритм: сначала проход...   6.06.2006 3:27
leahov   Bokul спасибо добрый человек!   6.06.2006 7:05
volvo   Нужен еще вариант? uses crt; type Tst=Array[1..2...   6.06.2006 7:53
Malice   Ну раз пошла такая пьянка, вот тебе вариант для ко...   6.06.2006 9:43


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 30.07.2025 15:45
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"