text:
How to randomize letters in a word
According to some controversial story, the odrer of ltteres in a wrod deos not mttaer much for raednig, as lnog as the frist and lsat lteter macth with the orignial wrod.
So, for fun, what would be the shortest function to randomize letter order in a word while keeping the first and the last letter in place?
Here's my stab at it with JavaScript. All whitespace removed it's at 124 130 characters.
function r(w) {
  var l=w.length-1;
  return l<3?w:w[0]+w.slice(1,l).split("").sort(function(){return Math.random()-.5}).join("")+w[l];
}

Shorter JavaScript always welcome.

Edit: length check added. Function should not fail for short words.

Haskell, 4 characters: r=id.

@trinithis Huh?

The randomizing function always returns the same (AHEM) random outcome. (id x = x is a built in function. For Haskellers out there, I still think id should be able to be written point-free style: id=)

@trinithis I'm afraid I know nothing about Haskell. ;) Does that keep the first and last letters in place?

Yes. It returns the exact same thing as the input. On another note, what do we do about punctuation? Do we only operate on words consisting only of letters?

@trinithis Yeah I assumed the function would only be fed with valid input, i.e. one word. ;)

@trinithis not sure what you talking about, but id is the identity function.  I would still like to see Haskell solution to this problem in less than 100 characters.

To clarify the spec: is it required that the function takes an argument and returns the result or are other solutions acceptable? For instance, in C++ it’s much shorter not to bother with arguments and return type and just mutate some global state.

Should the specification be updated to require a uniform distribution of outcomes? This would disallow the 4 character Haskell solution. It would also disallow your example Javascript solution (shuffling by doing a sort like that is not uniform).

I would like to clarify that by uniform, we should treat the problem as if each character was unique. That is, duplicate letters will 'apparently' skew the distribution, but in actuality, it doesn't, because we are really working on the problem of permuting [1, 2, ..., n] while keeping 1 and n in the same spot.

+1 for the first sentence: it actually took me a few seconds to realize it was spelled wrong XP

Can we assume that the word is not empty?

Throughout the other answers valid results for edge cases ("short input") were required. The empty string qualifies as an edge case, so I'd say no.

Is there any reason this isn't just as simple as using a built in shuffle function?

@ThomasEding shuffling arbitrarily long strings uniformly would require that the random number generator has arbitrarily many bits in its state, so id is a good compromise.

Funny, I actually read the Russian version of the story and I only noticed when the story actually told me

This matters for Swift (see my rambling here), so I have to ask: What counts as a "character"? Can we assume that the input is always pure ASCII?

It took me a couple of minutes to read the first sentence. It's very confusion 'cause I took some words for some others.

Haskell, 110 120 107 characters
import Random
s l=randomRIO(1,length l-2)>>=g.($l).splitAt
g(a:b,c:d)=fmap(a:).s$c:b++d
g(a,b)=return$a++b

An example of a program using this function:
main = getLine >>= s >>= putStrLn

fmap((a:t!!i:).tail)

@FUZxxl, no, sorry, I made the same mistake initially. Operator section does not work here because : is right-associative. I'd have to do (a:).(t!!i:).

~3.5 more years of experience, and another 13 characters saved!

J, 26 24 23 characters
r=:{.,({~?~@#)&}.&}:,{:

According to common code golf rules, you don't have to bind the phrase to a name.

#?# is one char shorter than?~@#

Ruby, 44 characters
r=->w{w[h=1..-2]=[*w[h].chars].shuffle*"";w}

Works also for short words, i.e. words with one, two or three characters are returned unaltered.
Edit: Using the array-splat idea of Ventero saves another char.

That's actually 44 characters. I eventually came up with the exact same answer by fine tuning my own - now I feel like a copy-cat after reading yours.

@user2316 Of course you are right. Thank you.

Ruby 1.9, 46 characters
r=->w{w[0]+[*w[1..-2].chars].shuffle*""+w[-1]}

+1 This use of array-splat saved me also one char. Great idea.

I don't know ruby - it fails on my ruby1.8, so I guess I need a never version? Does it work with input like 'I'?

@user: It says "Ruby 1.9" right there. ;) -- Ventero - One of the sensible requirements I forgot to mention is that it should not fail for word lengths 0 and 1. Sorry.

C++, 79 characters (with range check)
string f(string s){if(s.size()>3)random_shuffle(&s[1],&s.end()[-1]);return s;}

C++, 81 65 characters (without range check)
string f(string s){random_shuffle(&s[1],&s.end()[-1]);return s;}

Using pass by reference instead of returning the result shaves off another 10 characters from either solution.
Full program, reading a string of words and shuffling converting them:
#include <iostream>
#include <algorithm>
#include <cstdio>
#include <ctime>
#include <string>

using namespace std;
string f(string s){if(s.size()>3)random_shuffle(&s[1],&s.end()[-1]);return s;}

int main() {
    std::srand(std::time(0));
    std::string s;
    while(std::cin >> s)
        std::cout << f(s) << " ";
    std::cout << std::endl;
}

Morale: don’t build what’s already there. Oh, and overflow checks are for wusses.

Nice, std::random_shuffle, that's a new one to me.  btw I think you forgot #include<string> in your full code.

Something like that is what I had in mind originally. Unfortunately there is no built-in for shuffling a string in-place in JS.

Fails for very short strings.

That's true, you're missing a length check (I did, as well). BTW @Arlen's answer is also worth a look.

@userunknown That’s what I meant by “overflow checks are for wusses”. But to be fair, so do almost all other solutions.

At least 1/6 had it right from the start. Lame excuses are for wusses, imho. :)

@user 1/6 isn’t terribly much, and I complied with the OP’s specs. But I’ll change it.

Things I've learned: I'll be more careful with the specs next time. That, and there are quite a lot of languages I don't understand the least bit about.

-14 bytes for non-range-check version if you use C strings and in-place shuffle: void f(char*s){random_shuffle(s+1,s+strlen(s)-1);}. Another -1 for technically-undefined int instead of void return type (with missing return statement). Might work even without range checks (despite technical UB with <start_of_mem_region>-1) --- I don't know the behavior of random_shuffle if last < first, and it depends on that in that case.

Python, 87 79 75 93 92 chars
from random import*
f=lambda w:w if 4>len(w)else w[0]+''.join(sample(w[1:-1],len(w)-2))+w[-1]

EDIT: Originally thought it was supposed to split string words (which it did at 128 chars; now at 87 chars does requirement).   Argh, my bad at reading comprehension.
EDIT 2: Change from def to lambda function from def to save 6 chars.  Assuming sample is already imported to the namespace (from random import sample) could bring this down to ~60).
EDIT 3: "len(w[1:-1])" (12 chars) to "len(w)-2" (8 chars) per gnibbler's nice suggestion.
EDIT 4: JBernando saved one char (had considered from random import * and saw it was equivalent -- not realizing the space in import * is unnecessary).; user unknown added 19 chars w if len(w)<4 else to handle 0 and 1 char strings correctly.
EDIT 5: Saved another char per boothby's code golf trick.  if len(w)<4 else to if 4>len(w)else.

However, the question only defined the input as a word, not a string of words. :)

@sidran32: Thanks, my bad.  I had just noticed (upon rereading) and then saw your comment; deleted -- edited -- and undeleted.

Idea - you can trim 3 chars by doing this....
def f(w):j=w[1:-1]; return w[0]+''.join(r.sample(j,len(j)))+w[-1]

@rmckenzie: Good idea.  However, right before I saw your comment right after I trimmed it to lambda function (saving 6 chars), so I can no longer do your method of defining intermediate vars.

len(w)-2 instead of len(w[1:-1])?

@gnibbler - thanks.  Saved 4 chars.  Now its 75 characters (or 51 if sample has already been imported and we don't assign the lambda function to anything) lambda w:w[0]+''.join(sample(w[1:-1],len(w)-2))+w[-1]

from random import*

Fails on words like 'I'.

@user unknown - Not too difficult to handle short strings correctly (if input less than 4 characters just return the original string).  Adds 19 chars -- change the second line to f=lambda w:w if len(w)<4 else w[0]+''.join(r.sample(w[1:-1],len(w)-2)+w[-1] will handle that case.  However, it wasn't clear from the description if short strings should be handled correctly -- the example code clearly does not handle zero/one character strings correctly (in the example code - r('') gives 'undefinedundefined' and r('I') gives 'II').

Since tomalak seemed to use his function for the question (in a wrod), I thought his example is all right. He must have stumbled over this problem, or he feed his words by hand to the function, only choosing words of size 4 or more. However - to me it seems clear, that such a function would be used to work on sentences or wordlists, and should be a little robust.

@user: Actually, I scrambled the words manually. Unbelievable, but true. ;) Anyway, since defining what "a word" is and how to handle sentences would have been too much noise, I assumed that proper tokenization would take place elsewhere. Your hint that word length should be 4 or more characters is noted. I'll change my own implementation.

Save another character with if 4>len(w)else.

Isn't this 94 characters?

@Mechanical snail; I made a mistake -- but I think its 92 now.  My mistake was len('from random import*')+len('f=lambda w:w if 4>len(w)else w[0]+''.join(sample(w[1:-1],len(w)-2))+w[-1]') which I now realize undercounted by 2 (as it took at as two string concatenated together as I used single quotes twice in the second len).  I noticed that after removing one letter it shot down by 3; and figured I had counted incorrectly earlier see edit history.  Are new lines generally counted as a character in golf?  If yes, that would make it 93 now (94 if new line is counted as 2 chars like '\n').

Necessary whitespace generally should be one char each, not counting EOF.

Lose another two characters with l=len; then 4>l(w) and l(w)-2.

@r.e.s.  - Don't think that works.  l=len; adds 6 chars, and then using l for len twice saves 2 chars twice; meaning its 6-2-2=2 characters longer.

Arggg ... that'll teach me to post before having morning coffee.

Instead of checking length with if 4>len(w)else you can save some characters by taking advantage of degenerate slice indeces graceful handling: f=lambda w:w[0:1]+''.join(sample(w[1:-1],len(w[1:-1])))+w[1:][-1:]

C (K&R) - 88 86 87 chars
r(char*s){int m,j,l=strlen(s)-2,i=l;while(--i>0){j=rand()%l+1;m=s[j];s[j]=s[1];s[1]=m;}}

There's no build-in swap or shuffle function in C, so I had to do it manually :(
Sample Program with Ungolfed r():
#include <stdio.h>
#include <string.h>
#include <time.h>
#include <stdlib.h>

// -----------------------------------------------------------------------
r( char *s )
{
    int m, j, l=strlen(s)-2, i=l;

    while (--i>0)
    {
        j = rand() % l + 1;

        m = s[j];
        s[j] = s[1];
        s[1] = m;
    }

}
// -----------------------------------------------------------------------
int main()
{
    char s[] = "anticipated";

    srand( time(0) );
    r( s );
    puts( s );

    return 0;
}

EDIT: fixed the bug when s consists of less than 3 chars (thanks to user-uknown for noticing it! )

In glibc, there is (was?) a non-standard library function strfry.

funny experience, if I feed it with char s[] = "na"; // not anticipated

@user uknown: I just edited the code and fixed it, thanks for noticing the bug! (I just added >0 in the condition of the while loop, "costing me" two more, but needed, chars :) )

@Mechanical snail: I think strfy is still in glibc.

C++, 111 97 chars
std::string f(std::string s){for(int i=s.size()-1;i>1;std::swap(s[rand()%i+1],s[--i]));return s;}

Here is a full program for those who wish to test it:
#include<string>
#include<iostream>

std::string f(std::string s){for(int i=s.size()-1;i>1;std::swap(s[rand()%i+1],s[--i]));return s;}

int main(){
    for(int i = 0; i<100; ++i)
    std::cout<<f("letters")<<std::endl;
}

Edit
Realised there is no need to random both swap indexes, saved a variable and a few more characters.

Excellent. Most solutions fail on very small input. Yours not.

Perl - 96 (or 71) characters 84 (or 59) characters
This is what I came up with in Perl. Went through a few different ways to do it but this seemed shortest from what I can think of so far, at 97 characters.
use List::Util 'shuffle';sub r{($b,@w)=split//,$_[0];$e=pop(@w);return$b.join('',shuffle@w).$e;}

Though, if you cut out the 'use' line (which I guess is valid, since others excluded #include lines in their C programs) I can cut it down further to 71 characters:
sub r{($b,@w)=split//,$_[0];$e=pop(@w);return$b.join('',shuffle@w).$e;}

EDIT
It was suggested that I try doing this implementing @tobius' method. This way I got it down to 84 characters, or by removing the use line, 59 characters:
use List::Util 'shuffle';sub r{$_[0]=~m/(.)(.+)(.)/;$1.join'',shuffle split//,$2.$3}

shortened your Version down to 87: use List::Util 'shuffle';sub r{($b,@w)=split//,$_[0];$e=pop@w;join'',$b,(shuffle@w),$e}

@sidran32 Can you implement Perl a variant of @tobius' answer, just for comparison?

@Tomalak Sure, I'll try it out.

shortened your regex version down by 3 characters: use List::Util 'shuffle';sub r{$_[0]=~m/(.)(.+)(.)/;$1.join'',shuffle split//,$2.$3}

Nice. I'm too used to using a heaping helping of parenthesis for clarity. Bad habit when golfing. :P

php (68 characters)
$r=preg_replace('/^(\w)(\w+)(\w)$/e','$1.str_shuffle($2).$3',trim($w));

shorter (60 characters)
$r=preg_replace('/(.)(.+)(.)/e','$1.str_shuffle($2).$3',$w);

+1 Very nice. :) You could drop the trim(), actually, and in the regex you can remove the anchors and use . instead of \w.

@Tomalak Suggested I try rewriting this solution in Perl. Including his suggestions, I got this:
use List::Util 'shuffle';sub r{$_[0]=~m/(.)(.+)(.)/;$1.join('',shuffle split//,$2).$3;}
That's 87 characters. Without the use line, it's 62 characters.

Can you provide a demo of this working? Because I can't...

Ruby 1.9, 77 48 46 44 chars
r=->w{w[h=1..-2]=[*w[h].chars].shuffle*"";w}

Disclaimer: I tuned this based on the highest ranked answer - noticed the exact same answer later on. You can check the history that I have kept true to my original idea but changed from ruby 1.8 to ruby 1.9 for short lambdas and shuffle.
If empty words are allowed then 56 54 chars
r=->w{w.empty?||w[h=1..-2]=[*w[h].chars].shuffle*"";w}

Nobody expects the spanish 'I'.

Attempted to handle cases with 0 or 1 letters as well

Ruby, 77 75 characters
def r(s);f=s.size-2;1.upto(f){|i|x=rand(f)+1;t=s[i];s[i]=s[x];s[x]=t};s;end

My Scala solution in a slightly less verbose language. I'm not a Ruby expert by any means, so there's probably room for improvement.

Wow. Works with 'I', as your scala solution.

Python 3, 94 93 91 characters
Using a different technique. Might also work in Python 2.
from random import*
s=lambda x:x[0]+''.join(sample(x[1:-1],len(x)-2))+x[-1]if x[0:-1]else x

The ... if x[0:-1] else x gives x if its length is 1 (otherwise it would be duplicated). The function thereby works for strings of length 0 and 1.
The sample() is from https://stackoverflow.com/questions/2668312/shuffle-string-in-python/2668366#2668366.
Since it's one expression, we can use a lambda (eliminating return, def, and a pair of parentheses).
Edit: from random import* to save 1 character, after the other Python submission.

I know I am so so so late here, but can x[0:-1] become x[:-1]?

JavaScript - 118 122 125 chars
Uses approximately the same algorithm as the OP, but with less chaining. I tried a lot of recursion, and I tried some iteration, but they all tend to get bogged down in some way or another.
function s(w){w=w.split('');var a=w.shift(),z=w.pop();return z?a+(w.sort(function(){return Math.random()-.5}).join(''))+z:a;}

Ungolfed:
function s(w)
{
    w = w.split('');
    var a = w.shift(),
        z = w.pop();
    return z?a + (w.sort(function() { return Math.random() - .5}).join('')) + z:a;
}

Does not pass the 'I'-test.

@Ryan Using return z?a+...+z:w; as an implicit length check would be in order. The silent assumption was that the function would receive only "valid" words.

Good point, except that w has been modified, so I have to use a in the else of the ternary. Edited, and up to 122 chars.

@Ryan: I believe a would be wrong for two-letter input. :-\ Damn next time I will line out requirements more carefully.

I don't think it would, actually. z will only be undefined if the word is one letter (or less).

For what it's worth, the distribution of outcomes your function creates is not uniform: w.sort(function() { return Math.random() - .5}) is the culprit, yeilding the skewed distribution.

@userunknown What's that?

@BadHorsie: I don't remember. A Test with a one letter word?

D, 62 chars
import std.random;void s(char[] s){randomShuffle(s[1..$-1]);}

okay I cheated with a normal char array instead of a real string (which is immutable char[] so no in-place shuffling)
edit with a length check it requires 14 more
import std.random;void s(char[] s){if(s.length>1)randomShuffle(s[1..$-1]);}

And it returns what for an input like 'I'?

It would be fairer (= better comparable) to return the result.

@user a range error. @ konrad that would require return s; and char[] return type 11 more chars

@ratchet Could you post the entire program, please?  BTW, I don't understand why you are counting import std.random;, and not just the function.

I'm guessing you could save 1 byte by using omitting the space in char[] s (to make it char[]s), but I haven't used D in years.

Yeah. char[] s=>char[]s and randomShuffle(s[1..$-1]) => s[1..$-1].randomShuffle. Wow, two D answers.

php 5.3 (60 chars)
$r=!$w[2]?:$w[0].str_shuffle(substr($w,1,-1)).substr($w,-1);

Improved to 56 chars and no longer requires version 5.3:
$r=substr_replace($w,str_shuffle(substr($w,1,-1)),1,-1);

+1 nice alternative to the other PHP answer. Not shorter, but no regex is a plus.

Updated with a shorter solution that doesn't require version 5.3

The old version is not correct: returns true for short strings.

Python, 86 chars
Slnicig is safe, so no bnouds ckhnceig is neeacrssy.  Wkros on all
leghtns.
from random import*
def f(x):x=list(x);t=x[1:-1];shuffle(t);x[1:-1]=t;return''.join(x)

Scala, 135 139 142 156 characters
def r(s:String)={var(x,o,t,f)=(0,s.toArray,' ',s.size-2)
for(i<-1 to f){t=o(i)
x=util.Random.nextInt(f)+1
o(i)=o(x)
o(x)=t}
o.mkString}

-7: removed ':String' (return type can be inferred)
-7: removed 'return ' (last expression is the return value)
-3: factored s.size-2 out
-4: toCharArray -> toArray

Works with 'I' and 'Verwürfel' without fancy Python characters. :) However, my solution using 'shuffle' is a bit shorter.

@user unknown Thanks for the edits :-)

Perl - 111 characters (without using any library function)
sub r{($f,@w)=split//,shift;$l=pop@w;while(@w){if(rand(9)>1){push@w,shift@w}else{push@t,pop@w}}join'',$f,@t,$l}

Usage:
$in="randomizethis";
$out = &r($in);
print "\nout: $out";
sub r{($f,@w)=split//,shift;$l=pop@w;while(@w){if(rand(9)>1){push@w,shift@w}else{push@t,pop@w}}join'',$f,@t,$l}

Python
It's 90 89 112 characters of python!
Edit 1: as a function this time! (thanks gnibbler)
Edit 2: now handles short words  (thanks user unknown)
import random as r
def q(s):
 a=list(s)
 b=a[1:-1]
 r.shuffle(b)
 if len(s)<4:
  return s
 return a[0]+''.join(b)+a[-1]

even less if you follow the spec and write a function :)

ah, pity shuffle doesn't work on strings

The random module is like me at a nightclub... we both just sort of shuffle in place! :)

Doesn't work for input like 'I'; return 'II'.

thanks! it now handles short words, but is slightly longer :)

C++11: - 68 66 chars
auto f=[&](){if(s.size()>2)random_shuffle(s.begin()+1,s.end()-1);};

full program:
#include <iostream>
#include <string>
#include <algorithm>

using namespace std;

int main(int argc, char* argv[]){

  string s = "SomestrinG";
  auto f=[&](){if(s.size()>2)random_shuffle(s.begin()+1,s.end()-1);};

  f();
  cout << s << endl;
  return 0;
}

Is hard coding in the input string legal?

@trinithis I thought we were only concerned with the function itself.  The program only shows how to use the function.  Regardless, not hard coding the input would not make a difference in this case; just add string s; cin >> s;

Python - 76 characters
import random as r
def f(w):m=list(w)[1:-1];r.shuffle(m);return w[0]+''.join(m)+w[-1]

George's userscript puts this at 85 characters.

R, 104 (126)
f=function(w){s=strsplit(w,"")[[1]];paste(c(s[1],sample(s[2:(length(s)-1)]),s[length(s)]),collapse="")}

Usage:
for (i in 1:10) print(f("parola"))
[1] "plraoa"
[1] "prolaa"
[1] "praola"
[1] "parloa"
[1] "plaora"
[1] "palroa"
[1] "porlaa"
[1] "ploraa"
[1] "porlaa"
[1] "ploraa"

the below function works with words with length less than 3:
f=function(w){s=strsplit(w,"")[[1]];ifelse(length(s)<3,w,paste(c(s[1],sample(s[2:(length(s)-1)]),s[length(s)]),collapse=""))}

f("pl")
[1] "pl"
f("a")
[1] "a"

Part of the task was not to move the first and last letters.

@Tomalak fixed!

Does it work with words below the length of 3?

@Tomalak Now it should be ok! Thanks for the corrections!

R, 95 92 91 characters
f=function(w,a=el(strsplit(w,'')),b=length(a))cat(a[1],sample(a[c(1,b)],b-2),a[b],sep="")

Makes use of R's lazy evaluation to compute a and b as function parameters, saving space with re-use later on. Also unlike other R answer this works for all words >1 char long.
Example below:
> f("hippopotamus")
hpuoopaitmps

> f("dog")
dog

> f("az")
az

Edit:  Replaced unlist() with [[]]  Replaced [[1]] with el()

C#, 128
static string r(string w){var t="";while(w.Length>1){int n=new Random().Next(1,w.Length-1);t+=w[n];w=w.Remove(n,1);}return w+t;}

Erlang, 188 172 132 chars
f([H|C=[_|_]])->T=[lists:last(C)],[H|s(C--T,T)];f(X)->X. s([],N)->N;s(D,N)->E=[lists:nth(random:uniform(length(D)),D)],s(D--E,E++N).

I'm still learning Erlang so any tips on making this shorter are appreciated.
full code(string_shuffle module):
-module(string_shuffle).
-export([f/1]).

f([H|C=[_|_]])->
    T=[lists:last(C)],
    [H|s(C--T,T)];f(X)->X.
f(X)->X.

s([],N)->N;
s(D,N)->
    E=[lists:nth(random:uniform(length(D)),D)],
    s(D--E,E++N).

Edit
Took the shuffle part out as a seperate function which no longer requires the head and tail of the list to be passed around.
Edit 2
Restructured to remove one of the ffunction patterns, changed the shuffle function to accept only two parameters, changed lists:delete for --[], swapped a lists:reverse call for a lists:last

D: 55 characters
void f(T)(T s){if(s.length>2)randomShuffle(s[1..$-1]);};

full program:
import std.stdio, std.random, std.conv;

void f(T)(T s){if(s.length>2)randomShuffle(s[1..$-1]);};

void main(){

  char[] s = to!(char[])("SomestrinG");

  f(s);
  writeln(s);
}

I think the else s part is missing?

@Tomalak No, it's not, because there is no need for it.  If the string is of length 2 or less, then we leave it alone.  Also, randomShuffle() is in-place.

Wow, D being competitive. I think randomShuffle(s[1..$-1]) can be s[1..$-1].randomShuffle IIRC (unless that's in a D version older than this post)

PowerShell, 93
filter x{if($_.length-lt3){$_}else{$_[0,-1]-join-join($_[1..($a=$_.Length-2)]|random -c $a)}}

Look, double-jointed code!

Way too long, sadly.

You can't beat Golfscript anyway. ;) It's way shorter than my JS solution; Powershell is pretty expressive.

This actually demonstrates plenty of things it doesn't handle well. Usually I aim for at least beating Python :-)

saved some bytes by making a var on the first call to .Length and not declaring $a, only -5 thanks to all the brackets needed.. filter x{if(($l=$_.length)-lt3){$_}else{$_[0,-1]-join-join($_[1..($l-2)]|random -c $l)}}

Scala: 94
def r(w:String)=if(w.size<2)w else w(0)+util.Random.shuffle(w.tail.init.toSeq).mkString+w.last

This is a riff on "user unknowns" answer. Since a String can be implicitly cast to a Seq of chars, we can leverage Seq methods to access the middle and end of the String.

Groovy, 75
r={w->w.size()<3?w:w[0]+w[1..-2].toList().sort{Math.random()}.join()+w[-1]}

assert r('a') == 'a'
assert r('it') == 'it'
assert r('cap') == 'cap'

for(x in 1..10) {
    def w = r('Honorificabilitudinitatibus')
    println w
    assert w.size()==27 && w[0]=='H' && w[26]=='s'
}

MATLAB (46 Characters)
f=@(x)[x(1) x(randperm(length(x)-2)+1) x(end)]

Sample Usage:
>> f('elephant')

ans =

eplhnaet

>> f('imawesomebutyousuck')

ans =

iouesutuoeswbamycmk

Works with words size two or greater.

Q, 38 48
{((:)x),((-1(#:)a)?a:-1_1_x),last x}
Had to change it for words <=3 letters
{$[3<(#)x;((*:)x),((-1*(#:)a)?a:-1_1_x),-1#x;x]}

You can get three less along the same vein: {$[3<(#)x;(1#x),((-1*(#)a)?a:-1_1_x),-1#x;x]}

APL (Dyalog), 34 Charachters
Still trying to golf it a bit more, new to APL.  Tips appreciated.
y←(⍴x←⍞)-2⋄x[1],x[1+⍳y][y?y],x[⍴x]

Here is an attempt to explain it, I also simplified it a bit (no charachter improvement, though)
⋄ is a statement separator, think of it as a new line.
That leaves us with 2 statements.
y←(⍴x←⍞)-2 and x[1],x[1+⍳y][y?y],x[⍴x]
APL works from right to left in statements, but follows parentesis still, so (⍴x←⍞) is executed first. ⍞ takes charachter input. ← assigns that to x and ⍴ gives the length of x.  Then  the -2 is executed, which subtracts 2 from the length of x. Finally, the length-2 is assigned to y and we move on to the next statement.
x[⍴x] takes the last character of x, think of it as x[x.length] (using the length as the index of the last character).
, is catenate.
So we concatenate the last character of x with x[1+⍳y][y?y] which takes the middle indices of x using 2+⍳y and applies a randomization using [y?y].
⍳y generates 1 2 3 ... y and 1+ turns this into 2 3 4 ... y+1 which are the middle indices of x, for example, this returns bcdef from abcdefg.
[y?y] "deals" y values from 1 to y.
So, x[1+⍳y][y?y] grabs the middle of the word and randomizes it.
Finally, we concatenate the first charachter of x using x[1], to the rest of the string, and that is the output of the program.
Hopefully that was understandable...

Oh dear God. (+1) -- Would you care to break it down for somebody who has no concept of APL?

Sure, give me a minute to update it

No problem. If you can "golf it down" more do that first.

@Tomalak explained it as best as I could :)

J, 25
(]/:0,((2-~#)?1-~#),1-~#)

Example:
      (]/:0,((2-~#)?1-~#),1-~#) 'order'
oedrr
      (]/:0,((2-~#)?1-~#),1-~#) 'order'
oerdr
      (]/:0,((2-~#)?1-~#),1-~#) 'order'
oderr
      (]/:0,((2-~#)?1-~#),1-~#) 'order'
odrer
      (]/:0,((2-~#)?1-~#),1-~#) 'order'
oerdr
      (]/:0,((2-~#)?1-~#),1-~#) 'order'
oerdr

I can get down to 22 using the random shuffle verb on this page.

Actually ignore my last comment, the top answer uses the method I would have used.

CJam, 15 bytes
CJam is younger than this challenge, so this submission is not eligible for being accepted. This submission assumes that a "word" contains at least one character (I've requested clarification from the OP).
{(\_W>\W<mr\++}

This defines a block, the equivalent of an unnamed function in CJam.
Test it here.
If full programs (STDIN to STDOUT) are also acceptable, it can be solved in 12 bytes:
l(\_W>\W<mr\

Test it here.
Explanation
(             "Slice off first character and push it on the stack.";
 \            "Swap with remaining string.";
  _W>         "Duplicate and truncate to last character.";
     \W<      "Swap with other copy and slice off last character.";
        mr    "Shuffle.";
          \   "Swap with last character.";
           ++ "Concatenate the three parts back together.";

Note that _W>\W< could in principle be shortened to )\ (which I had originally). However, this fails when the string is empty at that point, i.e. when it originally contained less than 2 characters.
For the full program, we read the input with l first, and we can omit the ++ since the contents of the stack are printed at the end of the program automatically, back to back.

This is amazing :)

Python 3, 80 chars
This is an improvement on Ashley Grenon's answer. By removing variable assignments and using random.sample instead of random.shuffle, so you don't have to explicitly call list(), I saved 4 characters. This one still fails on strings less than 2 characters.
import random as r
def f(w):return w[0]+''.join(r.sample(w[1:-1],len(w)-2))+w[-1]

Welcome to Programming Puzzles and Code Golf. This is a great answer; much better than the average first post. If you feel it is required, adding a code breakdown and explanation may improve this answer.

Ruby, 39 characters
->s{a,*b,c=s.chars;[a,*b.shuffle,c]*''}

You supposed to process each word of the input text separately.

@manatwork The reference solution clearly assumes that the input is a single word. I'm certain that this is what the author intended.

Oops. I misread its .split(""). You are right. Sorry. Confused it with Cambridge Transposition.

Python, 102 characters
def f(x):t=list(x)[1:-1];k='';exec'k+=t.pop(id(7)%len(t));'*len(t);return[x[0],x[0]+k+x[-1]][len(x)>1]

No imports! Works for words 1 character and above. This is my first golf entry and I was inspired by BlueEyedBeast's entry from Shortest code to produce non-deterministic output for the idea of using id(Object).

Explanation: It makes a list of letters from the input excluding the first and last, and repeatedly pops from this list and appends to a new one until empty. The index it pops from is id(7) % len(list we're popping from). Since id(7) is the memory address of the object 7, it is essentially random. So now we have a list of randomly scrambled letters from the center of the original input. All we do now is append the first and last letters of the original output accordingly and we got the output we want: (first letter)+(scrambled middle)+(last letter).

Perl, 41 bytes
40 bytes code + 1 for -n.
$\=chop;s/.//;print"$&",sort{rand 2}/./g

Requires input to be supplied without a newline (echo -n ...) as we use chop to move the last char into $\ (which is appended after all arguments to print) and we sort, applying 0 or 1 (rand 2) to each character. This appears to result in all permutations given enough time. The $& has to be in quotes, as it changes after the /./g is executed, interpolating into a string works around this. Also print has to be used instead of say to utilise $\ :(.
Usage
echo -n 'stringified' | perl -ne '$\=chop;s/.//;print"$&",sort{rand 2}/./g'
sifirgtined

for i in `seq 1 20`; do echo -n 'stringified' | perl -ne '$\=chop;s/.//;print"$&",sort{rand 2}/./g'; echo; done
segfiiintrd
sitnrigfied
stringified
srtinigfied
sginitrefid
strnigieifd
seriftniigd
sifertniigd
siirtngfied
sintrgieifd
snitrigefid
sfgieinirtd
sigitrnifed
sefiirtingd
sirtnigifed
sifgenritid
srtingiifed
siignrteifd
sefiigtrind
sifneirtigd

Taxi, 1344 bytes
Go to Post Office:w 1 l 1 r 1 l.Pickup a passenger going to Chop Suey.Go to Chop Suey:n 1 r 1 l 4 r 1 l.Pickup a passenger going to Post Office.[B]Switch to plan C if no one is waiting.Pickup a passenger going to Cyclone.Go to Cyclone:n 1 l 3 l.Pickup a passenger going to Narrow Path Park.Pickup a passenger going to Sunny Skies Park.Go to Zoom Zoom:n.Go to Sunny Skies Park:w 2 l.Go to Narrow Path Park:n 1 r 1 r 1 l 1 r.Go to Chop Suey:e 1 r 1 l 1 r.Switch to plan B.[C]Go to Narrow Path Park:n 1 l 1 r 1 l.Switch to plan H if no one is waiting.Pickup a passenger going to Joyless Park.Go to Joyless Park:e 1 r 3 l.Go to Narrow Path Park:w 1 r 3 l.[D]Switch to plan E if no one is waiting.Pickup a passenger going to Cyclone.Go to Cyclone:w 1 l 1 r 2 l.Pickup a passenger going to Firemouth Grill.Pickup a passenger going to Sunny Skies Park.Go to Zoom Zoom:n.Go to Firemouth Grill:w 1 l 2 r 3 r.Go to Sunny Skies Park:w 1 l 1 r 1 r.Go to Narrow Path Park:n 1 r 1 r 1 l 1 r.Switch to plan D.[E]Go to Firemouth Grill:e 1 r 4 r.[F]Switch to plan G if no one is waiting.Pickup a passenger going to Post Office.Go to Fueler Up:e 1 l.Go to Post Office:s 1 r 1 l.Go to Firemouth Grill:n 1 l.Switch to plan F.[G]Go to Joyless Park:e 1 l 3 r.Pickup a passenger going to Post Office.Go to Post Office:w 1 l 1 r 1 l.[H]Go to Post Office:e 1 r 4 r 1 l.

Try it online!
Try it online with linebreaks!
Errors out by having the boss fire me if the string is 1 character, and by being unable to drive in the current direction otherwise. Don't you just love programs that exit uncleanly like that?
Firemouth Grill is one of two destinations in Townsville that offer randomness. It is like any of the three parks in that any number of passengers can be dropped off for later, but they are picked up in a random and unspecified order. This destination alone does the main part of our job, so the only other thing to do is make sure we're only doing this to the characters in the middle.

This is amazing :D

Powershell, 81 bytes
Inspired by Joey: I like her double join.
$args|%{($_,($_[0,-1]-join-join($_[1..($a=$_.Length-2)]|random -c 2e9)))[$a-ge2]}

Notable changes:

if else replaced with a Fake ternary operator.
$_.Length is written once.
Other golf to compact the script
The script gets Random for the word length >= 4 only.
random -c $a replaced with random -c 2e9. It need to avoid an exception with word length <= 2. I think the length = 2000000000 is enough for a word.

Test script:
$f = {

$args|%{($_,($_[0,-1]-join-join($_[1..($a=$_.Length-2)]|random -c 2e9)))[$a-ge2]}

}

&$f ""
&$f a
&$f ab
&$f abc
&$f abcd
&$f randomize
&$f reading
&$f Hello
&$f world

Output:
a
ab
abc
acbd
rmaniodze
rniedag
Hlelo
wrlod

Vyxal, 5 bytes
ÞẇṖ℅j

Try it Online!
Þẇ    # Push (first+last, rest)
  Ṗ℅  # Shuffle (rest)
    j # Join (first+last) by (rest)

C# w/Linq - 152 non-whitespace chars.
It's terrible compared to other languages on char count, but elegant:
public string Shuf(string i)
{
    return new String(i.Take(1)
        .Concat(i.Skip(1).Take(i.Length-2).OrderBy(x=>Guid.NewGuid()))
        .Concat(new[]{i.Last()})
        .ToArray());
}

Why is the toArray necessary?

Because the product of these Linq methods is an IEnumerable<char>, for which there isn't a built-in String constructor. It has to be converted to an explicit char[].

there's no Rand class in C# - it's Random. Also, name the function S instead of Shuf to gain some chars.

also, for a reason I haven't discovered yet, x=>new Random().Next() does not actually randomize the string. Try _=>Guid.NewGuid() - it's shorter and works

It would fail because each new Random() instance is being "seeded" with the same system time value as the last one (or the next one) and so each PRNG produces the same number sequence.

FSharp, ~207 177
Count includes whitespace since its significant for f#
let f w=
 let r=System.Random()
 let e = Seq.length w
 (w|>Seq.mapi(fun i l->if i=0||i=e-1 then i,l else r.Next(1,e-1),l)|>Seq.sortBy fst|>Seq.map snd|>List.ofSeq).ToString()

Run with:
printfn "%s" (f "apples")

Java, 194 charcters
String r(String s){String[]c=s.split("");if(c.length>2)java.util.Collections.shuffle(java.util.Arrays.asList(c).subList(2,c.length-1));return(""+java.util.Arrays.asList(c)).replaceAll("\\W","");}

If you can assume java.util.* is imported, then you can shave off a fair amount of characters. Might be able to squeeze in a List variable to save a few more. If the class the r function is implemented in derives from java.util.Arrays, then even more characters can be saved.

&& isn't much shorter than if; try it without asList and without 'replaceAll'. [, L, l, o, a] and [Ljava.lang.String;@addbf1 might be with you.

&& requires both sides to be boolean expressions, and shuffle has return type void. As for storing the asList into c, the types are incompatable. I could store it in a java.util.List, but that is lengthy right there.

@trinithis Yeah I just tried with && and came to the same conclusion. So I deleted my comment.

One can do import static java.util.Arrays.*, which is just another import instead of deriving from java.util.Arrays, which is kind of clumsy.

String r(String s){char[]c=s.toCharArray();if(c.length>2)java.util.Arrays.sort(c,1,c.length-1);return new String(c);}

Scala: 112  123
def v(s:String)=if(s.size<4)s else s(0)+util.Random.shuffle(s.substring(1,s.size-1).toList).mkString+s(s.size-1)

Incorporated hints from the comments (length->size (I need this hint every time), mkString without ("")) and size-1, not -2). Thanks.

I think you can save 6 chars by using .size instead of .length

You can also leave the ("") off the mkString call to save 4 more and get down to 112. There's a couple of typos too - the v(0) after the else should be s(0) and s.length-2 in the substring should be s.length-1 otherwise you lose a character in the result.

Lua, 173 chars
Does what it needs to do.
function(a)return(a:gsub('(%w)(%w*)(%w)',function(a,b,c)t={}for l in b:gmatch'.'do t[#t+1]=l end while #t>0 do i=math.random(#t)a=a..table.remove(t,i)end return a..c end))end

Haskell, 195
import Random
import Data.List
r l=fmap(f l.g l)newStdGen
f l n=map snd$head$filter(\l->map fst l==n)$permutations$zip[0..]l
g l=take(n+2).(0:).(++[n+1]).take n.nub.randomRs(1,n)where n=length l-2

Hacked this into existence while Rotsor was making his post. This will cover all possible permutations, and I believe it does so uniformly.
The function r is the function that the user uses.
The algorithm is fairly straightforward. It generates a random list of unique numbers from 1 to n-2. Then it tacks on 0 to the front and n-1 to the end of the list. The take(n+2) is there to handle the case where the input is a single character (or an empty string for that matter). Then it searches for the corresponding permutation and returns that.
The list is generated by generating an infinite list of random numbers from 1 to n-2. Then it picks out the first occurance of each number in that range.

I've been puzzled why this program always produces the same result until I've realised that one needs to call newStdGen upon each independent call to r.

Run it outside of ghci. Make a main function, such as main = getLine >>= r >>= putStrLn. Then compile it and execute or use runhaskell. This will solve the problem. That or exit ghci every time and restart it after every call to r.

I was testing the distribution by doing replicateM 500 $ r "12345", which returned 500 identical results, so running it outside of ghci makes no difference.

Actually I think you should replace getStdGen with newStdGen in your solution, so it behaves in a way most (?) would expect.

I see. Fixed it. Thankfully, the character count is the same :D

Javascript, 202 characters
function r(s){var s=s.split(""),h=[-1],n=s.length-1,t,i;h[-1]=s[0];for(i=0;++i<n;){do{t=Math.random()}while(t in h);h[t]=s[i];h[i]=t;}h.sort();for(i=0;i<n;++i)h[i]=h[h[i]];return n?h.join("")+s[n]:s[0]}

This solution has an unbiased distribution.
Algorithm:
Split input string into an array s. Consider another array h that is doubly used as a dictionary. For each letter in s at index 0 < i < s.length-1, assign a unique random number to h at i. Also map the random number in the range [0, 1) in h to the letter. The first and last letters are handled specially. Before assigning the random numbers as described above, do the analogous thing for the first letter, but hard code the number as -1 (guaranteed to be less than the smallest random number generated, which can be 0). Ignore the last letter for now. Sort h. Map h's random value to the corresponding letter. Join the array into a string and tack on the last letter. Special case for 1 character input, where we return the first character (we still crunch h because the logic is shorter that way).

for(i=1;i<n;++i) --> for(i=0;++i<n;) ?

Nifty (filler.)

Why is sorting by Math.random()-.5 biased?

Suppose we have a 5 card deck. Then there are exactly 5! = 120 unique outcomes. If you were to "shuffle" the deck by going through the bottom to the top, swapping the current card with any card in the deck (including itself and including the layer of the deck already shuffled), this would produce 5^5 or 3125 possible outcomes. But 120 does not divide 3125 evenly. Thus by the pigeonhole principle, there exists an outcome that occurs more often than at least one other outcome. Hence the bias.

@trinithis, that is an interesting observation! However I think you did not answer the question. Sorting by Math.random() should give uniform distribution if Math.random() generates unique numbers, but in practice it does not.

The problem does not like in Math.random. The problem lies in how many times elements move in the sort due to the sorting algorithm itself. That is, if we had a perfect random function (with or without uniqueness), the bias would still exist.

Perl - 76 chars
Pure Perl implementation that requires no external modules.
Also correctly handles one-letter, two-letter word edge cases.
sub r{@a=split//,pop;@a>1?join'',@a[0,(sort{rand()<=>rand}1..$#a-1),$#a]:@a}

Usage
say r('stringified') for 1 .. 20;

# Example output

srfgiietnid
sgfnieiitrd
seiifgrtnid
siigrfeintd
sgiirntiefd
siigerniftd
sifiitgnred
sftrneiiigd
sfieirtngid
sfeitirgnid
sfiertnigid
sigteifrind
sgieftirnid
sieitfrnigd
stnigirfeid
sfietrniigd
siigfrenitd
stefrniiigd
setrfiniigd
sifgtiernid

N.B.
I'm not entirely convinced that the letter randomization still renders the word readable in the example above

JavaScript 132 characters:
function r(w){return w.substr(0,1)+w.substr(1,w.length-2).split('').sort(function(){return Math.random()-.5}).join('')+w.substr(-1)}

You don't need to go through point by point. If provided a function which returns something where Math.round will return a random 0,1,-1, that will be sufficient (because of how sort works).

That won't keep the first and last letters in place.

@Tomalak Now it will.

But it does not work anymore.

VBA, 128 177 151 chars
I know this is an older puzzle, but I wanted to add my two cents from
Sub o(s)
n=Left(s,1)
p=Len(s)-1
s=Right(s,p)
For i=1 To p-1
p=p-1
r=Int(p*Rnd()+1)
n=n & Mid(s,r,1)
s=Left(s,r-1) & Right(s,p-r+1)
Next
s=n & s
End Sub

Example Usage:
a = "According"
o a ' a is assigned by the passing of the reference to the 'o' sub.
a = "to"
o a ' see above...
a = "some"
o a
a = "controversial"
o a
a = "story"
o a

I was actually happily surprised to see it fare as well as it did against some of the other, more typical CG languages. After improving, this is still not the shortest, but I was happy to do it.

Does that keep the first and last letters in place and work with strings less than 3 characters long?

D'oh! First and last don't keep, but length is not a problem. I'll get back to you...

Fixed, @Tomalak. Thanks for catching that.

MATLAB, 65 47 characters
r=@(s)s([3-min(end,2):1 randperm(end-2)+1 end])

Works for strings of positive length, but fails on the empty string. Improved by using end as in jazzkingrt's solution.
This use of end can further improve jazzkingrt's solution by substituting end for length(x). However, that solution doesn't handle strings of length one correctly. (I'm not allowed to comment, so I write here instead.)

Q (42 Characters)
{(x[0]),((neg count 1_-1_x)?1_-1_x),-1#x}

Sample Usage:
q){(x[0]),((neg count 1_-1_x)?1_-1_x),-1#x} "elephant"
"eeahlnpt"
q){(x[0]),((neg count 1_-1_x)?1_-1_x),-1#x} "ant"
"ant"

Doesn't work for single letter words, need to work on that.

41 bytes with {$[3<c:(#)x;(x 0),((2-c)?-1_1_x),-1#x;x]}, works with 0, 1, 2 etc length strings too.

Mathematica 98 chars
Not the most economical code but fun to write.
s holds the input sentence (as a string).
Row[StringJoin @@@ (Characters@# /. {f_, m___, e_} :>
   Flatten@{f, RandomSample@{m}, e} & /@ StringSplit@s), " "]

For example, when `s = "This sentence is fairly easy to read.",

TinyMUSH, 102
&_ me=left(%0,1)[ifelse(eq(strlen(%0),1),,scramble(mid(%0,1,sub(strlen(%0),2)))[right(%0,1)])]
\u(_,X)

Replace "X" with the input word.  The user-defined _ attribute uses the built-in scramble() function to scramble letters between the first and last letters.

MATLAB, 48 bytes
function t=f(t)
t(2:end-1)=t(randperm(end-2)+1);

Too bad the spec says 'function', using input() would be 43 bytes. Another version, that will fail slightly on a one-length word (a becomes aa), is 34 bytes:
f=@(t)t([1 randperm(end-2)+1 end])

Pyth - 11 bytes
Pyth is younger than this challenge so it doesn't count.
pez+hz.SPtz

Gets middle, shuffles it, then adds the rest. Takes I/O from stdout/stdin.
pez+hz      Print First letter of input, something else, and last letter of input
 .S         Shuffle
  P         All but the last
   t        All but the first
    z       The input

Doesn't work for for 1-letter inputs.

Clip, 24
?<lxWx],*R>%Ox{(x)x`(x)x

Here's an effective translation in pseudocode:
x = input by stdin
if len(x) < 2:
  output x
else:
  y = rotate_right(x, 1)
  y.remove_first_occurrence(first(x), last(x))
  # y is now the characters between the first and last of the input.
  shuffle(y)
  output place_at_end(last(x), place_at_beginning(first(x), y))

esolangs.com does not seem to exist anymore.

@Tomalak Fixed, had a .com instead of .org...

Rebol - 63
f: func[s][e: take/last s ajoin trim reduce[take s random s e]]

Ungolfed:
f: func [s] [
    e: take/last s
    ajoin trim reduce [take s random s e]
]

Usage example:
>> f "1"
== "1"

>> f "12"
== "12"

>> f "123"
== "123"

>> f "1234"
== "1324"

NB. An alternative (but unfortunately not shorter) version would be:
f: func [s] [
    change/part next s random copy/part next s back tail s back tail s
    s
]

With golfing and minor shavings this would come out at 73 chars.

><>, 40 bytes
_5l)?vl1-[&r02.
} .32<
x{|$!
/r]&
>l?!;o

Try it here!

Coffee-script: 76 91 Bytes
f=(a)->a.length>1&&a[0]+(a.split('')[1..-2].sort ()->.5-Math.random()).join('')+a[-1..]||a

Wow, I like this language already.

PHP 7.1, 54 bytes
If the word has less than 4 letters, don´t shuffle:
$r=$w[3]?$w[0].str_shuffle(substr($w,1,-1)).$w[-1]:$w;

><>, 19 bytes
{o&v
?vo>xl2(
&<oo{

Try it online!
Works for words of less than 3 length.

Python 3, 75 73 bytes
Thanks to @WW for saving me 2 bytes

lambda x:x[0]+''.join(sample(x[1:-1],len(x)-2))+x[-1]
from random import*

Try it online!

You can remove the s= to save 2 bytes.

@WW I see that you could do that if the import wasn't there but how would you call it in in the "Try it online!"

Try it online!

@WW I see now Thank You!

R, 93 79 bytes
function(x,l=nchar(x))"if"(l<4,x,intToUtf8(utf8ToInt(x)[c(1,sample(l-2)+1,l)]))

Try it online!
Wroks for any ipnut szie dwon to zero, by frsit ckciheng the lgnteh of the sintrg and rneturing it if nchar(x)<4
-14 bytes thanks to Giuseppe!

89 bytes changing the sampling a bit

Oops, 83 bytes

Aaaand another one for good measure: 79 bytes -- in all fairness to me, I haven't gotten much sleep the last few days.

@Giuseppe This is much better indeed!

JavaScript, 102 bytes
(_,a=[..._].slice(1,-1))=>_.replace(/./g,(m,i)=>(l=a.length,!i||!l?m:a.splice(~~(Math.random()*l),1)))

Try it online!
Using spread syntax and .slice() create array from input string beginning at index 1 through -1, .splice() elements from array within .replace() callback function, return string.

APL(NARS), 52 chars, 104 bytes
∇r←s w;x
r←,w⋄→0×⍳3≥⍴w⋄r←(↑w),x[?⍨⍴x←¯1↓1↓w],¯1↑w
∇

This 'solution' is based to the fact that 3?3 return a random permutation of 1 2 3;
6?6 a random permutation of 1 2 3 4 5 6 ecc n?n a random permutation of 1 2 .. n
so if B is a string B[(⍴B)?⍴B] would be a string random permutation of B.
The function 's' has to have as input one string and return one string or ''.
If someone see some error, please to say, thank you.
test:
  ⎕fmt s¨'' 'w' 'my' 'the' 'this' 'this' 'this'
┌7────────────────────────────────────────────┐
│┌0┐ ┌1─┐ ┌2──┐ ┌3───┐ ┌4────┐ ┌4────┐ ┌4────┐│
││ │ │ w│ │ my│ │ the│ │ tihs│ │ this│ │ this││
│└¯┘ └──┘ └───┘ └────┘ └─────┘ └─────┘ └─────┘2
└∊────────────────────────────────────────────┘
  s¨'random' 'random' 'random' 'random'
rdonam rodanm raodnm rodnam
  s 'permutation'
ptaemutroin

JavaScript, 93 bytes
(_,[a,[...b],c,d=b.sort(_=>Math.random()-.5).join``]=_.match(/(^.)|[^\1]+(?=.$)|.$/g))=>a+d+c

Try it online!
Using .match()  with regular expression /(^.)|[^\1]+(?=.$)|.$/g to match first character, one or more characters that at not the first character followed by one character and end of string, and character followed by end of string and .sort() approach used at the question.

Javascript 98 bytes
a=>{c=l=a.length-1;for(b=[a[0]];--c;)d=Math.random()*99|0,b[d]?c++:b[d]=a[c];return b.join``+a[l]}

Try it online!
This assigns each letter other than the first and last to a random array index, and then joins the array into a string.  99 can be changed to 9e9 to work on (much!) longer words at the cost of a byte, but then join takes almost a minute.  Besides, there aren't many words that even approach 100 characters.
Because of that, this is 12 bytes shorter (86 bytes) and works almost every time:
a=>{c=l=a.length-1;for(b=[a[0]];--c;)b[Math.random()*9e9|0]=a[c];return b.join``+a[l]}

05AB1E, 12 11 bytes
g≠ićs¨.rIθJ

Try it online or verify some more inputs.
Fun 12 11 bytes alternative:
gÍ¸1.ø£€.rJ

Try it online or verify some more inputs.
Both version also work for strings with less than 3 characters. The first one could be just ćs¨.rIθJ (8 bytes), but then it doesn't work for single-character strings ("a" becomes "aa").
Explanation:
g              # Take the length of the (implicit) input
               #  i.e. "howaboutthis" → 12
               #  i.e. "a" → 1
 ≠i            # If this length is not 1:
               #   i.e. 12 → 1 (truthy)
               #   i.e. 1 → 0 (falsey)
   ć           #  Extract the head of the (implicit) input
               #   i.e. "howaboutthis" → "owaboutthis" and "h"
    s          #  Swap so the list (minus head) is at the top of the stack again
     ¨         #  Remove the last character
               #   i.e. "owaboutthis" → "owaboutthi"
      .r       #  Randomly shuffle the characters
               #   i.e. "owaboutthi" → "oohbtwtiua"
        Iθ     #  Take the last character of the input
               #   i.e. "howaboutthis" → "s"
          J    #  Join the values on the stack together (and output implicitly)
               #   i.e. "h", "oohbtwtiua", "s" → "hoohbtwtiuas"
               # (Implicit else)
               #  (Output the input as is implicitly)
               #   i.e. "a"

g              # Take the length of the (implicit) input
               #  i.e. "howaboutthis" → 12
               #  i.e. "a" → 1
 Í             # Subtract 2
               #  i.e. 12 → 10
               #  i.e. 1 → -1
  ¸            # Wrap it into a list
               #  i.e. 10 → [10]
               #  i.e. -1 → [-1]
   1.ø         # Surround it with 1s
               #  i.e. [10] → [1,10,1]
               #  i.e. [-1] → [1,-1,1]
      £        # Split the (implicit) input into parts of that size
               #  i.e. "howaboutthis" and [1,10,1] → ["h","owaboutthi","s"]
               #  i.e. "a" and [1,-1,1] → ["a","",""]
       €       # Map each value to:
        .r     #  Randomly shuffle the characters
               #   i.e. ["h","owaboutthi","s"] → ["h","oohbtwtiua","s"]
               #   i.e. ["a","",""] → ["a","",""]
          J    # Join the values in the list together (and output implicitly)
               #  i.e. ["h","oohbtwtiua","s"] → "hoohbtwtiuas"
               #  i.e. ["a","",""] → "a"

K (ngn/k), 22 bytes
{,/0N?'(0 1,1|#1_x)_x}

Try it online!
hat-tip ovf from the array programming discord / matrix for this answer!
Takes a single word to shuffle/randomize.

(...)_x cut x (the input) on the indices from (...), returning a three-item list containing the first element, the middle element(s), and the last element

(0 1,1|#1_x) generate a three-item list equivalent to [0, 1, max(1, len(x)-1)]. taking the max with 1 ensures single-character strings (e.g. ,"a") are handled as well.

0N?' shuffle each slice; this is a no-op on empty and one-character strings
,/ flatten the shuffled slices into a single string and (implicitly) return it

Pyth, 18 bytes
KhQ=Z>1Q++KO.pPtQZ

Try it online!

APL, 27 bytes
{3≥⍴⍵:⍵⋄⍵[⍋0,(?⍨2-⍨⍴⍵),⍴⍵]}

JavaScript, 81 bytes
s=>s.length<4?s:s[0]+[...s.slice(1,-1)].sort(_=>Math.random()>.5).join``+s.at(-1)

Try it:

f=s=>s.length<4?s:s[0]+[...s.slice(1,-1)].sort(_=>Math.random()>.5).join``+s.at(-1)

;[
  '',
  '1',
  '12',
  '123',
  '1234',
  '12345',
  '123456',
  '1234567',
  '12345678',
  '123456789',
].forEach(s=>console.log(f(s)))

JavaScript, 4 bytes
s=>s

It is funny but in real the chance to randomly sort the symbols position in string and get the same string is equal to get the another string. And this is not depend on how many times we will randomize the symbols in string. It may seem like something unreal, but that's the way it is :)
To understand it more easy way imagine that we must generate a number by generating random digits. Let's say we have to get a number of length n. We have 10 digits, so in each position the chance of any digit is \$\frac{1}{10}\$ so the total chance to get the any number with length of n is \$(\frac{1}{10})^n\$. So the chance to get the number 8888888888888888...8888 randomly is the same as the chance to get 9872346897621449...0467. It is important to understand that the probability of the next digit is independent of the previous generated digit

C (gcc), 71 bytes
Look mom, I beat python!
f(s,d)char*s;{for(;s[2];)if(d=rand()%~-strlen(++s))*s^=s[d]^=*s^=s[d];}

Try it online!

Christ, I was expecting the C answer to be a lot longer than that ...

Thunno 2 j, 10 bytes
Dḣ?Ṫsḣµr$h

Attempt This Online!
Explanation
Dḣ?Ṫsḣµr$h  # Implicit input
D           # Duplicate the input
 ḣ          # Pop one copy and check if it's length is more than 1
  ?         # If that's true:
   Ṫ        #  Remove the last character and push it separately
    s       #  Swap so the last character is below the rest of the string
     ḣ      #  Discard the first character from this string
      µr    #  Randomly shuffle the string
        $h  #  Push the first character of the input again
            # Implicit output of joined stack

Python - 103 96 90 88 85 109 characters
import random as r
def s(x):
 if len(x)>3:y=list(x[1:-1]);r.shuffle(y);return x[0]+''.join(y)+x[-1]
 return x

props to @dr jimbob for the "import as" bit and for catching my non-conformance with the spec.
props also to @user unknown for getting the spec clarified.
Edit: updated to conform to short-words spec.

Sorry about the other comment; my mistake; though I still think you need a return x[0]+''.join(y)+x[-1] at the end; also could change y=[x[a] for a in range(1,len(x))] to y=[x[1:-1]]

The [1:-1] actually doesn't work, and results in ['hateve'] for input of 'whatever'. My bad on the last letter, good catch.

I meant y=list(x[1:-1]).  But you are supposed to not shuffle the first and last letter, so you need to change your return to return x[0]+''.join(y)+x[-1]

nice list(). I had [b for b in x[1:-1]] for a while there instead.

Doesn't work for input like 'I'; return 'II'.

@user - you are right, but is there any solution here which does not demonstrate that error in the interest of conciseness? Not that I can see. Implied in the spec is that all inputs will be of len(x) > 2. Otherwise how do you scramble the letters in the middle? Unless that test case gets added to the spec, I will continue to ignore it as undefined behavior.

@rmckenzie I have to admit that did not think of that; my bad. Of course short words should work, I've added a length check to my question.

@mckenzie: Before I checked most of the solutions I have an installed interpreter or compiler at hand, there already where some solutions which handled 'I' correctly: 1x Java, 1x Scala, 1xC++, 1xRuby at least. I didn't test php, mono, ruby1.9 and much more.

@user Many people have updated their answers. If you down-voted them for this reason alone, I'd think it would be fair if your'd revise your downvotes.

I already revised every downvote I made, where the code now handles the problem. I would find it unfair, if a solution is only as short as it is, because it doesn't handle the case. But you're right; again there are new corrections.

Updated to reflect the change in spec.

Go, 154 132 bytes
import."math/rand"
func f(S string)(e string){k:=S[1:len(S)-1]
for _,i:=range Perm(len(k)){e+=k[i:i+1]}
return S[:1]+e+S[len(S)-1:]}

Attempt This Online!

-22 bytes from rand.Perm, using string slices, and named return.

J, 18 bytes
({~>:,~0,1+?~)_2+#

Try it online!
Constructs random indexes for the interior, prepends 0, appends n-1, then uses all those to index into the input.

GolfScript, 26 bytes
(:f;):l;{;9rand}$f l@\]''+

Try it online!

Zsh +coreutils, 73 bytes
for n;printf $n[1]$(fold -1<<<${n:1:-1}|shuf|tr -d \\n)${n:$#n-1:$#n-1}\

Try it online!
 78bytes
 85bytes
 92bytes
Incidentally, the Zsh documentation mixes up the descriptions of flags. F splits, f joins.

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


text:
Session-Saving Quine
Inspired by this question.
Create a program that prompts the user to store some data, and when the program is quitting, spit out the program itself, except the session data changed.
The user then open the newly generated program, and can recall the data from the previous program.
Commands

KEY VALUE: sets session variable KEY to VALUE
*: clear all data
! KEY: delete KEY
? KEY: query KEY (if not exist: print nothing and move on)
otherwise, quit the program

Neither key or value cannot contain any spaces.
The newly generated program's filename must identify the version of the program, you can use dates or counters.
Example interaction:
 name test                    store name = test
                              data is now { name: test }
 0 1                          data is now { name: test, 0: 1 }
 ? name                       output: test
 ! 0                          delete 0
                              data is now { name: test }
 hello good world             data is now { name: test, hello: good }
                              the extra word "world" is ignored
 egiwiwegiuwe                 the "otherwise" case: quit program

The user opens the newly generated program
 ? name                       output: test
 name retest                  data is now { name: retest }
 *                            clear
                              data is now { }

Sample implementation: https://gist.github.com/1128876
Rules

You do not need to preserve comments or insignificant whitespaces in the quined program: just preserve the functionality and the data
You cannot use any external storage.
No cheating quines, like any other quine problems.
Shortest code wins.

This reminds me of the time that I wrote a view in SQL Server that acted just like a table by using INSERT/UPDATE/DELETE triggers and storing the data in the view itself as SELECT 1 AS ID, NAME AS BLAH UNION...

What's considered a cheating quine?

Casey, reading own source code, usually.

Ah. My JS solution comes close to doing that, whoops. Oh well, since the spec isn't that clear about that, I'll leave it up at the risk of being downvoted.

Ruby 1.9, 159 156
This program generates files named "1", "2", "3" and so on.
b={}
I=1
eval T="loop{c,d=gets.split
c==?*?b={}:d ?c==?!?b.delete(d):c==???puts(b[d]):b[c]=d :break}
open(I.to_s,?w){|f|f<<'b=%p
I=%d
eval T=%p'%[b,I+1,T]}"

JavaScript, 245
(function(o,N){while(a=prompt()){a=a.split(' ')
b=a[0]
c=a[1]
if(b=='*')o={}
else if(b=='?'){if(o[c]!=N)alert(o[c])}
else if(b=='!')delete o[a[1]]
else if(c!=N)o[b]=c
else break}alert('('+arguments.callee+')('+JSON.stringify(o)+')')}({}))

D (419 chars)
enum c=q{string[string] m;import std.stdio;import std.array;void main(){foreach(string s;lines(stdin)){auto a=s.split;if(!a.length)goto e;switch(a[0]){case "*":m.clear;break;case "!":m.remove(a[1]);break;case "?":writeln(m.get(a[1],""));break;default:if(a.length<2){goto e;}m[a[0]]=a[1];}stdout.flush;}e:write("static this(){");foreach(i,v;m)writef("m[`%s`]=`%s`;",i,v);write("}enum c=q{",c,"};mixin(c);");}};mixin(c);

formatted:
enum c=q{
    string[string] m;
    import std.stdio;
    import std.array;
    void main(){
        foreach(string s;lines(stdin)){
            auto a=s.split;
            if(!a.length)goto e;
            switch(a[0]){
                case "*":m.clear;break;
                case "!":m.remove(a[1]);break;
                case "?":writeln(m.get(a[1],""));break;
                default:if(a.length<2){goto e;}m[a[0]]=a[1];
            }
            stdout.flush;
        }
        e:write("static this(){");
        foreach(i,v;m)writef("m[`%s`]=`%s`;",i,v);
        write("}enum c=q{",c,"};mixin(c);");
    }
};mixin(c);

variant of my D quine
the * command relies on m.clear; to work correctly which it doesn't in dmd 2.52 (bug in the compiler)
the need for stdout.flush; depends whether auto flush is enabled (it isn't on my machine)

source: Stack Exchange

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

sort: votes


text:
Negative Regexp
Write the shortest function that takes one string, and returns a regular expression that matches anything EXCEPT the input string, in parenthesis. Escape necessary characters like Perl quotemeta.
Input:
  helloworld
Output:
  ([^h]|h[^e]|he[^l]|hel[^l]|hell[^o]|hello[^w]|hellow[^o]|hellowo[^r]|hellowor[^l]|helloworl[^d])
Input:
  */
Output:
  ([^\*]|\*[^\/])

See also:

http://yannesposito.com/Scratch/en/blog/2010-02-15-All-but-something-regexp/
http://shinkirou.org/blog/2010/12/tricky-regular-expression-problems/

I would have thought that that could be done more concisely in regex.

The resulting regexes are somehow strange. E.g. The first one will match "x" or "hx" but not "xx". This is not "anything except the input". What do you really want to match?

Or ^(?!hello$)(.*)$ should work also (depending on the exact requirement - it matches anything which is not exactly "hello", i.e. "hello!" would match).

actually the regex I wrote had a problem. But I think there's a way to do that

@Howard I think that's exactly what I was trying to do

Your example output for 'helloword' doesn't match the string 'h' or ''

Voting to close as unclear, because the examples do not do what the question says.

Python, 49 chars
import re
f=lambda x:'(^(?!%s$).*$)'%re.escape(x)

The answer matches anything but the input. It gives an output using conditional groups so is suited for the problem:

regular expression that matches anything EXCEPT the input string

The answer uses Howard's regex (fixing my regex)
You can use the same approach on Perl with a few less chars:
Perl, 40 38
sub f{'(^(?!'.quotemeta(pop).'$).*$)'}

Examples:
f('hello') -> (^(?!hello$).*$)

f('*/')    -> (^(?!\*\/$).*$)

You can save two by replacing $_[0] with pop.

@Howard that's right. But as the question asks for parenthesis in the answer, I added 2 chars too :)

You only need the parenthesis only once, either around the statement or around .*.

Perl, 32 bytes
sub{qr/^\Q$_[0]\E\z(*COMMIT)a|/}

Try it online!
This is actually a general-purpose negator for any regular expression that doesn't use control flow commands. The basic idea is that we do (*COMMIT) ("if this doesn't match, nothing can"), followed by something that can't possibly match (a true general-purpose negator would use (?!), but we can use just a in this context because we know it can't appear after the end of the string \z), in order to force a failure in cases where the initial regular expression matches; | then allows a success in all other cases.
Out of the 31 bytes here:

sub{, $_[0], } (10 bytes) handle I/O (because the original question asked specifically for a function);
qr/^\Q, \E\z, / (11 bytes) construct a regex that matches the string provided as input, and only that string (we return the regex as a regex object; a string would be 1 byte shorter, but the regex object happens to come with parentheses around it, as required by the question, and a string would require me to add parentheses manually);
(*COMMIT)a| (11 bytes) are the regex negator that we use to negate that regex.

It's notable how much boilerplate there is here, and how the answer might be shorter if the question were more difficult (allowing the negation of arbitrary regexes, rather than just ones that match a single string).

JAVA 61
String f(String w){return "^(?!"+Pattern.quote(w)+"$)(.*)$";}

String f(String w){return "^(?!\\Q"+w+"\\E)(.*)$";}

@john that doesn't escape \E in the input string

yes. make sense.+1

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


text:
Undulant numbers
An undulant number is a number where its digits alternate between up and down like the following number: 461902 or 708143, or even 1010101, but not 123, because
2 < 3.
Write a program or function which returns a truthy value if a number is undulant, and a falsy value otherwise. The shortest code wins.
Note: Single digit numbers are a valid input but are not considered udulant, thus isUndulant returns false for n < 10.

Number input as string, integer, float...?

integer (the type function signature Integer -> Boolean)

What's the objective here? Code-golf (shortest function)?

The question doesn't make sense for 1-digit numbers. It should be True, False or undefined behavior (preferred) ?

@JBernardo: I would think True or undefined behavior, as it would be a better base case for recursion.

@JBernardo: I have added a note for your comment.

Is the comparison </> or <=/>= ? E.g. is 32213 an undulant number ?

@Paul: the comparison should be either < or >. so, 32213 is not an undulant because the second and third digits are =.

Your definition of undulant number is not in agreement with the standard definition: http://mathworld.wolfram.com/UndulatingNumber.html.  Is this intentional?

@mellamokb: I did not know that definition. In fact, I found these numbers in another book which defines the numbers as I did. Also, there are another type of numbers called 'softly undulant' which can be like 12121212 or 1010101010 etc. thanks for your observation.

My solution could be 16% smaller if the base case were true (as would make sense IMHO).

How can a question asked almost nine years ago be a duplicate of a question asked today?

(pdf)eTeX, 129 chars
\def\a#1#2{\if#2?\ifx\r\s\def\s{1}\else
True\end\fi\fi\edef\t{\pdfstrcmp{#2}{#1}}\ifx\s\t
False\end\fi\let\s\t\a#2}\expandafter\a

Compiling with pdfetex filename.tex 1324? gives a pdf output. TeX is primarily a typesetting language, and outputting instead to stdout would take around 20 more chars. Also the strange requirement for one-digit numbers (false rather than true) takes me 26 chars.

Ruby, 72 70 characters
Q=10;k=->n,v{(n%Q-n/Q%Q)*v<0?k[n/Q,-v]:n<Q};u=->n{n>9&&k[n,-1]|k[n,1]}

Usage and testcases:
p u[10101]   # <= true
p u[708143]  # <= true
p u[2421]    # <= false
p u[1231]    # <= false
p u[873]     # <= false

Single digits yield false:
p u[5]       # <= false

Consecutive identical digits also return false:
p u[66]      # <= false
p u[1221]    # <= false

J, 45
*./(n>9),(}:(=-)}.)(}:*@-}.)n#:~10$~>.10^.n=.

Sample use:
   *./(n>9),(}:(=-)}.)(}:*@-}.)n#:~10$~>.10^.n=. 461902
1
   *./(n>9),(}:(=-)}.)(}:*@-}.)n#:~10$~>.10^.n=. 708143
1
   *./(n>9),(}:(=-)}.)(}:*@-}.)n#:~10$~>.10^.n=. 1010101
1
   *./(n>9),(}:(=-)}.)(}:*@-}.)n#:~10$~>.10^.n=. 123
0
   *./(n>9),(}:(=-)}.)(}:*@-}.)n#:~10$~>.10^.n=. 5
0

I'm pretty sure there's a finer way of twisting Insert / to do more of the work in a go, but I've been J-less for months, I need to get back to it.

It will be hard to beat J in this problem. nice solution!

J, 30 bytes
*/0<(#,]*{.*1 _1$~#)2-/\a.i.":

A different approach than the other J answers.

   */0<(#,]*{.*1 _1$~#)2-/\a.i.":461902
1
   */0<(#,]*{.*1 _1$~#)2-/\a.i.":708143
1
   */0<(#,]*{.*1 _1$~#)2-/\a.i.":1010101
1
   */0<(#,]*{.*1 _1$~#)2-/\a.i.":123
0
   */0<(#,]*{.*1 _1$~#)(}.-}:)a.i.":5
0

Would be 3 characters shorter if 5 were considered undulant.

Well, at least I can console myself with the thought that I had the lead for an hour. :-)

Haskell, 88 77 73 65 characters
z=tail>>=zipWith compare
q[]=0>1
q s=all(/=EQ)$s++z s
u=q.z.show

This requires the commonly used language pragma (or -X flag): NoMonomorphismRestriction. If you don't admit that, we have to add 4 characters and define z thus:
z s=zipWith compare s$tail s

I am so furious that you beat my 104 char solution. u n=length s>1&&(a[GT,LT]||a[LT,GT])where s=show n;z=q compare s$tail s;w=q(==)z;q=zipWith;a=and.w.cycle It's kinda elegant. zipWith once with compare like you did, then zipWith again with (==) and cycle[GT,LT] or cycle[LT,GT] as second arg.

you could inline w as tail>>=zipWith compare which would shorten few bytes.

also, I golfed a shorter version of q: q[]=0<1;q(a:b:s)|a/=b,a/=EQ=q$b:s;q _=0>1

actually, here's an even shorter version:                   q s=and$all(/=EQ)s:zipWith(/=)s(tail s)

@proudhaskeller - neither version passes all tests. They both fail on 3 (should be False), and the first fails many others, like 32 and 101010101.

@proudhaskeller - Your second idea was easy to fix, but the fix brought it back to 88 characters... However it then let me factor out zipWith f s$tail s saving 11 characters!

You could shorten it by one using (%)f=tail>>=zipWith f

Actually you would get a lower score making % not an operator

@proudhaskeller - done!

Sage, 83 76 bytes
f=lambda x:uniq(cmp(*`x`[i-2:i][::(-1)^i])for i in[2..len(`x`)])in[[1],[-1]]

Got the idea to use cmp(*[..]) from JBernardo.  In Sage, uniq(...) is an alias for list(set(...)).
Edit: just noticed that for x < 10, uniq(cmp(...)) == [], which isn't on [[1],[-1]].  If x were input as a string, instead of an integer, I could get another 4 characters out!

I had an idea to use sum(uniq(...))^2, since sum([1,-1]) = 0, and the sums of the singletons [1] and [-1] squares to 1.  Unfortunately, it fails on a thrice-repeated digit; 1011101.

Nice. I should learn sage.
BTW, I just realized that backticks will append an L if the number is bigger than 2**32 in Python and affects the result. Does that happens on Sage?

Yeah, Sage makes a few things nice for golfing... for instance, its ridiculous startup time is spent importing a huge tree of modules.  The Sage Integer class doesn't bother with the L because Sage is preparsed python; 1234 -> Integer('1234').  You can jump right into using Sage here: http://sagenb.org

Python: 101 100 characters
Before minification:
undulate = (lambda n: n > 9
            and all(cmp(*digits) == (i % 2) * 2 - 1
                    for i, digits
                    in enumerate(zip(min(`n`,`n`[1:]),
                                     max(`n`,`n`[1:])))))

After minification:
a=lambda b:b>9and all(cmp(*c)==d%2*2-1 for d,c in enumerate(zip(min(`b`,`b`[1:]),max(`b`,`b`[1:]))))

Python, 134 129 chars
def f(x):d=[cmp(*i)for i in zip(`x`,`x`[1:])]if x>9 else[0];n=d[0]>0;return all(i<0 for i in d[n::2])&all(i>0 for i in d[n<1::2])

Ungolfed:
def f(x):
    if x>9:
        d = [cmp(*i)for i in zip(`x`,`x`[1:])] #difference of x[i] and x[i+1]
    else:
        d = [0]       #trick to return False if x<10 using less chars
    n = d[0]>0        #First digit is -1 or 1?
    neg = d[n::2]     #negative numbers if x is Undulant
    pos = d[not n::2] #positive numbers if x is Undulant

    #check if all negs are -1 and all pos are 1 and return value
    return all(i<0 for i in neg) and all(i>0 for i in pos)

JavaScript, 88 chars
function _(i){i+='';c=i[0];f=i[a=x=1];for(g=f<c;d=i[x++];c=d)g^=a&=g?d<c:d>c;return!f^a}

In essence, turn the number into a string and compare adjacent characters, flipping the expectation for each.

In JavaScript, a function doesn't need a name and the question asks explicitly for a function, so you can save two characters.

Python, 119 108 bytes
def u(x):l=[cmp(i,j)for i,j in zip(`x`,`x`[1:])];print x>9and all([i*j<0 for i,j in zip(l,l[1:])])and l!=[0]

Nice use of xor.  You can cut quite a few characters out with ... for a,b in zip(t,t[1:]) rather than using ranges.  Also, you don't need the brackets in all([...]) -- Python makes a generator when it finds (... for ...), even if the parentheses are for a function call.

Thank you very much for your advice! They have been very valuable! -20 chars

Very nice solution. Few more characters x>9 and all(i^j for i,j in zip(l,l[1:])) and remove if l else False.

It is not working in all cases. Two cases are problematic: only 2 digits (e.g. 11), and last 2 digits are same and larger than one before (e.g. 12155). First problem is since there is no testing if x<100. Second is because 'one way comparison'. It can be fix with cmp(i,j) and instead i^j set i*j<0, and testing and l[0]!=0.
Few more characters :-/

Thank you! +9 chars, but now all working.

Hmmm... print saves one character over return, but is it legitimate? The spec does ask for a function that "returns".

Haskell, 82 bytes
c=cycle[(<),(>)]
l!n=n>9&&and(zipWith3($)l(show n)$tail$show n)
u n=c!n||((>):c)!n

Try it online!

I count only 83 characters in this solution. (Are you on Windows, perhaps? Write the file with unix line endings, which is legal Haskell.)

Thanks, I was using 'wc' to count my characters on Cygwin. I count 82 characters. I used the following code, as wc seems to be outputting an extra character. (Vim doesn't show a trailing newline, but notepad does...)
readFile "Undulant.hs" >>= print . length . dropWhile (== '\n') . reverse . filter (/= '\r')

c=cycle[(<),(>)] can be shortened to c=(<):(>):c.

zipWith3($)l(show n)$tail$show n can be zipWith3($)l=<<tail$show n and ((>):c) can be tail c. All together 70 bytes: Try it online!

J, 44 39 36 31 bytes
*/2(0<#@],0>*/\)*2-/\".;' ',.":

Usage as before.
I hadn't noticed that my last edit made the inequality with 0 check completely unnecessary. :-)
Previous answer (+ explanation):
(0=+/2=/\u)*(1<#u)**/2~:/\2<:/\u=.".;' ',.":

Usage:
    (0=+/2=/\u)*(1<#u)**/2~:/\2<:/\u=.".;' ',.":461902
1

The answer has four parts:

u=.".;' ',.":
This reads in the number as a string ":, splits it into a list of characters preceded by spaces ' ',., stitches it back together ;, converts it back to numbers ". and then stores the result u=. This basically turns 461902 into 4 6 1 9 0 2 which I find easier to process in J.
*/2~:/\2<:/\
This operates on the value stored in u. It takes each pair of characters and checks if the left one is less than or equal to the right one 2<:/\ so 4 6 1 9 0 2 becomes 1 0 1 0 1. It then takes the result of this and checks each pair of numbers for inequality 2~:/\ so 1 0 1 0 1 becomes 1 1 1 1. Finally it multiplies them all together to get either a 0 or a 1 */ At this point we could return the answer if it weren't for 2 things: a single digit returns 1 when the question requires a 0; and equal numbers are treated the same as 'less than' so 461900 returns 1 instead of 0. Bummer. On we go...
(1<#u)
This checks if the number of items stored in u #u is greater than 1 and returns false if it's just a single digit number.
(0=+/2=/\u)
This takes each pair of numbers stored in u and checks for equality 2=/\u. It then sums the answers and checks if it has 0.

The results of parts 2, 3 and 4 are then multiplied together to (hopefully) produce a 1 when the number meets the requirements specified in the question.

Nice job re-taking the lead, but I just borrowed a trick from yours!

(That being said, I think you could take my a.i.": to shave a few more characters off.)

Unfortunately, I'm probably going to have to put that inequality check back in - my answer fails now for 11, 22, 33, 44 etc.

CoffeeScript, 98 67 53 bytes
(n)->0!in((n[i]>=c^(n[0]<n[1])+i)%2for c,i in n[1..])

Tests:
[
    '01010101' # true
    '12345'    # false
    '1010101'  # true
    '887685'   # false
    '9120734'  # true
    '090909'   # true
]

Uncompressed:
undulant = (n) ->
    direction = n[0] < n[1]
    return n.split('').every (cur, i) ->
        prev = arr[i-1] or 10 * direction
        +(prev >= cur) is (direction+i)%2

K, 41 bytes
{(x>9)&~max(=). 1_'-':'1_'(<':;>':)@\:$x}

E.g.
{(x>9)&~max(=). 1_'-':'1_'(<':;>':)@\:$x}1212130659
1b

Python, 155 chars
g=lambda a,b:all(x>y for x,y in zip(a,b))
u=lambda D:g(D[::2],D[1::2])&g(D[2::2],D[1::2])
def U(n):D=map(int,str(n));return(n>9)&(u(D)|u([-d for d in D]))

C++, 94 chars
bool u(int N){int K,P,Q,U=1,D=1;while(N>9)P=N%10,Q=(N/=10)%10,K=D,D=U&Q
P;return U^D;}

same method as my Erlang awnser with a for loop rather than recursion.

Python 105 101 100 chars
c=lambda r,t:len(r)<2 or(cmp(*r[:2])==t and c(r[1:],-t))
u=lambda x:x>9and c(`x`,cmp(*`x`[:2])or 1)

Recursive solution. c(r,t) checks if first char of r is less (t==-1) or greater (t==1) of second char, and call opposite check on shortened string.

Nice. You can save a character in the first line by removing 0, and you can save three characters on the second line by writing u=lambda x:x>9 and c(\x`,cmp(*`x`[:2])or 1)`

Tnx. I didn't like any() from the beginning :-)

You can save one more by writing x>9and.

GolfScript, 48 bytes
[`..,(<\1>]zip{..$=\-1%.$=-}%(\{.@*0<*}/abs

Hoping to beat J, my first time using GolfScript.  Didn't quite succeed.

Perl/re, 139 bytes
Doing everything in regex is kind of a bad idea.
/^(?:(.)(?{local$a=$1}))?(?:(?>((.)(?(?{$a lt$3})(?{local$a=$3})|(?!)))((.)(?(?{$a gt$5})(?{local$a=$5})|(?!))))*(?2)?)(?(?{pos>1})|(?!))$/

I'm using Perl 5.12 but I think this will work on Perl 5.10.  Pretty sure 5.8 is out though.

for (qw(461902 708143 1010101 123 5)) {
    print "$_ is " . (/crazy regex goes here/ ? '' : 'not ') . "undulant\n";
}

461902 is undulant
708143 is undulant
1010101 is undulant
123 is not undulant
5 is not undulant

JavaScript, 66 65 62 60 bytes
Takes input as a string, returns true for undulant numbers, an empty string (falsey) for single digit numbers and false otherwise.
([s,...a])=>a+a&&a.every(x=>eval(s+"<>"[++y%2]+x,s=x),y=s<a)

Try it
Run the Snippet below to test 0-9 and 25 random numbers <10,000,000.

f=
([s,...a])=>a+a&&a.every(x=>eval(s+"<>"[++y%2]+x,s=x),y=s<a)
tests=new Set([...Array(10).keys()])
while(tests.add(Math.random()*1e7|0).size<35);
o.innerText=[...tests].map(x=>(x=x+``).padStart(7)+` = `+JSON.stringify(f(x))).join`\n`

Explanation
A few fun little tricks in this one so I think it warrants a rare explanation to a JS solution from me.
()=>

We start, simply, with an anonymous function which takes the integer string as an argument when called.
[s,...a]

That argument is immediately destructured into 2 parameters: s being the first character in the string and a being an array containing the remaining characters (e.g. "461902" becomes s="4" and a=["6","1","9","0","2"]).
a+a&&

First, we concatenate a with itself, which casts both occurrences to strings. If the input is a single digit number then a will be empty and, therefore, become and empty string; an empty string plus an empty string is still an empty string and, because that's falsey in JS, we stop processing at the logical AND and output our empty string. In all other cases a+a will be truthy and so we continue on to the next part of the function.
a.every(x=>)

We'll be checking if every element x in a returns true when passed through a function.
y=s<a

This determines what our first comparison will be (< or >) and then we'll alternate from there. We check if the string s is less than the array a, which gets cast to a string in the process so, if s is less than the first character in a, y will be true or false if it's not.
s+"<>"[++y%2]+x

We build a string with the current value of s at the beginning and x at the end. In between, we index into the string "<>" by incrementing y, casting its initial boolean value to an integer, and modulo by 2, giving us 0 or 1.
eval()

Eval that string.
s=x

Finally, we pass a second argument to eval, which it ignores, and use it to set the value of s to the current value of x for the next iteration.

Erlang, 137 123 118 chars
u(N)->Q=N div 10,u(Q,N rem 10,Q>0,Q>0). u(0,_,D,U)->D or U;u(N,P,D,U)->Q=N rem 10,u(N div 10,Q,U and(Q
P)).

Won't this return True so long as there has been at least one up and one down transition anywhere? Won't it return True for, say 1234321?

@ MtnViewMark, yeah it did thanks, I misunderstood the question fixed now hopefully.

Scala, 141 133 129 97 bytes
def u(n:Int):Boolean=n>9&&{
val a=n%10
val b=(n/10)%10
a!=b&&n<99||(a-b*b-(n/100)%10)<0&&u(n/10)}

With a = n % 10, b = (n/10) % 10, c = (n/100) % 10
if a > b and b < c or
   a  c

Then a-b * b-c is either x*-y or -x*y with x and y as positive numbers, and the product is in both cases negative, but for -x*-y or x*y (a < b < c or a > b > c) the product is always positive.
The rest of the code is handling special cases: one digit, two digits, two identical digits.

PowerShell, 88
Naïve and trivial. I will golf later.
filter u{-join([char[]]"$_"|%{if($n){[Math]::Sign($n-$_)+1}$n=$_})-notmatch'1|22|00|^$'}

My test cases.

JavaScript, 112
function(n,d,l,c,f){while(l=n%10,n=n/10|0)d=n%10,c?c>0?d>=l?(f=0):(c=-c):d<=l?(f=0):(c=-c):(c=d-l,f=1);return f}

You only need to pass it one argument. I could probably golf this further with a for loop.

(d>=l -> d>0) and (d<=l -> d<2) perhaps? I'm not looking closely, as perhaps d might contain fractional parts that might skew it.

@trinithis: That's a lowercase L, not a 1. Thanks though!

Where's DejaVu Sans Mono or Bitstream Vera Sans Mono when you need it? Perhaps I need to customize stackoverflow with some custom css or a user script...

@trinithis: I agree, the font choice isn't that great. Bolding doesn't stand out enough...

Q, 71 bytes
{$[x>9;any all a=#[;(1 -1;-1 1)](#)a:1_signum(-':){"I"$x}each -3!x;0b]}

Sample usage:
q){$[x>9;any all a=#[;(1 -1;-1 1)](#)a:1_signum(-':){"I"$x}each -3!x;0b]} 5
0b
q){$[x>9;any all a=#[;(1 -1;-1 1)](#)a:1_signum(-':){"I"$x}each -3!x;0b]} 10101
1b
q){$[x>9;any all a=#[;(1 -1;-1 1)](#)a:1_signum(-':){"I"$x}each -3!x;0b]} 01010
1b
q){$[x>9;any all a=#[;(1 -1;-1 1)](#)a:1_signum(-':){"I"$x}each -3!x;0b]} 134679
0b
q){$[x>9;any all a=#[;(1 -1;-1 1)](#)a:1_signum(-':){"I"$x}each -3!x;0b]} 123456
0b
q){$[x>9;any all a=#[;(1 -1;-1 1)](#)a:1_signum(-':){"I"$x}each -3!x;0b]} 132436
1b

You can logic away the if {(x>9)&any all a=#[;(1 -1;-1 1)](#)a:1_signum(-':)("I"$')($)x} gives 62

Never seen ($) syntax for string before and the logic is a nice touch.

Perl, 78 bytes
sub u{@_=split//,$_=shift;s/.(?=.)/($&cmp$_[$+[0]])+1/ge;chop;$#_&&!/00|1|22/}

Mathematica, 46 bytes
#!=Sort@#&&#!=Reverse@Sort@#&[IntegerDigits@n]

Examples (spaces are not required):
# != Sort@# && # != Reverse@Sort@# &[IntegerDigits@5]
# != Sort@# && # != Reverse@Sort@# &[IntegerDigits@123]
# != Sort@# && # != Reverse@Sort@# &[IntegerDigits@132]
# != Sort@# && # != Reverse@Sort@# &[IntegerDigits@321]

(*  out *)
False  False  True  False

CJam, 30 bytes
CJam is newer than this challenge, so this does not compete for the green checkmark, but it's not a winner anyway (although I'm sure this can actually be golfed quite a bit).
l"_1=\+{_@-\}*;]"_8'*t+~{W>},!

Test it here.
How it works
Firstly, I'm doing some string manipulation (followed by eval) to save 5 bytes on duplicate code:
"..."_8'*t+~
"..."        "Push this string.":
     _       "Duplicate.";
      8'*t   "Replace the 8th character (the -) with *.";
          +~ "Concatenate the strings and evaluate.";

So in effect my code is
l_1=\+{_@-\}*;]_1=\+{_@*\}*;]{W>},!

First, here is how I deal with the weird special case of a single digit. I copy the digit at index 1 and prepend it to the number. We need to distinguish 3 cases:

The first two digits are different, like 12..., then we get 212..., so the start is undulant, and won't affect whether the entire number is undulant.
The first two digits are the same, like 11..., then we get 111.... Now the start is not undulant, but the number wasn't undulant anyway, so this won't affect the result either.
If the number only has one digit, the digit at index 1 will be the first digit (because CJam's array indexing loops around the end), so this results in two identical digits, and the number is not undulant.

Now looking at the code in detail:
l_1=\+{_@-\}*;]_1=\+{_@*\}*;]{W>},!
l                                   "Read input.";
 _1=\+                              "Prepend second digit.";
      {_@-\}*                       "This fold gets the differences of consecutive elments.";
             ;]                     "Drop the final element and collect in an aray.";
               _1=\+                "Prepend second element.";
                    {_@*\}*         "This fold gets the products of consecutive elments.";
                           ;]       "Drop the final element and collect in an aray.";
                             {W>},  "Filter out non-negative numbers.";
                                  ! "Logical not.";

I'm sure there is a shorter way to actually check digits (of length greater 1) for whether they are undulant (in particular, without using two folds), but I couldn't find it yet.

Prolog 87 bytes
u(X) :- number_codes(X,C),f(C).
f([_,_]).
f([A,B,C|L]) :- (AC;A>B,B<C),f([B,C|L]).

To run it, just save it as golf.pl, open a prolog interpreter (e.g. gprolog) in the same directory then do:
consult(golf).
u(101010).

It will give true if the number is undulant, otherwise just no.

Julia 0.6, 62 bytes
f(x,a=sign.(diff(digits(x))))=x>9&&-a*a[1]==(-1).^(1:endof(a))

Takes in a number, returns true for Undulant, and false for not. Eg f(163) returns true.
f(x,a=sign.(diff(digits(x))))=x>9&&-a*a[1]==(-1).^(1:endof(a))
f(x,                        )                                   # function definition
    a=sign.(diff(digits(x)))                                    # default 2nd argument is array of differences of signs of digits
                              x>9&&                             # short circuiting and to catch cases under 10
                                   -a*a[1]                      # make the first element of a always -1
                                          ==(-1).^(1:endof(a))  # check that a is an array of alternating -1 and 1 of correct length

Try it online!

R, 91 94 86 bytes
Takes input from stdin, outputs TRUE or FALSE as appropriate.
all(-(z=sign(diff((x=scan())%/%10^(1:nchar(x)-1)%%10)))*z[1]==(-1)^(1:(l=sum(1|z))))&l

Try it online!
This uses basically the same algorithm as gggg's Julia answer, but it's a little more verbose.
Added 3 bytes as the first version didn't account for numbers of length 1 always being nonundulant ("unundulant"?). Removed 8 bytes thanks to some golfing of redundant parts.

PHP, 151 chars
function i($n){$n=str_split($n);@$p=$n[1]==null?:($m=($n[0]>=$n[1])?-1:1)*10;foreach($n as$k=>$v)if(($k%2*2-1)*($v-$p)*@$m<=0&$p=$v)return!1;return!0;}

ungolfed(-ish):
function is_undulant($n){

      $n=str_split($n);
      @$p=$n[1]==null?:($m = ($n[0] >= $n[1])? -1 : 1)*10;
      foreach ($n as$k=>$v)
        if ( ($k%2 * 2 - 1) * ($v - $p) * @$m <= 0 & $p=$v ) return !1;

      return !0;
}

Python, 124 bytes
def undulant(x):
    x = `x`
    return any((int(x[1])-int(x[0]))*-1**i*(int(x[i])-int(x[i-1]))>0 for i in range(2,len(x)))

Different approach I think.

You should tell us what language that is.

Scala, 194 characters
def u(i:Int):Boolean={val x=i.toString;if(!x.matches("(\\d)\\1")){"(?<=.*)(\\d)(?=(\\d).*)".r.replaceAllIn(x,m=>if(m.group(1)<m.group(2))"<"else">").matches("((<>)+<?)|((><)+>?)\\d")}else false}

Hmm...regex seemed like a good idea at the time...

Doing everything in regex is kind of a bad idea.  (Your comment inspired me!)

C#, 147 142 bytes
bool U(int i){if(i<10)return 0>1;var s=i+"";var b=s[0]>s[1];for(int j=2;j<s.Length;j++){var x=s[j-1]>s[j];if(x==b)return 0>1;b=x;}return 1>0;}

Working sample: http://ideone.com/b8ubr

Python 2, 79 77 69 bytes
a=raw_input()
print{cmp(a[i+1],a[i])for i in range(len(a)-1)}=={-1,1}

Incorrect.  Try 1221.

No, 1221 works. It returns True.

It should return false.

Fixed it. Now it's one single formula. :)

12321 should return False.

Why? There are no equal adjacent numbers, and it goes up and down.

It goes (up, up, down, down).  It should go (up, down, up, down) or (down, up, down, up).  Also, the task is to provide a function.

If your answer were correct, it could be shortened by using this technique:  f=lambda a:{cmp(*x)for x in zip(a,a[1:])}=={-1,1}

APL (Dyalog), 43 21 bytes
ASCII is way too limited! :P
{⍵≤9:0⋄∧/2≠/×2-/⍎¨⍕⍵}

In standard APL fashion, it returns 1 for true and 0 for false.
Usage:
  {⍵≤9:0⋄∧/2≠/×2-/⍎¨⍕⍵}461902
1
  {⍵≤9:0⋄∧/2≠/×2-/⍎¨⍕⍵}708143
1
  {⍵≤9:0⋄∧/2≠/×2-/⍎¨⍕⍵}123
0
  {⍵≤9:0⋄∧/2≠/×2-/⍎¨⍕⍵}6
0

Explanation:

⍵≤9:0⋄: If the argument is smaller or equal to 9, it's not an undulant number. Otherwise...
⍎¨⍕⍵: evaluate each character in the string representation of ⍵ (giving a list of digits)
2-/: subtract each pair of consecutive digits from each other (i.e. (4-6),(6-1),(1-9),(9-0),(0-2))
×: find the sign of each number in that list
2≠/: for each pair of consecutive signs, see if they are not equal
∧/: check if this is true for all pairs

Python 2.7, 89 chars
def f(a):z=[cmp(*x)for x in zip(a[1:],a)];return{(a&b)-(a^b)for a,b in zip(z[1:],z)}=={3}

C (Clang), 78 bytes
u(i){int d,p=0;while(i>9){d=i%10-(i/=10)%10;if(d*p>0|!d)i=d=0;p=d;}return!!p;}

Expanded code with test harness:
u(i){
  int d,p=0;
    while(i>9) {
      d=i%10-(i/=10)%10;
      if(d*p>0|!d)i=d=0;
      p=d;
  }
  return !!p;
}

void test(int i) {
  printf("%8d = %d\n", i, u(i));
}

int main(int argc, char *argv[]) {
  test(132);
  test(123);
  test(5);
  test(1332);
  test(176823);
}

(compiled with Apple clang version 3.1)
Results:
     132 = 1
     123 = 0
       5 = 0
    1332 = 0
  176823 = 1

Apparently u(132) is 0. Am I doing something wrong? http://ideone.com/MMrfM

while I spotted an error in my first version, it was still returning 1 for u(132) for me - odd.

APL, 19 characters
{a≡⍳⍴a←|-\×2-/⍎¨⍕⍵}


text:
Magic square generator
Create the shortest function to print a magic square of given size.
A magic square is a NxN matrix of distinct numbers and the sum of each row, column and diagonal is equal to a constant.
A magic square of size 4 is:
07 12 01 14
02 13 08 11
16 03 10 05
09 06 15 04

And the constant is 34.
The function should be able to handle inputs up to N = 30 and doesn't need to show leading zeroes.
Using Matlab's magic function or similar built-in function is not allowed.
More useful information: http://mathworld.wolfram.com/MagicSquare.html
The output doesn't need to be pretty printed and may contain [](){},  or List/Array delimiters of your language. Although, it should use one line for each row
E.g.
1, 2,
3, 4,

((9,8),
 (6,7))

[10 2]
[3 456]

PS: The corner case, when N = 2 is undefined behavior as there's no magic square of that size.
Also, the function should complete in less than 1 minute to avoid brute force.

Does it have to be pretty-printed, or can the function return a list of lists or similar?

@Joey I Added that information

Bad codegolf example as it is an NP-complete problem unless you're cheating.

@Neil Reference?

@JBernardo:  NP-complete problems can be solved.  By calling it NP-complete, I only mean there is no efficient manner of going about solving for a magic square.  Though it would seem that I confused magic squares with latin squares, which is NP-complete.

@JBernardo: If you had written what I had wrote, you'd realize I was stating that I was wrong and that I confused magic squares with latin squares.  Not just that, but you'd realize that NP-complete does not mean that it cannot be done since I addressed that as well.

Does the program have to handle the trivial case where N=1?

@Peter Of The Corn Yes.

Ruby, 344 characters
q=->n{r=0...n;n%2>0?(m=r.map{[]*n};x=n/2;y=i=0;r.map{r.map{m[y%=n][x%=n]=i+=1;x+=1;y-=1};x-=1;y+=2};m):n<5?[[16,3,2,13],[5,10,11,8],[9,6,7,12],[4,15,14,1]]:(d=q[n/2];r.map{|y|r.map{|x|4*d[b=y/2][a=x/2]-[0,3,2,1,3,0,2,1,3,0,1,2][(n/2%2<1?b<n/4?0:8:a==n/4&&b==n/4?4:a==n/4&&b==n/4+1?0:b<=n/4?0:b==n/4+1?4:8)+y%2*2+x%2]}})}
Q=->n{q[n].map{|s|p s}}

You can use it e.g. like
Q[3]

and the output will be
[8, 1, 6]
[3, 5, 7]
[4, 9, 2]

The solution is not yet fully golfed. Also huge squares are generated reasonably fast. It uses a recursive function q to generate the squares unless n is odd in which case the square is generated directly or n==4 which is hard-coded.

@Franklin I didn't know how to directly calculate the square for N=4 with less chars. And for the other one, the condition N<5 is one char less than N==4.

Q, 50
Works for odd numbers
{(+)a rotate'(+)(a:((!)x)-1)rotate'x cut 1+(!)x*x}

usage
q){(+)a rotate'(+)(a:((!)x)-1)rotate'x cut 1+(!)x*x} 5
24 1  8  15 17
5  7  14 16 23
6  13 20 22 4
12 19 21 3  10
18 25 2  9  11

Magic Square Generator in Python, 127 106 characters
106 char code
#Works for odd numbers only

n=5
print [[(i+j-1+n/2)%n*n+(i+2*j-2)%n+1for j in range(n)]for i in range(n)]

127 char code
#Works for odd numbers only
n=3
j,A=n/2,[[0]*n for i in[0]*n]
i=c=0
while c<n*n:c=A[i][j]=c+1;i,j=[i+1,[n,i][i>0]-1][c%n>0],[j,[n,j][j>0]-1][c%n>0]
print A

See: http://ajs-handling-problems-in-pythonblog.blogspot.in/2013/10/shortest-magic-square-generator-code-in.html

[n,i][i] returns list index out of range when i = 2, as it is after the very first iteration. Needs more testing?

my mistake! updated the code...128 chars

@primo
n=3
j,A=n/2,[[0]*n for i in[0]n]
i=c=0
while c<nn:c=A[i][j]=c+1;i,j=[i+1,[n,i][i>0]-1][c%n>0],[j,[n,j][j>0]-1][c%n>0]
print A

@primo sorry for bad indentation..use the link to see a clean code

I've added the code to your post. I imagine that it was downvoted by someone who thought it was spam.

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