Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Паскаль
Регистрация

Восстановить пароль
Повторная активизация e-mail


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 15 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

Ответ
 
Опции темы
Старый 30.05.2012, 14:46   #1
volha_alina
Пользователь
 
Регистрация: 22.05.2012
Сообщений: 13
Репутация: 10
Вопрос Неправильно передается в функцию массив а (с 0), хотя там только 1 и -1!

Код:
uses crt;
const
	N=10; Pm=0.05; P=10; Gen=5;
Type
	pp=array[1..N,1..Gen] of integer;
        ff=array[1..N] of real;
        ee=array[1..N,1..N] of real;
Var
	NR:byte; c:ee;

Function Fx(a:pp):real;
Var
	i,j,k:byte;
        x,sum,sum2,b:real;
Begin
b:=0.5;
for i:=1 to N do begin
                     sum2:=0;
                     for k:=1 to Gen do begin
                                               sum2:=a[i,k];
                                               write(a[i,k]:2);
                                               end;
                     end;
Fx:=0.5*b*sum2;
End;

Procedure Form(var a:pp; var b:ff);
Var
	i,j,k:byte;
Begin
for i:=1 to N do begin
                 for j:=1 to Gen do begin
                                    k:=random(2);
                                    if k=0 then a[i,j]:=-1
                                           else a[i,j]:=1;
                                    end;
                 b[i]:=Fx(a);
                 end;
End;

Procedure Out (a:pp; b:ff);
var
	j,i:byte;
Begin
writeln ('Nomer   Kod       Y');
for i:=1 to N do begin write (i:2,'   ');
for j:=1 to Gen do begin write (a[i,j]:2);
                   end;
                   writeln (b[i]:6:2);
                 end;
End;

Var
	popul:pp; func:ff; i,j,k:byte; sum1,R,N0,m,q:real;
Begin
clrscr;
randomize;
Form(popul,func);
writeln('Nachalnaya populyacia');
Out(popul,func);
readln;
End.
volha_alina вне форума   Ответить с цитированием
Старый 30.05.2012, 15:18   #2
veniside
Профессионал
 
Регистрация: 03.01.2011
Сообщений: 2,508
Репутация: 868
По умолчанию

Код:
Procedure Form(var a:pp; var b:ff);
Var
	i,j,k:byte;
       r: real;
Begin
for i:=1 to N do begin
                 for j:=1 to Gen do begin
                                    k:=random(2);
                                    if k=0 then a[i,j]:=-1
                                           else a[i,j]:=1;
                                    end;
                 end;
r := Fx(a);
for i:=1 to N do 
        b[i]:=r;
End;
__________________
"Когда приходит положенное время, человек перестаёт играть в пинбол. Только и всего."
veniside вне форума   Ответить с цитированием
Старый 30.05.2012, 15:42   #3
volha_alina
Пользователь
 
Регистрация: 22.05.2012
Сообщений: 13
Репутация: 10
По умолчанию

Спасибо! очень помог!
А ты не знаешь как еще сделать так, чтобы b[i](они же Fx,r,Y) выдавались разными?

Последний раз редактировалось volha_alina; 30.05.2012 в 21:24.
volha_alina вне форума   Ответить с цитированием
Старый 30.05.2012, 22:15   #4
veniside
Профессионал
 
Регистрация: 03.01.2011
Сообщений: 2,508
Репутация: 868
По умолчанию

Код:
b[i] := random(100);
условие задачи где?
__________________
"Когда приходит положенное время, человек перестаёт играть в пинбол. Только и всего."
veniside вне форума   Ответить с цитированием
Старый 31.05.2012, 08:30   #5
volha_alina
Пользователь
 
Регистрация: 22.05.2012
Сообщений: 13
Репутация: 10
По умолчанию Разработка спин-стекольной модели эволюции Шеррингтона-Киркпатрика

http://programmersforum.ru/showthread.php?t=201833[/url]

Вроде разобралась. Спасибо.

Последний раз редактировалось volha_alina; 31.05.2012 в 12:13.
volha_alina вне форума   Ответить с цитированием
Старый 31.05.2012, 12:12   #6
veniside
Профессионал
 
Регистрация: 03.01.2011
Сообщений: 2,508
Репутация: 868
По умолчанию

> Просить кого-то все cделать надо было сразу,

может и так, но по-любому самому сделать полезней

если делать по этой методичке, то получается нечто вроде:


Код:
program
  SK;

const
  Ns 	= 10;	// число спинов у особи
  n 	= 20;	// число особей в популяции
  Tmax	= 10;	// сколько популяций моделировать
  b     = 1.0;	// параметр интенсивности отбора
  Pm	= 50;	// интенсивность мутаций (от 0% до 100%)

type
  body = array[1..Ns] of integer;	// тип для особи
  population = array[1..n] of body;   // тип для популяции

var
  S: population;		// популяция
  Snew: population;		// новая популяция
  J: array[1..Ns, 1..Ns] of integer;	// матрица взаимодействия

// --  --
procedure initS_and_J();
var
  ii, jj: integer;
begin
  // начальная S
  for ii := 1 to n do
    for jj := 1 to Ns do
      S[ii, jj] := 1 - 2 * random(2);
  //
  // начальная J
  for ii := 1 to Ns do
    for jj := 1 to Ns do
      J[ii, jj] := random(100);	// не уверен, что это нормальное распределение, надо уточнить
end;

// --  --
function Fexp(k: integer): real;
var
  ii, jj: integer;
  E: real;
begin
  E := 0;
  //
  // вычисляем энергию S[k]
  for ii := 1 to Ns do
    for jj := 1 to Ns do
      if (ii <> jj) then
	E := E + (J[ii, jj] / 100) * S[k][ii] * S[k][jj];
  //
  Fexp := exp(b * 0.5 * E);
  //
  writeln(result:10:2);
end;


var
  i: integer;
  t: integer;   // номер популяции
  k: integer;	// номер особи
begin
  Randomize;
  //
  // Шаг 0 Формирование начальной популяции
  initS_and_J();
  //
  for t := 0 to Tmax - 1 do begin
    //
    // Подшаг 1.1.
    for k := 1 to n do begin
      //
      // по-идее, нам нужно отобрать лучших, остальных убить. В методичке этот момент не раскрыт
      // 100 выбрано от фонаря
      if (100 < Fexp(k)) then
	//
	// Подшаг 1.2., формируем новую популяцию из лучших особей
	Snew[k] := S[k]
      else
	//
	// Подшаг 1.2., формируем новую популяцию, т.к. особь из старой умерла, рождаем новую со случайными спинами
	for i := 1 to Ns do
	  Snew[k][i] := 1 - 2 * random(2);
    end;
    //
    // Шаг 2. Мутации
    S := Snew;
    for k := 1 to n do
      for i := 1 to Ns do
	if (random(100) < Pm) then
	  S[k][i] := -S[k][i]; // мутируем
    //
    // Шаг 3. Организация последовательности поколений. Повторяем шаги 1, 2 для t = 0, 1, 2, ...
  end;
end.
там есть пару непонятных моментов:
- нормальное распределение для J, фиг знает, что оно такое и как правильно его задать
- формирование нового поколения. Написано, что нужно отобрать n особой в новое поколение. Имхо, это бессмысленно, т.к. в новое поколение просто перейдут все n особей из старого. Смысл тогда считать приспосабливаемость? В общем, я сделал, что в новое поколение попадают только лучшие, а на месте худших рождаются новые. Наверняка это неправильно, но как задумывали Шеррингтон-Киркпатрик, из методы не ясно.
__________________
"Когда приходит положенное время, человек перестаёт играть в пинбол. Только и всего."
veniside вне форума   Ответить с цитированием
Ответ

Опции темы

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

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

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Создать функцию Max, которая находит в заданном целочисленном массиве максимальный элемень и возвращает его. массив передается в к devs Помощь студентам 2 21.12.2011 11:40
Аргумент в функцию потока не передается Silly Student Win Api 3 19.10.2011 12:42
двумерный массив. вывести все строки, содержащие хотя бы один "0"(ноль) (написать через функцию в Delphi) BLADIMIR Помощь студентам 4 07.09.2011 21:24
Вычисления значение выражения, которое передается в функцию в виде строки noobOS Помощь студентам 5 01.07.2010 17:03


15:41.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru