Указатели. Pascal.

[Heming]

Вообщем, я знаю, что заливать условие без попыток решения это моветон, но по обьективным причинам, сесть за решение и ознакомление с теор. частью я смогу не раньше 00:00, вдруг у кого-то уже есть решение подобной задачи, или захочет предложить рациональный подход, это было б супер, обещаю в где-то в часик залить свое решение+вопросы если появятся проблемы, а без них редко обходится.

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

2) Набор латинских слов задано односвязным списком. Описать процедуру, которая упорядочивает элементы списка в порядке алфавита. Массив не создавать.

[googl]

Списки. Есть книга. Очень хорошая. Там с задачами и примерами решений. Автор Окулов. В свое время мне очень помогла. Называется вроде "Программирование в алгоритмах". Про списки там очень хорошо написано

[ViktorR]

Так понимаю, что к спискам первая задача отношения точно не имеет.
Рандомный массив указателей - это как?
Предположил бы следующий вариант:
Есть некоторый массив действительных чисел, пусть даже и двумерный.
Есть другой массив, в котором каждый элемент - указатель.
Инициируем этот массив присваивая его элементам указатель на некоторый элемент исходного массива с действительными числами.
Это подготовка к задаче. И далее.
Просматриваем массив указателей и ищем равные числа в исходном массиве. Например, берём указатель из первого элемента и сравниваем число, на которое он ссылается, с другими числами исходного массива, через соответствующие указатели.
Если находим равное число, то заменяем старый указатель на это число, на тот, который используется для сравнения (указывает на первое число).
Например:

const n = 100;
Type mas = array[1..n] of real;
       pmas = array[1..n] of ^real;
       
var a : mas;
     pa : pmas;
     i, j : integer;
     r : real;
begin
{инициируем исходные данные}
   randomize;
   for i := 1 to n do begin
      pa[i] := adr(a[i]);
      a[i] := rand(100.0)-50.0;
   end;
   for j := 1 to n -1 do
       for i := 2 to n do
         if pa^[i] = pa^[j] then
            pa[i] := pa[j];
end.

Почему-то кажется, что должно быть как то так ...

[Heming]

Program Lab_11_part1;
const maxcount=20;
type mas=array[1..maxcount] of real;
     pmas=array[1..maxcount] of ^real;

var
a:mas;pa:pmas;i,j:integer;
begin
randomize;
for i:=1 to maxcount do begin
pa[i]:=@a[i];
a[i]:=random(20);
end;
for i:=1 to maxcount do
writeln(pa[i]);
for i:=1 to maxcount-1 do
for j:=2 to maxcount do
begin
if pa^[i]=pa^[j] then begin
pa[i]:=pa[j];
end;
for i:=1 to maxcount do
writeln(p[i]);
end.

Почему мне выдает сообщение, что pa^[i] не является указателем?

[Serge_Bliznykov]

Почему мне выдает сообщение, что pa^[i] не является указателем?

правильно выдаёт.
указателем является ЭЛЕМЕНТ массива.
т.е. вам нужно писать pa[i]^


а ещё и мой Турбо Паскаль и Delphi категорически отказался выдавать адрес массива через

writeln(pa[i]);

говорят нельзя выводить переменную такого типа: Illegal type in Write/Writeln statement
А Ваш Паскаль это "скушал"? и если да - то Вы каким Паскалем пользуетесь?

Кстати, а смысл этого какой? Что Вы хотите получить на экране?



а основной цикл я бы рекомендовал записать так:

for i:=1 to maxcount-1 do
  for j:=i+1 to maxcount do
    begin
      if pa[i]^=pa[j]^ then
         pa[j]:=pa[i];
    end;

[Heming]

ABC выводит адреса,но там не в этом суть
цель задания показатели, которые ссылаются на равные числа, ссылать первому указатели с этим числом.
т.е. я хочу показать,каким массив указателей был до и после изменений.

Вот вторая задача, помоги найти ошибку, работает не коректно:

Program Lab11_p2;
uses crt;
type
ptr=^Item;
Item=record
 data:string; {³íôîðì.ïîëå}
 next:ptr; {âêàç³âíèê íà íàñòóïíèé åëåìåíò}
end;
var head:ptr;
newptr,current,previous:ptr;
ch:char;
str:string;
flag:boolean;
{-----------ñòâîðåííÿ îäíîåëåìåíòîãî ñïèñêó------}
procedure CreateFirstItem;
begin
head:=newptr;{âêàç³âíèê íà âåðøèíó ñïèñêó ïåðåì³ñòèòè íà ïåðøèé åëåìåíò}
head^.next:=nil;
end;
{----------------âñòàâêà åëåìåíòà íà ïî÷àòîê ñïèñêó----}
procedure IsertInbeginning;
begin
newptr^.next:=head;{çâÿçîê íîâîãî åëåìåíòó ç âåðøèíîá}
head:=newptr;{ïåðåì³ñòèòè âåðøèíó ñïèñêó íà åëåìåíò,ùî äîäàºòüñÿ}
end;
{--------------ïîøóê ïîçèö³¿ âñòàâêè--------}
procedure SearchPlaceInsert;
begin
 current:=head;
 repeat
 previous:=current;
 current:=current^.next;
 if current=nil then{ÿêùî ê³íåöü ñïèñêó}
 flag:=true else
 flag:=current^.data>=str;{îçíàêà ïðîäîâæåííÿ}
 until flag;
 end;
{------------------âñòàâêà åëåìåíòà â ñåðåäèíó ñïèñêà-----}
procedure InsertIntoMiddle;
begin
  previous^.next:=newptr; {çâ'ÿçîê ïîïåðåäíüîãî ³ íîâîãî åëåìåíò³â}
  newptr^.next:=current; {çâ'ÿçîê íîâîãî ³ íàñòóïíîãî åëåìíò³â}
 end;
 {----------äîäàâàííÿ ñëîâà äî ñïèñêó-----------}
 procedure insert;
 begin
 write('input element: ');
 readln(str);
 new(newptr);
 newptr^.data:=str;
 if head=nil then CreateFirstItem
 else  if str<=head^.data
 then IsertInBeginning
 else
 begin
 SearchPlaceInsert;
 InsertIntoMiddle;
 end;
end;
 {--------------------âèäàëåííÿ ïåðøîãî åëåìåíòà ñïèñêó------}
 procedure DelFirst;
 begin
 head:=current^.next;
 dispose(current);
 end;
 {-------------ïîøóê åëåìåíòà äëÿ âèäàëåííÿ------}
 function SearchPlaceDelete:boolean;
 begin
  repeat
   previous:=current;
   current:=current^.next;
   until (current^.data=str) or (current^.next=nil);
   SearchPlaceDelete:=current^.data=str;
 end;
 {----------- âèäàëåííÿ åëåìåíòà ç ñåðåäèíè ñïèñêó----}
 procedure DelMiddle;
 begin
  previous^.next:=current^.next;
  dispose(current);
 end;
 {---------------âèäàëåííÿ ñëîâà ç³ ñïèñêó----------}
 procedure delete;
 begin
  if head=nil then
   begin
    writeln('List is empty. Press Enter...');
    readln;
   end
  else
   begin
    write('inpute value:');
    readln(str);
    current:=head;
    if current^.data=str
     then DelFirst
    else
     if SearchPlaceDelete
      then DelMiddle
     else
      begin
       write(str,' not found in list.');
       writeln('Press ENTER...');
       readln;
       end;
     end;
  end;
 {--------------âèâåäåííÿ ñïèñêó---------------}
 procedure outlist;
 begin
  current:=head;
  if current=nil then
   writeln('List is empty')
   else
    begin
     writeln('output list:');
      repeat
       write(current^.data,' ');
       current:=current^.next;
      until current=nil
     end;
    writeln;
 end;
 {------------main body------------}
begin
head:=nil;
clrscr;
repeat
 outlist;
  writeln('enter command:i- input d-delete q-quit');
 ch:=readkey;
 case ch of
 'i':insert;
 'd':delete;
 end;
 until ch='q';
 end.

На комменты квакозябры не обращайте внимание


Вроде прога работает правильно, но выдает в диалоговое окно лишние дублирование сообщания, а порой я не успеваю еще ввести команду, как оно само решает какую команду я ввел, вроде сколько не проверяю, все равно не могу найти ошибки.

[Serge_Bliznykov]

во-первых, я бы записал основное тело программы так:

 {------------main body------------}
begin
  head := nil;
  clrscr;
  repeat
    outlist;

  {очистим буфер клавиатуры}
    while KeyPressed do ch := readkey;

    writeln('enter command:i- input d-delete q-quit');
    repeat
      ch := readkey;
      if ch = #0 then readkey;
      case ch of
        'i': insert;
        'd': delete;
      end;
    until ch in ['i', 'd', 'q'];
  until ch = 'q';
  WriteLn('Good bye!');
end.

а во-вторых, исключительно для красоты я бы добавил в начало процедур insert и delete выдачу сообщения, в какой мы, собственно процедуре находимся..
ну, например, так:

procedure insert;
begin
  WriteLn('* Insert new element mode *');
  WriteLn('---------------------------');
  write('input element: ');
.....

procedure delete;
begin
  WriteLn('* Delete element mode *');
  WriteLn('---------------------------');
  if head = nil then
.....

в третьих, после любого действия у Вас стоит в цикле выдача списка (вызов процедуры outlist). Так вот, я бы добавил ещё одну команду в меню, например, s - show list
и вызывал её
's' : outlist;
а в начале цикла выкинул бы вызов..

[Heming]

Program Lab11_p2;
uses crt;
type
ptr=^Item;
Item=record
 data:string; {³íôîðì.ïîëå}
 next:ptr; {âêàç³âíèê íà íàñòóïíèé åëåìåíò}
end;
var head:ptr;
newptr,current,previous:ptr;
ch:char;
str:string;
flag:boolean;
{-----------ñòâîðåííÿ îäíîåëåìåíòîãî ñïèñêó------}
procedure CreateFirstItem;
begin
head:=newptr;{âêàç³âíèê íà âåðøèíó ñïèñêó ïåðåì³ñòèòè íà ïåðøèé åëåìåíò}
head^.next:=nil;
end;
{----------------âñòàâêà åëåìåíòà íà ïî÷àòîê ñïèñêó----}
procedure IsertInbeginning;
begin
newptr^.next:=head;{çâÿçîê íîâîãî åëåìåíòó ç âåðøèíîá}
head:=newptr;{ïåðåì³ñòèòè âåðøèíó ñïèñêó íà åëåìåíò,ùî äîäàºòüñÿ}
end;
{--------------ïîøóê ïîçèö³¿ âñòàâêè--------}
procedure SearchPlaceInsert;
begin
 current:=head;
 repeat
 previous:=current;
 current:=current^.next;
 if current=nil then{ÿêùî ê³íåöü ñïèñêó}
 flag:=true else
 flag:=current^.data>=str;{îçíàêà ïðîäîâæåííÿ}
 until flag;
 end;
{------------------âñòàâêà åëåìåíòà â ñåðåäèíó ñïèñêà-----}
procedure InsertIntoMiddle;
begin
  previous^.next:=newptr; {çâ'ÿçîê ïîïåðåäíüîãî ³ íîâîãî åëåìåíò³â}
  newptr^.next:=current; {çâ'ÿçîê íîâîãî ³ íàñòóïíîãî åëåìíò³â}
 end;
 {----------äîäàâàííÿ ñëîâà äî ñïèñêó-----------}
 procedure insert;
 begin
 WriteLn('* Insert new element mode *');
 WriteLn('---------------------------');
 write('input element: ');
 readln(str);
 new(newptr);
 newptr^.data:=str;
 if head=nil then CreateFirstItem
 else  if str<=head^.data
 then IsertInBeginning
 else
 begin
 SearchPlaceInsert;
 InsertIntoMiddle;
 end;
end;
 {--------------------âèäàëåííÿ ïåðøîãî åëåìåíòà ñïèñêó------}
 procedure DelFirst;
 begin
 head:=current^.next;
 dispose(current);
 end;
 {-------------ïîøóê åëåìåíòà äëÿ âèäàëåííÿ------}
 function SearchPlaceDelete:boolean;
 begin
  repeat
   previous:=current;
   current:=current^.next;
   until (current^.data=str) or (current^.next=nil);
   SearchPlaceDelete:=current^.data=str;
 end;
 {----------- âèäàëåííÿ åëåìåíòà ç ñåðåäèíè ñïèñêó----}
 procedure DelMiddle;
 begin
  previous^.next:=current^.next;
  dispose(current);
 end;
 {---------------âèäàëåííÿ ñëîâà ç³ ñïèñêó----------}
 procedure delete;
 begin
 WriteLn('* Delete element mode *');
 WriteLn('---------------------------');
  if head=nil then
   begin
    writeln('List is empty. Press Enter...');
    readln;
   end
  else
   begin
    write('inpute value:');
    readln(str);
    current:=head;
    if current^.data=str
     then DelFirst
    else
     if SearchPlaceDelete
      then DelMiddle
     else
      begin
       write(str,' not found in list.');
       writeln('Press ENTER...');
       readln;
       end;
     end;
  end;
 {--------------âèâåäåííÿ ñïèñêó---------------}
 procedure outlist;
 begin
  current:=head;
  if current=nil then
   writeln('List is empty')
   else
    begin
     writeln('output list:');
      repeat
       write(current^.data,' ');
       current:=current^.next;
      until current=nil
     end;
    writeln;
 end;
 {------------main body------------}
begin
head:=nil;
clrscr;
repeat
 outlist;
 while keypressed do ch:=readkey;
  writeln('enter command:i- input d-delete q-quit');
 ch:=readkey;
 if ch=#0 then readkey;
 case ch of
 'i':insert;
 'd':delete;
 end;
 until ch='q';
 Writeln('The end!');
 end.

Рабочий код, если кому-то пригодится(читайте в ABC и увидите комменты), Сергей, спасибо большое за помощь.

Первый код тоже правильный, в ABC паскале выводятся адреса(сегмент-смещение) на экран и можно убедится, что таки да адреса у указателей ссылающихся на одинаковые числа будут присвоены первому указателю с таким значением, пропишите только вывод еще адресов отдельно.

[Serge_Bliznykov]

while keypressed do ch:=readkey;

пока ЕстьВБуфереНажатыеКлавиши do ЧитаемКодКлавиш (в переменную ch )

так понятнее?
Кстати, в данном случае переменную ch можно смело опустить и просто читать коды клавиш (никуда их не сохраняя).
например, так:

while keypressed do readkey;

цель этой строчки кода обеспечить к моменту ввода команды ПУСТОЙ буфер клавиатуры.

[Heming]

Да все стало на свои места, когда я почитал про модуль crt, но за ваш ответ тоже спс.