Reassign Functions for Graphic Representation [closed]

Question

How might I construct a function of the form Rep[defs,code], graphic[code] and display[code] Such that the following outputs can occur?

Rep[
 y[a__] := Graphics[{Circle[],
    Inset[
     graphic[a]
     , Scaled[{0.498, 0.5020000000000002}], Center, 
     Scaled[{0.5, 0.5}]]}, ImagePadding -> 0,
   PlotRangePadding -> 0];
 Times[a_, b_] := Graphics[{RGBColor[1, 0, 0], Rectangle[{0, 0}],
    Black, Inset[
     display[a*b]
     , Scaled[{0.498, 0.5020000000000002}], Center, Scaled[{0.5, 0.5}]]
    }, ImagePadding -> 0, ImageSize -> {85., Automatic}, 
   PlotRangePadding -> 0];
 , graphic[y[y[a*b]]]
 ]

Rep[ 
 Sum[f_, {i_, max_}] :=
  Graphics[{Circle[],
    Inset[
     Sum[f, {i, max}]
     , Scaled[{0.498, 0.5020000000000002}], Center,
     Scaled[{0.5, 0.5}]]}, ImagePadding -> 0,
   PlotRangePadding -> 0],
 graphic[Sum[x^2 , {x, 10}]]
 ]

Here is my current attempt of creating Rep[funs,code]. The biggest problem that I have currently, is that I am trying to define custom functions on top of System attributes(Times & Plus). In addition I was originally going to add a namespace Gr to the passed in variables but I feel that there is likely a better way.

Questions are welcome around the current implementation or a slightly better/different implementation.

My question: How can I construct the functions above such that they satisfy the graphic outputs?

Answer 1

So it looks like what you want to do is apply the temporary definitions in defs to code, then show the output. Here's what I came up with.

SetAttributes[Rep, HoldAll];

Rep[defs_, code_] := Module[{symsTrans, downVals},
    symsTrans = Union[Cases[Hold[defs], 
        HoldPattern[SetDelayed][f_[___], _] :> (f -> "changeMe"[f]), {0, \[Infinity]}]];

    downVals = Union[Cases[Hold[defs], HoldPattern[SetDelayed][f_[a___], b_] :> 
        RuleDelayed[HoldPattern["changeMe"[f][a]], b], {0, \[Infinity]}]];

    ReleaseHold[Hold[code] /. symsTrans //. downVals]
]

(* flatten all graphics into one *)
graphic[obj_] := Module[{ops},
    ops = Sequence @@ Flatten[Cases[obj, Graphics[l_, op___] :> {op}, {0, \[Infinity]}]];

    Graphics[{obj}, ops] //. {
        Graphics[{a___, Graphics[l_, ___], b___}, o___] :> Graphics[{a, l, b}, o]}
]

(* not sure what this should be *)
display[expr_] := Text[expr]

Here, symsTrans will only allow your custom down values to be applied to the expressions only visible through code i.e. since your custom Sum contains Sum, we'd be in an infinite loop applying this definition.

Here are the outputs:

Rep[
 y[a__] := Graphics[{Circle[],
    Inset[
     graphic[a]
     , Scaled[{0.498, 0.5020000000000002}], Center, 
     Scaled[{0.5, 0.5}]]}, ImagePadding -> 0,
   PlotRangePadding -> 0];
 Times[a_, b_] := Graphics[{RGBColor[1, 0, 0], Rectangle[{0, 0}],
    Black, Inset[
     display[a*b]
     , Scaled[{0.498, 0.5020000000000002}], Center, Scaled[{0.5, 0.5}]]
    }, ImagePadding -> 0, ImageSize -> {85., Automatic}, 
   PlotRangePadding -> 0];
 , graphic[y[y[a*b]]]
 ]

Rep[ 
 Sum[f_, {i_, max_}] :=
  Graphics[{Circle[],
    Inset[
     Sum[f, {i, max}]
     , Scaled[{0.498, 0.5020000000000002}], Center,
     Scaled[{0.5, 0.5}]]}, ImagePadding -> 0,
   PlotRangePadding -> 0],
 graphic[Sum[x^2 , {x, 10}]]
 ]

Let me know if this is what you want (It wasn't very clear to me) or if this doesn't work for other examples you may have.