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

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

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 2.943 RSS
←   Июнь 2010   →
 1
 2
 3
 4
04.06.2010
00:04:42
21:29:10
 5
 6
 7
 8
08.06.2010
00:18:54
23:04:16
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30


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


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

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

Статистика

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

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


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

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

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

lamed
Статус: Профессионал
Рейтинг: 2754
∙ повысить рейтинг » 		Boriss
Статус: Академик
Рейтинг: 2450
∙ повысить рейтинг » 		star9491
Статус: Профессионал
Рейтинг: 2181
∙ повысить рейтинг »

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

Номер выпуска:1100
Дата выхода:05.06.2010, 21:30
Администратор рассылки:Boriss, Академик
Подписчиков / экспертов:213 / 181
Вопросов / ответов:3 / 3

Вопрос № 178560: Добрый день,уважаемые эксперты!!!! Помогите пожалуйста сделать задачу на тему:"типизированные файлы" файл с инструкцией, что необходимо сделать: http://rfpro.ru/upload/2462 http://rfpro.ru/upload/2461 -это индивидуальное за...

Вопрос № 178787: Даны текстовый файл, в котором находится прямоугольная матрица. Определить: 1) Количество столбцов, содержащий хотя бы один нулевой элемент( оформить виде функции) 2) Номер строки, в которой находится самая длинная серия одинаковых элементов(оф...
Вопрос № 178789: Здравствуйте, уважаемые эксперты! Помогите разобраться.. некорректно работает программа бинарного поиска. Текст программы в приложении (у меня нерекурсивная реализация, программа: ABC), также, если возможно подскажите рекурсивный вариант. Зар...
Вопрос № 178560:

Добрый день,уважаемые эксперты!!!!
Помогите пожалуйста сделать задачу на тему:"типизированные файлы"
файл с инструкцией, что необходимо сделать: http://rfpro.ru/upload/2462
http://rfpro.ru/upload/2461 -это индивидуальное задание(оно рабочее) на основе которого нужно сделать задание по файлам

будет запускаться на pascal abc
Прошу,пожалуйста помогите!
С уважением!



Отправлен: 22.05.2010, 16:20
Вопрос задал: angel.nero, Посетитель
Всего ответов: 1
Страница вопроса »

Отвечает lamed, Профессионал :
Здравствуйте, angel.nero! Приношу извинения за задержку. Проверено на ABC.
Возможные улучшения:
1. Быстрая сортировка
2. В данной программе в случае операций удаления/добавления индексные массивы пересоздаются, можно, просто добавлять или удалять соответствующую запись.
3. Выгодней создать структуру, которая содержит как индексный массив, так и функцию сравнения
4. Можно ввести массив указателей на индексные массивы, тогда можно менять их число
...
Если потребуются дополнения или уточнения, пишите в мини-форум
Код:
uses
  Crt;
const
  MAX_RECORDS = 500; // максимальное число записей в файле
type
  TIndex = record
    arr: array[0..MAX_RECORDS-1] of integer;
    size: integer;
  end;

  TOneinfo = reco
 rd
    name: string[20];
    House: real;
    Flat:integer;
    floor:integer;//этаж
  end;
  tkey = (kname, kHouse, kFlat, kfloor);
  TBase = file of TOneinfo;
  TGreater = function(rec1, rec: TOneInfo): boolean;

function find(
  const f:TBase;
  const recno: integer;
  var FoundRec: TOneInfo): integer;
// если запись существует
//   возвращает recno или -1, если запись не существует
//   foundrec присваивается значение найденной записи
// иначе возвращает
-1
//
var
  fSize: integer;
begin
  fSize := FileSize(f);
  if (fSize=0) or (recno < 0) or (recno >=fSize) then
    find := -1
  else begin
    seek(f, recno);
    read(f, FoundRec);
    find := recno;
  end;
end; { find }

function gtName(const rec1, rec2: TOneInfo): boolean;
// истина, если название улицы первой записи лексикографически следует
// за названием улицы второй записи
begin
  gtName := rec1.Name
  > rec2.Name;
end; { gtName }

function gtHouse(rec1, rec2: TOneInfo): boolean;
// истина, если номер дома первой записи больше номера дома второй записи
begin
  gtHouse := rec1.House > rec2.House;
end; { gtHouse }

function gtFlat(const rec1, rec2: TOneInfo): boolean;
// истина, если номер квартиры первой записи больше номера квартиры второй записи
begin
  gtFlat := rec1.Flat > rec2.Flat;
end; { gtFlat }

function gtFloor(const rec1, rec2: TOneInfo): boolean;
//
истина, если номер этажа первой записи больше номера этажа второй записи
begin
  gtFloor := rec1.floor > rec2.floor;
end; { gtFloor }

procedure CreateIdx(const f: TBase; var idx: TIndex);
// Создание индексного массива
var
  rec: TOneInfo;
  i  : integer;
begin
  idx.size := FileSize(f);
  for i:= 1 to idx.size do
    idx.arr[i] := i-1;
end; { CreateIdx }

procedure Sort(const f: TBase; var idx: TIndex; const
  gt: TGreater);
// Сортировка индексного массива
// Метод "пузырька" как самый простой для восприятия
var
  i,j,n : integer;
  tmp: integer;
  rec1, rec2: TOneinfo;
begin

  n:= filesize(f);
  seek(f,0);
  for i:= 1 to idx.size-1 do
    for j:= idx.size downto i+1 do begin
      seek(f, idx.arr[j]-1);
      read(f, rec1);
      read(f, rec2);

      if gt(rec1, rec2) then begin
        tmp := idx.arr[j];
        idx.arr[j] := idx.arr[j-1];

       idx.arr[j-1] := tmp;
      end;
    end;
end; { Sort }

procedure CreateIdxAll(
  const f: TBase; var idx1, idx2, idx3: TIndex; const gt1, gt2, gt3: TGreater);
// Создание и сортировка всех индексных файлов
begin
  CreateIdx(f, idx1);
  Sort(f, idx1, gt1);

  CreateIdx(f, idx2);
  Sort(f, idx2, gt2);

  CreateIdx(f, idx3);
  Sort(f, idx3, gt3);
end; { CreateIdxAll }

procedure AddRec(var f: TBase);
// Вв
 од новой записи и добавление в файл
var
  i, House, Flat: integer;
  name: string;
  rec: TOneinfo;

begin
  writeln(
'Ввод базы данных');

  write('Название улицы ');
  readln(rec.name);

  write('номер дома ');
  readln(rec.House);

  write('этаж ');
  readln(rec.floor);

  write('номер квартиры ');
  readln(rec.Flat);

  seek(f, filesize(f));
  write(f, rec);

  readln;
end; { AddRec }

procedure PrintRec(const rec:TOneinfo);
// Печать одной записи
var
  i: integer;
begin
  with rec do
    writeln('ул.',
name, ',', House, ',кв.', flat, ',', floor, '-й этаж');
end; { Print }

procedure PrintFile(const f: TBase; const idx: TIndex);
//Процедура вывода всех записей
var
  i: integer;
  rec: TOneinfo;
begin
  for i:= 1 to idx.size do begin
    seek(f, idx.arr[i]);
    read(f, rec);
    PrintRec(rec);
  end;
  readln;
end; { PrintAll }

procedure PrintAll(const f: TBase; const idx1, idx2, i
 dx3: TIndex);
// Печать всех записей файла, сортировка по трем условиям
begin
  clrscr;
  writeln('Сортировка по номеру дома');
  PrintFile(f, idx1);
  writeln('Сортировка по номеру квартиры');
  PrintFile(f, idx2);
  writeln('Сортировка по номеру этажа');
  PrintFile(f, idx3);
end; { PrintAll }

function MaxFlat(const f: TBase): TOneInfo;
//процедура, определяет запись с наибольшим номером квартиры
var
  i: integer;
  rec, max: TOneinfo;
begin

 max.Flat := -MaxInt-1;
  seek(f,0);
  while not eof(f) do
    begin
      read(f,rec);
      if rec.Flat > max.Flat then
        max := rec;
    end;
  MaxFlat := rec;
end; { MaxFlat }

function FirstFloor(const f: TBase): integer;
// функцию, определяющую количество жителей первого этажа
var
  k: integer;
  rec: TOneinfo;
begin
  k := 0;
  seek(f,0);
  while not eof(f) do
    begin
      re
 ad(f,rec);
      if rec.floor =1 then
        inc(k);
    end;
  FirstFloor:=k;
end; { FirstFloor }

procedure DelRec(var f: TBase; const RecNo: integer);
// Удаление записи
var
  rec, tmp: TOneInfo;
  fSize : integer;
begin
  fSize := FileSize(f);
  if (recno >= 0) and (recno < fSize) then begin
    seek(f, FileSize(f)-1);
    read(f, rec);
    seek(f, recno);
    write(f, rec);
    seek(f, fSize-1);
    Truncate(f);
    writeln('Запись
удалена');
  end
  else
    writeln('Неверный номер. Удаление невозможно');
end; { DelRec }

procedure menu;
begin
  writeln('1. Добавить запись');
  writeln('2. Вывести на печать одну запись');
  writeln('3. Вывести на печать все записи');
  writeln('4. Наибольший номер квартиры');
  writeln('5. Количество жителей первого этажа');
  writeln('6. Удалить запись');
  writ
 eln('0. Выход');
end; { menu }

var
  choice            : integer; // выбор пункта
  f                 : TBase;
  rec               : TOneInfo;
  idx1, idx2, idx3  : TIndex; // массив индексов
  recno             : integer;
  fName   : string;

//  y, m, k, n: integer;
//  key: tkey;
//  StreetName: string[20];

var
  ii: integer;
  
begin { main }
  ClrScr;
  fName := 'city.dat';
  assign(f, fName);
  if not FileExists(fname)
then
    begin
      rewrite(f);
      close(f);
    end;

  reset(f);
  
  CreateIdxAll(f, idx1, idx2, idx3, gtHouse, gtFlat, gtFloor);

  choice := 1;
  while choice <> 0 do
    begin
      clrscr;
      menu;
      write('Выбор ');
      readln(choice);
      case choice of
        1: begin
             AddRec(f);
             CreateIdxAll(f, idx1, idx2, idx3, gtHouse, gtFlat, gtFloor);
      
      end;
        2: begin
             write('Номер печатаемой записи ');
             readln(RecNo);
             if
 find(f, recno, rec)>=0 then
               PrintRec(rec)
             else
               writeln('Номер не существует');
             readln;
           end;
        3: PrintAll(f, idx1, idx2, idx3);
        4: begin
             writeln('Наибольший номер квартиры ', MaxFlat(f).Flat);
             readln;
           end;
        5: begin
             writeln('Количество жителей первого этажа ', FirstFloor(f));
             readln;
      
    end;
        6: begin
             write('Номер удаляемой записи ');
             readln(RecNo);
             DelRec(f, RecNo);
             CreateIdxAll(f, idx1, idx2, idx3, gtHouse, gtFlat, gtFloor);
             readln;
           end;
        0: writeln('Работа завершена')
      else
        writeln('Пункты 0..6');
      end;
    end;
  close(f);
end.


Пример работы
Код:
1. Добавить запись
2. Вывести на печать одну запись
3. Вывести на печать все записи
4. Наибольший номер квартиры
5. Количество жителей первого этажа
6. Удалить запись
0. Выход
Выбор 3
Сортировка по номеру дома
ул.Моховая,1,кв.1,1-й этаж
ул.Речная,1,кв.3,1-й этаж
ул.Сосновая,4,кв.20,5-й
этаж
ул.Сосновая,5,кв.1,1-й этаж
Сортировка по номеру квартиры
ул.Сосновая,5,кв.1,1-й этаж
ул.Моховая,1,кв.1,1-й этаж
ул.Речная,1,кв.3,1-й этаж
ул.Сосновая,4,кв.20,5-й этаж
Сортировка по номеру этажа
ул.Сосновая,5,кв.1,1-й этаж
ул.Моховая,1,кв.1,1-й этаж
ул.Речная,1,кв.3,1-й этаж
ул.Сосновая,4,кв.20,5-й этаж
1. Добавить запись
2. Вывести на печать одну запись
3. Вывести на печать все записи
4. Наибольший ном
 ер квартиры
5. Количество жителей первого этажа
6. Удалить запись
0. Выход
Выбор 4
Наибольший номер квартиры 1
1. Добавить запись
2. Вывести на печать одну запись
3. Вывести на печать все записи
4. Наибольший номер квартиры
5. Количество жителей первого этажа
6. Удалить запись
0. Выход
Выбор 5
Количество жителей первого этажа 3
1. Добавить запись
2. Вывести на печать одну запись
3. Вывести на печать все записи
4. Наибольший номер квартиры
5. Количество
жителей первого этажа
6. Удалить запись
0. Выход
Выбор 1
Ввод базы данных
Название улицы Ленина
номер дома 15
этаж 37
номер квартиры 2
1. Добавить запись
2. Вывести на печать одну запись
3. Вывести на печать все записи
4. Наибольший номер квартиры
5. Количество жителей первого этажа
6. Удалить запись
0. Выход
Выбор 6
Номер удаляемой записи 15
Неверный номер. Удаление невозможно
1. Добавить запись
2. Вывести на п
 ечать одну запись
3. Вывести на печать все записи
4. Наибольший номер квартиры
5. Количество жителей первого этажа
6. Удалить запись
0. Выход
Выбор 2
Номер печатаемой записи 2
ул.Сосновая,4,кв.20,5-й этаж
1. Добавить запись
2. Вывести на печать одну запись
3. Вывести на печать все записи
4. Наибольший номер квартиры
5. Количество жителей первого этажа
6. Удалить запись
0. Выход
Выбор 0
Работа завершена


Ответ отправил: lamed, Профессионал
Ответ отправлен: 03.06.2010, 09:09
Номер ответа: 261836

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

    • Вопрос № 178787:

    Даны текстовый файл, в котором находится прямоугольная матрица. Определить:
    1) Количество столбцов, содержащий хотя бы один нулевой элемент( оформить виде функции)
    2) Номер строки, в которой находится самая длинная серия одинаковых элементов(оформить виде процедуры).
    P.S вывести созданную в файле матрицу на экран.

    Отправлен: 31.05.2010, 20:46
    Вопрос задал: Борис Владимирович Быков, Посетитель
    Всего ответов: 1
    Страница вопроса »

    Отвечает Пупорев Юрий Борисович, Специалист :
    Здравствуйте, Борис Владимирович Быков!
    Код программы в приложении. Создайте в папке с программой несколько текстовых файлов для тестирования, примерно такого содержания
    5 6
    1 3 4 5 5 2
    0 2 2 2 6 8
    4 4 4 4 0 9
    0 2 3 5 6 6
    5 6 7 8 9 0
    в первой строке 2 числа это размеры матрицы
    в файлах сделать матрицы разных размеров, с разной длиной серий(в том числе и с нулевой), с нолями и без нолей.

    Приложение:

    Ответ отправил: Пупорев Юрий Борисович, Специалист
    Ответ отправлен: 31.05.2010, 23:00
    Номер ответа: 261781

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

    • Вопрос № 178789:

    Здравствуйте, уважаемые эксперты!
    Помогите разобраться.. некорректно работает программа бинарного поиска. Текст программы в приложении (у меня нерекурсивная реализация, программа: ABC), также, если возможно подскажите рекурсивный вариант.
    Заранее огромное спасибо!

    Отправлен: 31.05.2010, 21:16
    Вопрос задал: verona, 2-й класс
    Всего ответов: 1
    Страница вопроса »

    Отвечает amnick, Студент :
    Здравствуйте, verona.

    Собственно функция поиска у Вас работает нормально. Но бинарный поиск может быть применен только к упорядоченным данным, а Вы заполняете массив случайными числами. Я изменил процедуру Init для заполнения массива упорядоченными числами и добавил рекурсивную функцию CheckR (см. приложение). Массив передается в функцию как var-параметр — это уменьшает накладные расходы, что особенно важно в случае рекурсии. Функция CheckR возвращает индекс элемента или -1, если элемент не найден, поскольку, как правило, в практических приложениях данные — это некоторые структуры, и с найденным элементом потом что-то делают.

    В Вашей программе мне еще показалось странным объявление

    Type mas=array [1..n*2] of integer;

    Совершенно непонятно умножение верхней границы на 2 — в программе используется только n первых элементов. Поэтому я изменил определение на

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

    Программа проверена в Borland Pascal 7.0. Должна работать и в других реализациях Паскаля.

    Успехов!

    Приложение:

    Ответ отправил: amnick, Студент
    Ответ отправлен: 31.05.2010, 22:02
    Номер ответа: 261779

    Оценка ответа: 5
    Комментарий к оценке:
    Большое спасибо за быстрый и качественный ответ!

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

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

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

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

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

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

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

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