examples/applications/sorting-performance.shape

   1 /** This file is part of Shapes.
   2  **
   3  ** Shapes is free software: you can redistribute it and/or modify
   4  ** it under the terms of the GNU General Public License as published by
   5  ** the Free Software Foundation, either version 3 of the License, or
   6  ** any later version.
   7  **
   8  ** Shapes is distributed in the hope that it will be useful,
   9  ** but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  ** GNU General Public License for more details.
  12  **
  13  ** You should have received a copy of the GNU General Public License
  14  ** along with Shapes.  If not, see <http://www.gnu.org/licenses/>.
  15  **
  16  ** Copyright 2014 Henrik Tidefelt
  17  **/
  18
  19 ##needs ..Shapes..Data / seq-support
  20
  21 ##lookin ..Shapes
  22 ##lookin ..Shapes..Geometry
  23 ##lookin ..Shapes..Layout
  24 ##lookin ..Shapes..Traits
  25 ##lookin ..Shapes..Control
  26 ##lookin ..Shapes..Data
  27 ##lookin ..Shapes..Numeric..Random
  28 ##lookin ..Shapes..Numeric..Math
  29
  30 /** Merge sort implemented in Shapes
  31  **/
  32
  33 seq_split:
  34 {
  35   helper1: \ p q res → [if [nil? q] [fcons [seq_reverse res] p] [helper2 p q.cdr res]]
  36   helper2: \ p q res → [if [nil? q] [fcons [seq_reverse res] p] [helper1 p.cdr q.cdr ( p.car ; res )]]
  37   \ seq → [helper1 seq seq nil]
  38 }
  39
  40 seq_merge:
  41 {
  42   append_reverse: \ elems res → [if [nil? elems] [seq_reverse res] [append_reverse elems.cdr ( elems.car ; res )]]
  43
  44   helper: \ left right res precedes →
  45     [if [nil? left]
  46       [append_reverse right res]
  47       [if [nil? right]
  48         [append_reverse left res]
  49         [if [precedes right.car left.car]
  50           [helper left right.cdr ( right.car ; res) precedes]
  51           [helper left.cdr right ( left.car ; res) precedes]
  52         ]
  53       ]
  54     ]
  55
  56   \ left right precedes → [helper left right nil precedes]
  57 }
  58
  59 mergeSort:
  60 {
  61   mergeSort1: \ seq precedes →
  62     [if [nil? seq.cdr]
  63       seq
  64       {
  65         /** At least two elements in seq. **/
  66         lr: [seq_split seq]
  67         leftSorted: [mergeSort1 lr.car precedes]
  68         rightSorted: [mergeSort1 lr.cdr precedes]
  69         [seq_merge leftSorted rightSorted precedes]
  70       }
  71     ]
  72
  73   \ seq precedes → [if [nil? seq] nil [mergeSort1 seq precedes]]
  74 }
  75
  76 /** Measure computation times.
  77  **/
  78
  79 randomList:
  80 {
  81   helper: \ n res •rnd → [if (n = '0) res [helper (n - '1) (![ball1D •rnd] ; res) •rnd]]
  82   \ n •rnd → [helper n nil •rnd]
  83 }
  84
  85 seed: [newRandom (•time)]
  86
  87 clockRandomData: \ sortfun n seed →
  88 {
  89   •rnd: seed
  90   data: [randomList n •rnd]
  91
  92   •timer: newTimer
  93   dataSorted: ![sortfun data]
  94   time: freeze •timer
  95   (1*n, time)
  96 }
  97
  98 timeData_lexiographicSort_random:
  99   [fmap
 100     \ p → [clockRandomData (\ data → [lexiographicSort [fmap array data] data]) [pow '2 p] seed]
 101     [range '5 '12]
 102   ]
 103 timeData_sort_random:
 104   [fmap
 105     \ p → [clockRandomData (\ data → [sort data (<)]) [pow '2 p] seed]
 106     [range '5 '12]
 107   ]
 108 timeData_mergeSort_random:
 109   [fmap
 110     \ p → [clockRandomData (\ data → [mergeSort data (<)]) [pow '2 p] seed]
 111     [range '3 '7]
 112   ]
 113
 114 xSize: 10cm
 115 ySize: 8cm
 116
 117 xMin: 8
 118 xMax: 12000
 119 yMin: 0.8*^~3
 120 yMax: 20
 121
 122 xMap: \ x → ( xSize / [log xMax / xMin] ) * [log x / xMin]
 123 yMap: \ y → ( ySize / [log yMax / yMin] ) * [log y / yMin]
 124
 125 dataLine: \ timeData → [timeData.foldl (\ s e → s--([xMap e.x], [yMap e.y])) emptypath]
 126 mark: @width:0.1bp | [Graphics..stroke [circle 1bp]]
 127 dataMarks: \ timeData → [timeData.foldl (\ s e → s & [[shift ([xMap e.x], [yMap e.y])] mark]) Graphics..null]
 128
 129 /** Draw axes
 130  **/
 131 IO..•page << @width:0.3bp | [Graphics..stroke (0m,0m)--(xSize, 0m) head:Graphics..ShapesArrow]
 132 IO..•page << @width:0.3bp | [Graphics..stroke (0m,0m)--(0m, ySize) head:Graphics..ShapesArrow]
 133
 134 /** Linear axes
 135  **/
 136 |**IO..•page << @width:0.3bp | [[range 0 0.95*xRange step:2000].cdr.foldl (\ s e → s & [[shift ([xMap e],0)] [Graphics..stroke (0m,0m)--(0m,~1.5mm)] & [[shift (0,~5mm)] [center_x (Text..newText << [String..sprintf `%g´ e])]]]) Graphics..null]
 137 |**IO..•page << @width:0.3bp | [[range 0 0.95*yRange step:5].cdr.foldl (\ s e → s & [[shift (0,[yMap e])] [Graphics..stroke (0m,0m)--(~1.5mm,0m)] & [[shift (~2mm,~0.4*Text..@size)] [center_x (Text..newText << [String..sprintf `%g´ e]) 1]]]) Graphics..null]
 138
 139 /** Logarithmic axes
 140  **/
 141 IO..•page << @width:0.3bp & Text..@size:8bp |
 142   {
 143     [[range [floor [log10 xMin]] [ceil [log10 xMax]]].cdr.foldl
 144       \ s e →
 145         [[list 1 2 5].foldl
 146           \ s eSub →
 147             {
 148               val: [pow 10 e] * eSub
 149               c: [xMap val]
 150               [if xMin < val and val < xMax
 151                 s & [[shift (c,0)] [Graphics..stroke (0m,0m)--(0m,~1.5mm)] & [[shift (0,~5mm)] [center_x (Text..newText << [String..sprintf `%g´ val])]]]
 152                 s
 153               ]
 154             }
 155           s
 156         ]
 157       Graphics..null
 158     ]
 159   }
 160 IO..•page << @width:0.3bp & Text..@size:8bp |
 161   {
 162     [[range [floor [log10 yMin]] [ceil [log10 yMax]]].cdr.foldl
 163       \ s e →
 164         [[list 1 2 5].foldl
 165           \ s eSub →
 166             {
 167               val: [pow 10 e] * eSub
 168               c: [yMap val]
 169               [if yMin < val and val < yMax
 170                 s & [[shift (0,c)] [Graphics..stroke (0m,0m)--(~1.5mm,0m)] & [[shift (~2mm,~0.4*Text..@size)] [center_x (Text..newText << [String..sprintf `%g´ val]) 1]]]
 171                 s
 172               ]
 173             }
 174           s
 175         ]
 176       Graphics..null
 177     ]
 178   }
 179
 180 •dataView: Graphics..newGroup
 181
 182 /** Draw the data.
 183  **/
 184 {
 185   line: [dataLine timeData_lexiographicSort_random]
 186   •dataView << @width:0.5bp | [Graphics..stroke line]
 187             << [dataMarks timeData_lexiographicSort_random]
 188             << [[shift [intersection line (0.6*xSize,0)--((+0cm),ySize)].p] [center_wlm (Text..newText << `lexiographicSort´) (~1, 1)]]
 189 }
 190 {
 191   line: [dataLine timeData_sort_random]
 192   •dataView << @width:0.5bp | [Graphics..stroke line]
 193             << [dataMarks timeData_sort_random]
 194             << [[shift [intersection line (0.55*xSize,0)--((+0cm),ySize)].p] [center_wlm (Text..newText << `sort´) (1, ~1)]]
 195 }
 196 {
 197   line: [dataLine timeData_mergeSort_random]
 198   •dataView << @width:0.5bp | [Graphics..stroke line]
 199             << [dataMarks timeData_mergeSort_random]
 200             << [[shift [intersection line (0.3*xSize,0)--((+0cm),ySize)].p] [center_wlm (Text..newText << `mergeSort´) (1, ~1)]]
 201 }
 202
 203 /** Draw an n * log( n ) helper line.
 204  **/
 205 {
 206   c: 0.001
 207   line: [[range [log10 xMin] [log10 xMax] count:'100].foldl
 208           \ s e →
 209             {
 210               x: [pow 10 e]
 211               s--(1%C^)<([xMap x], [yMap c * x * [log x]])>(1%C^)
 212             }
 213           emptypath
 214         ]
 215   •dataView << @width:0.5bp & @stroking:[gray 0.5] | [Graphics..stroke line]
 216             << [[shift [intersection line (0.65*xSize,0)--((+0cm),ySize)].p] [center_wlm [Graphics..TeX [String..sprintf `$%g\, n\, \log(\, n \,)$´ c]] (1, ~1)]]
 217 }
 218
 219 dataView: freeze •dataView
 220 IO..•page << [Graphics..clip dataView [rectangle (0m,0m) (xSize, ySize)]]