Yes, I also couldn't build/find a small one which is abstract enough
If you'll find the time (file is added), I tried to simplify it as far as I can, I assume I also put more variables into module then needed and tried to exclude other possible errors, so here it is:
(If you're interested, it is a CA guessing the exit time for a single (I simplified it) pedestrian and now I want to guess my parameters when knowing the exit time)
function[mmm_, nnn_] := (
Module[
{pex, dt, widths, w, l, LL, pot, tot},
pex = 1;
widths = 4;
laenge = 32;
TT = 10000;
(* GRID 0.3 *)
w = Table[0.3 i, {i, -widths/2, widths/2, 1}];(*
korrigieren*)
l = Table[0.3 i + 0.15, {i, laenge - 1, 0, -1}];(*
23 wird zu 31 geändert wegen höherer DICHTE*)
points = Table[
{w[[i]], l[[j]]}, {j, 1, Length[l]}, {i, 1, Length[w]}];
(*Potential*)
pot = ConstantArray[0, {laenge, widths + 1}];
LL = ConstantArray[0, {laenge, widths + 1}]; (*SUBmatrixeinträge*)
Do[
LL[[i, j]] =
Table[{i + kk, j + ll}, {kk, -1, 1}, {ll, -1, 1, 1}];(*
nachbarkoordinaten*)
pot[[i, j]] = Table[
points[[i, j]] + {0.3 kk, 0.3 ll},
{ll, 1, -1, -1}, {kk, -1, 1}
];
Do[
{pot[[i, j, ll,
kk]]} = {Exp[-mmm*(Norm[pot[[i, j, ll, kk]]] -
Norm[points[[i, j]]])]},
{ll, 1, 3}, {kk, 1, 3}];
(* MITTELFELD MERKEN*)
pot[[i, j, 2, 2]] = X;
(* alle Ränder weg*)
If[
j == 1,(*links*)
pot[[i, j]] = Drop[pot[[i, j]], 0, 1];
LL[[i, j]] = Drop[LL[[i, j]], 0, 1];
];
(*Print[pot[[i,j]], "nach links"];*)
If[
j == Length[w],(*rechts*)
pot[[i, j]] = Drop[pot[[i, j]], 0, -1];
LL[[i, j]] = Drop[LL[[i, j]], 0, -1];
];
(*Print[pot[[i,j]], "nach rechts"];*)
If[
i == 1,(*oben*)
pot[[i, j]] = Drop[pot[[i, j]], 1];
LL[[i, j]] = Drop[LL[[i, j]], 1];
];
(*Print[pot[[i,j]], "nach oben"];*)
If[
i == Length[l],(*unten*)
pot[[i, j]] = Drop[pot[[i, j]], -1];
LL[[i, j]] = Drop[LL[[i, j]], -1];
];
(* //alle Ränder weg*)
(*normalisieren*)
tot = Total[Total[pot[[i, j]]]] - X;
{{kk, ll}} = Position[pot[[i, j]], X];
pot[[i, j]] = pot[[i, j]]/tot;
pot[[i, j, kk, ll]] = 1 - nnn; (*KORREKTUR MOTIVATION*)
tot = Total[Total[pot[[i, j]]]];
pot[[i, j]] = pot[[i, j]]/tot;
(*//normalisieren*)
,
{i, 1, laenge}, {j, 1, widths + 1}];
(* fertig Potentialfeld*)
(* INITIAL CONDITION*)
initial =
Transpose[{RandomInteger[{1, Length[l] - 1}, n + 30],
RandomInteger[{1, Length[w]}, n + 30]}];
initial = DeleteDuplicates[initial];
Length[initial] < n;
While[Length[initial] < n,
initial =
Transpose[{RandomInteger[{1, Length[l] - 1}, n + 30],
RandomInteger[{1, Length[w]}, n + 30]}];
initial = DeleteDuplicates[initial]];
Length[initial];
initial = initial[[1 ;; n]];
Length[initial];
initial = {{1, 3}};
(* // INITIAL CONDITION *)
history = ConstantArray[0, {TT + 1, Length[l], Length[w]}];
helpA = SparseArray[initial -> 1, {Length[l], Length[w]}];
history[[1]] = history[[1]] + helpA;
dataset = ConstantArray[0, TT + 1];
wishes = ConstantArray[0, Length[initial]];
dataset[[1]] = initial;
For[tt = 1, tt <= TT, tt++,
pointies = dataset[[tt]];
For[ii = 1, ii <= Length[initial], ii++,
i = pointies[[ii, 1]];
j = pointies[[ii, 2]];
If[i > 0 && j > 0,
possibilities =
Flatten[LL[[i, j]], 1]; (*MÖGLICHKEITEN in der Matrix*)
props = Flatten[
pot[[i, j]]];(*Dazugehörige Wahrscheinlichkeiten*)
nums = Table[jj, {jj, 1, Length[possibilities]}]; (*
Hilfsliste *)
help1 = Table[ (* EXCLUDE wo Agenten sitzen, setze props auf 0 *)
If[possibilities[[jj]] != {i, j},
If[
MemberQ[dataset[[tt]], possibilities[[jj]]],
0,
props[[jj]]],
props[[jj]]],
{jj, 1, Length[possibilities]}
];
ind =
RandomChoice[help1 -> Table[nn, {nn, 1, Length[help1], 1}]];
wishes[[ii]] = {possibilities[[ind]], {i, j}, help1[[ind]]};
(* EXIT START UNGERADE*)
If[
{i, j} == {Length[l], Floor[Length[w]/2] + 1},
(*Print["YES"];*)
help3 = {
{(1 - nnn)/(2 - nnn), 1/(2 - nnn)},
{1, 2},
{{Length[l], Floor[Length[w]/2] + 1}, {0,
0}}(*stehen raus*)
};
ind = RandomChoice[help3[[1]] -> help3[[2]]];
wishes[[ii]] = {help3[[3, ind]], {i, j}, help3[[1, ind]]};
];
If[
{i, j} == {Length[l], Floor[Length[w]/2] + 2},
(*Print["YES"];*)
help3 = {
{0.34*
If[MemberQ[
dataset[[tt]], {Length[l], Floor[Length[w]/2] + 1}], 0,
1], 0.66},(* so ist das nun ohne skip*)
{1, 2},
{{Length[l], Floor[Length[w]/2] + 1}, {0, 0}}(*mitte,
raus*)
};
ind = RandomChoice[help3[[1]] -> help3[[2]]];
wishes[[ii]] = {help3[[3, ind]], {i, j}, help3[[1, ind]]};
];
If[
{i, j} == {Length[l], Floor[Length[w]/2]},
(*Print["YES"];*)
help3 = {
{0.34*
If[MemberQ[
dataset[[tt]], {Length[l], Floor[Length[w]/2] + 1}], 0,
1], 0.66},(* so ist das nun ohne skip*)
(*{(1-
mm)/(2-mm),0.34/(2-mm),0.66/(2-mm)},*)(*
so war das früher*)
{1, 2},
{{Length[l], Floor[Length[w]/2] + 1}, {0, 0}}(* mitte,
raus*)
};
ind = RandomChoice[help3[[1]] -> help3[[2]]];
wishes[[ii]] = {help3[[3, ind]], {i, j}, help3[[1, ind]]};
(*
EXIT ENDE *)
(*ELSE falls Punkt bereits draußen auf (0,
0)*)
];
,(* KOMMA WICHTIG DA IF AUS*)
wishes[[ii]] = {{0, 1}, {0, 0}, 1}
];
];
dataset[[tt + 1]] =
wishes[[All, 1]];(*zukunft mit konflikten*)
(* KONFLIKT*)
counting = Tally[wishes[[All, 1]]];
(*COUNTING Länge der *)
For[
iii = 1, iii <= Length[counting], iii++,
If[Total[counting[[iii, 1]]] != 1,
Do[
If[counting[[iii, 2]] == MM,
help3 =
Position[wishes[[All, 1]], counting[[iii, 1]]] // Flatten; (*
wo stehen die streitenden?*)
For[
jj = 1, jj <= Length[help3], jj++,
dataset[[tt + 1, help3[[jj]] ]] =
dataset[[tt, help3[[jj]]]];
];
winner =
RandomChoice[
Table[wishes[[help3[[nn]], 3]], {nn, 1, MM}] -> help3];
(*Print[winner];
Print[dataset[[tt+1]]];*)
dataset[[tt + 1, winner]] = counting[[iii, 1]]
(*Print[dataset[[tt+1]]];*)
],
{MM, 2, Max[counting[[;; , 2]]]}](* DO ENDE*)
]
];
(* //KONFLIKT*)
(* DURCHFLUSS AM AUSGANG*)
If[MemberQ[dataset[[tt + 1]], {0, 0}],
{{huepfer}} = Position[dataset[[tt + 1]], {0, 0}];
dataset[[tt + 1, huepfer]] =
RandomChoice[{pex, 1 - pex} -> {{0, 0}, dataset[[tt, huepfer]]}];
];
(* // DURCHFLUSS AM AUSGANG*)
(* IST ES LEER? *)
If[
Total[Total[dataset[[tt]]]] == n,
Break[]
]
(* //IST ES LEER? *)
];
Return[tt - 1]
]
)
Then
function[1, 0]
function[3, 1]
function[10, 1]
works just fine, BUT
NMinimize[
{(function[x, 0] - 70)^2, 3 < x < 5}, {x, 3, 5}]
shows me as an error, that my mmm_ or here x is not used in the calculation. So I assume somewhere I defined my variables terribly wrong
All the best
Dear Daniel, thanks again for the quick reply
Just to understand it correctly,
function[x_?NumericQ, y_?NumericQ, z_?NumericQ] := ...
And then, when guessing e.g. x, I use NMinimize[{(function[x, 1,2] -70)^2, 3 < x < 4}, {x, 3, 4}]
?
Because this doesn't work. However, before going into detail, as written in the Link, the solution
NMinimize[{Hold[(function[x,1,2] - 70)^2, 3 < x < 4}, {x, 3, 4}]
NMinimize[{Hold[(function[x,1,2 ] - 70)^2, 3 < x < 4}, {x, 3, 4}]
gives me twice the same result, even my simulation has (more then one) propabilistic effect in it.
I assume hold is the reason? But again, no idea why I'll now try to build a minimal example to represent my problem
|
|
|
Might try defining function a bit differently:
function[x_?NumericQ, 1, 2] := ...
See if that improves matters. if not, more detail will be needed in the question.
|
|
|
Group Abstract
Message Boards
