Вычислить среднее арифмитическое длины слов в файле и в новый файл записать слова у которых длина больше средней

var 
f,p:text; 
a:array[1..100]of string; 
b:array[1..100]of string; 
t:string; 
k,n,i:integer; 
sr:real; 
begin 
assign(f,'input.txt'); 
reset(f); 
assign(p,'output.txt'); 
rewrite(p); 
while not eof(f) do 
begin 
inc(k); 
readln(f,a[k]); 
a[k]:=' '+a[k]; 
t:=a[k]; 
for i:=1 to length(t) do 
if t[i]=' 'then inc(n) else b[n]:=b[n]+t[i]; 
sr:=(length(t)-n)/n; 
for i:=1 to n do 
if length(b[i])>sr then write(p,b[i]+' '); 
writeln(p); 
for i:=1 to n do 
b[i]:=''; 
n:=0; 
end; 
close(f); 
close(p); 
end.

Program pr; 
Var f1, f2: text; 
Ch: char; 
Kolsl, kolb: integer; 
Sr: real; s:string; 
Begin assign(f1, 'input.txt'); 
Reset(f1); 
Assign( f2, 'output.txt'); 
Rewrite(f2); 
While not eof(f1) do begin 
read (f1,ch); 
Kolb:=kolb+1; 
If (ch=' ')or (ch='.') or (ch=',') then kolsl:=kolsl+1; 
Kolsl:=kolsl+1; 
Kolsl:=kolsl+1; 
Sr:=kolb/ kolsl; 
End; 
While not eof(f1) do begin 
Read(ch); 
If ((ch=' ')or (ch='.') or (ch=',')) then 
begin if length(s)>=sr then 
writeln(f2,s); 
s:=''; 
end 
else s:=s+ch; 
end; 
close(f1); 
close(f2);
 end.