Ordered words

From Rosetta Code
Revision as of 21:22, 15 January 2011 by Sonia (talk | contribs) (Go solution)
Task
Ordered words
You are encouraged to solve this task according to the task description, using any language you may know.

Define an ordered word as a word in which the letters of the word appear in alphabetic order. Examples include 'abbey' and 'dirt'.

The task is to find and display all the ordered words in this dictionary that have the longest word length. (Examples that access the dictionary file locally assume that you have downloaded this file yourself.)

Ada

<lang Ada>with Ada.Containers.Indefinite_Vectors; with Ada.Text_IO; procedure Ordered_Words is

  package Word_Vectors is new Ada.Containers.Indefinite_Vectors
     (Index_Type => Positive, Element_Type => String);
  function Is_Ordered (The_Word : String) return Boolean is
     Highest_Character : Character := 'a';
  begin
     for I in The_Word'Range loop
        if The_Word(I) not in 'a' .. 'z' then
           return False;
        end if;
        if The_Word(I) < Highest_Character then
           return False;
        end if;
        Highest_Character := The_Word(I);
     end loop;
     return True;
  end Is_Ordered;
  procedure Print_Word (Position : Word_Vectors.Cursor) is
  begin
     Ada.Text_IO.Put_Line (Word_Vectors.Element (Position));
  end Print_Word;
  File : Ada.Text_IO.File_Type;
  Ordered_Words : Word_Vectors.Vector;
  Max_Length : Positive := 1;

begin

  Ada.Text_IO.Open (File, Ada.Text_IO.In_File, "unixdict.txt");
  while not Ada.Text_IO.End_Of_File (File) loop
     declare
        Next_Word : String := Ada.Text_IO.Get_Line (File);
     begin
        if Is_Ordered (Next_Word) then
           if Next_Word'Length > Max_Length then
              Max_Length := Next_Word'Length;
              Word_Vectors.Clear (Ordered_Words);
              Word_Vectors.Append (Ordered_Words, Next_Word);
           elsif Next_Word'Length = Max_Length then
              Word_Vectors.Append (Ordered_Words, Next_Word);
           end if;
        end if;
     end;
  end loop;
  Word_Vectors.Iterate (Ordered_Words, Print_Word'Access);

end Ordered_Words;</lang>

Output:

abbott
accent
accept
access
accost
almost
bellow
billow
biopsy
chilly
choosy
choppy
effort
floppy
glossy
knotty

C

<lang C>

  1. include<stdlib.h>
  2. include<string.h>
  3. include<stdio.h>

typedef struct noda{ char str[100]; struct noda* link; }node;

typedef node* list;

list words,last;

int isOrdered(char* str) { int i;

for(i=0;str[i]!=00;i++) { if(str[i]>str[i+1] && str[i+1]!=00) return 0; }

return 1; }

void insert(char str[100]) { list temp;

if(words==NULL) { words = (list)malloc(sizeof(node)); strcpy(words->str , str); words->link = NULL; last = words; }

else { temp = (list)malloc(sizeof(node)); strcpy(temp->str , str); temp->link = NULL; last->link = temp; last = temp; } }

void destroyList() { list temp;

while(words!=NULL) { temp = words; words = words->link; temp->link = NULL; free(temp); } }

void printList() { while(words!=NULL) { printf("\n%s",words->str); words = words->link; } }

int main() { unsigned int longest=0; char str[100]; FILE* fp = fopen("C:/unixdict.txt","r");

while(fscanf(fp,"%s",str)!=EOF) { if(strlen(str)>longest && isOrdered(str)) { destroyList(); insert(str); longest = strlen(str); }

else if(strlen(str) == longest && isOrdered(str)) { insert(str); } }

fclose(fp);


printList(); printf("\nThe max length is %d",longest);

return 0; }

</lang>

And the output is :

<lang> abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty The max length is 6 </lang>

C++

<lang cpp>#include <fstream>

  1. include <iostream>
  2. include <string>
  3. include <algorithm>
  4. include <vector>
  5. include <iterator>
  6. include <functional>

struct OrderByLength :

  public std::binary_function<std::string, std::string , bool> {
  bool operator( )( const std::string &a , const std::string &b ) const {
     if ( a.length( ) != b.length( ) ) 

return a.length( ) > b.length( ) ;

     else 

return a < b ;

  }

};

int main( ) {

  std::ifstream infile( "unixdict.txt" ) ;
  if ( infile ) {
     std::string word , sorted ;
     std::vector<std::string> sortedWords ;
     getline( infile , word ) ;
     while ( infile ) {

sorted = word ; std::sort( sorted.begin( ) , sorted.end( ) ) ; if ( sorted == word ) { sortedWords.push_back( word ) ; } getline( infile , word ) ;

     }
     infile.close( ) ;
     std::partial_sort( sortedWords.begin( ) , sortedWords.begin( ) + 16 ,

sortedWords.end( ) , OrderByLength( ) ) ;

     std::copy( sortedWords.begin( ) , sortedWords.begin( ) + 16 , 

std::ostream_iterator<std::string>( std::cout , " " ) ) ;

     std::cout << '\n' ;
     return 0 ;
  } 
  else {
     std::cout << "Can't find word file!\n" ;
     return 1 ;
  }

}</lang>

Output

abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty

C#

<lang csharp>using System; using System.Linq; using System.Net;

static class Program {

   static void Main(string[] args)
   {
       WebClient client = new WebClient();
       string text = client.DownloadString("http://www.puzzlers.org/pub/wordlists/unixdict.txt");
       string[] words = text.Split(new char[] { '\r', '\n' }, StringSplitOptions.RemoveEmptyEntries);
       var query = from w in words
                   where IsOrderedWord(w)
                   group w by w.Length into ows
                   orderby ows.Key descending
                   select ows;
       Console.WriteLine(string.Join(", ", query.First().ToArray()));
   }
   private static bool IsOrderedWord(string w)
   {
       for (int i = 1; i < w.Length; i++)
           if (w[i] < w[i - 1])
               return false;
       return true;
   }

}</lang>

Output:

abbott, accent, accept, access, accost, almost, bellow, billow, biopsy, chilly, choosy, choppy, effort, floppy, glossy, knotty

D

<lang d>import std.stdio;

void main() {

   string[] words; // longest ordered words
   foreach (w; File("unixdict.txt").byLine())
       if (w == w.dup.sort)
           if (!words.length || w.length == words[0].length)
               words ~= w.idup;
           else if (w.length > words[0].length)
               words = [w.idup];
   writeln(words);

}</lang>

Output:

[abbott, accent, accept, access, accost, almost, bellow, billow, biopsy, chilly, choosy, choppy, effort, floppy, glossy, knotty]

More functional version (same output): <lang d>import std.stdio, std.algorithm, std.array;

void main() {

 auto oWords = filter!"a == a.dup.sort"(File("unixdict.txt").byLine());
 auto ordWords = array(map!"a.dup"(oWords));
 auto maxLen = reduce!max(map!"a.length"(ordWords));
 writeln(filter!((w){return w.length == maxLen;})(ordWords));

}</lang>

E

This example is incomplete. Program output is not shown. Please ensure that it meets all task requirements and remove this message.
Translation of: Python

<lang e>pragma.enable("accumulator")

def words := <http://www.puzzlers.org/pub/wordlists/unixdict.txt>.getText().split("\n") def ordered := accum [] for word ? (word.sort() <=> word) in words { _.with(word) } def maxLen := accum 0 for word in ordered { _.max(word.size()) } def maxOrderedWords := accum [] for word ? (word.size() <=> maxLen) in ordered { _.with(word) } println(" ".rjoin(maxOrderedWords))</lang>

One-pass procedural algorithm which avoids keeping the entire data set in memory:

<lang e>def best := [].diverge() for `@word$\n` ? (word.sort() <=> word) in <http://www.puzzlers.org/pub/wordlists/unixdict.txt> {

 if (best.size() == 0) {
   best.push(word)
 } else if (word.size() > best[0].size()) {
   best(0) := [word] # replace all
 } else if (word.size() <=> best[0].size()) {
   best.push(word)
 }

} println(" ".rjoin(best.snapshot()))</lang>

Factor

This example is incorrect. Please fix the code and remove this message.

Details: The output is not shown.

<lang factor>USING: fry grouping io io.encodings.utf8 io.files kernel math math.order sequences unicode.case ; IN: ordered-words

CONSTANT: dict-file "vocab:ordered-words/unixdict.txt"

word-list ( -- seq )
   dict-file utf8 file-lines ;
ordered-word? ( word -- ? )
   >lower 2 <clumps> [ first2 <= ] all? ;
filter-longest-words ( seq -- seq' )
   dup [ length ] [ max ] map-reduce
   '[ length _ = ] filter ;
main ( -- )
   word-list [ ordered-word? ] filter
   filter-longest-words [ print ] each ;</lang>

Fortran

<lang fortran> !***************************************************************************************

module ordered_module

!***************************************************************************************

implicit none 

!the dictionary file: integer,parameter :: file_unit = 1000 character(len=*),parameter :: filename = 'unixdict.txt'

!maximum number of characters in a word: integer,parameter :: max_chars = 50

type word character(len=max_chars) :: str !the word from the dictionary integer :: n = 0 !length of this word logical :: ordered = .false. !if it is an ordered word end type word

!the dictionary structure: type(word),dimension(:),allocatable :: dict

contains !***************************************************************************************

!****************************************************************************** function count_lines_in_file(fid) result(n_lines) !****************************************************************************** implicit none

integer  :: n_lines integer,intent(in)  :: fid character(len=1)  :: tmp integer  :: i integer  :: ios

!the file is assumed to be open already.

rewind(fid) !rewind to beginning of the file

n_lines = 0 do !read each line until the end of the file. read(fid,'(A1)',iostat=ios) tmp if (ios < 0) exit !End of file n_lines = n_lines + 1 !row counter end do

rewind(fid) !rewind to beginning of the file

!****************************************************************************** end function count_lines_in_file !******************************************************************************

!****************************************************************************** pure elemental function ordered_word(word) result(yn) !****************************************************************************** ! turns true if word is an ordered word, false if it is not. !******************************************************************************

implicit none character(len=*),intent(in) :: word logical :: yn

integer :: i

yn = .true. do i=1,len_trim(word)-1 if (ichar(word(i+1:i+1))<ichar(word(i:i))) then yn = .false. exit end if end do

!****************************************************************************** end function ordered_word !******************************************************************************

!***************************************************************************************

end module ordered_module

!***************************************************************************************

!****************************************************

program main

!****************************************************

use ordered_module
implicit none

integer :: i,n,n_max

!open the dictionary and read in all the words: open(unit=file_unit,file=filename) !open the file n = count_lines_in_file(file_unit) !count lines in the file allocate(dict(n)) !allocate dictionary structure do i=1,n  ! read(file_unit,'(A)') dict(i)%str !each line is a word in the dictionary dict(i)%n = len_trim(dict(i)%str) !save word length end do close(file_unit) !close the file

!use elemental procedure to get ordered words: dict%ordered = ordered_word(dict%str)

!max length of an ordered word: n_max = maxval(dict%n, mask=dict%ordered)

!write the output: do i=1,n if (dict(i)%ordered .and. dict(i)%n==n_max) write(*,'(A,A)',advance='NO') trim(dict(i)%str),' ' end do write(*,*)

!****************************************************

end program main

!**************************************************** </lang>

Output

abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty  

Go

Go has strings and Unicode and stuff, but with the dictionary all ASCII and lower case, strings and Unicode seem overkill. I just worked with byte slices here, only converting the final result to strings for easy output. <lang go>

package main

import (

   "bytes"
   "fmt"
   "io/ioutil"

)

func main() {

   // read into memory in one chunk
   b, err := ioutil.ReadFile("unixdict.txt")
   if err != nil {
       fmt.Println(err)
       return
   }
   // split at line ends
   bss := bytes.Split(b, []byte{'\n'}, -1)
   // accumulate result
   var longest int
   var list [][]byte
   for _, bs := range bss {
       // don't bother with words shorter than
       // our current longest ordered word
       if len(bs) < longest {
           continue
       }
       // check for ordered property
       var lastLetter byte
       for i := 0; ; i++ {
           if i == len(bs) {
               // end of word.  it's an ordered word.
               // save it and break from loop
               if len(bs) > longest {
                   longest = len(bs)
                   list = list[:0]
               }
               list = append(list, bs)
               break
           }
           // check next letter
           b := bs[i]
           if b < 'a' || b > 'z' {
               continue // not a letter.  ignore.
           }
           if b < lastLetter {
               break // word not ordered.
           }
           // letter passes test
           lastLetter = b
       }
   }
   // print result
   for _, bs := range list {
       fmt.Println(string(bs))
   }

} </lang> Output:

abbott
accent
accept
access
accost
almost
bellow
billow
biopsy
chilly
choosy
choppy
effort
floppy
glossy
knotty

Haskell

<lang haskell> -- Words are read from the standard input. We keep in memory only the current -- set of longest, ordered words. -- -- Limitation: the locale's collation order is not take into consideration.

isOrdered wws@(_:ws) = and $ zipWith (<=) wws ws

keepLongest _ acc [] = acc keepLongest max acc (w:ws) =

 let len = length w in 
 case compare len max of
   LT -> keepLongest max acc ws
   EQ -> keepLongest max (w:acc) ws
   GT -> keepLongest len [w] ws

longestOrderedWords = reverse . keepLongest 0 [] . filter isOrdered

main = do

 str <- getContents
 let ws = longestOrderedWords $ words str
 mapM_ putStrLn ws

</lang>

Output: <lang haskell> abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty </lang>

J

<lang j> require'web/gethttp'

  dict=: gethttp'http://www.puzzlers.org/pub/wordlists/unixdict.txt'
  oWords=: (#~ ] = /:~L:0) <;._2 dict-.CR
  ;:inv (#~ (= >./)@:(#@>))oWords

abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty</lang>

Recap:

  1. fetch dictionary (dict)
  2. break into words, one per line (<;._2 dict-.CR)
  3. find ordered words (oWords)
  4. select the longest ordered words ((#~ (= >./)@:(#@>))oWords)
  5. format for display (using ;:inv)

Java

Works with: Java version 1.5+

This example assumes there is a local copy of the dictionary whose paht is given as the first argument to the program. <lang java5>import java.io.BufferedReader; import java.io.FileReader; import java.io.IOException; import java.util.Arrays; import java.util.Collections; import java.util.Comparator; import java.util.LinkedList; import java.util.List;

public class Ordered {

private static boolean isOrderedWord(String word){ char[] sortedWord = word.toCharArray(); Arrays.sort(sortedWord); return word.equals(new String(sortedWord)); }

public static void main(String[] args) throws IOException{ List<String> orderedWords = new LinkedList<String>(); BufferedReader in = new BufferedReader(new FileReader(args[0])); while(in.ready()){ String word = in.readLine(); if(isOrderedWord(word)) orderedWords.add(word); } in.close();

Collections.<String>sort(orderedWords, new Comparator<String>() { @Override public int compare(String o1, String o2) { return new Integer(o2.length()).compareTo(o1.length()); } });

int maxLen = orderedWords.get(0).length(); for(String word: orderedWords){ if(word.length() == maxLen){ System.out.println(word); }else{ break; } } } }</lang> Output:

abbott
accent
accept
access
accost
almost
bellow
billow
biopsy
chilly
choosy
choppy
effort
floppy
glossy
knotty

JavaScript

This example is incomplete. Program output is not shown. Please ensure that it meets all task requirements and remove this message.

Using node.js:

<lang javascript>var fs = require('fs'), print = require('sys').print; fs.readFile('./unixdict.txt', 'ascii', function (err, data) {

   var is_ordered = function(word){return word.split().sort().join() === word;},
       ordered_words = data.split('\n').filter(is_ordered).sort(function(a, b){return a.length - b.length}).reverse(),
       longest = [], curr = len = ordered_words[0].length, lcv = 0;
   while (curr === len){
       longest.push(ordered_words[lcv]);
       curr = ordered_words[++lcv].length;
   };
   print(longest.sort().join(', ') + '\n');

});</lang>

Lua

<lang lua>fp = io.open( "dictionary.txt" )

maxlen = 0 list = {}

for w in fp:lines() do

   ordered = true
   for l = 2, string.len(w) do

if string.byte( w, l-1 ) > string.byte( w, l ) then ordered = false

 	    break

end

   end
   if ordered then

if string.len(w) > maxlen then list = {} list[1] = w maxlen = string.len(w) elseif string.len(w) == maxlen then list[#list+1] = w end

   end

end

for _, w in pairs(list) do

   print( w )

end

fp:close()</lang> Output:

abbott
accent
accept
access
accost
almost
bellow
billow
biopsy
chilly
choosy
choppy
effort
floppy
glossy
knotty

OCaml

<lang ocaml>let input_line_opt ic =

 try Some(input_line ic)
 with End_of_file -> None

(* load each line in a list *) let read_lines ic =

 let rec aux acc =
   match input_line_opt ic with
   | Some line -> aux (line :: acc)
   | None -> (List.rev acc)
 in
 aux []

let char_list_of_string str =

 let lst = ref [] in
 String.iter (fun c -> lst := c :: !lst) str;
 (List.rev !lst)

let is_ordered word =

 let rec aux = function
   | c1::c2::tl ->
       if (Pervasives.compare c1 c2) <= 0
       then aux (c2::tl)
       else false
   | c::[] -> true
   | [] -> true  (* should only occur with an empty string *)
 in
 aux (char_list_of_string word)

let longest_words words =

 let res, _ =
   List.fold_left
     (fun (lst, n) word ->
       let len = String.length word in
       let comp = Pervasives.compare len n in
       match lst, comp with
       | lst, 0 -> ((word::lst), n)  (* len = n *)
       | lst, -1 -> (lst, n)         (* len < n *)
       | _, 1 -> ((word::[]), len)   (* len > n *)
       | _ -> assert false
     )
     ([""], 0) words
 in
 (List.rev res)

let () =

 let ic = open_in "unixdict.txt" in
 let words = read_lines ic in
 let lower_words = List.rev_map String.lowercase words in
 let ordered_words =
   List.fold_left
     (fun acc w ->
       if is_ordered w
       then w::acc
       else acc)
     [] lower_words in
 let longest_ordered_words = longest_words ordered_words in
 List.iter print_endline longest_ordered_words</lang>
$ ocaml ordered_words.ml 
abbott
accent
accept
access
accost
almost
bellow
billow
biopsy
chilly
choosy
choppy
effort
floppy
glossy
knotty

Perl

<lang Perl>#!/usr/bin/perl use strict; use warnings;

open(FH, "<", "unixdict.txt") or die "Can't open file!\n"; my @words; while (<FH>) {

  chomp;
  push @{$words[length]}, $_ if $_ eq join("", sort split(//));

} close FH; print "@{$words[-1]}\n"; </lang> Output:

abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty

Perl 6

<lang Perl 6>my @words; my $maxlen = 0; for slurp("unixdict.txt").lines {

   if .chars >= $maxlen and [le] .comb {
       if .chars > $maxlen {
           @words = ();
           $maxlen = .chars;
       }
       push @words, $_;
   }

} say ~@words;</lang> Output:

abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty

PicoLisp

<lang PicoLisp>(in "unixdict.txt"

  (mapc prinl
     (maxi '((L) (length (car L)))
        (by length group
           (filter '((S) (apply <= S))
              (make (while (line) (link @))) ) ) ) ) )</lang>

Output:

abbott
accent
accept
access
accost
almost
bellow
billow
biopsy
chilly
choosy
choppy
effort
floppy
glossy
knotty

Prolog

Works with SWI-Prolog

<lang Prolog>:- use_module(library( http/http_open )).

ordered_words :-

       % we read the URL of the words

http_open('http://www.puzzlers.org/pub/wordlists/unixdict.txt', In, []), read_file(In, [], Out), close(In),

       % we get a list of pairs key-value where key = Length and value = <list-of-its-codes>
       % this list must be sorted

msort(Out, MOut),

group_pairs_by_key(MOut, POut),

      % we sorted this list in decreasing order of the length of values

predsort(my_compare, POut, [_N-V | _OutSort]), maplist(mwritef, V).


mwritef(V) :- writef('%s\n', [V]).

read_file(In, L, L1) :- read_line_to_codes(In, W), ( W == end_of_file ->

              % the file is read

L1 = L  ;

              % we sort the list of codes of the line

 % and keep only the "goods word" ( msort(W, W) -> length(W, N), L2 = [N-W | L], (len = 6 -> writef('%s\n', [W]); true)  ; L2 = L ),

              % and we have the pair Key-Value in the result list

read_file(In, L2, L1)).

% predicate for sorting list of pairs Key-Values % if the lentgh of values is the same % we sort the keys in alhabetic order my_compare(R, K1-_V1, K2-_V2) :- ( K1 < K2 -> R = >; K1 > K2 -> R = <; =). </lang> Output :

 ?- ordered_words.
abbott
accent
accept
access
accost
almost
bellow
billow
biopsy
chilly
choosy
choppy
effort
floppy
glossy
knotty
true.

PureBasic

<lang PureBasic>Procedure.s sortLetters(*word.Character, wordLength) ;returns a string with the letters of a word sorted

 Protected Dim letters.c(wordLength)
 Protected *letAdr = @letters()
 
 CopyMemoryString(*word, @*letAdr)
 SortArray(letters(), #PB_Sort_Ascending, 0, wordLength - 1)
 ProcedureReturn PeekS(@letters(), wordLength)

EndProcedure

Structure orderedWord

 word.s
 length.i

EndStructure

Define filename.s = "unixdict.txt", fileNum = 0, word.s

If OpenConsole()

 NewList orderedWords.orderedWord()
 If ReadFile(fileNum, filename)
   While Not Eof(fileNum)
     word = ReadString(fileNum)
     If word = sortLetters(@word, Len(word))
       AddElement(orderedWords())
       orderedWords()\word = word
       orderedWords()\length = Len(word)
     EndIf
   Wend
 EndIf
 SortStructuredList(orderedWords(), #PB_Sort_Ascending, OffsetOf(orderedWord\word), #PB_Sort_String)
 SortStructuredList(orderedWords(), #PB_Sort_Descending, OffsetOf(orderedWord\length), #PB_Sort_integer)
 Define maxLength
 FirstElement(orderedWords())
 maxLength = orderedWords()\length
 ForEach orderedWords()
   If orderedWords()\length = maxLength
     Print(orderedWords()\word + "  ")
   EndIf
 Next 
  
 Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
 CloseConsole()

EndIf</lang> Sample output:

abbott  accent  accept  access  accost  almost  bellow  billow  biopsy  chilly
choosy  choppy  effort  floppy  glossy  knotty

Python

<lang python>import urllib.request

url = 'http://www.puzzlers.org/pub/wordlists/unixdict.txt' words = urllib.request.urlopen(url).read().decode("utf-8").split() ordered = [word for word in words if word==.join(sorted(word))] maxlen = len(max(ordered, key=len)) maxorderedwords = [word for word in ordered if len(word) == maxlen] print(' '.join(maxorderedwords))</lang>

Alternate Solution <lang python>import urllib.request

mx, url = 0, 'http://www.puzzlers.org/pub/wordlists/unixdict.txt'

for word in urllib.request.urlopen(url).read().decode("utf-8").split():

   lenword = len(word)
   if lenword >= mx and word==.join(sorted(word)):
       if lenword > mx:
           words, mx = [], lenword
       words.append(word)

print(' '.join(words))</lang>

Sample Output

abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty

Ruby

<lang ruby> require 'open-uri' ordered_words = open('http://www.puzzlers.org/pub/wordlists/unixdict.txt', 'r').select do |word|

 word.chomp!
 word.split(  ).sort.join == word

end

grouped = ordered_words.group_by{ |word| word.size } puts grouped[grouped.keys.max] </lang>

Sample Output

abbott
accent
accept
access
accost
almost
bellow
billow
biopsy
chilly
choosy
choppy
effort
floppy
glossy
knotty

Scheme

The following implementation uses a char>=? procedure that accepts an arbitrary number of arguments. This is allowed, but not required, by R5RS, and is provided by many Scheme implementations.

<lang scheme> (define ordered-words

 (lambda (file)
   (let ((port (open-input-file file)))
     (let loop ((char (read-char port))
                (word '())
                (result '(())))
       (cond ((eof-object? char)
              (reverse (map (lambda (word) (apply string word)) result)))
             ((eq? #\newline char)
              (loop (read-char port) '()
                    (let ((best-length (length (car result)))
                          (word-length (length word)))
                      (cond ((or (< word-length best-length)
                                 (not (apply char>=? word)))
                             result)
                            ((> word-length best-length)
                             (list (reverse word)))
                            (else
                             (cons (reverse word) result))))))
             (else
              (loop (read-char port) (cons char word) result)))))))

</lang>

Tcl

<lang tcl>package require http

  1. Pick the ordered words (of maximal length) from a list

proc chooseOrderedWords list {

   set len 0
   foreach word $list {

# Condition to determine whether a word is ordered; are its characters # in sorted order? if {$word eq [join [lsort [split $word ""]] ""]} { if {[string length $word] > $len} { set len [string length $word] set orderedOfMaxLen {} } if {[string length $word] == $len} { lappend orderedOfMaxLen $word } }

   }
   return $orderedOfMaxLen

}

  1. Get the dictionary and print the ordered words from it

set t [http::geturl "http://www.puzzlers.org/pub/wordlists/unixdict.txt"] puts [chooseOrderedWords [http::data $t]] http::cleanup $t</lang> Output:

abbott accent accept access accost almost bellow billow biopsy chilly choosy choppy effort floppy glossy knotty

TUSCRIPT

<lang tuscript> $$ MODE TUSCRIPT SET data = REQUEST ("http://www.puzzlers.org/pub/wordlists/unixdict.txt") DICT orderdwords CREATE 99999 COMPILE LOOP word=data

- "<%" = any token
SET letters=STRINGS (word,":<%:")
SET wordsignatur= ALPHA_SORT (letters)
IF (wordsignatur==letters) THEN
 SET wordlength=LENGTH (word)
 DICT orderdwords ADD/COUNT word,num,cnt,wordlength
ENDIF

ENDLOOP

DICT orderdwords UNLOAD words,num,cnt,wordlength SET maxlength=MAX_LENGTH (words) SET rtable=QUOTES (maxlength) BUILD R_TABLE maxlength = rtable SET index=FILTER_INDEX (wordlength,maxlength,-) SET longestwords=SELECT (words,#index) PRINT num," ordered words - max length is ",maxlength,":"

LOOP n,w=longestwords SET n=CONCAT (n,"."), n=CENTER(n,4) PRINT n,w ENDLOOP ENDCOMPILE </lang> Output:

422 ordered words - max length is 6:
 1. abbott
 2. accent
 3. accept
 4. access
 5. accost
 6. almost
 7. bellow
 8. billow
 9. biopsy
10. chilly
11. choosy
12. choppy
13. effort
14. floppy
15. glossy
16. knotty