SoS

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

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

вот

const
 size_row = 10; { число строк }
 size_col = 10; { число столбцов }

type
 tvector = array[1 .. size_col] of integer;
 tmatrix = array[1 .. size_row] of tvector;

var
 mx: tmatrix;
 n,m, i, j: integer;  s:integer;


procedure swap_rows(var mx: tmatrix;
         const i, j: integer);
 var T: tvector;
 begin
   T := mx[i]; mx[i] := mx[j]; mx[j] := T
 end;

procedure print(var mx: tmatrix);
 var i, j: integer;
 begin
   for i := 1 to n do
     begin
       for j := 1 to m do
         write(mx[i][j]:4);
       writeln
     end;
 end;

function har(mx:tmatrix; i:integer):integer;
 var j: integer; s:integer;
 begin
   s:=0;
   for j  := 1 to m do   begin
     if (mx[i,j]<0) and (not (odd(mx[i][j]))) then inc(s,mx[i,j]);
   end;
   har:=s;
 end;



begin
 s:=0;
 writeln('enter n,m ... ');
 readln(n,m);
 { Заполнение матрицы }
 for i := 1 to n do
   for j := 1 to m do begin
     write('a[',i,',',j,']=');
     readln(mx[i][j])
   end;
 {Определить номер первого из столбцов, содер-жащих хотя бы один нулевой элемент.}
  for i:=1 to n do begin
   for j:=1 to m do begin
     if  (mx[i,j]=0) and (s=0) then s:=j;
   end
  end;
  if s<>0 then   writeln('s=',s) else writeln('Not Found!');


 { Матрица до обмена }
 writeln('before:'); print(mx);
 writeln('------------------------------------');
 for i:=1 to n-1 do
  for j:=i+1 to n do  if har(mx,i)<har(mx,j) then  swap_rows(mx, i, j);
 { Матрица после обмена }
 writeln('after:'); print(mx);
 readln;
end.

тестировал на
n=4
m=4

Спасибо большое но не могли бы сделать первую задачу попроще без указателей и динамических переменных "nil" пожалуйста заранее еще раз сапсибо.

Можно. щас переделаем.

вот преобразование с минимальными изменениями

Type
 TElem = string[20];
 TList = array[1..20] of telem;
VAR
 NN:integer;

function getmax(l:tlist):string;
var
 max:string;
 i:integer;
begin
 max:='';
 for i:=1 to nn do begin
  if length(L[i])>length(max) then max:=L[I];
 end;
 getmax:=max;
end;


Procedure  SepWord(var L:tlist; s:string);
         procedure  AddLast(var L: TList; E: TElem);
         Begin
           if nn<20 then begin
            inc(nn);
            l[nn]:=e;
           end else writeln('error! not free memory! ');
         End;
const
 i:integer=1;
 r:set of char = [chr(0)..chr(255)]-['A'..'Z','a'..'z','1'..'9','0'];
var
 SL:boolean;    ss:string;
begin
 sl:=false;  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;
end;

var
 L:tlist;
 maxstr,s:string;
 f:byte;
begin
 write('Enter string : '); readln(s);
 sepword(l,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;
end.

Я просто вас обожаю!!!
Я люблю весь мир!!!!!!!

мы тоже всех любим

HeX, ты уверен, что эта процедура будет выполняться только один раз, и не будет какого-нибудь цикла, вроде "вводить строку и проделывать указанные действия, пока не введена пустая строка (или, например, 10 раз)" ? Учти, если SepWord будет выполняться больше одного раза в одном запуске программы - будут проблемы.

Олег, найдешь сам, или показать, где?

ну так обнуление массива слов надо бы сделать да и переменной nn...

Да не только. Тут еще одна засада:

const
 i:integer=1;

в SepWord не будет выполняться Оно же при компиляции инициализируется, так что если ты при первом вызове нашел 3 слова, счетчик на 3-х и останется... Лучше бы такие вещи переменными объявлять...

Да вроде все работает не барахлит но если можно ускорить работу то покажите место я исправлю

volvo, там же в коде:
i:=1;

А тогда на что тебе Typed Const вообще? Я бы заменил вот так:

Var i: integer;
Const r = [chr(0)..chr(255)]-['A'..'Z','a'..'z','0'..'9'];

меньше вопросов у преподавателей будет возникать...

ТИпизированная константа и есть переменная!



Ко мне преподы не пристают с вопросами на программинге, гиблое дело

Дак есть ошибка или ето миф

HeX
Ты на мой вопрос ответил? Нет. Почему же ты думаешь, что я буду отвечать на твой?