Пожалуйста напишите прогу на Pascal'е!

Ответить
Impulsive
Сообщения: 43
Зарегистрирован: 19 окт 2007, 20:53

Подскажите как проще? И почему какие либо значения я б не вводил, все время покзаывает - что не равны! Ее воще упростить нельзя?
C_O_D_E
Сообщения: 296
Зарегистрирован: 13 фев 2008, 20:10
Откуда: Беларусь. Орша
Контактная информация:

Запусти мой вариант (изивини, что на "ты")
вводишь (только четко)
f
g
h
0
это первое множество, точно так же вводишь второе
f
g
h
0

затем ENTER

если выходит назад в окно кодера, то ALT+F5
и как ни странно выводит множества равны.

Прогу упростить можно. тебе к какому числу? постараюсь сделать.
Делать с коментами или разберешься?
Если назначен специальный человек для контроля за чистотой исходной информации, то найдется изобратательный идиот, который придумает способ, чтобы неправильная информация прошла этот контроль.
Impulsive
Сообщения: 43
Зарегистрирован: 19 окт 2007, 20:53

Сделал как сказали, все равно не равны. :( Желательно с коментариями, :( к завтра.
C_O_D_E
Сообщения: 296
Зарегистрирован: 13 фев 2008, 20:10
Откуда: Беларусь. Орша
Контактная информация:

ПОЧЕМУ ТОГДА У МЕНЯ РАВНЫ????????????????????
Если назначен специальный человек для контроля за чистотой исходной информации, то найдется изобратательный идиот, который придумает способ, чтобы неправильная информация прошла этот контроль.
C_O_D_E
Сообщения: 296
Зарегистрирован: 13 фев 2008, 20:10
Откуда: Беларусь. Орша
Контактная информация:

ввод множеств с клавы или можно случайно?
Если назначен специальный человек для контроля за чистотой исходной информации, то найдется изобратательный идиот, который придумает способ, чтобы неправильная информация прошла этот контроль.
Impulsive
Сообщения: 43
Зарегистрирован: 19 окт 2007, 20:53

C_O_D_E писал(а):ввод множеств с клавы или можно случайно?
с клавы. Делаю чтоб все попарно были равны - а множество выдает не равны..
C_O_D_E
Сообщения: 296
Зарегистрирован: 13 фев 2008, 20:10
Откуда: Беларусь. Орша
Контактная информация:

Работает

Код: Выделить всё

const
N=255;

var
A, B: array[1..N] of char;
nA, nB: integer;
i, j: integer;
ch: char;
eq: boolean;
sa,sb:string;

begin
nA := 0; {кол-во элементов в первом множестве}
nB := 0;{во втором}


Writeln('Введите множество в строку, элементы разделять пробелами ');
readln(Sa);
for i:=1 to Length(Sa) do begin  {до конца строки считать}
If sa[i]=' ' then delete(sa,i,1)  {удалим пробелы}
end;

Writeln('Введите 2e множество в строку, элементы разделять пробелами');
readln(Sb);
for i:=1 to Length(Sb) do begin  {см выше}
If sb[i]=' ' then delete(sb,i,1)
end;
nA:=Length(sa);  {новая длина без пробелов}
nB:=Length(sb); {--}
For i:=1 to nA do A[i]:=Sa[i];{заполняем массив символов}
For i:=1 to nB do B[i]:=Sb[i];



{Сортируем 1-е м*ожество}
for i:=1 to nA do   {сортировка}
for j:=1 to nA-1 do begin
if A[j] > A[j+1] then begin
ch := A[j];
A[j] := A[j+1];
A[j+1] := ch;
end;
end;

{Сортируем 2-е м*ожество}
for i:=1 to nB do
for j:=1 to nB-1 do begin
if B[j] > B[j+1] then begin
ch := B[j];
B[j] := B[j+1];
B[j+1] := ch;
end;
end;

{Ср*в*ив*ем м*ожеств*}
eq := true;
if nA<>nB then eq := false  {если размерность не равна, то соответственно не равны}

else begin  {проверяем равенство каждого символа}
for i:=1 to nA do
if A[i] <> B[i] then begin
eq := false; break; end  
else eq:= true;
end;

if eq = true then Writeln('Равны')
else Writeln('Не равны');
readln;
end.
Если назначен специальный человек для контроля за чистотой исходной информации, то найдется изобратательный идиот, который придумает способ, чтобы неправильная информация прошла этот контроль.
Impulsive
Сообщения: 43
Зарегистрирован: 19 окт 2007, 20:53

Спасиб... Я насчет #2 задачи, зачем какие-то процедуры - ведь можно сделать все легче, ток мозга пока не хватает!
Impulsive
Сообщения: 43
Зарегистрирован: 19 окт 2007, 20:53

#2.
program l2;
const gluh=['k','p','s','t','f','h','c','w']; {глухие звуки - (латинским)}
type wrds=array[1..250] of string;
var l:string;
ww:wrds;
len,ii:integer;

procedure fromstringtwords;
var i,j:integer;
cs:string;
begin
i:=1;
j:=1;
cs:='';
while l<>'.' do begin
if l=',' then
begin
ww[j]:=cs;
cs:='';
inc(j);
end else cs:=cs+l;
inc(i);
end;
ww[j]:=cs;
len:=j;
end;

function ninchet(s:char):boolean;
var i,j:integer;
k:boolean;
begin
i:=0;
k:=true;
while (i<=len) and k do
begin
inc(i,2);
j:=1;
while (j<=length(ww))and(ww[j]<>s) do inc(j);
if j<=length(ww) then
begin
k:=false;
end;
end;
ninchet:=i>len;
end;

function inallnechet(s:char):boolean;
var i,j:integer;
k:boolean;
begin
k:=true;
i:=-1;
while (i<=len) and k do
begin
inc(i,2);
j:=1;
while (j<=length(ww)) and (ww[j]<>s) do inc(j);
k:=j>length(ww);
end;
inallnechet:=i<len;
end;

begin
fillchar(ww,sizeof(ww),0);
read(l);
fromstringtwords;
for ii:=40 to 256 do
if chr(ii) in gluh then
begin
if ninchet(chr(ii)) and inallnechet(chr(ii)) then write(chr(ii),' ');
end;
end.

Задание:
Дана непустая последовательность слов из строчных русских букв; между соседними словами - запятая, за последним словом - точка. Напечатать в алфавитном порядке:
все глухие согласные буквы, которые входят в каждое нечетное слово и не входят хотябы в одно четное слово.

Не могу понять - я последовательность слов должен с клавиатуры вводить?

Подкариктируйте плз, может ее и легче можно переделать... Эт сильно замудренно
Зачем создавать procedure fromstringtwords, function ninchet, function inallnechet, можно при решение задания обойтись без нее?
C_O_D_E
Сообщения: 296
Зарегистрирован: 13 фев 2008, 20:10
Откуда: Беларусь. Орша
Контактная информация:

1) размещая код программы, заключай ее между тегами
2) процедуры и функции обычно используются для упрощения. я посмотрю. к какому дню (тока не говори, что к вчерашнему!!!)
Если назначен специальный человек для контроля за чистотой исходной информации, то найдется изобратательный идиот, который придумает способ, чтобы неправильная информация прошла этот контроль.
Ответить