Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

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

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

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.12.2019, 21:05   #1
ncuxuatop
Новичок
Джуниор
 
Регистрация: 03.06.2019
Сообщений: 3
По умолчанию Модель изинга

Кто может помочь с программой модель изинга на Делфи или лазарусе? Есть только скрин ехе файла
ncuxuatop вне форума Ответить с цитированием
Старый 24.12.2019, 16:19   #2
unbanned
Форумчанин
 
Аватар для unbanned
 
Регистрация: 23.11.2010
Сообщений: 530
По умолчанию

код не мой, не проверял
на TurboPascal'е но, возможно поможет
Код:
program dd;

uses
  crt,
  Graph;

const
  N = 10;
  M = 10;
  jj = 1;
var
  i, j, k, l, u, Gd, Gm: integer;
  p: real;
  h, E, EE, dE, x, a, fi, fi1, fi2: real;
  s: array [1..N, 1..M] of real;

label metka;

procedure Energy;
var
  i, j: integer;
begin
  E := 0;
  dE := 0;
  for i := 2 to N - 1 do
    for j := 2 to M - 1 do
      E := E - jj * (s[i, j] * s[i + 1, j] + s[i, j] * s[i - 1, j] + s[i, j] * s[i, j + 1] + s[i, j] * s[i, j - 1] + 0.7 *
        (s[i, j] * s[i + 1, j + 1] + s[i, j] * s[i - 1, j - 1] + s[i, j] * s[i - 1, j + 1] + s[i, j] * s[i + 1, j - 1]));
  for i := 2 to N - 1 do
    for j := 2 to M - 1 do
    begin
      h := 0;
      if (i > 0.6 * N) and (j > 0.6 * M) then
        h := -0.05;
      if (i < 0.4 * N) and (j < 0.4 * M) then
        h := 0.05;
      dE := dE - h * s[i, j];
    end;
  E := E + dE;
end;

procedure Draw;
var
  i, j: integer;
begin
  for i := 1 to N do
    for j := 1 to M do
    begin
      if s[i, j] = 1 then
      begin
        Circle(15 * i, 15 * j, 5);
        circle(15 * i, 15 * j, 6);
        circle(15 * i, 15 * j, 7);
      end;
      if s[i, j] = 0 then
        circle(15 * i, 15 * j, 5);
    end;
end;

begin
  Randomize;
  for i := 1 to N do
    for j := 1 to M do
    begin
      p := Random(100) / 100;
      s[i, j] := 0;
      if p < 0.33 then
        s[i, j] := -1;
      if p > 0.66 then
        s[i, j] := 1;
    end;
  Draw;
  repeat
    for k := 1 to round(N * M / 10) do
    begin
      Energy;
      EE := E;
      i := 1 + round(random(N - 2));
      j := 1 + round(random(M - 2));
      if s[i, j] = 1 then
      begin
        u := 1;
        s[i, j] := 0;
        goto metka;
      end;
      if s[i, j] = -1 then
      begin
        u := -1;
        s[i, j] := 0;
        goto metka;
      end;
      if (s[i, j] = 0) and (random(100) > 50) then
        s[i, j] := -1
      else
        s[i, j] := 1;
      u := 0;
      metka:
        Energy;
      if (E > EE) then
        s[i, j] := u;
    end;
    Energy;
    Draw;
  until keypressed;
  repeat
  until keypressed;
end.
unbanned вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
сделать программу на C++, которая переводит цветовую модель RGB в модель HSV Kabahol Помощь студентам 5 14.03.2014 19:05
3D модель на Си\Си++ Naerus Помощь студентам 10 02.06.2013 17:18
задачи по теме "моделирование":1) построить модель на графе 2) построить табличную модель 3) решить задачу венгерским методом Елена3110 Помощь студентам 1 05.05.2013 11:03
Языковая модель PalTanya Помощь студентам 2 18.11.2010 16:51
Фреймовая модель Шушелла Помощь студентам 0 15.05.2010 00:20