Each year there are several challenges for generative arts in the month January called “Genuary” ( https://genuary.art/prompts ). For this #genuary we have the topic ‘architecture’, so I wanted to make a fractal house:
Let’s first make a template to construct a house:
ClearAll[BuildHouse]​​BuildHouse[p:{x_,y_,z_},l_,side_:{"Left"}]:=Module[{α=0.05,β=0.03,γ=0.06,ϵ=0.005,w=0.1},​​Graphics3D[​​{​​EdgeForm[],​​RGBColor[0.97,0.92,0.52],​​Cuboid[p-l{1/2,1/2,0},p+l{1/2,1/2,1/2}],​​Cuboid[p+l{-1/2+β,1/2-α,1/2},p+l{1/2-β,1/2-β,1/2+γ}],​​Cuboid[p+l{-1/2+β,-1/2+α,1/2},p+l{1/2-β,-1/2+β,1/2+γ}],​​Cuboid[p+l{1/2-α,-1/2+α,1/2},p+l{1/2-β,1/2-α,1/2+γ}],​​Cuboid[p+l{-1/2+α,-1/2+α,1/2},p+l{-1/2+β,1/2-α,1/2+γ}],​​RGBColor[0.36,0.73,0.],​​If[MemberQ[side,"Right"],Cuboid[p+l{1/2-ϵ,-w/2,0},p+l{1/2+ϵ,w/2,1/4}],{}],​​If[MemberQ[side,"Left"],Cuboid[p+l{-1/2-ϵ,-w/2,0},p+l{-1/2+ϵ,w/2,1/4}],{}],​​If[MemberQ[side,"Front"],Cuboid[p+l{-w/2,-1/2-ϵ,0},p+l{w/2,-1/2+ϵ,1/4}],{}],​​RGBColor[0.12,0.66,0.86],​​Cuboid[p+l{-w/2+1/4,-1/2-ϵ,1/8},p+l{w/2+1/4,-1/2+ϵ,1/4}],​​Cuboid[p+l{-w/2-1/4,-1/2-ϵ,1/8},p+l{w/2-1/4,-1/2+ϵ,1/4}],​​Cuboid[p+l{1/2-ϵ,-w/2+1/4,1/8},p+l{1/2+ϵ,w/2+1/4,1/4}],​​Cuboid[p+l{1/2-ϵ,-w/2-1/4,1/8},p+l{1/2+ϵ,w/2-1/4,1/4}]​​},​​Axes->True,​​AxesLabel{x,y,z},​​Lighting"Neutral"​​]​​]​​(*Combinemultiplehouses:*)​​Show@{BuildHouse[{0,0,0},1,{"Left","Right","Front"}],BuildHouse[{-0.5+1/6,-0.5+1/6,1/2},1/3,{"Right"}],BuildHouse[{0.5-1/6,-0.5+1/6,1/2},1/3,{"Left"}]}
Out[]=
From one house, expand it such that it has 4 more houses on top of it:
ClearAll[ExpandConfig]​​ExpandConfig[sel:{p_,l_,_},α_]:=Module[{ns=αl},​​{​​{p+{-l/2+ns/2,-l/2+ns/2,l/2},ns,{"Right"}},​​{p+{l/2-ns/2,-l/2+ns/2,l/2},ns,{(*"Left"*)}},​​{p+{-l/2+ns/2,+l/2-ns/2,l/2},ns,{"Right","Front"}},​​{p+{l/2-ns/2,+l/2-ns/2,l/2},ns,{"Left","Front"}}​​}​​]​​(*fromthestartingconfigurationrepeat6timesindepth*)​​Sels={{{0,0,0},1,{"Left","Right","Front"}}};​​housespecs=NestList[Catenate[ExpandConfig[#,1/3]&/@#]&,Sels,6];​​graphics=BuildHouse@@@Catenate[housespecs];​​Show[graphics,PlotRange->All,Boxed->False,Axes->False]​​
Out[]=
Find the configuration for the house in the top-right corner for each level:
In[]:=
cb=TakeLargestBy[#[[1,2]]-#[[1,1]]&,1]/*First/@housespecs[[All,All,1;;2]]
Out[]=
{{0,0,0},1},-
1
3
,
1
3
,
1
2
,
1
3
,-
4
9
,
4
9
,
2
3
,
1
9
,-
13
27
,
13
27
,
13
18
,
1
27
,-
40
81
,
40
81
,
20
27
,
1
81
,-
121
243
,
121
243
,
121
162
,
1
243

Find the sequence function for x,y,z, and the size:
In[]:=
FindSequenceFunction[cb[[All,1,1]]]​​FindSequenceFunction[cb[[All,1,2]]]​​FindSequenceFunction[cb[[All,1,3]]]​​FindSequenceFunction[cb[[All,2]]]
Out[]=
-
1
2
-#1
3
(-3+
#1
3
)&
Out[]=
1
2
-#1
3
(-3+
#1
3
)&
Out[]=
1
4
1-#1
3
(-3+
#1
3
)&
Out[]=
1-#1
3
&
Find the camera positions based on these sequence functions:
In[]:=
ClearAll[Spec,VP]​​Spec[n_]:=-
1
2
-#1
3
(-3+
#1
3
)&[n],
1
2
-#1
3
(-3+
#1
3
)&[n],
1
4
1-#1
3
(-3+
#1
3
)&[n],
1-#1
3
&[n]​​VP[n_]:={#1+1.5{#2,-1.5#2,#2},#1+{0,0,#2/2}}&@@Spec[n]​​VP[1.5]
Out[]=
{{0.654701,-1.08771,1.18301},{-0.211325,0.211325,0.605662}}
Make some images
Dynamic[N[t]]​​imgs=Table[​​g=Show[graphics,PlotRange->All,Boxed->False,Axes->False,ViewVector->VP[t],ViewAngle->35Degree,ImageSize->2×600];​​Rasterize[g,"Image",RasterSize600,ImageSize600]​​,​​{t,Subdivide[1/100,4,133]}​​];
Out[]=
t
Fade the last 20 images:
ci=imgs;​​Do[​​ci[[-i]]//=Blend[{#,White},Clip[1-(i-1)0.05,{0,1}]]&;​​,​​{i,20}​​];
Export the gif:
SetDirectory[NotebookDirectory[]]​​Export["2022_9.gif",ci,"DisplayDurations"->1/30]
Out[]=
2022_9_2.gif

CITE THIS NOTEBOOK

Genuary 2022: Architecture - Courtyard with 4 houses​
by Sander Huisman​
Wolfram Community, STAFF PICKS, January 14, 2022
​https://community.wolfram.com/groups/-/m/t/2446413