работа со списками Паскаль - лабы на Паскале - Файлы - Помощь студенту
Помощь студентуФайлылабы на Паскалеработа со списками Паскаль
24 Марта 2017, Пятница
05:06
>>> Качественная веб-разработка <<<
05:06
Меню сайта
>Г Л А В Н А Я

>Ф А Й Л Ы

>С Т А Т Ь И

>Р Е Ф Е Р А Т Ы

>Ф О Р У М

>О Т З Ы В Ы

>Т Е С Т Ы

>F l a s h И Г Р Ы

>Ф О Т О Ш О П


Советуем...
Последовательности с++
Вводится последовательность из N положительных целых чисел. Найти наименьшее число среди четных элементов последовательности.

Шпора по матану
 Шпора по матану Пределы, Интегралы, Ряды, графики функциий. Почти весь материал мат. анализа.

ИЗУЧЕНИЕ ЗАКОНОВ ВРАЩАТЕЛЬНОГО ДВИЖЕНИЯ (маятник Обербека)
ИЗУЧЕНИЕ ЗАКОНОВ ВРАЩАТЕЛЬНОГО ДВИЖЕНИЯ
1. Цель работы: изучение законов динамики вращательного движения, проверка теоремы Гюйгенса-Штайнера, оценка влияния трения на точность результатов проведенных измерений.
2. Перечень приборов и принадлежностей: Лабораторная установка «маятник Обербека», набор грузов (массы грузов и погрешности их определения указаны на грузах), электронный секундомер (в составе установки).
3. Материал для изучения:Уравнение динамики вращательного движения. Момент инерции. Сила трения. Оценка погрешностей измерений.

Алгоритмы сжатия RLE, LZW и Хаффмана
В архиве находятся готовые лабораторные работы по алгоритмам сжатия RLE (Групповое кодирование - Run Length Encoding), LZW (lempe, Ziv, Welch) и Хаффмана (Huffman). Сделано на Паскале с комментариями.


Опрос
Зацените дизайн сайта
Всего ответов: 372

Сотрудничество
Поставьте себе на сайт и сообщите мне


код кнопки:


Связь с админом
395799449
Написать админу
Оставить отзыв


Файлы
Главная » Файлы » Учебные материалы » лабы на Паскале

работа со списками Паскаль

Название: работа со списками Паскаль
Категория: лабы на Паскале
Формат файла: *.pas
Размер: 2.8Kb
Просмотров: 4354
Загрузок: 1095

Дата добавления: 01 Июня 2009, 12:23
Теги:преобразовать, информатика, программирование, списки, процедуры, Паскаль, ФУНКЦИИ, ссылка, готовые лабы, индексы
Поделиться:
Скачать:

Скачать работа со списками Паскаль бесплатно и без регистрации


Внимание! Если ссылка не работает, файл не найден или просто возникают какие-либо вопросы, напишите об этом, пожалуйста, мне на почту: xdypx@yandex.ru. В письме достаточно указать ссылку на эту страницу и описание проблемы или свой вопрос.


Описание:
Задание:



Дан
текстовый файл с изображением целых чисел, которые необходимо переписать в
список L1. Удалить
из списка все числа – палиндромы, вставив вместо них
самое минимальное число всего списка.­



Пример:

исходный список:'127 12321 67897 45654 10001 17 9856 93456 767 984'

преобразованный
в список: '127 17 67897 17 17 9856 93456 17 984'.

Исходный код:
Program spiski;
uses crt;
Type
TElement=^element;
 Element=record
 a:string;
 next:TElement;
End;

var Q,last,head:TElement; m,j,c:integer; mas:string[11];

function polindrom(sl:string):boolean;
var cl:string; i,j:integer; b:boolean;
Begin
  polindrom:=false;
  b:=true;
  j:=1; i:=length(sl);
  while (j<i) and b do
   Begin
    if sl[i]<>sl[j] then b:=false;
    j:=j+1;
    i:=i-1;
   End;
   polindrom:=b;
End;

procedure proverka(filename:string);
var f:text;
Begin
 {$I-}
  Assign(f,filename);
  reset(f);
 {$I+}
  if ioresult<>0 then Begin textcolor(204); writeln('ERROR FILE!!!'); readln; halt; End
  else writeln('fail "',filename,'" otkrit');
End;

procedure printfile(filename:string);
var f:text;
    a:string; b:integer;
 Begin
 Assign(f,filename);
 reset(f);
 while not eof(f) do
  Begin
   readln(f,a);
   writeln(a);
  End;
 close(f);
End;

{====sozdanie spiska====}

procedure createhead(var head,last:TElement);
Begin
 new(head);
 head^.next:=nil;
 last:=head;
End;

{====zapolnenie spiska=====}

Procedure add(var last:TElement; k:string);
var Q:TElement;
Begin
  new(Q);
   Q^.a:=k;
   Q^.next:=nil;
   last^.next:=Q;
   Last:=Q;
 End;

{====vivod na ekran spiska====}

procedure print(head:TElement);
var Q:TElement;  l:integer;
Begin
 Q:=head^.next;
 while Q<>nil do
  Begin
  if polindrom(Q^.a)=true then Begin textcolor(5); write(Q^.a,'-->'); End else Begin textcolor(9); write(Q^.a,'-->'); End;
   Q:=Q^.next;
  End;
 writeln;
End;

{====vipoln9Iet...====}

procedure transfer(head:TElement; filename:string);
var Q:TElement; F:text; st,sl:string; l:integer;

Begin
 new(Q);
 Assign(f,filename);
 reset(f);
 st:='';
 sl:='';
 Q:=head^.next;
 while not eof(f) do
  Begin
   readln(f,st);
    for l:=1 to length(st) do
     Begin
      if st[l]<>' ' then sl:=sl+st[l] else
       Begin
        Add(last,sl);
        sl:='';
       End;
     End;
  End;
close(F);
End;

procedure poisk(head:TElement);
 var Q:TElement; sl:string; b,code,min:integer;
Begin
{poisk minimalnogo}
 Q:=head^.next;
 sl:=Q^.a;
 val(sl,b,code);
 min:=b;
 Q:=Q^.next;
  while Q^.next<>nil do
  Begin
   sl:=Q^.a;
   val(sl,b,code);
   if b<min then min:=b;
   Q:=Q^.next;
  End;
 writeln('min= ',min);
 Str(min,sl);
 
 {zamena polindromov}
 Q:=head^.next;
 while Q<>nil do
  Begin
   if polindrom(Q^.a)=true then Q^.a:=sl;
   Q:=Q^.next;
  End;
 
End;

BEGIN
clrscr;


textBackground(14);
textcolor(210);
proverka('g:\in.txt');
textBackground(0);
textcolor(12);
writeln('vivod faila: ');
textcolor(14);
printfile('g:\in.txt');
createhead(head,last);
transfer(head,'g:\in.txt');
textcolor(12);
writeln('vivod spiska: ');
print(head);
poisk(head);
textcolor(12);
writeln('vivod izmenennogo spiska: ');
textcolor(1);
print(head);
writeln;
readln;
END.

Комментарии:
Всего комментариев: 0
Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Разделы новостей
Образование [4]
лабы на Паскале [11]
Шпоры [10]
Учебники [19]
Лабы по физике [3]
Лабы по С++ [7]

Статистика

Яндекс.Метрика


Онлайн всего: 1
Гостей: 1
Пользователей: 0

Все пользователи

Яндекс цитирования Rambler's Top100 Каталог сайтов OpenLinks.RU Каталог сайтов iLinks.RU Каталог сайтов :: Развлекательный портал iTotal.RU Каталог сайтов Bi0 Каталог сайтов Всего.RU