Cómo evitar la explosión cuadrática de instancias de clase de tipo?

Question

considerar:

{-# OPTIONS -fglasgow-exts #-} 

data Second = Second 
data Minute = Minute 
data Hour = Hour 

-- Look Ma', a phantom type! 
data Time a = Time Int 

instance Show (Time Second) where 
    show (Time t) = show t ++ "sec" 

instance Show (Time Minute) where 
    show (Time t) = show t ++ "min" 

instance Show (Time Hour) where 
    show (Time t) = show t ++ "hrs" 

sec :: Int -> Time Second 
sec t = Time t 

minute :: Int -> Time Minute 
minute t = Time t 

hour :: Int -> Time Hour 
hour t = Time t 

class TimeAdder a b c | a b -> c where 
    add :: Time a -> Time b -> Time c 

instance TimeAdder Second Second Second where 
    add (Time s1) (Time s2) = sec (s1 + s2) 

instance TimeAdder Second Minute Second where 
    add (Time s) (Time m) = sec (s + 60*m) 

instance TimeAdder Second Hour Second where 
    add (Time s) (Time h) = sec (s + 3600*h) 

instance TimeAdder Minute Second Second where 
    add (Time m) (Time s) = sec (60*m + s) 

instance TimeAdder Minute Minute Minute where 
    add (Time m1) (Time m2) = minute (m1 + m2) 

instance TimeAdder Minute Hour Minute where 
    add (Time m) (Time h) = minute (m + 60*h) 

instance TimeAdder Hour Second Second where 
    add (Time h) (Time s) = sec (3600*h + s) 

instance TimeAdder Hour Minute Minute where 
    add (Time h) (Time m) = minute (60*h + m) 

instance TimeAdder Hour Hour Hour where 
    add (Time h1) (Time h2) = hour (h1 + h2) 

add (minute 5) (hour 2) 
--125min 

Aunque estoy muy emocionado de que cosas locas como esto funciona, me pregunto cómo se podría evitar la explosión cuadrática de TimeAdder casos.

Answer 1

Podría hacer algo como esto, pero no le da la dependencia funcional.

class TimeUnit a where 
    toSeconds :: a -> Int 
    fromSeconds :: Int -> a 

instance TimeUnit (Time Second) where toSeconds = id; fromSeconds = id 
instance TimeUnit (Time Minute) where toSeconds = (* 60); fromSeconds = (`quot` 60) 

class TimeAdd a b c where 
    add :: a -> b -> c 

instance (TimeUnit a, TimeUnit b, TimeUnit c) => TimeAdd a b c where 
    add a b = fromSeconds (toSeconds a + toSeconds b) 

Answer 2

A menos que tenga una buena razón para, me acaba de saltar las clases de tipos y el uso de una llanura de edad ADT:

data Time = Hour Int | Minute Int | Second Int 

instance Show Time where 
    show (Hour x) = show x ++ "hrs" 
    show (Minute x) = show x ++ "min" 
    show (Second x) = show x ++ "sec" 

add x y = fromSeconds (toSeconds x + toSeconds y) 

toSeconds (Hour x) = 3600 * x 
toSeconds (Minute x) = 60 * x 
toSeconds (Second x) = x 

fromSeconds x | mod x 3600 == 0 = Hour (div x 3600) 
       | mod x 60 == 0 = Minute (div x 60) 
       | otherwise = Second x 

Esto tiene la ventaja de ser capaz de hacer ciertas simplificaciones que el enfoque de clase tipo puede 't, por ejemplo:

> add (Second 18) (Second 42) 
1min 

Answer 3

Las instancias son bastante repetitivas. Yo diría que este es un caso para Template Haskell (aunque dejaré la explicación de cómo hacerlo a alguien que lo haya usado con ira).

Answer 4

Tomando la sugerencia de hammar 1 paso más allá, diría que para este ejemplo en particular, solo elimine el tipo de cosas por completo, y use constructores inteligentes en su lugar.

newtype Time = Sec Int 

instance Show Time where 
    show (Sec n) = h ++ " hrs " ++ m ++ " min " ++ s ++ " sec" 
    where h = ... 
      m = ... 
      s = ... 

sec :: Int -> Time 
sec = Sec 

min :: Int -> Time 
min = sec . (*60) 

hr :: Int -> Time 
hr = min . (*60) 

add (Sec n) (Sec m) = Sec (n+m) 

Por supuesto, eso no es divertido, ya que no tiene ningún tipo de fantasma. Ejercicio divertido: hacer lentes para hr, min, sec.

Answer 5

La forma en que haría esto en el tipo de campo es mapear los tipos fantasma para escribir números naturales de nivel y usar una operación "mínima" para encontrar el tipo de devolución correcto y luego dejar que la resolución de instancia haga el trabajo a partir de ahí.

Usaré familias de tipos aquí, pero probablemente se puede hacer con dependencias funcionales si las prefiere.

{-# LANGUAGE TypeFamilies, EmptyDataDecls, FlexibleInstances #-} 

En primer lugar, necesitaremos algunos elementos naturales de nivel y una operación mínima.

data Zero 
data Succ n 

type family Min a b 
type instance Min Zero a = Zero 
type instance Min a Zero = Zero 
type instance Min (Succ a) (Succ b) = Succ (Min a b) 

A continuación, vamos a definir nuestros tipos de fantasmas y proporcionar asignaciones desde y hacia nuestros productos naturales nivel de tipo:

data Second 
data Minute 
data Hour 

type family ToIndex a 
type instance ToIndex Hour = Succ (Succ Zero) 
type instance ToIndex Minute = Succ Zero 
type instance ToIndex Second = Zero 

type family FromIndex a 
type instance FromIndex (Succ (Succ Zero)) = Hour 
type instance FromIndex (Succ Zero) = Minute 
type instance FromIndex Zero = Second 

A continuación, el tipo y TimeShow casos. Estos son los mismos que en tu código original.

data Time a = Time Int 

instance Show (Time Second) where 
    show (Time t) = show t ++ "sec" 

instance Show (Time Minute) where 
    show (Time t) = show t ++ "min" 

instance Show (Time Hour) where 
    show (Time t) = show t ++ "hrs" 

sec :: Int -> Time Second 
sec t = Time t 

minute :: Int -> Time Minute 
minute t = Time t 

hour :: Int -> Time Hour 
hour t = Time t 

Al igual que en mi respuesta ADT, usaremos segundo como la unidad intermedia:

class Seconds a where 
    toSeconds :: Time a -> Int 
    fromSeconds :: Int -> Time a 

instance Seconds Hour where 
    toSeconds (Time x) = 3600 * x 
    fromSeconds x = Time $ x `div` 3600 

instance Seconds Minute where 
    toSeconds (Time x) = 60 * x 
    fromSeconds x = Time $ x `div` 60 

instance Seconds Second where 
    toSeconds (Time x) = x 
    fromSeconds x = Time x 

Ahora todo lo que queda es definir la función add.

add :: (Seconds a, Seconds b, Seconds c, 
     c ~ FromIndex (Min (ToIndex a) (ToIndex b))) 
     => Time a -> Time b -> Time c 
add x y = fromSeconds (toSeconds x + toSeconds y) 

La magia sucede en la restricción de tipo igualdad, que se asegura de que se elige el tipo de retorno correcta.

Este código se puede utilizar igual que tú querías:

> add (minute 5) (hour 2) 
125min 

Para añadir otra unidad, por ejemplo Days, es suficiente con añadir instancias de Show, FromIndex, ToIndex y Seconds, es decir, hemos evitado con éxito la explosión cuadrática

Answer 6

La primera parte no se puede hacer de esta manera en Haskell 2010, debido a la restricción sobre los tipos instanciados es que sean de la forma

T t1 ... tn 

donde t1 ... tn son diferentes variables de tipo y que no hay a lo sumo una instancia pro tipo y clase. En Frege, mientras que las restricciones en la forma del tipo se levantan un poco, la restricción crucial sigue siendo a lo sumo una instancia por clase y tipoconstructor. Aquí es una manera de hacer el show-Parte, sin embargo:

module Test where 

data Seconds = Seconds 
data Minutes = Minutes 
data Hours = Hours 

data Time u = Time Int 

class TimeUnit u where 
    verbose :: u -> String 
    fromTime :: Time u -> u 

instance TimeUnit Seconds where 
    verbose _ = "sec" 
    fromTime _ = Seconds 
instance TimeUnit Minutes where 
    verbose _ = "min" 
    fromTime _ = Minutes 
instance TimeUnit Hours where 
    verbose _ = "hrs" 
    fromTime _ = Hours 

instance Show (TimeUnit u) => Time u where 
    show (o@Time t) = t.show ++ verbose (fromTime o) 

main _ = do 
println (Time 42 :: Time Seconds) 
println (Time 42 :: Time Minutes) 
println (Time 42 :: Time Hours) 

La aplicación fromTime obliga al sitio de llamada a construir un diccionario adecuado, de manera que un valor TimeUnit puede hacerse ex nihilo, o al menos eso parece.

Se podría utilizar la misma técnica para hacer la aritmética entre diferentes tipos de Tiempo, creando un factor que haga cálculos en la unidad más pequeña posible.