Задача по файлам, Помогите исправить Опции

[Roise]

Знач так, дан файл f компонентами которого являеются целые числа. Файл создается с такими компонентами y = -5 + random (10). Сформировать новый файл g следующим образом: переписать содержимое файла f так, что бы сначала шли положительные числа, потом нули, а потом отрицательные числа, сохраняя порядок следования чисел.
Криво, косо, но вот что получилось:

Program Raz3_3;
uses crt;
var
 f1,f2,f3,f4:text;
 x1,t,l,y,k,i,s,n:integer;
Begin
 clrscr;
 assign (f1,'file.txt');
 rewrite (f1);
 for k:=1 to n do
  begin
  y:=-5+random(10);
  write(f1,y,' ');
  end;
 s:=0;
 l:=0;
 t:=0;
 reset (f1);
 assign (f2,'posit.txt');
 assign (f3,'zero.txt');
 assign (f4,'negat.txt');
 reset (f1);
 rewrite (f2);
 rewrite (f3);
 rewrite (f4);
 for i:=1 to n do
  begin
  read (f1, x1);
  if x1>0 then
   begin
   write (f2,x1,' ');
   t:=t+1;
   end
  else
   begin
   if x1=0 then
    begin
    write (f3,x1,' ');
    s:=s+1
    end
   else
    begin
    write (f4,x1,' ');
    l:=l+1;
    end;
   end;
  end;
  reset (f3);
  append (f2);
  for i:=1 to s do
   begin
   read (f3, x1);
   write (f2,x1,' ');
   end;
  close(f1);
  close(f2);
  close(f3);
  close(f4);
 end.

Пли-и-из, оч прошу помочь тугодуму заставить это сырое нечто работать :molitva:

ЗЫ Эх, мне бы еще научиться, как сделать так, что бы найти в текстовом файле строкус максимальным количеством слов и вывести ее на экран, но я понимаю, что за бесплатно таки вещи не делаются... Но если вдруг очень добрая и бескорыстная душа найдется... -___-

[volvo]

Ну, вот что я нашаманил :D

Program Raz3_3;
uses crt;

const
  n = 20;

var
  f_in, f_out: text;
  i, y, zeroes: integer;

begin
  clrscr;
  assign(f_in,'file_001.txt');
  rewrite(f_in);
  for i := 1 to n do begin
    y := -5 + random(10);
    write(f_in, y, ' ')
  end;
  assign(f_out,'file_002.txt');
  rewrite(f_out);

  { первый проход по файлу - переносим положительные числа }
  { и считаем количество нулей }
  reset(f_in); zeroes := 0;
  while not seekeof(f_in) do begin
    read(f_in, y);
    if y > 0 then write(f_out, y, ' ')
    else if y = 0 then inc(zeroes);
  end;

  { пишем столько нулей в выходной файл, сколько насчитали }
  y := 0;
  for i := 1 to zeroes do
    write(f_out, y, ' ');

  { переходим на начало исходного файла и пишем все отрицательные числа }
  reset(f_in);
  while not seekeof(f_in) do begin
    read(f_in, y);
    if y < 0 then write(f_out, y, ' ')
  end;
  close(f_out);
  close(f_in);
end.

как видишь, 4 файла использовать совершенно не обязательно... Да и переменных у тебя много лишних было.

[Roise]

Домо АРИГАТО :D :p9:

Do itashi mashite :yes:

Сообщение отредактировано: volvo - 26.05.2005 2:42

[Roise]

Эм.. А вот еще маленький вопросик..
Вы уж извиняйте за невменяемость, просто я в паскале совсем того... Вот, короче, если у меня из файла берутся компоненты, удовлетворяющие определенным условиям (ну, <1 или >8 в данном случае), то как записать операцию нахождения их среднего арифметического? Ну, я ж не знаю, сколько их там всего... Ну, вот такое вот я глупое.

[volvo]

s := 0; count := 0;
while not eof(f) do begin
  read(f, x);
  if { нужное условие } then begin
    s := s + x; inc(count);
  end;
end;

if count <> 0 then
  {среднее арифметическое} := s / count;

[mafia1232]

а подскажи те мне плиз. если взять тот же исходник Roise и те же начальные условия, но чтобы формировался файл g следующим образом: в файле g перед каждым положительным числом ставился ноль

[volvo]

Тогда меняй соответствующий фрагмент на:

var z: integer;
...
  { первый проход по файлу - переносим положительные числа }
  { и считаем количество нулей }
  reset(f_in); z := 0;
  while not seekeof(f_in) do begin
    read(f_in, y);
    if y > 0 then write(f_out, z, ' ', y, ' ')
    else if y = 0 then inc(zeroes); { если не нужно - это можно убрать }
  end;

[mafia1232]

огромное спасибо!!!!!
а вот еще прогу мона сделать?

дан текстовый файл, содержащий строки. удалить из строк знаки такие как @ # $ %

исходник буквы удаляет

Код

program P3_4;
uses crt;
var
a,b,p:char;
f,f1: text;
begin
clrscr;
p:=' ';
assign (f,'proekt.txt');
rewrite (f);
for a:='A' to 'z' do
write (f,a);
assign (f1,'chistka.txt');
reset (f);
rewrite (f1);
while not eof (f) do
     begin
     read (f,b);
     case b of
     'A','B','C','D','E','X','Y':write (f1,p)
     else
     write (f1,b);
     end;
     end;
close (f);
close(f1);
end.

[volvo]

Ну так сделай наоборот...

case b of
  '@','#','$','%' : write( f1, p )
  else write ( f1, B );
end;

[mafia1232]

А это нормально, что прога текст файлов qwe i nda переделывает в ангийский алфавит? или я неправильно что-то делаю?

[volvo]

Какие символы задаешь, такие и получишь в результате. Программа-то тут при чем? Она просто отсекает НЕ буквы...

[Roise]

Ой, последний вопрос, ПЛИИИИЗ >___<
И я отвяжусь, честно. Но просто ОЧеНЬ надо (хех, знаю, как и всем остальным)

Но прошу только одну строчку: как определить количество слов (отделяются пробелами) в строке? Я FAQ смотрел, но че-то не врубаюсь все равно

Сообщение отредактировано: Roise - 27.05.2005 2:10

[volvo]

как определить количество слов (отделяются пробелами) в строке? Я FAQ смотрел, но че-то не врубаюсь все равно

Лучше чем там я все равно сделать не смогу... Тот алгоритм уже отлажен, зачем же нужно переписывать его еще раз?

Что именно не ясно в алгоритме из FAQ-а ?

[Roise]

Ну, если у меня кроме пробелов других разделителей не учитывается, то здесь

Function GetWords(s: String; Var mas: TWords;

  delimiters: TDelimiter): Byte;

вместо TDelimeter надо просто ' ' написать? И вот этого куска

 { Заменяем все разделители пробелами }

    For i := 1 to Length(s) Do

      If s[i] In delimiters Then s[i] := #32;

не надо тогда писать?
Да, и еще, фунция просто определяет число слов и все, да? Т.е. что бы потом узнать, в какой из строк у меня слов больше всего, мне нужно просто присвоить этому значению какую-нить переменную MAX , а потом проверить, если GetWords другой строки >MAX, то присвоить МАХ уже этой строке.. Так?

[volvo]

вместо TDelimeter надо просто ' ' написать?

:no: Смотри внимательнее пример использования... Там написано:

Count := GetWords(s, words, []);

А внутри функции ничего менять не надо...

что бы потом узнать, в какой из строк у меня слов больше всего, мне нужно просто присвоить этому значению какую-нить переменную MAX , а потом проверить, если GetWords другой строки >MAX, то присвоить МАХ уже этой строке.. Так?

Именно так !!!

[Roise]

{ Заменяем все разделители пробелами }
For i := 1 to Length(s) Do
  If s[i] In delimiters Then s[i] := #32;

- я просто не понимаю тогда, зачем заменять все разделители пробелами О_о И что значит #32?

[volvo]

Да что ты привязался к этим разделителям???
Это что, для красоты сделано?

 If s[i] In delimiters then ...

Если множество разделителей пустое (а [] это именно пустое множество) - то In будет возвращать False и никаких замен произведено не будет !!! Ты что же думаешь, в FAQ что попало заносится? Все функции протестированы, причем не на одном десятке примеров...

А #32 - это код пробела...

[Roise]

Да не в коей мере не сомневаюсь в работоспособности этих функций, спрашиваю просто потому, что мне ведь потом объяснять придется, как прога работает СПАСИБО

[mafia1232]

А помогите переделать. есть созданный текстовый файл, где слова разделяются пробелами. Надо найти строки в которых 5 слов и удалить из этих строчек 2 последних слова.
исходник на удаления строчек длиной 10 символов

Program P1_5;

Uses CRT;
Var
f1,f2:text;
s:string;
Begin
CLRSCR;
Assign (f1,'z5.txt');
reset(f1);
Assign(f2,'chistka.txt');
Rewrite(f2);
While not eof(f1) do
      begin
      Readln (f1,s);
      if length(s)=10 then s:='';
      Writeln(f2,s);
      end;
Writeln;
Close(f1);
Close(f2);
Readln;
End.

[klem4]

что-то я не очень понял что ты сделал в своей проге ... вот удаление из строки 4-го и 5-го слова, состоящих из 5-ти букв :

uses crt;
var
   s:string;
   i,bword,count,count1:integer;

Begin
   clrscr;
   readln(s);
   i:=1;
   count:=0;
   while i<=length(s) do
    begin
       while(i<=length(s))and(s[i]=#32) do
        inc(i);
       if i<=length(s) then
        begin
           inc(count);
           bword:=i;
           count1:=0;
           while(i<=length(s))and(not(s[i]=#32)) do
            begin
               inc(i);
               inc(count1);
            end;
           if ((count=4)or(count=5))and(count1=5) then
            begin
               delete(s,bword,i-bword);
               i:=bword;
            end
        end;
    end;

    writeln(s);
    readln;
end.

Добавлено : Это не совсем верно, перед этим надо проверить сколько слов в строке и если в ней пять слов, то можно просто пойти с конца и удалить первые два.

Сообщение отредактировано: klem4 - 1.06.2005 22:32