Помощь новичкам

#287

Сделать меню с помощью модуля

  1. (Использовать готовый массив)
  2. (Использовать готовый запись)
  3. (Использовать готовый строка)
  4. (Использовать готовую подрограмму)
  5. Выход.
Unit Pr1;
 
interface
 
procedure sortirovka;
procedure zapis;
procedure stroka;
procedure summa;
 
implementation
 
procedure sortirovka;
var a:array [1..100] of integer;
    k,x,i,j,n:integer;
begin
  read(n);
  for i:=1 to n do begin
                      a[i]:=random(-15,25);
                      write(a[i]:4);
                   end;
   for i:=1 to n-1 do 
                      for j:=i+1 to n do
                                        if a[i]>a[j] then begin
                                                            x:=a[i];
                                                            a[i]:=a[j];
                                                            a[j]:=x;
                                                          end;
  for i:=1 to n do if a[i] mod 3=0 then k:=k+1;
  writeln;
  writeln('Количество элементов кратных 3=',k);
  write('По возрастанию ');
  write('Массив А:');
  for i:=1 to n do write(a[i]:5);
  writeln;
end;
 
procedure zapis;
const m: array[1..6] of string=('Сагаан','Демир-оол','Наксыл','Монгуш','Салчак','Донгак');
      pr:array[1..6] of string=('BMW','Audi','Ford','Toyota','Nissan','Mazda');
type mashina=record
  fam:string[10];
  marka:string[15];
  stazh:integer;
  vozrast:integer;
end;
var mn:array[1..2000] of mashina; 
    i,n,k:integer;
begin
  write('Введите количество машин: '); readln(n);
  for i:=1 to n do 
    with mn[i] do
   
      begin 
        fam:=m[1+random(6)];
        marka:=pr[1+random(6)];
        stazh:=random(30);
        vozrast:=random(28);
      end;
  writeln('Данные о машинах');                        
  writeln('-------------------------------------------------------');
  writeln('№ |Фамилия владельца | марка машины | стаж | возраст ');
  writeln('-------------------------------------------------------');
  for i:=1 to n do 
    with mn[i] do
      writeln(mn[i].fam:15, mn[i].marka:12, mn[i].stazh:14, mn[i].vozrast :9);
      writeln('-------------------------------------------------------');
      write;
    for i:=1 to n do if mn[i].stazh>10 then k:=k+1;
    writeln('самый молодой  k=',k);
    inc(k);
    writeln('Стаж>10');
    writeln('-------------------------------------------------------');
    writeln('№ | Фамилия владельца  | марка машины |  стаж  |  возраст ');
    writeln('-------------------------------------------------------'); 
    for i:=1 to n do
      begin
        if mn[i].stazh>10 then writeln(mn[i].fam:10, mn[i].marka:12, mn[i].stazh:14, mn[i].vozrast :16);
      end;
  writeln('-------------------------------------------------------');
end;   
   
procedure stroka;
var s,s1,s2:string;
Begin
write('Данное  слово: ');
    s:='Обществоведение';writeln(s);
write('Первое  слово: ');    
    s1:=(s[1]+s[2]+s[8]+s[11]) ;writeln(s1);
write('Второе  слово: ');   
    s2:=copy(s,1,8); writeln(s2);
End;
 
procedure summa;
var z,s:real;
function F(a,b:real):real; 
begin
 z:=(a+sqrt(b))/(b+sqrt(a));
 F:=z;
end;
begin
writeln('                        11+_/5   13+_/10   _/19+30 '); 
writeln('вычислить выражение F=  ------ + ------- + -------- ');
writeln('                        5+_/11   10+_/13   _/30+19 ');
writeln;
writeln;
s:=F(15,10)+F(11,5)+F(20,6);
writeln;
writeln('     11+_/5    13+_/10    _/19+30 '); 
writeln(' F= -------- + -------- + --------- = ',s:2:2);
writeln('    5+_/11     10+_/13     _/30+19');
end;
 
initialization 
  writeln('Загружен модуль!');        writeln;
finalization
  writeln;
  writeln('Программа завершена. Нажмите любую клавишу!');
  readln;
end.

Uses Pr1;
var k,r:integer;
begin
    while true do begin writeln;
                          writeln('Menu');
                          writeln('1:Массив');
                          writeln('2:Запись');
                          writeln('3:Строка');
                          writeln('4:Подпрограмма');
                          writeln('5:Выход');
                          read(k);
                      case k of
                      1: sortirovka ;
                      2: zapis;   
                      3: stroka;
                      4: summa;
                      5: Exit;
                      end;
                      end;
                      end.

Проверите код на исполняемость?

#288

Мой (достаточно большой) опыт работы с MS Excel из внешней программы (Visual Basic, Visual FoxPro) показывает, что наиболее эффективная работа получается при следующей схеме:

  • в вызывающей программе создается объект Excel.Application;
  • генерируется программа на Excel VBA и вставляется в проект вызванного приложения;
  • программа (макрос) получает управление и выполняется, делая все необходимое;
  • вызывающая программа удаляет макрос из проекта и закрывает рабочую книгу.

На самом деле, MS Excel - это прекрасный пользовательский интерфейс, к тому же, визуальный) для любого универсального алгоязыка, в том числе, для PascalABC.NET. Удобный структурированный ввод данных, прекрасные возможности по оформлению вывода (хоть графики программно рисуй!).

Сейчас пока не получается, а позднее, раз уж вызвать Excel удалось (спасибо @Sun_Serega), попытаюсь разработать класс для полноценной работы с MS Excel.

Шифрование
#289

Помогите пожалуйста, у меня возникает ошибка System.AccessViolationException как необработанное исключение на строчке if sqrt(sqr(Senter.X - CP1.X) + sqr(Senter.Y - CP1.Y) + sqr(Senter.Z - CP1.Z)) < Data^.CrLvls[lvl].LoadDistanse then, хотя до неё всегда вызывается Data^.CrLvls[lvl].LoadDistanse и все исключения в том потоке обрабатываются и записываются в файл Errors.txt. Левая часть неравенства никак не могла вызвать эту ошибку + ошибка начала возникать как раз после того как я покопался в правой части. Вот Исходники(108,4 КБ). Data тут поинтер на запись, CrLvls массив, а LoadDistanse - функция интерфейса. Ошибка возникает в PData, в Sector.Draw на строчке 146. Сборка 1590.

P.S. Такая ошибка возникает на Shift+F9 режиме, в просто F9 будет создавать файл Errors.txt и писать туда что ссылка на объект не указывает на экземпляр объекта, хотя это не может быть так, вся ссылочная часть строчки используется до этого.

#290

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

Старые указатели обычно можно использовать только в очень простых задачах вообще без управляемой памяти. А лучше не использовать вообще. Не хочу Вас учить, но если попытаться переписать Ваше приложение только с помощью управляемой памяти, то ошибка должна исчезнуть.

#291

А передвигает он её - в смысле сдвигает всю информацию как то так чтоб заполнить освободившийся пробел после удаления чего то? Можете объяснить подробнее? И если я заменю массив на своё подобие массива основанное на указателях это всё исправит? Это конечно костыль но если что лучше держать на будущее такую возможность.

Основной смысл, почему я использовал указатель - доступ к данным о объекте Planet(настройки процедурной генерации) даёт всем объектам Sector. Если использовать функции - это получается криво, по моему, слишком много лишних действий, не такой быстрый доступ, класс имеет удобства как наследование но неэффективно хранит своё содержимое. Ну а если использовать запись без указателя то данные будут копироваться, мне это никак не подходит считая что объектов Sector может быть сотни тысяч на 1 Planet. Вы как я понял предлагаете заменить на класс?

И ещё, это ошибка паскаля, то есть если найти исток то вы исправите?

#292

Это не ошибка Паскаля - это особенности управляемой и неуправляемой памяти.

Да, предлагаю заменить на класс и не использовать обычные указатели, поскольку под .NET они - зло.

#293

Да, все верно, у меня, как опытного программиста и преподавателя, проблем использование EXCEL с другими языками (VFP, VB, VBA, C++, C#, Дельфи, …) пока нет. Проблема пока с PascalABC.NET, так как многим ученикам и студентам вначале обучаю их этим прекрасным языком программирования. База данных для названных языков у меня разработано много, многие разработанные программы и приложения баз данных пользуются в Банках, школах, …

#294

Есть ли альтернатива этому кошмарику с прерыванием из внутреннего цикла с учетом того, что метки и goto ранее были преданы анафеме?

Суть задачи: найти в случайном целочисленном массиве тройку элементов, дающих в сумме ноль.

begin
  var n:=ReadInteger('n=');
  var a:=ArrRandom(n,-50,50); a.Println;
  var m:=n-1;
  var found:=false;
  for var i:=0 to m do begin
    for var j:=0 to m do
      if i=j then continue
      else begin
        for var k:=0 to m do
          if (k=i) or (k=j) then continue
          else
            if a[i]+a[j]+a[k]=0 then begin
              Println('Решение:',a[i],a[j],a[k]);
              found:=true;
              break
              end;
        if found then break
        end;
    if found then break
    end;
  if not found then Writeln('Нет нужной тройки чисел')
end.

Была мысль поставить Exit после Println, но это не конец программы, далее есть еще чем заняться.

#295

ну, нормальный код, чего тут улучшать. флаговые переменные куда лучше меток. и с ними проще отлаживать код.

#296

Да он какой-то “Си-образный” из-за этих брейков повсюду. И да, не сочтите предыдущий пост желанием вернуть метки )))

#297

А что насчёт занести код нахождения результата в процедуру и выходить из неё через exit?

#298

Спасибо, я пытался так сделать, но это была школьная задача из разряда “процедур еще не проходили”. Времени мало было, написал так, как показано выше. А теперь вот ищу решение покрасивее.

#299

Используйте goto.

Вас обманули. Не мучьтесь и используйте goto. Один вместо трёх breakов

  var found:=false;
  for var i:=0 to m do 
  for var j:=i+1 to m do
  for var k:=i+j+1 to m do
    if a[i]+a[j]+a[k]=0 then 
    begin
      found:=true;
      goto 1
    end;
  1: if not found then Writeln('Нет нужной тройки чисел')

А для тех, кто спит и видит функциональные решения, - как-то так:

  var b := a.Numerate;
  var q := b.Cartesian(b).Cartesian(b).Select(t->(t[0][0],t[0][1],t[1]))
    .Where(t->(t[0][0]<t[1][0]) and (t[1][0]<t[2][0]));
  
  Println(q.Where(t->t[0][1]+t[1][1]+t[2][1]=0).FirstOrDefault);

В последнем решении даже индексы можно понаблюдать :slight_smile:

#300

Если правильно помню - как только появляется ключевое слово Label в разделе описаний - прощаемся с лямбдами (их, правда, не тут, но все же…). А может и еще с чем-то надо прощаться? Но с лямбдами - это мне было в свое время отвечено или Вами, или @ibond

P.S. А функциональное решение - это, как говорится, “п-я-я-я-я-я-ть!”

#301

Тогда можно уже и не выходить из цикла, чтоб все такие числа нашло, всё равно быстрее функционального решения будет работать)).

#303

Почему быстрее? Найдёт First и закончит

#304 
label 1;

const
  IC = 10000;

begin
  Randomize(1);
  var a := ArrRandom(1000, -50, 50);//a.Println;
  
  var LT := System.DateTime.Now;
  
  loop IC do
  begin
    var m := a.Length - 1;
    var found := false;
    for var i := 0 to m do 
      for var j := i + 1 to m do
        for var k := i + j + 1 to m do
          if a[i] + a[j] + a[k] = 0 then 
          begin
            found := true;
            goto 1
          end;
    1: if not found then;// Writeln('Нет нужной тройки чисел');
  end;
  
  writeln(System.DateTime.Now - LT);
  readln;
  
end.

const
  IC = 10000;

begin
  Randomize(1);
  var a := ArrRandom(1000, -50, 50);//a.Println;
  
  var LT := System.DateTime.Now;
  
  loop IC do
  begin
    var b := a.Numerate;
    var q := b.Cartesian(b).Cartesian(b).Select(t -> (t[0][0], t[0][1], t[1]))
      .Where(t -> (t[0][0] < t[1][0]) and (t[1][0] < t[2][0]));
    
    q.Where(t -> t[0][1] + t[1][1] + t[2][1] = 0).FirstOrDefault;
  end;
  
  writeln(System.DateTime.Now - LT);
  readln;
  
end.

Разница 95 раз, и совсем не в пользу функционального программирования. В этот раз я запускал по Shift+F9 выключая дебаг в настройках компиляции. И я продолжаю считать что sequence всегда будет работать медленнее, хотя был бы рад если бы вы меня переубедили. Повторюсь, в каких случаях sequence работает быстрее чем без него? Есть ли они вообще? Удобства я не отрицаю и пользуюсь ими в случаях когда скорость не имеет значения, но вы вроде утверждали что у sequence есть собственные случаи где они эффективнее.

#305

Так и я говорю - с goto самое лучшее решение :slight_smile: В 95 раз - это вообще кошмар! Почти как Python!

#306

А по моему вы сказали на оборот…

И всё же

#307

Цикл всегда быстрее. Я имел в виду, что функциональное решение здесь тоже по “break” как бы выходит - не считает всё до конца если нашло. В этом смысле цикл без break на больших данных должен работать медленнее.