QUIZZZZZZZZ - Grattacieli

[Marius44]

Buon pomeriggio a tutti
Qualche giorno fa è stata avanzata richiesta a Anthony (vedasi questa discussione) di trastullarci con quiz, rebus, giochi e quant'altro.

Sommessamente avrei una proposta: il gioco dei Grattacieli.
Molti lo conosceranno già, molti sapranno trovare le soluzioni più disparate, molti non vorranno neppure provare.
In buona sostanza il gioco consiste un quadrato 4 x 4 oppure 5 x 5 e così via (all'incremento del numero aumentano le difficoltà) ai cui lati (all'esterno) sono evidenziati dei numeri. Dette cifre indicano il numero di grattacieli che è possibile "vedere" da quella posizione di vedetta. I Grattacieli sono di misura standard a 10, 20, 30 o 40 piani e possono stare in una riga o in una colonna solo 1 volta. Ovvio che se ho davanti un grattacielo di 40 piani non posso vedere cosa c'è dietro; se ho un grattacielo di 20 piani e appresso uno di 30 ne potrò vedere due. E così via.
State certi, comunque, che la soluzione all'apparenza facile non è poi così scontata.

In un gioco "serio" ci sarebbe stata una macro che, all'apertura, cambia i numeri nelle caselle grigie ma la mia richiesta principale - forse sarebbe stato meglio postarla in altra sezione, ma ero indeciso tra Excel in generale e Excel e macro - è la seguente:
- sarebbe possibile trovare una soluzione SOLO con le Formule?
- sarebbe possibile trovare una soluzione SOLO con VBA?
- sarebbe possibile trovare una soluzione MISTA.

Aspetto i vostri interventi e soluzioni.
Ciao a tutti,
Mario

 

[Utente cancellato 1617]

interessante.

Mi ha incuriosito di più cercare di capire come sei incappato nel pdf Dell' università di matematica di Milano, comunque.

Se ho ben compreso. vorresti cercare il modo di costruire un solutore? Del tipo, inserisco la griglia vuota con i numeri all' esterno e, dopo aver premuto il pulsante il grattacieli compaiono nel giusto ordine sulla griglia?
Secondo me, con le formule, non ce la fa nessuno
Oggi, ho pensato a due strade attraverso l' utilizzo di un algoritmo via VBA. il primo riguarda un processo di vari step ciclici del quale ho anche ritrovato riscontro mentre cercavo altro, su un pdf del dipartimento di matematica di Milano (tra l' altro riportava proprio le due griglie che proponi nel file)
Però sono convinto, ed era per questo che mi ero messo alla ricerca di qualche spunto matematico, che ci sia un legame stretto con le permutazioni.
Non so se è un caso perché ho avuto tempo solo di studiare la tua griglia piena ma la parte alta, la parte di destra e quella sotto, sono sequenze tutte differenti tra loro, mentre quella di sinistra sono doppioni delle altre.

Per adesso sono fermo a cercare un oggetto accettabile per raccogliere tutte le sequenze di range ed i vari dati utili che possiede

ALTO: C10:C14,D10:D14,E10:E14,F10:F14DESTRA: C14:G14,C13:G13,C12:G12,C11:G11
BASSO: F11:F15,E11:E15,D11:D15,C11:C15
SINISTRA: B14:F14,B13:F13,B12:F12,B11:F11

Sì: direi che sono ancora in alto mare.

 

[Marius44]

Ciao Draco
si, lo confesso: E' successo come a te: cercavo in rete degli spunti matematici e sono incappato nell'Università!!! Il caso mi ha incuriosito ed ho cercato di capirne di più.

Oltre a tentare di trovare la soluzione manualmente ho provato (ed in questo sono riuscito) a creare un algoritmo che riempie la griglia gialla, mette i numerini nei bordi e cancella l'interno (quello in giallo). Ovviamente solo VBA (le formule, e non so se si può fare, mi fan venire ... l'orticaria). Non mi è riuscito, invece, il procedimento contrario, cioè presenti i numeri nei bordi, inserire i dati nella griglia gialla: riesco a mettere "llll" e "l" e poi ... buio.

Spero nei vostri aiuti.

Ciao e buona domenica,
Mario

 

[cromagno]

.... riesco a mettere "llll" e "l" e poi ... buio.

Ciao a tutti,

M @Mario
già, anche io prima sono arrivato ad inserire i "grattacieli" se nei bordi c'è un 1 o un 4... per il resto aspetto di trovare una strada più semplice, perchè quella che ho in mente ora è di far ciclare ogni numero finchè non trova la soluzione, ma anche in questo modo c'è da tener conto dei valori "sui bordi". Facciazza

In compenso, sto diventando bravo a risolverli a mano Muio2

Ciao
Tore

 

[Powerwin]

Ciao a tutti, non sono pratico di formule ma utilizzando INDICE CONFRONTA e INSERISCI CODICE.CARATTERE(5) usando Arial con Font forse si potrebbe anche con le formule.

Sto provando a tirar fuori qualcosa

 

[Utente cancellato 1617]

Questo topic, a mio avviso, si presta bene ad un progetto di gruppo dove, una volta sviluppato il progetto nelle sue varie parti, lo si assembla per dar luogo al programmino finito.

Il mio ragionamento è questo. A parole pare pure semplice

Partendo da questa situazione:

	A​	B​	C​	D​	E​	F​
1​		4​	1​	3​	2​
2​	2​					2​
3​	3​					1​
4​	2​					2​
5​	1​					3​
6​		1​	2​	2​	2​

dove:
la parte grigia la chiamo Corona
la parte gialla la chiamo Campo
ogni colonna o riga del quadrante la chiamo Griglia

PARTENDO dall' alto e proseguendo in modo orario: Alto -> Destra -> Basso -> sinistra

I Algoritmo

• Se la cella della Corona, mostra un numero pari a 1, ALLORA, la prima cella della Griglia conterrà il GRattacielo massimo
• Se una cella mostra un numero pari a 2 E, nell' ultima cella della griglia, è gia presente il grattacielo massimo ALLORA , la prima cella della griglia conterrà il grattacielo massimo disponibile
• Se una cella mostra il numero 3 E, nelle ultime celle, sono gia presenti i grattacieli massimi , ALLORA,la prima cella conterrà il massimo grattacielo disponibile.
• E così via fino a che posssibile

	A​	B​	C​	D​	E​	F​
1​		4​	1​	3​	2​
2​	2​		4​			2​
3​	3​				4​	1​
4​	2​					2​
5​	1​	4​	3		2	3​
6​		1​	2​	2​	2​

II Algoritmo.

• Se nella griglia è rimasto solo una cella vuota, essa conterrà l' unico grattacielo disponibile
• Se, nel Campo, un valore è stato ripetuto il massimo delle volte meno uno, Allora esso sarà, all' incrocio tra le due griglie in cui manca.

	A​	B​	C​	D​	E​	F​
1​		4​	1​	3​	2​
2​	2​		4​			2​
3​	3​				4​	1​
4​	2​			4​		2​
5​	1​	4​	3​	1​	2​	3​
6​		1​	2​	2​	2​

III Algoritmo

Se la cella della corona mostra un numero pari al grattacielo massimo, ALLORA:
la griglia avrà i valori rimanenti, disposti in modo crescente partendo dalla prima cella.

	A​	B​	C​	D​	E​	F​
1​		4​	1​	3​	2​
2​	2​	1​	4​	2​		2​
3​	3​	2​		3​	4​	1​
4​	2​	3​		4​		2​
5​	1​	4​	3​	1​	2​	3​
6​		1​	2​	2​	2​

RIAPPLICANDO il II algoritmo, Enne volta (in questo caso 4) si risolve il gioco

4​

1​

3​

2​

_

4​

1​

3​

2​

_

4​

1​

3​

2​

_

4​

1​

3​

2​

2​

1​

4​

2​

3

2​

2​

1​

4​

2​

3

2​

2​

1​

4​

2​

3

2​

2​

1​

4​

2​

3

2​

3​

2​

3​

4​

1​

3​

2​

3​

4​

1​

3​

2​

1

3​

4​

1​

3​

2​

1

3​

4​

1​

2​

3​

4​

2​

2​

3​

4​

1

2​

2​

3​

4​

1

2​

2​

3​

2

4​

1

2​

1​

4​

3​

1​

2​

3​

1​

4​

3​

1​

2​

3​

1​

4​

3​

1​

2​

3​

1​

4​

3​

1​

2​

3​

1​

2​

2​

2​

1​

2​

2​

2​

1​

2​

2​

2​

1​

2​

2​

2​

Per poter applicare gli algoritmi, questi o altri, serve un modo composto di ciclare le griglie. Io ho scelto l' orario, si poteva scegliere l' anti orario, prima l ' alto poi il basso, e chi più ne ha più ne mentta.

Il fatto saliente è che c'è bisogno di una procedura che possa ciclare i range di modo da poter saltare da una griglia all' altra seguendo una dinamica che passi dalle colonne alle righe e, dalle righe alle colonne come se girasse in torno.
Di modo da poter processare i le varie griglie, i vari range, come segue:

ALTO: B2:B5,C2:C5,D2:D5,E2:E5
DESTRA: B2:E2,B3:E3,B4:E4,B5:E5 (la prima cella della griglia è l' ultima del range)
BASSO: E2:E5,D2:D5,C2:C5,B2:B5 (la prima cella della griglia è l' ultima del range)
SINISTRA: B5:E5,B4:E4,B3:E3,B2:E2


... più ci ragiono sopra e più mi pare di capire che sarebbe proprio utile definire un oggetto Campo, formato dal proprio numero di Griglie e, probabilmente, Campo non è altro che una collection di oggetti Griglia ...

La GRiglia la vedo con una proprietà Saliente che è la sua disposizione nello spazio (Alto, Basso, Destra, Sinistra)
questa proprietà ne determina quale sia la sua prima ed ultima cella.
Avrà una Property Address che ne identifica la posizione sul foglio.
Avrà anche la sua parte di Corona, con il proprio Address ed il proprio valore

Griglia.Direzione as TypeDirezione
Griglia.Address as Range oppure string
Griglia.CoronaAddress as Range oppure string
GRiglia.CoronaValue as long
Griglia.Grattacieli as [Una qualche collezione tra array, collection o chessoio]

.... vabbè... per oggi basta elucubrazioni :)
buona domenica palmata a tutti :)

 

[Marius44]

Salve a tutti
Noto con piacere che vi ho ... solleticato. PolliciSu
Come detto, ho una macro che "crea" il quadrato giallo.
Come detto, ho una macro ed una function che inseriscono rispettivamente "l" e "llll" quando sono "sicuri"
Aggiungo che la macro di cui sopra completa una riga/colonna quando le posizioni sono "sicure"

Ma ... il resto? :Confuso:Facciazza
Molto artigianalmente ecco la Macro e la Function (adatta per l'esempio riportato)

Sub Inser() 'inserimento tacca
Dim quadro As Range
Set quadro = Range("B10:G15")
Range("C11:F14").ClearContents


For Each c In quadro 'scrive i grattacieli sicuri
    If c.Value = 1 Or c.Value = 4 Then
        a = c.Address: b = c.Value
        Call scrive_1_4(a, b)
    End If
Next
'cerco nella griglia quanti sono i 4 inseriti
'ed inserisco 4 nella riga e colonna vuota, se possibile
Dim cl(1 To 4)
For i = 11 To 14
    For j = 3 To 6
        If Cells(i, j) = "llll" Then
            cl(i - 10) = j * 4
        End If
    Next j
Next i
Dim ra(1 To 4)
For j = 3 To 6
    For i = 11 To 14
        If Cells(i, j) = "llll" Then
            ra(j - 2) = i * 4
        End If
    Next i
Next j
tr = 0
For i = 1 To 4
    a = ra(i)
    For j = 1 To 4
        b = cl(j)
        If a = "" And b = "" Then
            Cells(i + 10, j + 2) = "llll"
            tr = 1: Exit For
        End If
    Next j
    If tr = 1 Then Exit For
Next i
Stop


Set quadro = Nothing
End Sub


Function scrive_1_4(ByVal a As String, ByVal b As Double)
    rg = Mid(a, 4, 2)
    cn = Mid(a, 2, 1)
    testo = WorksheetFunction.Rept("l", 4 - b + 1)
    If cn = "B" Then
        Cells(rg, 3) = testo
    ElseIf cn = "G" Then
        Cells(rg, 6) = testo
    ElseIf cn = "C" Or cn = "D" Or cn = "E" Or cn = "F" Then
        If rg = 10 Then
            Range(cn & 11) = testo
            If b = 4 Then
                Range(cn & 12) = "ll"
                Range(cn & 13) = "lll"
                Range(cn & 14) = "llll"
            End If
        ElseIf rg = 15 Then
            Range(cn & 14) = testo
            If b = 4 Then
                Range(cn & 13) = "ll"
                Range(cn & 12) = "lll"
                Range(cn & 11) = "llll"
            End If
        End If
    End If
End Function

 

[cromagno]

Ciao a tutti,

M @Mario
io ho lasciato perdere le "stanghette" ed ho messo direttamente i numeri (1 = 10 piani, 2 = 20 piani, etc...).
La macro attuale, quindi riempie il campo giallo solo se trova l'1 o il 4 nei bordi):

Sub Panorama()
Dim i As Integer, j As Integer, n As Integer, x As Integer, y As Integer
Dim Matr() As Integer, righe As Long, colonne As Long

n = 4
righe = 9
colonne = 1
ReDim Matr(1 To n + 2, 1 To n + 2)

For i = 1 + righe To n + 2 + righe
    For j = 1 + colonne To n + 2 + colonne
        If i = 1 + righe Or i = n + 2 + righe Or j = 1 + colonne Or j = n + 2 + colonne Then
            Matr(i - righe, j - colonne) = Cells(i, j)
            If Cells(i, j) = 1 Then
                If i = 1 + righe Then
                    Matr(i - righe + 1, j - colonne) = n
                ElseIf i = n + 2 + righe Then
                    Matr(i - righe - 1, j - colonne) = n
                ElseIf j = 1 + colonne Then
                    Matr(i - righe, j - colonne + 1) = n
                ElseIf j = n + 2 + colonne Then
                    Matr(i - righe, j - colonne - 1) = n
                End If
            ElseIf Cells(i, j) = 4 Then
                If i = 1 + righe Then
                    For x = 2 To n + 1
                        Matr(i - righe + (x - 1), j - colonne) = x - 1
                    Next x
                ElseIf i = n + 2 + righe Then
                    For x = 2 To n + 1
                        Matr(i - righe - (x - 1), j - colonne) = x - 1
                    Next x
                ElseIf j = 1 + colonne Then
                    For x = 2 To n + 1
                        Matr(i - righe, j - colonne + (x - 1)) = x - 1
                    Next x
                ElseIf j = n + 2 + colonne Then
                    For x = 2 To n + 1
                        Matr(i - righe, j - colonne - (x - 1)) = x - 1
                    Next x
                End If
            End If
        End If
    Next j
Next i

For i = 2 To n + 1
    For j = 2 To n + 1
        If Matr(i, j) = 0 Then
            Cells(i + righe, j + colonne) = ""
        Else
            Cells(i + righe, j + colonne) = Matr(i, j)
        End If
    Next j
Next i

End Sub

la strada è lunga....

M @marco
si, direi che è una buona idea quella di spezzettare e richiamare :ok:

 

[Powerwin]

Pare quasi un Sudoku

 

[Utente cancellato 1617]

@Crom...
M @Marius ...

Vi chiedo la cortesia di raccontarmi le vostre due macro per facilitarmi la comprensione... mi pare di comprendere che, bene o male, stanno operando nella stessa zona del problema... magari si possono fondere le idee di una e dell' altra per tirarne fuori quella risolutiva...

il risultato di questa macro deve essere quella raffigurata per il primo algoritmo:

	A​	B​	C​	D​	E​	F​
1​		4​	1​	3​	2​
2​	2​		4​			2​
3​	3​				4​	1​
4​	2​					2​
5​	1​	4​	3		2	3​
6​		1​	2​	2​	2​

in questo caso sono tre passate.
1 - fa un giro vede scritto il numero minimo (1) e scrive il valore massimo nell ultima cella
2 -fa un secondo giro e vede scritto il successivo numero minimo(2) e scrive il precedente numero massimo(3) perchè il massimo è gia presente(4)
3 - fa un ennesimo giro e vede scritto il numero minimo successivo(3) e scrive il numero massimo ancor più precedente(2) perchè è gia presente (3)

la cella che viene scritta è sempre la prima della griglia e quello che viene controllato è se c'è il valore massimo corrispondente sulla parte opposta della griglia.


Sentite questo ragionamento barlengo che pare fare al caso...

Parto a griglia vuota... dall' alto a sinistra...
leggo 4...
mi chiedo: posso inserre il quarto grattacielo più alto (sarebbe il più basso)
risposta NO. non posso scrivere 1 in questo luogo perchè vedrei tutti gli altri.
passo alla seconda casella grigia. c' scritto 1.
Posso inserire il primo grattacielo più alto? Si. è il più alto. vedo solo lui. significa che l' ho davanti agl' occhi.
passo alla successiva casella grigia e leggo 3.
Posso inserire nella prima cella il terzo grattacielo più alto qui?
NO. è il terzo più alto, poi la griglia è tutta vuota... non ho la certezza che esso vada proprio qui.
e così via...

Noterete che per questo algoritmo, pensare che il numero della casella grigia sia il grattacielo da inserire nella prima cella della griglia è un buon approccio.
Praticamente ti devi chiedere se il grattacielo, dal più alto al più basso, enumerato nella cella grigia lo puoi mettere nella prima casella della griglia..
...
Lo so... sono più impazzito di ieri
... devo uscire.. vi leggo da cello :)

 

[Marius44]

Salve a tutti
vedo, se posso, di fare un riassunto ed intanto dico a Fabio che l'idea è giusta per quanto riguarda la creazione della griglia, cioè popolarla con i numeri o tacche. Ed è quello che ho fatto io nella macro CreaGriglia che non vi ho postato.

Mi sembra ovvio che, anche se in maniere differenti, siamo tutti arrivati allo stesso punto. Occorre far "leggere" il numero fuori griglia (o campo, come lo chiama Draco): se questo numero è 1 allora nella cella immediatamente a fianco (per "a fianco" intendo la cella adiacente quella il cui numero stiamo leggendo) ci sta il grattacielo più alto, se è 4 ci sta il grattacielo più basso.
Se sono fortunato ed ho piazzato 3 volte lo stesso grattacielo, visto che in ogni riga/colonna devono starci tutti i numeri, cerco la cella di riga/colonna vuota e ci piazzo il quarto grattacielo (ed è quello che fa la mia macro nella seconda parte).
A questo punto se in una riga o colonna ho la prima e l'ultima cella piene (ovviamente possono solo essere 1 e 4, dal verso dove c'è il 4 inserisco i restanti grattacieli (ed anche questo è quello che fa la mia macro).

Adesso, forse seguendo il suggerimento di Powerwin, occorre una "ricorsiva" che faccia tutte le prove (appunto come si fa per il Sudoku). Io ci ho provato ma, come è evidente, con scarsi risultati.

Come dice Draco "magari si possono fondere le idee di una e dell' altra per tirarne fuori quella risolutiva", diamoci una mossa e tiriamo fuori la soluzione VBA.

Siamo, però, al palo per quanto riguarda lato Formule (anche se mi rendo conto che è una strada tutta in salita, e che salita).

Ciao,
Mario

 

[Utente cancellato 2758]

stesso errore

 

[Utente cancellato 1617]

marius... ma me ne rendo conto solo ora...
perchè hai chiamato FUNCTION la seconda procedura del tuo listato?

fa niente.

con la tua sub vuoi prender dentro tutto il problema. sappi che non vai da nessuna parte così.

devi sviluppare solo il primo FOR each.
quello dive valuti gli uno ed i 4.
quella regola non vale solo. per loro ma vale per tutti i grattacieli secondo il primo algoritmo.

l ennesimo grattacielo più alto descritto nella corona grigia è presente nella prima cella adiacente SE e Solo se nelle ultime sono presenti i precedenti i più alti di lui.
vedi la tabellina che ho riportato qui sopra.

 

[Marius44]

Ciao Draco
perchè volevo che mi restituisse qualcosa. Poi, in corso d'opera, ho cambiato idea ed il "titolo" è rimasto.

Aggiungo due cose:
1) mi sono accorto (per vero dire me lo ha fatto notare Anthony, che ancora non si vede...) che nella spiegazione sul foglio vi è un errore: se vi posizionate nella cella C3 si vedranno 4 grattacieli in altezza progressiva;
2) con le macro da me proposte vengono inserite le "tacche" anche in verticale se la cella in alto è 4 e l'ultima in basso è 1, ma non lo fa in orizzontale.

Ciao,
Mario

 

[cromagno]

Ciao a tutti,

oggi ho avuto un pò di tempo ed ho iniziato a buttare giù qualcosa (molto incasinato ma per ora questo mi è venuto).
Non è completo, ci sarebbe da scrivere la macro "Last_One" (per completare una riga/colonna con già 3 grattacieli piazzati) e forse una o due altre macro.

Per oggi mollo, ma lascio quello che ho fatto (in attesa di qualcosa con meno ripetizioni rispetto a quelle del mio codice ):

Option Explicit
Dim i As Integer, j As Integer, n As Integer, x As Integer, y As Integer
Dim Matr() As Integer, righe As Long, colonne As Long
Sub Panorama()

n = 4
righe = 9
colonne = 1
ReDim Matr(1 To n + 2, 1 To n + 2)

'Controlla se sul bordo c'è un 1 od un 4
For i = 1 + righe To n + 2 + righe
    For j = 1 + colonne To n + 2 + colonne
        If i = 1 + righe Or i = n + 2 + righe Or j = 1 + colonne Or j = n + 2 + colonne Then
            Matr(i - righe, j - colonne) = Cells(i, j)
            If Cells(i, j) = 1 Then
                If i = 1 + righe Then
                    Matr(i - righe + 1, j - colonne) = n
                ElseIf i = n + 2 + righe Then
                    Matr(i - righe - 1, j - colonne) = n
                ElseIf j = 1 + colonne Then
                    Matr(i - righe, j - colonne + 1) = n
                ElseIf j = n + 2 + colonne Then
                    Matr(i - righe, j - colonne - 1) = n
                End If
            ElseIf Cells(i, j) = 4 Then
                If i = 1 + righe Then
                    For x = 2 To n + 1
                        Matr(i - righe + (x - 1), j - colonne) = x - 1
                    Next x
                ElseIf i = n + 2 + righe Then
                    For x = 2 To n + 1
                        Matr(i - righe - (x - 1), j - colonne) = x - 1
                    Next x
                ElseIf j = 1 + colonne Then
                    For x = 2 To n + 1
                        Matr(i - righe, j - colonne + (x - 1)) = x - 1
                    Next x
                ElseIf j = n + 2 + colonne Then
                    For x = 2 To n + 1
                        Matr(i - righe, j - colonne - (x - 1)) = x - 1
                    Next x
                End If
            End If
        End If
    Next j
Next i

'ciclo di macro... fino a quando non viene completata la matrice

'Do while .....
Call Check_Mancanti
Call Check_2OnEdge
'Loop


'Compila la tabella sul foglio
Range(Cells(2 + righe, 2 + colonne), Cells(n + 1 + righe, n + 1 + colonne)).ClearContents
For i = 2 To n + 1
    For j = 2 To n + 1
        If Matr(i, j) = 0 Then
            Cells(i + righe, j + colonne) = ""
        Else
            Cells(i + righe, j + colonne) = Matr(i, j)
        End If
    Next j
Next i

End Sub

Sub Check_Mancanti()
Dim Conta As Integer, Riga() As Integer, Colonna() As Integer
Dim Indice As Integer, k As Integer, R_manc As Integer, C_manc As Integer, Confronto As Integer

'Cerca una "tipologia" di grattacielo e se è presente in tre posizioni
'piazza il quarto nella giusta posizione

ReDim Riga(1 To n)
ReDim Colonna(1 To n)

For x = 1 To n
    Conta = 0
    Indice = 1
    R_manc = 0
    C_manc = 0
    For i = 2 To n + 1
        For j = 2 To n + 1
            If Matr(i, j) = x Then
                Conta = Conta + 1
                Riga(Indice) = i
                Colonna(Indice) = j
                Indice = Indice + 1
            End If
        Next j
    Next i
    If Conta = 3 Then
        ReDim Preserve Riga(1 To n - 1)
        ReDim Preserve Colonna(1 To n - 1)
      
        For k = 2 To n + 1
            On Error Resume Next
            Confronto = Application.WorksheetFunction.Match(k, Riga, 0)
            If Err.Number <> 0 Then
                R_manc = k
                On Error GoTo 0
                GoTo passo2
            End If
        Next k

passo2:
        For k = 2 To n + 1
            On Error Resume Next
            Confronto = Application.WorksheetFunction.Match(k, Colonna, 0)
            If Err.Number <> 0 Then
                C_manc = k
                On Error GoTo 0
                GoTo passo3
            End If
        Next k
passo3:
        Matr(R_manc, C_manc) = x
    End If
Next x
End Sub

Sub Check_2OnEdge()

'Controlla i bordi con 2 grattacieli visibili ed il terzo in quella riga/colonna
'è il più alto...

For i = 1 To UBound(Matr, 1)
    For j = 1 To UBound(Matr, 1)
        Select Case i
            Case Is = 1
                If Matr(i, j) = 2 And Matr(i + 3, j) = 4 Then
                    If Matr(i + 4, j) = 1 Then
                        Matr(i + 1, j) = 3
                        Matr(i + 2, j) = 2
                    ElseIf Matr(i + 4, j) = 2 Then
                        Matr(i + 1, j) = 3
                        Matr(i + 2, j) = 1
                    ElseIf Matr(i + 4, j) = 3 Then
                        Matr(i + 1, j) = 2
                        Matr(i + 2, j) = 1
                    End If
                End If
            Case Is = 6
                If Matr(i, j) = 2 And Matr(i - 3, j) = 4 Then
                    If Matr(i - 4, j) = 1 Then
                        Matr(i - 1, j) = 3
                        Matr(i - 2, j) = 2
                    ElseIf Matr(i - 4, j) = 2 Then
                        Matr(i - 1, j) = 3
                        Matr(i - 2, j) = 1
                    ElseIf Matr(i - 4, j) = 3 Then
                        Matr(i - 1, j) = 2
                        Matr(i - 2, j) = 1
                    End If
                End If
            Case Else
                Select Case j
                    Case Is = 1
                        If Matr(i, j) = 2 And Matr(i, j + 3) = 4 Then
                            If Matr(i, j + 4) = 1 Then
                                Matr(i, j + 1) = 3
                                Matr(i, j + 2) = 2
                            ElseIf Matr(i, j + 4) = 2 Then
                                Matr(i, j + 1) = 3
                                Matr(i, j + 2) = 1
                            ElseIf Matr(i, j + 4) = 3 Then
                                Matr(i, j + 1) = 2
                                Matr(i, j + 2) = 1
                            End If
                        End If
                    Case Is = 6
                        If Matr(i, j) = 2 And Matr(i, j - 3) = 4 Then
                            If Matr(i, j - 4) = 1 Then
                                Matr(i, j - 1) = 3
                                Matr(i, j - 2) = 2
                            ElseIf Matr(i - 4, j) = 2 Then
                                Matr(i, j - 1) = 3
                                Matr(i, j - 2) = 1
                            ElseIf Matr(i - 4, j) = 3 Then
                                Matr(i, j - 1) = 2
                                Matr(i, j - 2) = 1
                            End If
                        End If
                End Select
        End Select
    Next j
Next i
  
End Sub

Sub Last_One()

'Controlla se in una riga/colonna manca una sola tipologia di grattacielo e se è così ce lo piazza

End Sub

Ciao
Tore

 

[Marius44]

Ciao a tutti

@cromagno
Sto provando anch'io ma ad un certo punto mi blocco Basta se no mi faccio male

Allego il file, ovviamente ancora non completo.

Ciao,
Mario

 

[Utente cancellato 1617]

Signori. Spero di fare cosa gradita, presentando il gioco... Mi sono accorto che a forza di fare delle prove e di studiare come è composto un tabellone, andavo sempre ripetendeo le stesse istruzioni ed alla fine ho deciso di mettere insieme i pezzi ed è uscito che adesso ci si può pure giocare

Il risolutore non l'ho ancora sviluppato. L' idea è ancora in testa...

Però fatemi dire due cose interessanti sulle permutazioni di questo giochino.

La prima cosa che ho scoperto è che generare un tabellone è la cosa più facile di questo mondo. Il merito, però, non è tutto mio ma devo ringraziare un imbeccata per aver notato questa cosa. Senza un consiglio di Rubik, non mi sarei messo a scrivere e non avrei notato una cosa tanto banale.

Prendiamo una tabella piccola. una tabella di tre per tre.

le possibili combinazioni di tre elementi distinti sono: 3 * 2 * 1 = 6 (il fattoriale di tre) -> il fattoriale del numero degli elementi disponibili.7
1) 123
2) 132
3) 213
4) 231
5) 312
6) 321

ora, a noi servono solo quelli che, intabellati in un quadrato, non si ripetano lungo una riga o una colonna:

	A​	B​	C​
1​	1​	2​	3​
2​	2​	3​	1​
3	3​	1​	2​

La disposizione in cui ve li presento; non è casuale ma è quella che ho definito il seme di tutte le combinazioni. Tutte le altre, sono uno scambio di righe o di colonne.

Per esempio, scambiando La colonna B con la colonna C, e successivamente la riga 2 con la riga 3, si ha la tabella seguente.

	A​	B​	C​
1​	1​	3​	2​
2​	3​	2​	1​
3​	2​	1​	3​

....
Risulta chiaro che una volta trovato un modo per costruire la prima tabella, poi, mescolarla è una cosa abbastanza semplice.
Così è stato.
Con un doppio ciclo For annidato e l' aiuto dell operatore MOD, si va a creare la matrice principale

'...Lato = NumPerLAto
    ReDim Matrice(1 To Lato, 1 To Lato)
    For i = 1 To Lato
        For j = i To i + Lato - 1
            Matrice(Int(h / Lato) + 1, h Mod Lato + 1) = (j Mod Lato) + 1
            h = h + 1
        Next
    Next
'...

e, successivamente, si miscelano con l' ausilio della funzione RND(), sia le righe che le colonne, per un numero arbitrario di volte

    'Mescola Righe
    For i = 1 To Lato ^ 2
        h = Int(Rnd() * (Lato - 1 + 1)) + 1
        k = Int(Rnd() * (Lato - 1 + 1)) + 1
        For j = 1 To UBound(Matrice)
            Fila = Matrice(h, j)
            Matrice(h, j) = Matrice(k, j)
            Matrice(k, j) = Fila
        Next
    Next
    'Mescola colonne
    For i = 1 To Lato ^ 2
        h = Int(Rnd() * (Lato - 1 + 1)) + 1
        k = Int(Rnd() * (Lato - 1 + 1)) + 1
        For j = 1 To UBound(Matrice)
            Fila = Matrice(j, h)
            Matrice(j, h) = Matrice(j, k)
            Matrice(j, k) = Fila
        Next
    Next

Il risultato finale è un funzione che restituisce una matrice da poter utilizzare anche come matriciale come scacciapensieri

Function Grattacieli(NumPerLAto As Long) As Variant
    Dim h As Long
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim Matrice As Variant
    Dim Fila As Variant
    Dim Lato As Long
 
    Lato = NumPerLAto
    ReDim Matrice(1 To Lato, 1 To Lato)
    For i = 1 To Lato
        For j = i To i + Lato - 1
            Matrice(Int(h / Lato) + 1, h Mod Lato + 1) = (j Mod Lato) + 1
            h = h + 1
        Next
    Next
 
    'Mescola Righe
    For i = 1 To Lato ^ 2
        h = Int(Rnd() * (Lato - 1 + 1)) + 1
        k = Int(Rnd() * (Lato - 1 + 1)) + 1
        For j = 1 To UBound(Matrice)
            Fila = Matrice(h, j)
            Matrice(h, j) = Matrice(k, j)
            Matrice(k, j) = Fila
        Next
    Next
    'Mescola colonne
    For i = 1 To Lato ^ 2
        h = Int(Rnd() * (Lato - 1 + 1)) + 1
        k = Int(Rnd() * (Lato - 1 + 1)) + 1
        For j = 1 To UBound(Matrice)
            Fila = Matrice(j, h)
            Matrice(j, h) = Matrice(j, k)
            Matrice(j, k) = Fila
        Next
    Next
    Grattacieli = Matrice
End Function

Infine, per avere la corona, le somme dei grattacieli visibili, ho seguito un altra strada... O meglio... avevo seguito molteplici strade per cercare varie cose... questa è nata così e quindi così è rimasta

Comunque il suo lavoro lo fa e pare che non si sbagli.
ha solo l' inconveniente di dover essere istruita anche nella direzione in cui si guardano i grattacieli. m

Function ContaGrattacieli(Griglia As Range, Optional Dritto As Boolean = True) As Long
    Dim GrigliaArr As Variant
    Dim i As Long
    Dim Confronta As Long
    Dim confrontato As Long
    Dim Conta As Long
 
    ReDim GrigliaArr(1 To Griglia.Cells.Count)
    If Dritto Then
        For i = 1 To Griglia.Cells.Count
            GrigliaArr(i) = Griglia.Cells(i)
        Next
    Else
        For i = 1 To Griglia.Cells.Count
            GrigliaArr(i) = Griglia.Cells(Griglia.Cells.Count - i + 1)
        Next
    End If
 
    Conta = 1
    Confronta = 1
    confrontato = 2
 
    Do Until confrontato > Griglia.Cells.Count
        If GrigliaArr(Confronta) < GrigliaArr(confrontato) Then
            Conta = Conta + 1
            Confronta = confrontato
            confrontato = confrontato + 1
        Else
            confrontato = confrontato + 1
        End If
    Loop
    ContaGrattacieli = Conta
End Function

Tutto il resto, nel file che allego, serve per settare il foglio ed altri fronzoli. queste due funzioni sono, credo, le più importanti.
Le condivido volentieri perchè, un pò possiate giocare ed un pò, spero possano esservi utili

ora basta.. le vacanze sono ufficialmente finite :Time:

 

[Marius44]

Ciao Dracoscrigno
oltre ad averti dato un "Utile" (più che meritato) mi piace spendere due parole per l'ottimo lavoro fatto.
Molte sono le "chicche" inserite (non ultima la possibilità di rendere dinamico il quadrato scegliendo il lato oppure il pulsante per l'help) dalle quali, quando le avrò capite :Confuso:, attingerò (visto il tuo consenso).

Rimane ancora in sospeso la soluzione, cioè la possibilità di pervenire al risultato con tentativi successivi. Io, fino ad ora e pur avendo speso molto tempo, non sono riuscito a cavare un ragno dal buco. Ho provato con una ricorsiva (tipo Sudoku) ma non c'è nulla da fare.

Speriamo che Cromagno (ciao Tore) faccia qualche "turno di notte"
Mario

PS. A questo punto, vista l'assenza di "formulisti", sarebbe il caso di trasferire il gioco nella sezione VBA.

 

[Anthony]

Sono partito dal bel lavoro di Draco per cercare di elaborare una macro per la soluzione degli schemi creati
Il risultato l'ho integrato in una evoluzione del file pubblicato da Draco e scaricabile qui: https://www.dropbox.com/s/xaauvy7uxmwpna5/forumexcel_giocodeigrattacieli_by-4-mani_wip1.xlsm?dl=0


Il funzionamento complessivo e' il seguente:
-si crea lo schema usando l'interfaccia e le macro di Draco
-si seleziona una cella della sua cornice e si avvia la Sub viaz disponibile sul Modulo_Anthony del vba, tramite il pulsante "Risolvi by Anthony" presente sul Foglio1.
-vengono create su foglio "Servizio", colonne B e adiacenti, tutte le permutazioni possibili degli "immobili" disponibili; in totale saranno "N!" (N fattoriali) righe; es per 5 righe/colonne si tratta di 120 permutazioni. In colonna A viene creato il punteggio "bilaterale" che quella combinazione consente
Il tentativo di risoluzione parte da questo elenco lavorando "per colonna", secondo il seguente procedimento:
-noto il punteggio verticale, si crea un primo array (UBArr) di N posizioni contenente il numero di elementi in colonna A:J che consente il punteggio verticale
-si crea un secondo array (iArr) di N righe e M posizioni contenente, in ogni riga l'indice di ogni combinazione che consente quel punteggio.
-si creano quindi una dopo l'altro le Combinazioni degli elementi che garantiscono il punteggio verticale; si controlla che formalmente la tabella sia corretta, poi si controlla se i punteggi orizzontali collimano con il punteggio scritto nella cornice.
-Se No, si continua con le N mila /milioni /miliardi di combinazioni, non sapendo se la combinazione giusta e' la decima dell'elenco o la penultima.

Avviata la risoluzione, una form avverte del progresso delle operazioni, in particolare sui cicli effettuati vs il totale di cicli (massimi) possibili.
E' presente sulla form un pulsante per interrompere la ricerca.


Non ci sono problemi a risolvere schemi da 5*5, che possono avere da poche migliaia a 2 milioni di combinazioni da provare; mentre secondo me gli schemi da 6 sono al limite del possibile.
Ad esempio lo schema 6*6 presente sul file ha 105*105*50*40*40*50=44.1 miliardi di combinazioni; dopo N ottimizzazioni sul mio pc non vado oltre circa 70 Mill Cicli/ora, mi servirebbe fino a un mese per completare... Certamente la soluzione non e' entro i primi 2 miliardi di combinazione...

Le Combinazioni (con ripetizione) e Permutazioni sono calcolate tramite la Sub recurPeppa2.
La Function cScore2 calcola il punteggio bilaterale di ognuna delle possibili permutazioni di altezze memorizzate in colonna B e successive
La Function ckForma era nata per controllare se il quadrato N*N e' formalmente corretto (senza ripetizioni dello stesso livello), ma poi ho trasferito il controllo all'interno della Sub Viaz.
La Function hPoints controlla che i punteggi orizzontali siano coerenti con quanto indicato nello schema da risolvere.

Buon divertimento, e se risolvete lo schemino da 6 a mano datemi per favore la soluzione

 

[Utente cancellato 1617]

@Anthony ...

Se ti dicessi che le soluzioni possibili sono molte meno di TUTTE?

Non tenendo conto delle rotazioni le possibili permutazioni sono pari a: Lato! * (lato - 1)! e, se il mio studio sta procedendo nel giusto verso, si trovano in fila.
Basta ricavare il primo riquadro e, successivamente; si permutano tutte le colonne. poi si cambia configurazione attraverso la permuta delle righe. ad ogni permuta di riga si permutano tutte le colonne.
Questo processo per il fattoriale del lato -1

	A​	B​	C​	D​	E​	F​	G​	H​	I​	J​	K​	L​	M​	N​	O​	P​	Q​	R​	S​	T​	U​	V​	W​
1​	1​	2​	3​		1​	2​	3​		2​	3​	1​		2​	3​	1​		3​	1​	2​		3​	1​	2​
2​	2​	3​	1​		3​	1​	2​		1​	2​	3​		3​	1​	2​		1​	2​	3​		2​	3​	1​
3​	3​	1​	2​		2​	3​	1​		3​	1​	2​		1​	2​	3​		2​	3​	1​		1​	2​	3​
4​
5​	1​	3​	2​		1​	3​	2​		2​	1​	3​		2​	1​	3​		3​	2​	1​		3​	2​	1​
6​	2​	1​	3​		3​	2​	1​		1​	3​	2​		3​	2​	1​		1​	3​	2​		2​	1​	3​
7​	3​	2​	1​		2​	1​	3​		3​	2​	1​		1​	3​	2​		2​	1​	3​		1​	3​	2​
8​
9​	2​	1​	3​		2​	1​	3​		3​	2​	1​		3​	2​	1​		1​	3​	2​		1​	3​	2​
10​	3​	2​	1​		1​	3​	2​		2​	1​	3​		1​	3​	2​		2​	1​	3​		3​	2​	1​
11​	1​	3​	2​		3​	2​	1​		1​	3​	2​		2​	1​	3​		3​	2​	1​		2​	1​	3​
12​
13​	2​	3​	1​		2​	3​	1​		3​	1​	2​		3​	1​	2​		1​	2​	3​		1​	2​	3​
14​	3​	1​	2​		1​	2​	3​		2​	3​	1​		1​	2​	3​		2​	3​	1​		3​	1​	2​
15​	1​	2​	3​		3​	1​	2​		1​	2​	3​		2​	3​	1​		3​	1​	2​		2​	3​	1​
16​
17​	3​	1​	2​		3​	1​	2​		1​	2​	3​		1​	2​	3​		2​	3​	1​		2​	3​	1​
18​	1​	2​	3​		2​	3​	1​		3​	1​	2​		2​	3​	1​		3​	1​	2​		1​	2​	3​
19​	2​	3​	1​		1​	2​	3​		2​	3​	1​		3​	1​	2​		1​	2​	3​		3​	1​	2​
20​
21​	3​	2​	1​		3​	2​	1​		1​	3​	2​		1​	3​	2​		2​	1​	3​		2​	1​	3​
22​	1​	3​	2​		2​	1​	3​		3​	2​	1​		2​	1​	3​		3​	2​	1​		1​	3​	2​
23​	2​	1​	3​		1​	3​	2​		2​	1​	3​		3​	2​	1​		1​	3​	2​		3​	2​	1​

...ilrisultato è comunque grandicello...

	AK​	AL​	AM​
3​	lato	lato!	Lato! * (lato - 1)!
4​	1​	1​	1​
5​	2​	2​	2​
6​	3​	6​	12​
7​	4​	24​	144​
8​	5​	120​	2880​
9​	6​	720​	86400​
10​	7​	5040​	3628800​
11​	8​	40320​	203212800​
12​	9​	362880​	14631321600​
13​	10​	3628800​	1,31682E+12​