Версия для печати темы

Автор: Lyorri 25.10.2007 2:16

Подскажите как решить задачу.Не могу понять.

Дан файл целых чисел.Определить минимальное значение среди чисел.Определить среднее арифметическое чисел, лежащих за минимальным значением и минимальное значение заменить в файле на среднее арифметическое.

Добавлено через 5 мин.
Что смог написал. Дальше не знаю..В фигурных скобках из другой задачи.Пытался сравнивать..

program file_1;
uses
	crt;
const
	n=20;
var
           f1:file of integer;
min,max,nmin,nmax,i,a:integer;

procedure SOZD_FILE;
 begin
  rewrite(f1);
    for i:=1 to n do
      begin
       a:=random(200);
       write(f1,a);
      end;
       close(f1);
 end;

procedure VIVOD_FILE(t:string;c:byte);
 begin
  writeln;
  writeln(t);
   reset(f1);
    while not eof(f1) do
      begin
       read(f1,a);
       write(a:4);
      end;
 end;

BEGIN
  clrscr;randomize;
  assign(f1,'f1prim1.int');
  SOZD_FILE;
  VIVOD_FILE('Ishodniy file',1);
   seek(f1,0);
{   min:=maxint;
   max:=-maxint;
     while not eof(f1) do
       begin
       read(f1,a);
       if a>max then begin max:=a;
                          nmax:=filepos(f1)-1;
                     end;
       if a<min then begin min:=a;
                          nmin:=filepos(f1)-1;
                     end;
       end;
   max:=max-min;
   min:=2*min;
   seek(f1,nmin);
   write(f1,max);
   seek(f1,nmax);
   write(f1,min);   }
  VIVOD_FILE('File posle izmeneniya',2);
   readkey;
end.

Автор: Malice 25.10.2007 2:58

Основной кусок должен быть типа этого:

m:=maxint;  mi:=0; s:=0; n:=0;
while not (eof (f)) do begin
read (f,i);
if i<m then begin
m:=i; mi:=filepos (f); s:=0; n:=0;
end else begin
inc (n); s:=s+i; end;
end; dec (mi); 

По окончании:
M-минимальное число,
S-сумма чисел после минимального,
N- их количество,
MI- индекс минимального элемента, туда записать (s div n) (если n>0 конечно..)

Автор: Lyorri 25.10.2007 12:16

спасибо.сейчас проверю.

Автор: Lyorri 25.10.2007 19:48

Что то никак не получается.какие-то ошибки странные выдает.Буду очень признателен,если вы напишите программку целиком.Буду разбираться от А до Я.У меня очень большие трудности со временем...и завтра сдача этой работы.

Автор: Lyorri 26.10.2007 13:08

Ребята,помогите пожалуйста решить эту задачку.срочно надо.У меня через несколько часов сдача работы и зачета.сам разобраться не могу.

Автор: Malice 28.10.2007 3:31

Сорри, просмотрел твои ответы..Если еще актуально, то держи:

uses crt;
var f:file of integer;
procedure create;
var i,a:integer;
begin
rewrite (f);
randomize;
for i:=1 to 10 do begin
a:=random (100);
write (f,a);
end;
close (f);
end;
procedure print;
var i:integer;
begin
reset (f); while not (eof(f)) do begin
read(f,i); write(i,' ');
end; writeln; end;

var
i,m,mi,s,n:integer;
begin
clrscr; assign (f,'test.ttt');
 create; print; reset (f);
m:=maxint;  mi:=0; s:=0; n:=0;
while not (eof (f)) do begin
read (f,i);
if i<m then begin
m:=i; mi:=filepos (f); s:=0; n:=0;
end else begin
inc (n); s:=s+i; end;
end;
write (m,' ', s,'/',n,'=');
if n=0 then s:=0 else s:=s div n;
writeln (s);
seek (f,mi-1); write (f,s); close(f);
print;
readln;
end.

Автор: Lyorri 29.10.2007 22:48

поздновато конечно немного....но Всеравно СПАСИБО!сейчас проверю...