AppleScript to create a taxonomy chart

Update: 6/29/2013. Rewrote script. Now it places the outline into a hierarchical structure before it draws the tree.

Also, I've posted a script that produces the exact same output, but using a JSON source rather than an outline.

-----

Unlike most flow charts, taxonomy charts have a purely hierarchical structure. This script creates such a chart.

Below is a taxonomy of the genre Rock/Pop (according to the music service Rhapsody) created by this script.

Although it would have been nice (and would have made the scripting much simpler) to have used OmniOutliner to provide the data for this chart, I didn't want to spend the $30 it costs, and I figured most people who use OmniGraffle don't have OmniOutliner. 

Instead, the data is drawn from a file placed on your desktop. By default, this file is called drawtree.txt, but you can change that in the SETTINGS properties at the top of the script.

The text in that file to create the chart above:

o Rock/Pop

oo Roots

ooo Cajun/Zydeco

ooo Tex Mex

ooo Swamp Pop

oo Classic Rock

ooo Adult Oriented Rock

oo Art & Progressive Rock

ooo Rock Opera

ooo New Prog

ooo Krautrock

oo Blues & Boogie Rock

ooo Boogie Rock

ooo Southern Rock

oo Glam

oo Hard Rock

ooo Post-Grunge

ooo Instrumental Guitar Rock

ooo Acid Rock

oo Instrumental Rock

oo Pop

ooo Dance Pop

ooo Teen Beat

ooo Teen Idols

oo Jam Rock

oo Latin Pop

oo Country Rock

oo Funk Rock

oo Metal

ooo Progressive Metal

ooo Thrash/Speed Metal

ooo Stoner Rock

ooo Doom Metal

ooo Pop Metal

ooo New Wave of British Heavy Metal

ooo Black Metal

ooo Death Metal

ooo Funk Metal

ooo Industrial Metal

ooo Christian Metal

ooo Rapcore

ooo Alt Metal

ooo Metalcore

oo Folk-Rock

ooo Political Rock

ooo Celtic Rock

oo Adult Alternative

oo Adult Contemporary

ooo Blue-Eyed Soul

ooo Modern Folk

ooo Lite Rock

ooo Jazz Rock

The hierarchy level of each item is indicated by the length of the string proceeding it. I'm using the letter "o" to create this string; any letter will work. It must be string of letters, however, and not - say - a string of asterisks. (I'm using the AppleScript keyword "word" to grab that first string; only a string of letters is considered a word.) A single "o" is the top level, "oo" is the next level down, etc.

Note: there must be a space between the string of o's and the label following it. Also, children directly follow their parent in this list. If you compare the list above to the chart above, you'll get the gist of it.

There are customizable options at the top of this script. These all start with the prefix "SETTINGS_".

Note that this script doesn't do a whole lot of error checking. If there's a problem with the text (e.g., no space between the string of o's and the label, skipping a hierarchy level, etc.), the script will probably fail. I've tested this on several large charts with no error, so if the script errors out, verify your data.

If you've verified your data and there's still a problem, leave your data in a comment here and I'll investigate.

The script follows the jump. Copy it, paste it into AppleScript Editor, and run it.


-- Copyright © 2013, Joseph Brick
-- All rights reserved. 
-- Redistribution, in whole or in part, with or without modification, is permitted provided that the copyright notice is retained.

-- Information on how to use this script can be found here:
-- http://omnigraffletips.blogspot.com/2013/06/applescript-to-create-taxonomy-chart.html

-- input file name (without path) - expects a text file formatted as follows; "o" is the root level, "oo" are children of that level, etc. Example:
(* 
o Rock/Pop
oo Roots
ooo Cajun/Zydeco
ooo Tex Mex
ooo Swamp Pop
oo Pop
ooo Dance Pop
ooo Teen Beat
*)
-- this file needs to be on your desktop
property SETTINGS_inputFile : "drawtree.txt"

-- chart properties
property SETTINGS_nodeVSpacing : 10 -- minimum distance between nodes with the same parent
property SETTINGS_nodeGroupVSpacing : 25 -- minimum distance between nodes at the same hierarchichal level but with different parents
property SETTINGS_levelHSpacing : 600 -- horizontal distance between a parent and child
property SETTINGS_chartOrigin : {50, 50} -- x,y location of the chart as a whole

-- node circle properties
property SETTINGS_nodeCircleDiameter : 20
property SETTINGS_nodeCircleStrokeThickness : 2
property SETTINGS_nodeCircleStrokeColor : {1, 0.5, 0}
property SETTINGS_nodeCircleStrokeOpacity : 1 -- 0 is fully transparent, 0.5 is 50% transparent, 1 is fully opaque
property SETTINGS_nodeCircleFillColor : {1, 1, 1}
property SETTINGS_nodeCircleFillOpacity : 0

-- line properties
property SETTINGS_lineThickness : 2
property SETTINGS_lineColor : {0.7, 0.8, 0.9}
property SETTINGS_lineOpacity : 1
property SETTINGS_lineCurveSharpness : 0.5 --length of bezier handles in relation to length of line; a higher number yields a sharper curve

-- node label properties
property SETTINGS_labelFontSize : 24
property Settings_labelFont : "Helvetica"
property SETTINGS_labelFontColor : {0, 0, 0}
property SETTINGS_labelFontOpacity : 1
property SETTINGS_labelHOffset : 8 -- distance between node label and node circle
property SETTINGS_labelVAdjust : 0 -- vertical adjustment of the label; by default, the node circle and node label are center-aligned

----

global highYPerLevel
global textHeightDetermined
global centerOffset
global depth

on run
set depth to 0
set textHeightDetermined to false
set centerOffset to 0
set highYPerLevel to {}
set treeData to null
set outlineText to desktopFileContents(SETTINGS_inputFile)
if outlineText is null then
return
end if
set treeData to loadTreeStructureFromOutline(outlineText)
set allNodes to drawChildren(treeData, null)
set nodeGroup to groupAllNodes(allNodes)
tell application id "OGfl"
tell front window
set origin of nodeGroup to SETTINGS_chartOrigin
end tell
end tell
end run

on desktopFileContents(fName)
tell application "Finder"
set fileName to URL of desktop & fName
end tell
set fileName to text (length of "file://localhost/") thru (length of fileName) of fileName
tell application "System Events"
set fileExists to (exists file fileName)
end tell
if fileExists = false then
display dialog "Can't find file:" & "\n\n" & fileName as text buttons {"OK"}
return null
end if
open for access fileName
set retVal to (read fileName)
close access fileName
return retVal
end desktopFileContents

on loadTreeStructureFromOutline(children)
set levelA to level(first paragraph of children) of me
set childList to ""
set curNode to ""
set parCount to count paragraphs of children
set retVal to {}
repeat with i from 1 to parCount
set par to paragraph i of children
set lev to level(par) of me
if lev is not null and lev is not levelA then
if childList is "" then
set childList to par
else
set childList to childList & "\n" & par
end if
end if
if lev = levelA or i = parCount or lev = null then
if childList is not "" then
set itemChildren of last item of retVal to loadTreeStructureFromOutline(childList) of me
set childList to ""
end if
if lev = levelA then
set caption to text (levelA + 3) thru (length of par) of par
set retVal to retVal & {{itemName:caption, itemChildren:{}}}
end if
end if
end repeat
return retVal
end loadTreeStructureFromOutline

on drawChildren(treeData, parentNodeCircle)
set i to 0
if (count highYPerLevel) < (depth + 1) then
set end of highYPerLevel to item 2 of SETTINGS_chartOrigin
end if
set retVal to {}
tell application id "OGfl"
tell canvas of front window
set ox to SETTINGS_levelHSpacing * depth + (item 1 of SETTINGS_chartOrigin)
repeat with treeObject in treeData
set oy to item (depth + 1) of highYPerLevel
set item (depth + 1) of highYPerLevel to (item (depth + 1) of highYPerLevel) + SETTINGS_nodeCircleDiameter + SETTINGS_nodeVSpacing

set nodeCircle to make new shape at end of graphics with properties {name:"Circle", size:{SETTINGS_nodeCircleDiameter, SETTINGS_nodeCircleDiameter}, origin:{ox, oy}, thickness:SETTINGS_nodeCircleStrokeThickness, draws shadow:false, magnets:{{1, 0}, {-1, 0}}, stroke color:SETTINGS_nodeCircleStrokeColor & {SETTINGS_nodeCircleStrokeOpacity}, fill color:SETTINGS_nodeCircleFillColor & {SETTINGS_nodeCircleFillOpacity}}
set nodeText to make new shape at end of graphics with properties {origin:{ox + SETTINGS_nodeCircleDiameter + SETTINGS_labelHOffset, oy + SETTINGS_labelVAdjust + centerOffset}, side padding:0, fill:no fill, draws stroke:false, draws shadow:false, autosizing:full, text:{text:itemName of treeObject, size:SETTINGS_labelFontSize, color:SETTINGS_labelFontColor & {SETTINGS_labelFontOpacity}, font:Settings_labelFont, alignment:center}, vertical padding:0}
set nodeTextHeight to item 2 of (size of nodeText as list)
if textHeightDetermined is false then
set textHeightDetermined to true
set centerOffset to (SETTINGS_nodeCircleDiameter - nodeTextHeight) / 2
set origin of nodeText to {ox + SETTINGS_nodeCircleDiameter + SETTINGS_labelHOffset, (item 2 of (origin of nodeCircle as list)) + centerOffset}
end if
if parentNodeCircle is not null then
set curLine to drawLine(parentNodeCircle, ox, oy) of me
set source of curLine to parentNodeCircle
set destination of curLine to nodeCircle
end if
set children to {}
set childNodes to {}
set moved to false
set hasKids to hasChildren(treeObject) of me
if hasKids then
set origin of nodeText to {ox - (item 1 of (size of nodeText as list)) - SETTINGS_labelHOffset, (item 2 of (origin of nodeText as list))}
set children to itemChildren of treeObject
set depth to depth + 1
set childNodes to drawChildren(children, nodeCircle) of me
set depth to depth - 1
set cSpan to childSpan(childNodes) of me
set proposedNodeY to (spanTop of cSpan) + ((spanBottom of cSpan) - (spanTop of cSpan)) / 2 - SETTINGS_nodeCircleDiameter / 2
if proposedNodeY ≥ oy then
slide nodeCircle by {0, proposedNodeY - oy}
slide nodeText by {0, proposedNodeY - oy}
set moved to true
set item (depth + 1) of highYPerLevel to (item (depth + 1) of highYPerLevel) + (proposedNodeY - oy)
get adjustLeafNodes(retVal, nodeCircle) of me
else
get moveChildren(childNodes, oy - proposedNodeY) of me
end if
end if
set nodeGroup to assemble {nodeCircle, nodeText}
set retVal to retVal & {{level:depth, node:nodeGroup, hasChildren:hasKids, wasMovedDown:moved}} & childNodes
end repeat
end tell
end tell
set item (depth + 1) of highYPerLevel to (item (depth + 1) of highYPerLevel) + (SETTINGS_nodeGroupVSpacing - SETTINGS_nodeVSpacing)
return retVal
end drawChildren

on drawLine(parentCircle, childCircleX, childCircleY)
tell application id "OGfl"
set op to (origin of parentCircle as list)
set px to (item 1 of op) + SETTINGS_nodeCircleDiameter
set py to (item 2 of op) + SETTINGS_nodeCircleDiameter / 2
set lineLen to childCircleX - px
set curveLen to lineLen * (SETTINGS_lineCurveSharpness)
tell canvas of front window
set retVal to make new line at end of graphics with properties {bezier point list:{{px, py}, {px + curveLen, py}, {childCircleX - curveLen, childCircleY + SETTINGS_nodeCircleDiameter / 2}, {childCircleX, childCircleY + SETTINGS_nodeCircleDiameter / 2}}, thickness:SETTINGS_lineThickness, line type:bezier, stroke color:SETTINGS_lineColor & {SETTINGS_lineOpacity}}
end tell
return retVal
end tell
end drawLine

on childSpan(children)
tell application id "OGfl"
set retVal to {spanTop:null, spanBottom:null}
repeat with curNode in children
if level of curNode is (depth + 1) then
set nodeCircle to item 1 of graphics of (node of curNode)
set nodeTop to item 2 of (origin of nodeCircle as list)
set nodeBottom to nodeTop + SETTINGS_nodeCircleDiameter
if spanTop of retVal is null or spanTop of retVal > nodeTop then
set spanTop of retVal to nodeTop
end if
if spanBottom of retVal is null or spanBottom of retVal < nodeBottom then
set spanBottom of retVal to nodeBottom
end if
end if
end repeat
end tell
return retVal
end childSpan

on moveChildren(_childList, vOffset)
tell application id "OGfl"
set levelsAffected to {}
repeat with curNode in _childList
slide (node of curNode) by {0, vOffset}
if level of curNode is not in levelsAffected then
set end of levelsAffected to level of curNode
end if
end repeat
repeat with lvl in levelsAffected
set item (lvl + 1) of highYPerLevel to (item (lvl + 1) of highYPerLevel) + vOffset
end repeat
end tell
end moveChildren

on adjustLeafNodes(_allNodes, bottomCircle)
tell application id "OGfl"
set nodesToMove to {}
set curNode to null
repeat with i from (count _allNodes) to 1 by -1
set curNode to item i of _allNodes

set topNode to null
if level of curNode = depth then
if hasChildren of curNode = false then
set end of nodesToMove to curNode
else
set topNode to curNode
exit repeat
end if
end if
end repeat
if (count nodesToMove) > 0 and topNode is not null then
set spanBottom to (item 2 of (origin of bottomCircle as list))
set spanTop to (item 2 of (origin of (item 1 of graphics of node of topNode) as list)) + SETTINGS_nodeCircleDiameter
set nodeCount to count nodesToMove

set nodesToMoveHeight to nodeCount * SETTINGS_nodeCircleDiameter
set gapSize to ((spanBottom - spanTop) - nodesToMoveHeight) / (nodeCount + 1)

repeat with nodeToMove in nodesToMove
set curY to item 2 of (origin of (item 1 of graphics of node of nodeToMove) as list)
set spanBottom to spanBottom - gapSize - SETTINGS_nodeCircleDiameter
slide node of nodeToMove by {0, spanBottom - curY}
end repeat
end if
end tell
end adjustLeafNodes

on hasChildren(treeObject)
set retVal to false
if (count (itemChildren of treeObject)) > 0 then
set retVal to true
end if
return retVal
end hasChildren

on groupAllNodes(_allNodes)
tell application id "OGfl"
set objectList to {}
repeat with curNode in _allNodes
set end of objectList to node of curNode
end repeat
return assemble objectList
end tell
end groupAllNodes

on level(_p)
if _p is not "" then
set w to first word of _p
return (length of w) - 1
else
return null
end if
end level