Страница 1 из 4 1234 ПоследняяПоследняя
Показано с 1 по 15 из 59

Тема: Pascal. Решение задач

  1. #1
    Участник
      Народный модератор раздела "Человек и Общество" 2008, Лучший модератор раздела "Человек и Общество" 2009
    Аватар для Jaratar
    Регистрация
    14.08.2006
    Адрес
    Россия
    Сообщений
    485
    Спасибо
    я - 49; мне - 55

    Стрела Pascal. Решение задач

    Дорогие участники! В этой теме вы можете попросить помощи в решении задач и в написании программ на языке программирования Pascal.

    Кстати говоря, если вы уже частично решили задачу, или у вас есть какой-то свой вариант, при котором, правда, происходит ошибка, то будет очень хорошо, если вы приведёте здесь свой текст программы. Возможно, что тогда будет достаточно всего лишь найти и устранить какой-то изъян, и это займёт намного меньше времени.

    А если вам не надо решать задачи, но вы хотите задать вопрос по языку, компиляторам, справочным руководствам - вы можете сделать это в теме Pascal.
    If there were no clouds, we should not enjoy the Sun

  2. #2
    Группа удаления Аватар для Sherry
    Регистрация
    27.09.2003
    Сообщений
    222
    Спасибо
    я - 5; мне - 3

    Стрела

    Еще такой вопрос.
    Даны два упорядоченных массива целых чисел М1 и М2. Слить их в один упорядоченный массив. Рассмотреть случаи, когда массивы М1 и М2 упорядочены одинаково и когда по-разному.
    Заранее благодарна.

  3. #3
    Музыкант
      Вице-Мистер форума весна 2004
    Аватар для Xermit
    Регистрация
    12.07.2003
    Адрес
    BASIN CITY
    Сообщений
    623
    Спасибо
    я - 0; мне - 0
    Sherry, вот тебе мой вариант задачи, не исключено, что не самый рациональный, как в прошлый раз, но работает.=)

    Код:
    Program XYZ;
    
    Var
       m1, m2, a: array [1..100] of integer;
       i, j, k, h, q, n1, n2: integer;
    
    Begin
       Read(n1);
       For i:=1 to n1 do Read(m1[i]);
       Writeln;
       Read(n2);
       for i:=1 to n2 do Read(m2[i]);
       Writeln;
       if m1[1]>m1[n1] then
        for i:=1 to (n1 div 2) do
         begin
          q:=m1[i];
          m1[i]:=m1[n1+1-i];
          m1[n1+1-i]:=q;
         end;
       if m2[1]>m2[n2] then
        for i:=1 to (n2 div 2) do
         begin
          q:=m2[i];
          m2[i]:=m2[n2+1-i];
          m2[n2+1-i]:=q;
         end;
    
        j:=1;
        k:=1;
        h:=1;
        while (j<=n1) and (k<=n2) do
         begin
          if m1[j]<m2[k] then
           begin
            a[h]:=m1[j];
            j:=j+1;
           end else
           begin
            a[h]:=m2[k];
            k:=k+1;
           end;
          h:=h+1;
          if j>n1 then q:=1;
          if k>n2 then q:=2;
         end;
     
        if q=1 then
         for i:=k to n2 do
          begin
           a[h]:=m2[i];
           h:=h+1;
          end;
        if q=2 then
         for i:=j to n1 do
          begin
           a[h]:=m1[i];
           h:=h+1;
          end;
       for i:=1 to h-1 do Write(a[i],' ');
      End.
    Turn the right corner in Sin City and you can find anything... anything.

  4. #4
    kipelovets
    Гость
    Вот мое решение. Довольно рационально по скорости, нерациональное по памяти и достаточно запутанное...

    Код:
    program Project2;
    var
      i,j,k,n,m,di,dj: Integer;
      a,b,c: array[0..999] of Integer;
      x,y: boolean;
    begin
      // Ввод...
      Read(n);
      for i:=0 to n-1 do
        Read(a[i]);
      Read(m);
      for i:=0 to m-1 do
        Read(b[i]);
    
      // В зависимости от направления упорядоченности массивов _
      // устанавливаем начальные значения счетчиков и приращения
      if (n>1) and (a[1]>a[0]) then
      begin
        i:=0;
        di:=1;
      end
      else
      begin
        i:=n-1;
        di:=-1;
      end;
    
      if (m>1) and (b[1]>b[0]) then
      begin
        j:=0;
        dj:=1;
      end
      else
      begin
        j:=m-1;
        dj:=-1;
      end;
    
      // ну а теперь большой цикл, в котором все и происходит...
      k:=0; // счетчик для нового массива
      x:=true; // флаг, что у нас массивы не кончились
      while x do
      begin
        y:=true; // По умолчанию копируем из массива "а"
        if (i>=0) and (i<n) then
        begin
          if (j>=0) and (j<m) then
          begin
            if a[i]>b[j] then
              y:=false; // Если не кончились оба массива и a[i]>b[j], то копируем из массива "b"
          end
        end
        else
        begin
          if (j>=0) and (j<m) then
            y:=false
          else
            x:=false; // Если оба массива кончились - завершаем цикл
        end;
        if x then
        begin
          if y then
          begin
            c[k]:=a[i];
            i:=i+di;
          end
          else
          begin
            c[k]:=b[j];
            j:=j+dj;
          end;
        end;
        Inc(k);
      end;
    
      // Вывод...
      for i:=0 to m+n-1 do
        Write(c[i],' ');
    end.
    я уже не уверен, что это работает, я писал в дельфи и с файловых IO, потом переписывал...

  5. #5
    Музыкант
      Вице-Мистер форума весна 2004
    Аватар для Xermit
    Регистрация
    12.07.2003
    Адрес
    BASIN CITY
    Сообщений
    623
    Спасибо
    я - 0; мне - 0
    Sherry, я уж испугался.))
    Проверил, она работает, может ты что-нибудь не то вводишь?
    Сначала ты должна ввести количество элементов массива M1, потом все его элементы, затем количество элементов массива M2, и после тоже все его элементы. Попробуй еще раз. Да и вариант kipelovets тоже работает, только комментарии исправь (или удали).

    И еще, если массивы упорядочены по-разному, или по убыванию, то программа все равно выведет по возрастанию.
    Turn the right corner in Sin City and you can find anything... anything.

  6. #6
    Группа удаления Аватар для Sherry
    Регистрация
    27.09.2003
    Сообщений
    222
    Спасибо
    я - 5; мне - 3
    Можно пример?

  7. #7
    Музыкант
      Вице-Мистер форума весна 2004
    Аватар для Xermit
    Регистрация
    12.07.2003
    Адрес
    BASIN CITY
    Сообщений
    623
    Спасибо
    я - 0; мне - 0
    Входные данные:
    1 1
    2 3 2
    Выходные данные:
    1 2 3
    Turn the right corner in Sin City and you can find anything... anything.

  8. #8
    Старожил Аватар для Шогал
    Регистрация
    05.10.2002
    Адрес
    Калининград
    Сообщений
    761
    Спасибо
    я - 0; мне - 1
    Млин, это же обыкновенная подзадача MergeSort'а...

    Самый простой способ слить массивы a и b в c. Параметры n1 и n2 - размеры массивов a и b. Массивы нумеруются с нуля (но легко переделать чтобы нумеровались с единицы).
    Код:
    procedure mergearr(var a, b, c : your_array_type; n1, n2 : integer);
    var i, i1, i2 : integer;
    begin
      i := 0; {текущий элемент общего массива}
      i1 := 0; {текущий элемент первого массива}
      i2 := 0; {текущий элемент втрого массива}
      while((i1 < n1) and (i2 < n2)) do begin {итерируем пока один из массивов не кончится}
        if(a[i1] < b[i2]) then begin {если в a элемент меньше чем в b}
          c[i] := a[i1];
          inc(i1);
        end else begin
          c[i] := b[i2];
          inc(i2);
        end;
        inc(i);
      end;
      if i1 = n1 then {если кончился первый массив}
        move(b[i2], c[i], (n2-i2)*sizeof(your_array_element)) {перемещаем остаток второго массива в c}
      else
        move(a[i1], c[i], (n1-i1)*sizeof(your_array_element));
    end;
    По-моему, еще проще чем этот алгоритм написать уже невозможно...

    А когда какой-нибудь массив упорядочен по-убыванию - просто инвертируй его перед вызовом процедуры
    Смерть - это наше спасение

  9. #9
    Tashik
    Гость
    Чет здесь давно никто не бывал, Ну может мне все таки кто то поможет!( до завтра) Нужно составить программу вычесляющая сумму нечетных чисел. Я сделала эту программу через оператор с предпроверкой. Но нужно еще и через счетный. Помогите.

  10. #10
    Администратор, Консультант по математике
      За вклад в развитие форума 2006, Лучший знаток физики 2007, Самый активный автор месяца. Август 2007, Лучший консультант 2007, Лучший супермодератор 2007, Народный модератор раздела "Наука и Образование" 2008, Лучший супермодератор 2008, Лучший консультант 2008
    Аватар для Trotil
    Регистрация
    15.12.2005
    Адрес
    град Москва
    Сообщений
    5,890
    Записей в блоге
    26
    Спасибо
    я - 57; мне - 380
    1) Покажи свое решение
    Ленивый дурак - это полбеды; деятельный дурак - это для всех головная боль, но нет ничего хуже, чем дурак с инициативой, да ещё и при должности.

  11. #11
    Tashik
    Гость
    Сейчас уже точно не вспомню но помоему вот так
    program probA;
    var i,n,s:integer;
    begin;
    writeln('программа вычесл.......');
    writeln('задайте n');
    readln(n);
    s:=0; i:=1;
    while i<=n do
    begin;
    s:=s+1;
    i:=i+2;
    end;
    end.

  12. #12
    Администратор, Консультант по математике
      За вклад в развитие форума 2006, Лучший знаток физики 2007, Самый активный автор месяца. Август 2007, Лучший консультант 2007, Лучший супермодератор 2007, Народный модератор раздела "Наука и Образование" 2008, Лучший супермодератор 2008, Лучший консультант 2008
    Аватар для Trotil
    Регистрация
    15.12.2005
    Адрес
    град Москва
    Сообщений
    5,890
    Записей в блоге
    26
    Спасибо
    я - 57; мне - 380
    n - число нечетных чисел
    s:=0;
    for i:=1 to n do s:=s+(2*i+1);
    Ленивый дурак - это полбеды; деятельный дурак - это для всех головная боль, но нет ничего хуже, чем дурак с инициативой, да ещё и при должности.

  13. #13
    Постоялец Аватар для Velgelmina
    Регистрация
    14.05.2007
    Сообщений
    82
    Спасибо
    я - 19; мне - 3

    Работа с файлами в Pascal

    Прошу помощи и совета.
    Не могу правильно написать программу.
    условие задачи:
    1.создать файл содержащий сведенья о сдачи студентами сессии. структура записи: индекс группы,фамилия студента,оценки по 3 экзаменам.
    2.определить неуспевающих студентов. средний балл группы.

    первую программу он выполняет, но во второй пишет ошибку fail not opened
    не могу понять почему он не открывает файл.
    если можете то напишите свой вариант программы или укажите на возможные ошибки.
    понимаю, что нагло, но первый вариант был бы предпочтительней.

  14. #14
    Администратор, Консультант по математике
      За вклад в развитие форума 2006, Лучший знаток физики 2007, Самый активный автор месяца. Август 2007, Лучший консультант 2007, Лучший супермодератор 2007, Народный модератор раздела "Наука и Образование" 2008, Лучший супермодератор 2008, Лучший консультант 2008
    Аватар для Trotil
    Регистрация
    15.12.2005
    Адрес
    град Москва
    Сообщений
    5,890
    Записей в блоге
    26
    Спасибо
    я - 57; мне - 380
    Velgelmina
    А код неправильный привести? Просто у меня среды исполнения нет, а по коду смогу что-нибудь подправить или подсказать..

    Код оформлять тегом [code]
    Ленивый дурак - это полбеды; деятельный дурак - это для всех головная боль, но нет ничего хуже, чем дурак с инициативой, да ещё и при должности.

  15. #15
    Постоялец Аватар для Velgelmina
    Регистрация
    14.05.2007
    Сообщений
    82
    Спасибо
    я - 19; мне - 3
    если вдруг неправильно оформлю, заранее извините:
    Код:
    Program fail; uses crt;
    type student=record
    index:string;
    fam:string;
    ysp:array[1..3] of integer;
    end;
    var f:file of student;
    a:student;
    i:byte;
    j:byte;
    begin
    clrscr;
    assign (f,'d:\student.txt');
    rewrite (f);
    for i:=1 to 3 do begin
    writeln ('vvedite familiy');
    readln (a.fam);
    writeln ('vvedite gruppy');
    readln (a.index);
    writeln ('vvedite ocenki po trem ekzamenam:');
    for j:=1 to 3 do begin
    readln (a.ysp[j]);
    write (f,a);
    end;
    end;
    close(f);
    end.
    это текст первой программы. ее он выполняет.
    сейчас напишу вторую.

    вот вторая часть:
    Код:
    Program fail2; uses crt;
    type student=record
    fam:string;
    index:string;
    ysp:array [1..3] of integer;
    end;
    var f:file of student;
    a:student;sr:real;
    S:integer;
    i:byte;
    m:integer;
    begin
    clrscr;
    assign(f,'d:\student.txt');
    reset(f);
    while not eof(f) do begin read (f,a);
    if a.ysp[i]=3 then write (a.fam);
    m:=m+1;
    S:=S+i;
    sr:=S/m;
    writeln ('srednii ball=',sr);
    close (f);
    end
    end.
    выдает ошибку на while.

Страница 1 из 4 1234 ПоследняяПоследняя

Ваши права

  • Вы не можете создавать новые темы
  • Вы не можете отвечать в темах
  • Вы не можете прикреплять вложения
  • Вы не можете редактировать свои сообщения
  •