разбиение на слова + массивы, Массивы + строки Опции

[HeX]

SoS

1.Дана строка символов. Группу символов, разделенных с одной или с обеих сторон одним или несколькими пробелами и не содержащую внутри себя пробелов, назовем словом.
Присвоить переменной F = 1, если слово с наибольшим количеством символов находится в первой половине строки, F= 2 – во второй половине, F= 0 – часть слово в первой, а часть во второй. Предполагается, что слово с наибольшей длиной единственное.

2.Дана целочисленная прямоугольная матрица. Определить номер первого из столбцов, содер-жащих хотя бы один нулевой элемент.
Характеристикой строки целочисленной матрицы назовем сумму ее отрицательных четных элементов. Переставляя строки заданной матрицы, расположить их в соответствии с убыванием характеристик.

[Altair]

1.Дана строка символов. Группу символов, разделенных с одной или с обеих сторон одним или несколькими пробелами и не содержащую внутри себя пробелов, назовем словом.
Присвоить переменной F = 1, если слово с наибольшим количеством символов находится в первой половине строки, F= 2 – во второй половине, F= 0 – часть слово в первой, а часть во второй. Предполагается, что слово с наибольшей длиной единственное.

вот

Исходный код

Type
TElem = string;
TList = ^TNode;
TNode = record
Info: TElem;
Next: TList
end;


function getmax(l:tlist):string;
var
max:string;
begin
max:='';
while L <> nil DO
begin
if length(L^.Info)>length(max) then max:=L^.Info;
L := L^.Next
end;
getmax:=max;
end;


procedure ListClear ( var L: TList );
var
N: TList;
begin
while L <> nil do
begin
N :=L;
L:=L^.Next;
dispose(N)
end
end;


function SepWord(s:string):tlist;
procedure AddLast(var L: TList; E: TElem);
var
N, P: TList;
Begin
new(N);
N^.Info :=E; N^.Next :=nil;
if L= nil then L:=N else begin
P:=L;
while P^.Next <> nil do P:=P^.Next;
P^.Next:=N
end
End;
const
i:integer=1;
r:set of char = [chr(0)..chr(255)]-['A'..'Z','a'..'z','1'..'9','0'];
var
SL:boolean; L: TList; ss:string;
begin
sl:=false; L:=nil; ss:='' ; i:=1;
while i<=length(s) do begin
if ((not(s[i] in r)) and (sl=false)) then sl:=true;
if (not(s[i] in r)) and (sl=true) then ss:=ss+s[i];
if ((s[i] in r)or(i=length(s))) and (sl=true) then
begin
AddLast(L,ss); ss:=''; sl:=false;
end;
inc(i)
end;
SepWord:=L;
end;

var
L:tlist;
maxstr,s:string;
f:byte;
begin
l:=nil;
write('Enter string : '); readln(s);
l:=sepword(s);
maxstr:=getmax(l);
if pos(maxstr,s)<length(s) div 2 then f:=1;
if pos(maxstr,s)>length(s) div 2 then f:=2;
if (pos(maxstr,s)<length(s) div 2) and (pos(maxstr,s)+length(maxstr)>length(s) div 2) then f:=0;
writeln(f);
readln;
listclear(l);
end.