Code Golf: Connecting the dots

Question

Commodore 64 BASIC - 313 chars

EDIT: See below for the golfed version

A little trip down the memory lane with PET graphics, POKEs and PEEKs and everything :)

The program operates directly in the screen memory, so you just go ahead, clear the screen, place your dots, and type RUN:

You have to wait a minute or so while it finds the dots and then it starts to draw. It isn't fast - you can actually see the lines being drawn, but that's the coolest part :)

Golfed version:

Commodore BASIC seems like a great language for golfing, because it doesn't require whitespace :) You can also shorten most of the commands by entering an unshifted first letter followed by a shifted second letter. For example, POKE can be typed as P[SHIFT+O], which appears as P┌ on the screen:

Perl, 222 char (211)

Perl, 384 365 276 273 253 225 222 218 211 chars (222 when contest ended). Newlines are for "readability" only and are not included in the character count.

Last edit: no longer overwriting $", and printing @S directly

    $_=join'',@S=map{$n=s/$/$"x97/e;(/./g)[0..95],$/}<>;
    while(/\b$n /){$S[$q=$-[0]]='+';($P,$Q)=sort{$a-$b}$q,$p||$q;
    for(qw'\98 |97 /96 -1'){/\D/;$S[$P]=$&until($Q-$P)%$'||$Q<=($P+=$')}
    $n++;$p=$q}s/\d/ /,print for@S

Explanation:

$_=join'',@S=map{$n=s/$/$"x97/e;(/./g)[0..95],$/}<>;

This task will be easier if all the lines are the same length (say, 97 characters). This statement takes each line of input, replaces the end-of-line character with 96 spaces, then pushes the first 96 characters plus a newline into the array @S. Note we are also setting $n=1, as 1 is the first number we'll look for in the input. The join statement creates a single string from the array @S. It is more convenient to use the scalar variable $_ for pattern matching, and more convenient to use the array @S for making updates to the picture.

while(/\b$n /){

Search for the number $n in the variable $_. Evaluating regular expressions in Perl has several side-effects. One is to set the special variable $-[0] with the position of the start of the matched pattern within the matched string. This gives us the position of the number $n in the string $_ and also the array @S.

Of course, the loop will end when $n is high enough that we can't find it in the input.

    $S[$q=$-[0]]='+';

Let $q be the position of the number $n in the string $_ and the array @S, and assign the character '+' at that position.

        $P=($p||=$q)+$q-($Q=$q>$p?$q:$p)
        ($P,$Q)=sort{$a-$b}$p||$q,$q;

The first time through the loop, set $p to $q. After the first time, $p will hold the previous value of $q (which will refer to the position in the input of the previous number). Assign $P and $Q such that $P=min($p,$q), $Q=max($p,$q)

    for(qw'\98 |97 /96 -1'){

By construction, consecutive numbers are either

• connected by a vertical line. Since the input is constructed to have 97 characters on each line, this case means that $p-$q is divisible by 97.

• "aligned to the slope of a backslash", which would make $p-$q divisible by 98

• "aligned to the slope of a forward slash", which would make $p-$q divisible by 96

• on the same horizontal line

The elements of this list encode the possible number of positions between line segments, and the character to encode that segment.

        /\D/;

Another trivial regex evaluation. As a side-effect, it sets the special variable $& (the MATCH variable) to the line segment character (\ | / or -) and $' (the POSTMATCH variable) to the number (98 97 96 or 1) encoded in the list element.

        $S[$P]=$&until($Q-$P)%$'||$Q<=($P+=$')

This statement draws the line segment between two numbers. If $Q-$P is divisible by $', then keep incrementing $P by $' and assigning the character $& to $S[$P] until $P reaches $Q. More concretely, for example if $Q-$P is divisible by 97, then increment $P by 97 and set $S[$P]='|'. Repeat until $P>=$Q.

    $n++;$p=$q

Prepare for the next iteration of the loop. Increment $n to the next number to search for in the input, and let $p hold the position of the previous number.

s/\d/ /,print for@S

Output the array, converting any leftover digits (from double digit identifiers in the input where we only overwrote the first digit with a '+') to spaces as we go.

MS-DOS Batch (yes, you read right!)

I often hear (or read) people say batch isn't very powerful and you can't do much with them, well to them I say, behold, the power of BATCH!

The actual script (script.bat):

set file=%~1
call :FindNextNum 1

for /F "tokens=2 delims=:" %%i IN ('find /c /V "" "%file%"') DO set /a totalLines=%%i

set maxLen=0
for /F "delims=" %%i IN (%file%) DO (
 call :CountChars "%%i"
 if /i !charCount! gtr !maxLen! set maxLen=!charCount!
)

for /L %%i IN (0,1,%totalLines%) DO set "final_%%i=" & for /L %%j IN (0,1,%maxLen%) DO set "final_%%i=!final_%%i! "

:MainLoop
set currLineNum=%lineNum%
set currCol=%linePos%
set currNum=%nextNum%

set /a targetNum=%currNum%+1
call :FindNextNum %targetNum%
if "%nextNum%"=="" goto MainEnd

REM echo %currNum% -^> %nextNum%
if /I %currLineNum% lss %lineNum% (
call :DrawLine %currCol% %currLineNum% %linePos% %lineNum%
) else (
call :DrawLine %linePos% %lineNum% %currCol% %currLineNum%
)

goto MainLoop

:MainEnd
for /L %%i IN (0,1,%totalLines%) DO echo.!final_%%i!
goto:eof


:DrawLine

if /I %2 equ %4 goto:DrawHoriz
set "char=" & set "pos=%1" & set "inc=0"
if /I %1 LSS %3 set "char=\" & set "pos=%1" & set "inc=1"
if /I %1 GTR %3 set "char=/" & set "pos=%1" & set "inc=-1"
for /L %%i IN (%2,1,%4) DO call :DrawChar %%i !pos! %char% & set /a "pos+=%inc%"
goto:DrawEnds

:DrawHoriz
set "start=%1+1" & set "end=%3"
if /I %start% gtr %end% set "start=%3+1" & set "end=%1"
set /a lineEnd=%end%+1
set lineEnd=!final_%2:~%lineEnd%!
for /L %%i IN (%start%,1,%end%) DO set final_%2=!final_%2:~0,%%i!-
set final_%2=!final_%2!!lineEnd!

:DrawEnds
call :DrawChar %2 %1 +
call :DrawChar %4 %3 +
goto:eof

:DrawChar 
set /a skip2=%2+1
if "%3"=="" (
set final_%1=!final_%1:~0,%2!^|!final_%1:~%skip2%!
) else (
set final_%1=!final_%1:~0,%2!%3!final_%1:~%skip2%!
)
goto:eof


:CountChars
set charCount=0
set val=%~1
:CountChars_loop
if not "%val:~1%"=="" (
set /a charCount+=1
set val=!val:~1!
goto CountChars_loop
)
goto:eof



:FindNextNum
for /F "delims=" %%i IN ('type "%file%" ^| find /V /N ""') DO (
for /F "tokens=1,2 delims=[]" %%j IN ("%%i") DO (
    set /a lineNum=%%j-1
    call :FindNext_internal "%%k" %1

    if /I !nextNum! equ %1 goto :eof
)
)

goto:eof

:FindNext_internal
set currLine=%~1
set linePos=0
:FindNext_internal_loop
call :NextNumInLine "%currLine%"
set /a linePos+=%spaceInterval%
if "%nextNum%"=="" goto :EOF
if /I %nextNum% equ %2 goto :EOF
set /a spaceInterval+=1
set /a linePos+=1
if /I %nextNum% GTR 9 set /a "spaceInterval+=1" & set /a linePos+=1
set currLine=!currLine:~%spaceInterval%!
goto FindNext_internal_loop

:NextNumInLine
set nextNum=
for /F %%i IN (%1) DO set /a nextNum=%%i
if "%nextNum%"=="" goto :eof
set /a spaceInterval=0
set val=%~1
:NextNumInLine_loop
if "%val:~0,1%"==" " (
set /a spaceInterval+=1
set val=!val:~1!
goto NextNumInLine_loop
)
goto :eof

And this is how you call it

echo off
setlocal ENABLEDELAYEDEXPANSION
call script.bat input.txt

where "input.txt" is a file that contains the input for the "program".

P.S. This isn't actually optimized for line length yet, I've already spent a couple of hours getting to this point and now I need to sleep... I'll see if I can improve it tomorrow (currently 'script.bat' sits at 2755 bytes)

Rebmu: 218 chars

Ma L{-|\/}Qb|[sg?SBaB]Da|[feSm[TfiSrj[spAsp]iT[++Tbr]]t]Xa|[i?A]Ya|[i?FImHDa]Ca|[skPCmSCaBKfsA]wh[Jd++N][roG[xJyJ]]Bf+GwhB[JcB Ff+GiF[KcF HqXkXj VqYkYju[chCbPClEZv1[ezH2[eeHv3 4]]e?A+bRE[hV]f]]chJeFIlSCj{+}{+ }Jk Bf]wM

I'm getting pretty good at reading and editing it natively in its pig-latin form. (Though I do use line breaks!!) :)

But here's how the dialect is transformed by the interpreter when the case-insensitive "mushing" trick is boiled away, and one gets accustomed to it. I'll add some comments. (Tips: fi is find, fe is foreach, sp is a space character, i? is index, hd is head, ch is change, sk is skip, pc is pick, bk is break, i is if, e is either, ee is either equal, ad nauseum)

; copy program argument into variable (m)atrix
m: a

; string containing the (l)etters used for walls
l: {-|\/} 

; q is a "b|function" (function that takes two parameters, a and b)
; it gives you the sign of subtracting b from a (+1, -1, or 0)
q: b| [sg? sb a b]

; d finds you the iterator position of the first digit of a two digit
; number in the matrix
d: a| [fe s m [t: fi s rj [sp a sp] i t [++ t br]] t]

; given an iterator position, this tells you the x coordinate of the cell
x: a| [i? a]

; given an iterator position, this tells you the y coordinate of the cell
y: a| [i? fi m hd a]

; pass in a coordinate pair to c and it will give you the iterator position
; of that cell
c: a| [sk pc m sc a bk fr a]

; n defaults to 1 in Rebmu.  we loop through all the numbers up front and
; gather their coordinate pairs into a list called g
wh [j: d ++ n] [ro g [x j y j]]

; b is the (b)eginning coordinate pair for our stroke. f+ returns the
; element at G's current position and advances G (f+ = "first+")
; advance g's iteration position
b: f+ g
wh b [
    ; j is the iterator position of the beginning stroke
    j: c b 

    ; f is the (f)inishing coordinate pair for our stroke
    f: f+ g

    ; if there is a finishing pair, we need to draw a line 
    i f [
        ; k is the iterator position of the end of the stroke
        k: c f

        ; the (h)orizontal and (v)ertical offsets we'll step by (-1,0,1)
        h: q x k x j 
        v: q y k y j 

        u [
            ; change the character at iterator location for b (now our
            ; current location) based on an index into the letters list
            ; that we figure out based on whether v is zero, h is zero,
            ; v equals h, or v doesn't equal h.
            ch c b pc l ez v 1 [ez h 2 [ee h v 3 4]]

            ; if we update the coordinate pair by the offset and it 
            ; equals finish, then we're done with the stroke
            e? a+ b re [h v] f
        ]
    ] 

    ; whether we overwrite the number with a + or a plus and space
    ; depends on whether we detect one of our wall "letters" already
    ; one step to the right of the iterator position
    ch j e fi l sc j {+} {+ }

    ; update from finish pair to be new begin pair for next loop iteration
    j: k
    b: f
] 

; write out m
w m

Both the language and sample are new and in an experimental stage. For instance, ad couldn't be used to add together vectors and matrices before I changed it to help with this sample. But I think that's just the sort of thing that a language designed specifically for code golf has to have anyway. It's a subtle line between "language" and "library".

Latest source with comments available on GitHub

Haskell, 424 chars

Current char count: 424 430 451 466 511 515 516 518 525 532 541 545 550 556 569 571 577 582 586 592.

import List
x%c=[(i,c)|i<-x]
l k p q|p>q=l k q p|True=head[[p,p+j..q]%c|m<-zip[k-1,k,k+1,1]"/|\\-",let (j,c)=m,mod(q-p)j==0]
w=map snd
q(k,m,x)z=w$sort$nubBy((==)&fst)$x%'+'++(concat$zipWith(l k)x$tail x)++z%'\n'++[1..m]%' '
r(z,m,x)=q(last z,m-1,w$sort x)z
u[(m,_)]n x=(-m::Int,n):x;u _ _ x=x
t(z,n,x)s|s=="\n"=(n:z,n+1,x)|True=(z,n+length s,u(reads s)n x)
y&x=(.x).y.x
main=interact$r.foldl t([],1,[]).groupBy((&&)&(>' '))

This version takes a lot of inspiration from the original Haskell entry below, but makes some significant changes. Most importantly, it represents image locations with a single index, not a pair of coordinates.

There are some changes:

1. The input must now have all lines padded to the same length (allowed by the rules.)
2. No longer needs either language extension

---

Original version:

(Needs -XTupleSections, and maybe -XNoMonomorphismRestriction)

import List
b=length
f=map
g=reverse
a(x,y)" "=(x,y+1)
a(x,y)z=([y,read z]:x,y+b z)
x%y=[min x y+1..max x y-1]
j([x,y],[w,z])|y==z=f(,'-')$f(y,)$x%w|x==w=f(,'|')$f(,x)$y%z|(y<z)==(x<w)=f(,'\\')$zip(y%z)$x%w|True=f(,'/')$zip(y%z)$g$x%w
k 0='\n'
k _=' '
y&x=(.x).y.x
y?x=f y.sort.x.concat
r z=snd?(nubBy((==)&fst).g)$[((y,x),k x)|x<-[0..maximum$f b d],y<-[1..b d]]:[((y,x),'+')|[x,y]<-e]:(f j$zip e$tail e)where d=f(groupBy$(&&)&(>' '))$lines z;e=tail?f g$zipWith(f.(:))[1..]$f(fst.foldl a([],1))d
main=interact r

---

Explanation:

(1) d=...: Splits the input into spaces and numbers, e.g.

   z = " 6  5\n\n1       2\n\n    4   3\n\n 7"
=> d = [[" ","6"," "," ","5"],[],["1"," "," "," "," "," "," "," ","2"],[],[" "," "," "," ","4"," "," "," ","3"],[],[" ","7"]]

(2) e=...: Converts d into a list of (y, x) coordinates for each number.

   e = [[1,3],[9,3],[9,5],[5,5],[5,1],[2,1],[2,7]]
--- //  1     2     3     4     5     6     7

(3)

• [((y,x),k x)|...] is an empty board. (k returns a space or a \n depending on the x-coordinate.)
• [((y,x),'+'))|...] are the plus signs at the numbers.
• (f j$zip e$tail e) are the lines connecting the numbers. (j maps a pair of coordinates into a list of (coordinate, character) which represents a line.)

These 3 components are concatenated and filtered to form the actual output. Note that the order is important, so that nubBy(...).g can only keep the last character in the same location.