Скачиваний:
329
Добавлен:
04.03.2014
Размер:
1 Кб
Скачать
  program  usa;
   uses crt;
   type words=array[1..80] of   string[80];
   var a:words;
       st:string;
       i,j:integer;
       num:real;
    function  lalc(st:string):integer;
     var j,k1,k2:integer;
     begin
      j:=0;
      repeat
    k1:=pos(' ',st);
    delete(st,k1,1);
    k2:=pos(' ',st);
    inc(j);
    a[j]:=copy(st,k1,k2-k1);
    delete(st,k1,k2-k1);
    until  st=' ';
    lalc:=j;
    end;
    function numsr(a:words;j:integer):real;
    var num:real;
      i:integer;
    begin
    num:=0;
    for  i:=1 to j  do
    num:=num+length(a[i]);
    num:=num/j;
    numsr:=num;
    end;
    begin
    repeat;
    clrscr;
    readln(st);
    while pos('  ',st)<>0 do
    delete(st,pos('  ',st),1);
    if st[length(st)]<>' ' then st:=' '+st;
    if st[1]<>' 'then  st:=' '+st;
    until (st<>'') and (st<>' ') and (length(st)<80);
    j:=lalc(st);
    num:=numsr(a,j);
    writeln('б«®ў:',j);
    writeln('‚ б।­Ґ¬   ЎгЄў  ў  б«®ўҐ: ',num:5:5);
    repeat until  keypressed;
    end.
Соседние файлы в папке Alex