Помощь - Поиск - Пользователи - Календарь
Полная версия: разбиение на слова + массивы
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
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.
Altair
Цитата
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

Цитата
s=3
before:
  1  -2  -3  -2
  1  -1  -4  -7
  2  3  0  3
  -1  5  -1  3
------------------------------------
after:
  2  3  0  3
  -1  5  -1  3
  1  -2  -3  -2
  1  -1  -4  -7
HeX
Спасибо большое но не могли бы сделать первую задачу попроще без указателей и динамических переменных "nil" пожалуйста заранее еще раз сапсибо. smile.gif good.gif good.gif good.gif
Altair
Можно. щас переделаем.
Altair
вот преобразование с минимальными изменениями

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
Я просто вас обожаю!!!
Я люблю весь мир!!!!!!!
wub.gif wub.gif wub.gif
Altair
wub.gif мы тоже всех любим wub.gif
volvo
HeX, ты уверен, что эта процедура будет выполняться только один раз, и не будет какого-нибудь цикла, вроде "вводить строку и проделывать указанные действия, пока не введена пустая строка (или, например, 10 раз)" ? Учти, если SepWord будет выполняться больше одного раза в одном запуске программы - будут проблемы.

Олег, найдешь сам, или показать, где?
Altair
ну так обнуление массива слов надо бы сделать да и переменной nn...
volvo
Да не только. Тут еще одна засада:
const
i:integer=1;
в SepWord не будет выполняться smile.gif Оно же при компиляции инициализируется, так что если ты при первом вызове нашел 3 слова, счетчик на 3-х и останется... Лучше бы такие вещи переменными объявлять...
HeX
Да вроде все работает не барахлит но если можно ускорить работу то покажите место я исправлю
Altair
volvo, там же в коде:
i:=1;
volvo
blink.gif А тогда на что тебе Typed Const вообще? Я бы заменил вот так:
Var i: integer;
Const r = [chr(0)..chr(255)]-['A'..'Z','a'..'z','0'..'9'];

меньше вопросов у преподавателей будет возникать... blum.gif
Altair
Цитата
А тогда на что тебе Typed Const вообще?

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

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


Ко мне преподы не пристают с вопросами на программинге, гиблое дело smile.gif tong2.gif
HeX
Дак есть ошибка или ето миф blink.gif
volvo
HeX
Ты на мой вопрос ответил? Нет. Почему же ты думаешь, что я буду отвечать на твой?
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.