Версия для печати темы

Автор: mitten 11.12.2007 2:06

В массивах М1(10),М2(8) и М3(5),элементы которых представлены 5-ти символьными словами,осуществить выборку тех из них,которые содержат 2 и более гласных букв.Из этих элементов сформировать новые массивы с подсчетом числа элементов.Новые и старые массивы распечатать.Вроде что-то сделала но хз прально или нет.

program satan;
uses crt;
var
m1: array[1..10] of string;
m2: array[1..8] of string;
m3: array[1..5] of string;
m4: array[1..23] of string;
s:real;
i,n,f,z: integer;
d,g:byte;
ch:char;
label
l1, l2;
begin
clrscr;
gotoxy(17,6);
textcolor(yellow);
writeln('‚ Вашему вниманию представляется программа ,');
gotoxy(23,7);
writeln('сортирующая элементы массива ');
gotoxy(17,8);
writeln('в порядке возрастания методом "m". ');
gotoxy(32,10);
textcolor(red);
writeln('Внимание! ');
gotoxy(10,11);
gotoxy(42,16);
textcolor(green);
writeln('Программу составила...');
gotoxy(42,17);
writeln('МГУПС группы ЭИЭ-111');
gotoxy(42,18);
writeln('........... ');
gotoxy(42,19);
writeln('Москва 14.11.2007');
gotoxy(32,24);
textcolor(white);
writeln(' Нажмите любую клавишу для продолжения...');
ch:=readkey;
l1:
clrscr;
for i:= 1 to 10 do
begin
write('Введите m1[' , i,']= ');
readln(m1[i]);
end;
for i:= 1 to 8 do
begin
write('Введите m2[' , i,']= ');
readln(m2[i]);
end;
for i:= 1 to 5 do
begin
write('Введите m3[' , i,']= ');
readln(m3[i]);
end;
n:=0;
for i:= 1 to 10 do
begin
if m1[i]='e' then begin m4[i]:=m1[i]; n:=n+1; end;
if m1[i]='y' then begin m4[i]:=m1[i]; n:=n+1; end;
if m1[i]='u' then begin m4[i]:=m1[i]; n:=n+1; end;
if m1[i]='i' then begin m4[i]:=m1[i]; n:=n+1; end;
if m1[i]='o' then begin m4[i]:=m1[i]; n:=n+1; end;
if m1[i]='a' then begin m4[i]:=m1[i]; n:=n+1; end;
if m1[i]='E' then begin m4[i]:=m1[i]; n:=n+1; end;
if m1[i]='Y' then begin m4[i]:=m1[i]; n:=n+1; end;
if m1[i]='U' then begin m4[i]:=m1[i]; n:=n+1; end;
if m1[i]='I' then begin m4[i]:=m1[i]; n:=n+1; end;
if m1[i]='O' then begin m4[i]:=m1[i]; n:=n+1; end;
if m1[i]='A' then begin m4[i]:=m1[i]; n:=n+1; end;
END;
FOR I:=1 to 10 do
begin
write (m4[i],', ' );
end;
writeln (n);
n:=0;
for i:= 1 to 8 do
begin
if m2[i]='e' then begin m4[i+10]:=m2[i]; n:=n+1; end;
if m2[i]='y' then begin m4[i+10]:=m2[i]; n:=n+1; end;
if m2[i]='u' then begin m4[i+10]:=m2[i]; n:=n+1; end;
if m2[i]='i' then begin m4[i+10]:=m2[i]; n:=n+1; end;
if m2[i]='o' then begin m4[i+10]:=m2[i]; n:=n+1; end;
if m2[i]='a' then begin m4[i+10]:=m2[i];n:=n+1; end;
if m2[i]='E' then begin m4[i+10]:=m2[i]; n:=n+1; end;
if m2[i]='Y' then begin m4[i+10]:=m2[i]; n:=n+1; end;
if m2[i]='U' then begin m4[i+10]:=m2[i]; n:=n+1; end;
if m2[i]='I' then begin m4[i+10]:=m2[i]; n:=n+1; end;
if m2[i]='O' then begin m4[i+10]:=m2[i]; n:=n+1; end;
if m2[i]='A' then begin m4[i+10]:=m2[i];n:=n+1; end;
end;
FOR I:=1 to 8 do
begin
write (m4[i+10],', ' );

end;
writeln (n);
n:=0;
for i:= 1 to 5 do
begin
if m3[i]='e' then begin m4[i+18]:=m3[i] ; n:=n+1; end;
if m3[i]='y' then begin m4[i+18]:=m3[i]; n:=n+1; end;
if m3[i]='u' then begin m4[i+18]:=m3[i]; n:=n+1; end;
if m3[i]='i' then begin m4[i+18]:=m3[i]; n:=n+1; end;
if m3[i]='o' then begin m4[i+18]:=m3[i]; n:=n+1; end;
if m3[i]='a' then begin m4[i+18]:=m3[i]; n:=n+1; end;
if m3[i]='E' then begin m4[i+18]:=m3[i]; n:=n+1; end;
if m3[i]='Y' then begin m4[i+18]:=m3[i]; n:=n+1; end;
if m3[i]='U' then begin m4[i+18]:=m3[i]; n:=n+1; end;
if m3[i]='I' then begin m4[i+18]:=m3[i]; n:=n+1; end;
if m3[i]='O' then begin m4[i+18]:=m3[i]; n:=n+1; end;
if m3[i]='A' then begin m4[i+18]:=m3[i]; n:=n+1; end;
end;
FOR I:=1 to 5 do
begin
write (m4[i+18],', ' );
end;
writeln (n);
n:=0;
writeln(' Хотите ли вы еще раз отсортировать массив? (Y - да , N -нет) ');
l2:
case readkey of
#89: goto l1;
#121: goto l1;
#78: exit;
#110: exit;
end;
goto l2;
end.




и вопрос есть ли в паскале функция отличающая гласные буквы от согласных???Заранее пасиб...[size=1]

М

1. Зачем кричишь в названии темы? 2. Используй тег CODE.

Автор: volvo 11.12.2007 2:28

Нет, но написать можно:

function is_vowel(ch: char): boolean;
begin
  is_vowel := upcase(ch) in ['A', 'E', 'O', 'I', 'U', 'Y'];
end;

Теперь есть

Автор: mitten 11.12.2007 2:36

остались гении на планете)а куда это все впихнуть и что удалить??)

Автор: volvo 11.12.2007 3:32

Проще будет удалить все и переделать... Ты сделала не по заданию, тебе надо перенести удовлетворяющие условию элементы массива в новые массивы, а не свалить все в один-единственный m4...

Как-то вот так (набросаю для одного m1, потом это надо будет оформить как процедуру):

var
  s: string;
  i, j, n, curr: integer;
  m1, m1_new: array[1 .. 10] of string;
...
{ здесь ввод массивов }
curr := 0;
for i := 1 to 10 do begin
  s := m1[i]; n := 0;
  for j := 1 to length(s) do if is_vowel(s[j]) then inc(n);
  if n >= 2 then begin
    inc(curr); m1_new[curr] := s;
  end;
end;

{ и печатаем содержимое сформированного массива: }
for i := 1 to curr do write(m1_new[i], ' ');
...

То же самое повторить с остальными массивами (m2, m3)...

Автор: mitten 12.12.2007 3:12

пасиб большое