(****************************************************************************) (* *) (* EvolvePlanes.m *) (* *) (* evolving 3d models of jet aircrafts *) (* *) (* Thang Nguyen *) (****************************************************************************) (************* Utilities for random picking, 3-D graphics ****************) Clear[ HeadsInExp]; HeadsInExp[expr_] := Map[Head[#]&, expr]; Clear[RandomPick]; RandomPick[list_List] := list[[ Random[Integer, {1, Length[list]}] ]] /; Length[list] > 0; RandomPick[list_List] := list /; Length[list] == 0; (* Make Polygons from ParametricPlot3D.m by Roman Maeder. Used in ListSurfacePlot. *) Clear[MakePolygons]; MakePolygons[vl_List] := Module[{l = vl, l1 = Map[RotateLeft, vl], mesh}, mesh = {l, l1, RotateLeft[l1], RotateLeft[l]}; mesh = Map[Drop[#, -1]&, mesh, {1}]; mesh = Map[Drop[#, -1]&, mesh, {2}]; Polygon /@ Transpose[ Map[Flatten[#, 1]&, mesh] ] ]; Clear[AllPoints, AllParts, AllLeaves, AllSubFunctions]; AllPoints[expr_] := Block[{points, fragments}, points = Select[Position[expr, _], (# != {})&]; fragments = Apply[expr[[##]]&, points, 1]; Return[Transpose[Append[List[fragments], points]]] ]; AllParts[expr_] := Select[AllPoints[expr], (Last[#[[2]]] != 0)&]; AllLeaves[expr_] := Select[AllParts[expr], (Depth[#[[1]]] == 1)&]; AllSubFunctions[expr_] := Select[AllParts[expr], (Depth[#[[1]]] > 1)&]; (******************** Random, Grammar-based model generation *************) Clear[ GenerateOneDesign, GenerateDesigns, DrawFromDesign, DrawAllDesigns, ExtractFrame, ExtractParameters, SetParamRules, CrossEnginesAndTails, CrossParameters, CrossAParameter]; (* An airplane design: {{index, Btype}, position, planeFrame, planeParameters, most recent changes due to crossover or mutation, score given by user} *) ModelPosition[design_] := design[[2]]; ModelFrame[design_] := design[[3]]; ModelParameters[design_] := design[[4]]; SetParamRules[ paramlist_]:= Map[ Rule[#[[1]], #[[2]]]&, paramlist]; HSpace = 16.5; GenerateDesigns[ genIndex_, popsize_] := Table[ GenerateOneDesign[genIndex, n, { HSpace * (n-1), 0, 0 } ], {n, 1, popsize} ]; (* position of plane pre-arranged, 1-d horiz. row *) GenerateOneDesign[genIndex_, index_, position_] := Module[{ planeStructure, planeParameters}, planeStructure = Plane//.PlaneFrame; planeParameters = Sort[ Map[SampleAParameter[#, RandomBinaryString[4]]&, Constraints]]; Return[ List[ {genIndex, index, Random}, position, planeStructure, planeParameters, {}] ]; ]; (***********) Clear[Constraints, HiddenParameters]; Constraints = { {midbodyLength, IsWithin, {6.0, 9.0}}, {bodyDiameter, IsWithin, {0.8, 1.3}}, {wingHSpan, IsWithin, {4.5, 6.8}}, {wingbaseWidth, IsWithin, {1.7, 3.0}}, {wingExbaseWidth, IsWithin, {0.8, 2.0}}, {wingbaseleadPointX, IsWithin, {0.52, 0.65}, midbodyLength}, {wingElbowK, IsWithin, {0.2, 0.37}, wingHSpan}, {wingSweep, IsWithin, {2.0, 5.0}}, {wingtipWidth, IsWithin, {0.35, 0.6}}, {wingEngineFromBase, IsWithin, {0.25, 0.5}, wingHSpan}, {bodyEngineFromTail, IsWithin, {-0.15, 0.05}, midbodyLength}, {rudderbaseWidth, IsWithin, {1.6, 2.0}}, {ruddertipHeight, IsWithin, {2, 2.4}}, {ruddertipWidth, IsWithin, {0.7, 1.2}}, {rudderSweep, IsWithin, {0.8, 1.6}}, {tailHSpan, IsWithin, {1.8, 2.7}}, {tailbaseWidth, IsWithin, {1.0, 1.8}}, {tailSweep, IsWithin, {0.7, 1.3}}, {tailtipWidth, IsWithin, {0.3, 0.6}} }; HiddenParameters = { rudderbaseHeight -> tailLength*Sin[0.15] + 0.02, rudderleadPointX -> -tailLength + rudderbaseWidth + 0.06, tailLength -> 2.3, tailRaise -> 0.15, BodyTailsMount -> {-tailLength + tailbaseWidth + 0.05, \ 0, rudderbaseHeight }, RudderTailsMount -> {rudderleadPointX - rudderSweep + 0.05, 0, ruddertipHeight - 0.1}, wingRaise -> 0.5, wingbaseHeight -> -0.4*bodyDiameter, enginemaxR -> 0.3, enginewingSpace -> -1.5*enginemaxR, TEnginebodySpace -> -0.1 + enginemaxR + bodyDiameter/2, enginewingLead -> -0.6, enginebodySpace -> 0.8*(bodyDiameter + enginemaxR) }; Clear[ParamNameList]; ParamNameList = Map[#[[1]]&, Constraints]; (*******) Clear[PlaneFrame, PlaneDesign]; PlaneFrame := { Plane->DesignPlane[Body, AllEngines, Wings, Tails, Rudder], Body->SketchBody[midbodyLength, tailLength, bodyDiameter], (* gives list of body polygons *) AllEngines->EnginesPick[ NumOfEngines[ Random[] ]], (* give list of engines configured properly *) WEngines->WEnginesAt[ wingEngineFromBase ], BEngines->BEnginesAt[ bodyEngineFromTail ], Wings->SketchWings[ wingHSpan, wingbaseWidth, wingExbaseWidth, wingbaseleadPointX, wingElbowK, wingSweep, wingtipWidth], (* a polygon of the 2 wings *) Tails->SketchTails[ tailHSpan, tailbaseWidth, tailtipWidth, tailSweep, TailsMount], Rudder->SketchRudder[rudderbaseWidth, ruddertipWidth, ruddertipHeight, rudderSweep] }; PlaneDesign = { SketchBody -> DesignBody, SketchWings -> DesignWings, WEnginesAt -> WingEnginesAt, BEnginesAt -> BodyEnginesAt, TEngine -> TailEngine, SketchTails -> DesignTails, SketchRudder -> DesignRudder }; (*********) Clear[EnginesPick, EngineConfigs, NumOfEngines]; NumOfEngines[ randX_] := 1 /; (randX >= 0.0)&&(randX < 0.1); NumOfEngines[ randX_] := 2 /; (randX >= 0.1)&&(randX < 0.5); NumOfEngines[ randX_] := 3 /; (randX >= 0.5)&&(randX <= 1.0); EnginesPick[ NumEngines_] := RandomPick[ Select[EngineConfigs, (#[[1]] == NumEngines)&][[1, 2]] ]; EngineConfigs = \ { {1, {{TEngine}}}, {2, {{WEngines}, {BEngines}}}, {3, {{WEngines, TEngine}, {BEngines, TEngine}}} }; (********* Geometric primitive assembly and Graphic Rendering ***************) Clear[PlaneAssembly, PlaneKit, PlaneForm, DrawAllDesigns, DrawFromDesign]; PlaneAssembly[ parts_] := Join[ parts[[1]], Flatten[ parts[[2]], 1], List[ parts[[3]], parts[[4]], parts[[5]] ] ]; SampleParams := Join[HiddenParameters, SetParamRules[ Map[SampleAParameter[#, RandomBinaryString[4]]&, Constraints] ]]; DrawAllDesigns[ alldesigns_] := Join[ List[Graphics3D[ List[ PrependTo[ PlaneAssembly[ModelFrame[ alldesigns[[1]] ] //.PlaneDesign //.Join[HiddenParameters, \ SetParamRules[ModelParameters[ alldesigns[[1]] ]]] ], EdgeForm[{Thickness[0.0007]}] ], Text[FontForm[ToString[Drop[ alldesigns[[1, 1]], 2]], {"Times", 5}], Plus[{5.8, 7.2, 0}, alldesigns[[1, 2]]] ], Text[FontForm[ StringJoin[ "gen", ToString[ alldesigns[[1, 1, 1]] ], ":#", ToString[ alldesigns[[1, 1, 2]] ] ], {"Times", 7}], Plus[{8, 5, 0}, alldesigns[[1, 2]]] ] ], PlotRange->All, Shading->False, Boxed->False] ], Map[DrawFromDesign[#]&, Drop[alldesigns, 1]] ]; DrawFromDesign[ design_] := Graphics3D[ List[PrependTo[ MoveAllPolygons[PlaneAssembly[ModelFrame[design] //.PlaneDesign \ //.Join[HiddenParameters, SetParamRules[ModelParameters[design]]] ], design[[2]] ], (* move assembly to position *) EdgeForm[{Thickness[0.0007]}] ], Text[FontForm[ToString[Drop[ design[[1]], 2]], {"Times", 5}], Plus[{5.8, 7.2, 0}, design[[2]]] ], Text[FontForm[ StringJoin[ "gen", ToString[ design[[1, 1]] ], ":#", ToString[ design[[1, 2]] ] ], {"Times", 7}], Plus[{8, 5, 0}, design[[2]]] ] ], PlotRange->All, Shading->False, Boxed->False ]; Clear[SeeFrames, ShowStandardView]; SeeFrames[designs_] := Map[#[[3]]&, designs]; ShowStandardView[designs_] := Show[DrawAllDesigns[designs], ViewPoint->{0, -2, 10}]; (******************* Generational Processing and Main Module ***********) Clear[MutateAPlane, BreedNewPlanes, EvolvePlanes]; SizeOfPopulation = 4; FitnessGoal = 100; MaxNumberOfGenerations = 5; EvolvePlanes[IDtag_String] := Block[{population, allpopulations, PlanesAndPlots, recordS = "runText", genS = "runPlanes", date, conD = "_", , conP = "-", Dtag, Ptag, ParVarEnv, startTime = Take[Date[], -4], stopTime}, Ptag = StringJoin[ToString[SizeOfPopulation], "G", ToString[MaxNumberOfGenerations]]; date = Map[ToString[#]&, Take[Date[], {2, 4}]]; Dtag = StringJoin[date[[1]], conD, date[[2]], conD, date[[3]]]; recordFile = StringJoin[recordS, Dtag, conP, Ptag, IDtag]; gensFile = StringJoin[genS, Dtag, conP, Ptag, IDtag]; PrependTo[$Echo, recordFile]; PrependTo[$Output, recordFile]; PrependTo[$Messages, recordFile]; Print[]; Print[" date stamp: ", Date[], " ", recordFile]; Print[]; Print[""]; Print["********* Creating the first generation ******"]; Print[" of ", SizeOfPopulation, " planes"]; Print[""]; Print[" FitnessGoal = ", FitnessGoal]; Print[" generations limit = ", MaxNumberOfGenerations]; Print[]; population = GenerateDesigns[ 0, SizeOfPopulation]; PlanesAndPlots = BreedNewPlanes[population, MaxNumberOfGenerations, FitnessGoal]; allpopulations = PlanesAndPlots[[1]]; stopTime = Take[Date[], -4]; Print[""]; Print["___ Run Time = ", 60*(60*( 24*(stopTime[[1]] - startTime[[1]]) \ + (stopTime[[2]] - startTime[[2]])) + stopTime[[3]] - startTime[[3]]) \ + stopTime[[4]] - startTime[[4]], " Seconds"]; Print["___ max memory used: ", N[MaxMemoryUsed[]/10^6], " MBytes"]; Print["___ memory in use: ", N[MemoryInUse[]/10^6], " MBytes"]; $Echo = Drop[$Echo, 1]; $Output = Drop[$Output, 1]; $Messages = Drop[$Messages, 1]; SaveTo[gensFile, allpopulations]; Return[PlanesAndPlots] ]; Clear[SaveTo]; SaveTo[file_String, data_] := {OpenWrite[file]; Write[file, data]; Close[file];} BreedNewPlanes[planes_, maxIter_, fitnessGoal_] := Module[{ allplanes = {}, i, j, currentbestscore, scores, currentplanes, newplanes, crossedplanes, mutatedplane, mutateIndex, plots, allplots = {}, combinedplot, startPlotTime, endPlotTime, genIndex }, currentbestscore = 0; i = 0; currentplanes = planes; genIndex = planes[[ 1, 1, 1 ]]; While[( genIndex <= maxIter)&&(currentbestscore < fitnessGoal), Print[""]; Print["___start processing the ", genIndex, "th generation. Preparing plots..."]; Print["___current plane tags: ", Map[#[[1]]&, currentplanes]]; startPlotTime = Take[Date[], -4]; plots = ShowStandardView[currentplanes]; AppendTo[allplots, plots]; Print[""]; Print["___just shown generation number ", genIndex ]; endPlotTime = Take[Date[], -4]; Print["___ Plot time = ", 60*(60*( 24*(endPlotTime[[1]] \ - startPlotTime[[1]]) \ + (endPlotTime[[2]] - startPlotTime[[2]])) + endPlotTime[[3]] - startPlotTime[[3]]) \ + endPlotTime[[4]] - startPlotTime[[4]], " Seconds"]; If [currentbestscore >= fitnessGoal, Break[]]; genIndex++; scores = Input["___enter list of 4 scores for the planes: "]; For[j = 1, j <= Length[scores], j++, AppendTo[currentplanes[[j]], {ScoreGivenIs, scores[[j]]}]]; scores = Sort[ Transpose[ List[Range[1, 4], scores]], \ (#1[[2]] > #2[[2]])& ]; AppendTo[allplanes, currentplanes]; mutateIndex = Random[Integer, {1, Length[currentplanes]}]; currentbestscore = scores[[1, 2]]; Print["___the rank scores of indexed planes: ", TableForm[scores]]; Print["___the mutated plane has index = ", mutateIndex]; Print[" current best score = ", currentbestscore]; crossedplanes = CrossOver2Planes[currentplanes[[scores[[1, 1]] ]], currentplanes[[scores[[2, 1]] ]] ]; mutatedplane = MutateAPlane[ currentplanes[[mutateIndex]], 3, { HSpace * 2, 0, 0} ]; newplanes = Join[ crossedplanes, List[ mutatedplane, GenerateOneDesign[ genIndex, 4, { HSpace * 3, 0, 0}] ] ]; currentplanes = newplanes; ]; Return[List[allplanes, allplots]] ]; MutateAPlane[plane_, index_, position_] := Module[{ randomPlane, mutatedPlane, genIndex }, genIndex = plane[[1, 1]]+1; randomPlane = GenerateOneDesign[ genIndex, index, position ]; mutatedPlane = CrossOver2Planes[ plane, randomPlane ][[1]]; Return[ Join[ List[ {genIndex, index, Mutated, { plane[[1, 2]], UnKRandom }}, position ], Drop[mutatedPlane, 2]] ] ]; (*************************** Structural Crossovers *************************) Clear[ CrossOver2Planes, PlaneIndex]; PlaneIndex[design_] := design[[1, 2]]; CrossOver2Planes[ modelA_, modelB_] := Module[{ frameA, frameB, NewFrames, newPlanes, newframeA, newframeB, birthRecA = {}, birthRecB = {}, genIndex }, newA = modelA; newB = modelB; NewFrames = List[ModelFrame[newA], ModelFrame[newB]]; genIndex = modelA[[1, 1]]; If [ Random[] < 0.9, Print["___cross engines"]; NewFrames = CrossEnginesOf2Frames[ NewFrames[[1]], NewFrames[[2]]]; AppendTo[birthRecA, CrossEngines]; AppendTo[birthRecB, CrossEngines] ]; (* if different engines, keep record *) If [ ToString[NewFrames[[1, 2]]] != ToString[modelA[[3, 2]]], AppendTo[birthRecA, List[AllEngines, {newVal, NewFrames[[1, 2]]}, {oldVal, modelA[[3, 2]]}]]; AppendTo[birthRecB, List[AllEngines, {newVal, NewFrames[[1, 2]]}, {oldVal, modelA[[3, 2]]}]] ]; If [ Random[] < 0.9, Print["___cross tail mounts"]; NewFrames = CrossTailMountings[ NewFrames[[1]], NewFrames[[2]] ]; AppendTo[birthRecA, CrossTailMounts]; AppendTo[birthRecB, CrossTailMounts] ]; (* if different tailmounts, keep record *) If [ToString[NewFrames[[1, 4, 5]]] != ToString[modelA[[3, 4, 5]]], AppendTo[birthRecA, List[TailsMountPoint, {newVal, NewFrames[[1, 4, 5]]}, {oldVal, modelA[[3, 4, 5]]}]]; AppendTo[birthRecB, List[TailsMountPoint, {newVal, NewFrames[[2, 4, 5]]}, {oldVal, modelB[[3, 4, 5]]}]] ]; newA = ReplacePart[ReplacePart[newA, NewFrames[[1]], 3], birthRecA, 5]; (* replace airframe and birth record *) newB = ReplacePart[ReplacePart[newB, NewFrames[[2]], 3], birthRecB, 5]; newPlanes = CrossParametersOf2Planes[newA, newB]; Return[ List[ Join[ { { genIndex+1, 1, Crossed, List[ modelA[[1, 2]], modelB[[1, 2]] ]}, {0, 0, 0} }, newPlanes[[1]] ], Join[ { { genIndex+1, 2, Crossed, List[ modelB[[1, 2]], modelA[[1, 2]] ]}, {16, 0, 0} }, newPlanes[[2]] ] ] ] ]; (*******) Clear[ CrossEngines, CrossEnginesOf2Frames, HasTailEngine, CrossTailMountings ]; HasTailEngine[engines_] := MemberQ[engines, TEngine]; CrossEnginesOf2Frames[ planeframeA_, planeframeB_] := Module[{ enginesA, enginesB, newengines}, enginesA = planeframeA[[ 2]]; enginesB = planeframeB[[ 2]]; newengines = CrossEngines[ enginesA, enginesB ]; Return[ List[ ReplacePart[ planeframeA, newengines[[1]], 2], ReplacePart[ planeframeB, newengines[[2]], 2] ]]; ]; CrossTailMountings[ planeframeA_, planeframeB_] := Module[{ AMount, BMount}, AMount = planeframeA[[4, 5]]; BMount = planeframeB[[4, 5]]; Return[ List[ ReplacePart[ planeframeA, BMount, {4, 5} ], ReplacePart[ planeframeB, AMount, {4, 5} ] ]]; ]; CrossEngines[ enginesA_, enginesB_] := Which[ Equal[ ToString[enginesA], ToString[enginesB]], Return[ List[enginesA, enginesB] ], (* no change! *) HasTailEngine[enginesA] && HasTailEngine[enginesB], Which[ (Length[enginesA] == 2)&&(Length[enginesB] == 2), Return[ List[ List[enginesB[[1]], enginesA[[2]]], List[enginesA[[1]], enginesB[[2]]] ]], (Length[enginesA] == 2)||(Length[enginesB] == 2), Return[ List[ enginesB, enginesA ]], (Length[enginesA] == 1)&&(Length[enginesB] == 1), Return[ List[enginesB, enginesA]] (* no change! *) ], HasTailEngine[enginesA]&&(Length[enginesA] == 2), Which[ Random[] > 0.5, (* exchange non-TailEngines *) Return[ List[ List[enginesB[[1]], enginesA[[2]]], List[enginesA[[1]]] ]], True, (* switch TailEngine from A to B *) Return[ List[ Drop[enginesA, -1], List[ enginesB[[1]], enginesA[[2]]] ]] ], HasTailEngine[enginesB]&&(Length[enginesB] == 2), Which[ Random[] > 0.5, (* exchange non-TailEngines *) Return[ List[ List[enginesB[[1]] ], List[enginesA[[1]], enginesB[[2]]] ]], True, (* switch TailEngine from B to A *) Return[ List[ List[enginesA[[1]], enginesB[[2]]], Drop[enginesB, -1] ]] ], True, (* each engine set has only one type, just exchange whole sets *) Return[ List[enginesB, enginesA] ] ]; (********) Clear[SampleParameters, CrossParametersOf2Planes, NoteChangedParams]; Clear[CrossParameterStrings, CrossBinaryStrings]; CrossParametersOf2Planes[ modelA_, modelB_] := Module[{ sampledparams, origAparams, origBparams, Aparams, Bparams, sampledAparams, sampledBparams, crossedParams, changedAparams, changedBparams}, sampledparams = SampleParameters[ ModelFrame[modelA] ]; Aparams = ModelParameters[modelA]; Bparams = ModelParameters[modelB]; sampledAparams = Sort[Select[ Aparams, (MemberQ[sampledparams, #[[1]]])&]]; sampledBparams = Sort[Select[ Bparams, (MemberQ[sampledparams, #[[1]]])&]]; origAparams = Select[ Aparams, (!MemberQ[sampledparams, #[[1]]])&]; origBparams = Select[ Bparams, (!MemberQ[sampledparams, #[[1]]])&]; Print[""]; crossedParams = Transpose[ Map[ CrossParameterStrings[#]&, Transpose[ List[sampledAparams, sampledBparams ]]] ]; changedAparams = NoteChangedParams[crossedParams[[1]], sampledAparams]; changedBparams = NoteChangedParams[crossedParams[[2]], sampledBparams]; Print["___changed A params: "]; Print[changedAparams]; Print[]; Print["___changed B params: "]; Print[changedBparams]; Return[ List[List[modelA[[3]], Sort[Join[crossedParams[[1]], origAparams]], Join[modelA[[5]], changedAparams] ], List[modelB[[3]], Sort[Join[crossedParams[[2]], origBparams]], Join[modelB[[5]], changedBparams] ] ]] ]; CrossParameterStrings[ parameterPair_] := Module[{ Aparam, Bparam, newStrings}, Aparam = parameterPair[[1]]; Bparam = parameterPair[[2]]; newStrings = CrossBinaryStrings[ Aparam[[3]], Bparam[[3]] ]; Return[ List[ UpdateAParameter[ Aparam[[1]], newStrings[[1]] ], UpdateAParameter[ Bparam[[1]], newStrings[[2]] ]]] ]; CrossBinaryStrings[ stringA_, stringB_] := Module[{ crosspoint, newA, newB}, crosspoint = Random[Integer, {1, Length[stringA] - 1}]; newA = Join[ Take[stringB, crosspoint], Drop[stringA, crosspoint] ]; newB = Join[ Take[stringA, crosspoint], Drop[stringB, crosspoint] ]; Return[ List[newA, newB] ] ]; SampleParameters[ planeframe_] := Module[{ sampledparameters}, sampledparameters = Join[ PickParametersFromStructure[ RandomPick[AllSubFunctions[Delete[planeframe, 2]]]], List[ wingEngineFromBase, bodyEngineFromTail ]]; Return[sampledparameters] ]; NoteChangedParams[ newparams_, oldparams_] := Module[{changedparams = {}, i}, For[i = 1, i <= Length[newparams], i++, If [ ((newparams[[i, 1]] == oldparams[[i, 1]]) && \ (newparams[[i, 2]] != oldparams[[i, 2]])), AppendTo[changedparams, List[oldparams[[i, 1]], {newVal, newparams[[i, 2]]}, {oldVal, oldparams[[i, 2]]}, {newString, newparams[[i, 3]]}, {oldString, oldparams[[i, 3]]} ]] ]; ]; Return[changedparams] ]; (***************** Parameter Manipulations and Crossovers ******************) Clear[RandomBinaryString, BinaryToDecimal, SampleAParameter, UpdateAParameter, BinarySampleOnInterval, PickParametersFromStructure]; RandomBinaryString[lgth_] := Table[ Random[Integer, {0,1}], {lgth} ]; BinaryToDecimal[binstring_] := Module[{value, k, len = Length[binstring]}, value = 0; For[ k=1, k<= len, k++, value += binstring[[k]] * 2^(len - k); ]; Return[value]; ]; SampleAParameter[ paramDef_, binstring_] := List[ paramDef[[1]], BinarySampleOnInterval[binstring, paramDef[[3]] ], binstring ]; BinarySampleOnInterval[binstring_, interval_] := (interval[[1]] + BinaryToDecimal[binstring]*(interval[[2]] \ - interval[[1]])/(2^Length[binstring] - 1)); PickParametersFromStructure[ partOfplane_ ] := Map[ First[#]&, Select[ AllLeaves[partOfplane], (MemberQ[ ParamNameList, #[[1]] ])& ] ]; UpdateAParameter[ paramName_, paramString_] := SampleAParameter[ Select[Constraints, (#[[1]] == paramName)&][[1]], paramString]; (********* Lowest-level Geometric Primitive Constructions ****************) (************** for all jet plane parts and engines *****************) Clear[FlipXZ, Translate3DPatch, RotateOnYAxis, MoveAllPolygons, MoveOnePolygon]; FlipXZ[point_] := List[point[[1]], -point[[2]], point[[3]]]; RotateOnYAxis[point_, alpha_] := Dot[ { {Cos[alpha], 0, -Sin[alpha]}, {0, 1, 0}, {Sin[alpha], 0, Cos[alpha]} }, point]; (* a patch is a list of lists of points *) Translate3DPatch[patch_, transvec_] := Block[{i, result ={}}, For[i = 1, i <= Length[patch], i++, AppendTo[result, Map[Plus[transvec, #]&, patch[[i]]] ]; ]; Return[result]; ]; MoveAllPolygons[ polys_, vector_] := Map[ MoveOnePolygon[ #, vector]&, polys]; MoveOnePolygon[ poly_Polygon, trans_] := Module[{result={}}, For[i = 1, i<= Length[poly[[1]]], i++, AppendTo[result, Plus[poly[[1, i]], trans]] ]; Return[Polygon[result]]; ]; (*****) Clear[DesignBody]; DesignBody[ midLength_, tlLength_, Diameter_] := Module[ {midBody, headTip, tailTip, headLength, tailsmallR}, midBody = Table[{x, 0.5*Diameter*Cos[phi], 0.5*Diameter*Sin[phi]}, {x, 0, midLength, midLength}, {phi, -Pi/2, 2 Pi - Pi/2, 2*Pi/7}]; headLength = 1.7; headTip = Table[{midLength, 0, 0} + RotateOnYAxis[{ headLength Cos[theta], 0.5*Diameter Sin[theta] Cos[phi], 0.5*Diameter Sin[theta] Sin[phi] }, -0.12], {theta, 0, Pi/2 + 0.22, Pi/8}, {phi, -Pi/2, 2 Pi - Pi/2, 2*Pi/7} ]; tailsmallR = 0.15*Diameter; tailTip = Table[RotateOnYAxis[ { x, (0.5*Diameter + (0.5*Diameter - tailsmallR)*x/tlLength) Cos[phi], (0.5*Diameter + (0.5*Diameter - tailsmallR)*x/tlLength) Sin[phi] }, -0.1], {x, -tlLength, 0, tlLength}, {phi, -Pi/2, 2 Pi - Pi/2, 2*Pi/7} ]; Return[ MakePolygons[Join[tailTip, midBody, headTip]] ]; ]; (*******) DesignWings[ wHSpan_, (* gives a polygon for the 2 wings *) wbaseWidth_, wExtbaseWidth_, wleadPointX_, wElbowK_, wSweep_, wtipWidth_ ] := Module[{ wingbaseLeadPoint, wingbaseTrailPoint, wingminorbaseTrailPoint, wingtipLeadPoint, wingtipTrailPoint, wingElbowPoint, leadPtX}, leadPtX = wleadPointX*midbodyLength; wingbaseLeadPoint = {leadPtX, 0, wingbaseHeight}; wingbaseTrailPoint = {leadPtX - (wbaseWidth + wExtbaseWidth), 0, wingbaseHeight}; wingminorbaseTrailPoint = {leadPtX - wbaseWidth, 0, wingbaseHeight}; wingtipLeadPoint = {leadPtX - wingSweep, wingHSpan, \ wingbaseHeight + wingRaise}; wingtipTrailPoint = wingtipLeadPoint - {wtipWidth, 0, 0}; wingElbowPoint = (1-wElbowK)*wingminorbaseTrailPoint \ + wElbowK*wingtipTrailPoint; Return[ Polygon[ {wingbaseLeadPoint, wingtipLeadPoint, wingtipTrailPoint, wingElbowPoint, wingbaseTrailPoint, FlipXZ[wingElbowPoint], FlipXZ[wingtipTrailPoint], FlipXZ[wingtipLeadPoint] } ] ]; ]; (************) Clear[DesignTails, TailsMount, DesignRudder, TranslatePolygonBy]; DesignTails[ tHSpan_, tbaseWidth_, ttipWidth_, tSweep_, mountPt_List] := Module[{ tailbaseLeadPoint, tailbaseTrailPoint, tailtipLeadPoint, tailtipTrailPoint, tailbaseleadPtX, tbaseHeight, MountPoint, mountPtX, mountPtZ}, mountPtX = mountPt[[1]]; mountPtZ = mountPt[[3]]; tailbaseLeadPoint = {mountPtX, 0, mountPtZ}; tailbaseTrailPoint = {mountPtX - tbaseWidth, 0, mountPtZ}; tailtipLeadPoint = {mountPtX - tSweep, tHSpan, mountPtZ + tailRaise}; tailtipTrailPoint = tailtipLeadPoint - {ttipWidth, 0, 0}; Return[ Polygon[ {tailbaseLeadPoint, tailtipLeadPoint, tailtipTrailPoint, tailbaseTrailPoint, FlipXZ[tailtipTrailPoint], FlipXZ[tailtipLeadPoint]} ] ]; ]; TailsMount := RandomPick[ { RudderTailsMount, BodyTailsMount } ]; (*********) DesignRudder[rrbaseWidth_, rrtipWidth_, rrtipHeight_, rrSweep_] := Module[ {rudderbaseLeadPoint, rudderbaseTrailPoint, ruddertipLeadPoint, ruddertipTrailPoint}, (* rudderleadPointX is X coordinate of rudder's leadPoint *) rudderbaseLeadPoint = {rudderleadPointX, 0, rudderbaseHeight}; rudderbaseTrailPoint = {rudderleadPointX - rrbaseWidth, \ 0, rudderbaseHeight}; ruddertipLeadPoint = {rudderleadPointX - rrSweep, 0, rrtipHeight}; ruddertipTrailPoint = ruddertipLeadPoint - {rrtipWidth, 0, 0}; Return[ Polygon[ {rudderbaseLeadPoint, ruddertipLeadPoint, ruddertipTrailPoint, rudderbaseTrailPoint}] ]; ]; (***********) Clear[MakeXCone, LineProfile, wwEngine, tEngine, LE, RE, TE]; MakeXCone[ Xmin_, Xmax_, Rxmin_, Rxmax_, Xpts_, Rpts_] := Table[ {x, Cos[phi] LineProfile[x, Xmin, Xmax, Rxmin, Rxmax], Sin[phi] LineProfile[x, Xmin, Xmax, Rxmin, Rxmax] }, {x, Xmin, Xmax, (Xmax-Xmin)/Xpts}, {phi, -Pi/2, 2 Pi - Pi/2, 2 Pi/Rpts}]; LineProfile[ x_, Xmin_, Xmax_, Rxmin_, Rxmax_ ] := (x - Xmin)*(Rxmax - Rxmin)/(Xmax - Xmin) + Rxmin; engineLength = 1.6; enginetipLength = 0.15*engineLength; enginemidLength = 0.5*engineLength; enginebackLength = 0.35*engineLength; enginemaxR = 0.3; enginefrontR = 0.26; enginemidR = 0.26; enginerearR = 0.17; TEngineLength = 2.4; TEnginetipLength = 0.14*TEngineLength; TEnginemidLength = 0.72*TEngineLength; TEnginebackLength = 0.12*TEngineLength; TEnginerearR = 0.05; wwEngine = Join[ MakeXCone[ 0, enginebackLength, enginerearR, enginemidR, 1, 7], MakeXCone[ enginebackLength, enginebackLength+enginemidLength, enginemidR, enginemaxR, 1, 7], MakeXCone[ enginebackLength+enginemidLength, enginebackLength+enginemidLength+enginetipLength, enginemaxR, enginefrontR, 1, 7] ]; tEngine = Join[ MakeXCone[ 0, TEnginebackLength, TEnginerearR, 0.15, 1, 7], MakeXCone[ TEnginebackLength, TEnginebackLength+TEnginemidLength, enginemaxR - 0.06, enginemaxR, 1, 7], MakeXCone[ TEnginebackLength+TEnginemidLength, TEnginebackLength+TEnginemidLength+TEnginetipLength, enginemaxR, enginefrontR, 1, 7] ]; (*******) Clear[WingEnginesAt, BodyEnginesAt, TailEngine]; WingEnginesAt[ distFrBase_] := Flatten[ Map[ MakePolygons[#]&, List[ Translate3DPatch[ wwEngine, (* left wing *) {enginewingLead + wingbaseleadPointX*midbodyLength \ - distFrBase*wingSweep, Max[distFrBase*wingHSpan, 1.4*bodyDiameter], enginewingSpace + wingRaise*distFrBase + wingbaseHeight} ], Translate3DPatch[ wwEngine, (* right wing *) {enginewingLead + wingbaseleadPointX*midbodyLength \ - distFrBase*wingSweep, -Max[distFrBase*wingHSpan, 1.4*bodyDiameter], enginewingSpace + wingRaise*distFrBase + wingbaseHeight} ] ]], 1 ]; BodyEnginesAt[ distFrTail_] := Flatten[ Map[MakePolygons[#]&, List[ Translate3DPatch[ wwEngine, (* left side *) {distFrTail*midbodyLength, enginebodySpace, 0} ], Translate3DPatch[ wwEngine, (* right side *) {distFrTail*midbodyLength, -enginebodySpace, 0} ] ]], 1 ]; TailEngine = MakePolygons[ Translate3DPatch[ tEngine, { -tailLength -0.5, 0, 0.5*bodyDiameter + enginemaxR - 0.035} ] ];