Ответы: 3рк строки
Описание
Характеристики ответов (шпаргалок)
Список файлов
- Строки
- Внимание.txt 65 b
- Задача 1 (найти в каждой строке кол-во самых длинных слов).txt 1,45 Kb
- Задача 4 (посчитать количество четных слов в каждой строке).txt 1,11 Kb
- Задача 5 (поменять местами первое и последнее слово).txt 1,18 Kb
- Задача 6 (количество букв в строке).txt 1,55 Kb
- Задача 7 (функция-найти количество наименьших слов).txt 1,3 Kb
- Задача 8 (функция - количество различных букв в строке).txt 867 b
- Задача 9 (функция - количество мин слов).txt 1,42 Kb
- Задача фотка (изменить строку по правилу).txt 1,28 Kb
- кол-во слов заданной длины.txt 767 b
Задачи на строки надо решать по примеру задачи 1! (осн программа)
1) найти кол-во максимальных элементов в массиве строк (как понимаю, надо написать процедуру/функцию, которая находит максимальное кол-во элементов в строке, а в основной программе уже найти кол-во максимальных элементов в тексте)
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..20] of string;
procedure SLOVO (var s:string;var b:mas;var kol:integer);
var slovo,max:string;
i,n,p:integer;
begin
{удаление пробелов - необязательно думаю}
p:=pos(' ',s);
while p>0 do
begin
delete(s,p,1);
p:=pos(' ',s);
end;
{сама программа}
s:=s+' ';
slovo:='';
n:=0;
for i:=1 to length(s) do if s[i]<>' ' then slovo:=slovo+s[i]
else begin
n:=n+1;
b[n]:=slovo;
slovo:=''
end;
max:=b[1];
for i:=1 to n do
if length(b[i])>length(max) then max:=b[i];
kol:=0;
for i:=1 to n do
if length(b[i])=length(max) then
kol:=kol+1;
end;
var s:string;
b,b1:mas;
n,i:integer;kol:array[1..20] of integer;
begin
writeln('Vvedite kolichestvo strok');
readln(n);
for i:=1 to n do begin
writeln('Vvedite stroku');
readln(b1[i]);
end;
for i:=1 to n do SLOVO(b1[i],b,kol[i]);
writeln('Izmenennie stroki');
for i:=1 to n do
writeln('Kolichestvo max dlin slov ',kol[i],' v stroke ',i);
readln;
end.
4) процедура в строке удаляет лишнии пробелы и подсчитыает слова с четным количеством букв
program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils;
procedure Izmen (var s:string;var chet:integer);
var i,p,kol:integer;
slovo:string;
begin
writeln('Vvedite stroku');
readln(s);
{удаление пробелов}
p:=pos(' ',s);
while p>0 do begin
delete(s,p,1);
p:=pos(' ',s);
end;
if s[1]=' ' then delete(s,1,1);
if s[length(s)]=' ' then delete (s,length(s),1);
s:=s+' ';
slovo:='';
chet:=0;
for i:=1 to length(s) do
if s[i]<>' ' then slovo:=slovo+s[i]
else begin if length(slovo) mod 2=0 then begin
chet:=chet+1;
slovo:='';
end
else slovo:='';
end;
writeln('kol-vo chet slov ',chet);
end;
var n,k,j:integer;
s:string;
begin
writeln('Vvedite kolichestvo strok');
readln(n);
for j:=1 to n do begin
Izmen(s,k);
end;
readln;
end.
5) разработать процедуру которая в строке меняет первое и последнее слово
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..20] of string;
procedure ZAMENA (var s:string;n:integer;var b:mas;var k:integer);
var i,p,j:integer;
slovo,buf:string;
begin
writeln('vvedite stroku');
readln(s);
{удаление пробелов}
p:=pos(' ',s);
while p>0 do begin
delete(s,p,1);
p:=pos(' ',s);
end;
if s[1]=' ' then delete(s,1,1);
if s[length(s)]=' ' then delete (s,length(s),1);
s:=s+' ';
slovo:='';
k:=0;
for i:=1 to length(s) do if s[i]<>' ' then slovo:=slovo+s[i]
else begin
k:=k+1;
b[k]:=slovo;
slovo:='';
end;
for i:=1 to k do begin
buf:=b[1];
b[1]:=b[k];
b[k]:=buf;
end;
end;
var n,i,kol,j:integer;
st:string;
B:mas;
begin
writeln('Vvedite kolichestvo strok');
readln(n);
for i:=1 to n do begin
ZAMENA(st,n,B,kol);
for j:=1 to kol do write (B[j],' ');
writeln;
end;
readln;
end.
6) используя процедуру, посчитать сколько букв в строке произвольной длины
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
procedure CHISLO (var s:string;n:integer;var k:integer);
var i,p,j:integer;
slovo,buf:string;
begin
writeln('vvedite stroku');
readln(s);
{удаление пробелов}
p:=pos(' ',s);
while p>0 do begin
delete(s,p,1);
p:=pos(' ',s);
end;
if s[1]=' ' then delete(s,1,1);
if s[length(s)]=' ' then delete (s,length(s),1);
s:=s+' ';
slovo:='';
k:=0;
for i:=1 to length(s) do if s[i]<>' ' then k:=k+1;
end;
var n,i,kol,j:integer;
st:string;
begin
writeln('Vvedite kolichestvo strok');
readln(n);
for i:=1 to n do begin
CHISLO(st,n,kol);
writeln('Kolicestvo bukv v ',i,' stroke ravno ',kol);
end;
readln;
end.
___________
6) используя процедуру, посчитать сколько букв в строке произвольной длины (если учитывать, что заданы разные символы)
program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mn=set of char;
function Kol(var s:string;n:integer):integer;
var i,p,k:integer;
M:mn;
begin
writeln('Vvedite stroku');
readln(s);
{поиск букв}
M:=['A'..'Z'];
k:=0;
for i:=1 to length(s) do if upcase(s[i]) in M then k:=k+1;
Kol:=k;
end;
var n,i,kolich:integer;
st:string;
begin
writeln('Vvedite kol-vo strok');
readln(n);
for i:=1 to n do begin
kolich:=kol(st,n);
writeln('Kolichestvo bukv v stroke ravno ',kolich);
end;
readln;
end.
7) Составить функцию, которая в строке произвольной длины находит число слов с минимальной длиной.
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..20] of string;
function CHISLO (var s:string;var b:mas;var kol:integer):integer;
var slovo,min:string;
i,n,p:integer;
begin
writeln('Vvedite stroku');
readln(s);
{удаление пробелов}
p:=pos(' ',s);
while p>0 do
begin
delete(s,p,1);
p:=pos(' ',s);
end;
if s[1]=' ' then delete(s,1,1);
if s[length(s)]=' ' then delete (s,length(s),1);
{сама программа}
s:=s+' ';
slovo:='';
n:=0;
for i:=1 to length(s) do if s[i]<>' ' then slovo:=slovo+s[i]
else begin
n:=n+1;
b[n]:=slovo;
slovo:=''
end;
min:=b[1];
for i:=1 to n do
if length(b[i])<length(min) then min:=b[i];
kol:=0;
for i:=1 to n do
if length(b[i])=length(min) then
kol:=kol+1;
CHISLO:=kol;
end;
var s:string;
b:mas;
n,i,kol:integer;
begin
writeln('Vvedite kolichestvo strok');
readln(n);
for i:=1 to n do begin
CHISLO(s,b,kol);
writeln('Kolichestvo min dlin slov ',kol,' v stroke ',i);
end;
readln;
end.
8) Написать функцию, которая определяет, сколько различных (именно различных:) букв есть в строке. Разработать эту функцию для N строк.
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mn=set of char;
function CHISLO (var s:string;n:integer):integer;
var i,kol:integer;
M:mn;
begin
writeln('Vvedite stroku');
readln(s);
M:=['A'..'Z'];
kol:=0;
for i:=1 to length(s) do if upcase(s[i]) in M then begin
kol:=kol+1;
M:=M-[upcase(s[i])];
end;
CHISLO:=kol;
end;
var n,i,kol:integer;
st:string;
begin
writeln('Vvedite kolichestvo strok');
readln(n);
for i:=1 to n do begin
kol:=CHISLO(st,n);
writeln('kol-vo razlichnix bukz v stroke ',kol);
end;
readln;
end.
9) разработать функцию для подсчета в строке минимального слова. (не поняла что это значит, то ли указать длину мин слова, то ли указать количество таких слов, но если писать длину слова, то тогда не учитывается условие, "их может быть несколько", поэтому думаю надо искать их количество) Учитывать , что их может быть несколько. Функцию применить для многих строк , количесво которых вводится с клавиатуры.
program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..20] of string;
function Min_sl (var s:string;n:integer):integer;
var i,kol:integer;
slovo,min:string;
b:mas;
begin
writeln('Vvedite stroku');
readln(s);
s:=s+' ';
slovo:='';
n:=0;
for i:=1 to length(s) do if s[i]<>' ' then slovo:=slovo+s[i]
else begin
n:=n+1;
b[n]:=slovo;
slovo:=''
end;
min:=b[1];
for i:=1 to n do
if length(b[i])<length(min) then min:=b[i];
kol:=0;
for i:=1 to n do
if length(b[i])=length(min) then
kol:=kol+1;
Min_sl:=kol;
end;
var n,k,i:integer;
st:string;
begin
writeln('Vvedite kol-vo strok');
readln(n);
for i:=1 to n do begin
k:=Min_sl(st,n);
writeln('Kolichestvo min slov ravno ',k);
end;
readln;
end.
Задача с фотки (изменить строку по правилу: пробел должен быть после . , ; а не перед ними)
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
procedure OSHIBKI(var s:string);
var p,k,i:integer;
begin
p:=pos(' ',s);
while p>0 do begin
delete(s,p,1);
p:=pos(' ',s);
end;
if s[1]=' ' then delete(s,1,1);
if s[length(s)]=' ' then delete(s,length(s),1);
k:=pos(' ,',s);
while k>0 do begin
delete(s,k,1);
k:=pos(' ,',s);
end;
k:=pos(' ;',s);
while k>0 do begin
delete(s,k,1);
k:=pos(' ;',s);
end;
k:=pos(' .',s);
while k>0 do begin
delete(s,k,1);
k:=pos(' .',s);
end;
for i:=length(s) downto 1 do if s[i]=',' then insert(' ',s,i+1);
for i:=length(s) downto 1 do if s[i]='.' then insert(' ',s,i+1);
for i:=length(s) downto 1 do if s[i]=';' then insert(' ',s,i+1);
p:=pos(' ',s);
while p>0 do begin
delete(s,p,1);
p:=pos(' ',s);
end;
end;
var n,i:integer;
st:array[1..10] of string;
begin
writeln('Vvedite kolichestvo strok');
readln(n);
for i:=1 to n do begin
writeln('Vvedite stroku');
readln(st[i]);
end;
for i:=1 to n do OSHIBKI(st[i]);
writeln('Izmenennie stroki');
for i:=1 to n do writeln(st[i]);
readln;
end.
program Pr1;
{$APPTYPE CONSOLE}
uses
SysUtils;
function kol_sl(x:string; n:integer):integer;
var i,k,kol:integer;
slovo:array[1..30]of string;
begin
kol:=1;k:=0;
for i:=1 to length(x) do
{slovo[kol]:='';}
if x[i]<>' ' then
slovo[kol]:=slovo[kol]+x[i]
else kol:=kol+1;
for i:=1 to kol do
if length (slovo[i])=n then
k:=k+1;
kol_sl:=k;
end;
var a:array[1..30]of string;
s,n,i,k:integer;
begin
{основная программа}
writeln('vvedite kol. strok');
readln(n);
writeln('vvedite stroki');
for i:=1 to n do
readln(a[i]);
writeln('vvedite zadannuy dlinu slov');
readln(k);
s:=0;
for i:=1 to n do
s:=s+kol_sl(a[i],k);
if s=0 then writeln('takix slov net')
else writeln('kol. slov zadannoy dliny =',s );
readln;
end.
Shnurras
