Mapas de calor

Considere una habitación rectangular, en cuyo techo tenemos una cámara térmica apuntando hacia abajo. En la habitación, hay algunas fuentes de intensidad de calor1-9 , siendo la temperatura de fondo 0. El calor se disipa de cada fuente, cayendo en una unidad por paso (no diagonal). Por ejemplo, la 20x10sala

...........1........
....................
...8................
..5...............2.
....................
.1..................
................1...
.................65.
....................
............2.......

contiene 9 fuentes de calor, y el gradiente de temperatura que muestra la cámara térmica es

34565432100100000000
45676543210000000000
56787654321000000110
45676543210000001221
34565432100000012321
23454321000000123432
12343210000001234543
01232100000012345654
00121000000011234543
00010000000121123432

En forma gráfica, esto podría verse así:

A partir del gradiente, podemos inferir las posiciones e intensidades de algunas fuentes de calor, pero no todas. Por ejemplo, todos los 9s siempre se pueden inferir, ya que tienen la temperatura máxima, y ​​también pueden hacerlo 8en este caso, ya que produce un máximo local en el gradiente. El 2borde cercano a la derecha también se puede inferir, aunque no esté en un máximo local, ya que no tiene otro 2como vecino. Los 5s, por otro lado, no se infieren, ya que su calor también podría ser producido por las fuentes más intensas cercanas a ellos. Los 0son conocidos s para contener no hay fuentes de calor, pero todos los otros azulejos pueden potencialmente contener uno. Denotemos los mosaicos inciertos por guiones-, ciertas fuentes de calor por los dígitos correspondientes y cierto espacio vacío por períodos .:

---------..1........
----------..........
---8-------......--.
----------......--2-
---------......-----
--------......------
-------......-------
.-----......-----6--
..---.......--------
...-.......-2-------

Su tarea será producir este patrón inferido a partir del gradiente de temperatura.

Reglas

Se le da la entrada como una cadena delimitada por líneas nuevas o tuberías verticales |, lo que sea más conveniente, y la salida será de la misma forma. Puede haber un delimitador final en la entrada y / o salida, pero ninguno precedente. El tamaño de la entrada puede variar, pero su ancho y alto siempre son al menos 4. Ambas funciones y programas completos son aceptables. El conteo de bytes más bajo gana, y las lagunas estándar están prohibidas.

Casos de prueba adicionales

Entrada:

898778765432100
787667654321100
677656543211210
678765432112321
567654321123210

que se ve así en forma gráfica:

Salida:

-9---8-------..
-------------..
--------------.
--8---------3--
-----------3--.

Entrada:

7898
8787
7676
6565

Salida:

--9-
8---
----
----

Entrada:

00001
00000
00000
10000

Salida:

....1
.....
.....
1....

CJam, 73 69 62 55 bytes

ACTUALIZACIÓN : Nuevo algoritmo. Menor y mayor margen de mejora

qN/5ff*{{[{_@_@<{I'0t}*\}*]W%}%z}4fI{):X-'-X~X'.??}f%N*

Cómo funciona

La lógica es similar al algoritmo a continuación, pero aquí no estoy verificando los 4 vecinos en una sola iteración. En cambio, utilizo un enfoque más pequeño para recorrer en iteración todas las filas y columnas en ambas direcciones. Aquí están los pasos involucrados:

• Convierta cada carácter en conjuntos de 5. Los primeros 4 se modificarán para indicar si son más grandes que la celda adyacente en la fila mientras se itera. El último es para fines de comparación.
• Iterar en cada fila y reducir en cada fila. Mientras reduzco, tengo dos cadenas de 5 caracteres. Sé qué tipo de iteración es [0 para filas normales, 1 columnas invertidas, 2 para filas invertidas y 3 para columnas normales] Actualizo el i- ^ésimo carácter en la primera cadena de 5 caracteres y lo hago 0 si es más pequeño que el segundo .
• Después de las 4 iteraciones, si los 5 caracteres son iguales y no son cero, ese es el máximo local. Mapeo a través de las cadenas de 5 caracteres y las convierto en un solo dígito .o -.

Aquí hay un ejemplo ejecutado en una pequeña entrada:

7898
8787
7676
6565

Después del primer paso:

["77777" "88888" "99999" "88888"
 "88888" "77777" "88888" "77777"
 "77777" "66666" "77777" "66666"
 "66666" "55555" "66666" "55555"]

Después del segundo paso:

["00777" "08888" "99999" "88088"
 "88888" "07007" "88808" "77007"
 "77707" "06006" "77707" "66006"
 "66606" "05005" "66606" "55005"]

Después de la última asignación a un solo carácter, salida final:

--9-
8---
----
----

Explicación del código :

qN/5ff*                         "Split the input on new line and convert each character";
                                "to string of 5 of those characters.";
{{[{             }*]W%}%z}4fI   "This code block runs 4 times. In each iteration, it";
                                "maps over each row/column and then for each of them,";
                                "It reduce over all elements of the row/column";
                                "Using combination of W% and z ensures that both rows and";
                                "columns are covered and in both directions while reducing";
    _@_@                        "Take a copy of last two elements while reducing over";
        <                       "If the last element is bigger than second last:";
         {I'0t}*\               "Convert the Ith character of the 5 char string of"
                                "second last element to 0";
                                "We don't have to compare Ith character of last two 5 char";
                                "string as the smaller one will be having more leading";
                                "0 anyways. This saves 4 bytes while comparing elements";
{):X-'-X~X'.??}f%N*             "This part of code converts the 5 char back to single char";
 ):X                            "Remove the last character and store in X. This last char";
                                "was not touched in the prev. loop, so is the original char";
    -                           "Subtract X from remaining 4 char. If string is not empty";
                                "then it means that it was not all same characters";
                                "In other words, this character was smaller then neighbors";
     '-      ?                  "If non-empty, then replace with - else ...";
       X~X'.?                   "if int(X) is zero, put . else put X";
               f%N*             "The mapping code block was run for each row and then";
                                "The rows are joined by newline.";

Pruébalo aquí

Enfoque anterior

qN/~_,):L0s*]0s*:Q_,{QI=:A[W1LL~)]If+Qf=$W=<'-A?A~\'.?I\t}fIL/W<Wf<N*

Cómo funciona

La lógica es simple, iterar a través de la cuadrícula y ver si el valor actual es mayor o igual a los cuatro vecinos restantes: arriba, abajo, izquierda y derecha. Luego, transforme el valor actual según la regla anterior y si el valor es igual a 0, hágalo "." .

Explicación del código

qN/~_,):L0s*]0s*:Q         "This part of code pads the grid with 0s";
qN/~                       "Read the input, split on new lines and unwrap the arrays";
    _,):L                  "Copy the last row, taken length, increment and store in L";
         0s*               "Get L length 0 string";
            ]0s*           "Wrap everything in an array and join the rows by 0";
                :Q         "Store this final single string in Q";

_,{        ...      }fI    "Copy Q and take length. For I in 0..length, execute block";
   QI=:A                   "Get the I'th element from Q and store in A";
   [WiLL~)]If+             "This creates indexes of all 4 neighboring cells to the Ith cell";
              Qf=          "Get all 4 values on the above 4 indexes";
                 $W=       "Sort and get the maximum value";
<'-A?                      "If the current value is not the largest, convert it to -";
     A~\'.?                "If current value is 0, convert it to .";
           I\t             "Update the current value back in the string";
{ ... }fIL/                "After the loop, split the resulting string into chunks of L";
           W<Wf<           "Remove last row and last column";
                N*         "Join by new line and auto print";

Pruébalo en línea aquí

JavaScript (ES6) 99

F=h=>[...h].map((c,i)=>[o=~h.search('\n'),-o,1,-1].some(d=>h[d+i]>c)&c>0?'-':c=='0'?'.':c).join('')

Prueba en la consola Firefox / FireBug

console.log(F('\
34565432100100000000\n\
45676543210000000000\n\
56787654321000000110\n\
45676543210000001221\n\
34565432100000012321\n\
23454321000000123432\n\
12343210000001234543\n\
01232100000012345654\n\
00121000000011234543\n\
00010000000121123432\n'),'\n\n',
F('\
898778765432100\n\
787667654321100\n\
677656543211210\n\
678765432112321\n\
567654321123210\n'), '\n\n',
F('7898\n8787\n7676\n6565\n'))

Salida

---------..1........
----------..........
---8-------......--.
----------......--2-
---------......-----
--------......------
-------......-------
.-----......-----6--
..---.......--------
...-.......-2-------


-9---8-------..
-------------..
--------------.
--8---------3--
-----------3--.


--9-
8---
----
----

Python 2: 154 bytes

b=input()
l=b.index('\n')+1
print''.join(('\n.'+('-'+v)[all([v>=b[j]for j in i-l,i-1,i+l,i+1if 0<=j<len(b)])])[('\n0'+v).index(v)]for i,v in enumerate(b))

La entrada tiene que ser de la forma "00001\n00000\n00000\n10000".

La conversión de una cadena a una matriz 2D es bastante larga en Python. Así que mantengo el formato de cadena original. Enumero sobre la entrada, ies el índice, ves el carácter (¡Finalmente enumero los bytes guardados en una solución de golf!). Para cada par (i,v)calculo el carácter correcto de salida, y los uno. ¿Cómo elijo el carácter de salida correcto? Si v == '\n', el carácter de salida es \n, it v == '0', que el carácter de salida es '.'. De lo contrario, pruebo los 4 vecinos de v, que están b[i-b.index('\n')-1](arriba), b[i-1](izquierda, b[i+1](derecha) y b[i+b.index('\n')+1](debajo), si lo están, <= vy elijo el carácter '-'ov. Aquí estoy comparando los caracteres, no los números, pero funciona bastante bien, porque los valores ascii están en el orden correcto. Además, no hay problemas, si b[i-1]o b[i+1]igual '\n', porque ord('\n') = 10.

Pyth: 61 58

JhxQbVQK@QN~k@++b\.?\-f&&gT0<TlQ<K@QT[tNhN-NJ+NJ)Kx+b\0K)k

Más o menos una traducción del script Python. Bastante feo ;-)

Pruébelo en línea: Pyth Compiler / Executor El mismo formato de entrada que la solución Python.

JhxQb      Q = input()
  xQb      Q.index('\n')
 h         +1
J          store in J

VQK@QN~k.....)k   k is initialized as empty string
VQ           )    for N in [0, 1, 2, ..., len(Q)-1]:
  K@QN                K = Q[n]
      ~k              k += ... (a char, computed in the next paragraph)
             )    end for
              k   print k

@...x+b\0K   ... is a char of len 3 (is constructed below)
     +b\0    the string "\n0"
    x    K   find Q[d] in this string and return index, if not found -1
@...         lookup in string at the computed position (this is done mod 3 automatically!)

++b\.?\-f&&gT0<TlQ<K@QT[tNhN-NJ+NJ)K   not to the string
                       [tNhN-NJ+NJ)    the list [d-1, d+1, d-J, d+j]
        f                              filter the list for indices T which
           gT0                            T >= 0
          &                               and
              <TlQ                        T < len(Q)
         &                                and
                  <K@QT                   Q[d] < Q[T]
     ?\-                           K   use "-" if len(filter) > 0 else Q[d]
                                       this creates the third char
++b\.                                  "\n" + "." + third char

Perl, 77, 75, 72 70

Trucos de coincidencia de expresiones regulares 2d estándar.

#!perl -p0
/
/;$x="(.{@-})?";y/0/./while s/$.$x\K$"|$"(?=$x$.)/-/s||($"=$.++)<9

Ejemplo:

$ perl heat.pl <in.txt
---------..1........
----------..........
---8-------......--.
----------......--2-
---------......-----
--------......------
-------......-------
.-----......-----6--
..---.......--------
...-.......-2-------

Pruébalo aquí

Java, 307 , 304 , 303 , 299 298

Este es sin duda un desafío "perfecto" para algunos codegolf de Java :)

class M{public static void main(String[]a){int c=a[0].indexOf('|'),i=c,d,v;char[]r=a[0].replace("|","").toCharArray(),m=new char[(v=r.length+c)+c];for(;i<v;){m[i]=r[i++-c];}for(i=c;i<v;i++){a[0]=i%c<1?"\n":"";d=m[i];System.out.print(a[0]+(d<49?'.':m[i-c]>d|m[i+c]>d|m[i-1]>d|m[i+1]>d?'-':m[i]));}}}

Entrada (método de tubería '|'):

34565432100100000000|45676543210000000000|56787654321000000110|45676543210000001221|34565432100000012321|23454321000000123432|12343210000001234543|01232100000012345654|00121000000011234543|00010000000121123432

Salida:

---------..1........
----------..........
---8-------......--.
----------......--2-
---------......-----
--------......------
-------......-------
.-----......-----6--
..---.......--------
...-.......-2-------

APL, 92

('.-',⎕D)[1+(M≠0)+M{(1+⍺)×0≠⍺∧M[J/⍨Z∊⍨J←⍵∘+¨(⌽¨,+)(-,+)⊂0 1]∧.≤⍺}¨Z←⍳⍴M←↑{×⍴⍵:(⊂⍎¨⍵),∇⍞⋄⍬}⍞]

Ejemplo:

       ('.-',⎕D)[1+(M≠0)+M{(1+⍺)×0≠⍺∧M[J/⍨Z∊⍨J←⍵∘+¨(⌽¨,+)(-,+)⊂0 1]∧.≤⍺}¨Z←⍳⍴M←↑{×⍴⍵:(⊂⍎¨⍵),∇⍞⋄⍬}⍞]
34565432100100000000
45676543210000000000
56787654321000000110
45676543210000001221
34565432100000012321
23454321000000123432
12343210000001234543
01232100000012345654
00121000000011234543
00010000000121123432

---------..1........
----------..........
---8-------......--.
----------......--2-
---------......-----
--------......------
-------......-------
.-----......-----6--
..---.......--------
...-.......-2-------

Rubí 140

f=->s{
r=s.dup
l=s.index(?\n)+1
(0...s.size).map{|i|
s[i]<?0||r[i]=r[i]<?1??.:[i-1,i+1,i-l,i+l].map{|n|n<0??0:s[n]||?0}.max>r[i]??-:s[i]}
r}

Nada especial; solo recorra el mapa y compare el valor actual con el valor de los cuatro vecinos.

Ejecútelo en línea con pruebas: http://ideone.com/AQkOSY

R, 223

Sobre lo mejor que puedo encontrar en este momento. Tratar con la cuerda es bastante costoso. Creo que hay margen de mejora, pero no puedo verlo en este momento.

s=strsplit;a=c(m<-do.call(rbind,s(s(scan(w="c"),'|',T)[[1]],'')));w=(d<-dim(m))[1];n=c(-1,1,-w,w);cat(t(array(sapply(seq(a),function(x)if(a[x]>0)if(any(a[(n+x)[which(n+x>0)]]>a[x]))'-'else a[x]else'.'),d)),fill=d[2],sep='')

Resultado de la prueba

> s=strsplit;a=c(m<-do.call(rbind,s(s(scan(w="c"),'|',T)[[1]],'')));w=(d<-dim(m))[1];n=c(-1,1,-w,w);cat(t(array(sapply(seq(a),function(x)if(a[x]>0)if(any(a[(n+x)[which(n+x>0)]]>a[x]))'-'else a[x]else'.'),d)),fill=d[2],sep='')
1: 898778765432100|787667654321100|677656543211210|678765432112321|567654321123210
2: 
Read 1 item
-9---8-------..
-------------..
--------------.
--8---------3--
-----------3--.
> s=strsplit;a=c(m<-do.call(rbind,s(s(scan(w="c"),'|',T)[[1]],'')));w=(d<-dim(m))[1];n=c(-1,1,-w,w);cat(t(array(sapply(seq(a),function(x)if(a[x]>0)if(any(a[(n+x)[which(n+x>0)]]>a[x]))'-'else a[x]else'.'),d)),fill=d[2],sep='')
1: 34565432100100000000|45676543210000000000|56787654321000000110|45676543210000001221|34565432100000012321|23454321000000123432|12343210000001234543|01232100000012345654|00121000000011234543|00010000000121123432
2: 
Read 1 item
---------..1........
----------..........
---8-------......--.
----------......--2-
---------......-----
--------......------
-------......-------
.-----......-----6--
..---.......--------
...-.......-2-------
> 

J - 69 bytes

[:u:45+[:(+2 0 3{~"#1+*)@((]*]=(0,(,-)1 0,:0 1)>./@:|.])-0=])"."0;._2

Ejemplos:

   ([:u:45+[:(+2 0 3{~"#1+*)@((]*]=(0,(,-)1 0,:0 1)>./@:|.])-0=])"."0;._2) (0 : 0)
34565432100100000000
45676543210000000000
56787654321000000110
45676543210000001221
34565432100000012321
23454321000000123432
12343210000001234543
01232100000012345654
00121000000011234543
00010000000121123432
)
---------..1........
----------..........
---8-------......--.
----------......--2-
---------......-----
--------......------
-------......-------
.-----......-----6--
..---.......--------
...-.......-2-------
   ([:u:45+[:(+2 0 3{~"#1+*)@((]*]=(0,(,-)1 0,:0 1)>./@:|.])-0=])"."0;._2) (0 : 0)
898778765432100
787667654321100
677656543211210
678765432112321
567654321123210
)
-9---8-------..
-------------..
--------------.
--8---------3--
-----------3--.

PD: (0 : 0)es la forma J estándar de especificar cadenas. También podría usar |cadenas delimitadas (con un final |).

Excel VBA - 426

Será una rara ocasión en que VBA gane cualquier código de juegos de golf, pero como es lo que más uso, es divertido jugar con él. La primera línea es un caso extremo que hizo que esto fuera más largo de lo que parece que debería ser.

Sub m(a)
    b = InStr(a, "|")
    For i = 1 To Len(a)
        t = Mid(a, i, 1)
        Select Case t
            Case "|"
                r = r & "|"
            Case 0
                r = r & "."
            Case Else
                On Error Resume Next
                x = Mid(a, i - 1, 1)
                y = Mid(a, i + 1, 1)
                Z = Mid(a, i + b, 1)
                If i < b Then
                    If t < x Or t < y Or t < Z Then
                        r = r & "-"
                    Else
                        r = r & t
                    End If
                Else
                    If t < x Or t < y Or t < Z Or t < Mid(a, i - b, 1) Then
                        r = r & "-"
                    Else
                        r = r & t
                    End If
                End If
        End Select
    Next
    MsgBox r
End Sub

El recuento no incluye el espacio en blanco de la línea inicial.

Jugué con la idea de enviar la entrada a una hoja y trabajar desde allí, pero creo que el bucle de la cadena aprobada carácter por carácter guarda el código.

Llamar desde la ventana inmediata:

m "34565432100100000000|45676543210000000000|56787654321000000110|45676543210000001221|34565432100000012321|23454321000000123432|12343210000001234543|01232100000012345654|00121000000011234543|00010000000121123432"

Salida (en una ventana):

---------..1........|----------..........|---8-------......--.|----------......--2-|---------......-----|--------......------|-------......-------|.-----......-----6--|..---.......--------|...-.......-2-------

Perl - 226

sub f{for(split'
',$_[0]){chomp;push@r,r($_);}for(t(@r)){push@y,r($_)=~s/0/./gr}$,=$/;say t(@y);}sub r{$_[0]=~s/(?<=(.))?(.)(?=(.))?/$1<=$2&&$3<=$2?$2:$2eq'0'?0:"-"/ger;}sub t{@q=();for(@_){for(split//){$q[$i++].=$_;}$i=0;}@q}

Puedes probarlo en ideone . Si alguien está interesado en una explicación, hágamelo saber.

Haskell - 193

z='0'
r=repeat z
g s=zipWith3(\u t d->zip3(zip(z:t)u)t$zip(tail t++[z])d)(r:s)s$tail s++[r]
f=unlines.map(map(\((l,u),t,(r,d))->case()of _|t==z->'.'|maximum[u,l,t,r,d]==t->t|0<1->'-')).g.lines

fes una función que toma una cadena en el formulario 0001\n0000\n0000\n1000y devuelve la cadena requerida.

g es una función que toma una lista de listas de caracteres y devuelve una lista de listas de ((izquierda, arriba), esto, (derecha, abajo)).