Zhang-Suen thinning algorithm: Difference between revisions
Rename Perl 6 -> Raku, alphabetize, minor clean-up
Thundergnat (talk | contribs) (Rename Perl 6 -> Raku, alphabetize, minor clean-up) |
|||
Line 107:
* "Character Recognition Systems: A Guide for Students and Practitioners" By Mohamed Cheriet, Nawwaf Kharma, Cheng-Lin Liu, Ching Suen
<br><br>
=={{header|AutoHotkey}}==
{{works with|AutoHotkey_L}}
Line 1,325:
</pre>
=={{header|Fortran}}==
With F90 came standardisation of a variety of array manipulation facilities. Since the image array is to be inspected as a whole then adjusted rather than adjusted step-by-step as it is inspected, the first thought was to employ the special facility of the FOR ALL statement, which is that in an expression such as <lang Fortarn>FOR ALL (i = 2:n - 1) A(i) = (A(i - 1) + A(i) + A(i + 1))/3</lang> all right-hand-side expressions will be evaluated with the original values of the array, while in the less special array assignment <lang Fortran>A(2:N - 1) = (A(1:N - 2) + A(2:N - 1) + A(3:N))/3</lang> as in the case of the equivalent DO-loop, the processing will be with a mixture of old and new values as the loop proceeds.
So, that suggests something like <lang Fortran> FOR ALL (I = 2:N - 1, J = 2:M - 1)
WHERE(DOT(I,J) .NE. 0) DOT(I,J) = ADJUST(DOT,I,J)</lang>
This requires function ADJUST to be a "pure" function, and they are not supposed to perpetrate side effects, such as one reporting that any adjustment was made. Nor is it clear that array DOT must be presented as a parameter either as the entire array or as element DOT(i,j), or if not, that it can be global to function ADJUST - which would also be an impurity - and for that matter, variables I and J could be global also...
Instead, thought turned to more closely following the task specification, which involves producing a list of elements to be adjusted after an inspection pass. Given that array DOT is two-dimensional, it would be nice if an element could be indexed via an expression such as <code>DOT(INDEX)</code> where INDEX was an array of two elements with INDEX(1) = i, and INDEX(2) = j, so as to access DOT(i,j) If this were possible, then obviously one could hope that array INDEX could be extended so as to store the multiple elements of a list of such locations to access, with a view to <code>DOT(INDEX(1:n)) = 0</code> adjusting the image.
Alas, such a syntax form is not accommodated. However, F90 also introduced the ability to define and use compound data types, such as the type PLACE as used below. It is not possible to define a type of a special, recognised form, such as say "SUBSCRIPT LIST" that can be used as dreamt of above, so the components are just ordinary variables. Two ordinary arrays could be used, one for each of the two subscripts, or a compound type could be devised in a hint towards self-documentation. Thus, <lang Fortran> DOT(WHACK(1:WHACKCOUNT).I,WHACK(1:WHACKCOUNT).J) = 0</lang>
But it doesn't work... After a fair amount of head scratching, not at all assisted by the woolly generalities and inane examples of the compiler's "help" collection, it became apparent that the expression did not work through a list of indices as anticipated, but instead, for ''each'' value of the first index, ''all'' the values of the second index were selected. Thus, instead of the first change being DOT(WHACK('''1''').I,WHACK('''1''').J) only, it was DOT(WHACK('''1''').I,WHACK('''1:WHACKCOUNT''').J) that were being cleared. Accordingly, the fancy syntax has to be abandoned in favour of a specific DO-loop.
<lang Fortran> MODULE ZhangSuenThinning !Image manipulation.
CONTAINS
SUBROUTINE ZST(DOT) !Attempts to thin out thick lines.
INTEGER DOT(:,:) !The image in an array, rows down the page.
TYPE PLACE !This records an array location.
INTEGER I !Via its
INTEGER J !Indices.
END TYPE PLACE !A lot of baggage.
TYPE(PLACE) WHACK(UBOUND(DOT,DIM = 1)*UBOUND(DOT,DIM = 2)) !Allow a whack for every dot.
INTEGER WHACKCOUNT !Counts up those to be wiped out.
LOGICAL WHACKED !Notes if any have been.
INTEGER STEP,I,N,J,M !Assistants.
INTEGER D9(9) !Holds a 3x3 portion.
INTEGER HIT1(3,2),HIT2(3,2) !Lists of elements to inspect for certain tests.
PARAMETER (HIT1 = (/2,6,8, 4,2,6/)) !Two stages.
PARAMETER (HIT2 = (/4,8,6, 2,4,8/)) !Each with two hit lists.
N = UBOUND(DOT,DIM = 1) !Number of rows.
M = UBOUND(DOT,DIM = 2) !Number of columns.
Commence a pass.
10 WHACKED = .FALSE. !No damage so far.
DO STEP = 1,2 !Each pass is in two stages.
WHACKCOUNT = 0 !No dots have been selected for whitewashing.
DO I = 2,N - 1 !Scan down the rows.
DO J = 2,M - 1 !And the columns. Interior dots only.
IF (DOT(I,J).NE.0) THEN !Rule 0: Is the dot black? Eight neighbours are present due to loop control.
D9(1:3) = DOT(I - 1,J - 1:J + 1) !Yes. Form a 3x3 mesh. 1 2 3 not 9 2 3
D9(4:6) = DOT(I ,J - 1:J + 1) !As a 1-D array. 4 5 6 8 1 4
D9(7:9) = DOT(I + 1,J - 1:J + 1) !For eased access. 7 8 9 7 6 5
CALL INSPECT(D9,HIT1(1,STEP),HIT2(1,STEP)) !Apply rules one to four, as specified.
END IF !So much for a black dot.
END DO !On to the next column.
END DO !On to the next row.
IF (WHACKCOUNT.GT.0) THEN !Are any to be wiped out?
DO I = 1,WHACKCOUNT !Yes!
DOT(WHACK(I).I,WHACK(I).J) = 0 !One by one.
END DO !On to the next victim.
Can't use DOT(WHACK(1:WHACKCOUNT).I,WHACK(1:WHACKCOUNT).J) = 0
WHACKED = .TRUE. !There has been a change.
END IF !So much for changes.
END DO !On to the second stage.
IF (WHACKED) GO TO 10 !If there had been changes, perhaps there will be more.
CONTAINS !Some helpers.
SUBROUTINE INSPECT(BLOB,HIT1,HIT2) !Inspect a 3x3 piece according to the four levels of tests as specified.
INTEGER BLOB(9) !The piece. BLOB(5) is DOT(I,J), and is expected to be 1.
INTEGER HIT1(3),HIT2(3) !Two hit lists.
INTEGER TWIRL(9) !traces the periphery of the piece.
PARAMETER (TWIRL = (/2,3,6,9,8,7,4,1,2/)) !Cycle around the periphery.
INTEGER B !A counter. !Rule:
B = SUM(BLOB) - BLOB(5) !1: Count the neighbours having one, not zero.
IF (2 <= B .AND. B <= 6) THEN ! The test. Can't have 2 <= B <= 6, alas.
IF (COUNT(BLOB(TWIRL(1:8)) !2: Counting transitions.
* .LT.BLOB(TWIRL(2:9))) .EQ.1) THEN ! The test of 0 --> positive.
IF (ANY(BLOB(HIT1).EQ.0)) THEN !3: At least one must be white.
IF (ANY(BLOB(HIT2).EQ.0)) THEN !4: Of two sets of three.
WHACKCOUNT = WHACKCOUNT + 1 !Another one down!
WHACK(WHACKCOUNT) = PLACE(I,J) !This is the place.
END IF !Now back out of the nested IF-statements.
END IF !Since the tests must all be passed
END IF !Rather than say three out of four.
END IF !For the given method.
END SUBROUTINE INSPECT!That was weird.
END SUBROUTINE ZST !But so it goes.
SUBROUTINE SHOW(A) !Display an image array on the standard output.
INTEGER A(:,:) !Values are expected to be zero and one.
CHARACTER*1 HIC(0:1) !But I don't want to look at wads of digits.
PARAMETER (HIC = (/".","#"/)) !These offer better contrast.
INTEGER I !A stepper.
DO I = 1,UBOUND(A,DIM = 1) !Work down the given number of rows.
WRITE (6,"(666A1)") HIC(A(I,:)) !Roll a translated line.
END DO !Hopefully, no more than 666 to a line.
END SUBROUTINE SHOW !That was straightforward.
END MODULE ZhangSuenThinning
PROGRAM POKE !Just set up the example.
USE ZhangSuenThinning
INTEGER N,M !Parameters for the example.
PARAMETER (N = 10,M = 32) !Rows and columns.
CHARACTER*(M) CANVAS(N) !Rather than some monster DATA statement,
PARAMETER (CANVAS = (/ !It is easier to prepare a worksheet.
1 " ",
2 " 111111111 11111111 ",
3 " 111 1111 1111 1111 ",
4 " 111 111 111 111 ",
5 " 111 1111 111 ",
6 " 111111111 111 ",
7 " 111 1111 111 111 ",
8 " 111 1111 111 1111 1111 111 ",
9 " 111 1111 111 11111111 111 ",
o " "/))
INTEGER IMAGE(N,M) !The image array. Exactly the required size.
INTEGER I !A stepper.
DO I = 1,N !Read the rows.
READ (CANVAS(I),"(666I1)") IMAGE(I,:) !Presumably, 666 will suffice.
END DO !A blank is taken as a zero with formatted input.
WRITE (6,*) "The initial image..."
CALL SHOW(IMAGE)
WRITE (6,*)
CALL ZST(IMAGE)
WRITE (6,*) "And after 'thinning'..."
CALL SHOW(IMAGE)
END PROGRAM POKE </lang>
Output:
<pre>
The initial image...
................................
.#########.......########.......
.###...####.....####..####......
.###....###.....###....###......
.###...####.....###.............
.#########......###.............
.###.####.......###....###......
.###..####..###.####..####.###..
.###...####.###..########..###..
................................
And after 'thinning'...
................................
..#######.........######........
..#.....#........##.............
..#......#.......#..............
..#.....#........#..............
..#####.#........#..............
.......##........#..............
........#....#...##....##...#...
.........#.........####.........
................................
</pre>
=={{header|FreeBASIC}}==
<lang freebasic>' version 08-10-2016
Line 1,484 ⟶ 1,632:
.........#.........####.........
................................</pre>
=={{header|Go}}==
Line 2,446 ⟶ 2,447:
# ############
### ### </pre>
=={{header|Julia}}==
Line 3,090:
............................................................
............................................................</pre>
=={{header|Phix}}==
Line 3,732 ⟶ 3,661:
................................
Thinned image:
................................
..#######.........######........
..#.....#........##.............
..#......#.......#..............
..#.....#........#..............
..#####.#........#..............
.......##........#..............
........#....#...##....##...#...
.........#.........####.........
................................</pre>
=={{header|Raku}}==
(formerly Perl 6)
Source image may be based on any characters whose low bits are 0 or 1 (which conveniently includes . and #).
<lang perl6>my $source = qq:to/EOD/;
................................
.#########.......########.......
.###...####.....####..####......
.###....###.....###....###......
.###...####.....###.............
.#########......###.............
.###.####.......###....###......
.###..####..###.####..####.###..
.###...####.###..########..###..
................................
EOD
my @lines = ([.ords X+& 1] for $source.split("\n")); # The low bits Just Work.
my \v = +@lines;
my \h = +@lines[0];
my @black = flat @lines.map: *.values; # Flatten to 1-dimensional.
my \p8 = [-h-1, -h+0, -h+1, # Flatland distances to 8 neighbors.
0-1, 0+1,
h-1, h+0, h+1].[1,2,4,7,6,5,3,0]; # (in cycle order)
# Candidates have 8 neighbors and are known black
my @cand = grep { @black[$_] }, do
for 1..v-2 X 1..h-2 -> (\y,\x) { y*h + x }
repeat while my @goners1 or my @goners2 {
sub seewhite (\w1,\w2) {
sub cycles (@neighbors) { [+] @neighbors Z< @neighbors[].rotate }
sub blacks (@neighbors) { [+] @neighbors }
my @prior = @cand; @cand = ();
gather for @prior -> \p {
my \n = @black[p8 X+ p];
if cycles(n) == 1 and 2 <= blacks(n) <= 6 and n[w1].any == 0 and n[w2].any == 0
{ take p }
else { @cand.push: p }
}
}
@goners1 = seewhite (0,2,4), (2,4,6);
@black[@goners1] = 0 xx *;
say "Ping: {[+] @black} remaining after removing ", @goners1;
@goners2 = seewhite (0,2,6), (0,4,6);
@black[@goners2] = 0 xx *;
say "Pong: {[+] @black} remaining after removing ", @goners2;
}
say @black.splice(0,h).join.trans('01' => '.#') while @black;</lang>
{{out}}
<pre>Ping: 66 remaining after removing 33 41 49 56 67 71 74 80 83 86 89 99 106 114 119 120 121 131 135 138 146 169 178 195 197 210 215 217 227 230 233 236 238 240 243 246 249 251 253 257 258 259 263 264 266 268 269 270 273 274 279 280 283 284 285
Pong: 47 remaining after removing 65 73 88 97 104 112 129 137 144 161 167 176 193 198 208 216 225 226 231
Ping: 45 remaining after removing 87 194
Pong: 45 remaining after removing
Ping: 45 remaining after removing
Pong: 45 remaining after removing
................................
..#######.........######........
Line 4,108 ⟶ 4,109:
................................
</pre>
=={{header|VBA}}==
{{trans|Phix}}
| |||