I'm making a user interface in Shiny and am trying to make a bunch of stylized buttons.
I suceeded in having them be the color I want, and the last thing I want is for the button to darken on hover, like the default buttons do.
I've made the following function for these buttons:
dateButton <- function(id, label) {
actionButton(inputId = id, label = label, style = "color: white;
background-color: darkblue;
border-radius:15%;
border-color: white;
.hover {
box-shadow: inset 0 0 100px 100px rgba(255, 255, 255, 0.1);
}")
}
I'm sure the problem is .hover, I can't find how to format these list-like attributes. Any resources would also be appreciated.
Repr:
library(shiny)
dateButton <- function(id, label) {
actionButton(inputId = id, label = label, style = "color: white;
background-color: darkblue;
border-radius:15%;
border-color: white;
.hover {
box-shadow: inset 0 0 100px 100px rgba(255, 255, 255, 0.1);;}")
ui <- fluidPage(
dateButton("my_button", "B1"),
actionButton("default_button", "B2")
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
}
When ran, B2 does what I want on hover, while B1 doesn't.
It doesn't seem possible to add the :hover pseudo-class selector to an object's inline style attribute. Instead it would work most smoothly to either insert as a <head><style>... section or link to an external style sheet (more examples here). First of these options as shown below:
library(shiny)
dateButton <- function(id, label) {
actionButton(
inputId = id,
label = label
)
}
ui <- fluidPage(
tags$head(tags$style(HTML("
#my_button {
background-color: darkblue;
color: white;
border-radius:15%;
border-color: white;
}
#my_button:hover {
box-shadow: inset 0 0 100px 100px rgba(255, 255, 255, 0.1);
font-weight: bold
}
"))),
dateButton("my_button", "B1"),
actionButton("default_button", "B2"))
server <- function(input, output, session) {
}
shinyApp(ui, server)
Edit - making a class to be shared across buttons
If you want to apply this to more buttons, add a class attribute in your constructor function call, and use css accordingly:
library(shiny)
dateButton <- function(id, label) {
actionButton(
inputId = id,
class = "hover-button",
label = label
)
}
ui <- fluidPage(
tags$head(tags$style(HTML("
.hover-button {
background-color: darkblue;
color: white;
border-radius:15%;
border-color: white;
}
.hover-button:hover {
box-shadow: inset 0 0 100px 100px rgba(255, 255, 255, 0.1);
font-weight: bold
}
"))),
dateButton("my_button", "B1"),
actionButton("default_button", "B2"))
server <- function(input, output, session) {
}
shinyApp(ui, server)
Related
I have a ColourPicker that I use to determine the background color of an action button. What I would like to do is click on the action button and have the hex code that was clicked from the ColourPicker be copied to my clipboard. The goal is to then paste that value to be the background color in a cell of a data table. Right now, I am mostly worried about the copying part.
I have a button that I can copy-button so I can copy a text value, which is easy enough, but this is not what I am trying to do.
What I would like to do is copy the hex code from the small button that is generated in my code, which can change color based on the color selected by the ColourPicker, and access just the hex code value of that button.
Do I need to reference the ID of the ColourPicker in order to access the hex code? Or could I just copy that hex code straight from the button? I haven't been able to find any packages that work with getting hex codes from objects.
For reference, this is basically what I have (much thanks again to #lz100)
library(shiny)
library(shinythemes)
library(sortable)
library(colourpicker)
library(glue)
library(png)
library(dplyr)
library(DT)
library(rclipboard)
# funcs
plate96 <- function(id) {
div(
style = "position: relative; height: 500px",
tags$style(HTML(
'
.wells {
height: 490px;
width: 750px;
overflow: hidden;
min-height: 20px;
padding: 19px;
margin-bottom: 20px;
border: 1px solid #e3e3e3;
border-radius: 4px;
-webkit-box-shadow: inset 0 1px 1px rgb(0 0 0 / 5%);
box-shadow: inset 0 1px 1px rgb(0 0 0 / 5%);
position: relative;
transform: translateX(50%);
}
.wells:after {
content: "";
height: 450px;
width: 690px;
border: 1px solid;
position: absolute;
transform: translate(15px, -100%);
z-index: -1;
}
.wells .corner-top {
position: absolute;
margin: -20px;
width: 43px;
height: 34px;
transform: rotate(45deg);
background-color: white;
z-index: 1;
left: 30px;
border-right: 1px solid;
}
.wells .corner-bot {
position: absolute;
margin: -20px;
width: 40px;
height: 40px;
transform: rotate(45deg);
background-color: white;
z-index: 1;
left: 35px;
bottom: 20px;
border-top: 1px solid;
}
.wells .html-widget {
transform: translateX(20px);
}
.wells thead tr th {
font-weight: 100;
}
.wells table:after {
content: "";
border: 1px solid #ccc;
position: absolute;
height: 410px;
width: 635px;
z-index: -1;
transform: translate(33px, -99%);
}
.wells table.dataTable.no-footer {
border-spacing: 3px;
border-bottom: unset;
}
.wells table.dataTable thead th {
border-bottom: unset;
}
.wells tbody tr td:not(:first-of-type) {
border-radius: 50%;
border: 1px solid black;
height: 15px;
width: 15px;
padding: 15px;
font-size: 0;
}
.wells table.dataTable.cell-border tbody tr td:first-of-type {
border: unset;
border-right: 1px solid #ccc;
font-weight: 900;
}
'
)),
div(
style = "position: absolute; left: 50%; transform: translateX(-100%);",
div(
class = "wells",
div(class = "corner-top"),
div(class = "corner-bot"),
DT::dataTableOutput(id, width = "90%", height= "100%")
)
)
)
}
renderPlate96 <- function(id, colors = rep("white", 96), byrow = TRUE) {
stopifnot(is.character(colors) && length(colors) == 96)
plate <- matrix(1:96, nrow = 8, ncol = 12, byrow = byrow, dimnames = list(LETTERS[1:8], 1:12))
colnames(plate) <- stringr::str_pad(colnames(plate), 2, "left", "0")
renderDataTable({
datatable(
plate,
options = list(dom = 't', ordering = F),
selection = list(target = 'cell'),
class = 'cell-border compact'
) %>%
formatStyle(
1:12,
cursor = 'pointer',
backgroundColor = styleEqual(1:96, colors, default = NULL)
)
})
}
# app code
ui <- fluidPage(
plate96("plate"),
tags$b("Wells Selected:"),
verbatimTextOutput("well_selected"),
rclipboardSetup(),
numericInput("num_conds",
label = h3("Enter the number of treatments/ conditions"),
min = 1,
max = 20,
value = 1),
uiOutput("cond_colors"),
htmlOutput("cond_buttons", align = 'center'),
# Add a text input
textInput("copytext", "Copy this:", "Test 1"),
# UI ouputs for the copy-to-clipboard buttons
uiOutput("clip"),
# A text input for testing the clipboard content.
textInput("paste", "Paste here:")
)
server <- function(input, output, session){
#####Number output for number of conditions#####
output$value = renderPrint({ input$num_conds })
#### Color selection for UI input####
output$cond_colors <- renderUI({
num_conds <- as.integer(input$num_conds)
lapply(1:num_conds, function(i) {
colourInput(paste0("colors", i),
label = (paste0("Select a color for condition ", i)),
show = c("both"),
value = "black",
palette = c("limited"),
)
})
})
#### Create action buttons for conditions to be selected####
output$cond_buttons <- renderUI({
num_conds = as.integer(input$num_conds)
lapply(1:num_conds, function(i) {
bg = input[[paste0("colors", i)]]
style = paste0(
collapse = " ",
glue("background-color:{bg};
color:#ffffff;
border-color:#000000")
)
label = input[[paste0("condID", i)]]
cond_buttons = actionButton(paste0("cond_buttons", i),
label = label,
style = style
)
})
})
# Add clipboard buttons
output$clip <- renderUI({
output$clip <- renderUI({
rclipButton(
inputId = "clipbtn",
label = "Test copy button",
clipText = input$copytext,
icon = icon("clipboard")
)
})
})
# Workaround for execution within RStudio version < 1.2
if (interactive()){
observeEvent(input$clipbtn, clipr::write_clip(input$copytext))
}
output$plate <- renderPlate96(
"plate",
colors = c(
rep("#eeeeee", 12),
rep("#27408b", 12),
rep("#0f8b44", 12),
rep("#9400d3", 12),
rep("#0701ff", 12),
rep("white", 36)
)
)
output$well_selected <- renderPrint({
input$plate_cells_selected
})
}
shinyApp(ui = ui, server = server)
And here is a picture to kind of explain what I am thinking. Before:
After:
You could set an input value via client-side Javascript, using Shiny.setInputValue and process this value like those provided by UI input elements.
Simple example:
library(shiny)
ui <- shiny::fluidPage(
actionButton('colored_button', 'a green button',
style = 'background-color:#00ff00'
),
actionButton('button_get_color', 'get color'),
textOutput('color_message'),
## inject client-side javascript:
tags$script('
// bind JS code to the getter button:
document.getElementById("button_get_color")
.onclick = function(){
// set input value via JS:
Shiny.setInputValue("color",
// select colored button and get its background color:
document.getElementById("colored_button")
.style.backgroundColor)
}'
)
)
server <- function(input, output) {
observeEvent(input$button_get_color,{
## do stuff, e. g.
output$color_message <- renderPrint(input$color)
})
}
shinyApp(ui, server)
Edit:
You can also use the colored button (or any page element) to set the input value: get the element by ID and have it trigger Shiny.setInputValue on click (or other mouse event)
more information on communicating via JS here
some suggestions on converting RGB to Hex
I want to have a glow to the refresh button when I change the pickerinput.
I have been able to get the glow but the problem is that this is glowing from the start. I don't want this to glow from the start and Yes! it is necessary to have a default selected value.
I hope this is clear enough. I'm sorry if I didn't adhere to the guidelines. I'm still learning.
Thank you in advance!
library("shiny")
library(shinyWidgets)
library(shinyjs)
#Created Ui having picker input, action button and Css for it
ui <- tagList(shinyjs::useShinyjs(),
fluidPage(
tags$h2("Select / Deselect all"),
actionButton("button_1", "Refresh Plot",style= "animation: none;"),
pickerInput(
inputId = "p1",
label = "Select all option",
choices = rownames(mtcars),
multiple = TRUE,
options = list(`actions-box` = TRUE), selected = rownames(mtcars)[1]
)),
tags$head(tags$style(HTML('#keyframes glowing {
0% { background-color: #4a257a !important; box-shadow: 0 0 5px #0795ab; }
50% { background-color: #6632ad !important; box-shadow: 0 0 20px #43b0d1; }
100% { background-color: #4a257a !important; box-shadow: 0 0 5px #0795ab; }
}
'))))
server <- function(input, output) {
observe({
runjs(paste0('$("#button_1").css("animation","glowing 5000ms infinite")'))
delay(5000, runjs(paste0('$("#button_1").css("animation","none")')))
print(input$p1)
})
}
shinyApp(ui, server)
Change observe({...}) to observeEvent(input$p1, {...}, ignoreInit = TRUE)
I have 2 textInput and 2 selectInput functions. One on the dark background on my sidebar and the other on the white (inside the bsModal). My question is: is there a way to style them in different ways? Ideally, I would like to keep the ones on the sidebar the way I styled, and for the ones inside bsModal at least change font color and a border color.
Code:
## Shiny
library(shiny)
library(shinydashboard)
library(shinyBS)
ui <- dashboardPage(
## Header ----
dashboardHeader(
disable = TRUE
),
## Sidebar ----
dashboardSidebar(
sidebarMenu(
div(style = "border-left-color: #1e282c; padding: 10px",
menuItem(text = div(HTML("<left>Search</left>")),
tabName = "search",
icon = icon("search", "fa-2x"))
)
)
),
## Body ----
dashboardBody(
## when header is disabled need to compensate for the missing 50px
## to avoid empty space on the bottom
tags$script('window.onload = function() {
function fixBodyHeight() {
var el = $(document.getElementsByClassName("content-wrapper")[0]);
var h = el.height();
el.css("min-height", h + 50 + "px");
};
window.addEventListener("resize", fixBodyHeight);
fixBodyHeight();
};'),
tags$style(HTML(
"
.well{
background-color: #222C3C;
color: #FFFFFF;
}
.form-control {
background-color: transparent;
border: 0px;
border-bottom: 1px solid #ffffff;
color: #ffffff;
}
.selectize-input{
background: transparent;
}
.selectize-input.items.not-full.has-options {
border: 0px;
border-bottom: 1px solid #ffffff;
border-radius: 0;
}
.selectize-dropdown, .selectize-input, .selectize-input input{
color: #FFFFFF;
}
.selectize-control.multi .selectize-input > div{
background: rgb(9, 231, 178, 0.3);
color: #ffffff;
}
.selectize-dropdown-content {
background: #1B2431;
color: #ffffff;
border-radius: 4px;
}
.selectize-input.full{
background-color: transparent;
color: #FFFFFF;
border: 0px;
border-bottom: 1px solid #ffffff;
border-radius: 0;
}
.selectize-input, .selectize-control.single, .selectize-input.input-active{
background: transparent !important;
}
"
)),
# includeCSS("www/style.css"),
tabItems(
tabItem(
tabName = "search",
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel(div("Search task"),
textInput("searchTextIn", HTML("<i class='fa fa-search'></i> KEYWORDS"), value = ""),
selectizeInput("productFilter", HTML("<i class='fa fa-share-alt gly-rotate-135'></i> PRODUCT OR COMPONENT"),
choices = c("A", "AAA", "B", "BBBBBB", "C", "CCCCCC"),
multiple = TRUE,
selected = c("A", "AAA")),
actionLink("saveToGroup", HTML("<u> Save to group </u>"), style = "color: #d3d3d3cf"),
width = 3)
)),
mainPanel(
bsModal("saveToGroupPopup", "Save to group", "saveToGroup",
div(selectizeInput("saveToGroupSelection",
"Add this search to a search group:",
choices = c("Category A", "Category B", "Category C",
"Batman"),
selected = NULL,
multiple = TRUE,
options = list(maxItems = 1))),
textInput("saveToGroupNew", label = NULL, value = "",
placeholder = "Create new…")
)
)
)
)
)
)
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
you can use glamor to style your inputs differently. Basically glamor allows you to write css using javascript like conditions. just pass a boolean variable along with the class and on the basis of that variable choose the style of text field for example
const descDiv = **isDark** => css({
color: isDark ? color.white : colors.gray,
marginBottom: isDark? '0rem' :'1rem',
letterSpacing:isDark ? '0px' :'-0.6px', //if isDark true 0px else -0.6px
width:isDark? '10rem' :'13.5rem'
});
One solution that worked for me is for the textInput is actually quite easy, all I needed to do is in my css:
textInput(id, "")
tags$style(HTML("
#id.form-control{color:gray;}
"))
For the selectize input is a bit more confusing:
selectizeInput(id, ....)
tags$style(HTML("
#id + div>.selectize-input.items.not-full.has-options{border-bottom: 1px solid #F2F2F2;}
#id + div>.selectize-dropdown, #id+ div>.selectize-input, #id+ div>.selectize-input input{ color: gray;}
#id + div> div> .item {color: gray;}
"))
I am developing a R Shiny Application that use the shinyWidgets library. I use 2 times the radioGroupButtons widget. I would like to make it green the first time, and red the second time, using CSS. (In reality I want to make more customisation).
Here is a basic code, applying CSS to every buttons. How can I apply 2 CSS classes?
Thank you very very much for your help !
library("shinyWidgets")
library(shiny)
# Useless server
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$button1), col = 'skyblue', border = 'white')
})
}
# Ui
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
# A CSS for every .btn button
tags$style(HTML("
.btn {
color: #2ecc71;
border: 2px #2ecc71 solid;
}
.btn:hover {
color: #fff;
background-color: #2ecc71;
}
.btn-default.active, .btn-default:active, .open > .dropdown-toggle.btn-default {
color: #fff;
background-color: #2ecc71;
border-color: #2ecc71;
}
")),
# first radio button, it is green!
radioGroupButtons("button1", label = "It's green !!", choices=c("choice1"=50, "Choice2"=100, "Choice3"=150), selected=100),
# second radio button, I wish it is red!
radioGroupButtons("button2", label = "I wish I was red :( ...", choices=c("choice1"=1, "Choice2"=2), selected=1)
),
mainPanel(plotOutput("distPlot"))
)
)
shinyApp(ui = ui, server = server)
So you want to add some specific classes to your radioGroupButtons. Well, ShinyWidgets doesn't let you, so why not create your own radioButtons widget function.
(Well, this function will be almost entirely copied from radioGroupButtons)
Hint: Type radioGroupButton into the R Console to view the source code.
And lets tweak that function, such that it accepts a class argument, which will be applied to the html element. Then, you can easily access the different radioGroupButton-classes with your CSS.
Working code below:
library("shinyWidgets")
library(shiny)
# Defining the new Widget.
customRadioGroupButtons <- function (inputId, label = NULL, choices, selected = NULL, status = "default", size = "normal", direction = "horizontal", justified = FALSE, individual = FALSE, checkIcon = list(), class=NULL) {
choices <- shinyWidgets:::choicesWithNames(choices)
if (!is.null(selected) && length(selected) > 1)
stop("selected must be length 1")
if (is.null(selected))
selected <- choices[1]
size <- match.arg(arg = size, choices = c("xs", "sm", "normal",
"lg"))
direction <- match.arg(arg = direction, choices = c("horizontal",
"vertical"))
status <- match.arg(arg = status, choices = c("default",
"primary", "success", "info", "warning", "danger"))
divClass <- if (individual)
""
else "btn-group"
if (!individual & direction == "vertical") {
divClass <- paste0(divClass, "-vertical")
}
if (justified) {
divClass <- paste(divClass, "btn-group-justified")
}
if (size != "normal") {
divClass <- paste0(divClass, " btn-group-", size)
}
# Below here, the paste call is the only difference to the original function.
radioGroupButtonsTag <- tagList(tags$div(id = inputId, class = paste("radioGroupButtons", class),
if (!is.null(label))
tags$label(class = "control-label", `for` = inputId, label),
if (!is.null(label))
br(), style = "margin-top: 3px; margin-bottom: 3px; ", style = if (justified) "width: 100%;",
tags$div(class = divClass, role = "group",
`aria-label` = "...", `data-toggle` = "buttons",
class = "btn-group-container-sw", shinyWidgets:::generateRGB(inputId, choices, selected, status, size, checkIcon))))
shinyWidgets:::attachShinyWidgetsDep(radioGroupButtonsTag)
}
# Useless server
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$button1), col = 'skyblue', border = 'white')
})
}
# Ui
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
# Note: Consider making a function if you use this more often.
tags$style(HTML("
.radioGroupButtons.green .btn {
color: #2ecc71;
border: 2px #2ecc71 solid;
}
.radioGroupButtons.green .btn:hover {
color: #fff;
background-color: #2ecc71;
}
.radioGroupButtons.green .btn-default.active, .radioGroupButtons.green .btn-default:active, .radioGroupButtons.green .open > .dropdown-toggle.btn-default {
color: #fff;
background-color: #2ecc71;
border-color: #2ecc71;
}
.radioGroupButtons.red .btn {
color: #EE102B;
border: 2px #EE102B solid;
}
.radioGroupButtons.red .btn:hover {
color: #fff;
background-color: #EE102B;
}
.radioGroupButtons.red .btn-default.active, .radioGroupButtons.green .btn-default:active, .radioGroupButtons.green .open > .dropdown-toggle.btn-default {
color: #fff;
background-color: #EE102B;
border-color: #EE102B;
}
")),
# first radio button, it is green!
customRadioGroupButtons("button1", class="green", label = "It's green !!", choices=c("choice1"=50, "Choice2"=100, "Choice3"=150), selected=100),
# second radio button, I wish it is red!
customRadioGroupButtons("button2", class="red", label = "I wish I was red :( ...", choices=c("choice1"=1, "Choice2"=2), selected=1)
),
mainPanel(plotOutput("distPlot"))
)
)
shinyApp(ui = ui, server = server)
You can add a Bootstrap status then overwrite the class, for example if you add status = "danger", buttons will have class btn-danger :
I can remove the limitation to valid Bootstrap status in the function, it could be useful for such styling (fill an issue here so i remenber).
library("shinyWidgets")
library("shiny")
# Useless server
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$button1), col = 'skyblue', border = 'white')
})
}
# Ui
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
# A CSS for every .btn button
tags$style(HTML("
.btn-success.btn {
color: #2ecc71;
background-color: #fff;
border: 2px #2ecc71 solid;
}
.btn-success.btn:hover {
color: #fff;
background-color: #2ecc71;
}
.btn-success.active {
color: #fff;
background-color: #2ecc71;
border-color: #2ecc71;
}
.btn-danger.btn {
color: #EE102B;
background-color: #fff;
border: 2px #EE102B solid;
}
.btn-danger.btn:hover {
color: #fff;
background-color: #EE102B;
}
.btn-danger.active {
color: #fff;
background-color: #EE102B;
border-color: #EE102B;
}
")),
# first radio button, it is green!
radioGroupButtons("button1", label = "It's green !!", status = "success", choices=c("choice1"=50, "Choice2"=100, "Choice3"=150), selected=100),
# second radio button, I wish it is red!
radioGroupButtons("button2", label = "I wish I was red :( ...", status = "danger", choices=c("choice1"=1, "Choice2"=2), selected=1)
),
mainPanel(plotOutput("distPlot"))
)
)
shinyApp(ui = ui, server = server)
Is there a way to make it so that if a user reaches the end of the "line" on a textInput field that it continues on the next line and increases the height of the textbox so that they can see the entirety of what they have typed? Right now, the text continues on the same line making what was typed first no longer visible. Increasing the height of the textbox would also work given that if they reached the end of textbox, then a scroll bar appeared allowing them to go back to the top of what was typed.
library('shiny')
ui<-fluidPage(
fluidRow(
textInput(inputId = "response1", label = "Type your Response Below")
))
server<-function(input,output,session)
{}
shinyApp(ui=ui, server=server)
Briefly, my proposition is to use an HTML tag textarea and then to give it the css style of shiny widgets.
In the example below I had first created a new div in which I put the HTML tag textarea with id=response2 and a label. Then I added the the css style of the textInput from and applied it to the textarea tag using tags head and style.
Full example:
library(shiny)
ui <- fluidPage(
# Default style of normal textInput applied to the textarea (HTML tag)
tags$head(
tags$style("textarea {
width:300px;
height:34px;
display: block;
padding: 6px 12px;
font-size: 14px;
line-height: 1.42857143;
color: #555;
background-color: #fff;
background-image: none;
border: 1px solid #ccc;
border-radius: 4px;
-webkit-box-shadow: inset 0 1px 1px rgba(0,0,0,.075);
box-shadow: inset 0 1px 1px rgba(0,0,0,.075);
}
textarea:focus {
border-color: #66afe9;
outline: 0;
-webkit-box-shadow: inset 0 1px 1px rgba(0, 0, 0, .075), 0 0 8px rgba(102, 175, 233, .6);
box-shadow: inset 0 1px 1px rgba(0, 0, 0, .075), 0 0 8px rgba(102, 175, 233, .6)
}"
)
),
h3("Normal text input"),
textInput(inputId = "response1", label = "Type your Response Below"),
h3("Styled textarea"),
withTags(
div(
h5(b("Type your Response Below")),
textarea(id = "response2")
)
),
br(),
h3("Text from the styled textarea"),
textOutput("out")
)
server<-function(input, output, session) {
output$out <- renderText({
input$response2
})
}
shinyApp(ui = ui, server = server)
Edit:
Another way of doing the same thing with a smaller amount of the code would be to add the css class of shiny inputs form-control shiny-bound-input to the textarea tag and change the width and the height using style attribute.
library(shiny)
ui <- fluidPage(
h3("Normal text input"),
textInput(inputId = "response1", label = "Type your Response Below"),
h3("Styled textarea"),
withTags(
div(
h5(b("Type your Response Below")),
textarea(id = "response2",
class = "form-control shiny-bound-input",
style = "width: 300px; height: 34px")
)
),
br(),
h3("Text from the styled textarea"),
textOutput("out")
)
server<-function(input, output, session) {
output$out <- renderText({
input$response2
})
}
shinyApp(ui = ui, server = server)
Another way to achieve this is to use textAreaInput instead of textInput, which takes the parameter rows.
This parameter, according to the textAreaInput documentation, takes "The value of the visible character rows of the input".
As such, it can be used like so:
library('shiny')
ui<-fluidPage(
fluidRow(
textAreaInput(inputId = "response1", label = "Type your Response Below", rows=4)
))
server<-function(input,output,session)
{}
shinyApp(ui=ui, server=server)
PS: textAreaInput has its own update-value function: updateTextAreaInput (just in case you are using the textInput's equivalent of updateTextInput)