183540 (Модель экспертной оценки), страница 5
Описание файла
Документ из архива "Модель экспертной оценки", который расположен в категории "". Всё это находится в предмете "экономико-математическое моделирование" из , которые можно найти в файловом архиве . Не смотря на прямую связь этого архива с , его также можно найти и в других разделах. Архив можно найти в разделе "курсовые/домашние работы", в предмете "экономико-математическое моделирование" в общих файлах.
Онлайн просмотр документа "183540"
Текст 5 страницы из документа "183540"
write('-');
writeln; write('Число избирателей ');
gotoXY(19,7);
for i:=1 to s do
write(many[i] ' ');
writeln; gotoXY(19,9);
for i:=1 to M do
begin
for j:=1 to s do
write(rang[і,j] ' ');
gotoXY(19, 9+i);
end;
gotoXY(1,15);
end;
{---------------------------}
{проверяет правильность ввода варианта выбора} procedure right;
label l;
begin
l: readln(c);
if (c<>'0') and (c<>'1') then
begin
write('Повторите попытку: ');
goto l;
end;
end;
{---------------------------}
{выводит список имен кандидатов}
procedure help;
var x,y,i: byte;
begin
x:=WhereX;
y:=WhereY;
gotoXY(1,24);
write('Имена кандидатов: ');
for i:=1 to M do
if i<>M then write(name[i] ', ')
else write(name[i]);
gotoXY(x,y);
end;
{---------------------------}
{определение победителя выборов}
procedure victory(v: ball; s: string);
var max, t: shortint;
hl: array[1..10] of byte;
begin
{определение максимальной оценки}
help;
max:=v[1];
for i:=1 to M do
if max max:=v[i]; t:=1; {определение кандидатов с максимальной оценкой} for i:=1 to M do if (v[i]-max)=0 then begin hl[t]:=i; t:=t+1; end; if (t-1)=1 then begin write('Победитель за ', s ' с сохранением нейтральности: '); writeln(name[hl[1]]); writeln('Сумма очков - ', max); end else begin vybor1:=name[hl[1]]; for i:=2 to t-1 do if name[hl[i]] vybor1:=name[hl[i]]; write('Победитель за ', s ' без сохранения нейтральности: '); writeln(vybor1); writeln('Сумма очков - ', max); writeln('избранный из множественного числа наилучших:'); for i:=1 to t-1 do writeln(name[hl[i]]); end; end; {---------------------------} {основная программа} begin gotoXY(21,1); writeln('Определение победителя выборов'); writeln; writeln('Запуск контрольного примера - 1; Самостоятельное внесение профиля 0'); right; if c='1' then begin example; help; goto z; end else clrscr; write('Введите количество кандидатов: '); readln(M); write('Введите количество избирателей: '); readln(N); writeln('Введите имена кандидатов'); for i:=1 to M do begin write('Кандидат ', и ': '); readln(name[i]); end; writeln('Как будет осуществляться занос информации?'); write('1- отдельными избирателями, 0- комитетом: '); right; if c='1' then for i:=1 to N do many[i]:=1; clrscr; writeln('Введите профиль преимуществ'); s:=1; contrl:=0; while contrl<>N do begin if c='1' then writeln('Избиратель ', s) else writeln('Группа ', s); for i:=1 to m do n1[i]:=''; help; for j:=1 to M do begin y:readln(vybor1); {проверка на корректность введенного профиля} r:=0; a:=0; b:=0; n1[j]:=vybor1; for l:=1 to M do begin if vybor1=name[l] then begin b:=1; for a:=1 to M do {такое имя уже было введено в данном профиле} if (vybor1=n1[a]) and ((a-j)<>0) then r:=1; end; {имя введенного кандидата не совпадает с ни одним из списка} if (vybor1<>name[l]) and (l=M) and (b<>1) then r:=1; end; if r=1 then begin n1[j]:=''; writeln('Внимательно вводите имена кандидатов'); goto в; end else rang[j,s]:=vybor1; {профиль корректен} end; if c='0' then begin writeln('Количество избирателей в группе ', s); readln(many[s]); contrl:=contrl+many[s]; end else contrl:=contrl+1; s:=s+1; clrscr; end; {while} {Определение оценок Копленда} z: contrl:=1; while contrl<=M do begin k:=contrl+1; vybor1:=name[contrl]; vybor2:=name[k]; while k<=M do begin i:=1; a:=0; b:=0; while i<=s do begin for j:=1 to M do if rang[j,i]=vybor1 then l:=j else if rang[j,i]=vybor2 then r:=j; if l else if l>r then b:=b+many[i]; i:=i+1; end; if a>b then begin kopl[contrl]:=kopl[contrl]+1; kopl[k]:=kopl[k]-1; end else if a begin kopl[k]:=kopl[k]+1; kopl[contrl]:=kopl[contrl]-1; end; k:=k+1; vybor2:=name[k]; end; {while по к} contrl:=contrl+1; end; {while по contrl} {определение оценок Борда} for i:=1 to s do for j:=1 to M do begin for k:=1 to M do if rang[j,i]=name[k] then r:=k; bord[r]:=many[i]*(M-j)+bord[r]; end; victory(kopl, 'Коплендом'); writeln ('Нажмите любую клавишу '); readkey; writeln; victory(bord, 'Борда'); end. Результаты работы программы Самостоятельное внесение профиля. Введите количество кандидатов: 5 Введите количество избирателей: 9 Введите имена кандидатов Кандидат 1: а Кандидат 2: b Кандидат 3: c Кандидат 4: d Кандидат 5: е Как будет осуществляться занос информации? 1-отдельными избирателями, 0 – комитетом: 0 Введите профиль преимуществ Группа 1 a b c d e Количество избирателей в группе 1: 1 Группа 2 c d b e a Количество избирателей в группе 2: 4 Группа 3 e a d b c Количество избирателей в группе 3: 1 Группа 4 e a b d c Количество избирателей в группе 4: 3 Победитель по Копленду с сохранением нейтральности – а Сумма очков – 2 Победитель по Борду с сохранением нейтральности – е Сумма очков – 20 Результаты работы программы