Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on September 04, 2021, 12:58:28 pm

Title: Stem and leaf - Rosetta Code
Post by: bplus on September 04, 2021, 12:58:28 pm
ref: http://rosettacode.org/wiki/Stem-and-leaf_plot

Not bad for not having built in sort:
Code: QB64: [Select]
  1. _Title "Stem and leaf - Rosetta Code" ' b+ start 2021-09-04
  2. Screen 12: Color 2 ' ref: http://rosettacode.org/wiki/Stem-and-leaf_plot
  3. d$ = "12 127 28 42 39 113 42 18 44 118 44 37 113 124 37 48 127 36 29 31 125 139 131 115 105 132 104"
  4. d$ = d$ + " 123 35 113 122 42 117 119 58 109 23 105 63 27 44 105 99 41 128 121 116 125 32 61 37 127"
  5. d$ = d$ + " 29 113 121 58 114 126 53 114 96 25 109 7 31 141 46 13 27 43 117 116 27 7 68 40 31 115 "
  6. d$ = d$ + "124 42 128 52 71 118 117 38 27 106 33 117 116 111 40 119 47 105 57 122 109 124 115 43 "
  7. d$ = d$ + "120 43 27 27 18 28 48 125 107 114 34 133 45 120 30 127 31 116 146 "
  8. For stem = 0 To 14
  9.     If stem = 0 Then s$ = "" Else s$ = _Trim$(Str$(stem))
  10.     ReDim sort$(0): b$ = ""
  11.     For i = 1 To Len(d$) ' read through data and pick numbers builds b$
  12.         If Mid$(d$, i, 1) = " " Then
  13.             If Mid$(b$, 1, Len(b$) - 1) = s$ Then loadSort Right$(b$, 1), sort$()
  14.             b$ = ""
  15.         Else
  16.             b$ = b$ + Mid$(d$, i, 1)
  17.         End If
  18.     Next
  19.     Print Space$(4); Right$(Str$(stem), 2); " & ";
  20.     For i = 1 To UBound(sort$)
  21.         Color Val(sort$(i)) + 5: Print sort$(i); " ";
  22.     Next
  23.     Color 2: Print
  25.  
  26. Sub loadSort (insertN As String, dynArr() As String) '  version 2020-06-07
  27.     'note this leaves dynArr(0) empty! so ubound of array is also number of items in list
  28.     ub = UBound(dynArr) + 1
  29.     ReDim _Preserve dynArr(LBound(dynArr) To ub) As String
  30.     For j = 1 To ub - 1
  31.         If insertN < dynArr(j) Then '  GT to LT according to descending or ascending sort
  32.             For k = ub To j + 1 Step -1
  33.                 dynArr(k) = dynArr(k - 1)
  34.             Next
  35.             Exit For
  36.         End If
  37.     Next
  38.     dynArr(j) = insertN
  40.  

Colorized
  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Text Only | Text with Attachments