siruri de caractere
Se citeşte un text într-o variabilă de tip string, in care cuvintele se despart prin spaţii. Se cere:
a) să se afişeze cuvintele în ordine alfabetică;
b) să se numere cuvintele cu minim 4 vocale distincte.
var a:array[1..30] of string;
n:byte;
procedure citire;
var c:char;s:string;i,k:integer;
begin
write('sirul=');readln(s);
n:=1;
i:=1;
k:=length(s);
while(i<=k) do
begin
a[n]:='';
while (s[i]<>' ')and(i<=k) do
begin
a[n]:=a[n]+s[i];
i:=i+1;
end;
if i<k then begin n:=n+1;i:=i+1;end;
end;
end;
procedure afisare;
var i:byte;
begin
for i:=1 to n do
writeln(a[i]);
writeln;
end;
procedure sortare;
var aux:string;i,j:byte;
begin
for i:=1 to n-1 do
for j:=i+1 to n do
if a[i]>a[j] then begin
aux:=a[i];
a[i]:=a[j];
a[j]:=aux;
end;
end;
procedure litere_distincte;
var nr,i,p:byte;c:char;
begin
for i:=1 to n do
begin
nr:=0;
for c:='a' to 'z' do
if pos(c,a[i])>0 then nr:=nr+1;
for c:='A' to 'Z' do
if pos(c,a[i])>0 then nr:=nr+1;
if nr>=4 then writeln(a[i]);
end;
end;
begin
citire;
afisare;
writeln('sortare ');
sortare;
afisare;
writeln('cuvintele cu cel putin 4 litere distincte');
litere_distincte;
end.
22. Se citeşte de la tastatură un cuvânt. Să se afişeze numărul iniţial de caractere ale cuvântului şi apoi să se şteargă toate vocalele din cuvânt.
var s:string;
n:integer;
procedure sterge;
var x,i:byte;
begin
x:=pos('a',s);
while x>0 do begin
delete(s,x,1);
x:=pos('a',s);
end;
x:=pos('A',s);
while x>0 do begin
delete(s,x,1);
x:=pos('A',s);
end;
x:=pos('e',s);
while x>0 do begin
delete(s,x,1);
x:=pos('e',s);
end;
x:=pos('E',s);
while x>0 do begin
delete(s,x,1);
x:=pos('E',s);
end;
x:=pos('i',s);
while x>0 do begin
delete(s,x,1);
x:=pos('I',s);
end;
x:=pos('o',s);
while x>0 do begin
delete(s,x,1);
x:=pos('o',s);
end;
x:=pos('O',s);
while x>0 do begin
delete(s,x,1);
x:=pos('O',s);
end;
x:=pos('u',s);
while x>0 do begin
delete(s,x,1);
x:=pos('u',s);
end;
x:=pos('U',s);
while x>0 do begin
delete(s,x,1);
x:=pos('U',s);
end;
writeln('sirul fara vocale=',s);
end;
begin
write('s=');readln(s);
writeln('nr de caractere din sir=',length(s));
sterge;
end.
23. Se citesc de la tastatură 2 şiruri de caractere. Să se verifice dacă sunt egale (la fel) fără a se face deosebire între literele mari şi literele mici.
var s1,s2:string;
procedure citire;
begin
write('primul sir'); readln(s1);
write('al doilea sir');readln(s2);
end;
procedure verificare;
var n1,n2,i:byte;
begin
n1:=length(s1);
n2:=length(s2);
if n1<>n2 then begin write('nu sunt egale');halt; end;
i:=1;
while(i<=n1) do begin
if upcase(s1[i])=upcase(s2[i])
then i:=i+1
else begin
write('sirurile nu sunt egale');
halt;
end;
end;
writeln('siruri egale');
end;
begin
citire;
verificare;
end.
