Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

(Golf) LED Sign

by tadman (Prior)
on Jun 08, 2001 at 04:22 UTC ( [id://86805]=perlmeditation: print w/replies, xml ) Need Help??

Since my former attempt at proposing a Golf was a dismal failure, for a refereshing change, how about something that isn't NP-Complete? This particular function, as with any Perl Golf, should allow for suitable creative expression. TMTOWTDI as always.

The Goal
Create a function which when given a numeric string, returns a multi-line string which is the equivalent 7-segment display output, as one might find on a cash register or digital watch. No external modules should be used. No requirement for compatibility with 'strict' or '-w', but the function must operate properly if called more than one time from within the same program.

An example is: print f("19.2"); Which would display:
X XXXX XXXX X X X X X X X X X XXXX XXXX X X X X X X X X X XXXX
Any combination of the characters 0-9, '-', or '.' are valid. Any other characters are ignored. 7 lines of text are always returned by the function, though these lines may be blank if no input was provided that was valid.

For reference, here is the complete character set, a 5x7 bitmap, with a ruler provided for reference purposes only:
---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- | XXXX X XXXX XXXX X X XXXX XXXX XXXX XXXX XXXX | X X X X X X X X X X X X X X | X X X X X X X X X X X X X X | X X X XXXX XXXX XXXX XXXX XXXX X XXXX XXXX XXXX | X X X X X X X X X X X X X | X X X X X X X X X X X X X | XXXX X XXXX XXXX X XXXX XXXX X XXXX XXXX X
Sample Code
My first take, a straight up approach, which is 272 characters without line breaks required here for readability.
sub f{ my@c=qw[00700 00001 00000 75557 11111 71747 71717 55711 74717 74757 71111 75757 75717]; my@l,$i;map{$l[$i++%5].=join'',(unpack("B8" ,chr)=~/(.)(.)(.)$/)[0,1,1,2],' '}map{split //,$c[ord($_)-45]}grep{/[0-9\.\-]/}split//, pop;$_=join'',map{"$_\n"}@l[0,1,1,2,3,3,4]; tr/01/ X/;$_ }
As you can see, there is substantial room for improvement.

Replies are listed 'Best First'.
Re: (Golf) LED Sign
by srawls (Friar) on Jun 08, 2001 at 05:59 UTC
    Well, I sure wish I could beat that by my own code, but I couldn't even come close. I can improve on yours though. First of all: in a golf, you needn't use my and pre-declare variables. Second, I don't understand the need for this statement:
    $_=join'',map{"$_\n"}@l[0,1,1,2,3,3,4];
    Why not just use this
    $_=join$/,@l[0,1,1,2,3,3,4];
    Well, here's your improved code, it checks in at 223 chars:
    sub f{ @c=qw[00700 00001 00000 75557 11111 71747 71717 55711 74717 74757 71111 75757 75717]; map{$l[$i++%5].=join'',(unpack("B8",chr)=~/(...)$/)[0,1,1,2],$"} map{split//,$c[ord($_)-45]}split//,pop; $_=join$/,@l[0,1,1..4]; tr/01/ X/;$_ }


    The 15 year old, freshman programmer,
    Stephen Rawls
      To clarify: In one case, you have something which is, to abbreviate, XnXnXnXn versus XnXnXnX, where the former has a newline at the end, and the second does not. It's a minor thing, I know, and mostly cosmetic.

      As a result, it doesn't wrap the last line around, leaving something like:
      shell% perl srawls X XXX XXX XXX X X X X X X X X X X X X X XXX XXX X X X X X X X X XXX XXX XXX shell%
      I like your art deco twist on the "font". Very retro.
        As a result, it doesn't wrap the last line around, leaving something like:
        ... X XXX XXX XXX shell%
        Configure your shell prompt to be "X", and you get free punctuation.

        As a result, it doesn't wrap the last line around, leaving something like:

        Yep, it's a golf, so I was trying to shave off as many chars as possible; good observation though.

        I like your art deco twist on the "font". Very retro.

        Funny you mention that, It happened completely by accident, when I was trying to shorten the code : )

        The 15 year old, freshman programmer,
        Stephen Rawls

          As a result, it doesn't wrap the last line around...
        $_=join$/,@l[0,1,1..4],'';
        fixes that.

          p

(tye)Re: 186- (Golf) LED Sign
by tye (Sage) on Jun 08, 2001 at 11:42 UTC

    Here is a program that writes a file that has a 186-char subroutine which is my golf entry:

    #!/usr/bin/perl open SEG, ">segment.pl" or die "Can't write seg.pl: $!\n"; binmode SEG; while(<DATA>){ s/::::::::/pack"H*",'1f10001100100111'/e; s/!!!!!!!!!!!!!!!/pack"H*",'fca88a04228f12420caacc30125084'/e; print SEG $_; } __END__ #!/usr/bin/perl sub d{ y/01/ #/for@p=unpack"b5"x8,"::::::::"; y/-./ab/for@n=split//,pop; @s=grep$_,split/(..)/,unpack"b*",'!!!!!!!!!!!!!!!'; map{$l=$_;join" ",map($p[$l<<2&4|3&$s[$l+5*hex$_]],@n),$/} 0,1,1,2,3,3,4 } print d("123-45"); print d("67.890");
    So if you download this code into a file called, for example, "seg1.pl", then you could do the following:
    $ perl seg1.pl
    $ perl segment.pl
        # ##### #####       #   # #####
        #     #     #       #   # #
        #     #     #       #   # #
        # ##### ##### ##### ##### #####
        # #         #           #     #
        # #         #           #     #
        # ##### #####           # #####
    ##### #####       ##### ##### #####
    #         #       #   # #   # #   #
    #         #       #   # #   # #   #
    #####     #       ##### ##### #   #
    #   #     #       #   #     # #   #
    #   #     #       #   #     # #   #
    #####     #     # ##### ##### #####
    $
    
    The reason for the extra step is that I have two binary strings as part of my subroutine.

    I suspect the sub can be golfed quite a bit still... Have fun. (:

            - tye (but my friends call me "Tye")

      I figured out a way to drop the 8-char binary string to a 5-char binary string and simplify some of the math. Unfortunately, the simpler math uses + instead of | so the precedence is wrong so I'd need two sets of parens, which makes the math expression 2 characters longer (despite the calculation being simpler). That would still be an over-all net reduction by one character. But that involves recomputing all of the bits, so I'm not including that trick.

      But some standard golfing on the rest did get me down to 177 (updated from 179) chars:

      #!/usr/bin/perl open SEG, ">segment.pl" or die "Can't write seg.pl: $!\n"; binmode SEG; while(<DATA>){ s/::::::::/pack"H*",'1f10001100100111'/e; s/!!!!!!!!!!!!!!!/pack"H*",'fca88a04228f12420caacc30125084'/e; print SEG $_; } __END__ #!/usr/bin/perl sub d{ y/01/ #/for@p=unpack"b5"x8,"::::::::";@s=grep$_,split/(..)/, unpack"b*",'!!!!!!!!!!!!!!!';map{$l=$_;join($",map{y/-./ab/; $p[4&$l*4|3&$s[$l+5*hex]]}split//,$_[0]).$/}0,1,1,2,3,3,4 } print d("123-45"); print d("67.890");

              - tye (but my friends call me "Tye")
Ah, but what about correct display of the decimal point?
by mugwumpjism (Hermit) on Jun 08, 2001 at 19:35 UTC

    Whilst my answer is longer, I think you will find it simulates a 7 segment display a little closer, and it has a larger, more readable font.

    This one weighs in at 299 characters, excluding line breaks.

    sub f{ $i=$_[0];$i=~s/(\d)\./$1|'@'/eg;@c=split//,"\brew\$]m.k{%\177o"; for$a(0..8){for$l(split//,$i){$x=ord$c[ord($l&"?")-45];print do{ if($a%4){$q=($x>>($a>4)*3)&6;($q&2?"|":" ")." ".($q&4?"|":" ") ." ";}else{($x>>($a>>2)*3&1?" ----- ":" "x7). ($a==8&&(($l&"@")eq"@")?" X ":" ");}}}print"\n";}} f(-123.04); f(56789);

    And the output is:

                         -----     -----              
                    |         |         |   |     |   
                    |         |         |   |     |   
                    |         |         |   |     |   
     -----               -----     -----     -----    
                    |   |               |         |   
                    |   |               |         |   
                    |   |               |         |   
                         -----     -----  X           
     -----     -----     -----     -----     -----     -----    
    |         |               |   |     |   |     |   |     |   
    |         |               |   |     |   |     |   |     |   
    |         |               |   |     |   |     |   |     |   
     -----     -----               -----     -----              
          |   |     |         |   |     |         |   |     |   
          |   |     |         |   |     |         |   |     |   
          |   |     |         |   |     |         |   |     |   
     -----     -----               -----     -----     -----    
    

    Not bad for a first golf attempt? :-)

      I really really like it! VERY NEAT! That's not much code for a VERY cool output.
Re: (Golf) LED Sign
by petral (Curate) on Jun 10, 2001 at 05:49 UTC
    179 chars:
    sub led{ ($b=pop)=~y/0-9.\-\0-~/\0-\cK/d; join$/, map{join$", ($"x4,'X ',' X','X X','X'x4)[(/./g)[unpack'C*',$b]] }424434444400, (322231123300)x2, 324444424404, (321222323200)x2, (424x4)-4,"" } print led @ARGV ? shift : "19QQ86\t-- \@0134.72x-0(?)";
    (Using hex conversion for the string (and to delete unwanted characters! ) and an array slice of an array slice to generate the lines.)

    (Change the trailing ' ~ ' to a ' ÿ '(" ÿaut "?) to reject 8-bit chars too -- I wasn't sure how it would travel inside code tags.)

    update:  or 172 chars w/o argument checking and putting the '-' first:
    ($b=pop)=~y/-0-9./\0-\cK/;join$/, map{join$",('X ',$"x4,' X','X X','X'x4)[(/./g)[unpack'C*',$b]]} 142443444441,(132223002331)x2,432444442441,(132022232321)x2,1 .424x4 ,""
      p

      The conversion to low-ASCII for index uses was something that I had considered while writing my first take. I would've used ord instead of unpack. However, using unpack to double as both ord and split is truly devious.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://86805]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others scrutinizing the Monastery: (4)
As of 2024-03-28 23:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found