0
$\begingroup$

Currently I am stuck with the issue of renaming an instanced variable like r1$38655 to a global one. The function is created within a "localizeAll" Module. Here's a link to localizeAll.

In particular I would like to rename the custom-made function's parameters at the end of the code:

   ClearAll["Global`*"]; Remove["Global`*"]; CloseKernels[];

   ClearAll[localizeAll];
   SetAttributes[localizeAll, HoldAll];
   localizeAll[code_] := With[{vars = 
   Join @@ Union@
   Cases[Hold[code], 
   s_Symbol /; 
     Context[s] == "Global`" && Length@OwnValues[s] == 0 && 
      Length@DownValues[s] == 0 :> Hold[s], Infinity, 
   Heads -> True]},(*Module[{##},code]&@@vars*)(*original*)
   vars /. Hold[v___] :> 
   Module[{v}, code] (*Leonid Shifrin's suggestion*)]

   (*now my actual function*)

    conscalc[d1_, d2_] := 
    localizeAll[
     Block[{h1 = d1, h2 = d2, y, c, q, tt, em, tm, all, ll, i, j, allmat, NBN},


  CloseKernels[]; LaunchKernels[8]; Kernels[]; n := 2; m := 2

; cons := Table[Subscript[(y), (i - 1)], {i, n + 1}]
; consN := Table[Subscript[(cons), j], {j, m}]
; fconsN := Table[Subscript[c, i - 1, j], {i, n + 1}, {j, m}]
; prices := Table[Subscript[p, i], {i, n}]
; endows := Table[Subscript[e, i - 1], {i, n + 1}]
; endowsN := Table[Subscript[(endows), j], {j, m}]
; qprices := Table[Subscript[q, i], {i, n}]

; probsN := Table[Subscript[(probs), j], {j, m}]

; thetaNN := Table[Subscript[(tt), i, j], {i, n} , {j, m}]

; thetaN := Table[Subscript[(theta), j], {j, m}]
; sallaN := Table[Subscript[(salla), j], {j, m}]
; endows := Table[Subscript[e, i - 1], {i, n + 1}]
; endowsN := Table[Subscript[(endows), j], {j, m}]
; solv := Table[Subscript[(sol), i], {i, n + 2}]
; solvN := Table[Subscript[(solv), j], {j, m}]
; mat := Table[Subscript[(mm), i, j], {i, n + 1}, {j, n + 1}]
; matN := Table[Subscript[(mat), z], {z, m}]
; parmat := mat[[1 ;; -1, 2 ;; -1]]
; parmatN := Table[Subscript[(parmat), z], {z, m}]
; lagraN := Table[Subscript[(ll), z], {z, m}]

; allmat := Table[Subscript[(em), i, j], {i, n + 1}, {j, n + 1}]
; allmatN := Table[Subscript[(allmat), z], {z, m}]
; allmat2 := Table[Subscript[(dm), i, j], {i, n + 1}, {j, n + 1}]
; allmat2N := Table[Subscript[(albmat3), z], {z, m}]
; allmat4 := Table[Subscript[(tm), i, j], {i, n}, {j, n}]
; allmat4N := Table[Subscript[(allmat4), z], {z, m}]
; comthetaN := Table[Subscript[(all), j], {j, m}]
; fixmat := mat[[1 ;; -1, 1 ;; 1]]
; fixmatN := Table[Subscript[(fixmat), z], {z, m}]
; NBN := Table[Subscript[(NB), j], {j, m}]

; pay := Table[(Subscript[a, i, j]), {i, n}, {j, n}]

; baby := Table[Subscript[g, i], {i, n}]
; babyN := Table[Subscript[(baby), z], {z, m}]
; baby2 := Table[Subscript[o, i], {i, n}]
; baby2N := Table[Subscript[(baby2), z], {z, m}]





; LAGRANGE[f0_, g0_] := 
 Module[{f = f0, g = g0}, 
  l = Table[Subscript[y, i - 1], {i, 0, n + 1}]; 
  Gradf = Table[D[f, l[[i]]], {i, 1, Length[l]}]; 
  Gradg = Table[D[g, l[[i]]], {i, 1, Length[l]}];
  Solve[{Gradf == \[Lambda] Gradg, g == 0}, Append[l, \[Lambda]]]]

; SASSIGN[f0_, g0_, n0_, b0_] := 
 Module[{f = f0, g = g0, n = n0, b = b0}, 
  f := Table[Subscript[(w), z], {z, n}]; 
  Do[Subscript[(w), j] = g[[All, j, 2]], {j, 1, n}]; 
  f = Transpose[f]]


; Vf[j_, \[Alpha]_] := Log[cons[[j]]]

; probsN = h2
; pay = {{1, 1}, {1, 3}}

;(*endowsN=Table[{Sequence@@Table[ent[[j,i]],{i,1,3}]},{j,2}]*);
; endowsN = h1;
;  \[Alpha] = {(1/Subscript[v, 1]), (1/Subscript[v, 2]), (1/100), (1/
   200), (1/100)};
; \[Beta] = {(Subscript[x, 1]), (Subscript[x, 
   2]), (0.3), (0.5), (0.5)}

; i = 1; While[i <= n, Subscript[g, i] = {pay[[i]].prices}; i++] 

; parmat = {(-1)*qprices}
; allmatt4 = baby

; i = 1; While[i <= n, parmat = Append[parmat, pay[[i]]] ; i++]  

; i = 1
; j = 1

; Do[fixmatN = (ReplacePart[
   fixmatN, {j, 1, 
     i} -> {-consN[[j, 1, i]] + endowsN[[j, i]]}]), {j, m}, {i, 
 n + 1}]
; allmat = ArrayFlatten[{{parmat, fixmat}}] 

; i = 1; 
; While[i <= m, 
allmatN = (ReplacePart[allmatN, 
   i -> (ArrayFlatten[{{parmat, fixmatN[[i, 1]]}}])]) ; i++]
; allmat2N = allmatN[[1 ;; -1, 2 ;; -1]]

; i = 1
; j = 1

; Do[Subscript[(allmat4), z] = RowReduce[allmat2N[[z]]], {z, m}]
; Do[(Subscript[(tt), i, j]) = allmat4N[[j, i, 3]], {i, n}, {j, m}] 

; thetaNNN = Transpose[thetaNN]
; Split[thetaNNN, #2 - #1 < 2 &] 

; allmat6N := allmatN[[1 ;; -1, 1 ;; 1]]

; fixmatN[[1, 1, 3]]
; Do[(Subscript[(NB), j]) = -fixmatN[[j, 1, 1]] - 
  thetaNNN[[j]].allmatt4, {j, m}] 



; NBN

; Do[(Subscript[(ll), j]) = 
 Vf[1, \[Alpha][[j]]] + \[Beta][[j]] * 
   Sum[probsN[[j, i - 1]]*Vf[i, \[Alpha][[j]]], {i, 2, 
     n + 1}], {j, 1, m}] 

; \[Lambda] := Subscript[y, -1]
; lagraN

; Do[Subscript[(salla), j] = 
 SASSIGN[sal, LAGRANGE[lagraN[[j]], NBN[[j]]], 4, 2], {j, 1, m}]
; sallaN = Flatten[sallaN, 1]
; sallaN = sallaN[[1 ;; -1, 2 ;; -1]]

; i = 1
; j = 1;

; amb = 
Solve[{baby[[1]] == Subscript[q, 1], 
  baby[[2]] == Subscript[q, 2]}, {Subscript[p, 1], Subscript[p, 
  2]}]
; i = 1; While[i <= n, Subscript[o, i] = amb[[All, i, 2]]; i++];
; Do[Subscript[p, i] = Subscript[o, i], {i, 0, 2}]

; Do[Subscript[(cons), j] = sallaN[[j]], {j, m}]
; consN = Flatten[consN, 1]

; i = 1
; j = 1

 ; While[
 j <= m, {{Do[(Subscript[(y), i - 1]) = sallaN[[j, i]], {i, 1, 
    n + 1}]}, {Subscript[all, j] = 
   Simplify[-thetaNNN[[j]]]} , {Do[
   Subscript[c, i - 1, j] = sallaN[[j, i]], {i, 1, n + 1}]} }; j++];

; fconsNt = Transpose[fconsN]
; Simplify[fconsNt]

; equi = {{((Sum[fconsNt[[j, 1]], {j, 1, m}]) - (Sum[
      endowsN[[j, 1]], {j, 1, m}]))}, {(Sum[
     endowsN[[j, 2]], {j, 1, m}]) - (Sum[
     fconsNt[[j, 2]], {j, 1, m}])}};
; eka = {{(Sum[fconsNt[[j, 1]], {j, 1, m}]) - (Sum[
      endowsN[[j, 1]], {j, 1, m}]) == 
   0} , {(Sum[endowsN[[j, 2]], {j, 1, m}]) - (Sum[
      fconsNt[[j, 2]], {j, 1, m}]) == 0}};
; With[{ equk = equi, equila = eka, r1 = Subscript[x, 1] , 
 r2 = Subscript[x, 2] , v3 = (Subscript[v, 1]) , 
 v4 = (Subscript[v, 2])}, 
Manipulate[{{r1}, {r2}, {v3}, {v4}}; {Plot3D[
   equk, {Subscript[q, 2], 0, 5}, {Subscript[q, 1], 0, 5}, 
   AxesLabel -> Automatic], 
  ContourPlot[
   equila, {Subscript[q, 2], 0, 2}, {Subscript[q, 1], 0, 2}, 
   AxesLabel -> Automatic]}, {r1, 0, 3}, {r2, 0, 3}, {v3, 10, 
  500}, {v4, 10, 500}, LocalizeVariables -> False]]

; Subscript[x, 1] = 1
; Subscript[x, 2] = 1
; Subscript[v, 1] = 200
; Subscript[v, 2] = 200

; qsolv = 
Solve[(Sum[fconsNt[[j, 1]], {j, 1, m}]) == (Sum[
     endowsN[[j, 1]], {j, 1, m}]) && (Sum[
     fconsNt[[j, 2]], {j, 1, m}]) == (Sum[
     endowsN[[j, 2]], {j, 1, m}]), {Subscript[q, 1], Subscript[q, 
  2]}, Reals];
; tol = SASSIGN[tol, qsolv, 2, 0]
; Subscript[q, 1] = tol[[1, 1]]
; Subscript[q, 2] = tol[[1, 2]]

; Simplify[comthetaN];
; Simplify[fconsNt]]]



 g = 30; h = 10
 consume := Table[Subscript[(e), j], {j, 1, h}]
 qprix := Table[Subscript[(o), j], {j, 1, h}]
 thet := Table[Subscript[(r), j], {j, 1, h}]

 a[i_, j_, k_] := {{e1, e2, e3}, {e4, e5, e6}}

 po[i_, k_] := {{0.05 + (i/1000), 0.95 - (i/1000)}, {0.1 + (k/1000), 0.9 - (k/1000)}}



 b5[r1_, r2_, z_] = conscalc[{{r1, r1, r1}, {r2, r2, r2}}, po[z, z]]

The output is:

$ \small \left( \begin{array}{ccc} \{1. \text{r1$\$$38655}\} & \left\{\frac{\text{r1$\$$38655} (1. \text{r1$\$$38655}+1. \text{r2$\$$38655})}{1. \text{r1$\$$38655}+2. \text{r2$\$$38655}}\right\} & \left\{\frac{\text{r1$\$$38655} (1. \text{r1$\$$38655}+1. \text{r2$\$$38655})}{1. \text{r1$\$$38655}+0.946259 \text{r2$\$$38655}}\right\} \\ \{1. \text{r2$\$$38655}\} & \left\{\frac{\text{r2$\$$38655} (1. \text{r1$\$$38655}+1. \text{r2$\$$38655})}{0.5 \text{r1$\$$38655}+1. \text{r2$\$$38655}}\right\} & \left\{\frac{(0.946259 \text{r1$\$$38655}+0.946259 \text{r2$\$$38655}) \text{r2$\$$38655}}{1. \text{r1$\$$38655}+0.946259 \text{r2$\$$38655}}\right\} \\ \end{array} \right)$

My whish would be a replacement of r1$38655 to r1 as well as for r2 for the function. Pattern-matching like:

    ToExpression@StringDelete[ToString@Names["r1$*"][[2]], "$*"]

Don't seem to work

Omitting the localizeAll enables me for a correct specification. But I can't run a similar nonlocalized module (for example giving me instead of consumption values the state prices) to produce a function like the first without localizeAll (variables will be populated then and errors appear). For example this function (same module with alteration without localizeAll Block)

     i = 0
     k = 0

     b4[e1_, e2_, e3_, e4_, e5_, e6_, r3_] =  Simplify[runoncepprices[{{e1, e2, e3}, {e4, e5, e6}}, Subscript[q, 1], Subscript[q, 2], po[r3, r3]]]

    ne = Simplify[b4[Subscript[r, 1], Subscript[r, 1], Subscript[r, 1], Subscript[r,2], Subscript[r, 2], Subscript[r, 2], z][[1]]]
    de = Simplify[b4[Subscript[r, 1], Subscript[r, 1], Subscript[r, 1], Subscript[r, 2], Subscript[r, 2], Subscript[r, 2], z][[2]]]

    With[{ne1 = ne, de1 = de, r2 = Subscript[r, 2]}, Manipulate[{{z}, {r2}};
      With[{plot1 = Plot[{{ne1}, {de1}}, {Subscript[r, 1], 0, 1000}, AxesLabel -> {x, y}, ImageSize -> Large, PlotLegends -> "Expressions", PlotLabel -> {{0.05 + (z/1000), 0.95 - (z/1000)}, {0.1 + (z/1000), 0.9 - (z/1000)}}]}, 
       With[{plot2 = plot1}, {Dynamic@Tooltip[plot2, (With[{zay = MousePosition["Graphics"]}, {N[zay]}])]}]], {r2, 0, 1000}, {z, 0, 1000}, LocalizeVariables -> False]]
    ClearAll["Global`*"]; Remove["Global`*"]; CloseKernels[];

The graphic would then represent state prices p1 and p2 with changes in probabilities and aggregate endowments of the agents. x-axis is aggregate endowment of Agent 1 (r1) in period zero and period 1 with two states. r2 can be manipulated as well as the probabilities (z is a increment changer in the defined probabilities within the vector of function po) The idea in the end is that I would like to show the first function values in the tooltip of the graphic depending on the mousevalues.

Easy Debreu-Model

Thanks.

$\endgroup$
5
  • $\begingroup$ That's a fairly large example. It would be helpful to have a much smaller one that still shows the underlying issue. $\endgroup$ Apr 28 '15 at 13:41
  • $\begingroup$ Hello Daniel, I tried to state the problem with the output of "r$$38655" etc. only, but the solution " ToExpression@StringDelete[ToString@r$38655, "$*"]" seemed not to be workable in any way. Therefore I stated my whole problem. $\endgroup$ Apr 28 '15 at 13:44
  • $\begingroup$ Can anybody help me with replacing the temporary variables in the example above with a concrete code? This would help me enormously. As last remedy I can always only use one nonlocalizeAll'ed module as function and just append all therein generated functions to a array. Sadly that there's no other way so far for me. $\endgroup$ Apr 30 '15 at 12:19
  • $\begingroup$ @Daniel, the underlying issue has been stated here [link] (mathematica.stackexchange.com/questions/80751/…) . But I does not work for me in this context. $\endgroup$ Apr 30 '15 at 12:25
  • 1
    $\begingroup$ My question is then this: How did those localized variables show up to begin with? So what would be useful is a small but complete example that gives full input and the (undesired form of) output. What you have provided is an incomplete example (at the link) and a complete but rather large example here. $\endgroup$ Apr 30 '15 at 13:41
1
$\begingroup$

The replacement rules are like these for a variable with name "R1" [Ri]. Also added is a "s12" [sij] unique variable. It is important to set the rule immediately to the expression where a module is called with the localizeAll function build into it:

[expression-to-replace] /. Flatten[{Table[ Symbol["R" <> ToString[ToExpression["i"]] <> "$" <> ToString[$ModuleNumber - 1]] -> Subscript[R, i], {i, 1, n}], Table[Symbol[ "s" <> ToString[i] <> ToString[j] <> "$" <> ToString[$ModuleNumber - 1]] -> Subscript[\[Sigma], i, j], {i, 1, n}, {j, 1, n}]}]

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.