Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Помощь студентам


Ответ
 
Опции темы Опции просмотра
Старый 03.11.2013, 01:25   #1 (permalink)
Viachka
Новичок
 
Регистрация: 03.11.2013
Сообщений: 4
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
Question Сколько различных ожерелий можно составить?

Доброго времени суток, помогите написать программу на PascalABC:

Сколько различных ожерелий можно составить из 2-ух белых, 2-ух синих и 2-ух красных бусин. Напечатать возможные варианты и их кол-во.
Viachka вне форума   Ответить с цитированием

Старый 03.11.2013, 01:25
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

На форуме так же есть похожие темы, отправлю их вам

За сколько можно продать?
За сколько можно продать компьютер?
За сколько можно продать?
Вот по этой программе какое можно составить задание?
Сколько можно запитать TDA7294 от ТС 180?

Старый 03.11.2013, 08:33   #2 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Цитата:
Сообщение от Viachka Посмотреть сообщение
Сколько различных ожерелий можно составить из 2-ух белых, 2-ух синих и 2-ух красных бусин.
Это-то элементарно, и Паскаль не нужен. У меня получается, что количество вариантов есть (6!)/(2³)=90. Поясню. В числителе дроби - полное количество перестановок из шести бусин. Естественно, мы должны исключить повторяющиеся варианты, которые возникают из-за неразличимости бусин в паре одного цвета, а поскольку таких пар - три, вот и получается 2³=8 в знаменателе.
Цитата:
Сообщение от Viachka Посмотреть сообщение
Напечатать возможные варианты и их кол-во.
А вот это уже серьёзно. Тут нужно найти алгоритм перебора вариантов перестановок (где-то мне попадался), а потом еще и модифицировать его с учетом исключения повторов. Ну, не знаю - непросто это...
Vladimir_S вне форума   Ответить с цитированием
Старый 03.11.2013, 15:22   #3 (permalink)
Viachka
Новичок
 
Регистрация: 03.11.2013
Сообщений: 4
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
Question

А правильно ли будет сделать вот так:
function f(z : byte) : real; begin if (z <= 1) then f := 1 else f := f(z - 1) * z; end;
И ищё вопрос как правильно вывести результат на экран.
Viachka вне форума   Ответить с цитированием
Старый 03.11.2013, 17:02   #4 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Цитата:
Сообщение от Viachka Посмотреть сообщение
А правильно ли будет сделать вот так:
function f(z : byte) : real; begin if (z <= 1) then f := 1 else f := f(z - 1) * z; end;
И ищё вопрос как правильно вывести результат на экран.
Правильно. Но это всего лишь рекурсивная функция вычисления факториала.
1. И что Вы с ней делать собираетесь?
2. А зачеркивать-то зачем?
3. Какой результат Вы собираетесь выводить?
Vladimir_S вне форума   Ответить с цитированием
Старый 03.11.2013, 17:52   #5 (permalink)
Viachka
Новичок
 
Регистрация: 03.11.2013
Сообщений: 4
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
Question

1. Я собираюсь её использовать как функцию, которая вычисляет вариации.
2. Случайно получилось.
3. Вывести все вариации в отдельном окне.
Viachka вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Старый 04.11.2013, 09:48   #6 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Цитата:
Сообщение от Viachka Посмотреть сообщение
3. Вывести все вариации в отдельном окне.
Так в этом-то и загвоздка. Очень непростая задача.
Vladimir_S вне форума   Ответить с цитированием
Старый 04.11.2013, 21:17   #7 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Ну так, программу-то я нарисовал, вот только не знаю, будет ли Вам с этого прок. Потому что я предупреждал - задача сложная, и не знаю, сумеете ли разобраться в коде. Ну, спрашивайте, если что - постараюсь объяснить. Обозначение цветов бусин:
w (white) - белая
b (blue) - синяя
r - (red) - красная.
И да, программа писалась и отлаживалась в НОРМАЛЬНОМ Паскале (в данном случае - Free), а за возможные глюки этого дебильного псевдо-лже-недопаскаля АВС я не отвечаю.
Код:
Var
 Q:Array[1..720,1..6] of Byte;
 i1,i2,i3,i4,i5,i6,m:byte;
 i,j,k,p:Integer;
 b,b1:boolean;
Begin
 p:=1;
 for i1:=1 to 6 do
  begin
   if (i1<3) then Q[p,1]:=1 else if (i1>4) then Q[p,1]:=3 else Q[p,1]:=2;
   for i2:=1 to 6 do
    if (i2<>i1) then
     begin
      if (i2<3) then Q[p,2]:=1 else if (i2>4) then Q[p,2]:=3 else Q[p,2]:=2;
      for i3:=1 to 6 do
       if (i3<>i1) and (i3<>i2) then
        begin
         if (i3<3) then Q[p,3]:=1 else if (i3>4) then Q[p,3]:=3 else Q[p,3]:=2;
         for i4:=1 to 6 do
          if (i4<>i3) and (i4<>i2) and (i4<>i1) then
           begin
            if (i4<3) then Q[p,4]:=1 else if (i4>4) then Q[p,4]:=3 else Q[p,4]:=2;
            for i5:=1 to 6 do
             if (i5<>i4) and (i5<>i3) and (i5<>i2) and (i5<>i1) then
              begin
               if (i5<3) then Q[p,5]:=1 else if (i5>4) then Q[p,5]:=3 else Q[p,5]:=2;
               for i6:=1 to 6 do
                if (i6<>i5) and (i6<>i4) and (i6<>i3) and (i6<>i2) and (i6<>i1) then
                 begin
                  if (i6<3) then Q[p,6]:=1 else if (i6>4) then Q[p,6]:=3 else Q[p,6]:=2;
                  Inc(p);
                  if p<721 then for m:=1 to 6 do Q[p,m]:=Q[p-1,m];
                 end;
              end;
           end;
        end;
     end;
  end;
 Dec(p);
 for i:=1 to p-1 do
  Repeat
   b1:=true;
   for j:=i+1 to p do
    begin
     b:=true;
     for m:=1 to 6 do if Q[i,m]<>Q[j,m] then b:=false;
     if b then
      begin
       for k:=j+1 to p do Q[k-1]:=Q[k];
       Dec(p);
       b1:=false;
      end;
    end;
  Until b1;
 Writeln('Number of variants = ',p);
 Writeln;
 for i:=0 to 17 do
  begin
   for j:=1 to 5 do
    begin
     for m:=1 to 6 do
      begin
       if Q[i*5+j,m]=1 then write('w');
       if Q[i*5+j,m]=2 then write('b');
       if Q[i*5+j,m]=3 then write('r');
      end;
     write('    ');
    end;
   writeln;
  end;
 Readln
End.
Миниатюры
glasses.jpg  
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ

Опции темы
Опции просмотра

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

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 15:47.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.