Merge two graphic objects

Question

I'd like to recursively draw tangles (=knots with open ends). So, the fundamental object O is a crossing, having some fixed size, say fitting into Rectangle[{{-100,-100},{100,100}}], e.g. {Line[{{-100, 100}, {100, -100}}], Line[{{-100, -100}, {-50, -50}}], Line[{{50, 50}, {100, 100}}]}.

I must be able to "add" any two objects O1,O2 (rescale object O1 to fit into Rectangle[{{-100,-100},{0,100}}], object O2 to fit into Rectangle[{{0,100},{100,100}}] - i.e. O1 is compressed into the left and O2 into the right half of the rectangle - merge and store as a new graphic object "O1+O2") and "rotate" any object O1 (rotate O1 around 0,0 by 90 degrees). In both cases the new object fits into the rectangle above again. Visually:

O1 O2 O1+O2 R[O1]

(I assume this can be reused?!)

(EDIT: I think I have an own idea: Since my graphic objects are just lists of Line[[{x1,y1},{x2,y2}}]] statements, I could simply map the contractions over them, I just have to handle when a statement is "left" or "right". I always have trouble with multiple slot syntax, but I guess I manage that...)

Answer 1

Try this:

tangle = Show[{
   Graphics[{White, Rectangle[{-100, 100}]}],
   Graphics[{Black, Line[{{-100, 100}, {100, -100}}], 
     Line[{{-100, -100}, {-50, -50}}], Line[{{50, 50}, {100, 100}}]}]
   }, ImageSize -> 100]

See the function Rotate to rotate subobjects.

Have fun!

Answer 2

I wouldn't mind at all if you optimize the following code which is a bit clumsy but seems to work:

ClearAll["Global`*"];
B[0]="|";B[1]="<";B[-1]=">";
FF[]:="";
FF[x___,i_]:=FF[x]<>B[i];
PR[x_]:=x/.{AD->MG,RO->BR}/.{F->FF};
MG[F[x___],F[y___]]:=F[x,y];
BR[F[x___]]:=F[1,x,-1];
RM[{}]:={};
RM[{x_,y___}]:={R0[x],RM[{y}]}//Flatten;
R0[Line[{{x1_,y1_},{x2_,y2_}}]]:=Line[{{y1,-x1},{y2,-x2}}];
AM[{u_,v___},{x_,y___}]:={A1[u],A2[x],AM[{v},{y}]}//Flatten;
AM[{u_,v___},{}]:={A1[u],AM[{v},{}]}//Flatten;
AM[{},{x_,y___}]:={A2[x],AM[{},{y}]}//Flatten;
AM[{},{}]:={};
A1[Line[{{x1_,y1_},{x2_,y2_}}]]:=Line[{{x1/2-50,y1},{x2/2-50,y2}}];
A2[Line[{{x1_,y1_},{x2_,y2_}}]]:=Line[{{x1/2+50,y1},{x2/2+50,y2}}];
VI[x_]:=x/.{F[0]->{Line[{{100,-100},{-100,100}}],Line[{{100,100},{50,50}}],Line[{{-50,-50},{-100,-100}}]}}/.{RO->RM,AD->AM};

AD[F[0],RO[F[0]]]:=o;
AD[RO[F[0]],F[0]]:=o;
RO[o]:=u;
RO[u]:=o;
AD[x___,o]:=x;
AD[o,x___]:=x;
AD[x___,u]:=u;
AD[u,x___]:=u;

L[1]:={F[0],RO[F[0]]};
L[n_]:=Table[{AD[L[k][[i]],L[n-k][[j]]],RO[AD[L[k][[i]],L[n-k][[j]]]]},{k,1,Floor[n/2]},{i,1,Length[L[k]]},{j,1,Length[L[n-k]]}]//Flatten//Union//Sort//Rest//Rest;

SH[n_]:=(#//VI//Graphics//Show)&/@L[n];

Explanations: When generating the tangle list, RO marks a rotation and AD an add operation. These stay undefined. PR(Print) turns the stuff into a readable list, with brackets indicating rotation and merge add (BR,MG). To turn the stuff into graphics, RM and AM recursively run through the Line operations. If they encounter a single line, they rescale the coordinates for rotation, left shrink or right shrink - R0,A1,A2. (Since AD has two arguments, AM "knows" the sides.) It's quite possible that F isn't needed but I wanted it in case of on-the-fly execution of laws like that an overcrossing and undercrossing annihilate. (Special o and u tangles.) The tangle list itself is recursively generated by adding and rotating smaller tangles.

The next step is now adding more laws to exclude tangles which can be simplified (which is not a trivial matter...).

SH[2]