IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Решение СЛАУ методом Монте-Карло
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 18
Пол: Мужской
Реальное имя: Игорь

Репутация: -  0  +


Народ у меня расчетно-графическая робота, решение системы линейных уравнени методом Монте-Карло!
Может кто знает или у кого-то есть код решения этой задачи, принимается код на С++!
Заранее благодарен!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


В поиске смотрел ?

Монте-Карло

Сообщение отредактировано: klem4 -


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 18
Пол: Мужской
Реальное имя: Игорь

Репутация: -  0  +


Помогите пределать код с Basica на Pascal!

10 REM ~~~МОНТЕ_КАРЛО~~~
20 REM ВЫЧИСЛЕНИЯ КОРНЯ СИСТЕМЫ ЛИНЕЙНЫХ
УРАВНЕНИЙ
30 DIM A(20,2l),B(20,20),W(20)
40 INPUT "ВВЕДИТЕ ПОРЯДОК РЕШАЕМОЙ СИСТЕМЫ";N
50 PRINT "ВВЕДИТЕ ПО СТРОКАМ КОЭФФИЦИЕНТЫ
СИСТЕМЫ"
60 FOR I=1 ТО N
70 INPUT A(I,I):B(I,I)=ABS(A(I,I)) 80 FOR J=2 TO N
90 INPUT A(I,J):B(I,J)=B(I,J-I)+ABS(A(I,J))
100 NEXT J
110 INPUT A(I,N+1)
120 NEXT I
130 FOR I=1 TO N
140 W(I)=A(I,N+1)/(1-B(I,N))
150 NEXT I
160 INPUT "ВВЕДИТЕ НОМЕР РЕШАЕМОГО УРАВНЕНИЯ -В И КОЛИЧЕСТВО РЕАЛИЗАЦИИ СЛУЧАЙНОГО ПРОЦЕССА - М ";В,М
170 T=1:Y=0
180 S=B:Y=1
190 IF T>M THEN 260
200 C=RND(1)
210 FOR J=N TO 1 STEP -1
220 IF C<=B(S,J) THEN 240
230 IF J=N THEN T=T+1:Y=Y+V*W(S):GOTO 180 ELSE V=V*SNG(A(S,J+1)):S=J+1:GOTO 200
240 NEXT J
250 V=V*SGN(A(S,l)):S=1:GOTO 200
260 X=Y/M
270 PRINT "КОРЕНЬ ";B;" - ГО УРАВНЕНИЯ X=";X
280 END
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Новичок
*

Группа: Пользователи
Сообщений: 18
Пол: Мужской
Реальное имя: Игорь

Репутация: -  0  +


Ура, я код переделал, но теперь есть ошибки с вводом, помогите их решить!
я думаю не одному мне этот метод понадобится, в инете я все обискал, только одну прогу платную нашел!

uses crt;

function SGN(a: real): integer;
begin
if a > 0 then
SGN := 1;
if a = 0 then
SGN := 0;
if a < 0 then
SGN := -1;
end;

var
a: array[1..20, 1..21] of real;
b: array[1..20, 1..20] of real;
w: array[1..20] of real;
n, d, m, t, s: byte;
i, j: word;
x, c, v, y: real;
label
label1, label2, label3;
begin
v := 0;
writeln('vvedite poradok system');
readln(n);
writeln('vvedite coeffs');
for I := 1 to N do
begin
readln(A[I, I]);
B[I, I] := ABS(A[I, I]);
for J := 2 to N do
begin
readln(A[I, J]);
B[I, J] := B[I, J - I] + ABS(A[I, J]);
end;
readln(A[I, N + 1]);
end;
readln;
for I := 1 to N do
W[i] := A[I, N + 1] / (1 - B[I, N]);
writeln('vvedite nomer uravnenia');
readln(d, m);
T := 1;
Y := 0;
label2:
S := d;
Y := 1;
if T > M then
goto label1;
label3:
C := random(1);
for J := N downto 1 do
begin
if C <= B[S, J] then
continue;
if J = N then
begin
T := T + 1;
Y := Y + V * W[S];
goto label2;
end
else
begin
V := V * SGN(A[S, J + 1]);
S := J + 1;
goto label3;
end;
end;
V := V * SGN(A[S, 1]);
S := 1;
goto label2;
label1:
X := Y / M;
writeln('coren ', d, ' - go uravnenia X=', X);
readln;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 29.03.2024 5:00
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name