Ordenamiento por el método de la burbuja

: mybounds  over + swap ;

6000 constant elements ( -- int)

: verify-list ( -- )
  list elements 1- cells mybounds do
    i 2@ >
 if ." bubble-sort: not sorted" abort then
  cell +loop
;

: bubble ( -- )
." bubbling..." cr
  1 elements 1 do
    list elements i - cells mybounds do
      i 2@ > if i 2@ swap i 2! then
    cell +loop
  loop
;

: bubble-sort ( -- )
  bubble
  verify-list
;

: main ( -- )
 bubble-sort
;

bubble_sort(Xs, Ys):-
  append(Ws, [A,B|Zs], Xs),
  B < A,
  append(Ws, [B,A|Zs], Vs),
  bubble_sort(Vs, Ys), !.
bubble_sort(Xs, Xs).

append([], Ys, Ys).
append([X|Xs], Ys, [X|Zs]):-append(Xs, Ys, Zs).

function bubble_sort(sequence x)
object temp
integer flip, limit

    flip = length(x)
  while flip > 0 do
       limit = flip
       flip = 0
      for i = 1 to limit - 1 do
          if compare(x[i+1], x[i]) < 0 then
                temp = x[i+1]
                x[i+1] = x[i]
                x[i] = temp
                flip = i
         end if
       end for
  end while
  return x
end function

Otro ejemplo de las bondades de Euphoria.

-- obtiene la edad actual de un individuo, dada su fecha de nacimiento

function edad(integer dia, integer mes, integer anio)

sequence ahora, nacido, anios

  nacido = anio & mes & dia    -- Se configura una secuencia adecuada
  nacido[1] -= 1900

  ahora = date()             -- Se obtiene la fecha actual del sistema
  ahora = ahora[1..3]

  anios = ahora - nacido      -- Se restan ambos datos

  if anios[2] > 0 then       -- Si el mes actual es mayor que el de nacimiento ...
     return anios[1]         -- ... se devuelve el dato del año
  elsif anios[2] = 0 and anios[3] >= 0 then  -- Si es el mes correcto y el dia es igual o
                                                -- superior al de nacimiento ...
     return anios[1]         -- ... se devuelve el dato del año
  else
     return anios[1] - 1      -- En caso contrario, aún no ha cumplido
  end if

end function

puts(1, "Tiene los siguientes a¤os: ")   -- La 'ñ' es la del código ASCII
printf(1, "%d", edad(19, 5, 1969))
 
 

Otro más

-- El objetivo de esta función es obtener el menor elemento de una secuencia,
-- (formada por secuencias de estructura regular), indicando mediante el
-- parámetro DATO por cual elemento de dicha estructura buscar.

include wildcard.e
include get.e

integer VOID

function Menor(sequence lista, integer DATO)

   integer indice
           indice = 1

   if compare(lista, {}) = 0 then
     return({})
   end if

   for i = 2 to length(lista) do
     if compare(lista[indice][DATO], lista[i][DATO]) = 1 then
        indice = i
     end if
   end for

   return {lista[indice]}

end function

puts(1, "\n Menor({{b,5,3,{'caramba'}}, {e,3,6,{}}, {g,4,1,{'cara'}}}, 3)\n")
pretty_print(1, Menor({{'b',5,3,{"caramba"}}, {'e',3,6,{}}, {'g',4,1,{"cara"}}}, 3), {3})
VOID = wait_key()