text:
How many friday the 13th in a year?
Your challenge is to write a program which, given a year, outputs the number of "Friday 13ths" in it.
Rules & Details:

You can take input via STDIN, or as an argument passed to your program.
You should output the result to STDOUT.
You may assume that input will be a valid year, and does not pre-date the Gregorian calendar (undefined behaviour is permitted in these cases).
Calendar/Date libraries are allowed.

This is a code-golf, so the shortest code (in bytes) wins.
(Related challenge link)

What is the required range of input? If it goes much before 1800, what assumptions should be made about switchover from Julian to Gregorian calendar?

@PeterTaylor I hadn't thought about it. If a date pre-dates gregorian then you can have undefined behaviour.

The first countries to adopt the Gregorian calendar did so in October 1582, following the bull of Gregory himself. Countries to adopt the new calendar late did not change until the 20th century, for example Greece introduced it on 1 March 1923.

@JeppeStigNielsen I don't know much about calendars and such. Whether they adopted them or not doesn't change what the gregorian dates are. Libraries should be able to calculate dates from quite a ways back I presume?

I am being offtopic here, I guess. Many libraries written by Anglo-American programmers use September 1752 as the "correct" time of change of calendars. This was when the British Empire changed. The new calendar was kept when U.S.A. was founded, of course. (As a curiosity, some SQL software has 1753 as the minimal year since they don't want to cope with the September 1752 issue.) However, using September 1752 is highly anglocentric. You are right Gregorian dates are the same whether they were used historically or not. That is the so-called proleptic Gregorian calendar.

APL (Dyalog APL) with cal  from dfns, 29 bytes
+/{13∊⍎,⍉3↑¯5↑⍉2↓cal⍵}¨⎕,¨⍳12

Try it online!
⍳ 12 the integers one through twelve
⎕ ,¨ take numeric input and prepend to each of the twelve numbers
{…}¨ on each of the pairs, apply the function…
 cal⍵ get a calendar for that year-month
 2 ↓ drop two rows (caption and days)
 ⍉ transpose (so we can address columns instead of rows)
 ¯5 ↑ take the last five (two digits for each of Friday and Saturday plus one space)
 3 ↑ take the first two (two digits for Friday plus a space)
 ⍉ transpose (so we get reading order)
 , ravel
 ⍎ execute as APL expression (gives list of Fridays' dates)
 13 ∊ is thirteen a member of that list?
+/ sum the 12 Booleans

Using @Wrzlprmft's algorithm, we can do it without libraries for 53 bytes:
'21232211321211'⊃⍨14|2 3 ¯1+.×⊢,0≠.=400 100 4∘.|-∘0 1

-∘0 1 subtract zero and one
400 100 4 ∘.| division remainder table for the two years (across) divided by these numbers (down)
0 ≠.= inner "product" with 0, but using ≠ and = instead of +.×
⊢ , prepend the unmodified argument year
2 3 ¯1 +.× inner product with these numbers
14 | division remainder when divided by fourteen
'21232211321211' ⌷⍨ index into this string

It's 29 characters, but these are more than 1 byte characters right?

@Cruncher I've added an explanatory link in the heading. If you open the TIO link, you'll see that it says "29 chars, 29 bytes (SBCS)" on the right, i.e. Single Byte Character Set.

Well, I guess this is the new winner then, is standard practice in this SE to change the accepted answer this long after the question?

@Cruncher Yes. And there are even badges to be had for getting accepted long after OP.

Mathematica 49 46 45 44 42
As a pure function: 42 chars
DayName@{#,m,6}~Table~{m,12}~Count~Friday&

Example
DayName@{#,m,6}~Table~{m,12}~Count~Friday&[2013]

2

As a named function: 44 chars
f=DayName@{#,m,6}~Table~{m,12}~Count~Friday&

Examples
f[1776]
f[2012]
f[2013]
f[2014]

2
3
2
1

One character shorter: f=DayName@{#,m,6}~Table~{m,12}~Count~Friday&

@Mr.Wizard  Yes. It surprises me that Mathematica can parse the multiple cases of infix notation.

David it surprises me that you haven't seen my (over)use of this conjoined notation. :^)  (Examples: (1), (2))

Ruby, 49 48 47 46
f=->m{(1..12).count{|i|Time.gm(m,i,6).friday?}}

Edit: Shaved a character by going back a week, thanks to Jan, and another by switching from Time.new to Time.gm
Edit: At the expense of obfuscating it a bit more, I can get to 46 with
f=->m{(1..12).count{|i|Time.gm(m,i,8).wday<1}}

one-char saving if you count the numbers of fridays the 6th

@JanDvorak clever!

why 6? I didn't get it.

If the 6th is a friday, then the 13th is also a friday

If the 8th is a Sunday, then the 1st is as well, and so you can use Time.gm(m,i).wday<1. Also, I don't know why you're naming the function.

You can remove f= if the rest is a complete function expression (in this case a lambda)

Powershell, 68 63 58 52 50
Thanks Iszi for the tip.
$n=$args;(1..12|?{!+(date $n-$_).DayOfWeek}).Count

Using the fact that if the 1st day in the month is Sunday, the 13th will be Friday.
I've also tried:
(1..12|?{!+(date $args-$_).DayOfWeek}).Count

but it's not the same $args inside the script block.

I like the idea of using the first day of the month.

Nice trick, there. The @ is unnecessary, though.

Another thing, though I'm guilty of the same in a lot of my scripts. The challenge does specify that the input can come from an argument. Replace $n with $args in the loop, and you can do without $n=read-host; entirely. Saves 8. Remove @, as mentioned above, and you're down to 54.

Correction: Comes down to 52!

Trying to figure out why your second script won't work and I'm at a loss. What's interesting is that I can change out $args for $input, thus feeding the year in from the pipeline, and the script will run but it always outputs 3.

I guess, in that case, $input enumerates the object that is currently in the pipeline, i.e. $input is the same as $_, so the script always operates on January year 1, February year 2, March year 3, and so on...

Nice. You can save 6 bytes $n=$args;(1..12|?{!(date $n-$_|% d*k)}).Count

bash 47 36
seq -f$1-%g-6 12|date -f-|grep -c ^F

Thanks @DigitalTrauma for saving 10 chars by using seq with default start to 1.

date -f<(printf "%s\n" $1-{1..12}-6)|grep -c ^F

(Previous version using echo present a bug because of the empty line when <(echo $1-{1..12}-6$'\n'). So this function worked fine until today is a Friday.
Lets see:
set -- 2013
seq -f$1-%g-6 1 12|date -f-|grep -c ^F
2

date -f<(printf "%s\n" $1-{1..12}-13)|grep -c ^F
2

This is locale dependant, so if this don't work, you may have to
export LANG=C

or
LANG=C date -f<(printf "%s\n" $1-{1..12}-13)|grep -c ^F

Into a function; +7 -> 43
f(){ seq -f$1-%g-6 12|date -f-|grep -c ^F;}

f 2013
2

for i in {2010..2017};do echo $i $(f $i) ;done
2010 1
2011 1
2012 3
2013 2
2014 1
2015 3
2016 1
2017 2

Bonus: +78 -> 121
From there, if my function become:
f(){ o=();for t in $(seq -f$1-%g-6 12|date -f- +%a,%b);do [ "${t:0:1}" = "F" ]&&o+=(${t#*,});done;echo ${#o[@]} ${o[@]};}

or
f(){ o=();
     for t in $(seq -f$1-%g-6 1 12|date -f- +%a,%b);do
         [ "${t:0:1}" = "F" ]&&o+=(${t#*,})
       done
     echo ${#o[@]} ${o[@]}
}

for i in {2010..2017};do echo $i $(f $i) ;done
2010 1 Aug
2011 1 May
2012 3 Jan Apr Jul
2013 2 Sep Dec
2014 1 Jun
2015 3 Feb Mar Nov
2016 1 May
2017 2 Jan Oct

This seems to be locale-dependent.

Yes, This is based on default C. But there is a bug...

Save a char by unquoting your printf format string and escaping the \ instead: %s\\n

Or use seq to drop 8 chars: date -f<(seq -f$1-%g-6 1 12)|grep -c ^F

@DigitalTrauma Thanks! Post edited!

@DigitalTrauma I have to win this, if my count is right!?

@F.Hauri There's this one http://codegolf.stackexchange.com/a/25525/11259 which is neck-and-neck with you if corrected according to my comment

Actually, you can shave off 2 more chars.  If you omit the starting sequence number, seq will start at 1 by default, which it what you want: seq -f$1-%g-6 12|date -f-|grep -c ^F

Not using any libraries or built-in date functions:
Golfscript – 51
~..({4/.25/.4/--@}2*2*\3*+-
14%' [3/=RI[)a%:*.'\=5%

 ' [3/=RI[)a%:*.' could as well be 'feefefgeeffgfe'

Python – 82 79
Essentially the same algorithm.
l=lambda y:y/4-y/100+y/400
i=input()
print"21232211321211"[(2*i+3*l(i)-l(i-1))%14]

Using this trick, this can be golfed down further to:
l=lambda y:y/4-y/100+y/400
i=input()
print 94067430>>(4*i+6*l(i)-2*l(i-1))%28&3

 This exploits the fact that, calender-wise, there are only 14 different years, which are distinguishable by their last day and whether they are leaping. l calculates the number of leap years up to its argument (if the Gregorian calendar extended backwards to the year 1). (2*i+3*l(i)-l(i-1))%14 is short for l(i)-l(i-1)+(i+l(i))%7*2, where l(i)-l(i-1) tells us whether the argument is a leap year and i+l(i) sums up the shifts of the last day (one in a normal year, two in a leap year).

Since this is my first golfscript golf, I would appreciate any hints on further golfing it down.

I was thinking about such a solution utilizing the fact that there's only 14 unique years actually, but wasn't sure the best language to make it competetive. I think this is the shortest answer with no libraries. If leap years were uniformly every 4 years, you might be able to win with this

Python2.7 90 86
from datetime import*
s=c=0
exec's+=1;c+=date(%d,s,9).weekday()<1;'%input()*12
print c

Monday the 9th may not have quite the same ring to it but works just as well.
Edit: A year and a half to notice that date is shorter than datetime :)

Really nice solution!

You can save a char by doing from datetime import*

Nice! I ended up with something effectively identical, but avoiding exec: f=lambda y:sum([date(y,m,13).weekday()==4 for m in range(1,13)]).... Same size solution with the import (86 bytes), though.

R 76 72 57
sum(format(as.Date(paste(scan(),1:12,1,sep="-")),"%w")<1)

Can easily get this down 4 by replacing your "%a %d")=="Fri 13" with "%w%d)=="513") by using dow as a number, and removing the spaces.

much appreciated!

+1 Though doing the seq only on the month is actually shorter here! sum(format(as.Date(paste(scan(),1:12,13,sep="-")),"%w%d")=="513")is only 65 characters!

wow I wouldn't have guessed that < would coerce a character to an integer. Nice trick!

@plannapus It's rather common. Since character codes are all numbers. Even java can compare int and char

It is the other way around. The integer is coerced to a character. See for example that "0.2e2" < 1 is TRUE.

I really have a short memory cause this is the exact same thing as the "TRUE"==TRUE issue.

C 301+ 287
main(int x,char**v){char p[400],*a[]={"abbababbacaacbac","bacabbb","baabbaca","abbb","aabbacaac","abbbbcaac","abbbbaabb"},*b="adcadcadcaebcadcadcafbcadcadcagbcadcadcadc";int c=0,i,y=atoi(v[0]);for(i=0;i<42;i++)strcpy(&p[c],a[b[i]-'a']),c+=strlen(a[b[i]-'a']);printf("%d",p[y%400]-'`');}

Not the shortest answer, but uses no libraries.

Hey, would you be willing to provide the ungolfed answer with an explanation? I'm interested in what exactly you did

@Cruncher, it's a lookup table on the basis that the Gregorian calendar follows a 400-year cycle.

More explicitly (and longer), C#: static char GetNumberOfFriday13s(int year) { const string perpetualCalendar = "1221212213113213122221122131122121221311321312222112213112212122131132131222211221311221212213113213112213113213122221122131122121221311321312222112213112212122131132131222211221311221212213113213122213113213122221122131122121221311321312222112213112212122131132131222211221311221212213113213122221122213122221122131122121221311321312222112213112212122131132131222211221311221212213113213122221122131"; return perpetualCalendar[year % 400];. Won't work for negative years.

Cute!  As a small bug, v[0] should be v[1].  You can also golf this a bit; consider using strcat, storing characters to directly print in a[], and subtracting numeric constants instead of character constants. :)

main(int x,char**v){char p[400],*a[]={"1221212213113213","2131222","21122131","1222","112213113","122223113","122221122"},*b="adcadcadcaebcadcadcafbcadcadcagbcadcadcadc";*p=0;for(;*b;b++)strcat(p,a[*b-97]);putchar(p[atoi(v[1])%400]);} (234 chars)

I improved the compression as well: main(int x,char**v){char p[400],*a[]={"1221212213113213","2131222","21122131","1222","112213113","122223113","122221122"},*b="adcadcadcaebcadcadcafbcadcadcagbcadcadcadc";*p=0;for(;*b;b++)strcat(p,a[*b-97]);putchar(p[atoi(v[1])%400]);} (215 chars)

JavaScript, 70
f=function(a){b=0;for(c=12;c--;)b+=!new Date(a,c,1).getDay();return b}

and why it is -1?

Looks good! You can save a few more bytes, by removing ,b,c from the function declaration (it's ok to leak vars for golf!), also as b is cast as a Number you can += the result of test instead of the &&b++: b+=/^F/.test(new Date(a,c,6)). However, you can save another byte, using !new Date(a,c,1).getDay() (this works because getDay returns 0 for Sunday, and if the 13th is a Friday, the 1st will be a Sunday) instead of the test which altogether should save you 7 bytes!

@DomHastings : thx for your tips !!!

C (151 145 137 131 130 chars)
I am surprised to see that there is only one other solution that doesn't use built-in calendar tools.  Here is a (highly obfuscated) mathematical approach, also in C:
f(x){return(x+(x+3)/4-(x+99)/100+!!x)%7;}main(int x,char**v){int y=atoi(v[1])%400,a=f(y+1);putchar('1'+((f(y)&3)==1)+(a>2&&a-5));}

(The above compiles in GCC with no errors)
Alternative solution: C (287->215 chars)
I rather enjoyed Williham Totland's solution and his use of compression.  I fixed two small bugs and tweaked the code to shorten its length:
main(int x,char**v){char p[400],*a[]={"1221212213113","213122221122131","12213113","22213113","22221122","2131"},*b="abababafcbababafdbababafebababab";*p=0;for(;*b;b++)strcat(p,a[*b-97]);putchar(p[atoi(v[1])%400]);}

I got my C entry down to 76 bytes - not quite so mathematical as this, but the necessary tables are well hidden until you read the explanation.

PHP, 82
<?for($i=1,$c=0;$i<13;$i++)$c+=(date("N",mktime(0,0,0,$i,1,$argv[1]))==7);echo $c;
Based on
"Any month that starts on a Sunday contains a Friday the 13th, and there is at least one Friday the 13th in every calendar year."
From http://en.wikipedia.org/wiki/Friday_the_13th

k
64 characters
{+/6={x-7*x div 7}(.:')x,/:(".",'"0"^-2$'$:1+!:12),\:".13"}[0:0]

Reads from stdin

Ok, just what is going on here? :P

Read in year, build list of dates of 13th day of every month, test day of week = friday, sum resulting list of booleans

Common Lisp (CLISP), 149
(print
    (loop for i from 1 to 12 count
        (= 4 (nth-value 6
            (decode-universal-time
                (encode-universal-time 0 0 0 13 i
                    (parse-integer (car *args*)) 0))))))

Oh god, I never could read lisp..

C# 110 101 93 92
int f(int y){int c=0;for(int i=1;i<13;i++)c+=new DateTime(y,i,8).DayOfWeek>0?0:1;return c;}

C# Linq 88
int g(int y){return Enumerable.Range(1,12).Count(m=>new DateTime(y,m,8).DayOfWeek==0);}

Thanks to Jeppe Stig Nielsen for linq and suggestion of checking for sunday on the 8th.
Thanks to Danko Durbić for suggesting > instead of ==.

Instead of c+=(int)new DateTime(y,i,13).DayOfWeek==5?1:0;, use the equivalent c+=new DateTime(y,i,8).DayOfWeek==0?1:0;. The trick is to subtract 5, because then you can get rid of the cast to int, and also the number 8 has one digit less than the number 13. Sunday the Eighth!

With Linq: int g(int y){return Enumerable.Range(1,12).Count(m=>new DateTime(y,m,8).DayOfWeek==0);}. Of course as a lambda this is y=>Enumerable.Range(1,12).Count(m=>new DateTime(y,m,8).DayOfWeek==0).

You can save one character by comparing .DayOfWeek<1.

@DankoDurbić This can apply to the c# answer but not sure how to apply it to linq .

My mistake; apparently you can't compare DayOfWeek with any other integer than 0 - error CS0019: Operator '<' cannot be applied to operands of type 'System.DayOfWeek' and 'int'.

PHP, 55 bytes
for(;++$i<13;)$c+=!date(w,strtotime($argn.-$i));echo$c;

Run with echo <year> | php -nR '<code>'.
Basically the same that Oleg tried and Damir Kasipovic did, just with better golfing:
Every month that starts with a sunday, has a Friday the 13th.
So I loop through the months and count the first days that are sundays.
breakdown
for(;++$i<13;)          // loop $i from 1 to 12
    $c+=!                   // 4. if result is not truthy (weekday==0), increment $c
        date(w,             // 3. get weekday (0 stands for Sunday)
            strtotime(      // 2. convert to timestamp (midnight 1st day of the month)
                $argn.-$i   // 1. concatenate year, "-" and month
            )
        )
    ;
echo$c;                 // output

Bash (52 47 characters)
for m in {1..12};do cal $m $Y;done|grep -c ^15

K, 42
{+/1={x-7*x div 7}"D"$"."/:'$+(x;1+!12;1)}

.
k){+/1={x-7*x div 7}"D"$"."/:'$+(x;1+!12;1)}'1776 2012 2013 2014
2 3 2 1

Python 195 / 204
Works only for previous years, because monthdatescalendar returns a calendar for the given year until now. I think there is a lot of optimizing potential left :).
import calendar, sys
c=calendar.Calendar()
f=0
for m in range(1,12):
 for w in c.monthdatescalendar(int(sys.argv[1]),m):
  for d in w:
   if d.weekday() == 4 and d.day == 13:
    f=f+1
print(f)

Another solution, works for every date but it isn't smaller:
import datetime,sys
y=int(sys.argv[1])
n=datetime.date
f=n(y,1,1)
l=n(y,12,31)
i=0
for o in range(f.toordinal(), l.toordinal()):
 d=f.fromordinal(o)
 if d.day == 13 and d.weekday() == 4:
  i=i+1
print(i)

In your first example the range should be (1,13) otherwise you'd miss December Friday 13ths, like in 2013.

You didn't even bother golfing. Remove some of those spaces.

Rebol, 63
f: 0 repeat m 12[d: do ajoin["6-"m"-"y]if d/weekday = 5[++ f]]f

Usage example in Rebol console:
>> y: 2012
== 2012

>> f: 0 repeat m 12[d: do ajoin["6-"m"-"y]if d/weekday = 5[++ f]]f
== 3

Alternative solution which collects all the Friday 13th in given year is:
>> collect[repeat m 12[d: do ajoin["13-"m"-"y]if d/weekday = 5[keep d]]]
== [13-Jan-2012 13-Apr-2012 13-Jul-2012]

Bash and Sed, 39
ncal $1|sed '/F/s/13/\
/g'|grep -c ^\ 2

ncal prints a calendar for the given year with days of the week down the left.
sed with a /g flag subs out all 13s with newlines
grep -c counts the lines that start with " 2" (20 always follows 13)
Thanks to @DigitalTrauma for finding a bug in my old version and proposing a solution!

Doesn't quite work for me - Friday lines are only printed once even if they contain more than one 13.

I think the best I can do with something like this is 38: ncal $1|sed /F/s/13/\\n/g|grep -c ^\ 2

@DigitalTrauma You're right.  At some point this script was working. let me fix it.

@DigitalTrauma looks like some much longer version was working.  thanks for the fix!

Interesting, the unquoted sed expression I proposed works with GNU sed (Linux) but not with BSD sed (OSX).  I guess you can gain 1 char at the cost of portability if you choose the GNU version.

36 bytes: ncal $1|grep F|tr \  \\n|grep -c 13.  Using grep+tr works out cheaper than that sed.  @DigitalTrauma, too.

Make that 32: ncal $1|grep F|grep -o 13|wc -l

Scala, 76 68 characters
In 78 chars:
def f(y:Int)=0 to 11 count(new java.util.GregorianCalendar(y,_,6).get(7)==6)
Nothing out of ordinary, except for using magical numbers for DAY_OF_WEEK = 7 and FRIDAY = 6.
68 character version:
def f(y:Int)=0 to 11 count(new java.util.Date(y-1900,_,6).getDay==5)
Yes, Java changed values of day of the week constants between API's.

It's a shame new java.util.GregorianCalendar has to be so long :(

Perl 6, 55 53
{sum (1..12).map: {Date.new($_,$^a,1).day-of-week>6}}

Old answer:
{sum (1..12).map: {Date.new($_,$^a,13).day-of-week==5}}

48 bytes

Python(v2) 120
import datetime as d,sys
s=0
for m in range(1, 13):
    if d.datetime(int(sys.argv[1]),m,6).weekday()==4: s=s+1
print s

Perl + lib POSIX 55
With the idea of not looking for 13th but first, and as sunday is 0 this let save 3 chars! Thanks @ Iszi and Danko Durbić!
$==$_;$_=grep{!strftime"%w",0,0,0,1,$_,$=-1900}(0..11)

Could compute 2010 to 2017 (for sample) in this way:
perl -MPOSIX -pE '$==$_;$_=grep{!strftime"%w",0,0,0,1,$_,$=-1900}(0..11)' <(
    printf "%s\n" {2010..2017})
11321312

(Ok, there is no newline, but that was not asked;)
Old post: 63
$==grep{5==strftime"%w",0,0,0,13,$_,$ARGV[0]-1900}(0..11);say$=

In action:
for i in {2010..2017};do
    echo $i $(
        perl -MPOSIX -E '
            $==grep{5==strftime"%w",0,0,0,13,$_,$ARGV[0]-1900}(0..11);say$=
            ' $i );
  done
2010 1
2011 1
2012 3
2013 2
2014 1
2015 3
2016 1
2017 2

In Smalltalk (Squeak/Pharo flavour), implement this method in Integer (86 chars)
countFriday13^(1to:12)count:[:m|(Date year:self month:m day:13)dayOfWeekName='Friday']

Then use it like this: 2014countFriday13.
Of course, we could use a shorter name, but then it would not be Smalltalk

C++ - Too many bytes :(
I tried a solution which doesn't make use of any date libraries.
I found a pretty cool (if I may say so myself) solution. Unfortunately I can't get it shorter than this, which really bugs me because it feels like there should be a better way.
The solution hinges on this algorithm which is only 44 bytes in itself. Unfortunately I need another 100 bytes to wrap it nicely...
#include<stdlib.h>
main(int,char**v){int f=0,d,m,y;for(m=1;m<13;++m)d=13,y=atoi(v[1]),(d+=m<3?y--:y-2,23*m/9+d+4+y/4-y/100+y/400)%7-5||++f;return f;}

Output through the return code (in C++, using cout or printf or anything like that requires another #include, which would blow up the solution even more).
Driver / test program:
# Make sure we're not running an old version
rm doomsday.exe

gcc doomsday.cpp -o doomsday.exe

./doomsday.exe 1776
echo 1766: $?

./doomsday.exe 2012
echo 2013: $?

./doomsday.exe 2013
echo 2013: $?

./doomsday.exe 2014
echo 2014: $?

echo `wc doomsday.cpp -c` characters

Output of the driver program:
$ ./test_doomsday
1766: 2
2013: 3
2013: 2
2014: 1
150 doomsday.cpp characters

I count 88 for the algorithm, not 44. What is the algorithm and what is the warpping? ($m<3?$y--:$y-2)+3 instead of d=13,, d+=m<3?y--:y-2, and d+4 should work as well and saves a lot. +5 instead of +3 and -5 should work too and saves 2 bytes. for(m=0;++m<13;) saves one byte. Moving m=0 to the function head saves another byte; and moving ()%7||++f to the loop head saves another one. Down from 149 to 136 bytes.

Clojure, 207 187 bytes
-20 bytes by getting rid of the import, and some whitespace I missed.
(import '[java.time LocalDate DayOfWeek])#(loop[d(LocalDate/parse(str %"-01-01"))c 0](if(=(.getYear d)%)(recur(.plusDays d 1)(if(and(=(.getDayOfMonth d)13)(= (.getDayOfWeek d) DayOfWeek/FRIDAY))(inc c)c))c))

Starting on Janauary 1st of the given year, it loops over each day. If the day is Friday the 13th, it increments the count. It continues to loop until it reaches the next year.
(import '[java.time LocalDate DayOfWeek])

(defn count-friday-13ths [year]
  (loop [d (LocalDate/parse (str year "-01-01")) ; Starting date
         c 0] ; The count
    (if (= (.getYear d) year) ; If we haven't moved onto the next year...
      (recur (.plusDays d 1) ; Add a day...
             (if (and (= (.getDayOfMonth d) 13) ; And increment the count if it's Friday the 13th
                      (= (.getDayOfWeek d) DayOfWeek/FRIDAY))
               (inc c) c))
      c))) ; Return the count once we've started the next year.

PHP, no builtins, 81 bytes
echo 0x5da5aa76d7699a>>(($y=$argn%400)+($y>102?$y>198?$y>299?48:32:16:0))%28*2&3;

Run with echo <year> | php -nR '<code>'.
breakdown
Weekdays repeat every 400 years.
In the results for 1600 to 1999 (for example), there is a 28-length period with just three gaps:
  0:2212122131132131222211221311
 28:2212122131132131222211221311
 56:2212122131132131222211221311
 84:2212122131132131122
103:       131132131222211221311
124:2212122131132131222211221311
152:2212122131132131222211221311
180:2212122131132131222
199:       131132131222211221311
220:2212122131132131222211221311
248:2212122131132131222211221311
276:221212213113213122221122
300:            2131222211221311
316:2212122131132131222211221311
344:2212122131132131222211221311
372:2212122131132131222211221311

After adjusting the year for these gaps, we can get the result with a simple hash:
$y=$argn%400;foreach([300,199,103]as$k)$y<$k?:$y+=16;
echo"2212122131132131222211221311"[$y%28];

Not short (95 bytes) but pretty. And we can golf

4 bytes by using a ternary chain for the offset,
8 bytes by converting the hash map from a base4 string to integer,
one more by using the hex representation,
and one by merging the expressions.

A port of CompuChip´s C++ answer can be golfed down to 84 bytes: for(;++$m<13;23*$m/9+($m<3?$y--:$y-2)+5+$y/4-$y/100+$y/400)%7?:$f++)$y=$argn;echo$f;

Japt -x, 10 8 bytes
CÆ!ÐUX e

Try it
CÆ5¥ÐUXD e     :Implicit input of integer U
C              :12
 Æ             :  Map each X in the range [0,C) (months are 0-indexed in JavaScript)
  5¥           :  Check if 5 is equal to
    ÐUXD       :  new Date(U,X,13)
         e     :  0-based index of day of the week
               :Implicitly reduce by addition and output

JavaScript, 56 47 bytes
f=(y,m=12)=>m&&f(y,--m)+!new Date(y,m).getDay()

Try It Online!

54

C, 76 bytes
A function that accepts a year and returns the count of Fridays the 13th for that year:
d(y){return(y+y/4-y/100+y/400)%7;}f(y){return(22>>d(y)&1|2)-(55>>d(y-1)&1);}

If a full program is really required, it comes in at 111 bytes, accepting a single argument and printing to standard out:
d(y){return(y+y/4-y/100+y/400)%7;}main(y,v)char**v;{y=atoi(*++v);putchar('0'+(22>>d(y)&1|2)-(55>>d(y-1)&1));}

Explanation
int day_index(int year)
{
    return (year + year/4 - year/100 + year/400) % 7;
}
int f(int year)
{
    const char a[] = "2332322";
    const char b[] = "1110110";
    return a[day_index(year)]
        -  b[day_index(year-1)];
}

We split the year into two parts (Jan-Feb and Mar-Dec) so that leap years don't disrupt the calculation.
The helper function computes the weekday of New Year's Eve (0 = Sunday).  We first use this to determine (in a) how many Fridays the 13th are in March-December.  Then we use the weekday index of the preceding year to get the count from b for January and February.
The golfed code uses a bit mask rather than a character array: a becomes 22 and b becomes 55.
Demo
The demo is on Try It Online.
#include <stdio.h>
int main(void)
{
    for (int year = 1990;  year < 2050;  ++year) {
        printf("%d: %d\n", year, f(year));
    }
}

1990: 2
1991: 2
1992: 2
1993: 1
1994: 1
1995: 2
1996: 2
1997: 1
1998: 3
1999: 1
2000: 1
2001: 2
2002: 2
2003: 1
2004: 2
2005: 1
2006: 2
2007: 2
2008: 1
2009: 3
2010: 1
2011: 1
2012: 3
2013: 2
2014: 1
2015: 3
2016: 1
2017: 2
2018: 2
2019: 2
2020: 2
2021: 1
2022: 1
2023: 2
2024: 2
2025: 1
2026: 3
2027: 1
2028: 1
2029: 2
2030: 2
2031: 1
2032: 2
2033: 1
2034: 2
2035: 2
2036: 1
2037: 3
2038: 1
2039: 1
2040: 3
2041: 2
2042: 1
2043: 3
2044: 1
2045: 2
2046: 2
2047: 2
2048: 2
2049: 1

Lua, 95 bytes
n=0 for i=1,12 do n=os.date('%w',os.time{month=i,day=13,year=...})=='5'and n+1or n end print(n)

Try it online!

JavaScript (Node.js), 47 bytes
f=(y,m=12)=>m&&f(y,--m)+!new Date(y,m).getDay()

Attempt This Online!
-2 bytes thanks to l4m2

JavaScript (Node.js), 47 bytes: f=(y,m=12)=>m&&f(y,--m)+!new Date(y,m).getDay()

Scala 3, 107 bytes
Golfed version. Attempt This Online!
y=>(1 to 12).map{m=>if(java.time.LocalDate.of(y,m,6).getDayOfWeek==java.time.DayOfWeek.FRIDAY)1 else 0}.sum

Ungolfed version. Attempt This Online!
import java.time._

object Main {
  def main(args: Array[String]): Unit = {
    println(countFridays(1776))
    println(countFridays(2012))
    println(countFridays(2013))
    println(countFridays(2014))
  }

  def countFridays(year: Int): Int = {
    (1 to 12).map { month =>
      val firstDay = LocalDate.of(year, month, 6).getDayOfWeek
      if (firstDay == DayOfWeek.FRIDAY) 1 else 0
    }.sum
  }
}

Go, 114 bytes
import."time"
func f(y int)(c int){for i:=0;i<12;i++{if Date(y,Month(i+1),1,0,0,0,0,UTC).Weekday()<1{c++}}
return}

Counts months starting with Sundays.
Attempt This Online!

Rust, 103 bytes
Golfed version. Run it on Rust Playground!
fn c(y:i32)->i32{(1..=12).filter(|m|NaiveDate::from_ymd(y,*m,6).weekday()==Weekday::Fri).count()as i32}

Ungolfed version. Run it on Rust Playground!
use chrono::{Datelike, Weekday, NaiveDate};

fn main() {
    println!("{}", count_fridays(1776));
    println!("{}", count_fridays(2012));
    println!("{}", count_fridays(2013));
    println!("{}", count_fridays(2014));
}

fn count_fridays(year: i32) -> i32 {
    let mut count = 0;
    for month in 1..=12 {
        let date = NaiveDate::from_ymd(year, month, 6);
        if date.weekday() == Weekday::Fri {
            count += 1;
        }
    }
    count
}


text:
Check whether there are more even than odd numbers on any given nested list
Take any type of nested list(s) containing numbers. Check for how many even/odd numbers are within and output even, same or odd (-1, 0, 1) in some way.
Example:
[[1,2,3],4,[5,6],[[7,8], 9]] => 5 odd > 4 even => odd or -1
[1,2,2,1,2,2,2]              => 5 even > 2 odd => even or 1
[1,2,2,1]                    => 2 even = 2 odd => same or 0

Mind clarifying the example (and possibly provide more of them)? Your task description talks about counting odd numbers and filtering out odd numbers, but your example doesn't really show anything of that ilk at all. Also, clarifying how input/output is supposed to work would help.

And if there are the same number?

Then say same or 0

-1 for changing important requirements after people posted their answers. Try to avoid that next time.

@flodel Boollum didn't do it - minitech, LegoStormtroopr and I did (I rolled it back)

Also, I've changed my answers to meet the requirements.

Well then I guess it is a downvote for y'all's contribution...

The question says “nested list”. From this I understand that recursive evaluation is required, making [[1,1,2],[1,1,2],[1,2,2,2,2]] = [odd,odd,even] = odd. Is this right?

@manatwork I assummed that that you count the number of odds and evens in the whole list then output the larger value. So for your example, [[1,1,2],[1,1,2],[1,2,2,2,2]] -> [1,1,2,1,1,2,1,2,2,2,2] = even (5 odd, 6 even)

@Quincunx, as I can tell, the other solutions are also using that interpretation. I think the best would be to rephrase this question as “Take any type of list containing numbers separated by any noise.” – seems that would not disqualify any existing answer. Then BoollumBits could open a new question for real nested list, with good explanation and relevant example.

Python - 63
This returns a negative number if its got more evens, 0 if their are an equal amount or a positive number if there are more odds.
x=input()
i=0
for o in x:
 try:x+=o
 except:i+=o%2-.5
print i

edit: Type checking, who needs that, lets just stab blindly.

Wouldn’t list be shorter than type([])?

@minitech yes it would :)

@minitech not type checking is even shorter!

This doesn't return even or odd, as required.

@Timtech: It says “indicate in some way” and the example shown isn’t exactly regular output, so…

@minitech Time to shorten my answers. =)

To be fair, I was the one who edited it to say "indicate in some way" as the original question was very ambiguous on that front.

Lol, editing it for your purpose. Fine though, you defined it better.

@Timtech all making people say 'odd' or 'even' will do is at least 7 (usually more) characters to their code. This way its truer to the idea of golf.

I'm not sure I understand how this would work with a nested list. NEVERMIND. I see. That's very clever! Should be noted that if you use this then you sabotage the list!

@LegoStormtroopr Yes, I agree. I've removed these from my answers.

Befunge 98 - 19
&2%6*j\1+\2j1+3j@.`

Outputs 1 if even, 0 if odd or the same. I'm still trying to figure out how to indicate that they are the same. However, I have not tested this because I don't have a Befunge 98 compiler. It works as follows:
&   receives input as a number, all parts that aren't numbers are ignored and skipped
2%  takes that number and divides it by two, then gets the remainder (1 if odd, 0 if even)
6*j jump 6 characters if odd, 0 if even

when even:
\   swap top two numbers on stack (I'm storing evens under the odds)
1+  add one to that value
\   swap back
2j  jump 2 characters

when odd:
1+  add 1 to top number on stack

3j  jump 3 characters (to end of line ie the beginning (Befunge wraps))

When & is hit again, if there are no more values, it acts like a reflector, sending the instruction pointer back the other way and running this:
@.`

(executed in reverse order):
` compares the even and odd values, if even is greater, then push 1, else 0
. prints it out
@ ends the program

With one simple change, it can be made to print some negative number if there are more odds, some positive number if there are more evens, and 0 if there are the same amount:
&2%6*j\1+\2j1+3j@.-

R, 64
three possible outputs
function(x)c("even","same","odd")[sign(mean(unlist(x)%%2)-.5)+2]

Examples:
(function(x)c("even","same","odd")[sign(mean(unlist(x)%%2)-.5)+2])(
   list(list(1, 2, 3), 4, list(5, 6), list(list(7, 8), 9)))
[1] "odd"

(function(x)c("even","same","odd")[sign(mean(unlist(x)%%2)-.5)+2])(
   list(list(2, 3), 4))
[1] "even"

(function(x)c("even","same","odd")[sign(mean(unlist(x)%%2)-.5)+2])(
  list(list(2, 3), list(4, 5)))
[1] "same"

k
34 characters.
Outputs o for odd, e for even, s for same.
{"ose"1+{(x>0)-x<0}@+/-1 xexp,//x}

{(`s#-0w -.5 .5!"ose")@+/-1 xexp,//x}

Example:
{"ose"1+{(x>0)-x<0}@+/-1 xexp,//x}((1 3;5 10);12 2 4 6 8)
"e"

R 58
This was written at a time the OP was asking for two "even" or "odd" possible outputs.
function(x)c("even","odd")[which.max(table(unlist(x)%%2))]

Example usage:
(function(x)c("even","odd")[which.max(table(unlist(x)%%2))])(
   list(list(1, 2, 3), 4, list(5, 6), list(list(7, 8), 9)))
# [1] "odd"

Golf-Basic 84, 17
i`Ad`fpart(A/2)*2

Returns 0s for even numbers and 1s for odd numbers. Accepts nested arrays -  1D, 2D, 3D, 4D, etc.

Old version, 30 characters:
i`A@fpart(A/2)*2t`ODD"#t`EVEN"

Explanation (for old version)
i`A

Store input in A. Accepts arrays, e.g. {1,2,3,4} or {{1,2},3,{4,5,{6,7}},8}
@fpart(A/2)*2t`ODD"#t`EVEN"

If (@) one or more numbers in array A are odd, display ODD. Else (#) display EVEN.

“If (@) one or more numbers in array A are odd, display ODD. Else (#) display EVEN.” That’s not the challenge. The idea is to check whether there are more even numbers than odd numbers.

@minitech WHAT?!?! Someone SERIOUSLY edited the question!!!

@minitech Nevermind, that was the old version. The new one outputs 1s for odd and 0s for even.

I think that might be taking “indicate in some way” a little far :D

@minitech I might as well, taken that Golf-Basic 84 actually runs through every digit in the array every time I put it into a mathematical equation (e.g. modulus).

JavaScript, 65
c=l=>l.reduce((a,b)=>a+(+b?b%2-.5:c(b)),0),l=>c(l)<0?"even":"odd"

Defaults to “odd” if there are equal numbers of each. Requires arrow function support, which currently means “SpiderMonkey”.
If you don’t mind output as a number, it’s just this part, at 42:
c=l=>l.reduce((a,b)=>a+(+b?b%2-.5:c(b)),0)

Ti-Basic 84, 26 characters
:Input A:Disp fpart(A/2)*2

Returns 1 for odd numbers and 0 for even numbers. Takes nested arrays - 1D, 2D, 3D, 4D, 5D, etc.

Old version, 50 characters:
:Input A:If fpart(A/2)*2:Disp"ODD":Else:Disp"EVEN"

Takes arrays like {1,2,3} and also {1,{2,3},4,{5,{6,7}},{{8,9},10},11}
Returns EVEN for all even and ODD if it contains odd.

The new version complies with the new requirements of measuring how many odd and even numbers there are (it displays an array of true and false).

JavaScript, 51+
Variation 1, 61 or 51
Reads input via prompt, outputs via alert, encodes answer as a number with sign denoting if more evens or odds.
b=0;prompt().replace(/\d+/g,function(s){b+=s%2*2-1});alert(b) // ES5, 61
b=0;prompt().replace(/\d+/g,s=>b+=s%2*2-1);alert(b) // ES6, 51

Variation 2, 72 or 49
As above, but as a function taking an array instead of using prompt/alert.
function f(s){b=0;return s.big?b+=s%2*2-1:s.join().replace(/\d+/g,f)&&b} // ES5, 72
f=a=>b=0,a.join().replace(/\d+/g,s=>b+=s%2*2-1),b // ES6, 49

source: Stack Exchange

license: Creative Commons - Attribution Share-Alike - https://creativecommons.org/licenses/by-sa/3.0/

sort: votes


text:
Simple One Game Blackjack
This is a very stripped down version of A BlackJack KOTH contest...
This is the goal:
Upon the execution: There are two inputs, "H" to hit (have the code deal a card), "S" to stand (Stop getting cards, and let dealer try to win).
Coding Rules:

There is no betting or splitting of hands, for simplicity of the challenge.
Suits are HDCS; standing for Hearts, Diamonds, Clubs and Spades respectively.
Trumps must be formatted as A23456789TJQK, where T is the 10; therefore TH is the 10 of Hearts, etc.
A is worth 1 or 11. Face cards are worth 10 points. A perfect game is 21 points.
If you go over 21 points, the output along with the cards must show "BUST".
If the dealer goes over 21 points and you're standing, output with cards must show "WIN"
If the dealer beats you even though you're standing, output with cards must show "LOSE"
If the dealer matches your score on standing, output with cards must show "PUSH"
Dealer must stand on 17 through to 21.
If you Stand, it calculates your score and displays it (see below), and then goes into dealer play mode. If the dealer stands or busts, it calculates its score and displays it.
Standard 52 cards in a deck, no duplicates can be generated.
Output must resemble the following:
H
Your hand: 3H
H
Your hand: 3H 8S
H
Your hand: 3H 8S 9D
S
Standing... Your hand: 3H 8S 9D = 20 points
My hand: 2C 5H 8H 9S = 24 points
WIN

Shortest code wins

Well, I was going to do this in PowerShell but I'm getting hung up on the damn aces. Handling one is probably simple enough, but more than that seems tricky (and not really golf-friendly).

The game play exemplified in your output is not really accurate for Blackjack. I don't mind that it requires an initial request to deal the hand, but the first deal should be two cards. Also, should the dealer still take their turn (normally doesn't) if the player hits 21 or Blackjack (A and T/J/K/Q on initial dealing)? Any special announcement required for 21 or Blackjack?

@Iszi I know, but like I said, it's very simplified.. I'm not asking for the Bellagio, I'm just asking for a simple game - nothing more ;)

Golf-Basic 84, 852 characters (ALL rules observed)
:"YOUR HAND:"_Str1:-1_X:0_O:0_A:0_P:2_H:3_2l`Ii`I@I=2o`H#o`Sl`H:Str1+" "_Str1:round(rand*13,0)_R@R=0:Str1+"A"_Str1@R=1:Str1+"2"_Str1@R=2:Str1+"3"_Str1@R=3:Str1+"4"_Str1@R4:Str1+"5"_Str1@R=5:Str1+"6"_Str1@R=6:Str1+"7"_Str1@R=7:Str1+"8"_Str1@R=8:Str1+"9"_Str1@R=9:Str1+"10"_Str1@R=10:Str1+"J"_Str1@R=11:Str1+"Q"_Str1@R=12:Str1+"K"_Str1@R=1:A+10_A@R<9:P+R+1_P#P+10_P:round(rand*4,0)_R@R=0:Str1+"H"_Str1@R=1:Str1+"D"_Str1@R=2:Str1+"C"_Str1@R=3:Str1+"S"_Str1d`Str1@P>20:o`So`Il`St`STANDING... "+Str1+", POINTS:"d`P@P=21 or P+A=21:"WIN"_Str2@P>21:"BUST"_Str2:round(rand*8,0)_R:"MY HAND: "_Str3l`X:X+1_X:round(rand*8,0)@R=0:Str3+"9H"_Str3@R=1:Str3+"9D"_Str3@R=2:Str3+"9C"_Str3@R=3:Str3+"9S"_Str3@R4:Str3+"JH"_Str3@R=5:Str3+"QD"_Str3@R=6:Str3+"KC"_Str3@R=7:Str3+"KS"_Str3@R<4:O+9_O#:O+10_O@Xo`E#o`Xl'Et`Str3+"= POINTS:"d`O@P=O:"PUSH"_Str2@P<O:"LOSE"_Str2d`Str2

Coded all by myself!
Explanation

Initialize variables; put 0 in P and "YOUR HAND:" in Str1
Take input, either H or S (no quotes needed)
Based on input, goto Lbl H or Lbl S
If input is H, generate a random card, add a space, a number/letter, and a suit to Str1
Based on the card generated, add the value of the card to P and additionally add 1 to A (ace count)
Get more input
If input is S, calculate the points and the dealer's points
Put WIN or BUST in Str2 depending on the points generated
Display the dealer's hand
Calculate your points and the dealer's points, conditionally put LOSE or PUSH in Str2
Display WIN, PUSH, LOSE, or BUST

Sample output
?H
YOUR HAND: 9C
?H
YOUR HAND: 9C 7S
?H
YOUR HAND: 9C 7S 4S
?S
STANDING... YOUR HAND: 3H 8S 9D, POINTS:
                                      20
MY HAND: 9H KS = POINTS:
                                      19
WIN

When did you create that language? - I should really ask "what is a language?" on [Meta]

@JohannesKuhn A couple weeks ago

Tim, great work, though I reckon you could whittle it down more with shorter variable names...? :)

@Eliseod'Annunzio Strings must have names of Str1, Str2, Str3, etc.

What's the point of a golfing language if variables can't be one character?

@Iszi Variables can be one letter unless they contain a string.

@Timtech, I'm actually impressed that you coded a golfing language on your own... Could we possibly get a link to where you'd have the language available so we could take a look?

@Eliseod'Annunzio Sure, give me some minutes to upload the compiler to my website.

@Eliseod'Annunzio Documentation + compiler - http://timtechsoftware.com/?page_id=1261

Javascript 838
The very first version, not optimized !
All rules are not fully observed, :-o
!function(){var f=require("readline").createInterface(process.stdin,process.stdout),g=[],h=function(){for(var b;!b||-1<g.indexOf(b);)b="A23456789TJQK".charAt(13*Math.random()|0)+"HDCS".charAt(4*Math.random()|0);g.push(b);return b},k=function(b){var a=0,d=0;for(z=b.length;z--;){var c=b[z].charAt(0);/[TJQK]/.test(c)?a+=10:/[2-9]/.test(c)?a+=+c:"A"==c&&(d++,a++)}for(;d--;)21>=a+10&&(a+=10);return a};(function(){var b=[],a=[],d=0,c=0;f.prompt();f.on("line",function(e){e=e.charAt(0);"H"==e&&(b.push(h()),
c=k(b),console.log("Your hand: "+b+" = "+c+" points"),21<c&&(console.log("LOSE"),process.exit(0)));if("S"==e){for(;17>(d=k(a));)a.push(h());console.log("My hand: "+a+" = "+d+" points");21<d||d<c?console.log("WIN"):d>c?console.log("LOSE"):console.log("DRAW");process.exit(0)}f.prompt()}).on("close",function(){process.exit(0)})})()}();

Execute it with nodeJS

"All rules are not fully observed" Lol, I did it right ;)

Lol, just missed rules 5 and 8. My code not display BUST or PUSH but the game is fully playable.

all_licenses: Creative Commons - Attribution Share-Alike - https://creativecommons.org/licenses/by-sa/3.0/


text:
Histogram generation
Write the shortest program that generates a histogram (a graphical representation of the distribution of data).
Rules:

Must generate a histogram based on the character length of the words (punctuation included)
input into the program. (If a word is 4 letters long, the bar representing the number 4 increases by 1)
Must display bar labels that correlate with the character length the bars represent.
All characters must be accepted.
If the bars must be scaled, there needs to be some way that is shown in the histogram.

Examples:
$ ./histogram This is a hole in one!
1 |#
2 |##
3 |
4 |###

$./histogram Extensive word length should not be very problematic.
1 |
2 |#
3 |#
4 |##
5 |
6 |##
7 |
8 |
9 |#
10|
11|
12|#

./histogram Very long strings of words should be just as easy to generate a histogram just as short strings of words are easy to generate a histogram for.
1 |##
2 |#######
3 |#
4 |#######
5 |###
6 |#
7 |##
8 |##
9 |##

Please write a specification rather than giving a single example which, solely by virtue of being a single example, cannot express the range of acceptable output styles, and which doesn't guarantee to cover all corner cases. It's good to have a few test cases, but it's even more important to have a good spec.

@PeterTaylor More examples given.

This is tagged [tag:graphical-output], which means that it's about drawing on the screen or creating an image file, but your examples are [tag:ascii-art]. Is either acceptable? (If not then plannabus might not be happy). 2. You define punctuation as forming countable characters in a word, but you don't state which characters separate words, which characters may and may not occur in the input, and how to handle characters which may occur but which are not alphabetic, punctuation, or word separators. 3. Is it acceptable, required, or prohibited to rescale the bars to fit in a sensible size?

@PeterTaylor I didn't tag it ascii-art, because it really isn't "art". Phannabus's solution is just fine.

@PeterTaylor I've added in some rules based on what you described.  So far, all the solutions here adhere to all of the rules still.

K, 35
{(1+!|/g)#`$(#:'=g:#:'" "\:x)#'"#"}

.
k){(1+!|/g)#`$(#:'=g:#:'" "\:x)#'"#"}"Very long strings of words should be just as easy to generate a histogram just as short strings of words are easy to generate a histogram for."
1| ##
2| #######
3| #
4| #######
5| ###
6| #
7| ##
8| ##
9| ##

.
A longer example
k){(1+!|/g)#`$(#:'=g:#:'" "\:x)#'"#"}"Please write a specification rather than giving a single example which, solely by virtue of being a single example, cannot express the range of acceptable output styles, and which doesnt guarantee to cover all corner cases. Its good to have a few test cases, but its even more important to have a good spec."
1 | #####
2 | ######
3 | #######
4 | ########
5 | ######
6 | ##############
7 | ###
8 | #
9 | ##
10| #
11|
12|
13| #

What happens if there are words with more than 9 letters?

It works for words of any length

R, 55 47 characters
hist(a<-sapply(scan(,""),nchar),br=.5+0:max(a))

Luckily R comes with a plot function hist for histograms, here supplied with a breaks argument where the breaks are 0.5, 1.5, ... until max(input)+0.5. sapply(scan(,""),nchar) takes an input (as stdin), separates it following the spaces and count the number of characters of each element.
Examples:
hist(a<-sapply(scan(,""),nchar),br=.5+0:max(a))
1: Extensive word length should not be very problematic.
9:
Read 8 items

hist(a<-sapply(scan(,""),nchar),br=.5+0:max(a))
1: Very long strings of words should be just as easy to generate a histogram just as short strings of words are easy to generate a histogram for.
28:
Read 27 items

Edit: A variation at 71 characters with an axis label at each possible value:
hist(a<-sapply(scan(,""),nchar),br=.5+0:max(a),ax=F);axis(1,at=1:max(a))

I love when a normally verbose language takes the lead!

This doesn't comply with the specification, however...

@Doorknob which specification doesn't it comply with?

The example testcases.

They are examples, not specifications...

Python - 83 characters
Seems that we can take input from anywhere, so this takes input during execution, rather than from the command line, and uses Ejrb's suggestion to shorten it by 8.
s=map(len,raw_input().split())
c=0;exec'c+=1;print"%3d|"%c+"#"*s.count(c);'*max(s)

Python - 91 characters
This will fall over with quotes.
import sys;s=map(len,sys.argv[1:])
for i in range(1,max(s)+1):print"%3d|"%i+'#'*s.count(i)

Input:
> python hist.py Please write a specification rather than giving a single example which, solely by virtue of being a single example, cannot express the range of acceptable output styles, and which doesnt guarantee to cover all corner cases. Its good to have a few test cases, but its even more important to have a good spec.

Output:
  1|#####
  2|######
  3|#####
  4|##########
  5|######
  6|#############
  7|####
  8|#
  9|##
 10|#
 11|
 12|
 13|#

nice, you can shave off 4 chars by reworking your second line (no algorithm change) to use exec and string concatenation: c=0;exec'c+=1;print"%3d|"%c+"#"*s.count(c);'*max(s)

Haskell - 126 characters
p[d]=[' ',d];p n=n
h l=[1..maximum l]>>= \i->p(show i)++'|':(l>>=($"#").drop.abs.(i-))++"\n"
main=interact$h.map length.words

This takes the input from stdin, not the command line:
& head -500 /usr/share/dict/words | runhaskell 15791-Histogram.hs
 1|##
 2|##
 3|######
 4|###############
 5|################################################
 6|###############################################################
 7|###################################################################
 8|###########################################################################
 9|#############################################################
10|##########################################################
11|#########################################################
12|#########################
13|#######
14|###
15|#####
16|###
17|#
18|
19|#
20|#

Looks good to me! +1

Perl, 56
$d[y///c].='#'for@ARGV;printf"%2d|$d[$_]
",$_ for+1..$#d

Added @manatwork's rewrite and literal newline suggestion, thank you very much! Added @chinese_perl_goth's updates.
Usage: save as hist.pl and run perl hist.pl This is a test
Example output:
$perl ~/hist.pl This is a test of the histogram function and how it will count the number of words of specific lengths. This sentence contains a long word 'complexity'.
 1|##
 2|#####
 3|####
 4|######
 5|##
 6|#
 7|
 8|#####
 9|#
10|
11|#

Why not use printf? You could spare some characters on formatting. And some more by changing from hash to array: $d[y///c]++for@ARGV;shift@d;printf"%2d|%s\n",++$i,"#"x$_ for@d.

Can I see an example of this program at work?

@manatwork printf didn't occur to me at all and for some reason I didn't think I could get the effect I wanted with an array, amazing!
@syb0rg adding now

golfed some more, got it down to 57 bytes:
$d[y///c].='#'for@ARGV;printf"%2d|$d[$_]\n",$_ for+1..$#d

@chineseperlgoth thank you! Updated the post! Not sure why building the string directly didn't occur to me!

We missed just the simplest trick: use a literal newline instead of \n to spare 1 more character. I mean like this: http://pastebin.com/496z2a0n

APL (42)
⎕ML←3⋄K,⊃⍴∘'▓'¨+⌿M∘.=K←⍳⌈/M←↑∘⍴¨I⊂⍨' '≠I←⍞

Could be shorter if I could omit lines where the value is 0.
Explanation:

⎕ML←3: set the migration level to 3 (this makes ⊂ (partition) more useful).
I⊂⍨' '≠I←⍞: read input, split on spaces
M←↑∘⍴¨: get the size of the first dimension of each item (word lengths), and store in M
K←⍳⌈/M: get the numbers from 1 to to the highest value in M, store in K
+⌿K∘.=M: for each value in M, see how many times it is contained in K.
⊃⍴∘'▓'¨: for each value in that, get a list of that many ▓s, and format it as a matrix.
K,: prepend each value in K to each row in the matrix, giving the labels.

Output:
      ⎕ML←3⋄K,⊃⍴∘'▓'¨+⌿M∘.=K←⍳⌈/M←↑∘⍴¨I⊂⍨' '≠I←⍞
This is a hole in one!
1 ▓
2 ▓▓
3
4 ▓▓▓
      ⎕ML←3⋄K,⊃⍴∘'▓'¨+⌿M∘.=K←⍳⌈/M←↑∘⍴¨I⊂⍨' '≠I←⍞
Very long strings of words should be just as easy to generate a histogram just as short strings of words are easy to generate a histogram for.
1 ▓▓
2 ▓▓▓▓▓▓▓
3 ▓
4 ▓▓▓▓▓▓▓
5 ▓▓▓
6 ▓
7 ▓▓
8 ▓▓
9 ▓▓

Python 3.3 (93)
a=[len(i) for i in input().split()]
for i in range(1,max(a)+1):
 print(i,'|',"#"*a.count(i))

Output:
(the first line is the input string)
Very long strings of words should be just as easy to generate a histogram just as short strings of words are easy to generate a histogram for.
1 | ##
2 | #######
3 | #
4 | #######
5 | ###
6 | #
7 | ##
8 | ##
9 | ##

It doesn't justify numbers as Lego Stormtroopr's Python solution (which is also shorter than mine), but it's my first entry ever in a golfing contest, so I might as well leave it here I guess :)

Could you edit in an example of a generated histogram by this program?

Yes, but I just noticed it has one problem: it doesn't justify the numbers as Lego Stormtroopr's solution, so I'm actually thinking about retiring the answer.

As long as there are labels for the represented bars, the answer is acceptable.

Ok, done then! :)

This takes input from input, not from arguments. Is this valid @syb0rg ?

@LegoStormtroopr Yes, as long as the histogram is accurate, any input is acceptable.

J, 48 47 46 45 43 characters
(;#&'#')/"1|:((],[:+/=/)1+[:i.>./)$;._1' ',

Usage:
   (;#&'#')/"1|:((],[:+/=/)1+[:i.>./)$;._1' ','Very long strings of words should be just as easy to generate a histogram just as short strings of words are easy to generate a histogram for.'
┌─┬───────┐
│1│##     │
├─┼───────┤
│2│#######│
├─┼───────┤
│3│#      │
├─┼───────┤
│4│#######│
├─┼───────┤
│5│###    │
├─┼───────┤
│6│#      │
├─┼───────┤
│7│##     │
├─┼───────┤
│8│##     │
├─┼───────┤
│9│##     │
└─┴───────┘

Tacit, 38 [:((](;#&'#')"0[:+/=/)1+[:i.>./)#@>@;: : Try it online!

Ruby, 98 85
a=$*.group_by &:size
1.upto(a.max[0]){|i|b=a.assoc i
puts"%-2i|#{b&&?#*b[1].size}"%i}

Not golfed much. Will golf more later.
c:\a\ruby>hist This is a test for the histogram thingy. yaaaaaaaaaaaay
1 |#
2 |#
3 |##
4 |##
5 |
6 |
7 |#
8 |
9 |#
10|
11|
12|
13|
14|#

Works nicely (++voteCount). Anything I could do to word the question better?

@syb0rg IMO the question is worded fine, the examples speak for themselves. Although your last once seems to have an error... I count 2 8-letter words (generate and generate) and 2 9-letter words (histogram, histogram)

Cool. You could change b ?(?#*b[1].size):'' with b&&?#*b[1].size.

Powershell, 97 93
$a=@{};$args-split ' '|%{$a[$_.length]++};1..($a.Keys|sort)[-1]|%{"{0,-2} |"-f $_+"#"*$a[$_]}

Example:
PS Z:\> .\hist.ps1 This is an example of this program running
1  |
2  |###
3  |
4  |##
5  |
6  |
7  |###

Can I see an example of this program running?

@syb0rg Sure, I've updated the answer with an example.

Looks good! +1 to you!

Nice. You could remove extra spaces and save 6 bytes $a=@{};-split$args|%{$a[$_.length]++};1..($a.Keys|sort)[-1]|%{"{0,-2}|"-f$_+"#"*$a[$_]}

Mathematica 97
Histogram["" <> # & /@ StringCases[StringSplit[InputString[]], WordCharacter] /.
a_String :> StringLength@a]

When I input text of the Declaration of Independence as a single string (through cut and paste, of course), the output generated was:

Ruby, 79
(1..(w=$*.group_by &:size).max[0]).map{|i|puts"%2i|#{?#*w.fetch(i,[]).size}"%i}

Example run:
$ ruby hist.rb Histograms, histograms, every where, nor any drop to drink.
 1|
 2|#
 3|##
 4|#
 5|#
 6|##
 7|
 8|
 9|
10|
11|##

Please see my Forth submission for a laugh.

Forth, 201
This was fun but my Ruby submission is more competitive.  ;-)
variable w 99 cells allot w 99 cells erase : h begin
1 w next-arg ?dup while swap drop dup w @ > if dup w
! then cells + +! repeat w @ 1+ 1 ?do i . 124 emit i
cells w + @ 0 ?do 35 emit loop cr loop ; h

Sample run:
$ gforth histo.fth Forth words make for tough golfing!
1 |
2 |
3 |#
4 |#
5 |###
6 |
7 |
8 |#

Max word length is 99.

Ruby 1.8.7,  74
A slightly different take than the other ruby solutions:
i=0;$*.map{|v|v.size}.sort.map{|v|$><<(i+1..v).map{|n|"
%2i:"%i=n}+['#']}

output:
ruby hist.rb `head -400 /usr/share/dict/words`

 1:#
 2:###
 3:######
 4:#############################
 5:#####################################################
 6:############################################################
 7:########################################################################
 8:######################################################
 9:############################################################
10:########################
11:###########################
12:######
13:#####

I didn't see this submission initially, sorry! +1

JavaScript (159 133)
Definitely not competitive, but so far the only JavaScript solution. Thanks to @manatwork for the tip on using String.replace.
prompt(o=[]).replace(/\S+/g,function(p){o[l=p.length]=(o[l]||'')+'#'});for(i=1;i<o.length;)console.log(i+(i>9?"|":" |")+(o[i++]||""))

Input

Code Golf is a question and answer site for programming puzzle enthusiasts and code golfers. It's built and run by you as part of the Stack Exchange network of Q&A sites. With your help, we're working together to build a library of programming puzzles and their solutions.

Output
1 |##
2 |#######
3 |#########
4 |########
5 |######
6 |###
7 |####
8 |####
9 |
10|#
11|###

Indeed, this is not really a field where JavaScript excels. But with replace() instead of split()+for and Array instead of Object+separate length variable can be reduced with a few characters: prompt(o=[]).replace(/\S+/g,function(p){o[l=p.length]=(o[l]||"")+"#"});for(i=1;i<o.length;)console.log(i+(i>9?"|":" |")+(o[i++]||"")). (And even shorter in Harmony: prompt(o=[]).replace(/\S+/g,p=>o[l=p.length]=(o[l]||"")+"#");for(i=1;i<o.length;)console.log(i+(i>9?"|":" |")+(o[i++]||"")).)

@manatwork Nice abuse of .length there.

Pure bash, 120 107 bytes
d=$*;d=${d//[ -z]/#};for a;do((b[${#a}]++));done;e=${!b[*]};for((i=0;i++<${e##* };)){ echo $i ${d:0:b[i]};}

or
d=$*
d=${d//[ -z]/#}
for a;do((b[${#a}]++));done
e=${!b[*]}
for((i=0;i++<${e##* };)){
echo $i ${d:0:b[i]}
}

or
d=$*;d=${d//[ -z]/#};for a;do((b[${#a}]++));done;e=${!b[*]}
for((i=0;i++<${e##* };)){ echo $i ${d:0:b[i]};}

Sample:
./histogram.sh Very long strings of words should be just as easy to generate a histogram just as short strings of words are easy to generate a histogram for.
1 ##
2 #######
3 #
4 #######
5 ###
6 #
7 ##
8 ##
9 ##

PHP, 162
<?php error_reporting(0);$b=0;while($argv[$b])$c[strlen($argv[++$b])]++;for($t=1;$t<=max(array_keys($c));$t++)echo $t.'|'.($c[$t]?str_repeat('#',$c[$t]):'')."\n";

Usage:
php histogram.php Very long strings of words should be just as easy to generate a histogram just as short strings of words are easy to generate a histogram for.
1|##
2|#######
3|#
4|#######
5|###
6|#
7|##
8|##
9|##

8th, 162 bytes
Code
a:new ( args s:len nip tuck a:@ ( 0 ) execnull rot swap n:1+ a:! ) 0 argc n:1- loop
a:len n:1- ( dup . "|" . a:@ ( 0 ) execnull "#" swap s:* . cr ) 1 rot loop bye

Usage
$ 8th histogram.8th Nel mezzo del cammin di nostra vita mi ritrovai per una selva oscura

Output
1|
2|##
3|####
4|#
5|##
6|###
7|
8|#

Ungolfed code (SED is Stack Effect Diagram)
a:new               \ create an empty array
(
    args s:len      \ length of each argument
                    \ SED: array argument lengthOfArgument
    nip             \ SED: array lengthOfArgument
    tuck            \ SED: lengthOfArgument array lengthOfArgument
    a:@             \ get item array at "lengthOfArgument" position
    ( 0 ) execnull  \ if null put 0 on TOS
                    \ SED: lengthOfArgument array itemOfArray
    rot             \ SED: array itemOfArray lengthOfArgument
    swap            \ SED: array lengthOfArgument itemOfArray
    n:1+            \ increment counter for the matching length
    a:!             \ store updated counter into array
) 0 argc n:1- loop  \ loop through each argument
\ print histogram
a:len n:1- ( dup . "|" . a:@ ( 0 ) execnull "#" swap s:* . cr ) 1 rot loop
bye                 \ exit program

Husk, 28 bytes
Ṡz+öTT' msŀSomȯ:'|R'##oḣ▲mLw

Try it online!
Husk is an ASCII art language.

APL (Dyalog Unicode), 31 bytes (SBCS)
Anonymous tacit prefix function.
(I,'#'⍴⍤0⍨1⊥⊢∘.=I←⍳⌈/)'\S+'⎕S 1

Try it online!
'\S+'⎕S 1 Search for runs of non-Space characters, returning the length of each
(…) apply the following tacit function to that list of lengths:
 ⌈/ the largest number (lit. maximum reduction)
 ⍳ the indices 1…that
 I← let I denote that function
 ⊢∘.= equality table of word lengths vertically and possible word lengths horizontally
 1⊥ sum the columns (lit. evaluate in base 1, with each row representing a digit)
 '#'⍴⍤0⍨ use each element to reshape the hash character, then stack the results and pad
 I, prepend the result of I (i.e. all the possible lengths) as an additional column on the left

all_licenses: Creative Commons - Attribution Share-Alike - https://creativecommons.org/licenses/by-sa/4.0/


text:
Generate the fewest lottery tickets to play in order to have at least N good numbers
This is a rather complex but very interesting maths subject (known as "covering problem"),
And I'd like your help for implementing it.
Imagine a lottery game, where each ticket must choose 5 random numbers in a set of 50 numbers (from 1 to 50).
It's quite easy to know the probability of a winning ticket, or the probability to have 1, 2, 3 or 4 good numbers.
It's also quite easy to "generate" all the tickets that have 1, 2, 3, 4 good numbers.
My question (and code challenge) is related to this, but slightly different:
I want to buy some lottery tickets (the fewest possible), such as at least one of my tickets has 3 good numbers.
Challenge
Your goal is to implement a generic solution (as a program or just a function), like this, in any language:
// Input: 3 prameters
min_lottery_tickets(total_numbers_to_choose_from, how_many_numbers_to_choose, how_many_good_numbers_i_want)

For the above example, one would just have to call:
min_lottery_tickets(50, 5, 3)

and the program will generate the smallest set of tickets to play to achieve this goal.

Example:
 min_lottery_tickets(10, 5, 2)

would output 7 tickets, like those:
1   2   3   4   5
5   6   7   8   9
10  1   2   6   7
10  3   4   8   9
3   4   6   7   8
1   2   3   8   9
1   4   9   5   10

because such tickets are enough to cover any pair of numbers from 1 to 10.

Output
Text, one line per ticket, tabulations or spaces between numbers

who wins
The most efficient program wins (i.e. the program generating the fewest tickets for the above parameters):
min_lottery_tickets(50, 5, 3)

Thanks!

Related.

This question needs various clarifications. Are you after a program, a function, or either? Does the output format matter? Do the numbers have to be indexed from 1, or could they be indexed from 0? And what's the objective winning condition?

Okay, so generating all tickets and printing it is the trivial case? Would this be considered an actual(albeit bad) answer?

Well, you can do it, but it'd obviously be the worst possible answer. My goal is to apply this algorithm in real life, and buy the least tickets possible :)

@xem this almost belongs on Math SE then. Where they will probably prove to you that the numbers aren't in your favour(though there does exist some jackpot number s.t it's worth buying tickets)

What is a good number?

... a winning number. A number that gets picked.

I'm pretty sure that it's provable that you will lose a lot of money if you actually go buy the tickets output by such a program.

I'm with @DavidCarraher - I'm still not seeing what is a good number?  "A number that gets picked" doesn't seem to make sense, because you are after a prediction of the result and yet your definition of "good" cannot be determined until after the draw.  Perhaps you mean "good" as in, "a number that has been drawn the most times, based on this table of the last x draws", in which case your problem is trivial (e.g. akin to SELECT TOP 5 num FROM draw_history GROUP BY num ORDER BY COUNT(1) DESC).

Sorry if I wasn't clear enough: the "government" picks 5 numbers out of 50. Those are the good numbers. The citizens play lottery, and on each lottery ticket, they chose 5 numbers, hoping that most of them are "good". So in this exercise, we try to play as few tickets as possible to be sure that at least one has 3 good numbers.

I know it's not optimal, but here is the code in node.js:
function min_lottery_tickets(total_numbers_to_choose_from, how_many_numbers_to_choose, how_many_good_numbers_i_want) {
    c(function(result) {
        var other = result[result.length - 1];
        while (result.length < how_many_numbers_to_choose) {
            other++;
            var already = false;
            for (var i = 0; i < result.length; i++) {
                if (other === result[i]) {
                    already = true;
                    break;
                }
            }
            if (!already) {
                result.push(other);
            }
        }
        if (other <= total_numbers_to_choose_from) {
            // Print results
            console.log(result);
        }
    }, total_numbers_to_choose_from, how_many_good_numbers_i_want);
}

function c(next, total_numbers, length, start, results) {
    if (!start) start = 1;
    if (!results) results = [];

    for (var i = start; i <= total_numbers + 1 - length; i++) {
        var resultsNew = results.slice(0);
        resultsNew.push(i);
        if (length > 1) {
            c(next, total_numbers, length - 1, i + 1, resultsNew);
        } else {
            next(resultsNew);
        }
    }
}

Some example results:
> min_lottery_tickets(5, 3, 2)
[ 1, 2, 3 ]
[ 1, 3, 4 ]
[ 1, 4, 5 ]
[ 2, 3, 4 ]
[ 2, 4, 5 ]
[ 3, 4, 5 ]

other:
> min_lottery_tickets(10, 5, 2)
[ 1, 2, 3, 4, 5 ]
[ 1, 3, 4, 5, 6 ]
[ 1, 4, 5, 6, 7 ]
[ 1, 5, 6, 7, 8 ]
[ 1, 6, 7, 8, 9 ]
[ 1, 7, 8, 9, 10 ]
[ 2, 3, 4, 5, 6 ]
[ 2, 4, 5, 6, 7 ]
[ 2, 5, 6, 7, 8 ]
[ 2, 6, 7, 8, 9 ]
[ 2, 7, 8, 9, 10 ]
[ 3, 4, 5, 6, 7 ]
[ 3, 5, 6, 7, 8 ]
[ 3, 6, 7, 8, 9 ]
[ 3, 7, 8, 9, 10 ]
[ 4, 5, 6, 7, 8 ]
[ 4, 6, 7, 8, 9 ]
[ 4, 7, 8, 9, 10 ]
[ 5, 6, 7, 8, 9 ]
[ 5, 7, 8, 9, 10 ]
[ 6, 7, 8, 9, 10 ]

other:
> min_lottery_tickets(10, 5, 3)
[ 1, 2, 3, 4, 5 ]
[ 1, 2, 4, 5, 6 ]
[ 1, 2, 5, 6, 7 ]
[ 1, 2, 6, 7, 8 ]
[ 1, 2, 7, 8, 9 ]
[ 1, 2, 8, 9, 10 ]
[ 1, 3, 4, 5, 6 ]
[ 1, 3, 5, 6, 7 ]
[ 1, 3, 6, 7, 8 ]
[ 1, 3, 7, 8, 9 ]
[ 1, 3, 8, 9, 10 ]
[ 1, 4, 5, 6, 7 ]
[ 1, 4, 6, 7, 8 ]
[ 1, 4, 7, 8, 9 ]
[ 1, 4, 8, 9, 10 ]
[ 1, 5, 6, 7, 8 ]
[ 1, 5, 7, 8, 9 ]
[ 1, 5, 8, 9, 10 ]
[ 1, 6, 7, 8, 9 ]
[ 1, 6, 8, 9, 10 ]
[ 1, 7, 8, 9, 10 ]
[ 2, 3, 4, 5, 6 ]
[ 2, 3, 5, 6, 7 ]
[ 2, 3, 6, 7, 8 ]
[ 2, 3, 7, 8, 9 ]
[ 2, 3, 8, 9, 10 ]
[ 2, 4, 5, 6, 7 ]
[ 2, 4, 6, 7, 8 ]
[ 2, 4, 7, 8, 9 ]
[ 2, 4, 8, 9, 10 ]
[ 2, 5, 6, 7, 8 ]
[ 2, 5, 7, 8, 9 ]
[ 2, 5, 8, 9, 10 ]
[ 2, 6, 7, 8, 9 ]
[ 2, 6, 8, 9, 10 ]
[ 2, 7, 8, 9, 10 ]
[ 3, 4, 5, 6, 7 ]
[ 3, 4, 6, 7, 8 ]
[ 3, 4, 7, 8, 9 ]
[ 3, 4, 8, 9, 10 ]
[ 3, 5, 6, 7, 8 ]
[ 3, 5, 7, 8, 9 ]
[ 3, 5, 8, 9, 10 ]
[ 3, 6, 7, 8, 9 ]
[ 3, 6, 8, 9, 10 ]
[ 3, 7, 8, 9, 10 ]
[ 4, 5, 6, 7, 8 ]
[ 4, 5, 7, 8, 9 ]
[ 4, 5, 8, 9, 10 ]
[ 4, 6, 7, 8, 9 ]
[ 4, 6, 8, 9, 10 ]
[ 4, 7, 8, 9, 10 ]
[ 5, 6, 7, 8, 9 ]
[ 5, 6, 8, 9, 10 ]
[ 5, 7, 8, 9, 10 ]
[ 6, 7, 8, 9, 10 ]

Your min_lottery_tickets(10, 5, 2) generates much more solutions than OP's.

I know @Groo, I said I knew it was not optimal, but this was the first working version I had ;) Any suggestion on how to remove "redundant" results?

Hi Groo, Hi greuze, thanks a lot for this first attempt. You have a score of 21 (because you generated 21 tickets for (10,5,2)). I don't know how to remove the redundant results however, that's why I created this topic. I'm still wondering what the best algorithm to do this job looks like.

Here are some good readings on the subject: (1) http://dip.sun.ac.za/~vuuren/papers/lotery_artikel1oud.pdf,
(2) http://goo.gl/Ex7Woa,
(3) https://www.google.fr/url?sa=t&rct=j&q=&esrc=s&source=web&cd=6&ved=0CHIQFjAF&url=http%3A%2F%2Fwww.cs.umanitoba.ca%2F~vanrees%2Flottotalk.doc&ei=_jDMUsSRPOOb0QW69ICADQ&usg=AFQjCNEv3NTcV3I1LBGdVu_j-6-otm95Og&bvm=bv.58187178,d.d2k&cad=rja

@xem, my math knowledge is limited, so I'm afraid I don't know so much combinatory to make a better algorithm than this. Maybe you can ask in math.stackexchange.com about the optimization algorithm.

It's a NP-complete problem, so I'm afraid there's no magic solution. We have to "brute force" the computation of all possible tickets and the elimination of those who are redundant by comparing each of its group of numbers to all the other tickets. That would take an exponential time.


text:
Compressing a DNA-like string
Challenge:
Write a a program to take an array of 24 4-letter strings, and output a compressed (lossless) representation of the array. You should also provide a program to decompress your representations.
Input:
The input will be comprised of 4 letter words using each of [G,T,A,C] exactly once (e.g. GTAC, ATGC, CATG, etc). There are always exactly 24 words, so the full input is something like:
GTAC CATG TACG GACT GTAC CATG TACG GACT GTAC CATG TACG GACT GTAC CATG TACG GACT GTAC CATG TACG GACT GTAC CATG TACG GACT

So there are \$4!=24\$ possibilities for each word, and 24 words in total.
Output:
The output should be a printable ASCII string that can be decompressed back into the input string. Since this is lossless compression, each output should match to exactly one input.
Example:
>>> compress(["GTAC", "CATG", "TACG", "GACT", "GTAC", "CATG", "TACG", "GACT", "GTAC", "CATG", "TACG", "GACT", "GTAC", "CATG", "TACG", "GACT", "GTAC", "CATG", "TACG", "GACT", "GTAC", "CATG", "TACG", "GACT"])
"3Ax/8TC+drkuB"

Winning Criterion
Your code should minimize the output length. The program with the shortest output wins. If it's not consistent, the longest possible output will be the score.
Edit: Based on helpful feedback comments, I would like to amend the criterion to add:
If two entries have the same results, the shortest code measured in characters wins.  If an entry is length dependent, a length of 1 million words is the standard.
However, I fear the community angrily telling me I didn't say it right and downvoting me to the abyss, so I leave to community editors to see if it makes sense with code golf traditions

I tried to reword this and clean it up a bit. I did change one thing: now, the output is scored by the maximum length instead of the average, for ease of scoring. I hope this is okay with you. If you want to do average, you should pick a specific set of inputs to test it on.

You also changed the output from alphanumeric to the entirety of printable ASCII, but the one existing answer didn't comply with that to begin with.

Despite the edits for clarity, this remains a challenge that seems pretty boring. An optimal solution is to map the n'th possible input onto the n'th ASCII string sorted lexicographically, so anyone can win by coding that or anything achieving the same maximum length. In fact, the existing solution does exactly this, using alphanumeric strings as the old rule required which could be easily adjusted to all printable ASCII. I think a better direction would be to make the challenge code golf and require the optimal output length.

@xnor a good comment.  If optimal solutions are known, then code golf should be the standard.

Python (output-length: 18 or 19, mean 18.80)
#list of the 24 possible words
Lbase = ['GTAC','GTCA','GATC','GACT','GCTA','GCAT','TGAC',\
'TGCA','TAGC','TACG','TCGA','TCAG','AGTC','AGCT','ATGC',\
'ATCG','ACGT','ACTG','CGTA','CGAT','CTGA','CTAG','CAGT','CATG']

#base-64 alphabet (used only in the output string-representation)
alph = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+/'

#change a bijective list-representation base from b to newb
def chg_bij_base(L, b, newb):
    n = sum([L[i]*b**i for i in range(len(L))])
    L = []
    while n > 0:
        L.append(1+(n-1)%newb)
        n = (n-1)//newb
    return L

#convert a bijective list-repr. to base-64 string-repr.
def list_to_str(Lin):
    L24 = [Lbase.index(w)+1 for w in Lin]
    L64 = chg_bij_base(L24,24,64)
    return ''.join([alph[i-1] for i in L64])

#convert a base-64 string to the corresponding base-64 list-repr.
def str_to_list(s):
    L64 = [alph.index(c)+1 for c in s]
    L24 = chg_bij_base(L64,64,24)
    return [Lbase[i-1] for i in L24]

Test run:
Lin = ["GTAC", "CATG", "TACG", "GACT", "GTAC", "CATG", "TACG", "GACT", "GTAC", "CATG", "TACG", "GACT", "GTAC", "CATG", "TACG", "GACT", "GTAC", "CATG", "TACG", "GACT", "GTAC", "CATG", "TACG", "GACT"]

#convert input list to a base-64 string
lts = list_to_str(Lin)

#convert the base-64 str back to the list
stl = str_to_list(lts)

print(len(lts))
print(lts)
print(stl == Lin)

Test output:
18
acFZIBuiiZJ+dwUn2V
True

This uses bijective numeration (which has no 0 digit) to get invertibility.
NB: When using base-64 with this method, all output strings for the above problem are either 18 or 19 characters. (A million random inputs gave an average of 18.80.) The same method works with other bases:
base         output-length
---------    -------------
56 - 58      19
59 - 69      18 or 19
70 - 73      18
74 - 88      17 or 18
89 - 96      17
...          ...
233 - 256    14

Well done.  That's exactly the kind of thing I expected. What if I added more characters to the list, like !.<>[]{} , then change the references from 64 to 72?   will the algorithm work the same way?  (I just wanted to know that before I port it to php and js).

There's a guy over on SO who says it's impossible to code 24^24 inputs into 18 characters using a 64-character set. Does this algorithm give considerably longer strings when the inputs are more random? The SO question is here: http://stackoverflow.com/questions/20527243/simple-compact-code-for-compressing-dna-like-strings/20534427

@AwokeKnowing - When using a 64-character alphabet with this method, all output strings for the above problem are either 18 or 19 characters. A million random inputs gave an average of 18.80. The same method works with larger alphabets; e.g., with size 90, a million random inputs all had output strings of length 17. I don't know how well the algorithm might port to JS or PHP.

@res Well thanks. looks like people who didn't have an answer decided to blame the question :) oh well. I've accepted your answer, great job.

license: Creative Commons - Attribution Share-Alike - https://creativecommons.org/licenses/by-sa/4.0/


text:
Calculate the bitruncated cubic distance between two points
The truncated octahedron is a shape that has the interesting property that it can tessellate an entire 3D space so that any two solids that meet by an edge or corner also meet by a face, in a configuration called the bitruncated cubic honeycomb.
This gives it the special property that there is only one metric for adjacency distance [unlike a cubic grid where two cubes touching by only a corner have a face distance of 3], a property which is shared by a hexagonal grid in two dimensions.
Any solid in the bitruncated cubic honeycomb can be represented by the 3D coordinates (a+h, b+h, c+h) where a, b, c are integers and h is either 0 or 1/2. Any solid at (x, y, z) is adjacent to the solids at the following locations:
x, y, z+1
x, y, z-1
x, y+1, z
x, y-1, z
x+1, y, z
x-1, y, z
x+1/2, y+1/2, z+1/2
x+1/2, y+1/2, z-1/2
x+1/2, y-1/2, z+1/2
x+1/2, y-1/2, z-1/2
x-1/2, y+1/2, z+1/2
x-1/2, y+1/2, z-1/2
x-1/2, y-1/2, z+1/2
x-1/2, y-1/2, z-1/2

Your task is to build a program that, given the locations of two truncated octahedrons in the above arrangement, finds their distance. You can take input in any format you wish.
The shortest code to do this in any language wins.

Hmm... it seems  to me the unit sphere for this metric is the rhombic dodecahedron, is it so?

I think it's actually the tetrakis cube.

Why did you accept an answer so quickly? Shouldn't you wait for a short time before doing so?

I will switch the accepted answer if a better solution comes along. However, you're right that I did it a little too quickly - my policy is usually to wait until there at least two answers.

Golfscript, 10 13 characters
~{$~\-}%$~+\;

input: a space-separated array of three two-element arrays of integers, wrapped in square brackets. Each pair of integers denotes the coordinates of both octahedra in one axis. If half-coordinate inputs are to be supported, the input should be scaled up by an even factor (say, 10).
output: a single integer, scaled up by the same amount as the input
reads: "eval the input, for each axis: {sort both coordinates, then subtract the smaller from the larger}, sort the differences, then dump them onto the stack (resulting in three separate numbers), add the top two (= largest two coordinates) and discard the element just below".
proof:
the algorithm to reach a destination in this amount of steps is:

If all three coordinate differences are nonzero, make a diagonal step. This reduces all three differences by 0.5, meaning their order doesn't change and the sum of the largest two differences reduces by 1
If only one coordinate difference is nonzero, make an orthogonal step. This reduces the largest difference by 1
If two of the difference are nonzero, either of these steps can be chosen.

Thus, this algorithm never underestimates the distance. Also, it is not possible to reduce the sum of top largest two differences by more than 1 in a single step, meaning this algorithm never overestimates either. Thus, the algorithm "sum of the largest two absolute values of coordinate differences" is correct.
example:
;"[[20 0] [30 0] [20 -20]]"
~{$~\-}%$~+\;
#70

test: http://golfscript.apphb.com/?c=OyJbWzIwIDBdIFszMCAwXSBbMjAgLTIwXV0iCn57JH5cLX0lJH4rXDs%3D

Yeah, negative coordinates have to be supported as the honeycomb extends infinitely in all directions.

Even so, 10 characters is amazingly short.

Maybe I am blind, but where is the second octahedron?

I was wondering that too. Maybe Jan's code sort of automatically assumes that the second one is located at the origin. (Which shouldn't happen.)

@JoeZ. oh. I was computing the distance from the origin. Sorry for that. Will fix.

@JoeZ. Fixed. Is my new input format acceptable?

Yes, that's fine.

(otherwise, I would have to add three more characters to zip the input after evaling it)

@howard fixed, sorry

APL, 14 13
x+.×1<⍋x←|⎕-⎕

1 char saving if I'm allowed to change system variables in configurations
Prompts for input twice, enter space-separated coords both times.
Thanks to Jan