п.1. - Напечатать все слова, отличные от последнего слова, которые состоят из тех же букв, что и первое слово.
п.2. - Напечатать все слова, отличные от последнего слова. Если слово нечетной длины, заменить все строчные гласные буквы прописными.
Может что то лишнее есть?
| Pascal |
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
| program test;
var
text: string[100];
wordArray: array[1..100] of string[20];
vowelArray: string[16];
separator,word: string[20];
flag,i,j,x1,x2,x3,n:integer;
procedure MyUpCase(var s:char);{ïðèâåäåíèå ê âåðõíåìó ðåãèñòðó}
begin
if s in ['a'..'z'] then s:=UpCase(s)
else if s in ['à'..'ï'] then s:=chr(ord(s)-32)
else if s in ['ð'..'ÿ'] then s:=chr(ord(s)-80)
else if s ='¸' then s:='¨';
end;
begin
vowelArray := 'eyuioaóåûàîýÿèþ';
j:=0;
n:=0;
separator:=', :;-().?!'; // ñòðîêà ðàçäåëèòåëåé ñëîâ
writeln('Please enter text');
readln(text);
text:= text + ' ';
for i := 1 to length(text) do
begin
if pos(text[i], separator) = 0 then // i-é ñèìâîë íå ðàçäåëèòåëü - ïðîäîëæàåì ñëîâî
word := word + text[i]
else // âñòðåòèëè ðàçäåëèòåëü - ïðåäûäóùåå ñëîâî çàêîí÷èëîñü
begin if length(word)>0
then begin
j:=j+1;
wordArray[j]:=word;
end;
word:= '';
end;
end;
writeln('Ïóíêò 1');
for i:=1 to j do
begin
for x1:=1 to length(wordArray[i]) do
begin
for x2:=1 to length(wordArray[1]) do
begin
if(wordArray[i][x1]=wordArray[1][x2]) then
begin
n:=n+1;
break;
end;
end;
end;
if(n=length(wordArray[i])) then
begin
flag:= 0;
if(length(wordArray[i])=length(wordArray[j])) then
begin
for x3:=1 to length(wordArray[j]) do
if(wordArray[i][x3]=wordArray[j][x3]) then flag:= flag+1;
end;
if(flag = length(wordArray[j])) then else
write(wordArray[i] + ' | ');
end;
n:= 0;
end;
writeln('Ïóíêò 2');
for i:=1 to j do
begin
if((length(wordArray[i]) mod 2)=1) then
begin
for x1:=1 to length(wordArray[i]) do
begin
for x2:=1 to length(vowelArray) do
begin
if(wordArray[i][x1]=vowelArray[x2]) then
begin
MyUpCase(wordArray[i][x1]);
end;
end;
end;
end;
flag:= 0;
if(length(wordArray[i])=length(wordArray[j])) then
begin
for x3:=1 to length(wordArray[j]) do
if(wordArray[i][x3]=wordArray[j][x3]) then flag:= flag+1;
end;
if(flag = length(wordArray[j])) then else
write(wordArray[i] + ' | ');
end;
end. |
|
(
