прикладная математика

program bf_laba_8;
{********************************************}
*       Laba#8 file: bf_laba_8.pas ver 1.0     *
*                 Text Image               *
* (c) $.$.$. Group I-14-1 Date: 20.10.2014 *
********************************************}
uses crt;
var
       s:string;
       i,sk,d:integer;
begin
         clrscr;
         readln(s);
         sk:=0;
         for i:=1 to length(s) do
             begin
                  if (s[i]='(') and (sk>=0) then
                     inc(sk);
                  if s[i]=')' then
                     dec(sk); d:=i;
             end;
         if sk=0 then
            writeln('0')
         else if sk>0 then
            writeln('-1')
         else
            writeln('Лишняя закрывающая скобка расположена на ',d,' месте в строке');
end.

Program Mr_Pozitiv;
//('*****************************************************');
//('*        laba #8  file: laba8.pas == ver.1.0        *');
//('*                     exercise                      *');
//('*   Malevanny V. A.  Group I-14-1 Date: 20/10/14    *');
//('*****************************************************');
const let=['а','о','э','и','у','ы','е','ё','ю','я'];
var s:String; p,i:Integer;
      begin
       p:=0;
      while p=0 do
        begin
        Writeln('Введите строку:');
        Readln(s);
        i:=0;
         while i<Length(s) do
          begin
           inc(i);
           if LowerCase(s[i]) in let then
            begin      
             Delete(s,i,1);
             dec(i);
            end;
          end;
        Write('Полученная строка: ');
        Writeln(s);
        Writeln('');
        end;
      end.

program ELMpr_La8;
{
OoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOo
o░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░o
O░░Lab░work░#8░░file:ELMpr_La8.pas░==░ver.1.0░░O
o░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░o
O░░░░░░░░░░░░░Laboratory work #8.░░░░░░░░░░░░░░O
o░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░o
O░░©░Grankin░V.I.░Group░І-14-1░Date:░21/10/14░░O
o░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░o
OoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOo
}
var
   S, Min_S, S_Temp, Max_S : string;                    
   S_Len, Min_S_Len, Max_S_Len, Len_S_Temp : integer;

{Trim: удаление пробелов в начале и конце строки}
function Trim(S: string): string;
var
   i, L: Integer;
begin
   L := Length(S);
   i := 1;
   while (i <= L) and (S [i]= #32) do Inc(i);
   if i > L then S := '' else
   begin
     while S [L]<= #32 do Dec(L);
     S := Copy(S, i, L - i + 1);
   end;

   Trim := S;
end;

{решение}
procedure Res;
var
   K : integer;
begin
   S := Trim(S);                        {удаление пробелов в начале и конце строки}
   S_Len := Length(S);                  {вычисляем длину строки}

   if S_Len = 0 then
   begin
     Min_S := '';
     Max_S := '';
     Min_S_Len := 0;
     Max_S_Len := 0;
     Exit;
   end;

   K := Pos(#32, S);
   if K = 0 then                        {если строка состоит из одного слова, без пробелов (код пробела: #32)}
   begin
     Min_S := S;
     Max_S := S;
     Min_S_Len := S_Len;
     Max_S_Len := S_Len;
     Exit;
   end;

   while Pos(#32#32, S) <> 0 do Delete(S, Pos(#32#32, S), 1);    {преобразуем все двойные пробелы в одинарные}
    
   {теперь строка, состоит из слов, разделенных одним пробелом}

   Min_S_Len := 255;                    {предполагаем, что слово минимальной длины
                    имеет максимально возможный размер}
   Max_S_Len :=   0;                    {предполагаем, что слово максимальной длины
                    имеет минимально возможный размер}

   while Pos(#32, S) <> 0 do            {пока в строке есть хотя бы один пробел}
   begin
     K := Pos(#32, S);                  {вычисляем позицию первого пробела}
     S_Temp := Copy(S, 1, K-1);         {выделяем первое слово}
     Delete(S, 1, K);                   {удаляем первое слово}
     Len_S_Temp := Length(S_Temp);      {вычисляем длину слова}

     if Min_S_Len > Len_S_Temp then     {если длина слова меньше текущей минимальной длины, то}
     begin
       Min_S := S_Temp;                 {запоминаем слово}
       Min_S_Len := Len_S_Temp;         {запоминаем минимальную длину}
     end;

     if Max_S_Len < Len_S_Temp then     {если длина слова больше текущей максимальной длины, то}
     begin
       Max_S := S_Temp;                 {запоминаем слово}
       Max_S_Len := Len_S_Temp;         {запоминаем максимальную длину}
     end;
   end;
    
{обработка последнего слова}
     S_Temp := S;                       {выделяем слово}
     Len_S_Temp := Length(S_Temp);      {вычисляем длину слова}

     if Min_S_Len > Len_S_Temp then     {если длина слова меньше текущей минимальной длины, то}
     begin
       Min_S := S_Temp;                 {запоминаем слово}
       Min_S_Len := Len_S_Temp;         {запоминаем минимальную длину}
     end;

     if Max_S_Len < Len_S_Temp then     {если длина слова больше текущей максимальной длины, то}
     begin
       Max_S := S_Temp;                 {запоминаем слово}
       Max_S_Len := Len_S_Temp;         {запоминаем максимальную длину}
     end;

end;
begin
   ReadLn(S);
   Res;
   WriteLn('Слово минимальной длины:  ', Min_S, '  его длина: ', Min_S_Len);
   WriteLn('Слово максимальной длины:  ', Max_S, '  его длина: ', Max_S_Len);
end.

Program lab8;
var a: array [1..100] of string;
b: array [1..100] of integer;
i,j,k,l: integer;
s,sl,s1,s2: string;
begin
write('Первое предложение: '); readln(s1);
write('Второе предложение: '); readln(s2);
s:=s1+' '+s2;
j:=1;
sl:='';
if s[length(s)]<>'.' then s:=s+'.';
for i:=1 to length(s) do
if (s[i]<>' ') and (s[i]<>'.')
then sl:=sl+s [i]else
begin
a[j]:=sl;
sl:='';
inc(j);
end;
k:=j;
writeln('Не повторяющиеся слова: ');
for j:=1 to k do
for l:=1 to k do
if a[j]=a [l]then
inc(b[j]);
for j:=1 to k do
if b[j]=1 then write(a[j],' ');
end.

Program torres;
                     
           { *************************************************************
            *         laba#8 file: misha_shabelnik 97 pas == ver.1.0    *
            *         Shabelnik M.V. Group I-14-1 Date: 22\10\14        *
            *************************************************************}
var s,sn: string;
       i: integer;
begin
write('Введите предложение:');
readln(s);
sn:='';
for i:=1 to length(s) do
       begin
       case s [i]of
       '0': sn:=sn+' ноль ';
       '1': sn:=sn+' один ';
       '2': sn:=sn+' два ';
       '3': sn:=sn+' три ';
       '4': sn:=sn+' четыре ';
       '5': sn:=sn+' пять ';
       '6': sn:=sn+' шесть ';
       '7': sn:=sn+' семь ';
       '8': sn:=sn+' восемь ';
       '9': sn:=sn+' девять ';
       else sn:=sn+s[i];
       end;
       end;
write('Исправленное предложение:',sn);
end.

program ira_butenko97;
var b:string; i,res,temp: integer;
a: array[1..28] of string;

begin
writeln ('Введите число->');
Readln (b);

a[1]:='один';
a[2]:='два';
a[3]:='три';
a[4]:='четыре';
a[5]:='пять';
a[6]:='шесть';
a[7]:='семь';
a[8]:='восемь';
a[9]:='девять';
a[10]:='десять';
a[11]:='одинадцать';
a[12]:='двенадцать';
a[13]:='тринадцать';
a[14]:='четырнадцать';
a[15]:='пятнадцать';
a[16]:='шестнадцать';
a[17]:='семнадцать';
a[18]:='восемнадцать';
a[19]:='девятнадцать';
a[20]:='двадцать';
a[21]:='тридцать';
a[22]:='сорок';
a[23]:='пятьдесят';
a[24]:='шестьдесят';
a[25]:='семьдесят';
a[26]:='восемьдесят';
a[27]:='девяносто';
a[28]:='сто';

res:=0;

for i:=1 to 9 do
begin
         temp:=pos(a[i],b);
         if temp>0 then res:=res+i;
end;
temp:=pos(a[10],b);
if temp>0 then res:=res+1;

temp:=pos(a[11],b);
if temp>0 then res:=res+1;

temp:=pos(a[12],b);
if temp>0 then res:=res+3;

temp:=pos(a[13],b);
if temp>0 then res:=res+1;

for i:=14 to 19 do
begin
         temp:=pos(a[i],b);
         if temp>0 then res:=res+i-9;
end;

temp:=pos(a[22],b);
if temp>0 then res:=res+4;

temp:=pos(a[26],b);
if temp>0 then res:=res-7;

temp:=pos(a[27],b);
if temp>0 then res:=res+8;

temp:=pos(a[28],b);
if temp>0 then res:=res+1;

writeln('Сумма = ',res);
readln;
end.

var
  s:string;
  i,r,a,b,c,d,e:integer;
begin
  readln(s);
  writeln('┌─┬─┐');
  for i:=1 to length(s) do if (s[i]='.') then r:=r+1;
  writeln('│.│',r,'│');
  writeln('┼─┼─┼');
  for i:=1 to length(s) do if (s[i]=',') then a:=a+1;
  writeln('│,│',a,'│');
  writeln('┼─┼─┼');
  for i:=1 to length(s) do if (s[i]='!') then b:=b+1;
  writeln('│!│',b,'│');
  writeln('┼─┼─┼');
  for i:=1 to length(s) do if (s[i]='?') then c:=c+1;
  writeln('│?│',c,'│');
  writeln('┼─┼─┼');
  for i:=1 to length(s) do if (s[i]=';') then d:=d+1;
  writeln('│;│',d,'│');
  writeln('┼─┼─┼');
  for i:=1 to length(s) do if (s[i]=':') then e:=e+1;
  writeln('│:│',e,'│');
  writeln('┼─┼─┼');
  writeln('└─┴─┘');
  readln;
  end.

Program qwerty159;
const rb=['а'..'я','ё'];
function Up(c:char):char;
Begin
if c in ['а'..'я'] then Up:=chr(ord(c)-32)
else if c='ё' then Up:='Ё';
end;
Var a:string;
     i:byte;
Begin
Writeln('Введите строку-предложение:');
Readln (a);
for i:=1 to length(a) do
if (a [i]in rb)and((i=1)or(a[i-1]=' ')) then a[i]:=Up(a[i]);
Writeln('Преобразованная строка:');
Write(a);
Readln
end.

uses crt;
var
text,gl:string;
s,i,j,n:integer;
count:Array[1..20] Of Integer;
  begin
  gl:='ауоыиэяюёе';
  s:=length(gl);
  writeln('Введите предложение');
  readln(text);
  n:=length(text);
  for j := 1 to s do
begin
count[j]:=0;
for i:=1 to n do
if text[i]=gl [j]then count[j]:=count[j]+1;
end;
writeln('┌─┬──┐');
for j:=1 to s do
Begin
writeln('│',gl[j],'│',count[j]:2,'│');
writeln('┼─┼──┼');
end;
writeln('└─┴──┘');
readln;
end.

program dimeshion;
     {('**************************************************');
      ('*      laba #8 file: di_8.pas == ver1.0          *');
      ('*                   laba #8                      *');
      ('*    Bazaliy E.V. Group: I-14-1 Date: 09/11/14   *');
      ('**************************************************');}
uses crt;
var str,str2: string; i: integer;
begin
clrscr;
writeln('Введите предложение: ');
readln(str);
for i:=length(str) downto 1 do str2:=str2+str[i];
writeln(str2);
readln;
end.

program AlenaKit8;
var s,n:string;
i,sum:integer;
begin
writeln('Введите предложение');
readln(s);
n:='';
sum:=0;
s:=s+' ';
for i:=1 to length(s) do   
if s [i]in ['0'..'9'] then n:=n+s [i]else
if length(n)<>0 then   
begin
sum:=sum+StrToInt(n);
n:='';
end;
writeln('Сумма=',sum);
end.

Program ProjectX;
{*************************************************
   *       Laba#8 file: Px8.pas==ver.7.0           *   
   *      Vyvid na ekran odnakovih sliv            *
   *       Shkurenko Anton I-14-1 20.11.14         *
   *************************************************}
   var mas1: array [1..100] of string;
       mas2: array [1..100] of integer;
       a,b,c,d: integer;
       st,stl,st1,st2: string;
   begin
       write('Первое предложение: '); readln(st1);
       write('Второе предложение: '); readln(st2);
       st:=st1+' '+st2;
       b:=1;
       stl:='';
       if st[length(st)]<>'.' then st:=st+'.';
       for a:=1 to length(st) do
       if (st[a]<>' ') and (st[a]<>'.')
       then stl:=stl+st [a]else
   begin
       mas1[b]:=stl;
       stl:='';
       inc(b);
       end;
       c:=b;
       writeln('Повторяющиеся слова: ');
       for b:=1 to c do
       for d:=1 to c do
       if mas1[b]=mas1 [d]then
       inc(mas2[b]);
       for b:=1 to c do
       if mas2[b]<>1 then write(mas1[b],' ');
end.

var
text,alfavit:string;
s,i,j,n:integer;
count:Array[1..33] Of Integer;
begin
alfavit:='абвгдеёжзийклмнопрстуфхцчшщъыьэюя';
s:=length(alfavit);
writeln('введите предложение');
readln(text);
n:=length(text);
for j := 1 to s do
begin
count[j]:=0;
for i:=1 to n do
if text[i]=alfavit [j]then count[j]:=count[j]+1;
end;
writeln('┌─┬──┐');
for j:=1 to s do
Begin
writeln('│',alfavit[j],'│',count[j]:2,'│');
writeln('┼─┼──┼');
end;
writeln('└─┴──┘');
readln;
end.

Program OlgaFrolova;
var s: string;
     len, i, j: integer;
      l:byte;
  word:string;
begin
write('Введите предложение:',' ');
readln(s);
len:= length(s);
  i:= 1; {начинаем с первого символа в строке}
  j:= 0; {сначала длина слова ровна нулю}
   while i<=len do begin
    if s[i] <> ' ' then begin {если очередной символ не пробел}
    j:=j+1; {увеличиваем длину слова}
    i:=i+1; {переходим к следующей букве}
     end
      else begin
        if j > 4 then begin  {если длинна слова > 4}
                 i:= i+1;
                 j:= 0; {обнуляем длину слова}
             end
             else begin {если длина слова < 4}
                 i:=1; {переходим к следующей букве}
                 j:= 0; {обнуляем длину слова}
  repeat
  word:=copy(s,1,pos(' ',s)); delete(s,1,pos(' ',s));
  l:=Length(word)-1;
  write(' ',l);
until pos(' ',s)=0;
  write(' ',Length(s));
readln;
           end;
         end;
     end;
end.

program dimeshion;
uses crt;
var
   str:string;
   s:array[1..20] of string;
   i,k:integer;
begin
    writeln('Введите предложение: ');
    readln (str);
    k:=1;
    s[k]:=s[k]+' ';
  for i:=length(str) downto 1 do
   begin
    if str[i]<>' ' then
    s[k]:=s[k]+str [i]else
    begin
     k:=k+1;
     s[k]:=' ';
    end;
   end;
  for i:=k downto 1 do
  write(s[i]);
  readln;
end.

Program OlgaFrolova;
   var s,s1: string;
     
       len, i, j: integer;
        l:byte;
    word:string;
   begin
   write('Введите предложение:',' ');
   readln(s);
   len:= length(s);
    i:= 1; {начинаем с первого символа в строке}
    j:= 0; {сначала длина слова ровна нулю}
     while i<=len do begin
      if s [i]<> ' ' then begin {если очередной символ не пробел}
      j:=j+1; {увеличиваем длину слова}
      i:=i+1; {переходим к следующей букве}
       end
        else begin
          if j > 4 then begin  {если длинна слова > 4}
                   i:= i+1;
                   j:= 0; {обнуляем длину слова}
               end
               else begin {если длина слова < 4}
                   i:=1; {переходим к следующей букве}
                   j:=0; {обнуляем длину слова}
    repeat
    word:=copy(s,1,pos(' ',s)); delete(s,1,pos(' ',s));
    l:=Length(word)-1;
   if l<=4 then begin
     str(l,s1);
    write(' ',s[j]+s1)
    end
    else write(' ',word);
   until pos(' ',s)=0;
    write(' ',Length(s));
   readln;
     
             end;
           end;
       end;
   end.

program Bonyasik;
  var s,b:string; f,i,a:integer;
    begin
    randomize;
    writeln('Исходное слово');
    readln(s);
    writeln('Полученое слово');  
    write(s[1]);  
    f:=length(s);
    for i:=2 to f-1 do begin  
    s[i]:=chr(ord('а')+random(33));
    write(s[i]);
    end;
    write(s[f]);
    end.

Program OlgaFrolova;
    var s,s1: string;

        len, i, j: integer;
         l:byte;
     word:string;
    begin
    write('Введите предложение:',' ');
    readln(s);
    len:= length(s);
     i:= 1; {начинаем с первого символа в строке}
     j:= 0; {сначала длина слова ровна нулю}
      while i<=len do begin
       if s [i]<> ' ' then begin {если очередной символ не пробел}
       j:=j+1; {увеличиваем длину слова}
       i:=i+1; {переходим к следующей букве}
        end
         else begin
           if j > 4 then begin  {если длинна слова > 4}
                    i:= i+1;
                    j:= 0; {обнуляем длину слова}
                end
                else begin {если длина слова < 4}
                    i:=1; {переходим к следующей букве}
                    j:=0; {обнуляем длину слова}
     repeat
     word:=copy(s,1,pos(' ',s)); delete(s,1,pos(' ',s));
     l:=Length(word)-1;
    if l<=4 then begin
      str(l,s1);
      word:=s1;
     write(' ',word )
     end
     else write(' ',word);
    until pos(' ',s)=0;
     write(' ',Length(s));
    readln;

              end;
            end;
        end;
    end.