Помощь - Поиск - Пользователи - Календарь
Полная версия: Задача по файлам
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
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:
Roise
Эм.. А вот еще маленький вопросик.. unsure.gif
Вы уж извиняйте за невменяемость, просто я в паскале совсем того... Вот, короче, если у меня из файла берутся компоненты, удовлетворяющие определенным условиям (ну, <1 или >8 в данном случае), то как записать операцию нахождения их среднего арифметического? Ну, я ж не знаю, сколько их там всего... Ну, вот такое вот я глупое. sad.gif
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 смотрел, но че-то не врубаюсь все равно
volvo
Цитата(Roise @ 26.05.05 22:00)
как определить количество слов (отделяются пробелами) в строке? Я 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
Цитата(Roise @ 26.05.05 22:54)
вместо 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
Да не в коей мере не сомневаюсь в работоспособности этих функций, спрашиваю просто потому, что мне ведь потом объяснять придется, как прога работает smile.gif СПАСИБО
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.






Добавлено : Это не совсем верно, перед этим надо проверить сколько слов в строке и если в ней пять слов, то можно просто пойти с конца и удалить первые два.
mafia1232
а можно узнать на какой файл он будет ссылаться? и слово у меня не обязательно из 5 букв. а из неизвестного кол-ва, это строка из 5 слов или более
klem4
ну я же говрю, сначала просматриваешь каждую строку, и проверяешь сколько в ней слов, да если они у тебя только пробелами разделены, то можешь удалить из нее лишние пробелы, а потом посчтитать кол-во оставшихся, если их 4, то в троке 5 слов, или просто посчитать колво слов, если не понял как это у меня в программе делается, пойди посмотри в FAQ.

лишние - несколько идущих подрят, а ткаже пробел в конце и в начале, если они есть, но это полюбому извращение, так что просто считай кол-во слов, если 5 то с конца строки удаляй 2 и все.
mafia1232
Прога должна файл txt просматривать и просматривать каждую строку. если строка из 5 слов то она должна удалить 4 и 5 слова, а если строка больше или
меньше то не трогать. ответ должен быть записан в другой txt файл
klem4
я не пойму, тебе всю программу написать ? я помойму все объяснил как делать blink.gif

Открываешь файл
береш строку
считаешт кол-во слов в строке, если ==5 то удаляешь с конца 2 слова иначе ничего не делаешь.

какой из пунктов не можешь реализовать ?
mafia1232
получилось так , но явно где-то ошибка. она делает файл чистка чистым полностью.
program p11;
uses crt;
var
   f1,f2:text;
   s:string;
   i,bword,count,count1:integer;

Begin
   clrscr;
Assign (f1,'z5.txt');
reset(f1);
Assign(f2,'chistka.txt');
Rewrite(f2);
While not eof(f1) do
      begin

   readln(f1,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;
end;
    writeln(f2,s);
    readln;

end.

klem4
не уверен что отрабатывает полностью правильно, но что-то в этом духе :
надеюсь поймешь.

program p11;
uses crt;
var
   f1,f2:text;
   s:string;
   i,bword,count,count1:integer;

Begin
   clrscr;
   Assign (f1,'z5.txt');
   reset(f1);
   Assign(f2,'chistka.txt');
   Rewrite(f2);
   While not eof(f1) do
    begin
       readln(f1,s);
       i:=1;
       count:=0;
       while i<=length(s) do
        begin
           while(i<=length(s))and(s[i]=#32) do
            inc(i);
           inc(count);
           if i<=length(s) then
           begin
               while(i<=length(s))and(not(s[i]=#32)) do
                inc(i);
           end;
        end;

    if count=5 then
     begin
        count:=0;
        i:=length(s);
        repeat
           bword:=i;
           while (s[i]<>#32) do dec(i);
           delete(s,i,bword-i+1);
           inc(count);
           while (s[i]=#32) do dec(i);
        until count=2;
        writeln(f2,s);
     end;
    end;

    close(f1);
    close(f2);

    readln;
end.


mafia1232
я , наверное, тормоз. почему файл чистка пустой получается если исходный txt такой (sasa ftt ewrw werwe erter
ewrwe wrr wert qweqw
asda asdas adsda asdas asdas asdas )?


ответ такой должен быть
(sasa ftt ewrw
ewrwe wrr wert qweqw
asda asdas adsda asdas asdas asdas )
klem4
проверь так, кое-что изменил :

program p11;
uses crt;
var
   f1,f2:text;
   s:string;
   i,bword,count,count1:integer;

Begin
   clrscr;
   Assign (f1,'z5.txt');
   reset(f1);
   Assign(f2,'chistka.txt');
   Rewrite(f2);
   While not eof(f1) do
    begin
       readln(f1,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);
               while(i<=length(s))and(not(s[i]=#32)) do
                inc(i);
           end;
        end;
       writeln('count=',count);

    if count=5 then
     begin
        count:=0;
        i:=1;
        while(i<=length(s)) do
         begin
            while(i<=length(s))and(s[i]=#32) do
             inc(i);
            if i<=length(s) then
             begin
                bword:=i;
                inc(count);
                while(i<=length(s))and(s[i]<>#32) do
                 inc(i);
                if (count=4)or(count=5) then
                 begin
                    delete(s,bword,i-bword);
                    i:=bword;
                 end;
             end;
          end;
         end;
     writeln(f2,s);
    end;


    close(f1);
    close(f2);

    readln;
end.


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

Program p3_3;
uses crt;

const
 n = 20;

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

begin
 clrscr;
 assign(f_in,'byka.txt');
 rewrite(f_in);
 for i := 1 to n do begin
   y := -5 + random(10);
   write(f_in, y, ' ')
 end;
 assign(f_out,'byka1.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, z, ' ', 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.

правильно ли она работает?
volvo
Цитата(mafia1232 @ 21.06.05 16:54)
дан файл f компонентами которого являются целые числа. Файл создается с такими компонентами y = -5 + random (10). Сформировать новый файл g следующим образом:чтоб перед каждым положительным числом ставился "0" (без ковычек):

Может и правильно, но она выполняет много лишнего ... Для правильной работы программы достаточно вот этого:
uses crt;
const
  n = 20;
  zero = 0;

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

begin
  clrscr;
  assign(f_in,'byka.txt');
  rewrite(f_in);
  for i := 1 to n do begin
    y := -5 + random(10);
    write(f_in, y, ' ')
  end;
  assign(f_out,'byka1.txt');
  rewrite(f_out);
  reset(f_in);
  while not seekeof(f_in) do begin
    read(f_in, y);
    if y > 0 then write(f_out, zero, ' ');
    write(f_out, y, ' ');
  end;
  close(f_out);
  close(f_in);
end.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.