Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Программирование на языке Pascal

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 2.942 RSS
←   Апрель 2010   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
23.04.2010
05:35:50
13:37:24
24
25
26
27
28
29
30


За последние 60 дней ни разу не выходила


Сайт рассылки: http://prog.rusfaq.ru/pascal
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

2.942 подписчиков
0 за неделю
←   Все выпуски   →

RFpro.ru: Программирование на языке Pascal


Хостинг портала RFpro.ru:
Московский хостер
Профессиональный хостинг на базе Linux x64 и Windows x64

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

lamed
Статус: Практикант
Рейтинг: 2239
∙ повысить рейтинг » 		Boriss
Статус: Академик
Рейтинг: 1966
∙ повысить рейтинг » 		_Ayl_
Статус: Практикант
Рейтинг: 1867
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И ПО / Программирование / Pascal (Паскаль)

Номер выпуска:1061
Дата выхода:11.04.2010, 06:30
Администратор рассылки:Boriss, Академик
Подписчиков / экспертов:334 / 205
Вопросов / ответов:2 / 3

Вопрос № 177688: Запрограммировать следующие процедуры и функции: а) поиск записи по двум любым полям, определенным в программе, б) вывод записи, в) добавление новой записи в конец файла, г) циклический сдвиг файла на N записей влево (к началу файла), ...

Вопрос № 177692: Создать массив целых чисел M[1..N], в котором могут быть нули. Последовательность чисел до первого нуля, между нулями и от последнего нуля до последнего числа назовем серией. Отсортировать массив М по убыванию количества чисел в каждой серии.
Вопрос № 177688:

Запрограммировать следующие процедуры и функции:
а) поиск записи по двум любым полям, определенным в программе,
б) вывод записи,
в) добавление новой записи в конец файла,
г) циклический сдвиг файла на N записей влево (к началу файла),
д) удаление записей по критерию,
е) вывод файла,
ж) построение диаграммы по одному из полей записи.

Код:
program pog;
uses crt;
const n=15;
type data=record
dr:1900..2000;
end;
type
dan=record
fio:string[20];
god:1900..2000;
mark:longint;
end;
mas=array[1..n] of dan;
var f:text;
u:mas;
a:dan;
i,j,c,x1,y1,x2,y2,dx,q:byte;
pr:boolean;
m:1..12;
p:string;
k:array[1..n] of byte;
ky,max:real;
procedure poisk;
          begin assign(f,'d
 an.txt');
                reset(f);
                i:=0;
                while not seekeof(f) do
                begin read(f,a.fio);
                read(f,a.god);
                     inc(i);
                      u[i]:=a;
                end;
                c:=i;
                writeln('Vvedite FIO');
                readln(p);
                if p='FIo' then
                begin readln(f,a.god);
 
                      end;
       
       readkey;
          end;
procedure dobavka;
begin
writeln('Vvedute FIO');
readln(a.fio);
for i:=1 to n do
a.fio:=a.fio+'';
writeln('Vvedite god rogdenia');
readln(a.god);
append(f);
writeln(f,a.fio,a.god:5);
close(f);
end;
procedure ciklsdvig;
 
 
procedure delete;
begin assign(f,'dan.txt');
reset(f);
writeln('Vvedite FIO dly delete');
i:=1;
while i=n do
begin
 
dec(i);
for j:=1 to n do
u[j]:=u[j+1];
u[i+1].mark:=0;
dec(i);
end;
close(f);
end;
procedure vivod;
          begin assign(f,'dan.txt');
                reset(f);
                i:=0;
                while not seekeof(f) do
                begin read(f,a.fio,a.god);
                      readln(f);
                      inc(i);
                      u[i]:=a;
                end;
                c:=i;
                for i:=1 to c do
 
                    writeln(u[i].fio,u[i].god:5);
                readkey;
          end;
procedure diagr;
          begin assign(f,'dan.txt');
                reset(f);
                i:=0;
                while not seekeof(f) do
                begin read(f,a.fio,a.god);
                      readln(f);
                      inc(i);
                      u[i]:=a;
                end;
                q:=i;
               
  for j:=1 to 11 do
                    k[j]:=0;
                for i:=1 to q do
                    for j:=1 to 11 do
                        inc(k[j]);
                {for j:=1 to 11 do
                writeln(k[j]);
                readkey;}
                window(1,8,80,25);
                textbackground(0);
                clrscr;
                max:=k[1];
                for i:=2 to 11 do
                    if k[i]>max then
                    max:=k[i];

               ky:=17/max;
                dx:=75 div 10;
                x1:=1;
                y2:=25;
                c:=1;
                for i:=1 to 11 do
                    begin x2:=x1+dx;
                          y1:=y2-round(k[i]*ky);
                          window(x1,y1,x2,y2);
                          textbackground(c);
                          clrscr;
                          write(i);
                          
 inc(c);
                          if c=8 then
                          c:=1;
                          x1:=x2;
              
      end;
                readkey;
                window(1,1,80,25);
                textbackground(0);
                clrscr;
          end;
begin clrscr;
      assign(f,'dan.txt');
      {$I-} reset(f); {$I+}
      if ioresult<>0 then
      writeln('SOZDAY FAIL!')
      else repeat pr:=false;
                  clrscr;
                  writeln('1 - Poisk zapisi');
                  writeln('2 - Dobavlenie zapisi v konec');

                 writeln('3 - cikl sdvig faila na n vlevo');
                  writeln('4 - Delete');
                  writeln('5 - Vivod file');
                  writeln('6 - Diagramma');
                  writeln('7 - Vihod');
                  case readkey of '1':poisk;
                                  '2':dobavka;
                                  '3':ciklsdvig;
              
                     '4':delete;
                                  '5':vivod;
                                  '6':diagr;
                                  '7':pr:=true;
                  end;
           until pr;
end.

затруднение с сдвигом и с удалением

Отправлен: 06.04.2010, 01:31
Вопрос задал: kasir, Посетитель
Всего ответов: 1
Страница вопроса »

Отвечает Boriss, Академик :
Здравствуйте, kasir.
Что-то Вы не отвечаете...
Помещаю код программы в приложении
Если что-то не так сделано, пишите - исправлю

Приложение:

-----
Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss, Академик
Ответ отправлен: 10.04.2010, 19:54
Номер ответа: 260745

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это!
Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 260745 на номер 1151 (Россия) | Еще номера »
  • Отправить WebMoney:

    • Вопрос № 177692:

    Создать массив целых чисел M[1..N], в котором могут быть нули. Последовательность чисел до первого нуля, между нулями и от последнего нуля до последнего числа назовем серией. Отсортировать массив М по убыванию количества чисел в каждой серии.

    Код:
    uses crt;
    const n=20;
    type mas=array[1..n]
of integer;

    var
    m:^mas;
    buf,i,k:integer;
    pris:boolean;
    v:byte;

    procedure pamyatb;
    begin
    writeln;
    writeln('vsya pamyatb= ', memavail);
    writeln('Maximalnaya pamyatb= ', maxavail);
    end;

    begin
    clrscr;
    randomize;
    pamyatb;
    {sozdanie massiva}
    writeln('ishodnye chisla');
    if maxavail>sizeof(mas) then begin
    getmem(m,sizeof(mas));
    for i:=1 to n do
    begin
          v:=random(
 4);
              if v= 0 then m^[i]:= 0
                 else m^[i]:=-50 + integer(random(150));

          write(m^[i],' ');
    end; end;
    writeln;

    {sortirovka}


    {vyvod massiva}
    pamyatb;
    writeln;
    writeln('posle sortirovki');
    for i:=1 to n do
     write(m^[i] ,' ');

    freemem(m,sizeof(mas));
    pamyatb;
    readkey;
    end.

    проблема с сортировкой, немогу понять, как сделать
    пояснение :
    А:120123456701012345012340 данный
    Б:123456701234501234012010 получившийся

    Отправлен: 06.04.2010, 01:46
    Вопрос задал: -melamory-, Посетитель
    Всего ответов: 2
    Страница вопроса »

    Отвечает Andrew Kovalchuk, 9-й класс :
    Здравствуйте, -melamory-.
    После объявления дополнительных переменных (есть комментарии), пары процедур и функции получилось представленное в приложении. Правда в результирующем массиве возможны коллизии с группами цифр, которые не разделены нулем и могут выглядеть более длинными чем их предшественники (к примеру первая группа цифр начинается не с нуля, а последняя нулем не заканчивается, при этом последняя группа располагается в результирующем массиве непосредственно перед первой). Если понадобятся дополнительные пояснения - велкам .

    Приложение:

    -----
    Временная неудача лучше временной удачи

    Ответ отправил: Andrew Kovalchuk, 9-й класс
    Ответ отправлен: 07.04.2010, 01:28
    Номер ответа: 260650

    Вам помог ответ? Пожалуйста, поблагодарите эксперта за это!
    Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 260650 на номер 1151 (Россия) | Еще номера »
  • Отправить WebMoney:

    • Отвечает star9491, Практикант :
    Здравствуйте, -melamory-.
    Мне кажется, что проще поступить по другому. Сначала создаем информационный массив, содержащий длины отрезков:
    Код:
    type
      TData = record
        start: integer;
        length: integer;
      end;
      AData = array[1..n] of TData;
    var
      data: AData;
    
 count: Integer;{число элементов информационного массива}

    и заполняем его как то так:
    Код:
     count:=0;
      IsStart:=false;
      for i:=1 to n do
      begin
        if (m^[i]<>0)and( not IsStart) then
        begin
          IsSta
 rt:=true;
          count:=count+1;
          data[count].start:=i;
        end;
        if (m^[i]=0)and(IsStart) then
        begin
          IsStart:=false;
          data[count].length:=i-data[count].start;
        end;
        if (i=n)and(m^[i]<>0)and(IsStart) then
        begin
          data[count].length:=i+1-data[count].start
        end;
      end;

    После этого сортируем информационный массив, например:
    Код:
    procedure Sort;
    var
      i,j: Integer;
      index: Integer;
      temp: TData;
    begin
      for i:=1 to count-1 do
      begin
        index:=i;
        for j:=i+1 to count do
           if data[index].length<data[j].length then index:=j;
        if (index<>i) then
        begin
          temp:=data[i];
          data[i]:=data[inde
 x];
          data[index]:=temp;
        end;
      end;
    end;

    И в конце формируем новую последовательность b[i]:
    Код:
     k:=1;
      for j:=1 to count do
      begin
        for i:=data[j].start to data[j].start+data[j].length-1 do
        begin
          b[k]:=m^[i];
          k:=k+1;
    
   end;
        if data[j].start+data[j].length-1<>n then
        begin
          b[k]:=0;
          k:=k+1;
        end;
      end;
      if k<n then for i:=k to n do b[i]:=0;


    Если собрать все вместе, то получится:
    Код:
    uses 
 crt;

    const
      n=20;

    type
      mas=array[1..n] of integer;

      TData = record
        start: integer;
        length: integer;
      end;
      AData = array[1..n] of TData;

    var
      m:^mas;
      i:integer;
      v:byte;

      data:AData;
      j,k,count: Integer;
      IsStart: boolean;
      b: mas;

    procedure pamyatb;
    begin
      writeln;
      writeln('vsya pamyatb= ', MemAvail);
      writeln('Maximalnaya pamyatb= ', maxavail);
    end;

    procedure Sort;
    var
    
 i,j: Integer;
      index: Integer;
      temp: TData;
    begin
      for i:=1 to count-1 do
      begin
        index:=i;
        for j:=i+1 to count do
           if data[index].length<data[j].length then index:=j;
        if (index<>i) then
        begin
          temp:=data[i];
          data[i]:=data[index];
          data[index]:=temp;
        end;
      end;
    end;

    begin
      clrscr;
      randomize;
      pamyatb;{sozdanie massiva}
      writeln('is
 hodnye chisla');
      if maxavail>sizeof(mas) then
      begin
        getmem(m,sizeof(mas));
        for i:=1 to n do
        begin
          v:=random(4);
          if v= 0 then m^[i]:= 0
          else m^[i]:=-50 + integer(random(150));
          write(m^[i],' ');
        end;
      end;
      writeln;{sortirovka}{vyvod massiva}
      pamyatb;
      writeln;

      for i:=1 to n do write(m^[i] ,' ');

      count:=0;
      IsStart:=false;
      for i:=1 to n do
      begin
        if (m^[i]<>0)and( not IsStart) then
        begin
          IsStart:=true;
          count:=count+1;
          data[count].start:=i;
        end;
     
  if (m^[i]=0)and(IsStart) then
        begin
          IsStart:=false;
          data[count].length:=i-data[count].start;
        end;
        if (i=n)and(m^[i]<>0)and(IsStart) then
        begin
          data[count].length:=i+1-data[count].start
        end;
      end;
      Sort;

      k:=1;
      for j:=1 to count do
      begin
        for i:=data[j].start to data[j].start+data[j].length-1 do
        begin
          b[k]:=m^[i];
          k:=k+1;
        end;
        if k<
 =n then
        begin
          b[k]:=0;
          k:=k+1;
        end;
      end;
      if k<=n then for i:=k to n do b[i]:=0;

      writeln;
      writeln('posle sortirovki');
      for i:=1 to n do write(b[i],' ');

      freemem(m,sizeof(mas));
      pamyatb;
      readkey;
    end.
    По просьбе автора помещен текст программы, реализующий идею автора
    -----
    ∙ Отредактировал: Boriss, Академик
    ∙ Дата редактирования: 07.04.2010, 21:31 (время московское)

    Ответ отправил: star9491, Практикант
    Ответ отправлен: 07.04.2010, 13:19
    Номер ответа: 260654

    Вам помог ответ? Пожалуйста, поблагодарите эксперта за это!
    Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 260654 на номер 1151 (Россия) | Еще номера »
  • Отправить WebMoney:

    • Оценить выпуск »
    Нам очень важно Ваше мнение об этом выпуске рассылки!

    Задать вопрос экспертам этой рассылки »

    Скажите "спасибо" эксперту, который помог Вам!

    Отправьте СМС-сообщение с тестом #thank НОМЕР_ОТВЕТА
    на короткий номер 1151 (Россия)
    Номер ответа и конкретный текст СМС указан внизу каждого ответа.

    Полный список номеров »

    * Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи. (полный список тарифов)
    ** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
    *** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.

    © 2001-2010, Портал RFpro.ru, Россия
    Авторское право: ООО "Мастер-Эксперт Про"
    Автор: Калашников О.А. | Программирование: Гладенюк А.Г.
    Хостинг: Компания "Московский хостер"
    Версия системы: 2010.6.14 от 03.03.2010
    В избранное