Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Программирование на языке Pascal

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 2.943 RSS
←   Февраль 2010   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28


За последние 60 дней ни разу не выходила


Сайт рассылки: http://prog.rusfaq.ru/pascal
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

2.943 подписчиков
0 за неделю
←   Все выпуски   →

RFpro.ru: Программирование на языке Pascal


Хостинг портала RFpro.ru:
Московский хостер
Профессиональный платный хостинг на базе Windows 2008

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

lamed
Статус: Практикант
Рейтинг: 2151
∙ повысить рейтинг » 		Boriss
Статус: Академик
Рейтинг: 1775
∙ повысить рейтинг » 		_Ayl_
Статус: Студент
Рейтинг: 1560
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И ПО / Программирование / Pascal (Паскаль)

Номер выпуска:1031
Дата выхода:17.02.2010, 20:00
Администратор рассылки:Калашников О.А., Руководитель
Подписчиков / экспертов:332 / 198
Вопросов / ответов:1 / 1

Вопрос № 176652: Здравствуйте, проблема такова. У меня Free Pascal и исполняемая программа, так вот при исполнении программы выводится много информации которая не помешается на экран а отображается только то что на самом экране(последние строки), т.е нет прокрутки а...

Вопрос № 176652:

Здравствуйте, проблема такова. У меня Free Pascal и исполняемая программа, так вот при исполнении программы выводится много информации которая не помешается на экран а отображается только то что на самом экране(последние строки), т.е нет прокрутки а надо посмотреть все что есть. Как это сделать, в настройках покрутить или как?

Отправлен: 12.02.2010, 19:55
Вопрос задал: Hivrenko, Посетитель
Всего ответов: 1
Страница вопроса »

Отвечает Сучкова Татьяна Михайловна, Администратор :
Здравствуйте, Hivrenko.
Как тут уже предложил Зенченко К.Н., давайте организуем вывод в файл. В данном случае это будет текстовый файл rez.dat и лежать он будет в корне диска d.
Путь можете поменять на удобный Вам, изменив путь к файлу в строке assign(fl1,'d:\rez.dat'); в начале Главной программы.
Смотреть его можно, открыв в Блокноте.

Код:
program sga;
uses crt;

const
maxpop = 100;
maxstring = 30;
dim = 2; {размерность пространства поиска}

type
allele = boolean;
{Алель ? позиция в битовой строке}
chromosome = array[1..maxstring*dim] of allele;
{битовая строка}
fenotype = array[1..dim] of real;
individual = record
chrom:chromosome;
{генотип = битова
 я строка}
x:fenotype; {фенотип = массив вещественных
координат точки в пространстве поиска}
fitness:real; {значение целевой функции}
end;
population = array[1..maxpop] of individual;

const
xmax:fenotype=(5.12,5.12);
{массив максимальных значений для координат точки в про-странстве поиска}
xmin:fenotype=(-5.12,-5.12);
{массив минимальных значений для координат точки в про-странстве поиска}

var fl1:text; {будем результат писать в файл}

oldpop, newpop, intpop :population;
{Три
непересекающихся популяции ? старая, новая и проме-жуточная}
popsize, lchrom, gen, maxgen: integer;
{Глобальные целые переменные}
pcross, pmutation, sumfitness:real;
{глобальные вещественные переменные}
nmutation, ncross:integer;
{Статистические целые}
avg, max, min:real; {Статистические вещественные}
{дополнительно введённые переменные}
min1,min2:real;
a,b,c,kolzap:integer;
razmpop,kolpop:integer;
sred,otvet,otvet1,otv
 et2:real;

{Вероятностные процедуры}

function random_:real;
begin
random_ := random(65535)/(65535-1);
end;

function flip(probability:real):boolean;
{подбрасывание монетки ? true если орел}
begin
if probability = 1.0 then
flip := true
else
flip := (random_ <= probability);
end;

function rnd(low,high:integer):integer;
{Случайный выбор между low и high}
var
i:integer;
begin
if low >= high then
i := low
else begin
i := trunc(
random_ * (high-low+1) + low);
if i > high then i := high;
end;
rnd := i;
end;

{интерфейсные процедуры: decode and objfunc}

function objfunc(x:fenotype):real;
begin
objfunc:= sqr(x[1])+sqr(x[2]);
end;

procedure decode(chrom:chromosome; lbits:integer; var x:fenotype);
{Декодирование строки в массив вещественных координат точки в пространстве поиска - 

true=1, false=0}
var
i,j:integer;
f, accum, powerof2:real;<
 br>begin
for i:=1 to dim do begin
accum := 0.0;
powerof2 := 1;
f:=1;
for j := 1+lbits*(i-1) to lbits+lbits*(i-1) do begin
if chrom[j] then accum := accum + powerof2;
powerof2 := powerof2 * 2;
f:=f*2;
end;
x[i] := xmin[i]+(xmax[i]-xmin[i])*accum/(f-1)
end
end;

{Расчет статистических величин: statistics }
procedure statistics(popsize:integer; var max,avg,min,sumfitness:real;
 var pop:population);
{Расчет статистик популяции }
var
j:integer;
begin
{Инициализация
}
sumfitness := pop[1].fitness;
min := pop[1].fitness;
max := pop[1].fitness;
{Цикл для max, min, sumfitness }
for j := 2 to popsize do with pop[j] do begin
sumfitness := sumfitness + fitness;
{Накопление суммы значений функции пригодности}
if fitness>max then max := fitness;
{Новое значение max}
if fitness<min then min := fitness;
{Новое значение min}
end;
{Расчет среднего}
avg := sumfitness/popsize;
end;<
 br>
{Процедура инициализации initpop}
procedure initpop;
{Инициализация начальной популяции случайным образом}
var
j, j1:in
teger;
begin
for j := 1 to popsize do with oldpop[j] do begin
for j1 := 1 to lchrom*dim do chrom[j1] := flip(0.5);
{Бросок монетки}
decode(chrom,lchrom,x);
{Декодирование строки}
fitness := objfunc(x);
{Вычисление начальных значений функции пригодно-сти}
end;
end;

{3 генетических оператора: отбора (select), скрещивания (crossover) и
мутации (mutation)}

procedure select;
 {процедура выбора}
var
ipick:integer;
procedure shuffle(var pop:population);
{процедура
перемешивания популяции в процессе отбора}
var
i,j:integer;
ind0:individual;
begin
for i := popsize downto 2 do begin
j:= random(i-1)+1;
ind0:=pop[i];
pop[i]:=pop[j];
pop[j]:=ind0;
end;
end;

function select_1:integer;
var
j1,j2,m:integer;
begin
if (ipick>popsize) then begin
shuffle(oldpop);
ipick:=1
end;
j1:=ipick;
j2:=ipick+1;
if (oldpop[j2].fitness<oldpop[j1].fitness) then
m:=j2

 else
m:=j1;
ipick:=ipick+2;
select_1:=m;
end;

var
j:integer;
begin
ipick:=1;
for j:=1 to popsize do begin
intpop[j]:=oldpop[select_1];
end;
oldpop:=intpop;
end;

function mutation (alleleval:allele; pmutation:real;
var nmutation:integer):allele;
{мутация одного бита в строке (аллеля) с вероятностью pmutation, count number of 

mutations}
var
mutate:boolean;
begin
mutate := flip(pmutation);
{Flip the biased coin}
if mutate then begin
nmutation
:= nmutation + 1;
mutation := not alleleval;
{Change bit value}
end else
mutation := alleleval;
{No change}
end;

procedure crossover(var parent1, parent2, child1, child2:chromosome;
flchrom:integer; var ncross, nmutation, jcross:integer;
var pcross, pmutation:real);
{Скрещивание 2 родительских строк, результат помещается в 2 строках-потомках}
var
j:integer;
begin
if flip(pcross) then begin
{Выполняется скрещ
 ивание с вероятностью pcross}
jcross := rnd(1,flchrom-1);
{Определение точки сечения в диапазоне между 1 и l-1}
ncross := ncross + 1;
{Инкрементирование счетчика скрещиваний}
end else
jcross := flchrom;
{певая часть обмена , 1 to 1 and 2 to 2}
for j := 1 to jcross do begin
child1[j] := mutation(parent1[j], pmutation, nmutation);
child2[j] := mutation(parent2[j], pmutation, nmutation);
end;
{вторая часть обмена, 1 to 2 and 2 to 1}
if jcross<>flchrom then
{пропуск,
если точка скрещивания равна flchrom--скрещивание не происходит}
for j := jcross+1 to flchrom do begin
child1[j] := mutation(parent2[j], pmutation, nmutation);
child2[j] := mutation(parent1[j], pmutation, nmutation);
end;
end;

{Процедура создания нового поколения: generation}

procedure generation;
{Генерирование нового поколения при помощи отбора, скре-щивания и мутации}
{Прим: предполагается, что популяция имеет четный размер}
var
 
j, mate1, mate2, jcross:integer;
begin
select;
j := 1;
repeat
{выполняются отбор, скрещивание и мутация, пока полно-стью не сформируется новая 

популяция ? newpop}
mate1:= j;
{выбор родительской пары}
mate2:= j+1;
{скрещивание и мутация ? мутация вставлена в процедуру скрещивания}
crossover(oldpop[mate1].chrom, oldpop[mate2].chrom,
newpop[j ].chrom, newpop[j + 1].chrom,
lchrom*dim, ncross, nmutation, jcross, pcross, pmutation);
{Декодирование строки и вычисление
пригодности}
with newpop[j ] do begin
decode(chrom, lchrom,x);
fitness := objfunc(x);
end;
with newpop[j+1] do begin
decode(chrom, lchrom,x);
fitness := objfunc(x);
end;
j := j + 2;
until (j>popsize);
end;

BEGIN { Главная программа }
clrscr;

assign(fl1,'d:\rez.dat');
rewrite(fl1); {открытие файла для записи}

for b:=1 to 3 do begin{размеры популяций}
if b=1 then razmpop:=10;
if b=2 then razmpo
 p:=20;
if b=3 then razmpop:=30;
for c:=1 to 2 do begin{выбор количества поколений}
if c=1 then kolpop:=30;
if c=2 then kolpop:
=100;
min2:= 65535; {Здесь подразумевается любое значение заведомо
бoльшее, нежели любой из минимумов}
otvet1:=0;
kolzap:=25;
for a:=1 to kolzap do begin{количество запусков программы}
popsize:=razmpop;
{размер популяции}
lchrom:=20;
{число битов на один кодируемый параметр}
maxgen:=kolpop;
{максимальное число поколений}
pmutation:=0.01;
{вероятность скрещивания}
pcross:=0.9;
{вероятность мутации}
{Инициализация генератора случайных чисел}
randomize;
{Инициализация
счетчиков}
nmutation := 0;
ncross := 0;
initpop;
statistics (popsize, max, avg, min, sumfitness, oldpop);
min1:=min;
gen:= 0; {Установка счетчика поколений в 0}
sred:=0;

repeat {Главный итерационный цикл}
gen:= gen + 1;
generation;
statistics(popsize, max, avg, min, sumfitness, newpop);
oldpop:= newpop;
{переход на новое поколение }
writeln(fl1,'min= ',min);
if min1>min then min1:=min;
sred:=sred+min
 ;
until (gen >= maxgen);

writeln(fl1,'minimum= ',min1);


if min2>min1 then min2:= min1;
otvet:=sred/maxgen;
writeln(fl1,otvet);
otvet1:=otvet1+otvet;
end;
otvet2:=otvet1/kolzap;
writeln(fl1,'Среднее',otvet2);
writeln(fl1,'Global minimum: ',min2);
writeln(fl1,'Количество популяций-',razmpop);
writeln(fl1,'Количество поколений-',kolpop);
writeln(fl1,'----------------------------------');
end;{конец цикла
выбора количества поколений}
end;{конец цикла выбора количества популяций}
close(fl1); {закрытие файла rez.dat}
readln;
END. {End главной программы}

Ответ отправил: Сучкова Татьяна Михайловна, Администратор
Ответ отправлен: 17.02.2010, 12:16
Номер ответа: 259503
Россия, Орск
Тел.: +79083225682
Адрес сайта: http://www.school56orsk.narod.ru
ICQ # 101137510

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это!
Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 259503 на номер 1151 (Россия) | Еще номера »
  • Отправить WebMoney:

    • Оценить выпуск »
    Нам очень важно Ваше мнение об этом выпуске рассылки!

    Задать вопрос экспертам этой рассылки »

    Скажите "спасибо" эксперту, который помог Вам!

    Отправьте СМС-сообщение с тестом #thank НОМЕР_ОТВЕТА
    на короткий номер 1151 (Россия)
    Номер ответа и конкретный текст СМС указан внизу каждого ответа.

    Полный список номеров »

    * Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи. (полный список тарифов)
    ** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
    *** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.

    © 2001-2010, Портал RFpro.ru, Россия
    Авторское право: ООО "Мастер-Эксперт Про"
    Автор: Калашников О.А. | Программирование: Гладенюк А.Г.
    Хостинг: Компания "Московский хостер"
    Версия системы: 2010.6.14 от 03.02.2010
    В избранное