https://github.com/n1ghtf1re/lab7
Lab №7. Exploring the String Data Type
https://github.com/n1ghtf1re/lab7
Last synced: 5 days ago
JSON representation
Lab №7. Exploring the String Data Type
- Host: GitHub
- URL: https://github.com/n1ghtf1re/lab7
- Owner: N1ghtF1re
- Created: 2017-11-25T19:10:22.000Z (almost 8 years ago)
- Default Branch: master
- Last Pushed: 2017-11-30T17:49:29.000Z (almost 8 years ago)
- Last Synced: 2025-04-05T22:43:05.342Z (6 months ago)
- Language: Pascal
- Homepage:
- Size: 197 KB
- Stars: 2
- Watchers: 0
- Forks: 1
- Open Issues: 0
-
Metadata Files:
- Readme: README.md
Awesome Lists containing this project
README
Lab №7. Exploring the String Data Type
--------------------
***
#### Task:
**Task number 19**
Item 1. - Print those words that are different from the last word, in which the largest number of letters are ordered in alphabetical order.
item 2. - Print all words that are different from the last word. If the word is even-length, replace all lowercase vowels with capital letters.
>The program in item 1. - prints those words that are different from the last word, in which the largest number of letters, ordered in alphabetical order, in paragraph 2. prints all words that are different from the last word. If the word is even-length, replace all lowercase vowels with capital letters.
**Language**: Delphi
**Algorithm scheme**:
**Code:**
``` pascal
program lab7;
{$APPTYPE CONSOLE}
const N=255;
const acceptchars = ['A'..'z', ' '];
const uperCase = ['A'..'Z'];
const vowels = ['a','e','u','i','o'];
type
TStringsArray = array[1..N] of string;
var str:string;
function toDownCase(str:string):string;
var i:byte;
begin
for i:=1 to Length(str) do
begin
if (str[i] in uperCase) then
begin
str[i] := chr(Ord(str[i]) + 32);
end;
toDownCase:=str;
end;
end;
function searchLastWord(var str: string):string;
var i:integer;
begin
i:=Length(str);
while(str[i] <> ' ') do
Dec(i);
searchLastWord:= copy (str,i+1,Length(str) );
end;
procedure repairString(var str:string);
var i,N:integer;
begin
n:=Length(str);
i:=1;
while(i <= N) do
begin
if(str[1] = ' ') then
begin
Delete(str,1,1);
Dec(N);
end
else
begin
if(str[N] = ' ') then
begin
Delete(str,n,1);
Dec(N);
end
else
begin
if(((str[i] = ' ') and (str[i+1] = ' ')) or (not (str[i] in acceptchars)))
then
begin
Delete(str,i,1);
Dec(N);
end
else
Inc(i);
end;
end;
end;
end;
procedure findNeedWords(var str: string; var arr: TStringsArray; var k: integer);
var nullarr: TStringsArray;
count,maxcount,lastpos:byte;
i:integer;
procedure compString;
begin
if (count > maxcount) then
begin
maxcount:=count;
arr:=nullarr;
k:=1;
arr[k]:=Copy(str,lastpos+1, i-lastpos-1);
Delete(str,i-length(arr[k]), length(arr[k])+1);
i:=i-length(arr[k])-1;
inc(k);
end
else
begin
if (count = maxcount) then
begin
arr[k]:=Copy(str,lastpos+1, i-lastpos-1);
Delete(str,i-length(arr[k]), length(arr[k])+1);
i:=i-length(arr[k])-1;
inc(k);
end;
end;
count:=0;
lastpos:=i;
inc(i);
end;
begin
nullarr:=arr;
maxcount:=1;
k:=1;
lastpos:=0;
count:=0;
i:=2;
while(i <= Length(str)) do
begin
if(str[i] > str[i-1]) then
Inc(count)
else
begin
if(pos(' ', copy(str,i,length(str)-i)) <> 0) then
i:=pos(' ', copy(str,i,length(str)-i))+i-1;
end;
if (str[i] = ' ') then
begin
compString;
end;
inc(i);
end;
i:=2;
lastpos:=0;
count:=0;
while(i <= Length(str)) do
begin
if((str[i] < str[i-1]) and (str[i] <> ' ')) then
Inc(count)
else
begin
if(pos(' ', copy(str,i,length(str)-i)) <> 0) then
i:=pos(' ', copy(str,i,length(str)-i))+i-1;
end;
if (str[i] = ' ') then
begin
compString;
end;
inc(i);
end;
end;
procedure deleteUtilWord(var str:string);
var lastword, dcstr:string;
isEnd:Boolean;
position:byte;
diff:Byte;
begin
dcstr:=toDownCase(str);
lastword:= searchLastWord(dcstr);
isEnd:=false;
diff:=0;
while(not isEnd) do
begin
position:=pos(lastword, dcstr);
if(position <> 0) then
begin
if (((dcstr[position-1] = ' ') or (dcstr[position-1] = '')) and
((dcstr[position+length(lastword)] = ' ') or (dcstr[position+length(lastword)] = '')))
then
begin
Delete(str, position+diff*length(lastword), Length(lastword));
Delete(dcstr, position, Length(lastword));
end
else
begin
Delete(dcstr, position, Length(lastword));
inc(diff);
end;
end
else
isEnd:=True;
end;
end;
procedure getFinalFormating(var str:string);
var i,j, lastindex,count:byte;
begin
i:=1;
lastindex:=0;
count:=0;
while(i <= Length(str)) do
begin
if (str[i] <> ' ') then
begin
Inc(count);
end
else
begin
if (not Odd(count)) then
begin
for j:=lastindex+1 to i-1 do
begin
if (str[j] in Vowels) then
str[j]:=UpCase(str[j]);
end;
end;
count:=0;
lastindex:=i;
end;
inc(i);
end;
end;
procedure p1(str:string);
var i,newarrN:integer;
StrArr:TStringsArray;
begin
str:=toDownCase(str);
writeln(str);
newarrN:=1;
findNeedWords(str, StrArr,newarrN);
Writeln('Point 1:');
for i:=1 to newarrN do
write(StrArr[i], ' ');
Writeln;
end;
procedure p2(str:string);
begin
getFinalFormating(str);
Writeln('Point 2:');
writeln(str);
end;
begin
repeat
Writeln('Please, enter string');
Readln(str);
repairString(str);
until(Pos(' ', str) <> 0);
deleteUtilWord(str);
repairString(str);
str:=str+' ';
p1(str);
p2(str);
Readln;
end.
```