1.Дана строка символов. Группу символов, разделенных с одной или с обеих сторон одним или несколькими пробелами и не содержащую внутри себя пробелов, назовем словом. Присвоить переменной F = 1, если слово с наибольшим количеством символов находится в первой половине строки, F= 2 – во второй половине, F= 0 – часть слово в первой, а часть во второй. Предполагается, что слово с наибольшей длиной единственное.
2.Дана целочисленная прямоугольная матрица. Определить номер первого из столбцов, содер-жащих хотя бы один нулевой элемент. Характеристикой строки целочисленной матрицы назовем сумму ее отрицательных четных элементов. Переставляя строки заданной матрицы, расположить их в соответствии с убыванием характеристик.
Altair
20.11.2005 22:57
Цитата
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.
Altair
20.11.2005 23:12
Цитата
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.
Спасибо большое но не могли бы сделать первую задачу попроще без указателей и динамических переменных "nil" пожалуйста заранее еще раз сапсибо.
Altair
21.11.2005 20:09
Можно. щас переделаем.
Altair
21.11.2005 20:20
вот преобразование с минимальными изменениями
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
21.11.2005 20:25
Я просто вас обожаю!!! Я люблю весь мир!!!!!!!
Altair
21.11.2005 20:27
мы тоже всех любим
volvo
21.11.2005 21:14
HeX, ты уверен, что эта процедура будет выполняться только один раз, и не будет какого-нибудь цикла, вроде "вводить строку и проделывать указанные действия, пока не введена пустая строка (или, например, 10 раз)" ? Учти, если SepWord будет выполняться больше одного раза в одном запуске программы - будут проблемы.
Олег, найдешь сам, или показать, где?
Altair
21.11.2005 21:18
ну так обнуление массива слов надо бы сделать да и переменной nn...
volvo
21.11.2005 21:21
Да не только. Тут еще одна засада:
const i:integer=1;
в SepWord не будет выполняться Оно же при компиляции инициализируется, так что если ты при первом вызове нашел 3 слова, счетчик на 3-х и останется... Лучше бы такие вещи переменными объявлять...
HeX
21.11.2005 21:22
Да вроде все работает не барахлит но если можно ускорить работу то покажите место я исправлю
Altair
21.11.2005 21:48
volvo, там же в коде: i:=1;
volvo
21.11.2005 21:59
А тогда на что тебе Typed Const вообще? Я бы заменил вот так:
Var i: integer; Const r = [chr(0)..chr(255)]-['A'..'Z','a'..'z','0'..'9'];
меньше вопросов у преподавателей будет возникать...
Altair
21.11.2005 22:25
Цитата
А тогда на что тебе Typed Const вообще?
ТИпизированная константа и есть переменная!
Цитата
меньше вопросов у преподавателей будет возникать... blum.gif
Ко мне преподы не пристают с вопросами на программинге, гиблое дело
HeX
22.11.2005 17:48
Дак есть ошибка или ето миф
volvo
22.11.2005 17:58
HeX Ты на мой вопрос ответил? Нет. Почему же ты думаешь, что я буду отвечать на твой?
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.